diff --git a/makefile b/makefile index 42a595c9..9fe833e8 100644 --- a/makefile +++ b/makefile @@ -2,7 +2,7 @@ BUILDID=$(shell date +%Y/%m/%d) TOS = linux TARCH = x86_64 -#TARCH = x86 x86_64 armv6j armv6j_hardfp armv7a_hardfp +#TARCH = x86 x86_64 armv6j armv6j_hardfp armv7a_hardfp powerpc CCOMP = gnuc RELEASE = 1.0 @@ -250,11 +250,6 @@ clean: rm *.a rm *.sym -coco: - $(JET) Sets.Mod Oberon.Mod CRS.Mod CRT.Mod CRA.Mod CRX.Mod CRP.Mod Coco.Mod -m - $(CC) Sets.c Oberon.c CRS.c CRT.c CRA.c CRX.c CRP.c - $(CL) -static -o Coco Coco.c Sets.o Oberon.o CRS.o CRT.o CRA.o CRX.o CRP.o CmdlnTexts.o SYSTEM.o Files.o -L. -lOberon -L/usr/lib -ldl - install: test -d $(PREFIX)/bin | mkdir -p $(PREFIX)/bin cp voc $(PREFIX)/bin/ diff --git a/makefile.gnuc.armv6j b/makefile.gnuc.armv6j index cd559b4b..1b0875c2 100644 --- a/makefile.gnuc.armv6j +++ b/makefile.gnuc.armv6j @@ -2,7 +2,7 @@ BUILDID=$(shell date +%Y/%m/%d) TOS = linux TARCH = armv6j -#TARCH = x86 x86_64 armv6j armv6j_hardfp armv7a_hardfp +#TARCH = x86 x86_64 armv6j armv6j_hardfp armv7a_hardfp powerpc CCOMP = gnuc RELEASE = 1.0 diff --git a/makefile.gnuc.armv6j_hardfp b/makefile.gnuc.armv6j_hardfp index 91afc2f1..e6d46142 100644 --- a/makefile.gnuc.armv6j_hardfp +++ b/makefile.gnuc.armv6j_hardfp @@ -2,7 +2,7 @@ BUILDID=$(shell date +%Y/%m/%d) TOS = linux TARCH = armv6j_hardfp -#TARCH = x86 x86_64 armv6j armv6j_hardfp armv7a_hardfp +#TARCH = x86 x86_64 armv6j armv6j_hardfp armv7a_hardfp powerpc CCOMP = gnuc RELEASE = 1.0 diff --git a/makefile.gnuc.armv7a_hardfp b/makefile.gnuc.armv7a_hardfp index 65e7174d..059a9d8b 100644 --- a/makefile.gnuc.armv7a_hardfp +++ b/makefile.gnuc.armv7a_hardfp @@ -2,7 +2,7 @@ BUILDID=$(shell date +%Y/%m/%d) TOS = linux TARCH = armv7a_hardfp -#TARCH = x86 x86_64 armv6j armv6j_hardfp armv7a_hardfp +#TARCH = x86 x86_64 armv6j armv6j_hardfp armv7a_hardfp powerpc CCOMP = gnuc RELEASE = 1.0 diff --git a/makefile.gnuc.powerpc b/makefile.gnuc.powerpc new file mode 100644 index 00000000..968af564 --- /dev/null +++ b/makefile.gnuc.powerpc @@ -0,0 +1,281 @@ +#SHELL := /bin/bash +BUILDID=$(shell date +%Y/%m/%d) +TOS = linux +TARCH = powerpc +#TARCH = x86 x86_64 armv6j armv6j_hardfp armv7a_hardfp powerpc +CCOMP = gnuc +RELEASE = 1.0 + + +INCLUDEPATH = -Isrc/lib/system/$(CCOMP)/$(TARCH) + +SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/v4/$(TARCH):src/lib/system:src/lib/system/$(CCOMP):src/lib/system/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(CCOMP):src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(CCOMP):src/lib/ooc:src/lib/ooc/$(CCOMP):src/lib/pow:src/lib/misc:src/lib/s3:src/voc:src/voc/$(CCOMP):src/voc/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/vmake:src/tools/coco:src/test + +VOC = voc +VOCSTATIC0 = $(SETPATH) ./vocstatic.$(TOS).$(CCOMP).$(TARCH) +VOCSTATIC = $(SETPATH) ./voc +VOCPARAM = $(shell ./vocparam > voc.par) +VERSION = GNU_Linux_$(TARCH) +LIBNAME = VishapOberon +LIBRARY = lib$(LIBNAME) + +ifndef PREFIX +PREFIX = /opt/voc-$(RELEASE) +endif + +CCOPT = -fPIC $(INCLUDEPATH) -g + +CC = cc $(CCOPT) -c +CL = cc $(CCOPT) +LD = cc -shared -o $(LIBRARY).so +# s is necessary to create index inside a archive +ARCHIVE = ar rcs $(LIBRARY).a + +#%.c: %.Mod +#%.o: %.c +# $(CC) $(input) + +all: stage2 stage3 stage4 stage5 stage6 stage7 + +# when porting to new platform: +# * put corresponding .par file into current directory. it can be generated on the target platform by compiling vocparam (stage0) and running (stage1) +# * run make port0 - this will generate C source files for the target architecture +# * move the source tree to the target machine, and compile (or compile here via crosscompiler) (port1) +port0: stage2 stage3 stage4 + +# now compile C source files for voc, showdef and ocat on target machine (or by using crosscompiler) +port1: stage5 +# after you have "voc" compiled for target architecture. replace vocstatic with it and run make on target platform to get everything compiled + +# this builds binary which generates voc.par +stage0: src/tools/vocparam/vocparam.c + $(CL) -I src/lib -o vocparam src/tools/vocparam/vocparam.c + +# this creates voc.par for a host architecture. +# comment this out if you need to build a compiler for a different architecture. +stage1: + #rm voc.par + #$(shell "./vocparam > voc.par") + #./vocparam > voc.par + $(VOCPARAM) + +# this copies necessary voc.par to the current directory. +# skip this if you are building compiler for the host architecture. +stage2: + cp src/par/voc.par.$(CCOMP).$(TARCH) voc.par +# cp src/par/voc.par.gnu.x86_64 voc.par +# cp src/par/voc.par.gnu.x86 voc.par +# cp src/par/voc.par.gnu.armv6 voc.par +# cp src/par/voc.par.gnu.armv7 voc.par + +# this prepares modules necessary to build the compiler itself +stage3: + + $(VOCSTATIC0) -siapxPS SYSTEM.Mod + $(VOCSTATIC0) -sPS Args.Mod Console.Mod Unix.Mod + $(VOCSTATIC0) -sPS oocOakStrings.Mod architecture.Mod version.Mod Kernel.Mod Modules.Mod + $(VOCSTATIC0) -sxPS Files.Mod + $(VOCSTATIC0) -sxPS OakFiles.Mod + $(VOCSTATIC0) -sPS Reals.Mod CmdlnTexts.Mod errors.Mod + +# build the compiler +stage4: + $(VOCSTATIC0) -sPS extTools.Mod + $(VOCSTATIC0) -sPS OPM.cmdln.Mod + $(VOCSTATIC0) -sxPS OPS.Mod + $(VOCSTATIC0) -sPS OPT.Mod OPC.Mod OPV.Mod OPB.Mod OPP.Mod + $(VOCSTATIC0) -smPS voc.Mod + $(VOCSTATIC0) -smPS BrowserCmd.Mod + $(VOCSTATIC0) -smPS OCatCmd.Mod + $(VOCSTATIC0) -sPS compatIn.Mod + $(VOCSTATIC0) -smPS vmake.Mod + +#this is to build the compiler from C sources. +#this is a way to create a bootstrap binary. +stage5: + $(CC) SYSTEM.c Args.c Console.c Modules.c Unix.c \ + oocOakStrings.c architecture.c version.c Kernel.c Files.c OakFiles.c Reals.c CmdlnTexts.c \ + version.c extTools.c \ + OPM.c OPS.c OPT.c OPC.c OPV.c OPB.c OPP.c errors.c + + $(CL) -static voc.c -o voc \ + SYSTEM.o Args.o Console.o Modules.o Unix.o \ + oocOakStrings.o architecture.o version.o Kernel.o Files.o Reals.o CmdlnTexts.o \ + extTools.o \ + OPM.o OPS.o OPT.o OPC.o OPV.o OPB.o OPP.o errors.o + $(CL) BrowserCmd.c -o showdef \ + SYSTEM.o Args.o Console.o Modules.o Unix.o oocOakStrings.o architecture.o version.o Kernel.o Files.o Reals.o CmdlnTexts.o \ + OPM.o OPS.o OPT.o OPV.o OPC.o errors.o + + $(CL) OCatCmd.c -o ocat \ + SYSTEM.o Args.o Console.o Modules.o Unix.o oocOakStrings.o architecture.o version.o Kernel.o Files.o Reals.o CmdlnTexts.o + + $(CC) compatIn.c + $(CL) vmake.c -o vmake SYSTEM.o Args.o compatIn.o CmdlnTexts.o Console.o Files.o Reals.o Modules.o Kernel.o Unix.o oocOakStrings.o version.o architecture.o + + +# build all library files +stage6: + #more v4 libs + $(VOCSTATIC) -sP Printer.Mod + $(VOCSTATIC) -sP Strings.Mod + + #ooc libs + $(VOCSTATIC) -sP oocAscii.Mod + $(VOCSTATIC) -sP oocStrings.Mod + $(VOCSTATIC) -sP oocStrings2.Mod + $(VOCSTATIC) -sP oocCharClass.Mod + $(VOCSTATIC) -sP oocConvTypes.Mod + $(VOCSTATIC) -sP oocIntConv.Mod + $(VOCSTATIC) -sP oocIntStr.Mod + $(VOCSTATIC) -sP oocSysClock.Mod + $(VOCSTATIC) -sP oocTime.Mod +# $(VOCSTATIC) -s oocLongStrings.Mod +# $(CC) oocLongStrings.c +# $(VOCSTATIC) -s oocMsg.Mod +# $(CC) oocMsg.c + + + #ooc2 libs + $(VOCSTATIC) -sP ooc2Strings.Mod + $(VOCSTATIC) -sP ooc2Ascii.Mod + $(VOCSTATIC) -sP ooc2CharClass.Mod + $(VOCSTATIC) -sP ooc2ConvTypes.Mod + $(VOCSTATIC) -sP ooc2IntConv.Mod + $(VOCSTATIC) -sP ooc2IntStr.Mod + $(VOCSTATIC) -sP ooc2Real0.Mod + #ooc libs + $(VOCSTATIC) -sP oocLowReal.Mod oocLowLReal.Mod + $(VOCSTATIC) -sP oocRealMath.Mod oocOakMath.Mod + $(VOCSTATIC) -sP oocLRealMath.Mod + $(VOCSTATIC) -sP oocLongInts.Mod + $(VOCSTATIC) -sP oocComplexMath.Mod oocLComplexMath.Mod + $(VOCSTATIC) -sP oocLRealConv.Mod oocLRealStr.Mod + $(VOCSTATIC) -sP oocRealConv.Mod oocRealStr.Mod + $(VOCSTATIC) -sP oocMsg.Mod oocChannel.Mod + $(VOCSTATIC) -sP oocStrings2.Mod oocRts.Mod oocFilenames.Mod + $(VOCSTATIC) -sP oocTextRider.Mod oocBinaryRider.Mod oocJulianDay.Mod + $(VOCSTATIC) -sP oocwrapperlibc.Mod + + #Ulm's Oberon system libs + $(VOCSTATIC) -sP ulmSys.Mod + $(VOCSTATIC) -sP ulmSYSTEM.Mod + $(VOCSTATIC) -sP ulmASCII.Mod + $(VOCSTATIC) -sP ulmSets.Mod + $(VOCSTATIC) -sP ulmObjects.Mod + $(VOCSTATIC) -sP ulmDisciplines.Mod + $(VOCSTATIC) -sP ulmPriorities.Mod + $(VOCSTATIC) -sP ulmServices.Mod + $(VOCSTATIC) -sP ulmEvents.Mod + $(VOCSTATIC) -sP ulmResources.Mod + $(VOCSTATIC) -sP ulmForwarders.Mod + $(VOCSTATIC) -sP ulmRelatedEvents.Mod + $(VOCSTATIC) -sP ulmIO.Mod + $(VOCSTATIC) -sP ulmProcess.Mod + $(VOCSTATIC) -sP ulmTypes.Mod + $(VOCSTATIC) -sP ulmStreams.Mod + $(VOCSTATIC) -sP ulmAssertions.Mod + $(VOCSTATIC) -sP ulmIndirectDisciplines.Mod + $(VOCSTATIC) -sP ulmStreamDisciplines.Mod + $(VOCSTATIC) -sP ulmIEEE.Mod + $(VOCSTATIC) -sP ulmMC68881.Mod + $(VOCSTATIC) -sP ulmReals.Mod + $(VOCSTATIC) -sP ulmPrint.Mod + $(VOCSTATIC) -sP ulmWrite.Mod + $(VOCSTATIC) -sP ulmTexts.Mod + $(VOCSTATIC) -sP ulmStrings.Mod + $(VOCSTATIC) -sP ulmConstStrings.Mod + $(VOCSTATIC) -sP ulmPlotters.Mod + $(VOCSTATIC) -sP ulmSysTypes.Mod + $(VOCSTATIC) -sP ulmSysConversions.Mod + $(VOCSTATIC) -sP ulmErrors.Mod + $(VOCSTATIC) -sP ulmSysErrors.Mod + $(VOCSTATIC) -sP ulmSysIO.Mod + $(VOCSTATIC) -sP ulmLoader.Mod + $(VOCSTATIC) -sP ulmNetIO.Mod + $(VOCSTATIC) -sP ulmPersistentObjects.Mod + $(VOCSTATIC) -sP ulmPersistentDisciplines.Mod + $(VOCSTATIC) -sP ulmOperations.Mod + $(VOCSTATIC) -sP ulmScales.Mod + $(VOCSTATIC) -sP ulmTimes.Mod + $(VOCSTATIC) -sP ulmClocks.Mod + $(VOCSTATIC) -sP ulmTimers.Mod + $(VOCSTATIC) -sP ulmConditions.Mod + $(VOCSTATIC) -sP ulmStreamConditions.Mod + $(VOCSTATIC) -sP ulmTimeConditions.Mod + $(VOCSTATIC) -sP ulmSysConversions.Mod + $(VOCSTATIC) -sP ulmSysStat.Mod + + + #pow32 libs + $(VOCSTATIC) -sP powStrings.Mod + + #misc libs + $(VOCSTATIC) -sP MultiArrays.Mod + $(VOCSTATIC) -sP MultiArrayRiders.Mod + $(VOCSTATIC) -sP MersenneTwister.Mod + + #s3 libs + $(VOCSTATIC) -sP ethBTrees.Mod + $(VOCSTATIC) -sP ethMD5.Mod + $(VOCSTATIC) -sP ethSets.Mod + $(VOCSTATIC) -sP ethZlib.Mod + $(VOCSTATIC) -sP ethZlibBuffers.Mod + $(VOCSTATIC) -sP ethZlibInflate.Mod + $(VOCSTATIC) -sP ethZlibDeflate.Mod + $(VOCSTATIC) -sP ethZlibReaders.Mod + $(VOCSTATIC) -sP ethZlibWriters.Mod + $(VOCSTATIC) -sP ethZip.Mod + $(VOCSTATIC) -sP ethRandomNumbers.Mod + $(VOCSTATIC) -sP ethGZReaders.Mod + $(VOCSTATIC) -sP ethGZWriters.Mod + + +stage7: + #objects := $(wildcard *.o) + #$(LD) objects + $(ARCHIVE) *.o + #$(ARCHIVE) objects + $(LD) *.o + echo "$(PREFIX)/lib" > 05vishap.conf + +clean: +# rm_objects := rm $(wildcard *.o) +# objects + rm *.o + rm *.so + rm *.h + rm *.c + rm *.a + rm *.sym + +coco: + $(JET) Sets.Mod Oberon.Mod CRS.Mod CRT.Mod CRA.Mod CRX.Mod CRP.Mod Coco.Mod -m + $(CC) Sets.c Oberon.c CRS.c CRT.c CRA.c CRX.c CRP.c + $(CL) -static -o Coco Coco.c Sets.o Oberon.o CRS.o CRT.o CRA.o CRX.o CRP.o CmdlnTexts.o SYSTEM.o Files.o -L. -lOberon -L/usr/lib -ldl + +install: + test -d $(PREFIX)/bin | mkdir -p $(PREFIX)/bin + cp voc $(PREFIX)/bin/ + cp showdef $(PREFIX)/bin/ + cp ocat $(PREFIX)/bin/ + cp vmake $(PREFIX)/bin/ + cp -a src $(PREFIX)/ + + test -d $(PREFIX)/lib/voc | mkdir -p $(PREFIX)/lib/voc + test -d $(PREFIX)/lib/voc/ | mkdir -p $(PREFIX)/lib/voc + test -d $(PREFIX)/lib/voc/obj | mkdir -p $(PREFIX)/lib/voc/obj + test -d $(PREFIX)/lib/voc/sym | mkdir -p $(PREFIX)/lib/voc/sym + + cp $(LIBRARY).so $(PREFIX)/lib + cp $(LIBRARY).a $(PREFIX)/lib + cp *.c $(PREFIX)/lib/voc/obj/ + cp *.h $(PREFIX)/lib/voc/obj/ + cp *.sym $(PREFIX)/lib/voc/sym/ + + cp 05vishap.conf /etc/ld.so.conf.d/ + ldconfig + +# cp *.o $(PREFIX)/lib/voc/$(RELEASE)/obj/ +uninstall: + rm -rf $(PREFIX) diff --git a/makefile.gnuc.x86 b/makefile.gnuc.x86 index c0b84d01..a08c8c58 100644 --- a/makefile.gnuc.x86 +++ b/makefile.gnuc.x86 @@ -2,7 +2,7 @@ BUILDID=$(shell date +%Y/%m/%d) TOS = linux TARCH = x86 -#TARCH = x86 x86_64 armv6j armv6j_hardfp armv7a_hardfp +#TARCH = x86 x86_64 armv6j armv6j_hardfp armv7a_hardfp powerpc CCOMP = gnuc RELEASE = 1.0 diff --git a/makefile.gnuc.x86_64 b/makefile.gnuc.x86_64 index 11ac7296..a30d9df9 100644 --- a/makefile.gnuc.x86_64 +++ b/makefile.gnuc.x86_64 @@ -2,7 +2,7 @@ BUILDID=$(shell date +%Y/%m/%d) TOS = linux TARCH = x86_64 -#TARCH = x86 x86_64 armv6j armv6j_hardfp armv7a_hardfp +#TARCH = x86 x86_64 armv6j armv6j_hardfp armv7a_hardfp powerpc CCOMP = gnuc RELEASE = 1.0 diff --git a/ocat b/ocat index 10efb9d6..0427650d 100755 Binary files a/ocat and b/ocat differ diff --git a/showdef.REMOVED.git-id b/showdef.REMOVED.git-id index 5728f240..e667c6d0 100644 --- a/showdef.REMOVED.git-id +++ b/showdef.REMOVED.git-id @@ -1 +1 @@ -127b39b0b88a2821cd08389f5930f44d9ced5c5c \ No newline at end of file +4defe4c7e72c85a151137ba3aa8993836fbb6340 \ No newline at end of file diff --git a/src/lib/system/gnuc/powerpc/Args.Mod b/src/lib/system/gnuc/powerpc/Args.Mod new file mode 100644 index 00000000..e8cd2a3c --- /dev/null +++ b/src/lib/system/gnuc/powerpc/Args.Mod @@ -0,0 +1,64 @@ +MODULE Args; (* jt, 8.12.94 *) + + (* command line argument handling for ofront *) + + + IMPORT SYSTEM; + + TYPE + ArgPtr = POINTER TO ARRAY 1024 OF CHAR; + ArgVec = POINTER TO ARRAY 1024 OF ArgPtr; + + VAR argc-, argv-: LONGINT; + + PROCEDURE -Argc(): INTEGER "SYSTEM_argc"; + PROCEDURE -Argv(): LONGINT "(long)SYSTEM_argv"; + PROCEDURE -getenv(var: ARRAY OF CHAR): ArgPtr + "(Args_ArgPtr)getenv(var)"; + + PROCEDURE Get*(n: INTEGER; VAR val: ARRAY OF CHAR); + VAR av: ArgVec; + BEGIN + IF n < argc THEN av := SYSTEM.VAL(ArgVec, argv); COPY(av[n]^, val) END + END Get; + + PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); + VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT; + BEGIN + s := ""; Get(n, s); i := 0; + IF s[0] = "-" THEN i := 1 END ; + k := 0; d := ORD(s[i]) - ORD("0"); + WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ; + IF s[0] = "-" THEN d := -d; DEC(i) END ; + IF i > 0 THEN val := k END + END GetInt; + + PROCEDURE Pos*(s: ARRAY OF CHAR): INTEGER; + VAR i: INTEGER; arg: ARRAY 256 OF CHAR; + BEGIN + i := 0; Get(i, arg); + WHILE (i < argc) & (s # arg) DO INC(i); Get(i, arg) END ; + RETURN i + END Pos; + + PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR); + VAR p: ArgPtr; + BEGIN + p := getenv(var); + IF p # NIL THEN COPY(p^, val) END + END GetEnv; + + PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN; + VAR p: ArgPtr; + BEGIN + p := getenv(var); + IF p # NIL THEN + COPY(p^, val); + RETURN TRUE + ELSE + RETURN FALSE + END + END getEnv; + +BEGIN argc := Argc(); argv := Argv() +END Args. diff --git a/src/lib/system/gnuc/powerpc/SYSTEM.c0 b/src/lib/system/gnuc/powerpc/SYSTEM.c0 new file mode 100644 index 00000000..580449aa --- /dev/null +++ b/src/lib/system/gnuc/powerpc/SYSTEM.c0 @@ -0,0 +1,205 @@ +/* +* The body prefix file of the Ofront runtime system, Version 1.0 +* +* Copyright (c) Software Templ, 1994, 1995 +* +* Module SYSTEM is subject to change any time without prior notification. +* Software Templ disclaims all warranties with regard to module SYSTEM, +* in particular shall Software Templ not be liable for any damage resulting +* from inappropriate use or modification of module SYSTEM. +* +* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers +* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings +* +*/ + +#include "SYSTEM.h" +#ifdef __STDC__ +#include "stdarg.h" +#else +#include "varargs.h" +#endif + +extern void *malloc(long size); +extern void exit(int status); + +void (*SYSTEM_Halt)(); +LONGINT SYSTEM_halt; /* x in HALT(x) */ +LONGINT SYSTEM_assert; /* x in ASSERT(cond, x) */ +LONGINT SYSTEM_argc; +LONGINT SYSTEM_argv; +LONGINT SYSTEM_lock; +BOOLEAN SYSTEM_interrupted; +static LONGINT SYSTEM_mainfrm; /* adr of main proc stack frame, used for stack collection */ + +#define Lock SYSTEM_lock++ +#define Unlock SYSTEM_lock--; if (SYSTEM_interrupted && (SYSTEM_lock == 0)) __HALT(-9) + + +static void SYSTEM_InitHeap(); +void *SYSTEM__init(); + +void SYSTEM_INIT(argc, argvadr) + int argc; long argvadr; +{ + SYSTEM_mainfrm = argvadr; + SYSTEM_argc = argc; + SYSTEM_argv = *(long*)argvadr; + SYSTEM_InitHeap(); + SYSTEM_halt = -128; + SYSTEM__init(); +} + +void SYSTEM_FINI() +{ + SYSTEM_FINALL(); +} + +long SYSTEM_XCHK(i, ub) long i, ub; {return __X(i, ub);} +long SYSTEM_RCHK(i, ub) long i, ub; {return __R(i, ub);} +long SYSTEM_ASH(i, n) long i, n; {return __ASH(i, n);} +long SYSTEM_ABS(i) long i; {return __ABS(i);} +double SYSTEM_ABSD(i) double i; {return __ABS(i);} + +void SYSTEM_INHERIT(t, t0) + long *t, *t0; +{ + t -= __TPROC0OFF; + t0 -= __TPROC0OFF; + while (*t0 != __EOM) {*t = *t0; t--; t0--;} +} + +void SYSTEM_ENUMP(adr, n, P) + long *adr; + long n; + void (*P)(); +{ + while (n > 0) {P(*adr); adr++; n--;} +} + +void SYSTEM_ENUMR(adr, typ, size, n, P) + char *adr; + long *typ, size, n; + void (*P)(); +{ + long *t, off; + typ++; + while (n > 0) { + t = typ; + off = *t; + while (off >= 0) {P(*(long*)(adr+off)); t++; off = *t;} + adr += size; n--; + } +} + +long SYSTEM_DIV(x, y) + unsigned long x, y; +{ if ((long) x >= 0) return (x / y); + else return -((y - 1 - x) / y); +} + +long SYSTEM_MOD(x, y) + unsigned long x, y; +{ unsigned long m; + if ((long) x >= 0) return (x % y); + else { m = (-x) % y; + if (m != 0) return (y - m); else return 0; + } +} + +long SYSTEM_ENTIER(x) + double x; +{ + long y; + if (x >= 0) + return (long)x; + else { + y = (long)x; + if (y <= x) return y; else return y - 1; + } +} + +void SYSTEM_HALT(n) + int n; +{ + SYSTEM_halt = n; + if (SYSTEM_Halt!=0) SYSTEM_Halt(n); + exit(n); +} + +#ifdef __STDC__ +SYSTEM_PTR SYSTEM_NEWARR(long *typ, long elemsz, int elemalgn, int nofdim, int nofdyn, ...) +#else +SYSTEM_PTR SYSTEM_NEWARR(typ, elemsz, elemalgn, nofdim, nofdyn, va_alist) + long *typ, elemsz; + int elemalgn, nofdim, nofdyn; + va_dcl +#endif +{ + long nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; + va_list ap; +#ifdef __STDC__ + va_start(ap, nofdyn); +#else + va_start(ap); +#endif + nofelems = 1; + while (nofdim > 0) { + nofelems = nofelems * va_arg(ap, long); nofdim--; + if (nofelems <= 0) __HALT(-20); + } + va_end(ap); + dataoff = nofdyn * sizeof(long); + if (elemalgn > sizeof(long)) { + n = dataoff % elemalgn; + if (n != 0) dataoff += elemalgn - n; + } + size = dataoff + nofelems * elemsz; + Lock; + if (typ == NIL) { + /* element typ does not contain pointers */ + x = SYSTEM_NEWBLK(size); + } + else if (typ == POINTER__typ) { + /* element type is a pointer */ + x = SYSTEM_NEWBLK(size + nofelems * sizeof(long)); + p = (long*)x[-1]; + p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ + p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ + while (n <= nofelems) {*p = n*sizeof(long); p++; n++;} + *p = - (nofelems + 1) * sizeof(long); /* sentinel */ + x[-1] -= nofelems * sizeof(long); + } + else { + /* element type is a record that contains pointers */ + ptab = typ + 1; nofptrs = 0; + while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ + nptr = nofelems * nofptrs; /* total number of pointers */ + x = SYSTEM_NEWBLK(size + nptr * sizeof(long)); + p = (long*)x[- 1]; + p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ + p -= nptr - 1; n = 0; off = dataoff; + while (n < nofelems) {i = 0; + while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} + off += elemsz; n++; + } + *p = - (nptr + 1) * sizeof(long); /* sentinel */ + x[-1] -= nptr * sizeof(long); + } + if (nofdyn != 0) { + /* setup len vector for index checks */ +#ifdef __STDC__ + va_start(ap, nofdyn); +#else + va_start(ap); +#endif + p = x; + while (nofdyn > 0) {*p = va_arg(ap, long); p++, nofdyn--;} + va_end(ap); + } + Unlock; + return x; +} + +/* ----------- end of SYSTEM.co ------------- */ + diff --git a/src/lib/system/gnuc/powerpc/SYSTEM.h b/src/lib/system/gnuc/powerpc/SYSTEM.h new file mode 100644 index 00000000..719a6d18 --- /dev/null +++ b/src/lib/system/gnuc/powerpc/SYSTEM.h @@ -0,0 +1,215 @@ +#ifndef SYSTEM__h +#define SYSTEM__h + +/* + +the Ofront runtime system interface and macros library +copyright (c) Josef Templ, 1995, 1996 + +gcc for Linux version (same as SPARC/Solaris2) +uses double # as concatenation operator + +*/ + +#include + +//extern void *memcpy(void *dest, const void *src, long n); +extern void *memcpy(void *dest, const void *src, size_t n); +extern void *malloc(long size); +extern void exit(int status); + +#define export +#define import extern + +/* constants */ +#define __MAXEXT 16 +#define NIL 0L +#define POINTER__typ (long*)1L /* not NIL and not a valid type */ + +/* basic types */ +typedef char BOOLEAN; +typedef unsigned char CHAR; +typedef signed char SHORTINT; +typedef short int INTEGER; +typedef long LONGINT; +typedef float REAL; +typedef double LONGREAL; +typedef unsigned long SET; +typedef void *SYSTEM_PTR; +typedef unsigned char SYSTEM_BYTE; + +/* runtime system routines */ +extern long SYSTEM_DIV(); +extern long SYSTEM_MOD(); +extern long SYSTEM_ENTIER(); +extern long SYSTEM_ASH(); +extern long SYSTEM_ABS(); +extern long SYSTEM_XCHK(); +extern long SYSTEM_RCHK(); +extern double SYSTEM_ABSD(); +extern SYSTEM_PTR SYSTEM_NEWREC(); +extern SYSTEM_PTR SYSTEM_NEWBLK(); +#ifdef __STDC__ +extern SYSTEM_PTR SYSTEM_NEWARR(long*, long, int, int, int, ...); +#else +extern SYSTEM_PTR SYSTEM_NEWARR(); +#endif +extern SYSTEM_PTR SYSTEM_REGMOD(); +extern void SYSTEM_INCREF(); +extern void SYSTEM_REGCMD(); +extern void SYSTEM_REGTYP(); +extern void SYSTEM_REGFIN(); +extern void SYSTEM_FINALL(); +extern void SYSTEM_INIT(); +extern void SYSTEM_FINI(); +extern void SYSTEM_HALT(); +extern void SYSTEM_INHERIT(); +extern void SYSTEM_ENUMP(); +extern void SYSTEM_ENUMR(); + +/* module registry */ +#define __DEFMOD static void *m; if(m!=0)return m +#define __REGMOD(name, enum) if(m==0)m=SYSTEM_REGMOD((CHAR*)name,enum); else return m +#define __ENDMOD return m +#define __INIT(argc, argv) static void *m; SYSTEM_INIT(argc, (long)&argv); +#define __REGMAIN(name, enum) m=SYSTEM_REGMOD(name,enum) +#define __FINI SYSTEM_FINI(); return 0 +#define __IMPORT(name) SYSTEM_INCREF(name##__init()) +#define __REGCMD(name, cmd) SYSTEM_REGCMD(m, name, cmd) + +/* SYSTEM ops */ +#define __SYSNEW(p, len) p=SYSTEM_NEWBLK((long)(len)) +#define __VAL(t, x) (*(t*)&(x)) +#define __GET(a, x, t) x= *(t*)(a) +#define __PUT(a, x, t) *(t*)(a)=x +#define __LSHL(x, n, t) ((t)((unsigned)(x)<<(n))) +#define __LSHR(x, n, t) ((t)((unsigned)(x)>>(n))) +#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) +#define __ROTL(x, n, t) ((t)((unsigned)(x)<<(n)|(unsigned)(x)>>(8*sizeof(t)-(n)))) +#define __ROTR(x, n, t) ((t)((unsigned)(x)>>(n)|(unsigned)(x)<<(8*sizeof(t)-(n)))) +#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) +#define __BIT(x, n) (*(unsigned long*)(x)>>(n)&1) +#define __MOVE(s, d, n) memcpy((char*)(d),(char*)(s),n) + +/* std procs and operator mappings */ +#define __SHORT(x, y) ((int)((unsigned long)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) +#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) +#define __CHR(x) ((CHAR)__R(x, 256)) +#define __CHRF(x) ((CHAR)__RF(x, 256)) +#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) +#define __DIVF(x, y) SYSTEM_DIV((long)(x),(long)(y)) +#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) +#define __MODF(x, y) SYSTEM_MOD((long)(x),(long)(y)) +#define __NEW(p, t) p=SYSTEM_NEWREC((long)t##__typ) +#define __NEWARR SYSTEM_NEWARR +#define __HALT(x) SYSTEM_HALT(x) +#define __ASSERT(cond, x) if (!(cond)) {SYSTEM_assert = x; SYSTEM_HALT(-1);} +#define __ENTIER(x) SYSTEM_ENTIER(x) +#define __ABS(x) (((x)<0)?-(x):(x)) +#define __ABSF(x) SYSTEM_ABS((long)(x)) +#define __ABSFD(x) SYSTEM_ABSD((double)(x)) +#define __CAP(ch) ((CHAR)((ch)&0x5f)) +#define __ODD(x) ((x)&1) +#define __IN(x, s) (((s)>>(x))&1) +#define __SETOF(x) ((SET)1<<(x)) +#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) +#define __MASK(x, m) ((x)&~(m)) +#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d;long _i=0,_t=n-1;while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} +static int __STRCMP(x, y) + CHAR *x, *y; +{long i = 0; CHAR ch1, ch2; + do {ch1 = x[i]; ch2 = y[i]; i++; + if (!ch1) return -(int)ch2; + } while (ch1==ch2); + return (int)ch1 - (int)ch2; +} +#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) +#define __ASHL(x, n) ((long)(x)<<(n)) +#define __ASHR(x, n) ((long)(x)>>(n)) +#define __ASHF(x, n) SYSTEM_ASH((long)(x), (long)(n)) +#define __DUP(x, l, t) x=(void*)memcpy(alloca(l*sizeof(t)),x,l*sizeof(t)) +#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) +#define __DEL(x) /* DUP with alloca frees storage automatically */ +#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(long)typ##__typ) +#define __TYPEOF(p) (*(((long**)(p))-1)) +#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) + +/* runtime checks */ +#define __X(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-2),0)) +#define __XF(i, ub) SYSTEM_XCHK((long)(i), (long)(ub)) +#define __RETCHK __retchk: __HALT(-3) +#define __CASECHK __HALT(-4) +#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) +#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) +#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) +#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) +#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) +#define __WITHCHK __HALT(-7) +#define __R(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-8),0)) +#define __RF(i, ub) SYSTEM_RCHK((long)(i),(long)(ub)) + +/* record type descriptors */ +#define __TDESC(t, m, n) \ + static struct t##__desc {\ + long tproc[m]; \ + long tag, next, level, module; \ + char name[24]; \ + long *base[__MAXEXT]; \ + char *rsrvd; \ + long blksz, ptr[n+1]; \ + } t##__desc + +#define __BASEOFF (__MAXEXT+1) +#define __TPROC0OFF (__BASEOFF+24/sizeof(long)+5) +#define __EOM 1 +#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size +#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (long)(n), P) +#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (long)(size), (long)(n), P) + +#define __INITYP(t, t0, level) \ + t##__typ= &t##__desc.blksz; \ + memcpy(t##__desc.base, t0##__typ - __BASEOFF, level*sizeof(long)); \ + t##__desc.base[level]=t##__typ; \ + t##__desc.module=(long)m; \ + if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ + t##__desc.blksz=(t##__desc.blksz+5*sizeof(long)-1)/(4*sizeof(long))*(4*sizeof(long)); \ + SYSTEM_REGTYP(m, (long)&t##__desc.next); \ + SYSTEM_INHERIT(t##__typ, t0##__typ) + +/* Oberon-2 type bound procedures support */ +#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(long)proc +#define __SEND(typ, num, funtyp, parlist) ((funtyp)(*(typ-(__TPROC0OFF+num))))parlist + +/* runtime system variables */ +extern LONGINT SYSTEM_argc; +extern LONGINT SYSTEM_argv; +extern void (*SYSTEM_Halt)(); +extern LONGINT SYSTEM_halt; +extern LONGINT SYSTEM_assert; +extern SYSTEM_PTR SYSTEM_modules; +extern LONGINT SYSTEM_heapsize; +extern LONGINT SYSTEM_allocated; +extern LONGINT SYSTEM_lock; +extern SHORTINT SYSTEM_gclock; +extern BOOLEAN SYSTEM_interrupted; + +/* ANSI prototypes; not used so far +static int __STRCMP(CHAR *x, CHAR *y); +void SYSTEM_INIT(int argc, long argvadr); +void SYSTEM_FINI(void); +long SYSTEM_XCHK(long i, long ub); +long SYSTEM_RCHK(long i, long ub); +long SYSTEM_ASH(long i, long n); +long SYSTEM_ABS(long i); +double SYSTEM_ABSD(double i); +void SYSTEM_INHERIT(long *t, long *t0); +void SYSTEM_ENUMP(long *adr, long n, void (*P)(void*)); +void SYSTEM_ENUMR(char *adr, long *typ, long size, long n, void (*P)(void*)); +long SYSTEM_DIV(unsigned long x, unsigned long y); +long SYSTEM_MOD(unsigned long x, unsigned long y); +long SYSTEM_ENTIER(double x); +void SYSTEM_HALT(int n); +*/ + +#endif + diff --git a/src/lib/system/gnuc/powerpc/Unix.Mod b/src/lib/system/gnuc/powerpc/Unix.Mod new file mode 100644 index 00000000..9e46278e --- /dev/null +++ b/src/lib/system/gnuc/powerpc/Unix.Mod @@ -0,0 +1,419 @@ +MODULE Unix; (* Josef Templ, 5.3.90 Linux system calls *) +(* system procedure added by noch *) +(* Module Unix provides a system call interface to Linux. + Naming conventions: + Procedure and Type-names always start with a capital letter. + error numbers as defined in Unix + other constants start with lower case letters *) + +IMPORT SYSTEM; + +CONST + +(* various important constants *) + + stdin* = 0; stdout* =1; stderr* = 2; + + LOCKEX* = 2; LOCKUN* = 8; (* /usr/include/file.h *) + AFINET* = 2; (* /usr/include/sys/socket.h *) + PFINET* = AFINET; (* /usr/include/linux/socket.h *) + SOCKSTREAM* = 1; (* /usr/include/linux/socket.h *) + FIONREAD* = 541BH; (* in /usr/include/asm/termios.h *) + SETFL* = 4; (* set file descriptor flags; in asm/fcntl.h *) + TCP* = 0; + +(* flag sets, cf. /usr/include/asm/fcntl.h *) + rdonly* = {}; wronly* = {0}; rdwr* = {1}; creat* = {6}; excl* = {7}; trunc* = {9}; append* = {10}; ndelay = {11}; + +(* error numbers *) + + EPERM* = 1; (* Not owner *) + ENOENT* = 2; (* No such file or directory *) + ESRCH* = 3; (* No such process *) + EINTR* = 4; (* Interrupted system call *) + EIO* = 5; (* I/O error *) + ENXIO* = 6; (* No such device or address *) + E2BIG* = 7; (* Arg list too long *) + ENOEXEC* = 8; (* Exec format error *) + EBADF* = 9; (* Bad file number *) + ECHILD* = 10; (* No children *) + EAGAIN* = 11; (* No more processes *) + ENOMEM* = 12; (* Not enough core *) + EACCES* = 13; (* Permission denied *) + EFAULT* = 14; (* Bad address *) + ENOTBLK* = 15; (* Block device required *) + EBUSY* = 16; (* Mount device busy *) + EEXIST* = 17; (* File exists *) + EXDEV* = 18; (* Cross-device link *) + ENODEV* = 19; (* No such device *) + ENOTDIR* = 20; (* Not a directory*) + EISDIR* = 21; (* Is a directory *) + EINVAL* = 22; (* Invalid argument *) + ENFILE* = 23; (* File table overflow *) + EMFILE* = 24; (* Too many open files *) + ENOTTY* = 25; (* Not a typewriter *) + ETXTBSY* = 26; (* Text file busy *) + EFBIG* = 27; (* File too large *) + ENOSPC* = 28; (* No space left on device *) + ESPIPE* = 29; (* Illegal seek *) + EROFS* = 30; (* Read-only file system *) + EMLINK* = 31; (* Too many links *) + EPIPE* = 32; (* Broken pipe *) + EDOM* = 33; (* Argument too large *) + ERANGE* = 34; (* Result too large *) + EDEADLK* = 35; (* Resource deadlock would occur *) + ENAMETOOLONG* = 36; (* File name too long *) + ENOLCK* = 37; (* No record locks available *) + ENOSYS* = 38; (* Function not implemented *) + ENOTEMPTY* = 39; (* Directory not empty *) + ELOOP* = 40; (* Too many symbolic links encountered *) + EWOULDBLOCK* = EAGAIN; (* Operation would block *) + ENOMSG* = 42; (* No message of desired type *) + EIDRM* = 43; (* Identifier removed *) + ECHRNG* = 44; (* Channel number out of range *) + EL2NSYNC* = 45; (* Level 2 not synchronized *) + EL3HLT* = 46; (* Level 3 halted *) + EL3RST* = 47; (* Level 3 reset *) + ELNRNG* = 48; (* Link number out of range *) + EUNATCH* = 49; (* Protocol driver not attached *) + ENOCSI* = 50; (* No CSI structure available *) + EL2HLT* = 51; (* Level 2 halted *) + EBADE* = 52; (* Invalid exchange *) + EBADR* = 53; (* Invalid request descriptor *) + EXFULL* = 54; (* Exchange full *) + ENOANO* = 55; (* No anode *) + EBADRQC* = 56; (* Invalid request code *) + EBADSLT* = 57; (* Invalid slot *) + EDEADLOCK* = 58; (* File locking deadlock error *) + EBFONT* = 59; (* Bad font file format *) + ENOSTR* = 60; (* Device not a stream *) + ENODATA* = 61; (* No data available *) + ETIME* = 62; (* Timer expired *) + ENOSR* = 63; (* Out of streams resources *) + ENONET* = 64; (* Machine is not on the network *) + ENOPKG* = 65; (* Package not installed *) + EREMOTE* = 66; (* Object is remote *) + ENOLINK* = 67; (* Link has been severed *) + EADV* = 68; (* Advertise error *) + ESRMNT* = 69; (* Srmount error *) + ECOMM* = 70; (* Communication error on send *) + EPROTO* = 71; (* Protocol error *) + EMULTIHOP* = 72; (* Multihop attempted *) + EDOTDOT* = 73; (* RFS specific error *) + EBADMSG* = 74; (* Not a data message *) + EOVERFLOW* = 75; (* Value too large for defined data type *) + ENOTUNIQ* = 76; (* Name not unique on network *) + EBADFD* = 77; (* File descriptor in bad state *) + EREMCHG* = 78; (* Remote address changed *) + ELIBACC* = 79; (* Can not access a needed shared library *) + ELIBBAD* = 80; (* Accessing a corrupted shared library *) + ELIBSCN* = 81; (* .lib section in a.out corrupted *) + ELIBMAX* = 82; (* Attempting to link in too many shared libraries *) + ELIBEXEC* = 83; (* Cannot exec a shared library directly *) + EILSEQ* = 84; (* Illegal byte sequence *) + ERESTART* = 85; (* Interrupted system call should be restarted *) + ESTRPIPE* = 86; (* Streams pipe error *) + EUSERS* = 87; (* Too many users *) + ENOTSOCK* = 88; (* Socket operation on non-socket *) + EDESTADDRREQ* = 89; (* Destination address required *) + EMSGSIZE* = 90; (* Message too long *) + EPROTOTYPE* = 91; (* Protocol wrong type for socket *) + ENOPROTOOPT* = 92; (* Protocol not available *) + EPROTONOSUPPORT* = 93; (* Protocol not supported *) + ESOCKTNOSUPPORT* = 94; (* Socket type not supported *) + EOPNOTSUPP* = 95; (* Operation not supported on transport endpoint *) + EPFNOSUPPORT* = 96; (* Protocol family not supported *) + EAFNOSUPPORT* = 97; (* Address family not supported by protocol *) + EADDRINUSE* = 98; (* Address already in use *) + EADDRNOTAVAIL* = 99; (* Cannot assign requested address *) + ENETDOWN* = 100; (* Network is down *) + ENETUNREACH* = 101; (* Network is unreachable *) + ENETRESET* = 102; (* Network dropped connection because of reset *) + ECONNABORTED* = 103; (* Software caused connection abort *) + ECONNRESET* = 104; (* Connection reset by peer *) + ENOBUFS* = 105; (* No buffer space available *) + EISCONN* = 106; (* Transport endpoint is already connected *) + ENOTCONN* = 107; (* Transport endpoint is not connected *) + ESHUTDOWN* = 108; (* Cannot send after transport endpoint shutdown *) + ETOOMANYREFS* = 109; (* Too many references: cannot splice *) + ETIMEDOUT* = 110; (* Connection timed out *) + ECONNREFUSED* = 111; (* Connection refused *) + EHOSTDOWN* = 112; (* Host is down *) + EHOSTUNREACH* = 113; (* No route to host *) + EALREADY* = 114; (* Operation already in progress *) + EINPROGRESS* = 115; (* Operation now in progress *) + ESTALE* = 116; (* Stale NFS file handle *) + EUCLEAN* = 117; (* Structure needs cleaning *) + ENOTNAM* = 118; (* Not a XENIX named type file *) + ENAVAIL* = 119; (* No XENIX semaphores available *) + EISNAM* = 120; (* Is a named type file *) + EREMOTEIO* = 121; (* Remote I/O error *) + EDQUOT* = 122; (* Quota exceeded *) + + +TYPE + JmpBuf* = RECORD + bx*, si*, di*, bp*, sp*, pc*: LONGINT; + maskWasSaved*, savedMask*: LONGINT; + END ; + + Status* = RECORD (* struct stat *) + dev*, devX*: LONGINT; (* 64 bit in Linux 2.2 *) + pad1: INTEGER; + ino*, mode*, nlink*, uid*, gid*: LONGINT; + rdev*, rdevX*: LONGINT; (* 64 bit in Linux 2.2 *) + pad2: INTEGER; + size*, blksize*, blocks*, atime*, unused1*, mtime*, unused2*, ctime*, + unused3*, unused4*, unused5*: LONGINT; + END ; + + Timeval* = RECORD + sec*, usec*: LONGINT + END ; + + Timezone* = RECORD + minuteswest*, dsttime*: LONGINT + END ; + + Itimerval* = RECORD + interval*, value*: Timeval + END ; + + FdSet* = ARRAY 8 OF SET; + + SigCtxPtr* = POINTER TO SigContext; + SigContext* = RECORD + END ; + + SignalHandler* = PROCEDURE (sig, code: LONGINT; scp: SigCtxPtr); + + Dirent* = RECORD + ino, off: LONGINT; + reclen: INTEGER; + name: ARRAY 256 OF CHAR; + END ; + + Rusage* = RECORD + utime*, stime*: Timeval; + maxrss*, ixrss*, idrss*, isrss*, + minflt*, majflt*, nswap*, inblock*, + oublock*, msgsnd*, msgrcv*, nsignals*, + nvcsw*, nivcsw*: LONGINT + END ; + + Iovec* = RECORD + base*, len*: LONGINT + END ; + + SocketPair* = ARRAY 2 OF LONGINT; + + Pollfd* = RECORD + fd*: LONGINT; + events*, revents*: INTEGER + END ; + + Sockaddr* = RECORD + family*: INTEGER; + port*: INTEGER; + internetAddr*: LONGINT; + pad*: ARRAY 8 OF CHAR; + END ; + + HostEntry* = POINTER [1] TO Hostent; + Hostent* = RECORD + name*, aliases*: LONGINT; + addrtype*, length*: LONGINT; + addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*) + END; + + Name* = ARRAY OF CHAR; + + PROCEDURE -includeStat() + "#include "; + + PROCEDURE -includeErrno() + "#include "; + + PROCEDURE -err(): LONGINT + "errno"; + + PROCEDURE errno*(): LONGINT; + BEGIN + RETURN err() + END errno; + + PROCEDURE -Exit*(n: LONGINT) + "exit(n)"; + + PROCEDURE -Fork*(): LONGINT + "fork()"; + + PROCEDURE -Wait*(VAR status: LONGINT): LONGINT + "wait(status)"; + + PROCEDURE -Select*(width: LONGINT; VAR readfds, writefds, exceptfds: FdSet; VAR timeout: Timeval): LONGINT + "select(width, readfds, writefds, exceptfds, timeout)"; + + PROCEDURE -Gettimeofday* (VAR tv: Timeval; VAR tz: Timezone) : LONGINT + "gettimeofday(tv, tz)"; + + PROCEDURE -Read* (fd, buf, nbyte: LONGINT): LONGINT + "read(fd, buf, nbyte)"; + + PROCEDURE -ReadBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT + "read(fd, buf, buf__len)"; + + PROCEDURE -Write* (fd, buf, nbyte: LONGINT): LONGINT + "write(fd, buf, nbyte)"; + + PROCEDURE -WriteBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT + "write(fd, buf, buf__len)"; + + PROCEDURE -Dup*(fd: LONGINT): LONGINT + "dup(fd)"; + + PROCEDURE -Dup2*(fd1, fd2: LONGINT): LONGINT + "dup(fd1, fd2)"; + + PROCEDURE -Pipe*(fds : LONGINT): LONGINT + "pipe(fds)"; + + PROCEDURE -Getpid*(): LONGINT + "getpid()"; + + PROCEDURE -Getuid*(): LONGINT + "getuid()"; + + PROCEDURE -Geteuid*(): LONGINT + "geteuid()"; + + PROCEDURE -Getgid*(): LONGINT + "getgid()"; + + PROCEDURE -Getegid*(): LONGINT + "getegid()"; + + PROCEDURE -Unlink*(name: Name): LONGINT + "unlink(name)"; + + PROCEDURE -Open*(name: Name; flag, mode: SET): LONGINT + "open(name, flag, mode)"; + + PROCEDURE -Close*(fd: LONGINT): LONGINT + "close(fd)"; + + PROCEDURE -stat(name: Name; VAR statbuf: Status): LONGINT + "stat((const char*)name, (struct stat*)statbuf)"; + + PROCEDURE Stat*(name: Name; VAR statbuf: Status): LONGINT; + VAR res: LONGINT; + BEGIN + res := stat(name, statbuf); + (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) + INC(statbuf.dev, statbuf.devX); + INC(statbuf.rdev, statbuf.rdevX); + RETURN res; + END Stat; + + PROCEDURE -fstat(fd: LONGINT; VAR statbuf: Status): LONGINT + "fstat(fd, (struct stat*)statbuf)"; + + PROCEDURE Fstat*(fd: LONGINT; VAR statbuf: Status): LONGINT; + VAR res: LONGINT; + BEGIN + res := fstat(fd, statbuf); + (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) + INC(statbuf.dev, statbuf.devX); + INC(statbuf.rdev, statbuf.rdevX); + RETURN res; + END Fstat; + + PROCEDURE -Fchmod*(fd, mode: LONGINT): LONGINT + "fchmod(fd, mode)"; + + PROCEDURE -Chmod*(path: Name; mode: LONGINT): LONGINT + "chmod(path, mode)"; + + PROCEDURE -Lseek*(fd, offset, origin: LONGINT): LONGINT + "lseek(fd, offset, origin)"; + + PROCEDURE -Fsync*(fd: LONGINT): LONGINT + "fsync(fd)"; + + PROCEDURE -Fcntl*(fd, cmd, arg: LONGINT ): LONGINT + "fcntl(fd, cmd, arg)"; + + PROCEDURE -Flock*(fd, operation: LONGINT): LONGINT + "flock(fd, operation)"; + + PROCEDURE -Ftruncate*(fd, length: LONGINT): LONGINT + "ftruncate(fd, length)"; + + PROCEDURE -Readblk*(fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT + "read(fd, buf, len)"; + + PROCEDURE -Rename*(old, new: Name): LONGINT + "rename(old, new)"; + + PROCEDURE -Chdir*(path: Name): LONGINT + "chdir(path)"; + + PROCEDURE -Ioctl*(fd, request, arg: LONGINT): LONGINT + "ioctl(fd, request, arg)"; + + PROCEDURE -Kill*(pid, sig: LONGINT): LONGINT + "kill(pid, sig)"; + + PROCEDURE -Sigsetmask*(mask: LONGINT): LONGINT + "sigsetmask(mask)"; + + + (* TCP/IP networking *) + + PROCEDURE -Gethostbyname*(name: Name): HostEntry + "(Unix_HostEntry)gethostbyname(name)"; + + PROCEDURE -Gethostname*(VAR name: Name): LONGINT + "gethostname(name, name__len)"; + + PROCEDURE -Socket*(af, type, protocol: LONGINT): LONGINT + "socket(af, type, protocol)"; + + PROCEDURE -Connect*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT + "connect(socket, &(name), namelen)"; + + PROCEDURE -Getsockname*(socket: LONGINT; VAR name: Sockaddr; VAR namelen: LONGINT): LONGINT + "getsockname(socket, name, namelen)"; + + PROCEDURE -Bind*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT + "bind(socket, &(name), namelen)"; + + PROCEDURE -Listen*(socket, backlog: LONGINT): LONGINT + "listen(socket, backlog)"; + + PROCEDURE -Accept*(socket: LONGINT; VAR addr: Sockaddr; VAR addrlen: LONGINT): LONGINT + "accept(socket, addr, addrlen)"; + + PROCEDURE -Recv*(socket, bufadr, buflen, flags: LONGINT): LONGINT + "recv(socket, bufadr, buflen, flags)"; + + PROCEDURE -Send*(socket, bufadr, buflen, flags: LONGINT): LONGINT + "send(socket, bufadr, buflen, flags)"; + + PROCEDURE -sys(str: ARRAY OF CHAR): INTEGER (* need this to call external tools like gcc or gas; noch *) + "system(str)"; + + PROCEDURE system*(cmd : ARRAY OF CHAR); + VAR r : INTEGER; + BEGIN + r := sys(cmd); + END system; + + PROCEDURE System*(cmd : ARRAY OF CHAR): INTEGER; + VAR r : INTEGER; + BEGIN + r := sys(cmd); + RETURN r + END System; + +END Unix. diff --git a/src/lib/ulm/powerpc/ulmSysConversions.Mod b/src/lib/ulm/powerpc/ulmSysConversions.Mod new file mode 100644 index 00000000..f8ea3fbb --- /dev/null +++ b/src/lib/ulm/powerpc/ulmSysConversions.Mod @@ -0,0 +1,574 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: SysConversi.om,v 1.2 1997/07/30 09:38:16 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: SysConversi.om,v $ + Revision 1.2 1997/07/30 09:38:16 borchert + bug in ReadConv fixed: cv.flags was used but not set for + counts > 1 + + Revision 1.1 1994/02/23 07:58:28 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 8/90 + adapted to linux cae 02/01 + ---------------------------------------------------------------------------- +*) + +MODULE ulmSysConversions; + + (* convert Oberon records to/from C structures *) + + IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Streams := ulmStreams, Strings := ulmStrings, + SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts; + + TYPE + Address* = SysTypes.Address; + Size* = Address; + + (* format: + + Format = Conversion { "/" Conversion } . + Conversion = [ Factors ] ConvChars [ Comment ] . + Factors = Array | Factor | Array Factor | Factor Array . + Array = Integer ":" . + Factor = Integer "*" . + ConvChars = OberonType CType | Skip CType | OberonType Skip . + OberonType = "a" | "b" | "c" | "s" | "i" | "l" | "S" . + CType = "a" | "c" | "s" | "i" | "l" . + Integer = Digit { Digit } . + Digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" . + Skip = "-" . + Comment = "=" { AnyChar } . + AnyChar = (* all characters except "/" *) . + + Oberon data types: + + a: Address + b: SYS.BYTE + B: BOOLEAN + c: CHAR + s: SHORTINT + i: INTEGER + l: LONGINT + S: SET + + C data types: + + a: char * + c: /* signed */ char + C: unsigned char + s: short int + S: unsigned short int + i: int + I: unsigned int + u: unsigned int + l: long int + L: unsigned long int + + example: + + conversion from + + Rec = + RECORD + a, b: INTEGER; + c: CHAR; + s: SET; + f: ARRAY 3 OF INTEGER; + END; + + to + + struct rec { + short a, b; + char c; + int xx; /* to be skipped on conversion */ + int s; + int f[3]; + }; + + or vice versa: + + "2*is=a,b/cc=c/-i=xx/Si=s/3:ii=f" + + The comments allow to give the field names. + *) + + CONST + (* conversion flags *) + unsigned = 0; (* suppress sign extension *) + boolean = 1; (* convert anything # 0 to 1 *) + TYPE + Flags = SET; + Event* = POINTER TO EventRec; + EventRec* = + RECORD + (Events.EventRec) + format*: Events.Message; + END; + ConvStream = POINTER TO ConvStreamRec; + ConvStreamRec = + RECORD + fmt: Texts.Text; + char: CHAR; + eof: BOOLEAN; + (* 1: Oberon type + 2: C type + *) + type1, type2: CHAR; length: INTEGER; left: INTEGER; + offset1, offset2: Address; + size1, size2: Address; elementsleft: INTEGER; flags: Flags; + END; + + Format* = POINTER TO FormatRec; + FormatRec* = + RECORD + (Objects.ObjectRec) + offset1, offset2: Address; + size1, size2: Address; + flags: Flags; + next: Format; + END; + VAR + badformat*: Events.EventType; + + PROCEDURE Error(cv: ConvStream; msg: ARRAY OF CHAR); + VAR + event: Event; + BEGIN + NEW(event); + event.type := badformat; + event.message := "SysConversions: "; + Strings.Concatenate(event.message, msg); + Strings.Read(event.format, cv.fmt); + Events.Raise(event); + cv.eof := TRUE; + cv.char := 0X; + cv.left := 0; + cv.elementsleft := 0; + END Error; + + PROCEDURE SizeError(msg, format: ARRAY OF CHAR); + VAR + event: Event; + BEGIN + NEW(event); + event.type := badformat; + event.message := "SysConversions: "; + Strings.Concatenate(event.message, msg); + COPY(format, event.format); + Events.Raise(event); + END SizeError; + + PROCEDURE NextCh(cv: ConvStream); + BEGIN + cv.eof := cv.eof OR ~Streams.ReadByte(cv.fmt, cv.char) OR (cv.char = 0X); + IF cv.eof THEN + cv.char := 0X; + END; + END NextCh; + + PROCEDURE IsDigit(ch: CHAR) : BOOLEAN; + BEGIN + RETURN (ch >= "0") & (ch <= "9") + END IsDigit; + + PROCEDURE ReadInt(cv: ConvStream; VAR i: INTEGER); + BEGIN + i := 0; + REPEAT + i := 10 * i + ORD(cv.char) - ORD("0"); + NextCh(cv); + UNTIL ~IsDigit(cv.char); + END ReadInt; + + PROCEDURE Open(VAR cv: ConvStream; format: ARRAY OF CHAR); + BEGIN + NEW(cv); + Texts.Open(SYS.VAL(Streams.Stream, cv.fmt)); + Strings.Write(cv.fmt, format); + cv.left := 0; cv.elementsleft := 0; + cv.offset1 := 0; cv.offset2 := 0; + cv.eof := FALSE; + NextCh(cv); + END Open; + + PROCEDURE Close(VAR cv: ConvStream); + BEGIN + IF ~Streams.Close(cv.fmt) THEN END; + END Close; + + PROCEDURE ScanConv(cv: ConvStream; + VAR type1, type2: CHAR; + VAR length: INTEGER) : BOOLEAN; + VAR + i: INTEGER; + factor: INTEGER; + BEGIN + IF cv.left > 0 THEN + type1 := cv.type1; + type2 := cv.type2; + length := cv.length; + DEC(cv.left); + RETURN TRUE + END; + IF cv.char = "/" THEN + NextCh(cv); + END; + IF cv.eof THEN + RETURN FALSE + END; + factor := 0; length := 0; + WHILE IsDigit(cv.char) DO + ReadInt(cv, i); + IF i <= 0 THEN + Error(cv, "integer must be positive"); RETURN FALSE + END; + IF cv.char = ":" THEN + IF length # 0 THEN + Error(cv, "multiple length specification"); RETURN FALSE + END; + length := i; + NextCh(cv); + ELSIF cv.char = "*" THEN + IF factor # 0 THEN + Error(cv, "multiple factor specification"); RETURN FALSE + END; + factor := i; cv.left := factor - 1; + NextCh(cv); + ELSE + Error(cv, "factor or length expected"); RETURN FALSE + END; + END; + type1 := cv.char; NextCh(cv); + type2 := cv.char; NextCh(cv); + IF cv.left > 0 THEN + cv.type1 := type1; cv.type2 := type2; cv.length := length; + END; + IF cv.char = "=" THEN (* comment *) + REPEAT + NextCh(cv); + UNTIL cv.eof OR (cv.char = "/"); + END; + RETURN TRUE + END ScanConv; + + PROCEDURE Align(VAR offset: Address; boundary: Address); + BEGIN + IF SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary) # 0 THEN + offset := SYS.VAL (INTEGER, offset) + (SYS.VAL (INTEGER, boundary) - SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary)); + END; + END Align; + + PROCEDURE ReadConv(cv: ConvStream; + VAR offset1, offset2: Address; + VAR size1, size2: Address; + VAR flags: Flags) : BOOLEAN; + VAR + type1, type2: CHAR; + length: INTEGER; + align: BOOLEAN; + boundary: INTEGER; + BEGIN + IF cv.elementsleft > 0 THEN + DEC(cv.elementsleft); + + (* Oberon type *) + IF size1 > SIZE(SYS.BYTE) THEN + Align(cv.offset1, SIZE(INTEGER)); + END; + offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; + size1 := cv.size1; size2 := cv.size2; flags := cv.flags; + IF (size1 > 0) & (cv.elementsleft = 0) THEN + Align(cv.offset1, SIZE(INTEGER)); + END; + + (* C type *) + IF size2 > 1 THEN + Align(cv.offset2, 2); + END; + offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); + + RETURN TRUE + END; + IF ScanConv(cv, type1, type2, length) THEN + flags := {}; + (* Oberon type *) + CASE type1 OF + | "a": size1 := SIZE(Address); INCL(flags, unsigned); + | "b": size1 := SIZE(SYS.BYTE); INCL(flags, unsigned); + | "B": size1 := SIZE(BOOLEAN); INCL(flags, boolean); + | "c": size1 := SIZE(CHAR); INCL(flags, unsigned); + | "s": size1 := SIZE(SHORTINT); + | "i": size1 := SIZE(INTEGER); + | "l": size1 := SIZE(LONGINT); + | "S": size1 := SIZE(SET); INCL(flags, unsigned); + | "-": size1 := 0; + ELSE Error(cv, "bad Oberon type specifier"); RETURN FALSE + END; + IF size1 > 0 THEN + IF length > 0 THEN + Align(cv.offset1, SIZE(INTEGER)); + ELSIF size1 > SIZE(SYS.BYTE) THEN + Align(cv.offset1, SIZE(INTEGER)); + END; + END; + offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; + + (* C type *) + CASE type2 OF + | "a": size2 := 4; INCL(flags, unsigned); (* char* *) + | "c": size2 := 1; (* /* signed */ char *) + | "C": size2 := 1; INCL(flags, unsigned); (* unsigned char *) + | "s": size2 := 2; (* short int *) + | "S": size2 := 2; INCL(flags, unsigned); (* unsigned short int *) + | "i": size2 := 4; (* int *) + | "I": size2 := 4; INCL(flags, unsigned); (* unsigned int *) + | "u": size2 := 4; INCL(flags, unsigned); (* unsigned int *) + | "l": size2 := 4; (* long int *) + | "L": size2 := 4; INCL(flags, unsigned); (* long int *) + | "-": size2 := 0; + ELSE Error(cv, "bad C type specifier"); RETURN FALSE + END; + IF size2 > 1 THEN + Align(cv.offset2, size2); + END; + offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); + + cv.size1 := size1; cv.size2 := size2; + IF length > 0 THEN + cv.elementsleft := length - 1; + cv.flags := flags; + END; + RETURN TRUE + ELSE + RETURN FALSE + END; + END ReadConv; + + PROCEDURE Convert(from, to: Address; ssize, dsize: Address; flags: Flags); + TYPE + Bytes = ARRAY 8 OF CHAR; + Pointer = POINTER TO Bytes; + VAR + dest, source: Pointer; + dindex, sindex: INTEGER; + nonzero: BOOLEAN; + fill : CHAR; + BEGIN + IF ssize > 0 THEN + dest := SYS.VAL(Pointer, to); + source := SYS.VAL(Pointer, from); + dindex := 0; sindex := 0; + IF boolean IN flags THEN + nonzero := FALSE; + WHILE ssize > 0 DO + nonzero := nonzero OR (source[sindex] # 0X); + INC(sindex); ssize := SYS.VAL (INTEGER, ssize) - 1; + END; + IF dsize > 0 THEN + IF nonzero THEN + dest[dindex] := 1X; + ELSE + dest[dindex] := 0X; + END; + dsize := dsize - 1; INC (dindex); + END; + WHILE dsize > 0 DO + dest[dindex] := 0X; + dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); + END; + ELSE + WHILE (dsize > 0) & (ssize > 0) DO + dest[dindex] := source[sindex]; + ssize := SYS.VAL (INTEGER, ssize) - 1; + dsize := dsize - 1; + INC(dindex); INC(sindex); + END; + IF dsize > 0 THEN + (* sindex has been incremented at least once because + * ssize and dsize were greater than 0, i.e. sindex-1 + * is a valid inex. *) + fill := 0X; + IF ~(unsigned IN flags) & (source[sindex-1] >= 080X) THEN + fill := 0FFX; + END; + END; + WHILE dsize > 0 DO + dest[dindex] := fill; + dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); + END; + END; + END; + END Convert; + + PROCEDURE ByAddrToC*(from, to: Address; format: ARRAY OF CHAR); + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO + Convert(from + offset1, to + offset2, size1, size2, flags); + END; + Close(cv); + END ByAddrToC; + + PROCEDURE ByAddrFromC*(from, to: Address; format: ARRAY OF CHAR); + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO + Convert(from + offset2, to + offset1, size2, size1, flags); + END; + Close(cv); + END ByAddrFromC; + + PROCEDURE CSize*(format: ARRAY OF CHAR) : Size; + (* returns the size of the C-structure described by `format' *) + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + size: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END; + Close(cv); + size := offset2 + size2; + Align(size, 2); + RETURN size + END CSize; + + PROCEDURE OberonSize*(format: ARRAY OF CHAR) : Size; + (* returns the size of the Oberon-structure described by `format' *) + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + size: Address; + flags: Flags; + BEGIN + Open(cv, format); + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END; + Close(cv); + size := offset1 + size1; + Align(size, SIZE(INTEGER)); + RETURN size + END OberonSize; + + PROCEDURE ToC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR); + BEGIN + IF OberonSize(format) > LEN(from) THEN + SizeError("Oberon record is too small", format); RETURN + END; + IF CSize(format) > LEN(to) THEN + SizeError("C structure is too small", format); RETURN + END; + ByAddrToC(SYS.ADR(from), SYS.ADR(to), format); + END ToC; + + PROCEDURE FromC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR); + BEGIN + IF OberonSize(format) > LEN(to) THEN + SizeError("Oberon record is too small", format); RETURN + END; + IF CSize(format) > LEN(from) THEN + SizeError("C structure is too small", format); RETURN + END; + ByAddrFromC(SYS.ADR(from), SYS.ADR(to), format); + END FromC; + + PROCEDURE Compile*(VAR fmt: Format; format: ARRAY OF CHAR); + (* translate format into an internal representation + which is later referenced by fmt; + ByFmtToC and ByFmtFromC are faster than ToC and FromC + *) + VAR + cv: ConvStream; + offset1, offset2, size1, size2: Address; + flags: Flags; + element: Format; + head, tail: Format; + BEGIN + Open(cv, format); + head := NIL; tail := NIL; + WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO + NEW(element); + element.offset1 := offset1; + element.offset2 := offset2; + element.size1 := size1; + element.size2 := size2; + element.flags := flags; + element.next := NIL; + IF tail # NIL THEN + tail.next := element; + ELSE + head := element; + END; + tail := element; + END; + fmt := head; + Close(cv); + END Compile; + + PROCEDURE ByFmtAndAddrToC*(from, to: Address; format: Format); + VAR + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + WHILE format # NIL DO + Convert(from + format.offset1, to + format.offset2, + format.size1, format.size2, format.flags); + format := format.next; + END; + END ByFmtAndAddrToC; + + PROCEDURE ByFmtAndAddrFromC*(from, to: Address; format: Format); + VAR + offset1, offset2, size1, size2: Address; + flags: Flags; + BEGIN + WHILE format # NIL DO + Convert(from + format.offset2, to + format.offset1, + format.size2, format.size1, format.flags); + format := format.next; + END; + END ByFmtAndAddrFromC; + + PROCEDURE ByFmtToC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format); + BEGIN + ByFmtAndAddrToC(SYS.ADR(from), SYS.ADR(to), format); + END ByFmtToC; + + PROCEDURE ByFmtFromC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format); + BEGIN + ByFmtAndAddrFromC(SYS.ADR(from), SYS.ADR(to), format); + END ByFmtFromC; + +BEGIN + Events.Define(badformat); + Events.SetPriority(badformat, Priorities.liberrors); +END ulmSysConversions. diff --git a/src/lib/ulm/powerpc/ulmSysStat.Mod b/src/lib/ulm/powerpc/ulmSysStat.Mod new file mode 100644 index 00000000..c7f00f04 --- /dev/null +++ b/src/lib/ulm/powerpc/ulmSysStat.Mod @@ -0,0 +1,201 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: SysStat.om,v 1.3 2000/11/12 13:02:09 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: SysStat.om,v $ + Revision 1.3 2000/11/12 13:02:09 borchert + door file type added + + Revision 1.2 2000/11/12 12:48:07 borchert + - conversion adapted to Solaris 2.x + - Lstat added + + Revision 1.1 1994/02/23 08:00:48 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 9/89 + ---------------------------------------------------------------------------- +*) + +MODULE ulmSysStat; + + (* examine inode: stat(2) and fstat(2) *) + + IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, uSYS := ulmSYSTEM, SysConversions := ulmSysConversions, SysErrors := ulmSysErrors, + SysTypes := ulmSysTypes; + + CONST + (* file mode: + bit 0 = 1<<0 bit 31 = 1<<31 + + user group other + 3 1 1111 11 + 1 ... 6 5432 109 876 543 210 + +--------+------+-----+-----+-----+-----+ + | unused | type | sst | rwx | rwx | rwx | + +--------+------+-----+-----+-----+-----+ + *) + + type* = {12..15}; + prot* = {0..8}; + + (* file types; example: (stat.mode * type = dir) *) + reg* = {15}; (* regular *) + dir* = {14}; (* directory *) + chr* = {13}; (* character special *) + fifo* = {12}; (* fifo *) + blk* = {13..14}; (* block special *) + symlink* = {13, 15}; (* symbolic link *) + socket* = {14, 15}; (* socket *) + + (* special *) + setuid* = 11; (* set user id on execution *) + setgid* = 10; (* set group id on execution *) + savetext* = 9; (* save swapped text even after use *) + + (* protection *) + uread* = 8; (* read permission owner *) + uwrite* = 7; (* write permission owner *) + uexec* = 6; (* execute/search permission owner *) + gread* = 5; (* read permission group *) + gwrite* = 4; (* write permission group *) + gexec* = 3; (* execute/search permission group *) + oread* = 2; (* read permission other *) + owrite* = 1; (* write permission other *) + oexec* = 0; (* execute/search permission other *) + + (* example for "r-xr-x---": (read + exec) * (owner + group) *) + owner* = {uread, uwrite, uexec}; + group* = {gread, gwrite, gexec}; + other* = {oread, owrite, oexec}; + read* = {uread, gread, oread}; + write* = {uwrite, gwrite, owrite}; + exec* = {uexec, gexec, oexec}; + rwx* = prot; + + TYPE + StatRec* = (* result of stat(2) and fstat(2) *) + RECORD + device*: SysTypes.Device; (* ID of device containing + a directory entry for this file *) + inode*: SysTypes.Inode; (* inode number *) + mode*: SET; (* file mode; see mknod(2) *) + nlinks*: LONGINT; (* number of links *) + uid*: LONGINT; (* user id of the file's owner *) + gid*: LONGINT; (* group id of the file's group *) + rdev*: SysTypes.Device; (* ID of device + this entry is defined only for + character special or block + special files + *) + size*: SysTypes.Offset; (* file size in bytes *) + blksize*: LONGINT; (* preferred blocksize *) + blocks*: LONGINT; (* # of blocks allocated *) + atime*: SysTypes.Time; (* time of last access *) + mtime*: SysTypes.Time; (* time of last data modification *) + ctime*: SysTypes.Time; (* time of last file status change *) + END; + +(* Linux kernel struct stat (2.2.17) + struct stat { + unsigned short st_dev; + unsigned short __pad1; + unsigned long st_ino; + unsigned short st_mode; + unsigned short st_nlink; + unsigned short st_uid; + unsigned short st_gid; + unsigned short st_rdev; + unsigned short __pad2; + unsigned long st_size; + unsigned long st_blksize; + unsigned long st_blocks; + unsigned long st_atime; + unsigned long __unused1; + unsigned long st_mtime; + unsigned long __unused2; + unsigned long st_ctime; + unsigned long __unused3; + unsigned long __unused4; + unsigned long __unused5; + }; +*) + + CONST + statbufsize = 88(*64*); (* see *) (* sizeof struct stat gives us 144 on x86_64 and 88 on x86 *) + TYPE + UnixStatRec = ARRAY statbufsize OF SYS.BYTE; + CONST + statbufconv = + (*"is=dev/-s=pad1/ll=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/ll=size/2*ll=blksize,blocks/il=atime/-l/il=mtime/-l/il=ctime/3*-l";*) + (*"ls=dev/-s=pad1/lL=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/lL=size/2*lL=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l";*) + "ll=dev/-l=devx/-s=pad1/ll=ino/Sl=mode/ll=nlink/ll=uid/ll=gid/ll=rdev/-l=rdevx/-s=pad2/ll=size/2*ll=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l"; + VAR + statbuffmt: SysConversions.Format; + + PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1, d2: LONGINT; + origbuf: UnixStatRec; + BEGIN + IF uSYS.UNIXCALL(Sys.newstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf), d2) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newstat, path); + RETURN FALSE + END; + END Stat; +(* + PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1: INTEGER; + origbuf: UnixStatRec; + BEGIN + IF SYS.UNIXCALL(Sys.newlstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf)) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newlstat, path); + RETURN FALSE + END; + END Lstat; +*) + PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + d0, d1, d2: LONGINT; + origbuf: UnixStatRec; + BEGIN + IF uSYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf), d2) THEN + SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); + RETURN TRUE + ELSE + SysErrors.Raise(errors, d0, Sys.newfstat, ""); + RETURN FALSE + END; + END Fstat; + +BEGIN + SysConversions.Compile(statbuffmt, statbufconv); +END ulmSysStat. diff --git a/src/lib/ulm/powerpc/ulmSysTypes.Mod b/src/lib/ulm/powerpc/ulmSysTypes.Mod new file mode 100644 index 00000000..174140e7 --- /dev/null +++ b/src/lib/ulm/powerpc/ulmSysTypes.Mod @@ -0,0 +1,70 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: SysTypes.om,v 1.1 1994/02/23 08:01:38 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: SysTypes.om,v $ + Revision 1.1 1994/02/23 08:01:38 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 9/89 + ---------------------------------------------------------------------------- +*) + +MODULE ulmSysTypes; + + IMPORT Types := ulmTypes; + + TYPE + Address* = Types.Address; + UntracedAddress* = Types.UntracedAddress; + Count* = Types.Count; + Size* = Types.Size; + Byte* = Types.Byte; + + File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *) + Offset* = LONGINT; + Device* = LONGINT; + Inode* = LONGINT; + Time* = LONGINT; + + Word* = INTEGER; (* must have the size of C's int-type *) + + (* Note: linux supports wait4 but not waitid, i.e. these + * constants aren't needed. *) + (* + CONST + (* possible values of the idtype parameter (4 bytes), + see + *) + idPid = 0; (* a process identifier *) + idPpid = 1; (* a parent process identifier *) + idPgid = 2; (* a process group (job control group) identifier *) + idSid = 3; (* a session identifier *) + idCid = 4; (* a scheduling class identifier *) + idUid = 5; (* a user identifier *) + idGid = 6; (* a group identifier *) + idAll = 7; (* all processes *) + idLwpid = 8; (* an LWP identifier *) + TYPE + IdType = INTEGER; (* idPid .. idLwpid *) + *) + +END ulmSysTypes. diff --git a/src/lib/ulm/powerpc/ulmTypes.Mod b/src/lib/ulm/powerpc/ulmTypes.Mod new file mode 100644 index 00000000..3b4a8e19 --- /dev/null +++ b/src/lib/ulm/powerpc/ulmTypes.Mod @@ -0,0 +1,125 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-2000 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: Types.om,v 1.5 2000/12/13 10:03:00 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: Types.om,v $ + Revision 1.5 2000/12/13 10:03:00 borchert + SetInt type used in msb constant + + Revision 1.4 2000/12/13 09:51:57 borchert + constants and types for the relationship of INTEGER and SET added + + Revision 1.3 1998/09/25 15:23:09 borchert + Real32..Real128 added + + Revision 1.2 1994/07/01 11:08:04 borchert + IntAddress, Int8/16/32, ToInt8/16/32 and bit/little endian stuff added + + Revision 1.1 1994/02/22 20:12:14 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 9/93 + ---------------------------------------------------------------------------- +*) + +MODULE ulmTypes; + + (* compiler-dependent type definitions; + this version works for Ulm's Oberon Compilers on + following architectures: m68k and sparc + *) + + IMPORT SYS := SYSTEM; + + TYPE + Address* = LONGINT (*SYS.ADDRESS*); + UntracedAddress* = LONGINT; (*SYS.UNTRACEDADDRESS;*) + Count* = LONGINT; + Size* = Count; + Byte* = SYS.BYTE; + IntAddress* = LONGINT; + Int8* = SHORTINT; + Int16* = INTEGER; + Int32* = LONGINT; + Real32* = REAL; + Real64* = LONGREAL; + + CONST + bigEndian* = 0; (* SPARC, M68K etc *) + littleEndian* = 1; (* Intel 80x86, VAX etc *) + byteorder* = littleEndian; (* machine-dependent constant *) + TYPE + ByteOrder* = SHORTINT; (* bigEndian or littleEndian *) + + (* following constants and type definitions try to make + conversions from INTEGER to SET and vice versa more portable + to allow for bit operations on INTEGER values + *) + TYPE + SetInt* = LONGINT; (* INTEGER type that corresponds to SET *) + VAR msb* : SET; + msbIsMax*, msbIs0*: SHORTINT; + msbindex*, lsbindex*, nofbits*: LONGINT; + + PROCEDURE ToInt8*(int: LONGINT) : Int8; + BEGIN + RETURN SHORT(SHORT(int)) + END ToInt8; + + PROCEDURE ToInt16*(int: LONGINT) : Int16; + BEGIN + RETURN SYS.VAL(Int16, int) + END ToInt16; + + PROCEDURE ToInt32*(int: LONGINT) : Int32; + BEGIN + RETURN int + END ToInt32; + + PROCEDURE ToReal32*(real: LONGREAL) : Real32; + BEGIN + RETURN SHORT(real) + END ToReal32; + + PROCEDURE ToReal64*(real: LONGREAL) : Real64; + BEGIN + RETURN real + END ToReal64; + +BEGIN + msb := SYS.VAL(SET, MIN(SetInt)); + (* most significant bit, converted to a SET *) + (* we expect msbIsMax XOR msbIs0 to be 1; + this is checked for by an assertion + *) + msbIsMax := SYS.VAL(SHORTINT, (msb = {MAX(SET)})); + (* is 1, if msb equals {MAX(SET)} *) + msbIs0 := SYS.VAL(SHORTINT, (msb = {0})); + (* is 0, if msb equals {0} *) + msbindex := msbIsMax * MAX(SET); + (* set element that corresponds to the most-significant-bit *) + lsbindex := MAX(SET) - msbindex; + (* set element that corresponds to the lowest-significant-bit *) + nofbits := MAX(SET) + 1; + (* number of elements in SETs *) + + ASSERT((msbIs0 = 1) & (msbIsMax = 0) OR (msbIs0 = 0) & (msbIsMax = 1)); +END ulmTypes. diff --git a/src/lib/v4/powerpc/Reals.Mod b/src/lib/v4/powerpc/Reals.Mod new file mode 100644 index 00000000..e752c0c9 --- /dev/null +++ b/src/lib/v4/powerpc/Reals.Mod @@ -0,0 +1,109 @@ +MODULE Reals; + (* JT, 5.2.90 / RC 9.12.91 conversion between reals and strings for HP-700, MB 9.12.91, JT for Ofront, 16.3. 95*) + + IMPORT S := SYSTEM; + + + PROCEDURE -ecvt (x: LONGREAL; ndigit, decpt, sign: LONGINT): LONGINT + "ecvt (x, ndigit, decpt, sign)"; + + PROCEDURE Ten*(e: INTEGER): REAL; + VAR r, power: LONGREAL; + BEGIN r := 1.0; + power := 10.0; + WHILE e > 0 DO + IF ODD(e) THEN r := r * power END ; + power := power * power; e := e DIV 2 + END ; + RETURN SHORT(r) + END Ten; + + PROCEDURE TenL*(e: INTEGER): LONGREAL; + VAR r, power: LONGREAL; + BEGIN r := 1.0; + power := 10.0; + LOOP + IF ODD(e) THEN r := r * power END ; + e := e DIV 2; + IF e <= 0 THEN RETURN r END ; + power := power * power + END + END TenL; + + PROCEDURE Expo*(x: REAL): INTEGER; + BEGIN + RETURN SHORT(ASH(S.VAL(LONGINT, x), -23) MOD 256) + END Expo; + + PROCEDURE ExpoL*(x: LONGREAL): INTEGER; + VAR h: LONGINT; + BEGIN + S.GET(S.ADR(x)+4, h); + RETURN SHORT(ASH(h, -20) MOD 2048) + END ExpoL; + + PROCEDURE SetExpo*(e: INTEGER; VAR x: REAL); + CONST expo = {1..8}; + BEGIN + x := S.VAL(REAL, S.VAL(SET, x) - expo + S.VAL(SET, ASH(LONG(e), 23))) + END SetExpo; + + PROCEDURE SetExpoL*(e: INTEGER; VAR x: LONGREAL); + CONST expo = {1..11}; + VAR h: SET; + BEGIN + S.GET(S.ADR(x)+4, h); + h := h - expo + S.VAL(SET, ASH(LONG(e), 20)); + S.PUT(S.ADR(x)+4, h) + END SetExpoL; + + PROCEDURE Convert*(x: REAL; n: INTEGER; VAR d: ARRAY OF CHAR); + VAR i, k: LONGINT; + BEGIN + i := ENTIER(x); k := 0; + WHILE k < n DO + d[k] := CHR(i MOD 10 + 48); i := i DIV 10; INC(k) + END + END Convert; +(* + PROCEDURE ConvertL*(x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR); + VAR i, k: LONGINT; + BEGIN + i := ENTIER(x); k := 0; + WHILE k < n DO + d[k] := CHR(i MOD 10 + 48); i := i DIV 10; INC(k) + END + END ConvertL; + *) + PROCEDURE ConvertL*(x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR); + VAR decpt, sign, i: LONGINT; buf: LONGINT; + BEGIN + (*x := x - 0.5; already rounded in ecvt*) + buf := ecvt(x, n+2, S.ADR(decpt), S.ADR(sign)); + i := 0; + WHILE i < decpt DO S.GET(buf + i, d[n - i -1]); INC(i) END ; (* showdef was crashing here on oocLowLReal.sym because of ecvt *) + i := n - i - 1; + WHILE i >= 0 DO d[i] := "0"; DEC(i) END ; + END ConvertL; + + PROCEDURE Unpack(VAR b, d: ARRAY OF S.BYTE); + VAR i, k: SHORTINT; len: LONGINT; + BEGIN i := 0; len := LEN(b); + WHILE i < len DO + k := SHORT(ORD(S.VAL(CHAR, b[i])) DIV 16); + IF k > 9 THEN d[i*2] := k + 55 ELSE d[i*2] := k + 48 END ; + k := SHORT(ORD(S.VAL(CHAR, b[i])) MOD 16); + IF k > 9 THEN d[i*2+1] := k + 55 ELSE d[i*2+1] := k + 48 END ; + INC(i) + END + END Unpack; + + PROCEDURE ConvertH* (y: REAL; VAR d: ARRAY OF CHAR); + BEGIN Unpack(y, d) + END ConvertH; + + PROCEDURE ConvertHL* (x: LONGREAL; VAR d: ARRAY OF CHAR); + BEGIN Unpack(x, d) + END ConvertHL; + +END Reals. diff --git a/src/par/voc.par.gnuc.powerpc b/src/par/voc.par.gnuc.powerpc new file mode 100644 index 00000000..df29c90d --- /dev/null +++ b/src/par/voc.par.gnuc.powerpc @@ -0,0 +1,12 @@ +CHAR 1 1 +BOOLEAN 1 1 +SHORTINT 1 1 +INTEGER 2 2 +LONGINT 4 4 +SET 4 4 +REAL 4 4 +LONGREAL 8 8 +PTR 4 4 +PROC 4 4 +RECORD 1 1 +ENDIAN 0 0 diff --git a/src/tools/coco/CR.ATG b/src/tools/coco/CR.ATG deleted file mode 100644 index aa68c1ed..00000000 --- a/src/tools/coco/CR.ATG +++ /dev/null @@ -1,376 +0,0 @@ -COMPILER CR (*H.Moessenboeck 17.11.93, Coco/R*) - -(*---------------------- semantic declarations ----------------------------*) - -IMPORT CRT, CRA, CRX, Sets, Texts := CmdlnTexts, Oberon; - -CONST - ident = 0; string = 1; (*symbol kind*) - -VAR - str: ARRAY 32 OF CHAR; - w: Texts.Writer; - genScanner: BOOLEAN; - - -PROCEDURE SemErr(nr: INTEGER); -BEGIN - CRS.Error(200+nr, CRS.pos); -END SemErr; - -PROCEDURE MatchLiteral(sp: INTEGER); (*store string either as token or as literal*) - VAR sn, sn1: CRT.SymbolNode; matchedSp: INTEGER; -BEGIN - CRT.GetSym(sp, sn); - CRA.MatchDFA(sn.name, sp, matchedSp); - IF matchedSp # CRT.noSym THEN - CRT.GetSym(matchedSp, sn1); sn1.struct := CRT.classLitToken; CRT.PutSym(matchedSp, sn1); - sn.struct := CRT.litToken - ELSE sn.struct := CRT.classToken; - END; - CRT.PutSym(sp, sn) -END MatchLiteral; - -PROCEDURE SetCtx(gp: INTEGER); (*set transition code to CRT.contextTrans*) - VAR gn: CRT.GraphNode; -BEGIN - WHILE gp > 0 DO - CRT.GetNode(gp, gn); - IF gn.typ IN {CRT.char, CRT.class} THEN - gn.p2 := CRT.contextTrans; CRT.PutNode(gp, gn) - ELSIF gn.typ IN {CRT.opt, CRT.iter} THEN SetCtx(gn.p1) - ELSIF gn.typ = CRT.alt THEN SetCtx(gn.p1); SetCtx(gn.p2) - END; - gp := gn.next - END -END SetCtx; - -PROCEDURE SetDDT(s: ARRAY OF CHAR); - VAR name: ARRAY 64 OF CHAR; i: INTEGER; ch: CHAR; -BEGIN - i := 1; - WHILE s[i] # 0X DO - ch := s[i]; INC(i); - IF (ch >= "0") & (ch <= "9") THEN CRT.ddt[ORD(ch)-ORD("0")] := TRUE END - END -END SetDDT; - -PROCEDURE FixString (VAR s: ARRAY OF CHAR; len: INTEGER); - VAR double: BOOLEAN; i: INTEGER; -BEGIN - double := FALSE; - FOR i := 0 TO len-2 DO - IF s[i] = '"' THEN double := TRUE END - END; - IF ~ double THEN s[0] := '"'; s[len-1] := '"' END -END FixString; - -(*-------------------------------------------------------------------------*) -CHARACTERS - letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz". - digit = "0123456789". - eol = CHR(13). - tab = CHR(9). - noQuote1 = ANY - '"' - eol. - noQuote2 = ANY - "'" - eol. - -IGNORE eol + tab + CHR(28) - - -TOKENS - ident = letter {letter | digit}. - string = '"' {noQuote1} '"' | "'" {noQuote2} "'". - number = digit {digit}. - - -PRAGMAS - ddtSym = "$" {digit}. (. CRS.GetName(CRS.nextPos, CRS.nextLen, str); SetDDT(str) .) - - -COMMENTS FROM "(*" TO "*)" NESTED - -(*-------------------------------------------------------------------------*) -PRODUCTIONS - -CR (. VAR undef, hasAttrs, ok, ok1: BOOLEAN; eofSy, gR: INTEGER; - gramLine, sp: INTEGER; - gn: CRT.GraphNode; sn: CRT.SymbolNode; - name, gramName: CRT.Name; .) -= - "COMPILER" (. Texts.OpenWriter(w); - CRT.Init; CRX.Init; CRA.Init; - gramLine := CRS.line; - eofSy := CRT.NewSym(CRT.t, "EOF", 0); - genScanner := TRUE; - CRT.ignoreCase := FALSE; - ok := TRUE; - Sets.Clear(CRT.ignored) .) - ident (. CRS.GetName(CRS.pos, CRS.len, gramName); - CRT.semDeclPos.beg := CRS.nextPos; CRT.importPos.beg := -1; .) - { "IMPORT" (. CRT.importPos.beg := CRS.nextPos .) - {ANY} ";" (. CRT.importPos.len := SHORT(CRS.pos - CRT.importPos.beg); - CRT.importPos.col := 0; - CRT.semDeclPos.beg := CRS.nextPos .) - | ANY - } (. CRT.semDeclPos.len := SHORT(CRS.nextPos - CRT.semDeclPos.beg); - CRT.semDeclPos.col := 0 .) - { Declaration } - SYNC - "PRODUCTIONS" (. IF genScanner THEN CRA.MakeDeterministic(ok) END; - CRT.nNodes := 0 .) - { ident (. CRS.GetName(CRS.pos, CRS.len, name); - sp := CRT.FindSym(name); undef := sp = CRT.noSym; - IF undef THEN - sp := CRT.NewSym(CRT.nt, name, CRS.line); - CRT.GetSym(sp, sn); - ELSE - CRT.GetSym(sp, sn); - IF sn.typ = CRT.nt THEN - IF sn.struct > 0 THEN SemErr(7) END - ELSE SemErr(8) - END; - sn.line := CRS.line - END; - hasAttrs := sn.attrPos.beg >= 0 .) - ( Attribs (. IF ~undef & ~hasAttrs THEN SemErr(9) END; - CRT.PutSym(sp, sn) .) - | (. IF ~undef & hasAttrs THEN SemErr(10) END .) - ) - [ SemText ] - WEAK "=" - Expression (. CRT.CompleteGraph(gR); CRT.PutSym(sp, sn); - IF CRT.ddt[2] THEN CRT.PrintGraph END .) - WEAK "." - } (. sp := CRT.FindSym(gramName); - IF sp = CRT.noSym THEN SemErr(11); - ELSE - CRT.GetSym(sp, sn); - IF sn.attrPos.beg >= 0 THEN SemErr(12) END; - CRT.root := CRT.NewNode(CRT.nt, sp, gramLine); - END .) - "END" ident (. CRS.GetName(CRS.pos, CRS.len, name); - IF name # gramName THEN SemErr(17) END; - IF CRS.errors = 0 THEN - Texts.WriteString(w, " checking"); Texts.Append(Oberon.Log, w.buf); - CRT.CompSymbolSets; - IF ok THEN CRT.TestCompleteness(ok) END; - IF ok THEN - CRT.TestIfAllNtReached(ok1); CRT.FindCircularProductions(ok) - END; - IF ok THEN CRT.TestIfNtToTerm(ok) END; - IF ok THEN CRT.LL1Test(ok1) END; - IF CRT.ddt[0] THEN CRA.PrintStates END; - IF CRT.ddt[7] THEN CRT.XRef END; - IF ok THEN - Texts.WriteString(w, " +parser"); - Texts.Append(Oberon.Log, w.buf); - CRX.GenCompiler; - IF genScanner THEN - Texts.WriteString(w, " +scanner"); - Texts.Append(Oberon.Log, w.buf); - CRA.WriteScanner - END; - IF CRT.ddt[8] THEN CRX.WriteStatistics END - END - ELSE ok := FALSE - END; - IF CRT.ddt[6] THEN CRT.PrintSymbolTable END; - IF ok THEN Texts.WriteString(w, " done") END; - Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf) .) - ".". -(*------------------------------------------------------------------------------------*) -Declaration (. VAR gL1, gR1, gL2, gR2: INTEGER; nested: BOOLEAN; .) -= - "CHARACTERS" { SetDecl } -| "TOKENS" { TokenDecl } -| "PRAGMAS" { TokenDecl } -| "COMMENTS" - "FROM" TokenExpr - "TO" TokenExpr - ( "NESTED" (. nested := TRUE .) - | (. nested := FALSE .) - ) (. CRA.NewComment(gL1, gL2, nested) .) -| "IGNORE" - ( "CASE" (. CRT.ignoreCase := TRUE .) - | Set - ) -. - -(*------------------------------------------------------------------------------------*) -SetDecl (. VAR c: INTEGER; set: CRT.Set; name: CRT.Name; .) -= - ident (. CRS.GetName(CRS.pos, CRS.len, name); - c := CRT.ClassWithName(name); IF c >= 0 THEN SemErr(7) END .) - "=" Set (. c := CRT.NewClass(name, set) .) - ".". -(*------------------------------------------------------------------------------------*) -Set (. VAR set2: CRT.Set; .) -= - SimSet - { "+" SimSet (. Sets.Unite(set, set2) .) - | "-" SimSet (. Sets.Differ(set, set2) .) - }. -(*------------------------------------------------------------------------------------*) -SimSet (. VAR c, n, i: INTEGER; name: CRT.Name; s: ARRAY 128 OF CHAR; .) -= - ident (. CRS.GetName(CRS.pos, CRS.len, name); - c := CRT.ClassWithName(name); - IF c < 0 THEN SemErr(15); Sets.Clear(set) - ELSE CRT.GetClass(c, set) - END .) -| string (. CRS.GetName(CRS.pos, CRS.len, s); - Sets.Clear(set); i := 1; - WHILE s[i] # s[0] DO - Sets.Incl(set, ORD(s[i])); INC(i) - END .) -| "CHR" "(" number (. CRS.GetName(CRS.pos, CRS.len, name); - n := 0; i := 0; - WHILE name[i] # 0X DO - n := 10 * n + (ORD(name[i]) - ORD("0")); - INC(i) - END; - Sets.Clear(set); Sets.Incl(set, n) .) - ")" -| "ANY" (. Sets.Fill(set) .) -. -(*------------------------------------------------------------------------------------*) -TokenDecl (. VAR sp, kind, gL, gR: INTEGER; sn: CRT.SymbolNode; - pos: CRT.Position; name: CRT.Name; .) -= - Symbol (. IF CRT.FindSym(name) # CRT.noSym THEN SemErr(7) - ELSE - sp := CRT.NewSym(typ, name, CRS.line); - CRT.GetSym(sp, sn); sn.struct := CRT.classToken; - CRT.PutSym(sp, sn) - END .) - SYNC - ( "=" TokenExpr "." (. IF kind # ident THEN SemErr(13) END; - CRT.CompleteGraph(gR); - CRA.ConvertToStates(gL, sp) .) - | (. IF kind = ident THEN genScanner := FALSE - ELSE MatchLiteral(sp) - END .) - ) - [ SemText (. IF typ = CRT.t THEN SemErr(14) END; - CRT.GetSym(sp, sn); sn.semPos := pos; CRT.PutSym(sp, sn) .) - ]. -(*------------------------------------------------------------------------------------*) -Expression (. VAR gL2, gR2: INTEGER; first: BOOLEAN; .) -= - Term (. first := TRUE .) - { WEAK "|" - Term (. IF first THEN - CRT.MakeFirstAlt(gL, gR); first := FALSE - END; - CRT.ConcatAlt(gL, gR, gL2, gR2) .) - }. -(*------------------------------------------------------------------------------------*) -Term (. VAR gL2, gR2: INTEGER; .) -= (. gL := 0; gR := 0 .) - ( Factor - { Factor (. CRT.ConcatSeq(gL, gR, gL2, gR2) .) - } - | (. gL := CRT.NewNode(CRT.eps, 0, 0); gR := gL .) - ). -(*------------------------------------------------------------------------------------*) -Factor (. VAR sp, kind, c: INTEGER; name: CRT.Name; - gn: CRT.GraphNode; sn: CRT.SymbolNode; - set: CRT.Set; - undef, weak: BOOLEAN; - pos: CRT.Position; .) -= - (. gL :=0; gR := 0; weak := FALSE .) -( [ "WEAK" (. weak := TRUE .) - ] - Symbol (. sp := CRT.FindSym(name); undef := sp = CRT.noSym; - IF undef THEN - IF kind = ident THEN (*forward nt*) - sp := CRT.NewSym(CRT.nt, name, 0) - ELSE (*undefined string in production*) - sp := CRT.NewSym(CRT.t, name, CRS.line); - MatchLiteral(sp) - END - END; - CRT.GetSym(sp, sn); - IF ~(sn.typ IN {CRT.t,CRT.nt}) THEN SemErr(4) END; - IF weak THEN - IF sn.typ = CRT.t THEN sn.typ := CRT.wt ELSE SemErr(23) END - END; - gL := CRT.NewNode(sn.typ, sp, CRS.line); gR := gL .) - - ( Attribs (. CRT.GetNode(gL, gn); gn.pos := pos; CRT.PutNode(gL, gn); - CRT.GetSym(sp, sn); - IF undef THEN - sn.attrPos := pos; CRT.PutSym(sp, sn) - ELSIF sn.attrPos.beg < 0 THEN SemErr(5) - END; - IF kind # ident THEN SemErr(3) END .) - | (. CRT.GetSym(sp, sn); - IF sn.attrPos.beg >= 0 THEN SemErr(6) END .) - ) -| "(" Expression ")" -| "[" Expression "]" (. CRT.MakeOption(gL, gR) .) -| "{" Expression "}" (. CRT.MakeIteration(gL, gR) .) -| SemText (. gL := CRT.NewNode(CRT.sem, 0, 0); - gR := gL; - CRT.GetNode(gL, gn); gn.pos := pos; CRT.PutNode(gL, gn) .) -| "ANY" (. Sets.Fill(set); Sets.Excl(set, CRT.eofSy); - gL := CRT.NewNode(CRT.any, CRT.NewSet(set), 0); gR := gL .) -| "SYNC" (. gL := CRT.NewNode(CRT.sync, 0, 0); gR := gL .) -). -(*------------------------------------------------------------------------------------*) -TokenExpr (. VAR gL2, gR2: INTEGER; first: BOOLEAN; .) -= - TokenTerm (. first := TRUE .) - { WEAK "|" - TokenTerm (. IF first THEN - CRT.MakeFirstAlt(gL, gR); first := FALSE - END; - CRT.ConcatAlt(gL, gR, gL2, gR2) .) - }. -(*------------------------------------------------------------------------------------*) -TokenTerm (. VAR gL2, gR2: INTEGER; .) -= - TokenFactor - { TokenFactor (. CRT.ConcatSeq(gL, gR, gL2, gR2) .) - } - [ "CONTEXT" - "(" TokenExpr (. SetCtx(gL2); CRT.ConcatSeq(gL, gR, gL2, gR2) .) - ")" - ]. -(*------------------------------------------------------------------------------------*) -TokenFactor (. VAR kind, c: INTEGER; set: CRT.Set; name: CRT.Name; .) -= - (. gL :=0; gR := 0 .) -( Symbol (. IF kind = ident THEN - c := CRT.ClassWithName(name); - IF c < 0 THEN - SemErr(15); - Sets.Clear(set); c := CRT.NewClass(name, set) - END; - gL := CRT.NewNode(CRT.class, c, 0); gR := gL - ELSE (*string*) - CRT.StrToGraph(name, gL, gR) - END .) -| "(" TokenExpr ")" -| "[" TokenExpr "]" (. CRT.MakeOption(gL, gR) .) -| "{" TokenExpr "}" (. CRT.MakeIteration(gL, gR) .) -). -(*------------------------------------------------------------------------------------*) -Symbol = - ( ident (. kind := ident .) - | string (. kind := string .) - ) (. CRS.GetName(CRS.pos, CRS.len, name); - IF kind = string THEN FixString(name, CRS.len) END .) . -(*------------------------------------------------------------------------------------*) -Attribs = - "<" (. attrPos.beg := CRS.nextPos; attrPos.col := CRS.nextCol .) - { ANY } - ">" (. attrPos.len := SHORT(CRS.pos - attrPos.beg) .). -(*------------------------------------------------------------------------------------*) -SemText = - "(." (. semPos.beg := CRS.nextPos; semPos.col := CRS.nextCol .) - { ANY } - ".)" (. semPos.len := SHORT(CRS.pos - semPos.beg) .). - -END CR. diff --git a/src/tools/coco/CRA.Mod b/src/tools/coco/CRA.Mod index aa0f5685..40ea2451 100644 --- a/src/tools/coco/CRA.Mod +++ b/src/tools/coco/CRA.Mod @@ -1,6 +1,14 @@ -MODULE CRA; (* handles the DFA *) +(* The following check seems to be unnecessary. It reported an error if a symbol + context + was a prefix of another symbol, e.g.: + s1 = "a" "b" "c". + s2 = "a" CONTEXT("b"). + But this is ok + IF t.state.endOf # CRT.noSym THEN + PutS("$Ambiguous CONTEXT clause.$"); correct := FALSE + END*) +MODULE CRA; (* handles the DFA *) -IMPORT Oberon, Texts := CmdlnTexts, Sets, CRS, CRT; +IMPORT Oberon, Texts, Sets, CRS, CRT; CONST maxStates = 300; @@ -30,6 +38,9 @@ TYPE next: Target; END; + + + Comment = POINTER TO CommentNode; CommentNode = RECORD (* info about a comment syntax *) start,stop: ARRAY 2 OF CHAR; @@ -43,7 +54,6 @@ TYPE state: State; (* new state *) next: Melted; END; - VAR firstState: State; @@ -53,10 +63,10 @@ VAR stateNr: INTEGER; (*number of last allocated state*) firstMelted: Melted; (* list of melted states *) firstComment: Comment; (* list of comments *) + dirtyDFA: BOOLEAN; (* DFA may be nondeterministic *) out: Texts.Writer; (* current output *) fram: Texts.Reader; (* scanner frame input *) - PROCEDURE SemErr(nr: INTEGER); BEGIN CRS.Error(200+nr, CRS.pos) END SemErr; @@ -101,8 +111,9 @@ BEGIN END; (*----- print ranges *) IF (top = 1) & (lo[0] = 0X) & (hi[1] = 7FX) & (CHR(ORD(hi[0]) + 2) = lo[1]) THEN - Sets.Fill(s1); Sets.Differ(s1, s); PutS("~ ("); PutRange(s1); Put(")") + Sets.Fill(s1); Sets.Differ(s1, s); PutS("~ "); PutRange(s1) ELSE + PutS("("); i := 0; WHILE i <= top DO IF hi[i] = lo[i] THEN PutS("(ch="); PutC(lo[i]) @@ -113,7 +124,8 @@ BEGIN Put(")"); IF i < top THEN PutS(" OR ") END; INC(i) - END + END; + PutS(")"); END END PutRange; @@ -217,6 +229,7 @@ END NewState; PROCEDURE NewTransition(from, to: State; typ, sym, tc: INTEGER); VAR a: Action; t: Target; BEGIN + IF to = firstState THEN SemErr(21) END; NEW(t); t^.state := to; t^.next := NIL; NEW(a); a^.typ := typ; a^.sym := sym; a^.tc := tc; a^.target := t; AddAction(a, from.firstAction) @@ -359,17 +372,33 @@ BEGIN DelUnused END DeleteRedundantStates; - PROCEDURE ConvertToStates*(gp0, sp: INTEGER); (*note: gn.line is abused as a state number!*) - VAR n: INTEGER; S: ARRAY maxStates OF State; gn: CRT.GraphNode; + VAR n: INTEGER; S: ARRAY maxStates OF State; visited: CRT.MarkList; + PROCEDURE NumberNodes (gp: INTEGER; state: State); + VAR gn: CRT.GraphNode; + BEGIN + IF gp = 0 THEN RETURN END; (*end of graph*) + CRT.GetNode(gp, gn); + IF gn.line # 0 THEN RETURN END; (*already visited*) + IF state = NIL THEN state := NewState() END; + INC(n); S[n] := state; gn.line := n; CRT.PutNode(gp, gn); + IF CRT.DelGraph(gp) THEN state.endOf := sp END; (*state is final state*) + CASE gn.typ OF + CRT.class, CRT.char: NumberNodes(ABS(gn.next), NIL) + | CRT.opt: NumberNodes(ABS(gn.next), NIL); NumberNodes(gn.p1, state) + | CRT.iter: NumberNodes(ABS(gn.next), state); NumberNodes(gn.p1, state) + | CRT.alt: NumberNodes(gn.p1, state); NumberNodes(gn.p2, state) + END + END NumberNodes; + PROCEDURE TheState(gp: INTEGER): State; VAR state: State; gn: CRT.GraphNode; BEGIN IF gp = 0 THEN state := NewState(); state.endOf := sp; RETURN state ELSE CRT.GetNode(gp, gn); RETURN S[gn.line] - END + END END TheState; PROCEDURE Step(from: State; gp: INTEGER); @@ -384,45 +413,39 @@ PROCEDURE ConvertToStates*(gp0, sp: INTEGER); END END Step; - PROCEDURE FindTrans(gp: INTEGER; state: State); - VAR gn: CRT.GraphNode; new: BOOLEAN; + PROCEDURE FindTrans (gp: INTEGER; start: BOOLEAN); + VAR gn: CRT.GraphNode; BEGIN - IF gp = 0 THEN RETURN END; (*end of graph*) - CRT.GetNode(gp, gn); - IF gn.line # 0 THEN RETURN END; (*already visited*) - new := state = NIL; - IF new THEN state := NewState() END; - INC(n); S[n] := state; gn.line := n; CRT.PutNode(gp, gn); - IF CRT.DelGraph(gp) THEN state.endOf := sp END; (*state is end state*) + IF (gp = 0) OR Sets.In(visited, gp) THEN RETURN END; + Sets.Incl(visited, gp); CRT.GetNode(gp, gn); + IF start THEN Step(S[gn.line], gp) END; (*start of group of equally numbered nodes*) CASE gn.typ OF - CRT.class, CRT.char: FindTrans(ABS(gn.next), NIL); - | CRT.opt: FindTrans(ABS(gn.next), NIL); FindTrans(gn.p1, state) - | CRT.iter: FindTrans(ABS(gn.next), state); FindTrans(gn.p1, state) - | CRT.alt: FindTrans(gn.p1, state); FindTrans(gn.p2, state) - END; - IF new OR (state = firstState) & (gp = gp0) THEN (*start of a group of equally numbered nodes*) - Step(state, gp) + CRT.class, CRT.char: FindTrans(ABS(gn.next), TRUE) + | CRT.opt: FindTrans(ABS(gn.next), TRUE); FindTrans(gn.p1, FALSE) + | CRT.iter: FindTrans(ABS(gn.next), FALSE); FindTrans(gn.p1, FALSE) + | CRT.alt: FindTrans(gn.p1, FALSE); FindTrans(gn.p2, FALSE) END END FindTrans; BEGIN IF CRT.DelGraph(gp0) THEN SemErr(20) END; - CRT.GetNode(gp0, gn); - IF gn.typ = CRT.iter THEN SemErr(21) END; - n := 0; FindTrans(gp0, firstState) + n := 0; NumberNodes(gp0, firstState); + CRT.ClearMarkList(visited); FindTrans(gp0, TRUE) END ConvertToStates; PROCEDURE MatchDFA* (s: ARRAY OF CHAR; sp: INTEGER; VAR matchedSp: INTEGER); - VAR state, to: State; a: Action; i, len: INTEGER; + VAR state, to: State; a: Action; i, len: INTEGER; weakMatch: BOOLEAN; BEGIN (*s with quotes*) - state := firstState; i := 1; len := Length(s) - 1; + state := firstState; i := 1; len := Length(s) - 1; weakMatch := FALSE; LOOP (*try to match s against existing DFA*) IF i = len THEN EXIT END; a := TheAction(state, s[i]); IF a = NIL THEN EXIT END; + IF a^.typ = CRT.class THEN weakMatch := TRUE END; state := a.target.state; INC(i) END; + IF weakMatch & (i < len) THEN state := firstState; i := 1; dirtyDFA := TRUE END; WHILE i < len DO (*make new DFA for s[i..len-1]*) to := NewState(); NewTransition(state, to, CRT.char, ORD(s[i]), CRT.normTrans); @@ -542,11 +565,7 @@ VAR correct:=FALSE END END; - IF t^.state.ctx THEN ctx := TRUE; - IF t.state.endOf # CRT.noSym THEN - PutS("$Ambiguous CONTEXT clause.$"); correct := FALSE - END - END; + IF t^.state.ctx THEN ctx := TRUE; END; t := t^.next END END GetStateSet; @@ -595,7 +614,6 @@ BEGIN Texts.Append(Oberon.Log, out.buf) END MeltStates; - PROCEDURE MakeDeterministic*(VAR correct: BOOLEAN); VAR state: State; changed: BOOLEAN; @@ -677,56 +695,60 @@ BEGIN END PrintStates; -PROCEDURE GenComment(com:Comment); - +PROCEDURE GenComment(com:Comment; i: INTEGER); + PROCEDURE GenBody; BEGIN - PutS(" LOOP$"); - PutS(" IF "); PutChCond(com^.stop[0]); PutS(" THEN$"); + PutS(" LOOP$"); + PutS(" IF "); PutChCond(com^.stop[0]); PutS(" THEN$"); IF Length(com^.stop) = 1 THEN - PutS(" DEC(level); oldEols := chLine - startLine; NextCh;$"); - PutS(" IF level = 0 THEN RETURN TRUE END;$"); + PutS(" DEC(level);$"); + PutS(" IF level = 0 THEN oldEols := chLine - startLine; NextCh; RETURN TRUE END;$"); + PutS(" NextCh;$"); ELSE + PutS(" NextCh;$"); + PutS(" IF "); PutChCond(com^.stop[1]); PutS(" THEN$"); + PutS(" DEC(level);$"); + PutS(" IF level=0 THEN oldEols := chLine - startLine; NextCh; RETURN TRUE END;$"); PutS(" NextCh;$"); - PutS(" IF "); PutChCond(com^.stop[1]); PutS(" THEN$"); - PutS(" DEC(level); oldEols := chLine - startLine; NextCh;$"); - PutS(" IF level=0 THEN RETURN TRUE END$"); - PutS(" END;$"); + PutS(" END;$"); END; IF com^.nested THEN - PutS(" ELSIF "); PutChCond(com^.start[0]); PutS(" THEN$"); + PutS(" ELSIF "); PutChCond(com^.start[0]); PutS(" THEN$"); IF Length(com^.start) = 1 THEN - PutS(" INC(level); NextCh;$"); + PutS(" INC(level); NextCh;$"); ELSE - PutS(" NextCh;$"); - PutS(" IF "); PutChCond(com^.start[1]); PutS(" THEN$"); - PutS(" INC(level); NextCh;$"); - PutS(" END;$"); + PutS(" NextCh;$"); + PutS(" IF "); PutChCond(com^.start[1]); PutS(" THEN$"); + PutS(" INC(level); NextCh;$"); + PutS(" END;$"); END; END; - PutS(" ELSIF ch = EOF THEN RETURN FALSE$"); - PutS(" ELSE NextCh END;$"); - PutS(" END;$"); + PutS(" ELSIF ch = EOF THEN RETURN FALSE$"); + PutS(" ELSE NextCh END;$"); + PutS(" END;$"); END GenBody; BEGIN - PutS(" IF "); PutChCond(com^.start[0]); PutS(" THEN$"); + PutS("PROCEDURE Comment"); PutI(i); PutS("(): BOOLEAN;$"); + PutS(" VAR level, startLine: INTEGER; oldLineStart: LONGINT;$"); + PutS("BEGIN$"); + PutS(" level := 1; startLine := chLine; oldLineStart := lineStart;$"); IF Length(com^.start) = 1 THEN - PutS(" NextCh;$"); + PutS(" NextCh;$"); GenBody; - PutS(" END;"); ELSE + PutS(" NextCh;$"); + PutS(" IF "); PutChCond(com^.start[1]); PutS(" THEN$"); PutS(" NextCh;$"); - PutS(" IF "); PutChCond(com^.start[1]); PutS(" THEN$"); - PutS(" NextCh;$"); GenBody; - PutS(" ELSE$"); - PutS(" IF ch = EOL THEN DEC(chLine); lineStart := oldLineStart END;$"); - PutS(" DEC(chPos, 2); Texts.OpenReader(r, src, chPos+1); NextCh; RETURN FALSE$"); - PutS(" END$"); - PutS(" END;"); + PutS(" ELSE$"); + PutS(" IF ch = EOL THEN DEC(chLine); lineStart := oldLineStart END;$"); + PutS(" DEC(chPos, 2); Texts.OpenReader(r, src, chPos+1); NextCh; RETURN FALSE$"); + PutS(" END$"); END; - END GenComment; + PutS("END Comment"); PutI(i); PutS(";$$$") +END GenComment; PROCEDURE CopyFramePart (stopStr: ARRAY OF CHAR); (*Copy from file to file until *) @@ -829,7 +851,7 @@ PROCEDURE *Show (t: Texts.Text; op: INTEGER; beg, end: LONGINT); END Show; -PROCEDURE WriteScanner*; +PROCEDURE WriteScanner* (VAR ok: BOOLEAN); VAR scanner: ARRAY 32 OF CHAR; name: ARRAY 64 OF CHAR; @@ -863,6 +885,7 @@ VAR END FillStartTab; BEGIN + IF dirtyDFA THEN MakeDeterministic(ok) END; FillStartTab; CRT.GetNode(CRT.root, gn); CRT.GetSym(gn.p1, sn); COPY(sn.name, scanner); l := Length(scanner); scanner[l] := "S"; scanner[l+1] := 0X; @@ -877,22 +900,22 @@ BEGIN CopyFramePart("-->modulename"); PutS(scanner); CopyFramePart("-->declarations"); PutS(" noSym = "); PutI(CRT.maxT); Put(";"); CopyFramePart("-->comment"); - com := firstComment; - WHILE com # NIL DO GenComment(com); com := com^.next END; + com := firstComment; i := 0; + WHILE com # NIL DO GenComment(com, i); com := com^.next; INC(i) END; CopyFramePart("-->literals"); GenLiterals; CopyFramePart("-->GetSy1"); - IF ~ Sets.In(CRT.ignored, ORD(EOL)) THEN PutS(" IF oldEols > 0 THEN DEC(oldEols); ch := EOL END;$") END; PutS(" WHILE (ch=20X)"); IF ~ Sets.Empty(CRT.ignored) THEN PutS(" OR ") END; PutRange(CRT.ignored); PutS(" DO NextCh END;"); IF firstComment # NIL THEN - PutS("$ IF ("); com := firstComment; + PutS("$ IF "); com := firstComment; i := 0; WHILE com # NIL DO PutChCond(com^.start[0]); + PutS(" & Comment"); PutI(i); PutS("() "); IF com^.next # NIL THEN PutS(" OR ") END; - com := com^.next + com := com^.next; INC(i) END; - PutS(") & Comment() THEN Get(sym); RETURN END;") + PutS(" THEN Get(sym); RETURN END;") END; CopyFramePart("-->GetSy2"); state := firstState.next; @@ -912,7 +935,7 @@ BEGIN END; CopyFramePart("-->modulename"); PutS(scanner); Put("."); - NEW(t); (*t.notify := Show;*) Texts.Open(t, ""); Texts.Append(t, out.buf); + NEW(t); t.notify := Show; Texts.Open(t, ""); Texts.Append(t, out.buf); l := Length(scanner); scanner[l] := "."; scanner[l+1] := "M"; scanner[l+2] := "o"; scanner[l+3] := "d"; scanner[l+4] := 0X; Texts.Close(t, scanner) END WriteScanner; @@ -922,9 +945,11 @@ PROCEDURE Init*; BEGIN firstState := NIL; lastState := NIL; stateNr := -1; rootState := NewState(); - firstMelted := NIL; firstComment := NIL + firstMelted := NIL; firstComment := NIL; + dirtyDFA := FALSE END Init; BEGIN Texts.OpenWriter(out) END CRA. + diff --git a/src/tools/coco/CRP.Mod b/src/tools/coco/CRP.Mod index bbd98a31..fe38ac12 100644 --- a/src/tools/coco/CRP.Mod +++ b/src/tools/coco/CRP.Mod @@ -1,12 +1,12 @@ (* parser module generated by Coco-R *) MODULE CRP; -IMPORT CRS, CRT, CRA, CRX, Sets, Texts := CmdlnTexts, Oberon; +IMPORT CRS, CRT, CRA, CRX, Sets, Texts, Oberon; CONST - maxP = 39; - maxT = 38; - nrSets = 18; + maxP = 42; + maxT = 41; + nrSets = 20; setSize = 32; nSets = (maxT DIV setSize) + 1; @@ -73,7 +73,7 @@ PROCEDURE FixString (VAR s: ARRAY OF CHAR; len: INTEGER); BEGIN double := FALSE; FOR i := 0 TO len-2 DO - IF s[i] = '"' THEN double := TRUE END + IF s[i] = '"' THEN double := TRUE ELSIF s[i] = " " THEN SemErr(24) END END; IF ~ double THEN s[0] := '"'; s[len-1] := '"' END END FixString; @@ -89,9 +89,9 @@ PROCEDURE Get; BEGIN LOOP CRS.Get(sym); IF sym > maxT THEN - IF sym = 39 THEN + IF sym = 42 THEN CRS.GetName(CRS.nextPos, CRS.nextLen, str); SetDDT(str) - END; + END ; CRS.nextPos := CRS.pos; CRS.nextCol := CRS.col; CRS.nextLine := CRS.line; @@ -161,22 +161,22 @@ BEGIN ELSE (*string*) CRT.StrToGraph(name, gL, gR) END ; - ELSIF (sym = 23) THEN + ELSIF (sym = 24) THEN Get; TokenExpr(gL, gR); - Expect(24); - ELSIF (sym = 28) THEN + Expect(25); + ELSIF (sym = 29) THEN Get; TokenExpr(gL, gR); - Expect(29); + Expect(30); CRT.MakeOption(gL, gR) ; - ELSIF (sym = 30) THEN + ELSIF (sym = 31) THEN Get; TokenExpr(gL, gR); - Expect(31); + Expect(32); CRT.MakeIteration(gL, gR) ; - ELSE Error(39) - END; + ELSE Error(42) + END ; END TokenFactor; PROCEDURE TokenTerm(VAR gL, gR: INTEGER); @@ -186,14 +186,14 @@ BEGIN WHILE StartOf(1) DO TokenFactor(gL2, gR2); CRT.ConcatSeq(gL, gR, gL2, gR2) ; - END; - IF (sym = 33) THEN + END ; + IF (sym = 34) THEN Get; - Expect(23); + Expect(24); TokenExpr(gL2, gR2); SetCtx(gL2); CRT.ConcatSeq(gL, gR, gL2, gR2) ; - Expect(24); - END; + Expect(25); + END ; END TokenTerm; PROCEDURE Factor(VAR gL, gR: INTEGER); @@ -205,10 +205,10 @@ PROCEDURE Factor(VAR gL, gR: INTEGER); BEGIN gL :=0; gR := 0; weak := FALSE ; CASE sym OF - | 1,2,27: IF (sym = 27) THEN + | 1,2,28: IF (sym = 28) THEN Get; weak := TRUE ; - END; + END ; Symbol(name, kind); sp := CRT.FindSym(name); undef := sp = CRT.noSym; IF undef THEN @@ -225,7 +225,7 @@ BEGIN IF sn.typ = CRT.t THEN sn.typ := CRT.wt ELSE SemErr(23) END END; gL := CRT.NewNode(sn.typ, sp, CRS.line); gR := gL ; - IF (sym = 34) THEN + IF (sym = 35) OR (sym = 37) THEN Attribs(pos); CRT.GetNode(gL, gn); gn.pos := pos; CRT.PutNode(gL, gn); CRT.GetSym(sp, sn); @@ -237,30 +237,30 @@ BEGIN ELSIF StartOf(2) THEN CRT.GetSym(sp, sn); IF sn.attrPos.beg >= 0 THEN SemErr(6) END ; - ELSE Error(40) - END; - | 23: Get; + ELSE Error(43) + END ; + | 24: Get; Expression(gL, gR); - Expect(24); - | 28: Get; + Expect(25); + | 29: Get; Expression(gL, gR); - Expect(29); + Expect(30); CRT.MakeOption(gL, gR) ; - | 30: Get; + | 31: Get; Expression(gL, gR); - Expect(31); + Expect(32); CRT.MakeIteration(gL, gR) ; - | 36: SemText(pos); + | 39: SemText(pos); gL := CRT.NewNode(CRT.sem, 0, 0); gR := gL; CRT.GetNode(gL, gn); gn.pos := pos; CRT.PutNode(gL, gn) ; - | 25: Get; + | 26: Get; Sets.Fill(set); Sets.Excl(set, CRT.eofSy); gL := CRT.NewNode(CRT.any, CRT.NewSet(set), 0); gR := gL ; - | 32: Get; + | 33: Get; gL := CRT.NewNode(CRT.sync, 0, 0); gR := gL ; - ELSE Error(41) - END; + ELSE Error(44) + END ; END Factor; PROCEDURE Term(VAR gL, gR: INTEGER); @@ -272,11 +272,11 @@ BEGIN WHILE StartOf(3) DO Factor(gL2, gR2); CRT.ConcatSeq(gL, gR, gL2, gR2) ; - END; + END ; ELSIF StartOf(4) THEN gL := CRT.NewNode(CRT.eps, 0, 0); gR := gL ; - ELSE Error(42) - END; + ELSE Error(45) + END ; END Term; PROCEDURE Symbol(VAR name: CRT.Name; VAR kind: INTEGER); @@ -287,8 +287,8 @@ BEGIN ELSIF (sym = 2) THEN Get; kind := string ; - ELSE Error(43) - END; + ELSE Error(46) + END ; CRS.GetName(CRS.pos, CRS.len, name); IF kind = string THEN FixString(name, CRS.len) END ; END Symbol; @@ -310,10 +310,10 @@ BEGIN WHILE s[i] # s[0] DO Sets.Incl(set, ORD(s[i])); INC(i) END ; - ELSIF (sym = 22) THEN + ELSIF (sym = 23) THEN Get; - Expect(23); - Expect(3); + Expect(24); + Expect(4); CRS.GetName(CRS.pos, CRS.len, name); n := 0; i := 0; WHILE name[i] # 0X DO @@ -321,20 +321,20 @@ BEGIN INC(i) END; Sets.Clear(set); Sets.Incl(set, n) ; - Expect(24); - ELSIF (sym = 25) THEN + Expect(25); + ELSIF (sym = 26) THEN Get; Sets.Fill(set) ; - ELSE Error(44) - END; + ELSE Error(47) + END ; END SimSet; PROCEDURE Set(VAR set: CRT.Set); VAR set2: CRT.Set; BEGIN SimSet(set); - WHILE (sym = 20) OR (sym = 21) DO - IF (sym = 20) THEN + WHILE (sym = 21) OR (sym = 22) DO + IF (sym = 21) THEN Get; SimSet(set2); Sets.Unite(set, set2) ; @@ -342,8 +342,8 @@ BEGIN Get; SimSet(set2); Sets.Differ(set, set2) ; - END; - END; + END ; + END ; END Set; PROCEDURE TokenExpr(VAR gL, gR: INTEGER); @@ -351,13 +351,13 @@ PROCEDURE TokenExpr(VAR gL, gR: INTEGER); BEGIN TokenTerm(gL, gR); first := TRUE ; - WHILE WeakSeparator(26, 1, 5) DO + WHILE WeakSeparator(27, 1, 5) DO TokenTerm(gL2, gR2); IF first THEN CRT.MakeFirstAlt(gL, gR); first := FALSE END; CRT.ConcatAlt(gL, gR, gL2, gR2) ; - END; + END ; END TokenExpr; PROCEDURE TokenDecl(typ: INTEGER); @@ -371,11 +371,11 @@ BEGIN CRT.GetSym(sp, sn); sn.struct := CRT.classToken; CRT.PutSym(sp, sn) END ; - WHILE ~( StartOf(6) ) DO Error(45); Get END; - IF (sym = 8) THEN + WHILE ~( StartOf(6) ) DO Error(48); Get END ; + IF (sym = 9) THEN Get; TokenExpr(gL, gR); - Expect(9); + Expect(10); IF kind # ident THEN SemErr(13) END; CRT.CompleteGraph(gR); CRA.ConvertToStates(gL, sp) ; @@ -383,13 +383,13 @@ BEGIN IF kind = ident THEN genScanner := FALSE ELSE MatchLiteral(sp) END ; - ELSE Error(46) - END; - IF (sym = 36) THEN + ELSE Error(49) + END ; + IF (sym = 39) THEN SemText(pos); IF typ = CRT.t THEN SemErr(14) END; CRT.GetSym(sp, sn); sn.semPos := pos; CRT.PutSym(sp, sn) ; - END; + END ; END TokenDecl; PROCEDURE SetDecl; @@ -398,10 +398,10 @@ BEGIN Expect(1); CRS.GetName(CRS.pos, CRS.len, name); c := CRT.ClassWithName(name); IF c >= 0 THEN SemErr(7) END ; - Expect(8); + Expect(9); Set(set); c := CRT.NewClass(name, set) ; - Expect(9); + Expect(10); END SetDecl; PROCEDURE Expression(VAR gL, gR: INTEGER); @@ -409,80 +409,99 @@ PROCEDURE Expression(VAR gL, gR: INTEGER); BEGIN Term(gL, gR); first := TRUE ; - WHILE WeakSeparator(26, 2, 8) DO + WHILE WeakSeparator(27, 2, 8) DO Term(gL2, gR2); IF first THEN CRT.MakeFirstAlt(gL, gR); first := FALSE END; CRT.ConcatAlt(gL, gR, gL2, gR2) ; - END; + END ; END Expression; PROCEDURE SemText(VAR semPos: CRT.Position); BEGIN - Expect(36); + Expect(39); semPos.beg := CRS.nextPos; semPos.col := CRS.nextCol ; WHILE StartOf(9) DO - Get; - END; - Expect(37); - semPos.len := SHORT(CRS.pos - semPos.beg) ; + IF StartOf(10) THEN + Get; + ELSIF (sym = 3) THEN + Get; + SemErr(18) ; + ELSE + Get; + SemErr(19) ; + END ; + END ; + Expect(40); + semPos.len := CRS.pos - semPos.beg ; END SemText; PROCEDURE Attribs(VAR attrPos: CRT.Position); BEGIN - Expect(34); - attrPos.beg := CRS.nextPos; attrPos.col := CRS.nextCol ; - WHILE StartOf(10) DO + IF (sym = 35) THEN Get; - END; - Expect(35); - attrPos.len := SHORT(CRS.pos - attrPos.beg) ; + attrPos.beg := CRS.nextPos; attrPos.col := CRS.nextCol ; + WHILE StartOf(11) DO + Get; + END ; + Expect(36); + attrPos.len := CRS.pos - attrPos.beg ; + ELSIF (sym = 37) THEN + Get; + attrPos.beg := CRS.nextPos; attrPos.col := CRS.nextCol ; + WHILE StartOf(12) DO + Get; + END ; + Expect(38); + attrPos.len := CRS.pos - attrPos.beg ; + ELSE Error(50) + END ; END Attribs; PROCEDURE Declaration; VAR gL1, gR1, gL2, gR2: INTEGER; nested: BOOLEAN; BEGIN - IF (sym = 11) THEN + IF (sym = 12) THEN Get; WHILE (sym = 1) DO SetDecl; - END; - ELSIF (sym = 12) THEN - Get; - WHILE (sym = 1) OR (sym = 2) DO - TokenDecl(CRT.t); - END; + END ; ELSIF (sym = 13) THEN Get; WHILE (sym = 1) OR (sym = 2) DO - TokenDecl(CRT.pr); - END; + TokenDecl(CRT.t); + END ; ELSIF (sym = 14) THEN Get; - Expect(15); - TokenExpr(gL1, gR1); + WHILE (sym = 1) OR (sym = 2) DO + TokenDecl(CRT.pr); + END ; + ELSIF (sym = 15) THEN + Get; Expect(16); + TokenExpr(gL1, gR1); + Expect(17); TokenExpr(gL2, gR2); - IF (sym = 17) THEN + IF (sym = 18) THEN Get; nested := TRUE ; - ELSIF StartOf(11) THEN + ELSIF StartOf(13) THEN nested := FALSE ; - ELSE Error(47) - END; + ELSE Error(51) + END ; CRA.NewComment(gL1, gL2, nested) ; - ELSIF (sym = 18) THEN + ELSIF (sym = 19) THEN Get; - IF (sym = 19) THEN + IF (sym = 20) THEN Get; CRT.ignoreCase := TRUE ; - ELSIF StartOf(12) THEN + ELSIF StartOf(14) THEN Set(CRT.ignored); - ELSE Error(48) - END; - ELSE Error(49) - END; + ELSE Error(52) + END ; + ELSE Error(53) + END ; END Declaration; PROCEDURE CR; @@ -491,7 +510,7 @@ PROCEDURE CR; gn: CRT.GraphNode; sn: CRT.SymbolNode; name, gramName: CRT.Name; BEGIN - Expect(4); + Expect(5); Texts.OpenWriter(w); CRT.Init; CRX.Init; CRA.Init; gramLine := CRS.line; @@ -503,28 +522,28 @@ BEGIN Expect(1); CRS.GetName(CRS.pos, CRS.len, gramName); CRT.semDeclPos.beg := CRS.nextPos; CRT.importPos.beg := -1; ; - WHILE StartOf(13) DO - IF (sym = 5) THEN + WHILE StartOf(15) DO + IF (sym = 6) THEN Get; CRT.importPos.beg := CRS.nextPos ; - WHILE StartOf(14) DO + WHILE StartOf(16) DO Get; - END; - Expect(6); - CRT.importPos.len := SHORT(CRS.pos - CRT.importPos.beg); + END ; + Expect(7); + CRT.importPos.len := CRS.pos - CRT.importPos.beg; CRT.importPos.col := 0; CRT.semDeclPos.beg := CRS.nextPos ; ELSE Get; - END; - END; - CRT.semDeclPos.len := SHORT(CRS.nextPos - CRT.semDeclPos.beg); + END ; + END ; + CRT.semDeclPos.len := CRS.nextPos - CRT.semDeclPos.beg; CRT.semDeclPos.col := 0 ; - WHILE StartOf(15) DO + WHILE StartOf(17) DO Declaration; - END; - WHILE ~( (sym = 0) OR (sym = 7)) DO Error(50); Get END; - Expect(7); + END ; + WHILE ~( (sym = 0) OR (sym = 8)) DO Error(54); Get END ; + Expect(8); IF genScanner THEN CRA.MakeDeterministic(ok) END; CRT.nNodes := 0 ; WHILE (sym = 1) DO @@ -543,23 +562,23 @@ BEGIN sn.line := CRS.line END; hasAttrs := sn.attrPos.beg >= 0 ; - IF (sym = 34) THEN + IF (sym = 35) OR (sym = 37) THEN Attribs(sn.attrPos); IF ~undef & ~hasAttrs THEN SemErr(9) END; CRT.PutSym(sp, sn) ; - ELSIF (sym = 8) OR (sym = 36) THEN + ELSIF (sym = 9) OR (sym = 39) THEN IF ~undef & hasAttrs THEN SemErr(10) END ; - ELSE Error(51) - END; - IF (sym = 36) THEN + ELSE Error(55) + END ; + IF (sym = 39) THEN SemText(sn.semPos); - END; - ExpectWeak(8, 16); + END ; + ExpectWeak(9, 18); Expression(sn.struct, gR); CRT.CompleteGraph(gR); CRT.PutSym(sp, sn); IF CRT.ddt[2] THEN CRT.PrintGraph END ; - ExpectWeak(9, 17); - END; + ExpectWeak(10, 19); + END ; sp := CRT.FindSym(gramName); IF sp = CRT.noSym THEN SemErr(11); ELSE @@ -567,7 +586,7 @@ BEGIN IF sn.attrPos.beg >= 0 THEN SemErr(12) END; CRT.root := CRT.NewNode(CRT.nt, sp, gramLine); END ; - Expect(10); + Expect(11); Expect(1); CRS.GetName(CRS.pos, CRS.len, name); IF name # gramName THEN SemErr(17) END; @@ -589,7 +608,7 @@ BEGIN IF genScanner THEN Texts.WriteString(w, " +scanner"); Texts.Append(Oberon.Log, w.buf); - CRA.WriteScanner + CRA.WriteScanner(ok) END; IF CRT.ddt[8] THEN CRX.WriteStatistics END END @@ -598,7 +617,7 @@ BEGIN IF CRT.ddt[6] THEN CRT.PrintSymbolTable END; IF ok THEN Texts.WriteString(w, " done") END; Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf) ; - Expect(9); + Expect(10); END CR; @@ -611,93 +630,102 @@ BEGIN END Parse; BEGIN - symSet[0, 0] := {0,1,2,7,8,11,12,13,14,18}; - symSet[0, 1] := {4}; - symSet[1, 0] := {1,2,23,28,30}; + symSet[0, 0] := {0,1,2,8,9,12,13,14,15,19}; + symSet[0, 1] := {7}; + symSet[1, 0] := {1,2,24,29,31}; symSet[1, 1] := {}; - symSet[2, 0] := {1,2,9,23,24,25,26,27,28,29,30,31}; - symSet[2, 1] := {0,4}; - symSet[3, 0] := {1,2,23,25,27,28,30}; - symSet[3, 1] := {0,4}; - symSet[4, 0] := {9,24,26,29,31}; - symSet[4, 1] := {}; - symSet[5, 0] := {7,9,11,12,13,14,16,17,18,24,29,31}; - symSet[5, 1] := {}; - symSet[6, 0] := {0,1,2,7,8,11,12,13,14,18}; - symSet[6, 1] := {4}; - symSet[7, 0] := {1,2,7,11,12,13,14,18}; - symSet[7, 1] := {4}; - symSet[8, 0] := {9,24,29,31}; - symSet[8, 1] := {}; + symSet[2, 0] := {1,2,10,24,25,26,27,28,29,30,31}; + symSet[2, 1] := {0,1,7}; + symSet[3, 0] := {1,2,24,26,28,29,31}; + symSet[3, 1] := {1,7}; + symSet[4, 0] := {10,25,27,30}; + symSet[4, 1] := {0}; + symSet[5, 0] := {8,10,12,13,14,15,17,18,19,25,30}; + symSet[5, 1] := {0}; + symSet[6, 0] := {0,1,2,8,9,12,13,14,15,19}; + symSet[6, 1] := {7}; + symSet[7, 0] := {1,2,8,12,13,14,15,19}; + symSet[7, 1] := {7}; + symSet[8, 0] := {10,25,30}; + symSet[8, 1] := {0}; symSet[9, 0] := {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; - symSet[9, 1] := {0,1,2,3,4,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; - symSet[10, 0] := {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; - symSet[10, 1] := {0,1,2,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; - symSet[11, 0] := {7,11,12,13,14,18}; - symSet[11, 1] := {}; - symSet[12, 0] := {1,2,22,25}; - symSet[12, 1] := {}; - symSet[13, 0] := {1,2,3,4,5,6,8,9,10,15,16,17,19,20,21,22,23,24,25,26,27,28,29,30,31}; - symSet[13, 1] := {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; - symSet[14, 0] := {1,2,3,4,5,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; - symSet[14, 1] := {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; - symSet[15, 0] := {11,12,13,14,18}; - symSet[15, 1] := {}; - symSet[16, 0] := {0,1,2,7,8,9,11,12,13,14,18,23,25,26,27,28,30}; - symSet[16, 1] := {0,4}; - symSet[17, 0] := {0,1,2,7,8,10,11,12,13,14,18}; - symSet[17, 1] := {4}; + symSet[9, 1] := {0,1,2,3,4,5,6,7,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; + symSet[10, 0] := {1,2,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; + symSet[10, 1] := {0,1,2,3,4,5,6,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; + symSet[11, 0] := {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; + symSet[11, 1] := {0,1,2,3,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; + symSet[12, 0] := {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; + symSet[12, 1] := {0,1,2,3,4,5,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; + symSet[13, 0] := {8,12,13,14,15,19}; + symSet[13, 1] := {}; + symSet[14, 0] := {1,2,23,26}; + symSet[14, 1] := {}; + symSet[15, 0] := {1,2,3,4,5,6,7,9,10,11,16,17,18,20,21,22,23,24,25,26,27,28,29,30,31}; + symSet[15, 1] := {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; + symSet[16, 0] := {1,2,3,4,5,6,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; + symSet[16, 1] := {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}; + symSet[17, 0] := {12,13,14,15,19}; + symSet[17, 1] := {}; + symSet[18, 0] := {0,1,2,8,9,10,12,13,14,15,19,24,26,27,28,29,31}; + symSet[18, 1] := {1,7}; + symSet[19, 0] := {0,1,2,8,9,11,12,13,14,15,19}; + symSet[19, 1] := {7}; END CRP. | 0: Msg("EOF expected") | 1: Msg("ident expected") | 2: Msg("string expected") - | 3: Msg("number expected") - | 4: Msg("'COMPILER' expected") - | 5: Msg("'IMPORT' expected") - | 6: Msg("';' expected") - | 7: Msg("'PRODUCTIONS' expected") - | 8: Msg("'=' expected") - | 9: Msg("'.' expected") - | 10: Msg("'END' expected") - | 11: Msg("'CHARACTERS' expected") - | 12: Msg("'TOKENS' expected") - | 13: Msg("'PRAGMAS' expected") - | 14: Msg("'COMMENTS' expected") - | 15: Msg("'FROM' expected") - | 16: Msg("'TO' expected") - | 17: Msg("'NESTED' expected") - | 18: Msg("'IGNORE' expected") - | 19: Msg("'CASE' expected") - | 20: Msg("'+' expected") - | 21: Msg("'-' expected") - | 22: Msg("'CHR' expected") - | 23: Msg("'(' expected") - | 24: Msg("')' expected") - | 25: Msg("'ANY' expected") - | 26: Msg("'|' expected") - | 27: Msg("'WEAK' expected") - | 28: Msg("'[' expected") - | 29: Msg("']' expected") - | 30: Msg("'{' expected") - | 31: Msg("'}' expected") - | 32: Msg("'SYNC' expected") - | 33: Msg("'CONTEXT' expected") - | 34: Msg("'<' expected") - | 35: Msg("'>' expected") - | 36: Msg("'(.' expected") - | 37: Msg("'.)' expected") - | 38: Msg("??? expected") - | 39: Msg("invalid TokenFactor") - | 40: Msg("invalid Factor") - | 41: Msg("invalid Factor") - | 42: Msg("invalid Term") - | 43: Msg("invalid Symbol") - | 44: Msg("invalid SimSet") - | 45: Msg("this symbol not expected in TokenDecl") - | 46: Msg("invalid TokenDecl") - | 47: Msg("invalid Declaration") - | 48: Msg("invalid Declaration") - | 49: Msg("invalid Declaration") - | 50: Msg("this symbol not expected in CR") - | 51: Msg("invalid CR") + | 3: Msg("badString expected") + | 4: Msg("number expected") + | 5: Msg("'COMPILER' expected") + | 6: Msg("'IMPORT' expected") + | 7: Msg("';' expected") + | 8: Msg("'PRODUCTIONS' expected") + | 9: Msg("'=' expected") + | 10: Msg("'.' expected") + | 11: Msg("'END' expected") + | 12: Msg("'CHARACTERS' expected") + | 13: Msg("'TOKENS' expected") + | 14: Msg("'PRAGMAS' expected") + | 15: Msg("'COMMENTS' expected") + | 16: Msg("'FROM' expected") + | 17: Msg("'TO' expected") + | 18: Msg("'NESTED' expected") + | 19: Msg("'IGNORE' expected") + | 20: Msg("'CASE' expected") + | 21: Msg("'+' expected") + | 22: Msg("'-' expected") + | 23: Msg("'CHR' expected") + | 24: Msg("'(' expected") + | 25: Msg("')' expected") + | 26: Msg("'ANY' expected") + | 27: Msg("'|' expected") + | 28: Msg("'WEAK' expected") + | 29: Msg("'[' expected") + | 30: Msg("']' expected") + | 31: Msg("'{' expected") + | 32: Msg("'}' expected") + | 33: Msg("'SYNC' expected") + | 34: Msg("'CONTEXT' expected") + | 35: Msg("'<' expected") + | 36: Msg("'>' expected") + | 37: Msg("'<.' expected") + | 38: Msg("'.>' expected") + | 39: Msg("'(.' expected") + | 40: Msg("'.)' expected") + | 41: Msg("??? expected") + | 42: Msg("invalid TokenFactor") + | 43: Msg("invalid Factor") + | 44: Msg("invalid Factor") + | 45: Msg("invalid Term") + | 46: Msg("invalid Symbol") + | 47: Msg("invalid SimSet") + | 48: Msg("this symbol not expected in TokenDecl") + | 49: Msg("invalid TokenDecl") + | 50: Msg("invalid Attribs") + | 51: Msg("invalid Declaration") + | 52: Msg("invalid Declaration") + | 53: Msg("invalid Declaration") + | 54: Msg("this symbol not expected in CR") + | 55: Msg("invalid CR") + diff --git a/src/tools/coco/CRS.Mod b/src/tools/coco/CRS.Mod index 2595bdad..d49fda37 100644 --- a/src/tools/coco/CRS.Mod +++ b/src/tools/coco/CRS.Mod @@ -7,7 +7,7 @@ CONST EOL = 0DX; EOF = 0X; maxLexLen = 127; - noSym = 38; + noSym = 41; TYPE ErrorProc* = PROCEDURE (n: INTEGER; pos: LONGINT); @@ -35,8 +35,11 @@ VAR PROCEDURE NextCh; (*return global variable ch*) BEGIN - Texts.Read(r, ch); INC(chPos); - IF ch = EOL THEN INC(chLine); lineStart := chPos + 1 END + IF oldEols > 0 THEN DEC(oldEols); ch := EOL + ELSE + Texts.Read(r, ch); INC(chPos); + IF ch = EOL THEN INC(chLine); lineStart := chPos + 1 END + END END NextCh; @@ -52,8 +55,9 @@ BEGIN (*Comment*) IF (ch ="*") THEN NextCh; IF (ch =")") THEN - DEC(level); oldEols := chLine - startLine; NextCh; - IF level=0 THEN RETURN TRUE END + DEC(level); + IF level=0 THEN oldEols := chLine - startLine; NextCh; RETURN TRUE END; + NextCh; END; ELSIF (ch ="(") THEN NextCh; @@ -79,33 +83,33 @@ VAR state: INTEGER; lexeme: ARRAY maxLexLen+1 OF CHAR; IF nextLen < maxLexLen THEN lexeme[nextLen] := 0X END; IF (lexeme[0] >= "A") & (lexeme[0] <= "W") THEN CASE lexeme[0] OF - | "A": IF lexeme = "ANY" THEN sym := 25 + | "A": IF lexeme = "ANY" THEN sym := 26 END - | "C": IF lexeme = "CASE" THEN sym := 19 - ELSIF lexeme = "CHARACTERS" THEN sym := 11 - ELSIF lexeme = "CHR" THEN sym := 22 - ELSIF lexeme = "COMMENTS" THEN sym := 14 - ELSIF lexeme = "COMPILER" THEN sym := 4 - ELSIF lexeme = "CONTEXT" THEN sym := 33 + | "C": IF lexeme = "CASE" THEN sym := 20 + ELSIF lexeme = "CHARACTERS" THEN sym := 12 + ELSIF lexeme = "CHR" THEN sym := 23 + ELSIF lexeme = "COMMENTS" THEN sym := 15 + ELSIF lexeme = "COMPILER" THEN sym := 5 + ELSIF lexeme = "CONTEXT" THEN sym := 34 END - | "E": IF lexeme = "END" THEN sym := 10 + | "E": IF lexeme = "END" THEN sym := 11 END - | "F": IF lexeme = "FROM" THEN sym := 15 + | "F": IF lexeme = "FROM" THEN sym := 16 END - | "I": IF lexeme = "IGNORE" THEN sym := 18 - ELSIF lexeme = "IMPORT" THEN sym := 5 + | "I": IF lexeme = "IGNORE" THEN sym := 19 + ELSIF lexeme = "IMPORT" THEN sym := 6 END - | "N": IF lexeme = "NESTED" THEN sym := 17 + | "N": IF lexeme = "NESTED" THEN sym := 18 END - | "P": IF lexeme = "PRAGMAS" THEN sym := 13 - ELSIF lexeme = "PRODUCTIONS" THEN sym := 7 + | "P": IF lexeme = "PRAGMAS" THEN sym := 14 + ELSIF lexeme = "PRODUCTIONS" THEN sym := 8 END - | "S": IF lexeme = "SYNC" THEN sym := 32 + | "S": IF lexeme = "SYNC" THEN sym := 33 END - | "T": IF lexeme = "TO" THEN sym := 16 - ELSIF lexeme = "TOKENS" THEN sym := 12 + | "T": IF lexeme = "TO" THEN sym := 17 + ELSIF lexeme = "TOKENS" THEN sym := 13 END - | "W": IF lexeme = "WEAK" THEN sym := 27 + | "W": IF lexeme = "WEAK" THEN sym := 28 END ELSE END @@ -129,42 +133,50 @@ BEGIN | 1: IF (ch>="0") & (ch<="9") OR (ch>="A") & (ch<="Z") OR (ch>="a") & (ch<="z") THEN ELSE sym := 1; CheckLiteral; RETURN END; - | 2: IF (ch<=CHR(12)) OR (ch>=CHR(14)) & (ch<="!") OR (ch>="#") THEN - ELSIF (ch =CHR(34)) THEN state := 3; - ELSE sym := noSym; RETURN - END; - | 3: sym := 2; RETURN - | 4: IF (ch<=CHR(12)) OR (ch>=CHR(14)) & (ch<="&") OR (ch>="(") THEN - ELSIF (ch ="'") THEN state := 3; - ELSE sym := noSym; RETURN + | 2: sym := 2; RETURN + | 3: sym := 3; RETURN + | 4: IF (ch>="0") & (ch<="9") THEN + ELSE sym := 4; RETURN END; | 5: IF (ch>="0") & (ch<="9") THEN - ELSE sym := 3; RETURN + ELSE sym := 42; RETURN END; - | 6: IF (ch>="0") & (ch<="9") THEN - ELSE sym := 39; RETURN + | 6: IF (ch<=CHR(12)) OR (ch>=CHR(14)) & (ch<="!") OR (ch>="#") THEN + ELSIF (ch=CHR(13)) THEN state := 3; + ELSIF (ch =CHR(34)) THEN state := 2; + ELSE sym := noSym; RETURN END; - | 7: sym := 6; RETURN - | 8: sym := 8; RETURN - | 9: IF (ch =")") THEN state := 22; - ELSE sym := 9; RETURN + | 7: IF (ch<=CHR(12)) OR (ch>=CHR(14)) & (ch<="&") OR (ch>="(") THEN + ELSIF (ch=CHR(13)) THEN state := 3; + ELSIF (ch ="'") THEN state := 2; + ELSE sym := noSym; RETURN + END; + | 8: sym := 7; RETURN + | 9: sym := 9; RETURN + | 10: IF (ch =">") THEN state := 23; + ELSIF (ch =")") THEN state := 25; + ELSE sym := 10; RETURN END; - | 10: sym := 20; RETURN | 11: sym := 21; RETURN - | 12: IF (ch =".") THEN state := 21; - ELSE sym := 23; RETURN + | 12: sym := 22; RETURN + | 13: IF (ch =".") THEN state := 24; + ELSE sym := 24; RETURN END; - | 13: sym := 24; RETURN - | 14: sym := 26; RETURN - | 15: sym := 28; RETURN + | 14: sym := 25; RETURN + | 15: sym := 27; RETURN | 16: sym := 29; RETURN | 17: sym := 30; RETURN | 18: sym := 31; RETURN - | 19: sym := 34; RETURN - | 20: sym := 35; RETURN + | 19: sym := 32; RETURN + | 20: IF (ch =".") THEN state := 22; + ELSE sym := 35; RETURN + END; | 21: sym := 36; RETURN | 22: sym := 37; RETURN - | 23: sym := 0; ch := 0X; RETURN + | 23: sym := 38; RETURN + | 24: sym := 39; RETURN + | 25: sym := 40; RETURN + | 26: sym := 0; ch := 0X; RETURN END (*CASE*) ELSE sym := noSym; RETURN (*NextCh already done*) @@ -195,7 +207,7 @@ BEGIN END Reset; BEGIN - start[0]:=23; start[1]:=0; start[2]:=0; start[3]:=0; + start[0]:=26; start[1]:=0; start[2]:=0; start[3]:=0; start[4]:=0; start[5]:=0; start[6]:=0; start[7]:=0; start[8]:=0; start[9]:=0; start[10]:=0; start[11]:=0; start[12]:=0; start[13]:=0; start[14]:=0; start[15]:=0; @@ -203,28 +215,29 @@ BEGIN start[20]:=0; start[21]:=0; start[22]:=0; start[23]:=0; start[24]:=0; start[25]:=0; start[26]:=0; start[27]:=0; start[28]:=0; start[29]:=0; start[30]:=0; start[31]:=0; - start[32]:=0; start[33]:=0; start[34]:=2; start[35]:=0; - start[36]:=6; start[37]:=0; start[38]:=0; start[39]:=4; - start[40]:=12; start[41]:=13; start[42]:=0; start[43]:=10; - start[44]:=0; start[45]:=11; start[46]:=9; start[47]:=0; - start[48]:=5; start[49]:=5; start[50]:=5; start[51]:=5; - start[52]:=5; start[53]:=5; start[54]:=5; start[55]:=5; - start[56]:=5; start[57]:=5; start[58]:=0; start[59]:=7; - start[60]:=19; start[61]:=8; start[62]:=20; start[63]:=0; + start[32]:=0; start[33]:=0; start[34]:=6; start[35]:=0; + start[36]:=5; start[37]:=0; start[38]:=0; start[39]:=7; + start[40]:=13; start[41]:=14; start[42]:=0; start[43]:=11; + start[44]:=0; start[45]:=12; start[46]:=10; start[47]:=0; + start[48]:=4; start[49]:=4; start[50]:=4; start[51]:=4; + start[52]:=4; start[53]:=4; start[54]:=4; start[55]:=4; + start[56]:=4; start[57]:=4; start[58]:=0; start[59]:=8; + start[60]:=20; start[61]:=9; start[62]:=21; start[63]:=0; start[64]:=0; start[65]:=1; start[66]:=1; start[67]:=1; start[68]:=1; start[69]:=1; start[70]:=1; start[71]:=1; start[72]:=1; start[73]:=1; start[74]:=1; start[75]:=1; start[76]:=1; start[77]:=1; start[78]:=1; start[79]:=1; start[80]:=1; start[81]:=1; start[82]:=1; start[83]:=1; start[84]:=1; start[85]:=1; start[86]:=1; start[87]:=1; - start[88]:=1; start[89]:=1; start[90]:=1; start[91]:=15; - start[92]:=0; start[93]:=16; start[94]:=0; start[95]:=0; + start[88]:=1; start[89]:=1; start[90]:=1; start[91]:=16; + start[92]:=0; start[93]:=17; start[94]:=0; start[95]:=0; start[96]:=0; start[97]:=1; start[98]:=1; start[99]:=1; start[100]:=1; start[101]:=1; start[102]:=1; start[103]:=1; start[104]:=1; start[105]:=1; start[106]:=1; start[107]:=1; start[108]:=1; start[109]:=1; start[110]:=1; start[111]:=1; start[112]:=1; start[113]:=1; start[114]:=1; start[115]:=1; start[116]:=1; start[117]:=1; start[118]:=1; start[119]:=1; - start[120]:=1; start[121]:=1; start[122]:=1; start[123]:=17; - start[124]:=14; start[125]:=18; start[126]:=0; start[127]:=0; + start[120]:=1; start[121]:=1; start[122]:=1; start[123]:=18; + start[124]:=15; start[125]:=19; start[126]:=0; start[127]:=0; + END CRS. diff --git a/src/tools/coco/CRT.Mod b/src/tools/coco/CRT.Mod index 45cc2c8b..e582a62a 100644 --- a/src/tools/coco/CRT.Mod +++ b/src/tools/coco/CRT.Mod @@ -1,6 +1,6 @@ -MODULE CRT; (* H.Moessenboeck 17.11.93, Cocol-R Tables *) +MODULE CRT; (* Cocol-R Tables *) -IMPORT Texts := CmdlnTexts, Oberon, Sets; +IMPORT Texts := CmdlnTexts,(* Oberon, Sets; CONST maxSymbols* = 300; (*max nr of t, nt, and pragmas*) @@ -27,7 +27,7 @@ TYPE Name* = ARRAY 16 OF CHAR; (*symbol name*) Position* = RECORD (*position of stretch of source text*) beg*: LONGINT; (*start relative to beginning of file*) - len*: INTEGER; (*length*) + len*: LONGINT; (*length*) col*: INTEGER; (*column number of start position*) END; @@ -129,7 +129,7 @@ BEGIN HALT(99) END Restriction; -PROCEDURE ClearMarkList(VAR m: MarkList); +PROCEDURE ClearMarkList*(VAR m: MarkList); VAR i: INTEGER; BEGIN i := 0; WHILE i < maxNodes DIV Sets.size DO m[i] := {}; INC(i) END; @@ -303,10 +303,10 @@ PROCEDURE CompFollowSets; WHILE j <= lastNt - firstNt DO (* for all nonterminals *) IF Sets.In(follow[i].nts, j) THEN Complete(j); Sets.Unite(follow[i].ts, follow[j].ts); - Sets.Excl(follow[i].nts, j) + IF i = curSy THEN Sets.Excl(follow[i].nts, j) END END; INC(j) - END; + END END Complete; BEGIN (* CompFollowSets *) @@ -323,7 +323,7 @@ BEGIN (* CompFollowSets *) INC(curSy) END; CompFol(root); (*curSy=lastNt+1*) - + curSy := 0; (*add indirect successors to follow.ts*) WHILE curSy <= lastNt - firstNt DO ClearMarkList(visited); Complete(curSy); @@ -945,9 +945,8 @@ PROCEDURE TestIfNtToTerm* (VAR ok: BOOLEAN); BEGIN WHILE gp > 0 DO GetNode(gp, gn); - IF (gn.typ = nt) & ~ Sets.In(termList, gn.p1) - OR (gn.typ = alt) & ~ IsTerm(gn.p1) & ~ IsTerm(gn.p2) THEN RETURN FALSE - END; + IF (gn.typ = nt) & ~ Sets.In(termList, gn.p1) THEN RETURN FALSE END; + IF (gn.typ = alt) & ~ IsTerm(gn.p1) & ((gn.p2 = 0) OR ~IsTerm(gn.p2)) THEN RETURN FALSE END; gp := gn.next END; RETURN TRUE @@ -992,3 +991,4 @@ BEGIN (* CRT *) gn[0].typ := -1; gn[0].p1 := 0; gn[0].p2 := 0; gn[0].next := 0; gn[0].line := 0; Texts.OpenWriter(w) END CRT. + diff --git a/src/tools/coco/CRX.Mod b/src/tools/coco/CRX.Mod index 9e2c567a..48969adb 100644 --- a/src/tools/coco/CRX.Mod +++ b/src/tools/coco/CRX.Mod @@ -1,11 +1,11 @@ -MODULE CRX; (* H.Moessenboeck 17.11.93 *) +MODULE CRX; -IMPORT Oberon, Texts := CmdlnTexts, Sets, CRS, CRT, SYSTEM; +IMPORT Oberon, Texts, Sets, CRS, CRT, SYSTEM; -CONST +CONST symSetSize = 100; maxTerm = 3; (* sets of size < maxTerm are enumerated *) - + tErr = 0; altErr = 1; syncErr = 2; EOL = 0DX; @@ -23,7 +23,7 @@ VAR PROCEDURE Restriction(n: INTEGER); BEGIN - Texts.WriteLn(w); Texts.WriteString(w, "Restriction "); + Texts.WriteLn(w); Texts.WriteString(w, "Restriction "); Texts.WriteInt(w, n, 0); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf); HALT(99) END Restriction; @@ -32,7 +32,7 @@ PROCEDURE PutS(s: ARRAY OF CHAR); VAR i: INTEGER; BEGIN i := 0; WHILE (i < LEN(s)) & (s[i] # 0X) DO - IF s[i] = "$" THEN Texts.WriteLn(syn) ELSE Texts.Write(syn, s[i]) END; + IF s[i] = "$" THEN Texts.WriteLn(syn) ELSE Texts.Write(syn, s[i]) END ; INC(i) END END PutS; @@ -52,9 +52,9 @@ BEGIN i := 0; first := TRUE; WHILE i < Sets.size DO IF i IN s THEN - IF first THEN first := FALSE ELSE Texts.Write(syn, ",") END; + IF first THEN first := FALSE ELSE Texts.Write(syn, ",") END ; PutI(i) - END; + END ; INC(i) END END PutSet; @@ -65,9 +65,9 @@ BEGIN i := 0; first := TRUE; WHILE i <= CRT.maxT DO IF Sets.In(s, i) THEN - IF first THEN first := FALSE ELSE Texts.Write(syn, ",") END; + IF first THEN first := FALSE ELSE Texts.Write(syn, ",") END ; PutI(i) - END; + END ; INC(i) END END PutSet1; @@ -75,7 +75,7 @@ END PutSet1; PROCEDURE Length*(s: ARRAY OF CHAR): INTEGER; VAR i: INTEGER; BEGIN - i:=0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END; + i:=0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END ; RETURN i END Length; @@ -85,7 +85,7 @@ BEGIN n := 0; WHILE gp > 0 DO CRT.GetNode(gp, gn); gp := gn.p2; INC(n) - END; + END ; RETURN n END Alternatives; @@ -97,7 +97,7 @@ BEGIN IF ch = startCh THEN (* check if stopString occurs *) i := 0; REPEAT - IF i = high THEN RETURN END; (*stopStr[0..i] found; no unrecognized character*) + IF i = high THEN RETURN END ; (*stopStr[0..i] found; no unrecognized character*) Texts.Read (fram, ch); INC(i); UNTIL ch # stopStr[i]; (*stopStr[0..i-1] found; 1 unrecognized character*) @@ -107,7 +107,7 @@ BEGIN END END CopyFramePart; -PROCEDURE CopySourcePart (pos: CRT.Position; indent: INTEGER); +PROCEDURE CopySourcePart (pos: CRT.Position; indent: INTEGER); (*Copy sequence from to *) VAR ch: CHAR; i: INTEGER; nChars: LONGINT; r: Texts.Reader; BEGIN @@ -118,13 +118,13 @@ BEGIN LOOP WHILE ch = EOL DO Texts.WriteLn(syn); Indent(indent); - IF nChars > 0 THEN Texts.Read(r, ch); DEC(nChars) ELSE EXIT END; + IF nChars > 0 THEN Texts.Read(r, ch); DEC(nChars) ELSE EXIT END ; i := pos.col; WHILE (ch = " ") & (i > 0) DO (* skip blanks at beginning of line *) - IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END; + IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END ; DEC(i) END - END; + END ; Texts.Write (syn, ch); IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END END @@ -135,18 +135,18 @@ BEGIN nChars := pos.len; col := pos.col - 1; ch := " "; WHILE (nChars > 0) & (ch = " ") DO (*skip leading blanks*) Texts.Read(r, ch); DEC(nChars); INC(col) - END; + END ; Indent(indent); LOOP WHILE ch = EOL DO Texts.WriteLn(syn); Indent(indent); - IF nChars > 0 THEN Texts.Read(r, ch); DEC(nChars) ELSE EXIT END; + IF nChars > 0 THEN Texts.Read(r, ch); DEC(nChars) ELSE EXIT END ; i := col - 1; WHILE (ch = " ") & (i > 0) DO (* skip blanks at beginning of line *) - IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END; + IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END ; DEC(i) END - END; + END ; Texts.Write (syn, ch); IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END END (* LOOP *) @@ -154,18 +154,18 @@ BEGIN END CopySourcePart; PROCEDURE GenErrorMsg (errTyp, errSym: INTEGER; VAR errNr: INTEGER); - VAR i: INTEGER; name: ARRAY 32 OF CHAR; sn: CRT.SymbolNode; + VAR i: INTEGER; name: ARRAY 32 OF CHAR; sn: CRT.SymbolNode; BEGIN INC (errorNr); errNr := errorNr; CRT.GetSym (errSym, sn); COPY(sn.name, name); - i := 0; WHILE name[i] # 0X DO IF name[i] = CHR(34) THEN name[i] := "'" END; INC(i) END; + i := 0; WHILE name[i] # 0X DO IF name[i] = CHR(34) THEN name[i] := "'" END ; INC(i) END ; Texts.WriteString(err, " |"); Texts.WriteInt (err, errNr, 3); Texts.WriteString (err, ": Msg("); Texts.Write(err, CHR(34)); CASE errTyp OF | tErr : Texts.WriteString (err, name); Texts.WriteString (err, " expected") | altErr : Texts.WriteString (err, "invalid "); Texts.WriteString (err, name) | syncErr: Texts.WriteString (err, "this symbol not expected in "); Texts.WriteString (err, name) - END; + END ; Texts.Write(err, CHR(34)); Texts.Write(err, ")"); Texts.WriteLn(err) END GenErrorMsg; @@ -174,27 +174,27 @@ PROCEDURE NewCondSet (set: CRT.Set): INTEGER; BEGIN i := 1; (*skip symSet[0]*) WHILE i <= maxSS DO - IF Sets.Equal(set, symSet[i]) THEN RETURN i END; - INC(i) - END; - INC(maxSS); IF maxSS > symSetSize THEN Restriction (9) END; + IF Sets.Equal(set, symSet[i]) THEN RETURN i END ; + INC(i) + END ; + INC(maxSS); IF maxSS > symSetSize THEN Restriction (9) END ; symSet[maxSS] := set; RETURN maxSS END NewCondSet; PROCEDURE GenCond (set: CRT.Set); VAR sx, i, n: INTEGER; - + PROCEDURE Small(s: CRT.Set): BOOLEAN; BEGIN i := Sets.size; WHILE i <= CRT.maxT DO - IF Sets.In(set, i) THEN RETURN FALSE END; + IF Sets.In(set, i) THEN RETURN FALSE END ; INC(i) - END; + END ; RETURN TRUE END Small; - + BEGIN n := Sets.Elements(set, i); (*IF n = 0 THEN PutS(" FALSE") (*this branch should never be taken*) @@ -206,11 +206,11 @@ BEGIN IF Sets.In (set, i) THEN PutS(" (sym = "); PutI(i); Texts.Write(syn, ")"); DEC(n); IF n > 0 THEN PutS(" OR") END - END; + END ; INC(i) END ELSE PutS(" sym IN symSet["); PutI(NewCondSet(set)); PutS(",0]") - END;*) + END ;*) IF n = 0 THEN PutS(" FALSE") (*this branch should never be taken*) ELSIF n <= maxTerm THEN i := 0; @@ -218,12 +218,12 @@ BEGIN IF Sets.In (set, i) THEN PutS(" (sym = "); PutI(i); Texts.Write(syn, ")"); DEC(n); IF n > 0 THEN PutS(" OR") END - END; + END ; INC(i) END ELSE PutS(" StartOf("); PutI(NewCondSet(set)); PutS(") ") - END; - + END ; + END GenCond; PROCEDURE GenCode (gp, indent: INTEGER; checked: CRT.Set); @@ -233,15 +233,15 @@ BEGIN WHILE gp > 0 DO CRT.GetNode (gp, gn); CASE gn.typ OF - + | CRT.nt: Indent(indent); CRT.GetSym(gn.p1, sn); PutS(sn.name); IF gn.pos.beg >= 0 THEN Texts.Write(syn, "("); CopySourcePart(gn.pos, 0); Texts.Write(syn, ")") - END; + END ; PutS(";$") - + | CRT.t: CRT.GetSym(gn.p1, sn); Indent(indent); IF Sets.In(checked, gn.p1) THEN @@ -249,32 +249,32 @@ BEGIN ELSE PutS("Expect("); PutI(gn.p1); PutS(");$") END - + | CRT.wt: CRT.CompExpected(ABS(gn.next), curSy, s1); CRT.GetSet(0, s2); Sets.Unite(s1, s2); CRT.GetSym(gn.p1, sn); Indent(indent); PutS("ExpectWeak("); PutI(gn.p1); PutS(", "); PutI(NewCondSet(s1)); PutS(");$") - + | CRT.any: Indent(indent); PutS("Get;$") - + | CRT.eps: (* nothing *) - - | CRT.sem: + + | CRT.sem: CopySourcePart(gn.pos, indent); PutS(";$"); | CRT.sync: CRT.GetSet(gn.p1, s1); GenErrorMsg (syncErr, curSy, errNr); - Indent(indent); + Indent(indent); PutS("WHILE ~("); GenCond(s1); PutS(") DO Error("); - PutI(errNr); PutS("); Get END;$") + PutI(errNr); PutS("); Get END ;$") | CRT.alt: CRT.CompFirstSet(gp, s1); equal := Sets.Equal(s1, checked); alts := Alternatives(gp); - IF alts > 5 THEN Indent(indent); PutS("CASE sym OF$") END; + IF alts > 5 THEN Indent(indent); PutS("CASE sym OF$") END ; gp2 := gp; WHILE gp2 # 0 DO CRT.GetNode(gp2, gn2); @@ -284,16 +284,16 @@ BEGIN ELSIF gp2 = gp THEN PutS("IF"); GenCond(s1); PutS(" THEN$") ELSIF (gn2.p2 = 0) & equal THEN PutS("ELSE$") ELSE PutS("ELSIF"); GenCond(s1); PutS(" THEN$") - END; + END ; Sets.Unite(s1, checked); GenCode(gn2.p1, indent + 2, s1); gp2 := gn2.p2 - END; + END ; IF ~ equal THEN GenErrorMsg(altErr, curSy, errNr); Indent(indent); PutS("ELSE Error("); PutI(errNr); PutS(")$") - END; - Indent(indent); PutS("END;$") + END ; + Indent(indent); PutS("END ;$") | CRT.iter: CRT.GetNode(gn.p1, gn2); @@ -302,58 +302,58 @@ BEGIN CRT.CompExpected(ABS(gn2.next), curSy, s1); CRT.CompExpected(ABS(gn.next), curSy, s2); CRT.GetSym(gn2.p1, sn); - PutS(" WeakSeparator("); PutI(gn2.p1); PutS(", "); PutI(NewCondSet(s1)); + PutS(" WeakSeparator("); PutI(gn2.p1); PutS(", "); PutI(NewCondSet(s1)); PutS(", "); PutI(NewCondSet(s2)); PutS(") "); Sets.Clear(s1); (*for inner structure*) IF gn2.next > 0 THEN gp2 := gn2.next ELSE gp2 := 0 END ELSE gp2 := gn.p1; CRT.CompFirstSet(gp2, s1); GenCond(s1) - END; + END ; PutS(" DO$"); GenCode(gp2, indent + 2, s1); - Indent(indent); PutS("END;$") + Indent(indent); PutS("END ;$") | CRT.opt: CRT.CompFirstSet(gn.p1, s1); IF ~ Sets.Equal(checked, s1) THEN Indent(indent); PutS("IF"); GenCond(s1); PutS(" THEN$"); GenCode(gn.p1, indent + 2, s1); - Indent(indent); PutS("END;$") + Indent(indent); PutS("END ;$") ELSE GenCode(gn.p1, indent, checked) END - END; (*CASE*) - IF ~ (gn.typ IN {CRT.eps, CRT.sem, CRT.sync}) THEN Sets.Clear(checked) END; + END ; (*CASE*) + IF ~ (gn.typ IN {CRT.eps, CRT.sem, CRT.sync}) THEN Sets.Clear(checked) END ; gp := gn.next END END GenCode; PROCEDURE GenCodePragmas; VAR i, p: INTEGER; sn: CRT.SymbolNode; - + PROCEDURE P(s1, s2: ARRAY OF CHAR); BEGIN PutS(" "); PutS(scanner); PutS(s1); PutS(" := "); PutS(scanner); PutS(s2); PutS(";$") END P; - + BEGIN i := CRT.maxT + 1; - WHILE i <= CRT.maxP DO + WHILE i <= CRT.maxP DO CRT.GetSym(i, sn); - PutS(" IF sym = "); PutI(i); PutS(" THEN$"); CopySourcePart(sn.semPos, 9); PutS("$ END;$"); + PutS(" IF sym = "); PutI(i); PutS(" THEN$"); CopySourcePart(sn.semPos, 9); PutS("$ END ;$"); INC(i) - END; + END ; P(".nextPos", ".pos"); P(".nextCol", ".col"); P(".nextLine", ".line"); P(".nextLen", ".len") END GenCodePragmas; PROCEDURE GenProcedureHeading (sn: CRT.SymbolNode; forward: BOOLEAN); BEGIN PutS("PROCEDURE "); - IF forward THEN Texts.Write(syn, "^") END; + IF forward THEN Texts.Write(syn, "^") END ; PutS(sn.name); - IF sn.attrPos.beg >= 0 THEN + IF sn.attrPos.beg >= 0 THEN Texts.Write(syn, "("); CopySourcePart(sn.attrPos, 0); Texts.Write(syn, ")") - END; + END ; PutS(";$") END GenProcedureHeading; @@ -365,7 +365,7 @@ BEGIN WHILE sp <= CRT.lastNt DO (* for all nonterminals *) CRT.GetSym (sp, sn); GenProcedureHeading(sn, TRUE); INC(sp) - END; + END ; Texts.WriteLn(syn) END END GenForwardRefs; @@ -376,26 +376,26 @@ BEGIN curSy := CRT.firstNt; WHILE curSy <= CRT.lastNt DO (* for all nonterminals *) CRT.GetSym (curSy, sn); GenProcedureHeading (sn, FALSE); - IF sn.semPos.beg >= 0 THEN CopySourcePart(sn.semPos, 2); PutS(" $") END; + IF sn.semPos.beg >= 0 THEN CopySourcePart(sn.semPos, 2); PutS(" $") END ; PutS("BEGIN$"); Sets.Clear(checked); - GenCode (sn.struct, 2, checked); + GenCode (sn.struct, 2, checked); PutS("END "); PutS(sn.name); PutS(";$$"); INC (curSy); - END; + END ; END GenProductions; PROCEDURE InitSets; VAR i, j: INTEGER; BEGIN i := 0; CRT.GetSet(0, symSet[0]); - WHILE i <= maxSS DO + WHILE i <= maxSS DO j := 0; WHILE j <= CRT.maxT DIV Sets.size DO - PutS(" symSet["); PutI(i); PutS(", ");PutI(j); + PutS(" symSet["); PutI(i); PutS(", ");PutI(j); PutS("] := {"); PutSet(symSet[i, j]); PutS("};$"); INC(j) - END; - INC(i) + END ; + INC(i) END END InitSets; @@ -406,29 +406,29 @@ PROCEDURE GenCompiler*; VAR errNr, i: INTEGER; checked: CRT.Set; gn: CRT.GraphNode; sn: CRT.SymbolNode; parser: ARRAY 32 OF CHAR; - t: Texts.Text; pos: LONGINT; + t: Texts.Text; pos: LONGINT; ch1, ch2: CHAR; BEGIN CRT.GetNode(CRT.root, gn); CRT.GetSym(gn.p1, sn); COPY(sn.name, parser); i := Length(parser); parser[i] := "P"; parser[i+1] := 0X; COPY(parser, scanner); scanner[i] := "S"; - + NEW(t); Texts.Open(t, "Parser.FRM"); Texts.OpenReader(fram, t, 0); IF t.len = 0 THEN Texts.WriteString(w, "Parser.FRM not found"); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf); HALT(99) - END; + END ; Texts.OpenWriter(err); Texts.WriteLn(err); i := 0; - WHILE i <= CRT.maxT DO GenErrorMsg(tErr, i, errNr); INC(i) END; + WHILE i <= CRT.maxT DO GenErrorMsg(tErr, i, errNr); INC(i) END ; (*----- write *P.Mod -----*) Texts.OpenWriter(syn); - NEW(t); (*t.notify := Show;*) Texts.Open(t, ""); + NEW(t); t.notify := Show; Texts.Open(t, ""); CopyFramePart("-->modulename"); PutS(parser); CopyFramePart("-->scanner"); PutS(scanner); - IF CRT.importPos.beg >= 0 THEN PutS(", "); CopySourcePart(CRT.importPos, 0) END; + IF CRT.importPos.beg >= 0 THEN PutS(", "); CopySourcePart(CRT.importPos, 0) END ; CopyFramePart("-->constants"); PutS("maxP = "); PutI(CRT.maxP); PutS(";$"); PutS(" maxT = "); PutI(CRT.maxT); PutS(";$"); @@ -444,7 +444,7 @@ BEGIN PutS(" ELSE EXIT$"); PutS(" END$"); PutS("END$") - END; + END ; CopyFramePart("-->productions"); GenForwardRefs; GenProductions; CopyFramePart("-->parseRoot"); Sets.Clear(checked); GenCode (CRT.root, 2, checked); CopyFramePart("-->initialization"); InitSets; @@ -472,3 +472,4 @@ END Init; BEGIN Texts.OpenWriter(w) END CRX. + diff --git a/src/tools/coco/Coco.Mod b/src/tools/coco/Coco.Mod index 9c3b4138..ff84d65e 100644 --- a/src/tools/coco/Coco.Mod +++ b/src/tools/coco/Coco.Mod @@ -19,7 +19,7 @@ ==========================================================================*) MODULE Coco; -IMPORT Oberon, (*TextFrames,*) Texts := CmdlnTexts,(* Viewers,*) CRS, CRP, CRT; +IMPORT Oberon, TextFrames, Texts, Viewers, CRS, CRP, CRT; CONST minErrDist = 8; @@ -42,55 +42,59 @@ BEGIN | 0: Msg("EOF expected") | 1: Msg("ident expected") | 2: Msg("string expected") - | 3: Msg("number expected") - | 4: Msg("'COMPILER' expected") - | 5: Msg("'IMPORT' expected") - | 6: Msg("';' expected") - | 7: Msg("'PRODUCTIONS' expected") - | 8: Msg("'=' expected") - | 9: Msg("'.' expected") - | 10: Msg("'END' expected") - | 11: Msg("'CHARACTERS' expected") - | 12: Msg("'TOKENS' expected") - | 13: Msg("'PRAGMAS' expected") - | 14: Msg("'COMMENTS' expected") - | 15: Msg("'FROM' expected") - | 16: Msg("'TO' expected") - | 17: Msg("'NESTED' expected") - | 18: Msg("'IGNORE' expected") - | 19: Msg("'CASE' expected") - | 20: Msg("'+' expected") - | 21: Msg("'-' expected") - | 22: Msg("'CHR' expected") - | 23: Msg("'(' expected") - | 24: Msg("')' expected") - | 25: Msg("'ANY' expected") - | 26: Msg("'|' expected") - | 27: Msg("'WEAK' expected") - | 28: Msg("'[' expected") - | 29: Msg("']' expected") - | 30: Msg("'{' expected") - | 31: Msg("'}' expected") - | 32: Msg("'SYNC' expected") - | 33: Msg("'CONTEXT' expected") - | 34: Msg("'<' expected") - | 35: Msg("'>' expected") - | 36: Msg("'(.' expected") - | 37: Msg("'.)' expected") - | 38: Msg("??? expected") - | 39: Msg("invalid TokenFactor") - | 40: Msg("invalid Factor") - | 41: Msg("invalid Factor") - | 42: Msg("invalid Term") - | 43: Msg("invalid Symbol") - | 44: Msg("invalid SimSet") - | 45: Msg("this symbol not expected in TokenDecl") - | 46: Msg("invalid TokenDecl") - | 47: Msg("invalid Declaration") - | 48: Msg("invalid Declaration") - | 49: Msg("invalid Declaration") - | 50: Msg("this symbol not expected in Coco") - | 51: Msg("invalid start of the program") + | 3: Msg("badString expected") + | 4: Msg("number expected") + | 5: Msg("'COMPILER' expected") + | 6: Msg("'IMPORT' expected") + | 7: Msg("';' expected") + | 8: Msg("'PRODUCTIONS' expected") + | 9: Msg("'=' expected") + | 10: Msg("'.' expected") + | 11: Msg("'END' expected") + | 12: Msg("'CHARACTERS' expected") + | 13: Msg("'TOKENS' expected") + | 14: Msg("'PRAGMAS' expected") + | 15: Msg("'COMMENTS' expected") + | 16: Msg("'FROM' expected") + | 17: Msg("'TO' expected") + | 18: Msg("'NESTED' expected") + | 19: Msg("'IGNORE' expected") + | 20: Msg("'CASE' expected") + | 21: Msg("'+' expected") + | 22: Msg("'-' expected") + | 23: Msg("'CHR' expected") + | 24: Msg("'(' expected") + | 25: Msg("')' expected") + | 26: Msg("'ANY' expected") + | 27: Msg("'|' expected") + | 28: Msg("'WEAK' expected") + | 29: Msg("'[' expected") + | 30: Msg("']' expected") + | 31: Msg("'{' expected") + | 32: Msg("'}' expected") + | 33: Msg("'SYNC' expected") + | 34: Msg("'CONTEXT' expected") + | 35: Msg("'<' expected") + | 36: Msg("'>' expected") + | 37: Msg("'<.' expected") + | 38: Msg("'.>' expected") + | 39: Msg("'(.' expected") + | 40: Msg("'.)' expected") + | 41: Msg("??? expected") + | 42: Msg("invalid TokenFactor") + | 43: Msg("invalid Factor") + | 44: Msg("invalid Factor") + | 45: Msg("invalid Term") + | 46: Msg("invalid Symbol") + | 47: Msg("invalid SimSet") + | 48: Msg("this symbol not expected in TokenDecl") + | 49: Msg("invalid TokenDecl") + | 50: Msg("invalid Attribs") + | 51: Msg("invalid Declaration") + | 52: Msg("invalid Declaration") + | 53: Msg("invalid Declaration") + | 54: Msg("this symbol not expected in CR") + | 55: Msg("invalid CR") ELSE Texts.WriteString(w, "error "); Texts.WriteInt(w, n, 0) END ELSE @@ -112,11 +116,13 @@ BEGIN | 215: Msg("undefined name") | 216: Msg("attributes not allowed in token declaration") | 217: Msg("name does not match name in heading") + | 218: Msg("bad string in semantic action") + | 219: Msg("Missing end of previous semantic action") | 220: Msg("token may be empty") | 221: Msg("token must not start with an iteration") | 222: Msg("only characters allowed in comment declaration") | 223: Msg("only terminals may be weak") - | 224: + | 224: Msg("tokens must not contain blanks") | 225: Msg("comment delimiter must not exceed 2 characters") | 226: Msg("character set contains more than one character") ELSE Texts.WriteString(w, "error "); Texts.WriteInt(w, n, 0) @@ -128,7 +134,7 @@ END Error; PROCEDURE Options(VAR s: Texts.Scanner); VAR i: INTEGER; BEGIN - IF s.nextCh = "/" THEN Texts.Scan(s); Texts.Scan(s); + IF s.nextCh = "\" THEN Texts.Scan(s); Texts.Scan(s); IF s.class = Texts.Name THEN i := 0; WHILE s.s[i] # 0X DO IF CAP(s.s[i]) = "X" THEN CRT.ddt[7] := TRUE @@ -142,19 +148,19 @@ END Options; PROCEDURE Compile*; - VAR (*v: Viewers.Viewer;*)(* f: TextFrames.Frame; *) s: Texts.Scanner; src, t: Texts.Text; + VAR v: Viewers.Viewer; f: TextFrames.Frame; s: Texts.Scanner; src, t: Texts.Text; pos, beg, end, time: LONGINT; i: INTEGER; BEGIN - (* Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s); + Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s); f := Oberon.Par.frame(TextFrames.Frame); src := NIL; pos := 0; IF (s.class = Texts.Char) & (s.c = "^") THEN Oberon.GetSelection(t, beg, end, time); IF time >= 0 THEN Texts.OpenScanner(s, t, beg); Texts.Scan(s) END - END;*) + END; IF s.class = Texts.Name THEN NEW(src); Texts.Open(src, s.s); - (*ELSIF (s.class = Texts.Char) & (s.c = "*") THEN + ELSIF (s.class = Texts.Char) & (s.c = "*") THEN v := Oberon.MarkedViewer(); IF (v # NIL) & (v.dsc.next IS TextFrames.Frame) THEN src := v.dsc.next(TextFrames.Frame).text; @@ -162,7 +168,7 @@ BEGIN END ELSIF (s.class = Texts.Char) & (s.c = "@") THEN Oberon.GetSelection(t, beg, end, time); - IF time >= 0 THEN src := t; pos := beg; s.s := " " END*) + IF time >= 0 THEN src := t; pos := beg; s.s := " " END END; IF src # NIL THEN Texts.WriteString (w, "Coco/R - Compiler-Compiler V2.2"); Texts.Append(Oberon.Log, w.buf); @@ -175,6 +181,6 @@ BEGIN END Compile; BEGIN - Texts.OpenWriter(w); - Compile; + Texts.OpenWriter(w) END Coco. + diff --git a/src/tools/coco/Coco.Report.ps.1 b/src/tools/coco/Coco.Report.ps.1 deleted file mode 100644 index bd8ddb7e..00000000 --- a/src/tools/coco/Coco.Report.ps.1 +++ /dev/null @@ -1,5 +0,0 @@ -%!PS-Adobe-2.0 %%Title: Report %%Creator: WriteNow 3.0 %%CreationDate: Donnerstag, 4. Februar 1993 %%Pages: (atend) %%BoundingBox: ? ? ? ? %%PageBoundingBox: 28 30 566 811 %%For: %%DocumentProcSets: "(AppleDict md)" 71 0 %% © Copyright Apple Computer, Inc. 1989-91 All Rights Reserved. %%EndComments %%BeginProcSet: "(AppleDict md)" 71 0 userdict/LW{save statusdict/product get(LaserWriter)anchorsearch exch pop{dup length 0 eq{pop 1}{( Plus)eq{2}{3}ifelse}ifelse}{0}ifelse exch restore}bind put userdict/downloadOK known not{userdict/downloadOK{systemdict dup/eexec known exch/cexec known and LW dup 1 ne exch 2 ne and and vmstatus exch sub exch pop 120000 gt and}bind put}if userdict/type42known known not{userdict/type42known systemdict/resourcestatus known{42/FontType resourcestatus{pop pop true}{false}ifelse }{false}ifelse put}if type42known not downloadOK and {userdict begin /*charpath /charpath load def/charpathflag false def/charpath{userdict/charpathflag true put userdict/*charpath get exec userdict/charpathflag false put}bind def end}if userdict/checkload known not{userdict/checkload{{pop exec} {save 3 dict begin/mystring 6050 string def exch/endstring exch def{currentfile mystring readline not{stop}if endstring eq{exit}if}loop end restore pop}ifelse}bind put}if userdict/LW+{LW 2 eq}bind put userdict/ok known not{userdict/ok{systemdict/statusdict known dup{LW 0 gt and}if}bind put}if systemdict/currentpacking known{currentpacking true setpacking}if /md 270 dict def md begin /av 71 def /T true def/F false def/mtx matrix def/s75 75 string def/sa8 8 string def/sb8 8 string def /sc8 8 string def/sd8 8 string def/s1 ( ) def/pxs 1 def/pys 1 def /ns false def 1 0 mtx defaultmatrix dtransform exch atan/pa exch def/nlw .24 def/ppr [-32 -29.52 762 582.48] def /pgr [0 0 0 0] def /pgs 1 def/por true def/xb 500 array def/so true def/tso true def/fillflag false def/pnm 1 def/fmv true def /sfl false def/ma 0 def/invertflag false def/dbinvertflag false def/xflip false def/yflip false def/noflips true def/scaleby96 false def/fNote true def/fBitStretch true def /4colors false def/fg (Rvd\001\001\000\000\177) def /bdf{bind def}bind def /xdf{exch def}bdf /xl{neg exch neg translate}bdf /fp{pnsh 0 ne pnsv 0 ne and}bdf /nop{}bdf/lnop[/nop load]cvx bdf /vrb[ {fp{fg 6 get 0 ne{gsave stroke grestore}{gsave 1 setlinewidth pnsh pnsv scale stroke grestore}ifelse}if newpath}bind /eofill load dup /newpath load 2 index dup {clip newpath}bind {}bind dup 2 copy ]def /sgd systemdict/setpagedevice known{{2 dict begin/PreRenderingEnhance exch def/Policies 1 dict dup/PreRenderingEnhance 1 put def currentdict end setpagedevice}}{{pop}}ifelse bdf /svsc systemdict/currentcolorscreen known{{currentcolorscreen/dkspf xdf/dkrot xdf/dkfreq xdf/dyspf xdf/dyrot xdf/dyfreq xdf/dmspf xdf/dmrot xdf/dmfreq xdf /dcspf xdf/dcrot xdf/dcfreq xdf}}{{currentscreen/spf xdf/rot xdf/freq xdf}}ifelse bdf /doop{vrb exch get exec}bdf /psu{/udf xdf/tso xdf /fNote xdf/fBitStretch xdf/scaleby96 xdf/yflip xdf/xflip xdf /invertflag xdf/dbinvertflag invertflag statusdict begin version cvr 47.0 ge product (LaserWriter) eq not and end invertflag and {not}if def xflip yflip or{/noflips false def}if /pgs xdf 2 index .72 mul exch div/pys xdf div .72 mul/pxs xdf ppr astore pop pgr astore pop/por xdf sn and/so xdf}bdf /tab{userdict /11x17 known{userdict begin /11x17 load exec end}{statusdict /setpage known{statusdict begin 792 1224 1 setpage end}{statusdict /setpageparams known{statusdict begin 792 1224 0 1 setpageparams end}if}ifelse}ifelse}bdf /a3Size{userdict /a3 known{userdict begin /a3 load exec end}{statusdict /setpageparams known{statusdict begin 842 1191 0 1 setpageparams end}if}ifelse}bdf /txpose{fNote{smalls}{bigs}ifelse pgs get exec pxs pys scale ppr aload pop por{noflips{pop exch neg exch translate pop 1 -1 scale}if xflip yflip and{pop exch neg exch translate 180 rotate 1 -1 scale ppr 3 get ppr 1 get neg sub neg ppr 2 get ppr 0 get neg sub neg translate}if xflip yflip not and{pop exch neg exch translate pop 180 rotate ppr 3 get ppr 1 get neg sub neg 0 translate}if yflip xflip not and{ppr 1 get neg ppr 0 get neg translate}if} {noflips{translate pop pop 270 rotate 1 -1 scale}if xflip yflip and{translate pop pop 90 rotate 1 -1 scale ppr 3 get ppr 1 get neg sub neg ppr 2 get ppr 0 get neg sub neg translate}if xflip yflip not and{translate pop pop 90 rotate ppr 3 get ppr 1 get neg sub neg 0 translate}if yflip xflip not and{translate pop pop 270 rotate ppr 2 get ppr 0 get neg sub neg 0 exch translate}if}ifelse statusdict begin/waittimeout where{pop waittimeout 300 lt{statusdict/waittimeout 300 put}if}if end scaleby96{ppr aload pop 4 -1 roll add 2 div 3 1 roll add 2 div 2 copy translate .96 dup scale neg exch neg exch translate}if}bdf /fr{4 copy pgr aload pop 3 -1 roll add 3 1 roll exch add 6 2 roll 3 -1 roll sub 3 1 roll exch sub 3 -1 roll exch div 3 1 roll div exch scale pop pop xl}bdf /obl{{0.212557 mul}{pop 0}ifelse}bdf /sfd{ps fg 5 -1 roll get mul 100 div 0 ps 5 -1 roll obl ps neg 0 0 6a astore makefont setfont}bdf /fnt{findfont sfd}bdf /bt{sa 3 1 roll 3 index and put}bdf /sa(\000\000\000\000\000\000\000\000\000\000)def /fs{0 1 bt 1 2 bt 2 4 bt 3 8 bt 4 16 bt 5 32 bt 6 64 bt 7 128 bt sa exch 8 exch put}bdf /mx1 matrix def /mx2 matrix def /mx3 matrix def /bu{currentpoint 4colors{currentcmykcolor}{currentrgbcolor}ifelse currentlinewidth currentlinecap currentlinejoin currentdash exch aload length fg 5 sfl{1}{0}ifelse put pnsv pnsh 2t aload pop 3a aload pop mx2 aload pop mx1 aload pop mtx currentmatrix aload pop mx3 aload pop ps pm restore/ps xdf mx3 astore pop}bdf /bn{/pm save def mx3 setmatrix newpath 0 0 moveto ct dup 39 get 0 exch getinterval cvx exec mtx astore setmatrix mx1 astore pop mx2 astore pop 3a astore pop 2t astore pop/pnsh xdf/pnsv xdf gw /sfl fg 5 get 0 ne def array astore exch setdash setlinejoin setlinecap setlinewidth 4colors{mysetcmykcolor}{setrgbcolor}ifelse moveto}bdf /fc{save vmstatus exch sub 50000 lt {(%%[|0|]%%)=print flush}if pop restore}bdf /tc{32768 div add 3 1 roll 32768 div add 2t astore pop}bdf /3a [0 0 0] def /2t 2 array def /tp{3a astore pop}bdf /tt{mx2 currentmatrix pop currentpoint 2 copy 2t aload pop qa 2 copy translate 3a aload pop exch dup 0 eq {pop}{1 eq{-1 1}{1 -1}ifelse scale}ifelse rotate pop neg exch neg exch translate moveto}bdf /te{mx2 setmatrix}bdf /th{3 -1 roll div 3 1 roll exch div 2 copy mx1 scale pop scale/sfl true def}bdf /tu{1 1 mx1 itransform scale/sfl false def}bdf /ts{1 1 mx1 transform scale/sfl true def}bdf /fz{/ps xdf}bdf /dv{dup 0 ne{div}{pop}ifelse}bdf /pop4{pop pop pop pop}bdf /it{sfl{mx1 itransform}if}bdf /gm{exch it moveto}bdf/rm{it rmoveto}bdf /lm{currentpoint sfl{mx1 transform}if exch pop sub 0 exch it rmoveto}bdf /fm{statusdict/manualfeed known}bdf /se{statusdict exch/manualfeed exch put}bdf /mf{dup/ma exch def 0 gt{fm se/t1 5 st ok ma 1 gt and{/t2 0 st/t3 0 st statusdict/manualfeedtimeout 3600 put }if}if}bdf /jn{/statusdict where exch pop{statusdict exch /jobname exch put}if}bdf /pen{pnm mul/pnsh xdf pnm mul/pnsv xdf pnsh setlinewidth}bdf /min{2 copy gt{exch}if pop}bdf /max{2 copy lt{exch}if pop}bdf /dh{fg 6 1 put array astore dup {1 pxs div mul exch}forall astore exch pop exch pop exch setdash}bdf /ih[currentdash]def /rh{fg 6 0 put ih aload pop setdash}bdf /dl{gsave nlw pys div setlinewidth 0 setgray}bdf /dlin{exch currentpoint currentlinewidth 2 div dup translate newpath moveto lineto currentpoint stroke grestore moveto}bdf /lin{fg 6 get 0 ne{exch lineto currentpoint 0 doop moveto} {exch currentpoint/pnlv xdf/pnlh xdf gsave newpath/@1 xdf/@2 xdf fp{pnlh @2 lt{pnlv @1 ge {pnlh pnlv moveto @2 @1 lineto pnsh 0 rlineto 0 pnsv rlineto pnlh pnsh add pnlv pnsv add lineto pnsh neg 0 rlineto} {pnlh pnlv moveto pnsh 0 rlineto @2 pnsh add @1 lineto 0 pnsv rlineto pnsh neg 0 rlineto pnlh pnlv pnsv add lineto}ifelse}{pnlv @1 gt {@2 @1 moveto pnsh 0 rlineto pnlh pnsh add pnlv lineto 0 pnsv rlineto pnsh neg 0 rlineto @2 @1 pnsv add lineto}{pnlh pnlv moveto pnsh 0 rlineto 0 pnsv rlineto @2 pnsh add @1 pnsv add lineto pnsh neg 0 rlineto 0 pnsv neg rlineto}ifelse}ifelse closepath fill}if @2 @1 grestore moveto}ifelse}bdf /gw{/pnm fg 3 get fg 4 get div def}bdf /lw{fg exch 4 exch put fg exch 3 exch put gw pnsv pnsh pen}bdf /barc{/@1 xdf/@2 xdf/@3 xdf/@4 xdf/@5 xdf /@6 xdf/@7 xdf/@8 xdf gsave @5 @7 add 2 div @6 @8 add 2 div translate newpath 0 0 moveto @5 @7 sub @6 @8 sub mtx currentmatrix pop scale @1{newpath}if 0 0 0.5 @4 @3 arc @4 @3 sub abs 360 ge{closepath}if mtx setmatrix @2 doop grestore}bdf /ar{dup 0 eq barc}bdf /ov{0 exch 360 exch true barc}bdf /rc{dup/@t xdf 0 eq{4 copy 3 -1 roll eq 3 1 roll eq and{pnsv 2 div sub exch pnsh 2 div sub exch 4 2 roll pnsv 2 div add exch pnsh 2 div add exch /@t 1 def}if}if currentpoint 6 2 roll newpath 4 copy 4 2 roll exch moveto 6 -1 roll lineto lineto lineto closepath @t doop moveto}bdf /mup{dup pnsh 2 div le exch pnsv 2 div le or}bdf /rr{/@1 xdf 2. div/@2 xdf 2. div/@3 xdf /@4 xdf/@5 xdf/@6 xdf/@7 xdf @7 @5 eq @6 @4 eq @2 mup or or{@7 @6 @5 @4 @1 rc} {@4 @6 sub 2. div dup @2 lt{/@2 xdf}{pop}ifelse @5 @7 sub 2. div dup @2 lt{/@2 xdf}{pop}ifelse @1 0 eq{/@2 @2 pnsh 2 div 2 copy gt{sub def}{0 pop4}ifelse}if currentpoint newpath @4 @6 add 2. div @7 moveto @4 @7 @4 @5 @2 arcto pop4 @4 @5 @6 @5 @2 arcto pop4 @6 @5 @6 @7 @2 arcto pop4 @6 @7 @4 @7 @2 arcto pop4 closepath @1 doop moveto}ifelse}bdf /pr{gsave newpath/pl{exch moveto/pl{exch lineto}def}def}bdf /pl{exch lineto}bdf /ep{dup 0 eq{{moveto}{exch lin}{}{(%%[|1|]%%)= flush}pathforall pop grestore}{doop grestore}ifelse currentpoint newpath moveto}bdf /gr{64. div setgray}bdf /savescreen{ns not{/ns true def systemdict/currentcolorscreen known{currentcolorscreen/pkspf xdf/pkrot xdf/pkfreq xdf/pyspf xdf/pyrot xdf/pyfreq xdf/pmspf xdf/pmrot xdf/pmfreq xdf /pcspf xdf/pcrot xdf/pcfreq xdf}{currentscreen/sspf xdf/srot xdf/sfreq xdf}ifelse}if}bdf /restorescreen{/ns false def systemdict/setcolorscreen known{pcfreq pcrot/pcspf load pmfreq pmrot/pmspf load pyfreq pyrot/pyspf load pkfreq pkrot/pkspf load setcolorscreen}{sfreq srot/sspf load setscreen}ifelse}bdf /pat{savescreen sa8 copy pop 9.375 pa por not{90 add}if{1 add 4 mul cvi sa8 exch get exch 1 add 4 mul cvi 7 sub bitshift 1 and}setscreen exch not{gr}{pop}ifelse}bdf /sg{restorescreen gr}bdf /cpat{savescreen 10 2 roll 7 -1 roll sa8 copy pop 9.375 pa por not{90 add}if{1 add 4 mul cvi sa8 exch get exch 1 add 4 mul cvi 7 sub bitshift 1 and}8 -1 roll sb8 copy pop 9.375 pa por not{90 add}if{1 add 4 mul cvi sb8 exch get exch 1 add 4 mul cvi 7 sub bitshift 1 and}9 -1 roll sc8 copy pop 9.375 pa por not{90 add}if{1 add 4 mul cvi sc8 exch get exch 1 add 4 mul cvi 7 sub bitshift 1 and}10 -1 roll sd8 copy pop 9.375 pa por not{90 add}if{1 add 4 mul cvi sd8 exch get exch 1 add 4 mul cvi 7 sub bitshift 1 and}psuedo1 dsc 4{4 -1 roll 1 exch 64 div sub}repeat mysetcmykcolor pop pop}bdf systemdict/setcolorscreen known{/psuedo1 lnop bdf/dsc/setcolorscreen load def}{/psuedo1{16{pop}repeat sa8 copy pop 9.375 pa por not{90 add}if{1 add 4 mul cvi sa8 exch get exch 1 add 4 mul cvi 7 sub bitshift 1 and}}bdf /bwsc{setscreen dup gr 0 exch 0 exch 64 exch 64 exch 64 exch}bdf/dsc/bwsc load def }ifelse systemdict/setcmykcolor known{/mysetcmykcolor /setcmykcolor load def}{/mysetcmykcolor{1 sub 4 1 roll 3{3 index add neg dup 0 lt{pop 0}if 3 1 roll}repeat setrgbcolor pop}bdf}ifelse /dc{transform round .5 sub exch round .5 sub exch itransform}bdf /sn{userdict/smooth4 known}bdf /x8{3 bitshift}bdf /x4{2 bitshift}bdf /d4{-2 bitshift}bdf /d8{-3 bitshift}bdf /rb{15 add -4 bitshift 1 bitshift}bdf /db{/@7 save def/@1 xdf/@2 xdf/@3 xdf/@4 xdf/@5 xdf/@6 @5 @3 4 add mul def dc translate scale/xdbit 1 1 idtransform abs/ydbit exch def abs def{0 0 1 ydbit add 1 10 rc clip}if @1 0 eq @1 4 eq or{currentrgbcolor 1 setgray ydbit 0 1 ydbit add 1 2 rc setrgbcolor}if @1 3 eq @1 7 eq or{1 setgray}{currentrgbcolor 2 index eq exch 2 index eq and exch pop{0 setgray}if}ifelse/@9 @1 0 eq @1 1 eq @1 3 eq or or dbinvertflag xor def/@13 @6 def @2 fBitStretch or{/@10 @4 x4 def/@11 @3 x4 def/@12 @10 rb def/@13 @12 @11 mul def/@15 1 1 dtransform abs/calcY 1 index def round cvi/@14 exch def abs/calcX 1 index def round cvi scaleby96 not{1 add}if def/@16 @15 rb def/@17 @16 @14 mul def}if sn @13 60000 lt and @2 fBitStretch or and{mtx currentmatrix dup 1 get exch 2 get 0. eq exch 0. eq and @17 60000 lt and fBitStretch and{@16 3 bitshift @14 @9 [calcX 0 0 calcY 0 0]{@17 string @13 string currentfile @6 string readhexstring pop 1 index @4 @3 @5 @12 @2 smooth4 @10 @11 @12 dup string 5 index @15 @14 @16 dup string stretch}imagemask}{@12 x8 @11 @9 [@10 0 0 @11 0 0]{@13 string currentfile @6 string readhexstring pop 1 index @4 @3 @5 @12 @2 smooth4}imagemask}ifelse}{@5 3 bitshift @3 4 add @9 [@4 0 0 @3 0 2]{currentfile @6 string readhexstring pop}imagemask}ifelse @7 restore}bdf systemdict/setcmykcolor known{/psuedo lnop bdf/di/colorimage load def}{/routines[{.3 mul add 1}bind{.59 mul add 2}bind{.11 mul add round cvi str exch i exch put/i i 1 add def 0 0}bind]def /psuedo{/i 0 def 0 exch 0 exch{exch routines exch get exec}forall pop pop str}bdf/bwi{pop pop image}bdf/di/bwi load def}ifelse /cdb{/@7 save def/@1 xdf/@2 xdf/@3 xdf/@4 xdf/@5 xdf systemdict/setcmykcolor known not{dc}if translate scale /@6 xdf /@18 @5 dup 60000 ge{pop 60000}if string def @6 not{/str @18 0 @18 length 3 idiv getinterval def}if @4 @3 8 [@4 0 0 @3 0 0]@6{{currentfile @18 readhexstring pop}image}{{currentfile @18 readhexstring pop psuedo}false 3 di}ifelse @7 restore}bdf /wd 16 dict def /mfont 14 dict def /mdf{mfont wcheck not{/mfont 14 dict def}if mfont begin xdf end}bdf /cf{{1 index/FID ne{def}{pop pop}ifelse}forall}bdf/rf{/@1 exch def/@2 exch def FontDirectory @2 known{cleartomark pop}{findfont dup begin dup length @1 add dict begin cf{/Encoding macvec def}{Encoding dup length array copy/Encoding exch def counttomark 2 idiv{Encoding 3 1 roll put}repeat}ifelse pop exec currentdict end end @2 exch definefont pop}ifelse}bdf /bmbc{exch begin wd begin /cr xdf save CharTable cr 6 mul 6 getinterval{}forall /bitheight xdf/bitwidth xdf .96 div/width xdf Gkernmax add/XOffset xdf Gdescent add/YOffset xdf/rowbytes xdf rowbytes 255 eq{0 0 0 0 0 0 setcachedevice} {Gnormsize dup scale width 0 XOffset YOffset bitwidth XOffset add bitheight YOffset add setcachedevice rowbytes 0 ne{ XOffset YOffset translate newpath 0 0 moveto bitwidth bitheight scale sn{ /xSmt bitwidth x4 def /ySmt bitheight x4 def /rSmt xSmt rb def rSmt x8 ySmt true [xSmt 0 0 ySmt neg 0 ySmt] {rSmt ySmt mul string CharData cr get 1 index bitwidth bitheight rowbytes rSmt tso smooth4} }{rowbytes 3 bitshift bitheight 4 add true [bitwidth 0 0 bitheight neg 0 bitheight 2 add] {CharData cr get} }ifelse imagemask }if }ifelse restore end end }bdf /bb{.96 exch div/Gnormsize mdf 2 index /Gkernmax mdf 1 index/Gdescent mdf 3 index div 4 1 roll 2 index div 1. 5 2 roll exch div 4 1 roll 4 array astore/FontBBox mdf }bdf /cdf{mfont/CharData get 3 1 roll put}bdf /bf{ mfont begin /FontType 3 def /FontMatrix [1 0 0 1 0 0] def /Encoding macvec def /MFontType 0 def /BuildChar/bmbc load def end mfont definefont pop }bdf /wi LW 1 eq{{gsave 0 0 0 0 0 0 0 0 moveto lineto lineto lineto closepath clip stringwidth grestore}bind}{/stringwidth load}ifelse def /aps{0 get 124 eq}bdf /xc{s75 cvs dup}bdf /xp{put cvn}bdf /scs{xc 3 67 put dup 0 95 xp}bdf /sos{xc 3 79 xp}bdf /sbs{xc 1 66 xp}bdf /sis{xc 2 73 xp}bdf /sob{xc 2 79 xp}bdf /sss{xc 4 83 xp}bdf /dd{exch 1 index add 3 1 roll add exch}bdf /smc{moveto dup show}bdf /ndf2{udf{dup /FontType get 0 eq{/FDepVector get{dup /FontType get 0 eq{ndf2}{dup /df2 known{begin df2 0 null put end }{pop}ifelse}ifelse}forall}{/df2 known{dup begin df2 0 null put end}if}ifelse}{pop}ifelse}bdf /kwn{FontDirectory 1 index known{findfont dup ndf2 exch pop}}bdf /gl{1 currentgray sub setgray}bdf /newmm{dup /FontType get 0 eq{dup maxlength dict begin{1 index/FID ne 2 index/UniqueID ne and{def}{pop pop}ifelse}forall currentdict end dup /FDepVector 2 copy get[exch 6 index exch 6 index exch{newmm 3 1 roll}forall pop pop] put dup }{/mfont 10 dict def mfont begin/FontMatrix [1 0 0 1 0 0] def /FontType 3 def/Encoding macvec def/df 1 index def/df2 1 array def/FontBBox [0 0 1 1] def/StyleCode 2 index def /mbc{bcarray StyleCode get}def/BuildChar{exch begin wd begin/cr exch def/cs s1 dup 0 cr put def df /MFontType known not{ df2 0 get null eq{df dup length 2 add dict begin{1 index/FID ne 2 index/UniqueID ne and{def}{pop pop}ifelse}forall /StrokeWidth 1 0 FontMatrix idtransform pop dup nlw mul pys div ps div exch 0.012 mul 2 copy le{exch}if pop def/PaintType 2 def currentdict end /q exch definefont df2 exch 0 exch put}if}if mbc exec end end}def end mfont}ifelse 3 index exch definefont exch pop}bdf /mb{dup sbs kwn{0 2 index findfont newmm exch pop exch pop exch pop}ifelse sfd}bdf /mo{dup sos kwn{2 2 index findfont newmm exch pop exch pop exch pop}ifelse sfd}bdf /ms{dup sss kwn{4 2 index findfont newmm exch pop exch pop exch pop}ifelse sfd}bdf /ou{dup sos kwn{mfont/df2 known{mfont begin df2 0 null put end}if 3 2 index findfont newmm exch pop exch pop exch pop}ifelse sfd}bdf /su{dup sss kwn{mfont/df2 known{mfont begin df2 0 null put end}if 5 2 index findfont newmm exch pop exch pop exch pop}ifelse sfd}bdf /ao{/fmv true def ou}bdf/as{/fmv true def su}bdf /vo{/fmv false def ou}bdf/vs{/fmv false def su}bdf /c{currentrgbcolor dup 4 1 roll eq 3 1 roll eq and/gray xdf}bdf /bcarray[{/da .03 def df setfont gsave cs wi 1 index 0 ne{exch da add exch}if grestore setcharwidth cs 0 0 smc da 0 smc da da smc 0 da moveto show}bind dup{/da 1 ps div def df setfont gsave cs wi 1 index 0 ne{exch da add exch}if grestore setcharwidth cs 0 0 smc da 0 smc da da smc 0 da smc c gray{gl}{1 setgray}ifelse da 2. div dup moveto show}bind {df setfont gsave cs wi grestore setcharwidth c gray{gl}{currentrgbcolor 1 setgray}ifelse cs 0 0 smc df2 0 get setfont gray{gl}{4 1 roll setrgbcolor}ifelse 0 0 moveto show}bind {/da 1 ps div def/ds .05 def/da2 da 2. div def df setfont gsave cs wi 1 index 0 ne{exch ds add da2 add exch}if grestore setcharwidth cs ds da2 add .01 add 0 smc 0 ds da2 sub translate 0 0 smc da 0 smc da da smc 0 da smc c gray{gl}{1 setgray}ifelse da 2. div dup moveto show}bind {/da .05 def df setfont gsave cs wi 1 index 0 ne{exch da add exch}if grestore setcharwidth c cs da .01 add 0 smc 0 da translate gray{gl}{currentrgbcolor 1 setgray 4 -1 roll}ifelse 0 0 smc gray{gl}{4 1 roll setrgbcolor}ifelse df2 0 get setfont 0 0 moveto show}bind]def /st{1000 mul usertime add dup 2147483647 gt{2147483647 sub}if def}bdf /the{usertime sub dup 0 lt exch -2147483648 gt and}bdf /6a 6 array def /2a 2 array def /3q 3 array def /qs{3 -1 roll sub exch 3 -1 roll sub exch}bdf /qa{3 -1 roll add exch 3 -1 roll add exch}bdf /qm{3 -1 roll 1 index mul 3 1 roll mul}bdf /qn{6a exch get mul}bdf /qA .166667 def/qB .833333 def/qC .5 def /qx{6a astore pop qA 0 qn qB 2 qn add qA 1 qn qB 3 qn add qB 2 qn qA 4 qn add qB 3 qn qA 5 qn add qC 2 qn qC 4 qn add qC 3 qn qC 5 qn add}bdf /qp{6 copy 12 -2 roll pop pop}bdf /qc{exch qp qx curveto}bdf /qi{{exch 4 copy 2a astore aload pop qa .5 qm newpath moveto}{exch 2 copy 6 -2 roll 2 qm qs 4 2 roll}ifelse}bdf /qq{{qc 2a aload pop qx curveto}{exch 4 copy qs qa qx curveto}ifelse}bdf /pt{currentpoint newpath moveto}bdf /qf{/fillflag true def}bdf /ec{dup 4 and 0 ne{closepath}if 1 and 0 ne{0 doop}if grestore currentpoint newpath moveto/fillflag false def}bdf /eu{currentpoint fp{0 ep}{grestore newpath}ifelse moveto/fillflag false def}bdf /bp{currentpoint newpath 2 copy moveto}bdf /ef{gsave fillflag{gsave eofill grestore}if}bdf /sm{0 exch{@1 eq{1 add}if}forall}bdf /lshow{4 1 roll exch/@1 exch def{1 index wi pop sub 1 index sm dv 0 @1 4 -1 roll widthshow}{1 index wi pop sub 1 index dup sm 10 mul exch length 1 sub add dv dup 10. mul 0 @1 4 -1 roll 0 6 -1 roll awidthshow}ifelse}bdf /setTxMode{sa 9 2 index put exch not{3 eq{1}{0}ifelse setgray}{pop}ifelse}bdf /SwToSym{{}mark false/Symbol/|______Symbol 0 rf 0 sa 6 get 0 ne{pop 1}{sa 7 get 0 eq{pop 2}if}ifelse sa 1 get 0 ne/|______Symbol sa 4 get 0 ne{vs}{sa 3 get 0 ne{vo}{fnt}ifelse}ifelse}bdf /mc{0 3 1 roll transform neg exch pop}bdf /ul{dup 0 ne sa 2 get 0 ne and{gsave 0 0 /UnderlinePosition kif{mc}{ps -10 div}ifelse/UnderlineThickness kif{mc}{ps 15 div}ifelse abs setlinewidth neg rmoveto sa 4 get 0 ne{gsave currentlinewidth 2. div dup rmoveto currentpoint newpath moveto 2 copy rlineto stroke grestore}if sa 3 get sa 4 get or 0 ne{gsave currentrgbcolor dup 4 1 roll eq 3 1 roll eq and{gl}{1 setgray}ifelse 2 copy rlineto stroke grestore rlineto strokepath nlw pys div setlinewidth}{rlineto}ifelse stroke grestore}{pop}ifelse}bdf /sgt{2 copy known{get true}{pop pop false}ifelse}bdf /kif{currentfont dup/FontMatrix get exch/FontInfo sgt{true}{currentfont/df sgt {dup/FontInfo sgt{3 1 roll/FontMatrix get mtx concatmatrix exch true}{pop pop pop false} ifelse}{pop pop false}ifelse}ifelse{3 -1 roll sgt{exch true}{pop false}ifelse}{false}ifelse}bdf /blank/Times-Roman findfont/CharStrings get/space get def /macvec 256 array def /NUL/SOH/STX/ETX/EOT/ENQ/ACK/BEL/BS/HT/LF/VT/FF/CR/SO/SI /DLE/DC1/DC2/DC3/DC4/NAK/SYN/ETB/CAN/EM/SUB/ESC/FS/GS/RS/US macvec 0 32 getinterval astore pop macvec 32/Times-Roman findfont/Encoding get 32 96 getinterval putinterval macvec dup 39/quotesingle put 96/grave put /Adieresis/Aring/Ccedilla/Eacute/Ntilde/Odieresis/Udieresis/aacute /agrave/acircumflex/adieresis/atilde/aring/ccedilla/eacute/egrave /ecircumflex/edieresis/iacute/igrave/icircumflex/idieresis/ntilde/oacute /ograve/ocircumflex/odieresis/otilde/uacute/ugrave/ucircumflex/udieresis /dagger/degree/cent/sterling/section/bullet/paragraph/germandbls /registered/copyright/trademark/acute/dieresis/notequal/AE/Oslash /infinity/plusminus/lessequal/greaterequal/yen/mu/partialdiff/summation /product/pi/integral/ordfeminine/ordmasculine/Omega/ae/oslash /questiondown/exclamdown/logicalnot/radical/florin/approxequal/Delta/guillemotleft /guillemotright/ellipsis/blank/Agrave/Atilde/Otilde/OE/oe /endash/emdash/quotedblleft/quotedblright/quoteleft/quoteright/divide/lozenge /ydieresis/Ydieresis/fraction/currency/guilsinglleft/guilsinglright/fi/fl /daggerdbl/periodcentered/quotesinglbase/quotedblbase/perthousand/Acircumflex/Ecircumflex/Aacute /Edieresis/Egrave/Iacute/Icircumflex/Idieresis/Igrave/Oacute/Ocircumflex /apple/Ograve/Uacute/Ucircumflex/Ugrave/dotlessi/circumflex/tilde /macron/breve/dotaccent/ring/cedilla/hungarumlaut/ogonek/caron macvec 128 128 getinterval astore pop {}mark true/Courier/|______Courier 0 rf {/Metrics 21 dict begin/zero 600 def/one 600 def/two 600 def/three 600 def/four 600 def/five 600 def/six 600 def/seven 600 def/eight 600 def /nine 600 def/comma 600 def/period 600 def/dollar 600 def/numbersign 600 def/percent 600 def/plus 600 def/hyphen 600 def/E 600 def/parenleft 600 def/parenright 600 def/space 600 def currentdict end def currentdict/UniqueID known{/UniqueID 16#800000 def}if/FontBBox FontBBox 4 array astore def}mark true/Helvetica/|______Seattle 1 rf /oldsettransfer/settransfer load def /concatprocs{/proc2 exch cvlit def/proc1 exch cvlit def/newproc proc1 length proc2 length add array def newproc 0 proc1 putinterval newproc proc1 length proc2 putinterval newproc cvx}def /settransfer{currenttransfer concatprocs oldsettransfer}def /PaintBlack{{1 exch sub}settransfer gsave newpath clippath 1 setgray fill grestore}def /od{(Rvd\001\001\000\000\177) fg copy pop txpose 1 0 mtx defaultmatrix dtransform exch atan/pa exch def newpath clippath mark {transform{itransform moveto}}{transform{itransform lineto}} {6 -2 roll transform 6 -2 roll transform 6 -2 roll transform {itransform 6 2 roll itransform 6 2 roll itransform 6 2 roll curveto}} {{closepath}}pathforall newpath counttomark array astore/gc xdf pop ct 39 0 put 10 fz 0 fs 2 F/|______Courier fnt invertflag{PaintBlack}if statusdict/processcolors known{statusdict begin processcolors end 4 eq{/4colors true def}if}if}bdf /cd{}bdf /op{/sfl false def systemdict/currentcolorscreen known{dcfreq dcrot/dcspf load dmfreq dmrot/dmspf load dyfreq dyrot/dyspf load dkfreq dkrot/dkspf load setcolorscreen}{freq rot/spf load setscreen}ifelse savescreen /ns false def/pm save def}bdf /cp{not{userdict/#copies 0 put}if ma 0 gt{{t1 the{exit}if}loop}if{/copypage load exec}{/showpage load exec}ifelse pm restore}bdf /px{0 3 1 roll tp tt}bdf /psb{/us save def}bdf /pse{us restore}bdf /ct 40 string def /nc{currentpoint initclip newpath gc{dup type dup/arraytype eq exch/packedarraytype eq or{exec}if} forall clip newpath moveto}def /kp{ct 0 2 index length 2 index 39 2 index put getinterval copy cvx exec mx3 currentmatrix pop}bdf end LW 1 eq userdict/a4small known not and{/a4small [[300 72 div 0 0 -300 72 div -120 3381] 280 3255 {statusdict/jobstate (printing) put 0 setblink margins exch 196 add exch 304 add 8 div round cvi frametoroket statusdict/jobstate (busy) put 1 setblink} /framedevice load 60 45{dup mul exch dup mul add 1.0 exch sub}/setscreen load {}/settransfer load/initgraphics load/erasepage load]cvx statusdict begin bind end readonly def}if md begin/bigs[lnop userdict/letter known{/letter load}{lnop}ifelse userdict/legal known{/legal load}{lnop}ifelse userdict/a4 known{/a4 load}{lnop}ifelse userdict/b5 known{/b5 load}{lnop}ifelse lnop lnop lnop /tab load/a3Size load]def /smalls[lnop userdict/lettersmall known{/lettersmall load}{userdict/note known{/note load}{lnop}ifelse}ifelse userdict/legal known{/legal load}{lnop}ifelse userdict/a4small known{/a4small load}{lnop}ifelse userdict/b5 known{/b5 load}{userdict/note known{/note load}{lnop}ifelse}ifelse lnop lnop lnop /tab load/a3Size load]def end systemdict/currentpacking known{setpacking}if {currentfile eexec} ( %endeexec) ok userdict/stretch known not and checkload 373A767D4B7FD94FE5903B7014B1B8D3BED02632C855D56F458B118ACF3AF73FC4EF5E81F5749042B5F9CF1016D093B75F250B7D8280B2EACE05A37037F7BDF6E12226D7D4E2DF2C52FAFD5FD40FE72A0D3AC4BD485D8369D4C87636E920D1DAF222D92155A9CB1667E715F0B82799B37CC8F5B32B74B39CF494536DC39C7EF04A7BCB29E2CEC79073CADCCFB23B4AA1363F876F5121B618071B7B4EB1E5DE75FAA2368A3E5DB2B198623AFE92AE9484270FE7F57A850E88C0D3EEA156611C91D8E480D4370B025CCA6929A2BF40AD3D01B2CB7EE6DFB46E12A830542337F7819B67F9765210F76DB06F34DA5B13A11759305C582E16D2B854939F6D9121F2A4F285282F5DCD3D15896D121E3D6F5BE79E087451BB0ED233CDBEF090D3B4AC2DC34B97E70C61D95FB072B8C12D2ABD843520949A39DCF99E2C1AA8FBCD025E47E0A82A8D96E75BAF40F52AD402495BBD4DE0F356C8B14E764874E639C9F045A0D1908EC6456EB6C5B8A6F826192F767EF2C55A21C58F5F9CC1F59247B55F2387828C7FE89D5E7D8484D1BC86CB6673BDBE4FE17DD9BDE95224FE645136F41330BF155A4DDE1B0A32233BF471CE58FBC660DC7E641B0A0D30018454E2191C414A3011FF3FED1C0D88FE1FF9F75DCC456D097947226FBEC92509146D3A4CFFC0471B31C53222ED9DD88566F60F6C0D705AD79DACF53B070026F083ED28B5CF757AAA0A169F6F320A75E9D2ED50ABD939AF85B6346C2ADB25D168F10508E1516D194C635E6B187FADEA0829DBF0390C0F003F0265E215BC96CA3CC13D4A8E01570BE193CA75A620728CD275ACF1986EFFB3A13419FE55EA7C4467B7E7EEDC1FC29C9F8C46A557D2CCDB914EF7B93E7530D555DFC2398AFC68CAD991F062EF85BAA1884EC166C7C5DF8543666D8C41BE267D706BD1588F1F662F705CAE4D29DC38EF66BFAA89470D8A099B6F1B4587F7B024412276106FCD3EB5AE17A5D1DF1781992DC40EA0A992F706F701304CEA9D9073E7A74F1E687D81C3E5841D31CF86855BAAAD9B5D30317C75150A857C6B114735315CDD1AEF36C26BBB0645499406DEE2F24B3B1C72FEC97C7BA31AA2CDAB25418BB1DC4C7E4757F1D625087B0FD0300C03A65F2A72CE734925735277E034CDCF599129679F70CC8B66E03878851DB75041F275E1E5761F3EC753BE1359CA364A22047AE4886217F9259FE19FF5B116E8019B98B143114B313E8BEF87EC949D85C82E0812E6F50525E73890AF362CC8EE8A85F4197E6AC18638EF12E56A808D439AF1BFD363F140314BF4E534485C42F1856688CC35288E8D770120A420FB9F1FCF8AE8BD6D6156CC23E6C51119FE4DE1B68C9DF3487E9974BF9ED31F8D3CE93FF101867319F2FF492D5D398B4F09A66F2F55BCAB34B99173B7EE89039D00DD21A7B3A52E9F028F8301B5FC12D409412E064513BC579AAC498F577EA8ECD1FE3E42DC3CC320786C7B00194FEDF344402C33FC492D4BA86992B01683F440220FFE756BC88A94223D316078D69D33560E8EAB76B24CB7AA4320CF435593D76F624324ABE00B5587A4F283C725EA24567133F25F472B5E2E4474DDB5A16AC5F2DF32350395D3E3892FE361F4D5C9A610C654C9227614FBBAFF3356A90A2266E00F66234061075491571A65616211257F160000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 cleartomark - %endeexec - {currentfile eexec} ( %endeexec) ok userdict/smooth4 known not and checkload F94E00EE41A71C59E5CAEED1EDBCF23D1DBA1EE99B9BB356492923BD8B1BA83A87CEB0E07377A31FD6241E814681118E17DC7CACE570399506E6E441B871B6043831BD03EFC11DBBD8001EE2FF8CFBD485065D455A2E15AC36F1A84AD8789FA6461199C7CD14CB9FD64D4B06452B7FC0A8FC263F70F1CCB893295D4DE70ADAB771C0F84396FA98C60B11DA02ABA157298DF0A23621853BEF167443A985ADC09BEFFD51CB4D29179E2B34609EF38A49DA61F4BFC256A3DE0732D7D29754A194857B9C9E9971227AA1DD0611FBB10E44E5FF66C062D9C24ED3290529330BC317825E876929582DB0E39B9FC5EFD20CC1D4F94920EB9C534D0DA90DE70D25BC7287319CF28602B3F46633C242CAFC8905E960317E3C2FA20AB8DB06ADBAF292FC7BA2CA14EE65DF28B99CC11666B70AD33E8E1D57D63D4B89ECC615AE5747C1CA752C833D8D6DE54CD4A0350B44310555CE3BD2C615ADD27B634CDB350AF3A432CE78AACD2909A5B586F666CD87919A36DB1CBE86B3CE281DFD01CD7E1B8A18A4B415CECBFF79A5C4390A15EA77D14D6BE12BAB5A8268C3F286D0590060647CABED674443CD258F11415E866AB330A251691B61F2422A61AFE59B6B4FBDCF85ED9BA0F8E483C034089E6877FF5923698D3A0DC0EED6B9CFD32DF0839BC4EA5F6D1FCB6DD0920391E57E84745131D02D100179F4E0A68EC0A5FF6680A6F463D038B04AF63FFA13D743B995A26A743C26D387209023C91DE43DF047A16F328AC9DDC08573B38BE9EA341EA16C78EC32F3A1B36B90D95A50610F4D050EC1C33497F3F3A81A1B4C8BEF0BA84EE2FAA32DC112DAC490AF53E1749C4A0D866CAF7B893E52383B0D38065C333FB122B700D7246F7EE87D942AE3DB5C1DD77E9E76C80CC5AD63D28DFED0E229CE604673F78CD47F258FDF5BF3A3EAEC5C9BC8E482D8DBA9D268A35DA8C095A690679ED2123E8B8F5E4826FA3B199EAA5D482D4B6AA86572E387CECEB7149C8947F41D6339328A748A17F8C4AD3B0555F1E409450BA0C564F1F488BB5096EB003568D4D5EF6489897E27409547D0EE4487D30184793B0F27BD265A64BDB3EA6761569DA955620C612E718677B77D6D81B999C6298877AFE0D1D6F6F358377A8BD2402F669C64B972B3A065EF7DD4BDEFFFE17E63DB8898FA6E69166B710AAD6BA2EA9AF61E4B8C8701638D4D6E4DFFFC192AEF6BC027095C4C72D748979675BA29FAF61E75343E14E61034602E5A79CD2519796ED6A9CC4EDEA46A9B59D4A807E786B5EE46F25B0360BC8E7C12D723122CDEEF247C9776F4C99C8EBED6828AA19744B5ADF0D07D95D98B3072372388D41B0FAB1CCE2775170679575ECDCA13B22A17FE9C6605C3445F58F1A829512DAB6C528F83580C8AA53C35D605F626F5AD0B7FC1EA87D69A835E3F53A1F450FB0AF42A5772F89D92A50D10F15BDBDA409F50C0B8AB93FE8A16D029DD8BB5C480D1466735ED4D9CAF637E5ECD6C2ECB6BF3B3EFBEE7AB936D2C568E3009D156B87CACB1FB3A48A70BC91B2EC35CC9147FFB1A524E2B2F2E4E2C1B12F1C1C63768BB95CD62FEC01CBA79B9FA282DD4DF49990F27FF8EE4E2DDE2F0ACD83BC9D4BE0090192C7A799967EC4DC2D63C0835E22D4C4B366D7FDCF3A05A4B53DF780F986EF25C79B665D5C00EFF7F17C0BB6D544F9D83A7FDAC47D9C5683A656011374253C918FF6EA64749DD971B2300DD5320033E01EC591F6318CCE94CE2B81C04322EC52B624E50643B52391CCD2AB56396A2AD8E2D3CA61B80D9D4CC363B2DF7863526958CDF3497E36648406C317E58EC563E7C26149A2A3C643ADFB39A8DD92974C6D2A2A9D7B71CDF3FEBBF32BB02E7B45CF53AAEAD5E963A4AA4AF9A149A08A4EC303D5F2369977E93F54897EEAD31B06C5845D63F49D65F8E5573962241A57CCD717CE6CA8C784A11192943616EA059B51BC38429E18D0121FCBB6FBD5D909B0D89E616C66DEF6A0F165A7030BD911A1B120468329CBB006C8D37720E531CF31E878CB4AAAC137633675C3D546F5162487AB35F470C042BDEB945E0F2532BF92AA6FD53434440221ECD3533A7AA89900CB19EFE2CD872DF8B7969AF0D3B72BF31DC5DD69CA6460966F61AB17CB507964098DBA3AF122EEC3128A9BAFE1034493F372B36BD1351205E9043A67C544402D8BCE24358C8A5CE33867A00794CF7097D59C88279A11EE9C854E7E7AAE881F9828C569D208F5F33375F59E9A3818CFA38AAD0CBFBA32F9F44A8BB79DE4C40E3886457C16DA4A27953AA1E99472E35F2323F0BAA5E37DC28CBA46FEFB73B190016055ADD4D27615D748499A0E1C4B8C7EC339C1C4D95A813A85918A8D01EEB485DDCDCEA6EA3F2C2A9D85C139CD90CCB352634F9AFE836BCAC0C274E352BA2071B5269D5DE4CCDE3FF990CBA974980C7332AE1545A9C60D5D1459D3AE95C1AC065733AF14FADB440A110DD539563B8D850CD0704C52F3F7CCCB53630D776560CBD22D8FF08F5B354487A171AEC15F5F54DE9CAB668BCAC573E788D92762EF63E76087005F4AC2D02E0CAC173C11BE62ACE5DC4D3374F2F9746C9981E125FF9AB8CAE76D13039E2C54DFD708E028A619EA1ED78E6B46F06DF0D0B74BBEDD8C190C7C0CEBDE8F7A4888CC36575313478DD2CFE392E9BB7B2416955D44B7024A3BA43FBF37293B386D64746D7748895411D243FAEC50638F2AA33337D7FA018ADDAC5835A0DDFAE99AD6299DFB4CA6872C59853E3AC12FC9E3D26629C5B49CF844C87B3C4BFBE3074E3A1CE6984758C20C661084381CD6B4582D84F19C0000B5FC0DCB42B567E396031601C095D7016283EBE5F13CD8A3A374A74DDBBABD36081149F8BC242085F2F7297CC97FD3B8BAD206D8AC9707A39ECCC7963B522E08DA391A1EF12DD4D746DBDDDCC0834F88160CF189A9645567CEC2F023A571AF0DFD15DB85B744C28C000DF53B05F8F210841F6E87A04F20C777B7C0BE6182BE2E90226E5301A12532A745F2FAAA81637CF11B78CD2B99A4D18B862D6C5DBD31793FB16A2D9AAD376D4484D75AA833D0068B1D34DB74E3302480854E3B5484D8A47E39A89A2FA927BC3641EA7F8E004FDE4C2F08D40D99F1ACB47CAF6887629BF6DFE12968D297596D28CE0CF148B12E7DCB49FB94F5ADBD214C3A6CE1E249831BA9EB8A189F2CE1ABE39A7B537253E369A508A2AF2ADB9463F9B56BBBFF31D535FF997F537C6675C196E7ECBD493F652FA7CC6D9C1CA3379BFDB5AF7513C6E834054494296B91A6EE800114363D5D5D0759F41B4DECB653B9DE3E94583579EF549ED5F3FAFB12661ABC0C57A332406517ED3454EDED34B386C60F78DC976266E0EAF54FC245FB0E3EFC8016236436B599C1C97A8C5E0AC8F7836161873C71F01ED9CC25C236420F41FD8277993D3959205912FA0927B59E3DAE7377D82079447D6E41EE5AEC0DFFF79AF8F4ED47F17EE708FEA45877860D56F8CBCE65A061E8E1CA4A5FBAF0E13429A7F0ADB6F178FA449F46CC539BBC0107E3A53B1C362A04B20E6D721E7E6E1E4976A11DDC98C7614D22B53DFBB6DAE533AC9BE882021A735C30DAA4A44AED09F49A390E8CFF59BD9C30667AF21B03EC5CEBD5C2C3AA2769E8D714191A48E7DDF50B13D1560E82EFB65FCE601AE9E8C351FBA1DED80B7351314E7F9F9A784BFE3759B7E322A84E7B51F9DC5F5D9C8050CD79B27C0A4B0DD68A3C27A948AD6858E35B960D2DEA838C479CAEA83B1A912174ACB2100E55E7A14892D7A9B3711FF0B20065C1995B49E1F23464A92DD140642E3A7B1973849E64D1A3CF60000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 cleartomark - %endeexec - %%EndProcSet %%EndProlog %%BeginDocumentSetup md begin F sgd svsc T T 0 0 781 538 -30 -28 811 566 100 72 72 3 F F F F T T T F psu (; document: Report)jn 0 mf od %%EndDocumentSetup %%Page: ? 1 op 0 0 xl 1 1 pen 0 0 gm (nc 0 0 781 538 6 rc)kp 167 238 gm (nc 50 0 377 538 6 rc)kp 1.50659 0 rmoveto F 1 setTxMode 1 fs bu fc {}mark T /Helvetica-Bold /|______Helvetica-Bold 0 rf bn 18 fz bu fc 2 F /|______Helvetica-Bold fnt bn (Coco/R)show 219 122 gm 11.41015 0 rmoveto 14 fz bu fc 2 F /|______Helvetica-Bold fnt bn (A Generator for Fast Compiler Front-Ends)show 271 224 gm 0 fs bu fc {}mark T /Helvetica /|______Helvetica 0 rf bn bu fc 2 F /|______Helvetica fnt bn -0.14265 0.(H.M\232ssenb\232ck)ashow 307 177 gm 0.05419 0 rmoveto 10 fz bu fc 2 F /|______Helvetica fnt bn (ETH Z\237rich, Institut f\237r Computersysteme)show 323 201 gm 0.17236 0 rmoveto (ETH-Zentrum, CH-8092 Z\237rich)show 339 139 gm 2.75952 0 rmoveto (Tel.: +41-1-254 7342, E-mail: moessenboeck@inf.ethz.ch)show F T cp %%Page: ? 2 op 0 0 xl 1 1 pen 20 400 gm (nc 746 0 781 538 6 rc)kp 29 34 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (2)show 100 34 gm (nc 50 0 669 538 6 rc)kp 1 fs 10 fz bu fc 2 F /|______Helvetica-Bold fnt bn 0.63578 0.(Abstract)ashow 128 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.62011 0. 32 0.06201 0.(Formal compiler descriptions serve two purposes: \(1\) they can be used as a reference document which)awidthshow 142 34 gm 0.82427 0. 32 0.08242 0.(specifies the syntax and the semantics of a language, and \(2\) they provide a convenient notation from)awidthshow 156 34 gm 0.29144 0. 32 0.02914 0.(which efficient compilers can be generated. Compiler generating systems put emphasis on either the one)awidthshow 170 34 gm 0.05264 0. 32 0.00526 0.(or the other of these aspects. The system described in this report mainly concentrates on the second goal.)awidthshow 184 34 gm 1.49963 0. 32 0.14996 0.(We show that it is possible to generate compilers that are as efficient as hand-coded and carefully)awidthshow 198 34 gm 0.92346 0. 32 0.09234 0.(optimized production-quality compilers. Our system generates recursive descent parsers with a simple)awidthshow 212 34 gm -0.01786 0.(error-handling mechanism and scanners with a special buffering scheme. Almost as important as efficiency)ashow 226 34 gm -0.05258 0.(is the simplicity and adequacy of the system. Programmers are not willing to use a tool if it does not come in)ashow 240 34 gm 0.02899 0. 32 0.00289 0.(handy in their work, if it uses a cryptic notation or a multitude of options and special cases. The tool should)awidthshow 254 34 gm -0.01171 0.(make their work easier without limiting their flexibility. We used our system to generate an Oberon compiler)ashow 268 34 gm -0.03524 0.(that is even faster than the standard Oberon compiler used at ETH.)ashow 324 34 gm 1 fs bu fc 2 F /|______Helvetica-Bold fnt bn 0.95454 0.(Contents)ashow 352 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.66255 0.(1.)ashow 352 48 gm 0.16035 0.(Introduction)ashow 376 34 gm 0.66255 0.(2.)ashow 376 48 gm 0.08026 0. 32 0.00802 0.(The Compiler Description Language Cocol/R)awidthshow 390 48 gm 0.55174 0.(2.1)ashow 390 68 gm (Overall Structure)show 404 48 gm 0.55174 0.(2.2)ashow 404 68 gm 0.43624 0. 32 0.04362 0.(Scanner Specification)awidthshow 418 48 gm 0.55174 0.(2.3)ashow 418 68 gm 0.03417 0. 32 0.00341 0.(Parser Specification)awidthshow 442 34 gm 0.66255 0.(3.)ashow 442 48 gm -0.06913 0.(Using Coco/R to Generate a Compiler)ashow 456 48 gm 0.55174 0.(3.1)ashow 456 68 gm 0.03433 0. 32 0.00343 0.(Scanner Interface)awidthshow 470 48 gm 0.55174 0.(3.2)ashow 470 68 gm -0.07473 0.(Parser Interface)ashow 484 48 gm 0.55174 0.(3.3)ashow 484 68 gm -0.28596 0.(Grammar Tests)ashow 508 34 gm 0.66255 0.(4.)ashow 508 48 gm -0.01744 0.(Hints for Advanced Users of Coco/R)ashow 532 34 gm 0.66255 0.(5.)ashow 532 48 gm 0.05061 0.(Implementation)ashow 546 48 gm 0.55174 0.(5.1)ashow 546 68 gm 0.19622 0. 32 0.01962 0.(Scanner Generation)awidthshow 560 48 gm 0.55174 0.(5.2)ashow 560 68 gm -0.04244 0.(Parser Generation)ashow 574 48 gm 0.55174 0.(5.3)ashow 574 68 gm -0.01649 0.(Error Recovery)ashow 598 34 gm 0.66255 0.(6.)ashow 598 48 gm 0.08042 0.(Measurements)ashow 622 34 gm 0.66255 0.(7.)ashow 622 48 gm -0.12846 0.(Summary)ashow 650 34 gm -0.12419 0.(Appendix A Cocol/R Grammar)ashow 664 34 gm -0.06437 0.(Appendix B Sample Attributed Grammar in Cocol/R)ashow F T cp %%Page: ? 3 op 0 0 xl 1 1 pen 20 261 gm (nc 746 0 781 538 6 rc)kp 29 500 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (3)show 63 34 gm (nc 53 0 728 538 6 rc)kp 1 fs 10 fz bu fc 2 F /|______Helvetica-Bold fnt bn 4.40567 0. 32 0.44056 0.(1. Introduction)awidthshow 91 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.49301 0. 32 0.04930 0.(Coco/R is a program that takes an augmented EBNF grammar of a language and generates a recursive)awidthshow 105 34 gm -0.06611 0.(descent parser and a scanner for this language. The programmer has to supply a main module that calls the)ashow 119 34 gm 0.17700 0. 32 0.01770 0.(parser, as well as semantic modules that are called from within the grammar \(e.g., a symbol table handler)awidthshow 133 34 gm -0.04187 0.(and a code generator\). )ashow -261 -113 xl 0 0 gm (nc -96 0 0 309 6 rc)kp 64 gr -66 221 -51 264 4 rc 0 gr -65.5 221.5 -51.5 263.5 0 rc 1 64 lw 64 gr -96 221 -81 264 4 rc 0 gr -95.5 221.5 -81.5 263.5 0 rc 64 1 lw 1 1 lw 64 gr -30 176 -15 219 4 rc 0 gr -29.5 176.5 -15.5 218.5 0 rc 1 64 lw 64 gr -30 221 -15 264 4 rc 0 gr -29.5 221.5 -15.5 263.5 0 rc 64 gr -30 266 -15 309 4 rc 0 gr -29.5 266.5 -15.5 308.5 0 rc -55 229 gm F 1 setTxMode 9 fz bu fc 2 F /|______Helvetica fnt bn 0.10018 0.(Parser)ashow -85 233 gm -0.16621 0.(Main)ashow -19 181 gm 0.08155 0.(Scanner)ashow -4 226 gm (Semantic modules)show -39 82 gm (Coco)show -16 9 gm -0.14161 0.(Compiler)ashow -5 4 gm 0.14942 0.(description)ashow -30 197 gm 0 gr -39 197 lin -30 287 gm -39 287 lin -39 197 gm -39 227 lin -39 257 gm -39 287 lin -39 227 gm (nc -49 0 0 309 6 rc)kp -51 227 lin (nc -96 0 0 309 6 rc)kp -56 222 -46 232 75 105 4 ar -39 257 gm (nc -49 0 0 309 6 rc)kp -51 257 lin (nc -96 0 0 309 6 rc)kp -56 252 -46 262 75 105 4 ar -30 242 gm (nc -49 0 0 309 6 rc)kp -51 242 lin (nc -96 0 0 309 6 rc)kp -56 237 -46 247 75 105 4 ar -66 242 gm (nc -79 0 0 309 6 rc)kp -81 242 lin (nc -96 0 0 309 6 rc)kp -86 237 -76 247 75 105 4 ar -66 5 gm -30 5 lin -30 35 lin -72 35 lin -72 11 lin -66 5 lin -66 11 lin -72 11 lin -60 137 gm (nc -96 0 0 195 6 rc)kp -60 197 lin (nc -96 0 0 309 6 rc)kp -65 192 -55 202 165 195 4 ar -24 137 gm (nc -96 0 0 156 6 rc)kp -24 158 lin (nc -96 0 0 309 6 rc)kp -29 153 -19 163 165 195 4 ar -24 137 gm -39 137 lin -45 137 gm -60 137 lin -39 137 gm -39 113 lin -45 137 gm -45 113 lin -42 44 gm (nc -96 0 0 66 6 rc)kp -42 68 lin (nc -96 0 0 309 6 rc)kp -47 63 -37 73 165 195 4 ar 64 1 lw 1 1 lw 261 113 xl 289 34 gm (nc 53 0 728 538 6 rc)kp F 1 setTxMode 10 fz bu fc 2 F /|______Helvetica fnt bn 0.99166 0. 32 0.09916 0.(The input language of Coco/R \(Cocol/R\) is based on )awidthshow 2 fs bu fc {}mark T /Helvetica-Oblique /|______Helvetica-Oblique 0 rf bn bu fc 2 F /|______Helvetica-Oblique fnt bn 1.83914 0. 32 0.18391 0.(attributed grammars)awidthshow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.30706 0. 32 0.13070 0.(. Attributed grammars were)awidthshow 303 34 gm 0.64514 0. 32 0.06451 0.(introduced by )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.18249 0.(Knuth)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.60043 0. 32 0.06004 0.( [Knu68] as a formalism to specify the semantics of context-free languages. In their)awidthshow 317 34 gm 1.20880 0. 32 0.12088 0.(original form they are static descriptions. They describe dependencies between attributes of symbols)awidthshow 331 34 gm 0.24551 0. 32 0.02455 0.(without giving an order in which the dependencies are to be evaluated. Many compiler generators stick to)awidthshow 345 34 gm 0.61264 0. 32 0.06126 0.(this notation [GaGi84, KHZ82, R\212i83]. For the implementation of efficient compilers, however, it may be)awidthshow 359 34 gm -0.02233 0.(better to look at attributed grammars as an algorithmic notation. The evaluation order of semantic actions is)ashow 373 34 gm 1.26373 0. 32 0.12637 0.(then determined by the textual order of the actions in the grammar. There are also several compiler)awidthshow 387 34 gm 0.07232 0. 32 0.00723 0.(generators, including Coco/R, that use this paradigm [John75, Gro88]. )awidthshow 415 34 gm 0.59890 0. 32 0.05989 0.(Coco/R is an improvement over an older version of this program \(Coco [ReM\23289]\). The main difference)awidthshow 429 34 gm 1.04827 0. 32 0.10482 0.(between Coco and Coco/R is that Coco/R produces recursive descent parsers instead of table-driven)awidthshow 443 34 gm 0.58059 0. 32 0.05805 0.(parsers and that it integrates the scanner description and the parser description, thus avoiding interface)awidthshow 457 34 gm 0.03204 0. 32 0.00320 0.(problems between the generated parts. A main nuisance of Coco was that all attributes had to be declared)awidthshow 471 34 gm 0.60287 0. 32 0.06028 0.(in a global scope, making it necessary to stack attribute values from time to time. This was remedied in)awidthshow 485 34 gm 1.03637 0. 32 0.10363 0.(Coco/R. Attributes can be declared local to productions. A similar extension of Coco, based on table-)awidthshow 499 34 gm 0.17333 0. 32 0.01733 0.(driven parsing, has recently been described in [DoPi90].)awidthshow 527 34 gm 0.72433 0. 32 0.07243 0.(The following example gives an impression of how a compiler description might look. A precise specifi-)awidthshow 541 34 gm 0.96527 0. 32 0.09652 0.(cation of the description language follows in Section 2. The example shows the translation of variable)awidthshow 555 34 gm 1.22421 0. 32 0.12242 0.(declarations. The task is to enter declared names into a symbol table and to compute addresses for)awidthshow 569 34 gm -0.12216 0.(variables. One starts with a context-free EBNF grammar that is usually already at hand)ashow 597 48 gm -0.02528 0.(VarDeclaration = Ident {"," Ident} ":" Type ";".)ashow 625 34 gm -0.07235 0.(By simply writing down this rule, one already gets a parser that can check variable declarations syntactically.)ashow 639 34 gm 0.01434 0. 32 0.00143 0.(To process them semantically as well,one has to think about how variable declarations are translated. This)awidthshow 653 34 gm 0.37750 0. 32 0.03775 0.(requires the following considerations:)awidthshow 681 34 gm (\245)show 681 48 gm 1.25442 0. 32 0.12544 0.(What are the semantic values of )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.37435 0.(VarDeclaration)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.36712 0. 32 0.03671 0.(, )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.35249 0.(Ident)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.70495 0. 32 0.07049 0.( and )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.44047 0.(Type)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.22848 0. 32 0.12284 0.(? In other words, what does the)awidthshow 695 48 gm 0.13107 0. 32 0.01310 0.(recognition of these symbols yield and what context information must be supplied in order to be able to)awidthshow 709 48 gm 0.72708 0. 32 0.07270 0.(recognize them? This leads to the so-called )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.17424 0.(attributes)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.56747 0. 32 0.05674 0.( of the symbols. The attribute of an )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.18843 0.(Ident)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.37109 0. 32 0.03710 0.( is its)awidthshow 723 48 gm 1.16348 0. 32 0.11634 0.(name, while the attribute of a )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.44860 0.(Type)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.22421 0. 32 0.12242 0.( is some node with type information. )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.38127 0.(VarDeclaration)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.18591 0. 32 0.11859 0.( does not)awidthshow F T cp %%Page: ? 4 op 0 0 xl 1 1 pen 20 505 gm (nc 746 0 781 538 6 rc)kp 29 34 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (4)show 57 48 gm (nc 47 0 734 538 6 rc)kp 10 fz bu fc 2 F /|______Helvetica fnt bn 0.37658 0. 32 0.03765 0.(produce an attribute. Instead, it needs an attribute from its context; i.e., it needs to know the next free)awidthshow 71 48 gm -0.03005 0.(address in the address space for variables. Attributes can be considered as \(input or output\) parameters)ashow 85 48 gm -0.01786 0.(of syntax symbols. They are denoted as follows:)ashow 113 62 gm 0.14434 0. 32 0.01443 0.(Ident )awidthshow 127 62 gm 0.51467 0. 32 0.05146 0.(Type )awidthshow 141 62 gm -0.10629 0.(VarDeclaration )ashow 169 34 gm (\245)show 169 48 gm -0.00863 0.(The next question is: what actions are necessary to translate a construct? These actions are formulated)ashow 183 48 gm 0.14923 0. 32 0.01492 0.(in a general purpose programming language \(e.g., )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.04383 0.(Oberon)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.13732 0. 32 0.01373 0.( [Wirth89]\) and are enclosed by the symbols)awidthshow 197 48 gm 0.91278 0. 32 0.09127 0.("\(." and ".\)". A semantic action may appear anywhere on the right-hand side of a production and is)awidthshow 211 48 gm 0.17288 0. 32 0.01728 0.(executed at that point during parsing.)awidthshow 239 34 gm 0.23208 0. 32 0.02320 0.(These consideration lead to an attributed production:)awidthshow 267 48 gm -0.13607 0.(VarDeclaration )ashow 281 170 gm -0.10592 0.(\(.)ashow 281 181 gm -0.11241 0.(VAR )ashow 281 207 gm -0.04214 0.(obj, obj1: SymTab.Object; typ: SymTab.Type; n, a: LONGINT; )ashow 295 181 gm -1.55661 0.( )ashow 295 207 gm -0.10670 0.(name: ARRAY 32 OF CHAR;.\))ashow 309 48 gm (=)show 309 62 gm 0.14434 0. 32 0.01443 0.(Ident )awidthshow 309 170 gm -0.10592 0.(\(.)ashow 309 181 gm -0.07363 0.(obj := SymTab.Find\(name\); obj.link := NIL; n := 1 .\))ashow 323 62 gm -0.02774 0.({ "," Ident )ashow 323 170 gm -0.10592 0.(\(.)ashow 323 181 gm -0.05276 0.(obj1 := SymTab.Find\(name\); obj1.link := obj; obj := obj1; INC\(n\) .\))ashow 337 62 gm (} ":")show 351 62 gm 0.51467 0. 32 0.05146 0.(Type )awidthshow 351 170 gm -0.10592 0.(\(.)ashow 351 181 gm -0.14994 0.(adr := adr + n* typ.size; a := adr;)ashow 365 181 gm -0.12828 0.(WHILE obj # NIL DO DEC\(a, typ.size\); obj.adr := a; obj := obj.link END .\))ashow 379 62 gm 0.44790 0.(";".)ashow 407 34 gm 0.18341 0. 32 0.01834 0.(Although the format is free, it is wise to shift syntactic parts to the left and semantic parts to the right. This)awidthshow 421 34 gm 0.54977 0. 32 0.05497 0.(gives a nice separation between syntax and semantics and makes it immediately clear what actions are)awidthshow 435 34 gm 1.63116 0. 32 0.16311 0.(executed upon recognition of a certain syntax symbol. Note that the production also contains local)awidthshow 449 34 gm 0.64071 0. 32 0.06407 0.(declarations of variables needed in the semantic actions. Besides, globally declared or imported names)awidthshow 463 34 gm -0.04618 0.(can also be accessed.)ashow 491 34 gm 1.13647 0. 32 0.11364 0.(An attributed grammar can be viewed as a special purpose language for writing compilers \(or similar)awidthshow 505 34 gm 0.01312 0. 32 0.00131 0.(programs\). It is a short-hand notation for the well-known recursive descent technique. Although it is not too)awidthshow 519 34 gm -0.03831 0.(hard to implement a compiler front-end by hand, a notation like the above can have advantages:)ashow 547 34 gm (\245)show 547 48 gm -0.02494 0.(It is easy to read. Syntax and semantics are clearly separated. Semantic actions are not buried between)ashow 561 48 gm 0.27191 0. 32 0.02719 0.(parsing statements.)awidthshow 575 34 gm (\245)show 575 48 gm 1.44775 0. 32 0.14477 0.(Routine activities like getting the next token from the scanner, handling alternatives, options and)awidthshow 589 48 gm -0.03407 0.(iterations, or error-handling don't have to be written down explicitly but are derived from the grammar.)ashow 603 34 gm (\245)show 603 48 gm 1.16607 0. 32 0.11660 0.(It is faster and safer to implement a compiler in this high-level notation than in a general purpose)awidthshow 617 48 gm 0.00930 0. 32 0.00093 0.(programming language. During language design several alternatives of a construct can be tried out and)awidthshow 631 48 gm 0.30456 0. 32 0.03045 0.(their implementations can be prototyped.)awidthshow 645 34 gm (\245)show 645 48 gm 1.79428 0. 32 0.17942 0.(Irregularities in the grammar like circular productions or violations of the LL\(1\) property can go)awidthshow 659 48 gm 1.01516 0. 32 0.10151 0.(undetected when the parser is implemented by hand. For a generator it is easy to check for these)awidthshow 673 48 gm -0.01515 0.(irregularities.)ashow 701 34 gm 1.43386 0. 32 0.14338 0.(Compiler generators enable programmers who are not experienced compiler writers to process little)awidthshow 715 34 gm 0.42663 0. 32 0.04266 0.(languages. Examples for little languages are numerous in programming [Ben88], ranging from command)awidthshow 729 34 gm -0.01757 0.(languages to descriptions of data structures on a file.)ashow F T cp %%Page: ? 5 op 0 0 xl 1 1 pen 20 267 gm (nc 746 0 781 538 6 rc)kp 29 500 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (5)show 64 34 gm (nc 54 0 727 538 6 rc)kp 10 fz bu fc 2 F /|______Helvetica fnt bn 0.38101 0. 32 0.03810 0.(The rest of this report describes the input language Cocol/R, shows how the generator can be used, and)awidthshow 78 34 gm 0.33096 0. 32 0.03309 0.(gives an overview of its implementation together with measurements. The appendix contains an example)awidthshow 92 34 gm -0.09985 0.(of a compiler description for a small language. )ashow 134 34 gm 1 fs bu fc 2 F /|______Helvetica-Bold fnt bn 3.29879 0. 32 0.32987 0.(2. The Compiler Description Language Cocol/R)awidthshow 162 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.34759 0. 32 0.03475 0.(A compiler description can be viewed as a module consisting of imports, declarations and grammar rules)awidthshow 176 34 gm 1.04309 0. 32 0.10430 0.(that describe the lexical and syntactical structure of a language as well as its translation into a target)awidthshow 190 34 gm -0.02561 0.(language. The vocabulary of Cocol/R uses identifiers, strings and numbers in the usual way:)ashow 218 48 gm 0.05355 0. 32 0.00535 0.(ident = letter {letter|digit}.)awidthshow 232 48 gm 0.28442 0. 32 0.02844 0.(string = ')awidthshow bu fc {}mark T /Times-Roman /|______Times-Roman 0 rf bn bu fc 2 F /|______Times-Roman fnt bn 0.09219 0.(")ashow bu fc 2 F /|______Helvetica fnt bn 0.45455 0. 32 0.04545 0.(' {anyButQuote} ')awidthshow bu fc 2 F /|______Times-Roman fnt bn 0.09219 0.(")ashow bu fc 2 F /|______Helvetica fnt bn 0.20507 0. 32 0.02050 0.(' |\312")awidthshow bu fc 2 F /|______Times-Roman fnt bn (')show bu fc 2 F /|______Helvetica fnt bn 0.54656 0. 32 0.05465 0.(" {anyButApostrophe} ")awidthshow bu fc 2 F /|______Times-Roman fnt bn (')show bu fc 2 F /|______Helvetica fnt bn 0.14300 0.(".)ashow 246 48 gm -0.00881 0.(number = digit {digit}.)ashow 274 34 gm -0.04475 0.(Upper case letters are distinct from lower case letters. Strings must not cross line borders. Keywords are)ashow 302 48 gm 9 fz bu fc 2 F /|______Helvetica fnt bn -0.31477 0.(ANY CASE CHARACTERS CHR COMMENTS COMPILER CONTEXT END FROM IGNORE)ashow 316 48 gm -0.27471 0.(NESTED PRAGMAS PRODUCTIONS SYNC TO TOKENS WEAK)ashow 344 34 gm 10 fz bu fc 2 F /|______Helvetica fnt bn -0.02384 0.(The following metacharacters are used to form EBNF expressions:)ashow 372 48 gm -0.75373 0.(\( \) )ashow 372 85 gm 0.78842 0. 32 0.07884 0.(for grouping)awidthshow 386 48 gm -0.76187 0.({ } )ashow 386 85 gm (for iterations)show 400 48 gm -0.60379 0.([ ] )ashow 400 85 gm 0.66131 0. 32 0.06613 0.(for options)awidthshow 414 48 gm -0.50367 0.(< > )ashow 414 85 gm 0.19058 0. 32 0.01905 0.(for attributes)awidthshow 428 48 gm -0.51292 0.(\(. .\) )ashow 428 85 gm -0.08522 0.(for semantic parts)ashow 442 48 gm -0.43704 0.(= . | + -)ashow 442 85 gm (as explained below)show 470 34 gm -0.04801 0.(Comments are enclosed in "\(*" and "*\)" and may be nested. The semantic parts may contain declarations or)ashow 484 34 gm 0.65582 0. 32 0.06558 0.(statements in a general purpose programming language. The language actually used is implementation)awidthshow 498 34 gm 0.60363 0. 32 0.06036 0.(dependent. This implementation uses Oberon.)awidthshow 540 34 gm 1 fs bu fc 2 F /|______Helvetica-Bold fnt bn 3.80172 0. 32 0.38017 0.(2.1 Overall Structure)awidthshow 568 34 gm 1 64 lw 0 fs bu fc 2 F /|______Helvetica fnt bn -0.02685 0.(A compiler description is made up of the following parts)ashow -582 -48 xl -1 0 gm (nc -1 0 0 184 6 rc)kp 0 gr -1 183 lin 64 1 lw 1 1 lw 582 48 xl 596 48 gm (nc 54 0 727 538 6 rc)kp F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn -0.13613 0.(Cocol = )ashow 596 96 gm 0.49041 0. 32 0.04904 0.("COMPILER" ident)awidthshow 610 96 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.09194 0.(arbitraryText)ashow 624 96 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.10981 0.(ScannerSpecification)ashow 638 96 gm 0.04869 0.(ParserSpecification)ashow 652 96 gm 1 64 lw 0.24475 0. 32 0.02447 0.("END" ident "." .)awidthshow -666 -48 xl -1 0 gm (nc -1 0 0 184 6 rc)kp 0 gr -1 183 lin 64 1 lw 1 1 lw 666 48 xl 694 34 gm (nc 54 0 727 538 6 rc)kp F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn -0.03588 0.(The name after the keyword COMPILER is the )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.04170 0.(grammar name)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.03562 0.( and must match the name after the keyword)ashow 708 34 gm -0.06817 0.(END. The grammar name also denotes the topmost nonterminal \(the start symbol\). After the grammar name)ashow 722 34 gm 0.99746 0. 32 0.09974 0.(arbitrary Oberon text may follow that is not checked by Coco/R. It usually contains imports of Oberon)awidthshow F T cp %%Page: ? 6 op 0 0 xl 1 1 pen 20 505 gm (nc 746 0 781 538 6 rc)kp 29 34 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (6)show 56 34 gm (nc 46 0 733 538 6 rc)kp 10 fz bu fc 2 F /|______Helvetica fnt bn 0.17242 0. 32 0.01724 0.(modules and declarations of global objects \(constants, types, variables, or procedures\) that are needed in)awidthshow 70 34 gm 1.16577 0. 32 0.11657 0.(the semantic actions later on. The remaining parts of the compiler description specify the lexical and)awidthshow 84 34 gm 0.10314 0. 32 0.01031 0.(syntactical structure of the language to be processed.)awidthshow 126 34 gm 1 fs bu fc 2 F /|______Helvetica-Bold fnt bn 4.28924 0. 32 0.42892 0.(2.2 Scanner Specification)awidthshow 154 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.44021 0. 32 0.04402 0.(A scanner has to read source text, skip meaningless characters, and recognize tokens which have to be)awidthshow 168 34 gm 0.56121 0. 32 0.05612 0.(passed to the parser. Tokens may be classified as )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.12603 0.(literals)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.31051 0. 32 0.03105 0.( and )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.91949 0. 32 0.09194 0.(token classes)awidthshow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.59890 0. 32 0.05989 0.(. Literals \(e.g., "END", ":=",)awidthshow 182 34 gm 0.07263 0. 32 0.00726 0.(etc.\) are written as strings and denote themselves. They are introduced right in the productions and do not)awidthshow 196 34 gm 0.79849 0. 32 0.07984 0.(have to be declared. Token classes \(e.g., identifiers or numbers\) have a certain structure that must be)awidthshow 210 34 gm -0.05377 0.(declared by a regular expression in EBNF. There are usually many different instances of a token class \(e.g.,)ashow 224 34 gm 1 64 lw -0.03555 0.(many different identifiers\) which are all recognized as the same token.)ashow -238 -48 xl -1 0 gm (nc -1 0 0 322 6 rc)kp 0 gr -1 321 lin 64 1 lw 1 1 lw 238 48 xl 252 48 gm (nc 46 0 733 538 6 rc)kp F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn 0.47332 0. 32 0.04733 0.(ScannerSpecification =)awidthshow 266 62 gm -0.02459 0.({ "CHARACTERS" {SetDecl})ashow 280 62 gm 0.04089 0. 32 0.00408 0.(| "TOKENS" {TokenDecl})awidthshow 294 62 gm -0.12774 0.(| "PRAGMAS" {PragmaDecl})ashow 308 62 gm -0.05862 0.(| CommentDecl)ashow 322 62 gm -0.10565 0.(| VariousDecl)ashow 336 62 gm 1 64 lw -0.11819 0.(}.)ashow -350 -48 xl -1 0 gm (nc -1 0 0 322 6 rc)kp 0 gr -1 321 lin 64 1 lw 1 1 lw 350 48 xl 378 34 gm (nc 46 0 733 538 6 rc)kp F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn -0.06657 0.(A scanner specification consists of 5 optional parts that may be written in arbitrary order.)ashow 406 34 gm 3 fs bu fc {}mark T /Helvetica-BoldOblique /|______Helvetica-BoldOblique 0 rf bn bu fc 2 F /|______Helvetica-BoldOblique fnt bn 2.07443 0. 32 0.20744 0.(Character sets)awidthshow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.16348 0. 32 0.11634 0.(. This section allows the declaration of names for character sets like letters or digits.)awidthshow 420 34 gm 1 64 lw 0.02410 0. 32 0.00241 0.(These names may be used in the other sections of the scanner specification.)awidthshow -434 -48 xl -1 0 gm (nc -1 0 0 253 6 rc)kp 0 gr -1 252 lin 64 1 lw 1 1 lw 434 48 xl 448 48 gm (nc 46 0 733 538 6 rc)kp F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn 0.12756 0. 32 0.01275 0.(SetDecl )awidthshow 448 96 gm 0.31677 0. 32 0.03167 0.(= ident "=" Set.)awidthshow 462 48 gm 0.16494 0. 32 0.01649 0.(Set )awidthshow 462 96 gm -0.06071 0.(= BasicSet { \("+"|"-"\) BasicSet}.)ashow 476 48 gm -0.02923 0.(BasicSet )ashow 476 96 gm 1 64 lw -0.09523 0.(= ident | string | "CHR" "\(" number "\)" | "ANY".)ashow -490 -48 xl -1 0 gm (nc -1 0 0 253 6 rc)kp 0 gr -1 252 lin 64 1 lw 1 1 lw 490 48 xl 518 34 gm (nc 46 0 733 538 6 rc)kp F 1 setTxMode 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.11491 0.(SetDecl)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.10437 0.( associates a name with a character set. Basic character sets are denoted as)ashow 532 48 gm 0.11129 0.(string)ashow 532 113 gm -0.07873 0.(a set consisting of all characters in the string)ashow 546 48 gm 0.33131 0.(ident)ashow 546 113 gm -0.03991 0.(the previously declared character set with this name)ashow 560 48 gm -0.30645 0.(CHR\(i\))ashow 560 113 gm -0.07650 0.(a character set consisting of a single element with ordinal value i)ashow 574 48 gm -0.27951 0.(ANY)ashow 574 113 gm -0.09797 0.(the set of all characters)ashow 602 34 gm -0.07463 0.(Character sets may be formed from basic sets by the operators)ashow 616 48 gm (+)show 616 62 gm 0.79376 0. 32 0.07937 0.(set union)awidthshow 630 48 gm (-)show 630 62 gm 0.86318 0. 32 0.08631 0.(set difference)awidthshow 658 34 gm 0.01512 0.(Examples)ashow 672 48 gm 1.19995 0. 32 0.11999 0.(digit = "0123456789".)awidthshow 672 198 gm -0.05085 0.(the set of all digits)ashow 686 48 gm 0.14694 0. 32 0.01469 0.(hexdigit = digit + "ABCDEF".)awidthshow 686 198 gm -0.05987 0.(the set of all hexadecimal digits)ashow 700 48 gm -0.07260 0.(eol = CHR\(13\).)ashow 700 198 gm 0.10818 0. 32 0.01081 0.(end-of-line character)awidthshow 714 48 gm -0.09838 0.(noDigit = ANY - digit.)ashow 714 198 gm -0.10163 0.(Any character that is not a digit)ashow F T cp %%Page: ? 7 op 0 0 xl 1 1 pen 20 332 gm (nc 746 0 781 538 6 rc)kp 29 500 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (7)show 60 34 gm (nc 50 0 709 538 6 rc)kp 3 fs 10 fz bu fc 2 F /|______Helvetica-BoldOblique fnt bn 0.09577 0.(Tokens)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.26153 0. 32 0.02615 0.(. A token is a terminal symbol for the parser but a syntactically structured symbol for the scanner.)awidthshow 74 34 gm 1 64 lw -0.03108 0.(This structure has to be described by a regular expression in EBNF.)ashow -88 -48 xl -1 0 gm (nc -1 0 0 361 6 rc)kp 0 gr -1 360 lin 64 1 lw 1 1 lw 88 48 xl 102 48 gm (nc 50 0 709 538 6 rc)kp F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn 0.23071 0. 32 0.02307 0.(TokenDecl )awidthshow 102 113 gm (=)show 102 122 gm 0.50643 0. 32 0.05064 0.(Symbol ["=" TokenExpr "."].)awidthshow 116 48 gm 0.46264 0. 32 0.04626 0.(TokenExpr )awidthshow 116 113 gm (=)show 116 122 gm 0.01586 0. 32 0.00158 0.(TokenTerm {"|" TokenTerm}.)awidthshow 130 48 gm 0.05966 0. 32 0.00596 0.(TokenTerm )awidthshow 130 113 gm (=)show 130 122 gm 0.07522 0. 32 0.00752 0.(TokenFactor {TokenFactor} ["CONTEXT" "\(" TokenExpr "\)"].)awidthshow 144 48 gm 0.04928 0. 32 0.00492 0.(TokenFactor )awidthshow 144 113 gm (=)show 144 122 gm -0.02296 0.(Symbol | "\(" TokenExpr "\)" | "[" TokenExpr "]" | "{" TokenExpr "}".)ashow 158 48 gm 0.13296 0.(Symbol)ashow 158 113 gm -0.61819 0.(= )ashow 158 122 gm 1 64 lw -0.00360 0.(ident | string.)ashow -172 -48 xl -1 0 gm (nc -1 0 0 361 6 rc)kp 0 gr -1 360 lin 64 1 lw 1 1 lw 172 48 xl 200 34 gm (nc 50 0 709 538 6 rc)kp F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn 0.75866 0. 32 0.07586 0.(Tokens may be declared in any order. A token declaration defines a symbol together with its structure.)awidthshow 214 34 gm 0.60821 0. 32 0.06082 0.(Usually the symbol on the left-hand side of the declaration is an identifier. It is declared to stand for the)awidthshow 228 34 gm 0.15899 0. 32 0.01589 0.(structure described on the right-hand side of the declaration. \(For special purposes the symbol on the left-)awidthshow 242 34 gm -0.05882 0.(hand side may also be a string, in which case no right-hand side may be specified; see Section 4.\) )ashow 270 34 gm 1.81488 0. 32 0.18148 0.(The right-hand side of a token declaration specifies the structure of the token by a regular EBNF)awidthshow 284 34 gm 1.91879 0. 32 0.19187 0.(expression. This expression may contain literals denoting themselves \(e.g., "END"\) and names of)awidthshow 298 34 gm 0.99502 0. 32 0.09950 0.(character sets \(e.g., letter\) denoting an arbitrary character from this set. It must )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.28222 0.(not)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.04522 0. 32 0.10452 0.( contain names of)awidthshow 312 34 gm 2.23892 0. 32 0.22389 0.(previously declared tokens. The CONTEXT phrase in a )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.68029 0.(TokenTerm)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.69082 0. 32 0.16908 0.( means that the term is only)awidthshow 326 34 gm 0.56701 0. 32 0.05670 0.(recognized when its right-hand context in the input stream is the )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.18768 0.(TokenExpr)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.53573 0. 32 0.05357 0.( specified in brackets. If the)awidthshow 340 34 gm -0.01773 0.(right-hand side of a declaration is missing, no scanner is generated. This gives the programmer the chance)ashow 354 34 gm -0.00309 0.(to provide a hand-written scanner \(see Section 4\).)ashow 382 34 gm 0.01512 0.(Examples)ashow 396 48 gm 0.36468 0. 32 0.03646 0.(ident )awidthshow 396 91 gm -0.07148 0.(= letter {letter | digit}.)ashow 410 48 gm -0.36083 0.(real )ashow 410 91 gm -0.00495 0.(= digit {digit} "." {digit} ["E" ["+"|"-"] digit {digit}].)ashow 424 48 gm 0.20629 0. 32 0.02062 0.(number )awidthshow 424 91 gm -0.00973 0.(= digit {digit} | digit {digit}\312CONTEXT \(".."\).)ashow 438 48 gm -0.15190 0.(and )ashow 438 91 gm -0.04066 0.(= "&" | "AND".)ashow 466 34 gm 0.89508 0. 32 0.08950 0.(The CONTEXT phrase in the above example allows a distinction between reals \(e.g., 1.23\) and range)awidthshow 480 34 gm 0.01541 0. 32 0.00154 0.(constructs \(e.g., 1..2\) that could otherwise not be scanned with a single character lookahead.)awidthshow 508 34 gm 9 fz bu fc 2 F /|______Helvetica fnt bn 1.13372 0. 32 0.11337 0.(Note: The scanner exports two variables, )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.33349 0.(pos)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.55206 0. 32 0.05520 0.( and )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.27597 0.(len)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.94192 0. 32 0.09419 0.(, which are the source position and the length of the most)awidthshow 522 34 gm 0.92330 0. 32 0.09233 0.(recently recognized token. It also exports a procedure )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.31657 0.(GetName)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.17237 0.(\()ashow bu fc {}mark F /Symbol /|______Symbol 0 rf bn bu fc 2 F /|______Symbol fnt bn 0.31224 0.(\257)ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.27830 0.(pos)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.23986 0. 32 0.02398 0.(, )awidthshow bu fc 2 F /|______Symbol fnt bn 0.31224 0.(\257)ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.23030 0.(len)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.23986 0. 32 0.02398 0.(, )awidthshow bu fc 2 F /|______Symbol fnt bn 0.31224 0.(\255)ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.25616 0.(sourceText)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.72982 0. 32 0.07298 0.(\) which can be used to)awidthshow 536 34 gm 0.10360 0. 32 0.01036 0.(obtain the source text of the token at position )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.03807 0.(pos)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.09811 0. 32 0.00981 0.( having the length )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.03150 0.(len)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.10833 0. 32 0.01083 0.(. See also Section 3.)awidthshow 578 34 gm 3 fs 10 fz bu fc 2 F /|______Helvetica-BoldOblique fnt bn 0.10624 0.(Pragmas)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.28060 0. 32 0.02806 0.(. A pragma is a token that may occur anywhere in the input stream \(e.g., end-of-line symbols or)awidthshow 592 34 gm 0.09094 0. 32 0.00909 0.(compiler options\). It would be too cumbersome to handle the many places in which they could occur in the)awidthshow 606 34 gm 0.64666 0. 32 0.06466 0.(grammar. Therefore a special mechanism is provided to process pragmas without including them in the)awidthshow 620 34 gm 0.47821 0. 32 0.04782 0.(productions. Pragmas are declared like tokens, but they may have an associated semantic action that is)awidthshow 634 34 gm 1 64 lw 0.29449 0. 32 0.02944 0.(executed whenever they are recognized by the scanner.)awidthshow -648 -48 xl -1 0 gm (nc -1 0 0 301 6 rc)kp 0 gr -1 300 lin 64 1 lw 1 1 lw 648 48 xl 662 48 gm (nc 50 0 709 538 6 rc)kp F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn -0.17782 0.(PragmaDecl )ashow 662 108 gm 0.49835 0. 32 0.04983 0.(= TokenDecl [SemAction].)awidthshow 676 48 gm 0.46264 0. 32 0.04626 0.(SemAction )awidthshow 676 108 gm 1 64 lw -0.05186 0.(= "\(." )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.06367 0.(arbitraryText)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.05537 0.( ".\)".)ashow -690 -48 xl -1 0 gm (nc -1 0 0 301 6 rc)kp 0 gr -1 300 lin 64 1 lw 1 1 lw F T cp %%Page: ? 8 op 0 0 xl 1 1 pen 20 206 gm (nc 746 0 781 538 6 rc)kp 29 34 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (8)show 64 34 gm (nc 54 0 727 538 6 rc)kp 10 fz bu fc 2 F /|______Helvetica fnt bn 0.01770 0.(Example)ashow 78 48 gm -0.01319 0.(option = "$" {letter} . )ashow 78 170 gm -0.44213 0.(\(. )ashow 78 181 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.01193 0.(Scanner)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.01217 0.(.GetName\()ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.01193 0.(Scanner)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.03433 0. 32 0.00343 0.(.pos, )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.01193 0.(Scanner)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.02563 0. 32 0.00256 0.(.len, str\); i := 1;)awidthshow 92 181 gm -0.08807 0.(WHILE i < )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.09747 0.(Scanner)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.10351 0.(.len DO)ashow 106 193 gm -0.16601 0.(IF str[i] = "A" THEN \311)ashow 120 193 gm -0.09941 0.(ELSIF str[i] = "B" THEN \311)ashow 134 193 gm 0.03778 0.(END;)ashow 148 193 gm -0.41827 0.(INC\(i\))ashow 162 181 gm -0.29519 0.(END .\) )ashow 204 34 gm 3 fs bu fc 2 F /|______Helvetica-BoldOblique fnt bn 0.47216 0.(Comments)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.31088 0. 32 0.13108 0.(. Comments are difficult \(nested comments are even impossible\) to specify with regular)awidthshow 218 34 gm -0.00166 0.(expressions. This makes it necessary to have a special construct to express their structure. Comments are)ashow 232 34 gm 0.59814 0. 32 0.05981 0.(declared by specifying their opening and their closing brackets. It is possible to declare several kinds of)awidthshow 246 34 gm 1 64 lw -0.01480 0.(comments. Comment brackets must not be longer than 2 characters.)ashow -260 -48 xl -1 0 gm (nc -1 0 0 367 6 rc)kp 0 gr -1 366 lin 64 1 lw 1 1 lw 260 48 xl 274 48 gm (nc 54 0 727 538 6 rc)kp 1 64 lw F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn 0.20202 0. 32 0.02020 0.(CommentDecl = "COMMENTS" "FROM" TokenExpr "TO" TokenExpr ["NESTED"].)awidthshow -288 -48 xl -1 0 gm (nc -1 0 0 367 6 rc)kp 0 gr -1 366 lin 64 1 lw 1 1 lw 288 48 xl 316 34 gm (nc 54 0 727 538 6 rc)kp F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn 0.01512 0.(Examples)ashow 330 48 gm -0.08508 0.(COMMENTS FROM "\(*" TO "*\)" NESTED)ashow 344 48 gm -0.11860 0.(COMMENTS FROM "--" TO eol)ashow 386 34 gm 1 64 lw 3 fs bu fc 2 F /|______Helvetica-BoldOblique fnt bn 0.08929 0.(Various)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.33050 0. 32 0.03305 0.(. The following options serve to parameterize the generated scanner.)awidthshow -400 -48 xl -1 0 gm (nc -1 0 0 181 6 rc)kp 0 gr -1 180 lin 64 1 lw 1 1 lw 400 48 xl 414 48 gm (nc 54 0 727 538 6 rc)kp 1 64 lw F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn -0.06849 0.(VariousDecl = "IGNORE" \("CASE" | Set\).)ashow -428 -48 xl -1 0 gm (nc -1 0 0 181 6 rc)kp 0 gr -1 180 lin 64 1 lw 1 1 lw 428 48 xl 456 34 gm (nc 54 0 727 538 6 rc)kp F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn -0.00175 0.(IGNORE CASE specifies that lower case letters are treated like upper case letters in names. IGNORE Set)ashow 470 34 gm -0.01240 0.(specifies the set of meaningless characters that are to be skipped by the scanner \(e.g., tabulators and eol\).)ashow 484 34 gm -0.02615 0.(Blank is meaningless by default.)ashow 526 34 gm 1 fs bu fc 2 F /|______Helvetica-Bold fnt bn 3.99993 0. 32 0.39999 0.(2.3 Parser Specification)awidthshow 554 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 1.02783 0. 32 0.10278 0.(The parser specification is the main part of the compiler description. It contains the productions of an)awidthshow 568 34 gm 0.43395 0. 32 0.04339 0.(attributed grammar specifying the syntax of the language to be recognized as well as its translation. The)awidthshow 582 34 gm 0.03601 0. 32 0.00360 0.(productions may be given in any order. References to yet undeclared nonterminals are allowed. Any name)awidthshow 596 34 gm 0.92514 0. 32 0.09251 0.(that is not declared as a terminal token is considered to be a nonterminal. There must be exactly one)awidthshow 610 34 gm 1 64 lw -0.03601 0.(production for every nonterminal. There must be a production for the start symbol \(the grammar name\).)ashow -624 -48 xl -1 0 gm (nc -1 0 0 358 6 rc)kp 0 gr -1 357 lin 64 1 lw 1 1 lw 624 48 xl 638 48 gm (nc 54 0 727 538 6 rc)kp F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn 0.03417 0. 32 0.00341 0.(ParserSpecification )awidthshow 638 142 gm (=)show 638 153 gm 0.27618 0. 32 0.02761 0.("PRODUCTIONS" {Production}.)awidthshow 652 48 gm 0.71563 0. 32 0.07156 0.(Production )awidthshow 652 142 gm (=)show 652 153 gm 0.19561 0. 32 0.01956 0.(ident [FormalAttributes] [LocalDecl] "=" Expression "." .)awidthshow 666 48 gm 0.04467 0.(FormalAttributes)ashow 666 142 gm -0.61819 0.(= )ashow 666 153 gm -0.01379 0.("<" )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.01515 0.(arbitraryText)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.01623 0.( ">".)ashow 680 48 gm 0.01322 0.(LocalDecl)ashow 680 142 gm (=)show 680 153 gm -0.02990 0.("\(." )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.04035 0.(arbitraryText)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.03509 0.( ".\)".)ashow 694 48 gm 0.13296 0.(Symbol)ashow 694 142 gm (=)show 694 153 gm 1 64 lw -0.00360 0.(ident | string.)ashow -708 -48 xl -1 0 gm (nc -1 0 0 358 6 rc)kp 0 gr -1 357 lin 64 1 lw 1 1 lw F T cp %%Page: ? 9 op 0 0 xl 1 1 pen 20 210 gm (nc 746 0 781 538 6 rc)kp 29 500 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (9)show 57 34 gm (nc 47 0 734 538 6 rc)kp 3 fs 10 fz bu fc 2 F /|______Helvetica-BoldOblique fnt bn 0.17208 0.(Productions)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.52062 0. 32 0.05206 0.(. A production may be considered as a procedure that parses a nonterminal. It has its own)awidthshow 71 34 gm 0.44586 0. 32 0.04458 0.(scope for attributes and local objects and is made up of a left-hand side and a right-hand side which are)awidthshow 85 34 gm 0.90667 0. 32 0.09066 0.(separated by an equal sign. The left-hand side specifies the name of the nonterminal together with its)awidthshow 99 34 gm 0.58822 0. 32 0.05882 0.(formal attributes and local declarations. The right-hand side consists of a context-free EBNF expression)awidthshow 113 34 gm -0.01129 0.(that specifies the structure of the nonterminal as well as its translation. The formal attributes are written like)ashow 127 34 gm 0.68359 0. 32 0.06835 0.(formal parameters in Oberon. They are enclosed in angle brackets. In analogy to input parameters and)awidthshow 141 34 gm 0.19622 0. 32 0.01962 0.(output parameters \(variable parameters\) we use the terms input attributes and output attributes. The local)awidthshow 155 34 gm -0.01489 0.(declarations are arbitrary Oberon declarations enclosed in "\(." and ".\)". A production constitutes a scope for)ashow 169 34 gm 0.06271 0. 32 0.00627 0.(its formal attributes and its locally declared objects. Terminals and nonterminals, globally declared objects,)awidthshow 183 34 gm -0.00746 0.(and imported modules are visible in any production.)ashow 211 34 gm 0.01770 0.(Example)ashow 225 48 gm -0.01081 0.(Expression )ashow 225 227 gm -0.12969 0.(\(. VAR y: Item; operator: INTEGER; .\))ashow 239 48 gm -0.39062 0.(= \311 .)ashow 267 34 gm 3 fs bu fc 2 F /|______Helvetica-BoldOblique fnt bn 0.57594 0.(Expressions)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.84921 0. 32 0.18492 0.(. An EBNF expression defines the context-free structure of some part of the source)awidthshow 281 34 gm 0.99731 0. 32 0.09973 0.(language together with attributes and semantic actions that specify the translation of this part into the)awidthshow 295 34 gm 1 64 lw 0.29937 0. 32 0.02993 0.(target language.)awidthshow -309 -48 xl -1 0 gm (nc -1 0 0 358 6 rc)kp 0 gr -1 357 lin 64 1 lw 1 1 lw 309 48 xl 323 48 gm (nc 47 0 734 538 6 rc)kp F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn 0.38421 0. 32 0.03842 0.(Expression )awidthshow 323 142 gm (=)show 323 153 gm -0.15715 0.(Term {"|" Term}.)ashow 337 48 gm -0.27529 0.(Term )ashow 337 142 gm (=)show 337 153 gm -0.12672 0.(Factor {Factor}.)ashow 351 48 gm -0.06649 0.(Factor)ashow 351 142 gm (=)show 351 153 gm 0.68481 0. 32 0.06848 0.(["WEAK"] Symbol [Attributes])awidthshow 365 142 gm (|)show 365 153 gm 0.20718 0.(SemAction)ashow 379 142 gm (|)show 379 153 gm -0.08740 0.("ANY" )ashow 393 142 gm (|)show 393 153 gm 0.02436 0.("SYNC")ashow 407 142 gm (|)show 407 153 gm -0.04248 0.("\(" Expression "\)" | "[" Expression "]" | "{" Expression "}".)ashow 421 48 gm 0.19674 0.(Attributes)ashow 421 142 gm -0.61819 0.(= )ashow 421 153 gm -0.01379 0.("<" )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.01515 0.(arbitraryText)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.01623 0.( ">".)ashow 435 48 gm 0.20718 0.(SemAction)ashow 435 142 gm (=)show 435 153 gm -0.02990 0.("\(." )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.04035 0.(arbitraryText)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.03509 0.( ".\)".)ashow 449 48 gm 0.13296 0.(Symbol)ashow 449 142 gm (=)show 449 153 gm 1 64 lw -0.00360 0.(ident | string.)ashow -463 -48 xl -1 0 gm (nc -1 0 0 358 6 rc)kp 0 gr -1 357 lin 64 1 lw 1 1 lw 463 48 xl 491 34 gm (nc 47 0 734 538 6 rc)kp F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn 0.30166 0. 32 0.03016 0.(Nonterminals may have attributes. They are written like actual parameters in Oberon and are enclosed in)awidthshow 505 34 gm -0.00680 0.(angle brackets. If a nonterminal has formal attributes, every occurrence of this nonterminal must have a list)ashow 519 34 gm -0.00680 0.(of actual attributes that correspond to the formal attributes according to the parameter compatibility rules of)ashow 533 34 gm 0.60333 0. 32 0.06033 0.(Oberon. The conformance, however, is only checked when the generated parser module is compiled. A)awidthshow 547 34 gm -0.01588 0.(semantic action is an arbitrary sequence of Oberon statements enclosed in "\(." and ".\)".)ashow 575 34 gm 0.85784 0. 32 0.08578 0.(The symbol ANY denotes any terminal that is not an alternative of this ANY symbol. It can be used to)awidthshow 589 34 gm 0.08193 0. 32 0.00819 0.(conveniently parse structures that contain arbitrary text. For example, the translation of a Cocol/R attribute)awidthshow 603 34 gm -0.08476 0.(list looks as follows:)ashow 631 48 gm -0.01863 0.(Attributes =)ashow 645 62 gm 0.53022 0.("<")ashow 645 142 gm -0.04251 0.(\(. pos := Scanner.pos + 1 .\))ashow 659 62 gm -0.30964 0.({ANY})ashow 673 62 gm 0.53022 0.(">")ashow 673 142 gm -0.06352 0.(\(. len := Scanner.pos - pos .\) .)ashow 701 34 gm 0.03234 0. 32 0.00323 0.(In this example the closing angle bracket is an implicit alternative of the ANY symbol in curly brackets. The)awidthshow 715 34 gm 0.16845 0. 32 0.01684 0.(meaning is that ANY matches any terminal except ">". )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.05068 0.(Scanner.pos)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.14007 0. 32 0.01400 0.( is the source text position of the most)awidthshow 729 34 gm 0.06134 0. 32 0.00613 0.(recently recognized terminal. It is exported by the generated scanner \(see Section 3\).)awidthshow F T cp %%Page: ? 10 op 0 0 xl 1 1 pen 20 412 gm (nc 746 0 781 538 6 rc)kp 29 34 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (10)show 59 34 gm (nc 49 0 680 538 6 rc)kp 3 fs 10 fz bu fc 2 F /|______Helvetica-BoldOblique fnt bn 0.13023 0.(Error-handling)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.41915 0. 32 0.04191 0.(. The programmer has to give some hints in order to allow Coco/R to generate good and)awidthshow 73 34 gm 1.06613 0. 32 0.10661 0.(efficient error-handling. First, )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 1.59698 0. 32 0.15969 0.(synchronization points)awidthshow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.80795 0. 32 0.08079 0.( have to be specified. A synchronization point is a)awidthshow 87 34 gm 1.08688 0. 32 0.10868 0.(location in the grammar where especially safe terminals are expected that are hardly ever missing or)awidthshow 101 34 gm 0.32455 0. 32 0.03245 0.(mistyped. When the generated parser reaches such a point, it adjusts the input to the next symbol that is)awidthshow 115 34 gm 0.23025 0. 32 0.02302 0.(expected at this point. In most languages good candidates for synchronization points are the beginning of)awidthshow 129 34 gm 1.48040 0. 32 0.14804 0.(a statement \(where IF, WHILE, etc. are expected\), the beginning of a declaration sequence \(where)awidthshow 143 34 gm 1.78939 0. 32 0.17893 0.(CONST, VAR, etc. are expected\) and the beginning of a type \(where RECORD, ARRAY, etc. are)awidthshow 157 34 gm 0.78140 0. 32 0.07814 0.(expected\). The end-of-file symbol is always among the synchronization symbols which guarantees that)awidthshow 171 34 gm 0.59951 0. 32 0.05995 0.(synchronization terminates at least at the end of the source text. A synchronization point is specified by)awidthshow 185 34 gm -0.04495 0.(the symbol SYNC.)ashow 213 34 gm 0.70373 0. 32 0.07037 0.(Error-handling can further be improved by specifying which terminals are "weak" in a certain context. A)awidthshow 227 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.11657 0. 32 0.01165 0.(weak terminal)awidthshow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.07080 0. 32 0.00708 0.( is a symbol that is often mistyped or missing, such as the semicolon between statements. A)awidthshow 241 34 gm 0.57525 0. 32 0.05752 0.(weak terminal is denoted by preceding it with the keyword WEAK. When the generated parser does not)awidthshow 255 34 gm 0.26306 0. 32 0.02630 0.(find a terminal specified as weak, it adjusts the input to the next symbol that is either a legal successor of)awidthshow 269 34 gm 0.10681 0. 32 0.01068 0.(the weak symbol or a symbol expected at any synchronization point \(symbols expected at synchronization)awidthshow 283 34 gm 0.03601 0. 32 0.00360 0.(points are considered to be very "strong", so that it makes sense that they never be skipped\).)awidthshow 311 34 gm 0.01770 0.(Example)ashow 325 48 gm 0.84762 0. 32 0.08476 0.(StatementSeq )awidthshow 325 119 gm 0.15625 0. 32 0.01562 0.(= Statement {WEAK ";" Statement}.)awidthshow 339 48 gm -0.12156 0.(Declaration )ashow 339 119 gm -0.19483 0.(= SYNC \("CONST" \311 | "TYPE" \311 | "VAR" \311 | \311\).)ashow 381 34 gm 3 fs bu fc 2 F /|______Helvetica-BoldOblique fnt bn 2.53768 0. 32 0.25376 0.(LL\(1\) requirements)awidthshow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.46850 0. 32 0.14685 0.(. Recursive descent parsing requires that the grammar of the parsed language)awidthshow 395 34 gm 0.01220 0. 32 0.00122 0.(satisfies the LL\(1\) property. This means that at any point in the grammar the parser must be able to decide)awidthshow 409 34 gm 0.27557 0. 32 0.02755 0.(on the basis of a single lookahead symbol which of several possible alternatives have to be selected. For)awidthshow 423 34 gm 0.19577 0. 32 0.01957 0.(example, the following production is not LL\(1\):)awidthshow 451 48 gm 0.34362 0. 32 0.03436 0.(Statement )awidthshow 451 102 gm (=)show 451 113 gm 0.64926 0. 32 0.06492 0.(ident ":=" Expression)awidthshow 465 102 gm (|)show 465 113 gm 0.46524 0. 32 0.04652 0.(ident ["\(" ExpressionList "\)"].)awidthshow 493 34 gm 1.08657 0. 32 0.10865 0.(Both alternatives start with the symbol )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.27523 0.(ident)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.10260 0. 32 0.11026 0.( and the parser cannot distinguish between them when it)awidthshow 507 34 gm 1.83364 0. 32 0.18336 0.(comes to a statement and )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.50601 0.(ident)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.90460 0. 32 0.19046 0.( is the next input symbol. However, the production can easily be)awidthshow 521 34 gm 0.30853 0. 32 0.03085 0.(transformed into)awidthshow 549 48 gm -0.01583 0.(Statement = ident \( ":=" Expression | ["\(" ExpressionList "\)"] \).)ashow 577 34 gm -0.07530 0.(where all alternatives start with distinct symbols. There are LL\(1\) conflicts that are not as easy to detect as in)ashow 591 34 gm 0.11795 0. 32 0.01179 0.(the above example. For a programmer, it can be hard to find them if he has no tool to check the grammar.)awidthshow 605 34 gm 0.87448 0. 32 0.08744 0.(The result would be a parser that in some situations selects a wrong alternative. Coco/R checks if the)awidthshow 619 34 gm 0.34759 0. 32 0.03475 0.(grammar satisfies the LL\(1\) property and gives appropriate error messages that show how to correct any)awidthshow 633 34 gm 0.05494 0.(violations.)ashow F T cp %%Page: ? 11 op 0 0 xl 1 1 pen 20 79 gm (nc 746 0 781 538 6 rc)kp 29 495 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (11)show 64 34 gm (nc 54 0 727 538 6 rc)kp 1 fs 10 fz bu fc 2 F /|______Helvetica-Bold fnt bn 2.63519 0. 32 0.26351 0.(3. Using Coco/R to Generate a Compiler)awidthshow 92 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.33432 0. 32 0.03343 0.(The attributed grammar is the central document of a compiler implementation with Coco/R. A user has to)awidthshow 106 34 gm -0.07031 0.(perform the following tasks in order to write a compiler: )ashow 134 48 gm -0.05784 0.(1. )ashow 134 62 gm -0.14274 0.(Write an attributed grammar; )ashow 148 48 gm -0.05784 0.(2. )ashow 148 62 gm -0.07896 0.(Write semantic modules if necessary \(import them in the attributed grammar\); )ashow 162 48 gm -0.05784 0.(3. )ashow 162 62 gm -0.09533 0.(Use Coco/R to generate a scanner and a parser from the attributed grammar; )ashow 176 48 gm -0.05784 0.(4. )ashow 176 62 gm -0.14849 0.(Write a main module that calls the parser. )ashow 204 34 gm 0.05172 0. 32 0.00517 0.(The command)awidthshow 232 48 gm -0.03492 0.(Coco.Compile )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.04330 0.(name)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.02107 0.( [ "/" {)ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.02566 0.(letter)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.03082 0.(} ])ashow 260 34 gm 0.69732 0. 32 0.06973 0.(translates the compiler description in file )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.25105 0.(name)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.61813 0. 32 0.06181 0.( \(with the grammar name )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.31239 0.(G)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.65505 0. 32 0.06550 0.(, say\) into a scanner module)awidthshow 274 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn (G)show 0 fs bu fc 2 F /|______Helvetica fnt bn -0.02575 0.(S.Mod and a parser module )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn (G)show 0 fs bu fc 2 F /|______Helvetica fnt bn -0.02487 0.(P.Mod. The following options may be specified)ashow 302 48 gm (S)show 302 62 gm -0.02915 0.(prints the set of start and successor symbols for every nonterminal)ashow 316 48 gm (X)show 316 62 gm -0.07540 0.(prints a cross-reference list of all terminals and nonterminals)ashow 358 34 gm 1 fs bu fc 2 F /|______Helvetica-Bold fnt bn 4.10675 0. 32 0.41067 0.(3.1 Scanner Interface)awidthshow 386 48 gm 0 fs bu fc 2 F /|______Helvetica fnt bn -0.12054 0.(DEFINITION )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.17352 0.(G)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.10484 0.(S; \(*generated scanner*\))ashow 400 62 gm -0.12867 0.(IMPORT Files;)ashow 414 62 gm 0.22053 0.(VAR)ashow 428 76 gm -0.04351 0.(src: Files.File;)ashow 428 224 gm 0.03646 0. 32 0.00364 0.(\(*source file; to be opened by the caller*\))awidthshow 442 76 gm -0.07446 0.(pos: LONGINT;)ashow 442 224 gm 0.17059 0. 32 0.01705 0.(\(*source file position of current token*\))awidthshow 456 76 gm -0.06800 0.(line, col, len: INTEGER;)ashow 456 224 gm 0.16784 0. 32 0.01678 0.(\(*line, column, and length of current token*\))awidthshow 470 76 gm -0.08749 0.(Error: PROCEDURE \(n: INTEGER; pos: LONGINT\); \(*install error message procedure here*\))ashow 484 62 gm 0.17730 0. 32 0.01773 0.(PROCEDURE Reset;)awidthshow 498 62 gm -0.12507 0.(PROCEDURE Get\(VAR sym: INTEGER\);)ashow 512 62 gm -0.12226 0.(PROCEDURE GetName\(pos: LONGINT; len: INTEGER; VAR name: ARRAY OF CHAR\);)ashow 526 48 gm -0.16174 0.(END )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.21067 0.(G)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.25590 0.(S.)ashow 554 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn (Reset)show 0 fs bu fc 2 F /|______Helvetica fnt bn 0.02883 0. 32 0.00288 0.( is called by the parser to initialize the scanner. Note that the main module is responsible to open the)awidthshow 568 34 gm 0.43380 0. 32 0.04338 0.(source file )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.12757 0.(src)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.40512 0. 32 0.04051 0.( prior to calling the parser. The parser then calls )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.15426 0.(Get)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.44448 0. 32 0.04444 0.( repeatedly to get the next token from)awidthshow 582 34 gm 0.44189 0. 32 0.04418 0.(the source text. Information about the most recently recognized token can be found in the variables )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.14027 0.(pos)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn (,)show 596 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.28717 0.(line)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.34194 0. 32 0.03419 0.(, )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.31449 0.(col)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.71029 0. 32 0.07102 0.(, and )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.32826 0.(len)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.17736 0. 32 0.11773 0.(. The procedure )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.45126 0.(GetName)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.24569 0.(\()ashow 9 fz bu fc 2 F /|______Symbol fnt bn 0.40057 0.(\257)ashow 2 fs 10 fz bu fc 2 F /|______Helvetica-Oblique fnt bn 0.39671 0.(pos)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.20513 0.(,)ashow 9 fz bu fc 2 F /|______Symbol fnt bn 0.40057 0.(\257)ashow 2 fs 10 fz bu fc 2 F /|______Helvetica-Oblique fnt bn 0.84991 0. 32 0.08499 0.( len)awidthshow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.34194 0. 32 0.03419 0.(, )awidthshow 9 fz bu fc 2 F /|______Symbol fnt bn 0.40057 0.(\255)ashow 2 fs 10 fz bu fc 2 F /|______Helvetica-Oblique fnt bn 0.46157 0.(name)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.95214 0. 32 0.09521 0.(\) can be used to obtain the text of the)awidthshow 610 34 gm 0.17974 0. 32 0.01797 0.(token at position )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.06132 0.(pos)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.14160 0. 32 0.01416 0.( with length )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.05073 0.(len)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn (.)show 638 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.27221 0. 32 0.02722 0.(Error messages)awidthshow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.14755 0. 32 0.01475 0.(. For every syntax error the parser calls the procedure variable )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.04115 0.(Error)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.14663 0. 32 0.01466 0.( with an error number)awidthshow 652 34 gm -0.04382 0.(and an error position as parameters. The user can install any procedure that prints a message or that saves)ashow 666 34 gm 0.36758 0. 32 0.03675 0.(the error information for later output. )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.10032 0.(Error)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.34378 0. 32 0.03437 0.( can also be used to report semantic errors. \(Make sure to use)awidthshow 680 34 gm 0.10345 0. 32 0.01034 0.(semantic error numbers that do not interfere with syntax error numbers; e.g., start semantic error numbers)awidthshow 694 34 gm 0.21545 0. 32 0.02154 0.(at 200.\) The error numbers together with an explanatory text are appended to the generated parser in the)awidthshow 708 34 gm 0.23315 0. 32 0.02331 0.(following form:)awidthshow F T cp %%Page: ? 12 op 0 0 xl 1 1 pen 20 99 gm (nc 746 0 781 538 6 rc)kp 29 34 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (12)show 57 48 gm (nc 47 0 734 538 6 rc)kp 10 fz bu fc 2 F /|______Helvetica fnt bn 0.02822 0. 32 0.00282 0.(| 0: Msg\("EOF expected"\))awidthshow 71 48 gm 0.16082 0. 32 0.01608 0.(| 1: Msg\("ident expected"\))awidthshow 85 48 gm 0.04364 0. 32 0.00436 0.(| 2: Msg\("string expected"\))awidthshow 99 48 gm 0.12619 0. 32 0.01261 0.(| 3: Msg\("number expected"\))awidthshow 113 48 gm (\311)show 141 34 gm -0.02680 0.(This text can be copied to a procedure that prints textual error messages.)ashow 183 34 gm 1 fs bu fc 2 F /|______Helvetica-Bold fnt bn 3.78311 0. 32 0.37831 0.(3.2 Parser Interface)awidthshow 211 48 gm 0 fs bu fc 2 F /|______Helvetica fnt bn -0.14956 0.(DEFINITION )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.21530 0.(G)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.12704 0.(P; \(*generated parser*\))ashow 225 62 gm -0.03713 0.(PROCEDURE Parse;)ashow 239 48 gm -0.16174 0.(END )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.21067 0.(G)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.25590 0.(P.)ashow 267 34 gm 0.47058 0. 32 0.04705 0.(The main program simply has to open the source file and call )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.16307 0.(Parse)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.46035 0. 32 0.04603 0.( in order to start the compilation. An)awidthshow 281 34 gm -0.14614 0.(example of a simple main program is:)ashow 309 48 gm 0.62988 0. 32 0.06298 0.(Texts.OpenScanner\(s, Oberon.Par.text, Oberon.Par.pos\); Texts.Scan\(s\);)awidthshow 323 48 gm -0.16676 0.(IF s.class = Texts.Name THEN)ashow 337 62 gm -0.05755 0.(GS.src := Files.Old\(s.s\);)ashow 351 62 gm -0.01737 0.(GS.Error := )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.01921 0.(own error message procedure)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn (;)show 365 62 gm -0.20217 0.(IF GS.src # NIL THEN GP.Parse END;)ashow 379 48 gm -0.05427 0.(END)ashow 421 34 gm 1 fs bu fc 2 F /|______Helvetica-Bold fnt bn 2.77236 0. 32 0.27723 0.(3.3 Grammar Tests)awidthshow 449 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 1.58843 0. 32 0.15884 0.(Coco/R performs several tests to check if the grammar is well-formed. If one of the following error)awidthshow 463 34 gm (messages is produced, no compiler parts are generated.)show 491 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.00708 0.(No production for X)ashow 505 48 gm 0 fs bu fc 2 F /|______Helvetica fnt bn -0.00283 0.(The nonterminal X has been used, but there is no production for it.)ashow 519 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.01446 0.(X cannot be reached)ashow 533 48 gm 0 fs bu fc 2 F /|______Helvetica fnt bn -0.04469 0.(There is a production for nonterminal X, but X cannot be derived from the start symbol.)ashow 547 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.04403 0.(X cannot be derived to terminals)ashow 561 48 gm 0 fs bu fc 2 F /|______Helvetica fnt bn -0.10134 0.(For example, if there is a production X = "\(" X "\)".)ashow 575 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.48934 0.(X --> Y, Y --> X)ashow 589 48 gm 0 fs bu fc 2 F /|______Helvetica fnt bn -0.12486 0.(X and Y are nonterminals with circular derivations.)ashow 603 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn (Tokens X and Y cannot be distinguished)show 617 48 gm 0 fs bu fc 2 F /|______Helvetica fnt bn -0.07893 0.(The terminal symbols X and Y are declared to have the same structure, e.g.,)ashow 631 62 gm 0.02563 0. 32 0.00256 0.(integer = digit {digit}.)awidthshow 645 62 gm -0.05805 0.(real = digit {digit} ["." {digit}].)ashow 659 48 gm -0.10908 0.(In this example, a digit string can be recognized as an integer or as a real.)ashow 687 34 gm 0.89248 0. 32 0.08924 0.(The following messages are warnings. They may indicate an error but they may also describe desired)awidthshow 701 34 gm 0.21835 0. 32 0.02183 0.(effects. The generated compiler parts are valid. If an LL\(1\) error is reported for a construct X one must be)awidthshow 715 34 gm -0.06115 0.(aware that the generated parser will choose the first of several possible alternatives for X.)ashow F T cp %%Page: ? 13 op 0 0 xl 1 1 pen 20 424 gm (nc 746 0 781 538 6 rc)kp 29 495 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (13)show 59 34 gm (nc 49 0 708 538 6 rc)kp 2 fs 10 fz bu fc 2 F /|______Helvetica-Oblique fnt bn (X deletable)show 73 48 gm 0 fs bu fc 2 F /|______Helvetica fnt bn -0.07884 0.(X can be derived to the empty string, e.g., X = {Y}.)ashow 87 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.12348 0.(LL\(1\) error in X: Y is start of more than one alternative)ashow 101 48 gm 0 fs bu fc 2 F /|______Helvetica fnt bn -0.05706 0.(Several alternatives in the production of X start with the terminal Y, e.g.,)ashow 115 62 gm 0.09506 0. 32 0.00950 0.(Statement = ident ":=" Expression | ident [ActualParameters].)awidthshow 129 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.07868 0.(LL\(1\) error in X: Y is start and successor of deletable structure)ashow 143 48 gm 0 fs bu fc 2 F /|______Helvetica fnt bn -0.03291 0.(Deletable structures are [\311] and {\311}, e.g.,)ashow 157 62 gm 0.42221 0. 32 0.04222 0.(qualident = [ident "."] ident.)awidthshow 171 62 gm 0.31921 0. 32 0.03192 0.(Statement = "IF" Expression "THEN" Statement ["ELSE" Statement].)awidthshow 185 48 gm 0.64086 0. 32 0.06408 0.(The ELSE at the start of the else-part may also be a successor of a statement. This LL\(1\) conflict is)awidthshow 199 48 gm 0.31845 0. 32 0.03184 0.(known under the name "dangling else".)awidthshow 241 34 gm 1 fs bu fc 2 F /|______Helvetica-Bold fnt bn 2.57080 0. 32 0.25708 0.(4. Hints for Advanced Users of Coco/R)awidthshow 283 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.02209 0.(Providing a Hand-Written Scanner)ashow 311 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.21392 0. 32 0.02139 0.(Scanning is a time-consuming task. The scanner generated by Coco/R is optimized, but it is implemented)awidthshow 325 34 gm 0.94192 0. 32 0.09419 0.(as a deterministic finite automaton, which introduces some overhead. A manual implementation of the)awidthshow 339 34 gm -0.03724 0.(scanner is slightly more efficient. For time-critical applications a programmer may want to generate a parser)ashow 353 34 gm -0.05758 0.(but provide a hand-written scanner. This can be done by declaring all terminal symbols \(including literals\) as)ashow 367 34 gm 0.22964 0. 32 0.02296 0.(tokens but without defining their structure by an EBNF expression, e.g.,)awidthshow 395 48 gm 0.17678 0.(TOKENS)ashow 409 62 gm 0.33131 0.(ident)ashow 423 62 gm 0.22164 0.(number)ashow 437 62 gm ("IF")show 451 62 gm (\311)show 479 34 gm 0.22506 0. 32 0.02250 0.(If a named token is declared without structure, no scanner is generated. Tokens are assigned numbers in)awidthshow 493 34 gm 0.68923 0. 32 0.06892 0.(the order of their declaration; i.e., the first token gets the number 1, the second the number 2, etc. The)awidthshow 507 34 gm 0.70434 0. 32 0.07043 0.(number 0 is reserved for the end-of-file symbol. The hand-written scanner has to return token numbers)awidthshow 521 34 gm 0.06805 0. 32 0.00680 0.(according to this convention. It must have the interface described in Section 3.)awidthshow 563 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.02461 0.(Tailoring the Generated Compiler Parts to One's Needs)ashow 591 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.29739 0. 32 0.02973 0.(Using a generator usually increases productivity while at the same time flexibility is decreased. There are)awidthshow 605 34 gm 0.54306 0. 32 0.05430 0.(always special cases that can be handled more efficiently in a hand-written implementation. A good tool)awidthshow 619 34 gm 0.54550 0. 32 0.05455 0.(handles routine matters in a standard way but gives the user the chance to change them if he wants to.)awidthshow 633 34 gm -0.02359 0.(Coco/R generates the scanner and the parser from source texts \(so-called frames\) stored under the names)ashow 647 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.29768 0.(Scanner.FRM)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.47225 0. 32 0.04722 0.( and )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.28608 0.(Parser.FRM)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.91293 0. 32 0.09129 0.(. It does so by inserting grammar-specific parts into these frames. The)awidthshow 661 34 gm 0.93780 0. 32 0.09378 0.(programmer may edit the frames and may therefore change any of the internally used algorithms. For)awidthshow 675 34 gm -0.00823 0.(example, he can Implement a different buffering scheme for input characters.)ashow F T cp %%Page: ? 14 op 0 0 xl 1 1 pen 20 374 gm (nc 746 0 781 538 6 rc)kp 29 34 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (14)show 60 34 gm (nc 50 0 681 538 6 rc)kp 2 fs 10 fz bu fc 2 F /|______Helvetica-Oblique fnt bn 0.50750 0. 32 0.05075 0.(Accessing the Lookahead Token)awidthshow 88 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.77850 0. 32 0.07785 0.(Section 3 specified the interface of the generated scanner. This interface is not complete. Actually, the)awidthshow 102 34 gm 0.08941 0. 32 0.00894 0.(scanner also exports information about the lookahead token:)awidthshow 130 48 gm 0.03814 0. 32 0.00381 0.(nextPos: LONGINT;)awidthshow 130 227 gm 0.17379 0. 32 0.01737 0.(\(*source file position of the lookahead token*\))awidthshow 144 48 gm 0.21270 0. 32 0.02127 0.(nextLine, nextCol: INTEGER;)awidthshow 144 227 gm 0.08026 0. 32 0.00802 0.(\(*line and column number of the lookahead token*\))awidthshow 172 34 gm 0.37078 0. 32 0.03707 0.(These variables refer to the most recently )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.12118 0.(scanned)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.37521 0. 32 0.03752 0.( token \(the lookahead token\), while the variables )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.12059 0.(pos)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn (,)show 186 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn (line)show 0 fs bu fc 2 F /|______Helvetica fnt bn ( and )show 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn (col)show 0 fs bu fc 2 F /|______Helvetica fnt bn -0.00486 0.( refer to the most recently )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn (parsed)show 0 fs bu fc 2 F /|______Helvetica fnt bn ( token.)show 228 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.02769 0.(Controlling the Parser by Semantic Information)ashow 256 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn -0.00219 0.(Ideally, syntax analysis should be independent of semantic analysis \(symbol table handling, type checking,)ashow 270 34 gm 0.05203 0. 32 0.00520 0.(etc.\). Some languages like Ada and C, however, have constructs that can only be distinguished if one also)awidthshow 284 34 gm 0.75500 0. 32 0.07550 0.(considers semantic information, e.g., the type of the parsed symbols. Even Oberon has constructs that)awidthshow 298 34 gm -0.03598 0.(cannot be parsed by looking at their syntax alone. For example, a designator is defined in Oberon as)ashow 326 48 gm -0.05940 0.(Designator = Qualident {"." ident | "^" | "[" ExprList "]" | "\(" Qualident "\)" }.)ashow 354 34 gm -0.07766 0.(where x\(T\) means a type guard \(i.e., x is asserted to be of type T\). A designator may be used in a statement)ashow 382 48 gm -0.09426 0.(Statement = \311 | Designator ["\(" ExprList "\)"] | \311 .)ashow 410 34 gm 1.90902 0. 32 0.19090 0.(Here x\(T\) can be interpreted as a designator x \(a procedure name\) and a parameter T. The two)awidthshow 424 34 gm 0.68054 0. 32 0.06805 0.(interpretations of x\(T\) can only be distinguished by looking at the type of x. If it is a procedure then the)awidthshow 438 34 gm -0.03605 0.(opening bracket is the start of a parameter list, otherwise the bracket belongs to a type guard.)ashow 466 34 gm 0.75408 0. 32 0.07540 0.(Cocol/R allows control of the parser from within semantic actions to a certain degree. A designator, for)awidthshow 480 34 gm -0.01066 0.(example, can be processed in the following way:)ashow 508 48 gm -0.07012 0.(Designator =)ashow 522 62 gm 0.34149 0. 32 0.03414 0.(Qualident )awidthshow 536 62 gm -0.55903 0.({ \311)ashow 550 62 gm (|)show 550 198 gm -0.10592 0.(\(.)ashow 550 210 gm -0.12097 0.(IF )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.13952 0.(x is procedure)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.18528 0.( THEN RETURN END .\))ashow 564 76 gm 0.06820 0. 32 0.00682 0.("\(" Qualident "\)")awidthshow 564 198 gm -0.44213 0.(\(. )ashow 564 210 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.02212 0. 32 0.00221 0.(process type guard)awidthshow 0 fs bu fc 2 F /|______Helvetica fnt bn ( .\))show 578 62 gm -0.44824 0.(} .)ashow 606 34 gm 0.80352 0. 32 0.08035 0.(When an opening bracket is seen after a )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.25152 0.(Qualident)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.89080 0. 32 0.08908 0.(, the alternative starting with an opening bracket is)awidthshow 620 34 gm 0.01144 0. 32 0.00114 0.(selected. The first semantic action of this alternative checks for the type of x. If x is a procedure, the parser)awidthshow 634 34 gm 0.32333 0. 32 0.03233 0.(returns from the production and continues in the Statement production.)awidthshow F T cp %%Page: ? 15 op 0 0 xl 1 1 pen 20 352 gm (nc 746 0 781 538 6 rc)kp 29 495 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (15)show 67 34 gm (nc 57 0 725 538 6 rc)kp 1 fs 10 fz bu fc 2 F /|______Helvetica-Bold fnt bn 4.61700 0. 32 0.46170 0.(5. Implementation)awidthshow 95 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.76904 0. 32 0.07690 0.(Coco/R was written in Oberon on a Ceres workstation. There is also a Modula-2 version for Macintosh)awidthshow 109 34 gm -0.02037 0.(computers. A preliminary version of Coco/R was implemented as a master's thesis \([Senn89]\). Coco/R was)ashow 123 34 gm 0.03356 0. 32 0.00335 0.(used for its own implementation. Like any compiler, it consists of a scanner \(CRS\), a parser \(CRP\), a table)awidthshow 137 34 gm 0.18997 0. 32 0.01899 0.(handler \(CRT\), and two modules for output generation, one for the scanner \(CRA\) and one for the parser)awidthshow 151 34 gm 0.04028 0. 32 0.00402 0.(\(CRX\). During parsing the scanner description is transformed into a non-deterministic finite automaton and)awidthshow 165 34 gm 0.14129 0. 32 0.01412 0.(the attributed grammar is transformed into a graph. These data structures are used for grammar tests and)awidthshow 179 34 gm 1 64 lw 0.20996 0. 32 0.02099 0.(for the generation of the two source modules.)awidthshow -300 -198 xl 0 0 gm (nc -103 0 0 113 6 rc)kp 0 gr -102.5 58.5 -90.5 86.5 0 rc -94 62 gm F 1 setTxMode 9 fz bu fc 2 F /|______Helvetica fnt bn (Coco)show 0 gr -12.5 0.5 -0.5 25.5 0 rc -4 4 gm F 1 setTxMode -0.49874 0.(CRS)ashow 0 gr -72.5 60.5 -60.5 85.5 0 rc -64 64 gm F 1 setTxMode -0.49874 0.(CRP)ashow 0 gr -12.5 60.5 -0.5 84.5 0 rc -4 64 gm F 1 setTxMode -0.74606 0.(CRT)ashow 0 gr -42.5 87.5 -30.5 112.5 0 rc -34 91 gm F 1 setTxMode -0.49874 0.(CRA)ashow 0 gr -42.5 33.5 -30.5 58.5 0 rc -34 37 gm F 1 setTxMode -0.49874 0.(CRX)ashow -12 72 gm (nc -58 0 0 113 6 rc)kp 0 gr -60 72 lin (nc -103 0 0 113 6 rc)kp -65 67 -55 77 75 105 4 ar -48 45 gm -43 45 lin -48 45 gm -48 66 lin -48 102 gm -43 102 lin -48 102 gm -48 78 lin (nc -58 0 0 113 6 rc)kp -60 78 lin (nc -103 0 0 113 6 rc)kp -65 73 -55 83 75 105 4 ar -48 66 gm (nc -58 0 0 113 6 rc)kp -60 66 lin (nc -103 0 0 113 6 rc)kp -65 61 -55 71 75 105 4 ar -18 66 gm -13 66 lin -18 66 gm -18 45 lin (nc -28 0 0 113 6 rc)kp -30 45 lin (nc -103 0 0 113 6 rc)kp -35 40 -25 50 75 105 4 ar -18 78 gm -13 78 lin -18 78 gm -18 99 lin (nc -28 0 0 113 6 rc)kp -30 99 lin (nc -103 0 0 113 6 rc)kp -35 94 -25 104 75 105 4 ar -13 12 gm -78 12 lin -18 12 gm -18 39 lin (nc -28 0 0 113 6 rc)kp -30 39 lin (nc -103 0 0 113 6 rc)kp -35 34 -25 44 75 105 4 ar -51 12 gm -51 60 lin (nc -58 0 0 113 6 rc)kp -60 60 lin (nc -103 0 0 113 6 rc)kp -65 55 -55 65 75 105 4 ar -73 72 gm (nc -88 0 0 113 6 rc)kp -90 72 lin (nc -103 0 0 113 6 rc)kp -95 67 -85 77 75 105 4 ar -78 12 gm -78 66 lin (nc -88 0 0 113 6 rc)kp -90 66 lin (nc -103 0 0 113 6 rc)kp -95 61 -85 71 75 105 4 ar 64 1 lw 1 1 lw 300 198 xl 342 34 gm (nc 57 0 725 538 6 rc)kp F 1 setTxMode 1 fs 10 fz bu fc 2 F /|______Helvetica-Bold fnt bn 4.22378 0. 32 0.42237 0.(5.1 Scanner Generation)awidthshow 370 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.36285 0. 32 0.03628 0.(During parsing of the compiler description, the token declarations are translated into a syntax graph from)awidthshow 384 34 gm 1.63909 0. 32 0.16390 0.(which a non-deterministic finite automaton is generated. In a second step, this automaton is made)awidthshow 398 34 gm 0.63552 0. 32 0.06355 0.(deterministic. The algorithms for the manipulation of the automaton are described in [M\232ss86]. Figure 1)awidthshow 412 34 gm 1 64 lw 0.40191 0. 32 0.04019 0.(sketches this process.)awidthshow -683 -85 xl 0 0 gm (nc -253 0 0 367 6 rc)kp 64 gr -127 183 0 367 4 rc 0 gr -126.5 183.5 -0.5 366.5 0 rc 64 gr -127 0 0 184 4 rc 0 gr -126.5 0.5 -0.5 183.5 0 rc (nc -82 94 -70 109 6 rc)kp 64 gr -82 91 -70 109 4 ov 0 gr -81.5 91.5 -70.5 108.5 0 ov (nc -85 283 -73 298 6 rc)kp 64 gr -85 280 -73 298 4 ov 0 gr -84.5 280.5 -73.5 297.5 0 ov (nc -42 84 -27 96 6 rc)kp 64 gr -45 84 -27 96 4 ov 0 gr -44.5 84.5 -27.5 95.5 0 ov (nc -43 273 -28 285 6 rc)kp 64 gr -46 273 -28 285 4 ov 0 gr -45.5 273.5 -28.5 284.5 0 ov (nc -253 0 0 367 6 rc)kp 64 gr -253 0 -126 184 4 rc 0 gr -252.5 0.5 -126.5 183.5 0 rc 64 gr -253 183 -126 367 4 rc 0 gr -252.5 183.5 -126.5 366.5 0 rc -212 10 gm F 1 setTxMode 9 fz bu fc 2 F /|______Helvetica fnt bn -0.33288 0.(CHARACTERS)ashow -201 10 gm -0.09483 0.( digit = "0123456789".)ashow -190 10 gm -0.04913 0.( octdigit = "01234567".)ashow -168 10 gm -0.20079 0.(TOKENS)ashow -157 10 gm -0.06816 0.( decimal = digit {digit}.)ashow -146 10 gm 0.03097 0. 32 0.00309 0.( octal = octdigit {octdigit} "B".)awidthshow -200 295 gm 0.12463 0.(digit)ashow -200 250 gm 0.12463 0.(digit)ashow -158 250 gm 0.21356 0.(octdigit)ashow -158 301 gm 0.21356 0.(octdigit)ashow -137 306 gm -0.19628 0.("B")ashow -200 199 gm (decimal :)show -239 52 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.36727 0. 32 0.03672 0.(regular expression)awidthshow -239 247 gm 0.70709 0. 32 0.07070 0.(syntax graph)awidthshow -113 31 gm 0.41229 0. 32 0.04122 0.(non-deterministic automaton)awidthshow -113 226 gm 0.46539 0. 32 0.04653 0.(deterministic automaton)awidthshow -158 199 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.62179 0. 32 0.06217 0.(octal :)awidthshow -203 270 gm (nc -253 0 0 289 6 rc)kp 0 gr -203 291 lin (nc -253 0 0 367 6 rc)kp -208 286 -198 296 165 195 4 ar -203 315 gm -203 324 lin -215 324 lin -215 279 lin (nc -253 0 -205 367 6 rc)kp -203 279 lin (nc -253 0 0 367 6 rc)kp -208 274 -198 284 255 285 4 ar -197 303 gm (nc -253 0 -190 367 6 rc)kp -188 303 lin (nc -253 0 0 367 6 rc)kp -193 298 -183 308 255 285 4 ar -180 301 gm F 1 setTxMode bu fc 2 F /|______Symbol fnt bn (e)show -161 282 gm (nc -253 0 0 295 6 rc)kp 0 gr -161 297 lin (nc -253 0 0 367 6 rc)kp -166 292 -156 302 165 195 4 ar -161 333 gm -161 345 lin -173 345 lin -173 285 lin (nc -253 0 -163 367 6 rc)kp -161 285 lin (nc -253 0 0 367 6 rc)kp -166 280 -156 290 255 285 4 ar -155 312 gm (nc -253 0 -148 367 6 rc)kp -146 312 lin (nc -253 0 0 367 6 rc)kp -151 307 -141 317 255 285 4 ar 64 gr -82 30 -69 43 4 ov 0 gr -81.5 30.5 -69.5 42.5 0 ov 64 gr -85 219 -72 232 4 ov 0 gr -84.5 219.5 -72.5 231.5 0 ov 64 1 lw 1 1 lw 64 gr -82 84 -69 97 4 ov 0 gr -81.5 84.5 -69.5 96.5 0 ov 64 gr -85 273 -72 286 4 ov 0 gr -84.5 273.5 -72.5 285.5 0 ov 1 64 lw 64 gr -52 84 -39 97 4 ov 0 gr -51.5 84.5 -39.5 96.5 0 ov 64 1 lw 1 1 lw 64 gr -52 126 -39 139 4 ov 0 gr -51.5 126.5 -39.5 138.5 0 ov 64 gr -55 315 -42 328 4 ov 0 gr -54.5 315.5 -42.5 327.5 0 ov 1 64 lw -72 34 gm F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn (1)show -75 223 gm (1)show -77 52 gm 0.12463 0.(digit)ashow -80 241 gm ({8, 9})show -62 280 gm ({8, 9})show -47 105 gm (B)show -49 298 gm (B)show -47 43 gm 0.21356 0.(octdigit)ashow -50 232 gm 0.21356 0.(octdigit)ashow -18 76 gm 0.21356 0.(octdigit)ashow -19 265 gm 0.21356 0.(octdigit)ashow -72 110 gm 0.12463 0.(digit)ashow -75 299 gm 0.12463 0.(digit)ashow -72 88 gm (2)show -75 277 gm (2)show -42 88 gm (3)show -42 130 gm (4)show -45 319 gm (4)show -76 42 gm (nc -253 0 0 82 6 rc)kp 0 gr -76 84 lin (nc -253 0 0 367 6 rc)kp -81 79 -71 89 165 195 4 ar -79 231 gm (nc -253 0 0 271 6 rc)kp -79 273 lin (nc -253 0 0 367 6 rc)kp -84 268 -74 278 165 195 4 ar -46 36 gm (nc -253 0 0 82 6 rc)kp -46 84 lin (nc -253 0 0 367 6 rc)kp -51 79 -41 89 165 195 4 ar -49 225 gm (nc -253 0 0 262 6 rc)kp -49 264 lin (nc -253 0 0 367 6 rc)kp -54 259 -44 269 165 195 4 ar -70 36 gm -46 36 lin -73 225 gm -49 225 lin -46 96 gm (nc -253 0 0 124 6 rc)kp -46 126 lin (nc -253 0 0 367 6 rc)kp -51 121 -41 131 165 195 4 ar -49 291 gm (nc -253 0 0 313 6 rc)kp -49 315 lin (nc -253 0 0 367 6 rc)kp -54 310 -44 320 165 195 4 ar -81 96 gm (nc -253 96 0 367 6 rc)kp -80 94 lin (nc -253 0 0 367 6 rc)kp -85 89 -75 99 319 349 4 ar -84 285 gm (nc -253 285 0 367 6 rc)kp -83 283 lin (nc -253 0 0 367 6 rc)kp -88 278 -78 288 319 349 4 ar -39 84 gm (nc -40 0 0 367 6 rc)kp -42 86 lin (nc -253 0 0 367 6 rc)kp -47 81 -37 91 109 139 4 ar -40 273 gm (nc -41 0 0 367 6 rc)kp -43 275 lin (nc -253 0 0 367 6 rc)kp -48 270 -38 280 109 139 4 ar 64 1 lw 1 1 lw 64 gr -55 265 -42 293 23.5 23.5 4 rr 0 gr -54.5 265.5 -42.5 292.5 23.5 23.5 0 rr 1 64 lw -45 268 gm F 1 setTxMode 0.66101 0. 32 0.06610 0.([2, 3])awidthshow -55 279 gm (nc -71 0 0 367 6 rc)kp 0 gr -73 279 lin (nc -253 0 0 367 6 rc)kp -78 274 -68 284 75 105 4 ar 64 1 lw 1 1 lw 2 2 pen -62 146 gm (nc -253 0 0 188 6 rc)kp 32 gr -62 194 lin (nc -253 0 0 367 6 rc)kp -76 180 -46 210 165 195 4 ar -182 146 gm (nc -253 0 0 188 6 rc)kp -182 194 lin (nc -253 0 0 367 6 rc)kp -196 180 -166 210 165 195 4 ar -140 197 gm (nc -253 0 -113 367 6 rc)kp -107 164 lin (nc -253 0 0 367 6 rc)kp -121 150 -91 180 300 330 4 ar 683 85 xl 1 1 pen 706 105 gm (nc 57 0 725 538 6 rc)kp 2.73217 0 rmoveto F 1 setTxMode 1 fs bu fc 2 F /|______Helvetica-Bold fnt bn (Fig. 1)show 0 fs bu fc 2 F /|______Helvetica fnt bn ( Transformation of regular expressions into a deterministic finite automaton)show F T cp %%Page: ? 16 op 0 0 xl 1 1 pen 20 437 gm (nc 746 0 781 538 6 rc)kp 29 34 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (16)show 54 34 gm (nc 44 0 690 538 6 rc)kp 10 fz bu fc 2 F /|______Helvetica fnt bn 0.09826 0. 32 0.00982 0.(The automaton is not generated directly from the regular expressions but from a syntax graph. This allows)awidthshow 68 34 gm 0.25466 0. 32 0.02546 0.(making it more deterministic from the beginning, thus simplifying the later algorithms. Figure 1 shows that)awidthshow 82 34 gm 1.46942 0. 32 0.14694 0.(tokens may have very similar structures, differing only in their last characters. These structures are)awidthshow 96 34 gm 0.91079 0. 32 0.09107 0.(automatically stripped of any disambiguity. The programmer does not have to take care of making the)awidthshow 110 34 gm 0.16586 0. 32 0.01658 0.(beginnings of tokens distinct. Even very complicated structures can be processed like the various kinds of)awidthshow 124 34 gm 1 64 lw -0.03179 0.(numeric constants in Modula-2 \(Figure 2; final states are denoted by bold circles\):)ashow -391 -48 xl 0 0 gm (nc -249 0 0 389 6 rc)kp 64 gr pr -184 168 pl -178 174 pl -175 174 pl -172 171 pl -172 168 pl -178 162 pl 4 ep 0 gr pr -184 168 pl -178 174 pl -175 174 pl -172 171 pl -172 168 pl -178 162 pl 0 ep (nc -49 345 -40 357 6 rc)kp 64 gr -49 342 -40 357 4 ov 0 gr -48.5 342.5 -40.5 356.5 0 ov (nc -249 0 0 389 6 rc)kp 64 gr pr -187 234 pl -196 243 pl -199 243 pl -202 240 pl -202 237 pl -193 228 pl 4 ep 0 gr pr -187 234 pl -196 243 pl -199 243 pl -202 240 pl -202 237 pl -193 228 pl 0 ep 64 gr pr -142 225 pl -151 216 pl -151 213 pl -147 209 pl -145 209 pl -136 218 pl 4 ep 0 gr pr -142 225 pl -151 216 pl -151 213 pl -147 209 pl -145 209 pl -136 218 pl 0 ep -236 4 gm F 1 setTxMode 9 fz bu fc 2 F /|______Helvetica fnt bn -0.03268 0.(integer =)ashow -225 4 gm -0.06776 0.( digit {digit})ashow -214 4 gm -0.10772 0.(| digit {digit} CONTEXT \(".."\))ashow -203 4 gm -0.07946 0.(| digit {hexdigit} "H")ashow -192 4 gm 0.11291 0. 32 0.01129 0.(| octdigit {octdigit} "B".)awidthshow -170 4 gm -0.05148 0.(char =)ashow -159 4 gm 0.01174 0. 32 0.00117 0.( octdigit {octdigit} "C".)awidthshow -137 4 gm -0.15097 0.(real =)ashow -126 4 gm -0.05261 0.( digit {digit} "." {digit})ashow -115 4 gm -0.00845 0.( ["E" ["+"|"-"] digit [digit]].)ashow 64 gr -245 153 -229 169 4 ov 0 gr -244.5 153.5 -229.5 168.5 0 ov 64 1 lw 1 1 lw 64 gr -193 153 -177 169 4 ov 0 gr -192.5 153.5 -177.5 168.5 0 ov 64 gr -193 219 -177 235 4 ov 0 gr -192.5 219.5 -177.5 234.5 0 ov 1 64 lw 64 gr -142 219 -126 235 4 ov 0 gr -141.5 219.5 -126.5 234.5 0 ov 64 1 lw 1 1 lw 64 gr -142 270 -126 286 4 ov 0 gr -141.5 270.5 -126.5 285.5 0 ov 64 gr -52 287 -36 303 4 ov 0 gr -51.5 287.5 -36.5 302.5 0 ov 64 gr -52 330 -36 346 4 ov 0 gr -51.5 330.5 -36.5 345.5 0 ov 1 64 lw 64 gr -94 330 -78 346 4 ov 0 gr -93.5 330.5 -78.5 345.5 0 ov 64 1 lw 1 1 lw 64 gr -136 330 -120 346 4 ov 0 gr -135.5 330.5 -120.5 345.5 0 ov 64 gr -178 330 -162 346 4 ov 0 gr -177.5 330.5 -162.5 345.5 0 ov 1 64 lw 64 gr -136 372 -120 388 4 ov 0 gr -135.5 372.5 -120.5 387.5 0 ov 64 1 lw 1 1 lw 64 gr -16 287 0 303 4 ov 0 gr -15.5 287.5 -0.5 302.5 0 ov 64 gr -82 219 -66 235 4 ov 0 gr -81.5 219.5 -66.5 234.5 0 ov 64 gr -112 186 -96 202 4 ov 0 gr -111.5 186.5 -96.5 201.5 0 ov 1 64 lw -211 163 gm F 1 setTxMode 0.21356 0.(octdigit)ashow -152 190 gm 0.14173 0.(hexdigit)ashow -86 195 gm 0.14173 0.(hexdigit)ashow -119 181 gm 0.14173 0.(hexdigit)ashow -74 163 gm (C)show -107 163 gm (B)show -134 244 gm (H)show -162 268 gm (H)show -74 244 gm (H)show -105 244 gm (H)show -65 307 gm (E)show -59 339 gm (E)show -44 306 gm 0.12463 0.(digit)ashow -101 339 gm 0.12463 0.(digit)ashow -143 339 gm 0.12463 0.(digit)ashow -88 355 gm -0.05267 0.({+, -})ashow -129 351 gm 0.12463 0.(digit)ashow -41 358 gm 0.12463 0.(digit)ashow -26 288 gm 1 fs 12 fz bu fc 2 F /|______Helvetica-Bold fnt bn (.)show -45 165 gm (.)show -140 297 gm (.)show -56 163 gm 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (H)show -167 174 gm 0.21356 0.(octdigit)ashow -202 239 gm 0.12463 0.(digit)ashow -234 159 gm (1)show -182 159 gm (2)show -182 225 gm (3)show -131 224 gm (4)show -131 276 gm (5)show -71 225 gm (7)show -101 192 gm (6)show -41 293 gm (8)show -5 293 gm (9)show -41 333 gm (10)show -83 333 gm (11)show -125 333 gm (12)show -125 375 gm (13)show -167 333 gm (14)show -187 179 gm 0.12037 0.({8,9})ashow -135 162 gm 0.06074 0.({A,D,E,F})ashow -160 229 gm 0.08068 0.({A,B,C})ashow -149 229 gm ({D,E,F})show -240 185 gm 0.12037 0.({8,9})ashow -186 168 gm (nc -249 0 0 217 6 rc)kp 0 gr -186 219 lin (nc -249 0 0 389 6 rc)kp -191 214 -181 224 165 195 4 ar -178 227 gm (nc -249 0 -144 389 6 rc)kp -142 227 lin (nc -249 0 0 389 6 rc)kp -147 222 -137 232 255 285 4 ar -139 215 gm (nc -249 0 -138 389 6 rc)kp -136 218 lin (nc -249 0 0 389 6 rc)kp -141 213 -131 223 210 240 4 ar -178 160 gm -43 160 lin -133 160 gm (nc -249 0 0 217 6 rc)kp -133 219 lin (nc -249 0 0 389 6 rc)kp -138 214 -128 224 165 195 4 ar -74 160 gm (nc -249 0 0 217 6 rc)kp -74 219 lin (nc -249 0 0 389 6 rc)kp -79 214 -69 224 165 195 4 ar -82 227 gm (nc -125 0 0 389 6 rc)kp -127 227 lin (nc -249 0 0 389 6 rc)kp -132 222 -122 232 75 105 4 ar -55 160 gm -55 277 lin -134 234 gm (nc -249 0 0 268 6 rc)kp -134 270 lin (nc -249 0 0 389 6 rc)kp -139 265 -129 275 165 195 4 ar -55 277 gm (nc -125 0 0 389 6 rc)kp -127 277 lin (nc -249 0 0 389 6 rc)kp -132 272 -122 282 75 105 4 ar -74 234 gm (nc -249 0 0 274 6 rc)kp -74 276 lin (nc -249 0 0 389 6 rc)kp -79 271 -69 281 165 195 4 ar -184 234 gm -184 277 lin (nc -249 0 -144 389 6 rc)kp -142 277 lin (nc -249 0 0 389 6 rc)kp -147 272 -137 282 255 285 4 ar -196 231 gm (nc -249 0 -195 389 6 rc)kp -193 228 lin (nc -249 0 0 389 6 rc)kp -198 223 -188 233 300 330 4 ar -43 160 gm (nc -249 0 0 284 6 rc)kp -43 286 lin (nc -249 0 0 389 6 rc)kp -48 281 -38 291 165 195 4 ar -186 234 gm -186 294 lin (nc -249 0 -55 389 6 rc)kp -53 294 lin (nc -249 0 0 389 6 rc)kp -58 289 -48 299 255 285 4 ar -37 294 gm (nc -249 0 -19 389 6 rc)kp -17 294 lin (nc -249 0 0 389 6 rc)kp -22 289 -12 299 255 285 4 ar -43 302 gm (nc -249 0 0 328 6 rc)kp -43 330 lin (nc -249 0 0 389 6 rc)kp -48 325 -38 335 165 195 4 ar -52 337 gm (nc -77 0 0 389 6 rc)kp -79 337 lin (nc -249 0 0 389 6 rc)kp -84 332 -74 342 75 105 4 ar -52 300 gm (nc -80 0 0 389 6 rc)kp -82 330 lin (nc -249 0 0 389 6 rc)kp -87 325 -77 335 120 150 4 ar -94 337 gm (nc -119 0 0 389 6 rc)kp -121 337 lin (nc -249 0 0 389 6 rc)kp -126 332 -116 342 75 105 4 ar -136 337 gm (nc -161 0 0 389 6 rc)kp -163 337 lin (nc -249 0 0 389 6 rc)kp -168 332 -158 342 75 105 4 ar -128 372 gm (nc -249 347 0 389 6 rc)kp -128 345 lin (nc -249 0 0 389 6 rc)kp -133 340 -123 350 345 375 4 ar -86 345 gm -86 379 lin (nc -119 0 0 389 6 rc)kp -121 379 lin (nc -249 0 0 389 6 rc)kp -126 374 -116 384 75 105 4 ar -175 165 gm (nc -176 0 0 389 6 rc)kp -178 162 lin (nc -249 0 0 389 6 rc)kp -183 157 -173 167 30 60 4 ar -230 160 gm (nc -249 0 -196 389 6 rc)kp -194 160 lin (nc -249 0 0 389 6 rc)kp -199 155 -189 165 255 285 4 ar -238 168 gm -238 225 lin (nc -249 0 -195 389 6 rc)kp -193 225 lin (nc -249 0 0 389 6 rc)kp -198 220 -188 230 255 285 4 ar -105 160 gm (nc -249 0 0 183 6 rc)kp -105 185 lin (nc -249 0 0 389 6 rc)kp -110 180 -100 190 165 195 4 ar -109 201 gm (nc -125 0 0 389 6 rc)kp -127 219 lin (nc -249 0 0 389 6 rc)kp -132 214 -122 224 120 150 4 ar -105 201 gm (nc -249 0 0 274 6 rc)kp -105 276 lin (nc -249 0 0 389 6 rc)kp -110 271 -100 281 165 195 4 ar -49 348 gm (nc -249 347 0 389 6 rc)kp -49 345 lin (nc -249 0 0 389 6 rc)kp -54 340 -44 350 345 375 4 ar 64 1 lw 1 1 lw 391 48 xl 419 48 gm (nc 44 0 690 538 6 rc)kp F 1 setTxMode 1 fs bu fc 2 F /|______Helvetica-Bold fnt bn 0.05722 0.(Fig.2)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.19714 0. 32 0.01971 0.( Automaton for the various kinds of numeric constants in Modula-2)awidthshow 447 34 gm 10 fz bu fc 2 F /|______Helvetica fnt bn 0.32257 0. 32 0.03225 0.(If speed is important, a finite automaton is not the best possible implementation of a scanner. It would be)awidthshow 461 34 gm 1.67327 0. 32 0.16732 0.(more efficient to implement the recognition of tokens as ordinary procedures like in a hand-written)awidthshow 475 34 gm 0.82321 0. 32 0.08232 0.(scanner. However, if one looks at the Figure 2, one can imagine that it is not easy to generate such a)awidthshow 489 34 gm 1.36077 0. 32 0.13607 0.(scanner automatically. On the other hand, an automaton is space-efficient. Therefore we decided to)awidthshow 503 34 gm 0.72937 0. 32 0.07293 0.(generate the scanner as an automaton. To make it as efficient as possible, the automaton is not table-)awidthshow 517 34 gm 0.14190 0. 32 0.01419 0.(driven but implemented in code. For the token declarations)awidthshow 545 48 gm 0.05355 0. 32 0.00535 0.(ident = letter {letter|digit}.)awidthshow 559 48 gm -0.00881 0.(number = digit {digit}.)ashow 587 34 gm 0.08255 0. 32 0.00825 0.(and the occurrence of the literals "IF", "THEN", "END", "<", and "<=" in the productions of the grammar the)awidthshow 601 34 gm 0.36727 0. 32 0.03672 0.(automaton of Figure 3 is generated. The textual representation of token classes like )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.09194 0.(ident)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.12771 0. 32 0.01277 0.( or )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.11981 0.(number)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.30822 0. 32 0.03082 0.( can)awidthshow 615 34 gm 2.55218 0. 32 0.25521 0.(be obtained via the procedure )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.92396 0.(GetName)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.50308 0.(\()ashow 9 fz bu fc 2 F /|______Symbol fnt bn 0.82017 0.(\257)ashow 2 fs 10 fz bu fc 2 F /|______Helvetica-Oblique fnt bn 0.81227 0.(pos)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.70007 0. 32 0.07000 0.(, )awidthshow 9 fz bu fc 2 F /|______Symbol fnt bn 0.82017 0.(\257)ashow 2 fs 10 fz bu fc 2 F /|______Helvetica-Oblique fnt bn 0.67213 0.(len)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.70007 0. 32 0.07000 0.(, )awidthshow 9 fz bu fc 2 F /|______Symbol fnt bn 0.82017 0.(\255)ashow 2 fs 10 fz bu fc 2 F /|______Helvetica-Oblique fnt bn 0.74761 0.(sourceText)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.94961 0. 32 0.19496 0.(\) where )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.81227 0.(pos)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.34460 0. 32 0.13446 0.( and )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.67213 0.(len)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.89819 0. 32 0.18981 0.( are the)awidthshow 629 34 gm 1.78665 0. 32 0.17866 0.(position and length of the token in the source file. Note, that keywords cannot be handled by the)awidthshow 643 34 gm -0.02296 0.(automaton since they have the same structure as identifiers. This fact is taken into account by Coco/R: Any)ashow 657 34 gm 0.49087 0. 32 0.04908 0.(literal that matches a declared token is stored in a literal list. Later, when an identifier is recognized, it is)awidthshow 671 34 gm 0.42648 0. 32 0.04264 0.(checked whether it is a literal \()awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.13656 0.(CheckLiteral)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.49011 0. 32 0.04901 0.(\), and if so, the literal's token number is returned. Comments)awidthshow 685 34 gm -0.00424 0.(are not handled by the automaton. They are recognized by a special procedure.)ashow F T cp %%Page: ? 17 op 0 0 xl 1 1 pen 20 386 gm (nc 746 0 781 538 6 rc)kp 29 495 gm (nc 0 0 35 538 6 rc)kp 1 64 lw F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (17)show -285 -34 xl 0 0 gm (nc -229 118 -220 130 6 rc)kp 64 gr -229 115 -220 130 4 ov 0 gr -228.5 115.5 -220.5 129.5 0 ov (nc -199 118 -190 130 6 rc)kp 64 gr -199 115 -190 130 4 ov 0 gr -198.5 115.5 -190.5 129.5 0 ov 64 1 lw 1 1 lw (nc -235 0 0 443 6 rc)kp 64 gr -232 103 -216 119 4 ov 0 gr -231.5 103.5 -216.5 118.5 0 ov 64 gr -202 103 -186 119 4 ov 0 gr -201.5 103.5 -186.5 118.5 0 ov 64 gr -172 115 -156 131 4 ov 0 gr -171.5 115.5 -156.5 130.5 0 ov 1 64 lw 64 gr -172 79 -156 95 4 ov 0 gr -171.5 79.5 -156.5 94.5 0 ov 64 gr -232 46 -216 62 4 ov 0 gr -231.5 46.5 -216.5 61.5 0 ov -224 134 gm F 1 setTxMode bu fc 2 F /|______Helvetica fnt bn 0.20007 0.(letter)ashow -213 134 gm 0.12463 0.(digit)ashow -191 134 gm 0.12463 0.(digit)ashow -226 68 gm 0.20007 0.(letter)ashow -226 212 gm -0.04966 0.(Get\(VAR sym: INTEGER\))ashow -4 212 gm -0.07183 0.(END Get;)ashow -196 68 gm 0.12463 0.(digit)ashow -166 65 gm (<)show -166 98 gm (=)show -220 52 gm (0)show -220 107 gm (1)show -190 107 gm (2)show -160 83 gm (3)show -148 49 gm (\311)show -160 119 gm (4)show -215 221 gm (\311)show -204 221 gm 0.40817 0. 32 0.04081 0.(state := startState[ch]; pos := chPos; len := 0;)awidthshow -193 221 gm (LOOP)show -182 221 gm -0.07853 0.( NextCh; INC\(len\);)ashow -171 221 gm -0.13423 0.( CASE state OF)ashow -160 221 gm -0.15074 0.( 1: IF \(ch>="A"\) & \(ch<="Z"\) OR \(ch>="a"\) & \(ch<="z"\) )ashow -149 221 gm -0.18882 0.( OR \(ch>="0"\) & \(ch<="9"\) THEN state := 1)ashow -138 221 gm -0.13345 0.( ELSE sym := ident; CheckLiteral; RETURN)ashow -127 221 gm -0.50016 0.( END)ashow -116 221 gm -0.13627 0.( | 2: IF \(ch>="0"\) & \(ch<="9"\) THEN state := 2)ashow -105 221 gm -0.24304 0.( ELSE sym := number; RETURN)ashow -94 221 gm -0.50016 0.( END)ashow -83 221 gm -0.17680 0.( | 3: IF ch = "=" THEN state := 4)ashow -72 221 gm -0.21798 0.( ELSE sym := lss; RETURN)ashow -61 221 gm -0.50016 0.( END)ashow -50 221 gm -0.20364 0.( | 4: sym := leq; RETURN)ashow -39 221 gm -0.50047 0.( \311)ashow -28 221 gm -0.49977 0.( END)ashow -17 221 gm -0.49874 0.(END)ashow -224 61 gm (nc -235 0 0 100 6 rc)kp 0 gr -224 102 lin (nc -235 0 0 443 6 rc)kp -229 97 -219 107 165 195 4 ar -194 54 gm (nc -235 0 0 100 6 rc)kp -194 102 lin (nc -235 0 0 443 6 rc)kp -199 97 -189 107 165 195 4 ar -164 54 gm (nc -235 0 0 76 6 rc)kp -164 78 lin (nc -235 0 0 443 6 rc)kp -169 73 -159 83 165 195 4 ar -164 94 gm (nc -235 0 0 112 6 rc)kp -164 114 lin (nc -235 0 0 443 6 rc)kp -169 109 -159 119 165 195 4 ar -221 120 gm (nc -235 119 0 443 6 rc)kp -222 117 lin (nc -235 0 0 443 6 rc)kp -227 112 -217 122 3 33 4 ar -191 120 gm (nc -235 119 0 443 6 rc)kp -192 117 lin (nc -235 0 0 443 6 rc)kp -197 112 -187 122 3 33 4 ar -217 54 gm -157 54 lin 64 1 lw 1 1 lw 285 34 xl 299 85 gm (nc 50 0 598 538 6 rc)kp F 1 setTxMode 1 fs bu fc 2 F /|______Helvetica-Bold fnt bn 0.27206 0. 32 0.02720 0.(Fig. 3)awidthshow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.27496 0. 32 0.02749 0.( Implementation of an automaton)awidthshow 327 34 gm 10 fz bu fc 2 F /|______Helvetica fnt bn 0.70480 0. 32 0.07048 0.(The most time-consuming task in scanning is reading the source text. The scanner can be speeded up)awidthshow 341 34 gm 0.30303 0. 32 0.03030 0.(significantly if reading can be made faster. To read a text character by character is usually slower than to)awidthshow 355 34 gm -0.04710 0.(read it in blocks that correspond to disk sectors. With the large memories available today, it is even possible)ashow 369 34 gm 0.68328 0. 32 0.06832 0.(to read the whole source text into memory at once. In the Oberon system this is more than three times)awidthshow 383 34 gm 0.56579 0. 32 0.05657 0.(faster than reading it character by character. Even large Oberon programs rarely exceed 40 kilobytes in)awidthshow 397 34 gm 0.45913 0. 32 0.04591 0.(source code. With several megabytes of memory available, this "waste" of 40 kilobytes seems justified if)awidthshow 411 34 gm -0.04696 0.(scanning speed can be improved so drastically \(the overall run time of the compiler is improved by 30%\).)ashow 439 34 gm 0.79376 0. 32 0.07937 0.(Having the whole source text in memory has yet another advantage: the source text can be used as a)awidthshow 453 34 gm 0.15472 0. 32 0.01547 0.(name list. The text of token classes, like identifiers, no longer has to be copied to a separate name list but)awidthshow 467 34 gm 0.22033 0. 32 0.02203 0.(can remain where it is. One simply has to remember its position and its length. This idea is in accordance)awidthshow 481 34 gm 1.16485 0. 32 0.11648 0.(with the principle that during scanning every input character should be "touched" as little as possible)awidthshow 495 34 gm 0.11026 0.([Waite86].)ashow 523 34 gm 1.11862 0. 32 0.11186 0.(Another advantage of this technique is that it permits the backup of the input pointer to any previous)awidthshow 537 34 gm 0.30258 0. 32 0.03025 0.(position. This is useful for handling tokens with CONTEXT phrases in Cocol/R. To recognize such tokens)awidthshow 551 34 gm 0.76873 0. 32 0.07687 0.(the right-hand context has to be analyzed, too. After the token and its context have been scanned, the)awidthshow 565 34 gm -0.02268 0.(input pointer is simply decreased by the length of the CONTEXT phrase, so that this text will be read by the)ashow 579 34 gm -0.04434 0.(scanner again.)ashow F T cp %%Page: ? 18 op 0 0 xl 1 1 pen 20 99 gm (nc 746 0 781 538 6 rc)kp 29 34 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (18)show 60 34 gm (nc 50 0 720 538 6 rc)kp 1 fs 10 fz bu fc 2 F /|______Helvetica-Bold fnt bn 3.91159 0. 32 0.39115 0.(5.2 Parser Generation)awidthshow 88 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.58898 0. 32 0.05889 0.(The productions of the attributed grammar are translated into procedures of a recursive descent parser.)awidthshow 102 34 gm 0.48248 0. 32 0.04824 0.(However, it is not possible to generate the parser on the fly while the grammar is analyzed since certain)awidthshow 116 34 gm 0.32974 0. 32 0.03297 0.(sets of terminal symbols are required at various locations in the parsing procedures. These sets can only)awidthshow 130 34 gm 0.01449 0. 32 0.00144 0.(be computed when the whole grammar is known. Therefore, the productions are first translated into syntax)awidthshow 144 34 gm 0.77209 0. 32 0.07720 0.(graphs, then the symbol sets are computed, and finally the parsing procedures are generated from the)awidthshow 158 34 gm -0.02291 0.(graphs. The syntax graphs are also used for grammar tests \(completeness, redundancy, LL\(1\) property\).)ashow 186 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 1.25549 0. 32 0.12554 0.(Syntax graphs)awidthshow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.71319 0. 32 0.07131 0.(. A node is generated for every symbol in the grammar and for every semantic action. A)awidthshow 200 34 gm 0.09628 0. 32 0.00962 0.(sequence of symbols and actions is translated into a sequence of nodes. A semantic action node contains)awidthshow 214 34 gm 1.60842 0. 32 0.16084 0.(the position and the length of the action in the source text. Alternatives, options and iterations are)awidthshow 228 34 gm 1 64 lw 0.08285 0. 32 0.00828 0.(modelled by special nodes of the following form)awidthshow -311 -48 xl 0 0 gm (nc -65 0 0 385 6 rc)kp 64 gr -38 9 -25 40 4 rc 0 gr -37.5 9.5 -25.5 39.5 0 rc 64 gr -38 210 -25 241 4 rc 0 gr -37.5 210.5 -25.5 240.5 0 rc 64 gr -26 9 -13 40 4 rc 0 gr -25.5 9.5 -13.5 39.5 0 rc 64 gr -14 9 -1 40 4 rc 0 gr -13.5 9.5 -1.5 39.5 0 rc 64 gr -26 210 -13 241 4 rc 0 gr -25.5 210.5 -13.5 240.5 0 rc -29 58 gm F 1 setTxMode 9 fz bu fc 2 F /|______Helvetica fnt bn 1.18652 0. 32 0.11865 0.(to successor)awidthshow -29 259 gm 1.18652 0. 32 0.11865 0.(to successor)awidthshow -56 208 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.16485 0.(option,)ashow -45 208 gm 0.12458 0.(iteration)ashow -47 4 gm 0.14933 0.(alternative)ashow -16 58 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.29449 0. 32 0.02944 0.(to start node of alternative)awidthshow -4 58 gm 0.29708 0. 32 0.02970 0.(to next branch)awidthshow -16 259 gm 0.24398 0. 32 0.02439 0.(to start node of inner structure)awidthshow -32 33 gm (nc -65 0 0 49 6 rc)kp 0 gr -32 51 lin (nc -65 0 0 385 6 rc)kp -37 46 -27 56 165 195 4 ar -32 234 gm (nc -65 0 0 250 6 rc)kp -32 252 lin (nc -65 0 0 385 6 rc)kp -37 247 -27 257 165 195 4 ar -20 33 gm (nc -65 0 0 49 6 rc)kp -20 51 lin (nc -65 0 0 385 6 rc)kp -25 46 -15 56 165 195 4 ar -8 33 gm (nc -65 0 0 49 6 rc)kp -8 51 lin (nc -65 0 0 385 6 rc)kp -13 46 -3 56 165 195 4 ar -20 234 gm (nc -65 0 0 250 6 rc)kp -20 252 lin (nc -65 0 0 385 6 rc)kp -25 247 -15 257 165 195 4 ar 64 1 lw 1 1 lw 311 48 xl 339 34 gm (nc 50 0 720 538 6 rc)kp F 1 setTxMode 10 fz bu fc 2 F /|______Helvetica fnt bn 0.30441 0. 32 0.03044 0.(A production like)awidthshow 367 48 gm -0.02561 0.(Expression )ashow 367 204 gm -0.10592 0.(\(.)ashow 367 215 gm -0.14468 0.(VAR y: OGT.Item; op: INTEGER .\))ashow 381 48 gm (=)show 381 62 gm -0.02314 0.(SimExpr )ashow 395 62 gm ([)show 395 76 gm 0.68832 0. 32 0.06883 0.(Relop )awidthshow 395 204 gm -0.10592 0.(\(.)ashow 395 215 gm -0.09780 0.(IF x.typ.form = Bool THEN OGE.MOp\(op, x\) END .\))ashow 409 76 gm -0.02314 0.(SimExpr )ashow 409 204 gm -0.10592 0.(\(.)ashow 409 215 gm -0.06182 0.(OGE.Op\(op, x, y\) .\))ashow 423 62 gm (|)show 423 76 gm -0.07380 0.("IN" SimExpr )ashow 423 204 gm -0.10592 0.(\(.)ashow 423 215 gm -0.17417 0.(OGE.In\(x, y\) .\))ashow 437 62 gm (|)show 437 76 gm -0.08154 0.("IS" )ashow 437 204 gm -0.10592 0.(\(.)ashow 437 215 gm -0.12344 0.(IF x.mode >= Typ THEN err\(112\) END .\))ashow 451 76 gm 0.44128 0. 32 0.04412 0.(qualident )awidthshow 451 204 gm -0.10592 0.(\(.)ashow 451 215 gm -0.09649 0.(IF y.mode = Typ THEN OGE.TypTest\(x, y\) ELSE err\(52\) END .\))ashow 465 62 gm 0.44335 0.(].)ashow 493 34 gm 1 64 lw -0.01289 0.(is translated into the following graph)ashow -673 -48 xl -153 161 gm (nc -162 0 0 370 6 rc)kp 2 fs 9 fz bu fc 2 F /|______Helvetica-Oblique fnt bn 0.24656 0.(opt)ashow -114 182 gm 0.24949 0.(alt)ashow -75 182 gm 0.24949 0.(alt)ashow -36 182 gm 0.24949 0.(alt)ashow -137 88 gm 0 fs bu fc 2 F /|______Helvetica fnt bn (SimExpr)show -138 4 gm 0.16578 0.(Expression)ashow -138 55 gm bu fc 2 F /|______Symbol fnt bn (\336)show -93 295 gm bu fc 2 F /|______Helvetica fnt bn (SimExpr)show -57 244 gm (SimExpr)show -18 280 gm 0.06072 0.(qualident)ashow -93 217 gm -0.12539 0.(RelOp)ashow -93 259 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn (sem)show -18 244 gm (sem)show -93 349 gm (sem)show -57 298 gm (sem)show -18 334 gm (sem)show -57 217 gm 0 fs bu fc 2 F /|______Helvetica fnt bn (IN)show -18 217 gm 0.49656 0.(IS)ashow -142 129 gm (nc -162 0 0 148 6 rc)kp 0 gr -142 150 lin (nc -162 0 0 370 6 rc)kp -147 145 -137 155 165 195 4 ar -97 243 gm (nc -162 0 0 253 6 rc)kp -97 255 lin (nc -162 0 0 370 6 rc)kp -102 250 -92 260 165 195 4 ar -97 279 gm (nc -162 0 0 289 6 rc)kp -97 291 lin (nc -162 0 0 370 6 rc)kp -102 286 -92 296 165 195 4 ar -22 264 gm (nc -162 0 0 274 6 rc)kp -22 276 lin (nc -162 0 0 370 6 rc)kp -27 271 -17 281 165 195 4 ar -61 228 gm (nc -162 0 0 238 6 rc)kp -61 240 lin (nc -162 0 0 370 6 rc)kp -66 235 -56 245 165 195 4 ar -22 228 gm (nc -162 0 0 238 6 rc)kp -22 240 lin (nc -162 0 0 370 6 rc)kp -27 235 -17 245 165 195 4 ar -97 333 gm (nc -162 0 0 343 6 rc)kp -97 345 lin (nc -162 0 0 370 6 rc)kp -102 340 -92 350 165 195 4 ar -61 282 gm (nc -162 0 0 292 6 rc)kp -61 294 lin (nc -162 0 0 370 6 rc)kp -66 289 -56 299 165 195 4 ar -22 318 gm (nc -162 0 0 328 6 rc)kp -22 330 lin (nc -162 0 0 370 6 rc)kp -27 325 -17 335 165 195 4 ar 64 gr -148 153 -138 181 4 rc 0 gr -147.5 153.5 -138.5 180.5 0 rc 64 gr -112 165 -102 193 4 rc 0 gr -111.5 165.5 -102.5 192.5 0 rc 64 gr -73 165 -63 193 4 rc 0 gr -72.5 165.5 -63.5 192.5 0 rc 64 gr -34 165 -24 193 4 rc 0 gr -33.5 165.5 -24.5 192.5 0 rc 64 gr -139 153 -129 181 4 rc 0 gr -138.5 153.5 -129.5 180.5 0 rc 64 gr -103 165 -93 193 4 rc 0 gr -102.5 165.5 -93.5 192.5 0 rc 64 gr -64 165 -54 193 4 rc 0 gr -63.5 165.5 -54.5 192.5 0 rc 64 gr -25 165 -15 193 4 rc 0 gr -24.5 165.5 -15.5 192.5 0 rc 64 gr -94 165 -84 193 4 rc 0 gr -93.5 165.5 -84.5 192.5 0 rc 64 gr -55 165 -45 193 4 rc 0 gr -54.5 165.5 -45.5 192.5 0 rc 64 gr -16 165 -6 193 4 rc 0 gr -15.5 165.5 -6.5 192.5 0 rc -143 174 gm -143 186 lin -107 186 gm -107 198 lin -68 186 gm -68 198 lin -29 186 gm -29 198 lin -146 186 gm -140 186 lin -110 198 gm -104 198 lin -71 198 gm -65 198 lin -32 198 gm -26 198 lin -133 167 gm (nc -162 0 -117 370 6 rc)kp -115 167 lin (nc -162 0 0 370 6 rc)kp -120 162 -110 172 255 285 4 ar -88 179 gm (nc -162 0 -78 370 6 rc)kp -76 179 lin (nc -162 0 0 370 6 rc)kp -81 174 -71 184 255 285 4 ar -49 179 gm (nc -162 0 -39 370 6 rc)kp -37 179 lin (nc -162 0 0 370 6 rc)kp -42 174 -32 184 255 285 4 ar -98 186 gm (nc -162 0 0 208 6 rc)kp -98 210 lin (nc -162 0 0 370 6 rc)kp -103 205 -93 215 165 195 4 ar -59 186 gm (nc -162 0 0 208 6 rc)kp -59 210 lin (nc -162 0 0 370 6 rc)kp -64 205 -54 215 165 195 4 ar -20 186 gm (nc -162 0 0 208 6 rc)kp -20 210 lin (nc -162 0 0 370 6 rc)kp -25 205 -15 215 165 195 4 ar -10 179 gm -1 179 lin -1 176 gm -1 182 lin 64 1 lw 1 1 lw 673 48 xl 687 48 gm (nc 50 0 720 538 6 rc)kp F 1 setTxMode 1 fs bu fc 2 F /|______Helvetica-Bold fnt bn 0.29739 0. 32 0.02973 0.(Fig. 4)awidthshow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.31021 0. 32 0.03102 0.( Syntax graph for the generation of parsing procedures)awidthshow F T cp %%Page: ? 19 op 0 0 xl 1 1 pen 20 297 gm (nc 746 0 781 538 6 rc)kp 29 495 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (19)show 60 34 gm (nc 50 0 723 538 6 rc)kp 10 fz bu fc 2 F /|______Helvetica fnt bn 0.62149 0. 32 0.06214 0.(Note that this kind of graphs is different from the syntax graphs used for scanner generation \(Figure 1\).)awidthshow 74 34 gm 0.12710 0. 32 0.01271 0.(Alternatives, options and iterations are represented by special nodes. This makes the graphs better suited)awidthshow 88 34 gm 1.12411 0. 32 0.11241 0.(for the generation of recursive descent parsers. Having the graphs and the symbol sets, it is easy to)awidthshow 102 34 gm 0.66116 0. 32 0.06611 0.(generate parsing procedures. A sequence of nodes is translated into a sequence of parsing constructs.)awidthshow 116 34 gm 0.52078 0. 32 0.05207 0.(Semantic actions are simply copied from the source text without modification. The following table shows)awidthshow 130 34 gm -0.07427 0.(that every grammar item can be replaced mechanically by the equivalent parsing item.)ashow 158 159 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.24090 0.(grammar item)ashow 158 255 gm -0.04055 0.(parsing item)ashow 172 48 gm 0 fs bu fc 2 F /|______Helvetica fnt bn -0.16595 0.(terminal )ashow 172 159 gm (t)show 172 255 gm 0.12496 0.(Expect\(t\))ashow 186 48 gm (nonterminal )show 186 159 gm -0.05879 0.(nt )ashow 186 255 gm -0.09533 0.(nt\(a, b\))ashow 200 48 gm -0.08222 0.(semantic action )ashow 200 159 gm -0.07397 0.(\(. )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.12690 0.(anyText)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.11096 0.( .\))ashow 200 255 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.07272 0.(anyText)ashow 228 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.04623 0. 32 0.00462 0.(Terminals are recognized by the procedure)awidthshow 256 48 gm -0.05937 0.(PROCEDURE Expect\(s: INTEGER\);)ashow 270 48 gm -0.21556 0.(BEGIN IF sym = s THEN Get ELSE Error\(s\) END)ashow 284 48 gm 0.38421 0. 32 0.03842 0.(END Expect;)awidthshow 312 34 gm 1.18621 0. 32 0.11862 0.(The procedure )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.31959 0.(Get)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.92086 0. 32 0.09208 0.( requests the next input token from the scanner and stores it in the global variable)awidthshow 326 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.10906 0.(sym)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.07380 0.(. It is also responsible for filtering out pragmas.)ashow 354 48 gm -0.04278 0.(PROCEDURE Get;)ashow 368 48 gm -0.27894 0.(BEGIN)ashow 382 62 gm 0.17639 0. 32 0.01763 0.(LOOP Scanner.Get\(sym\);)awidthshow 396 76 gm -0.15687 0.(IF )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.20170 0.(sym is pragma)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.22036 0.( THEN )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.17684 0.(Handle it)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.23970 0.( ELSE EXIT END)ashow 410 62 gm -0.05427 0.(END)ashow 424 48 gm -0.11152 0.(END Get;)ashow 452 34 gm 0.69152 0. 32 0.06915 0.(Alternatives, options and iterations are translated into control structures. Whenever possible, redundant)awidthshow 466 34 gm -0.00337 0.(checks are eliminated. The following procedure is generated from the graph in Figure 4.)ashow 494 48 gm -0.05545 0.(PROCEDURE Expression \(VAR x: OGT.Item\);)ashow 508 62 gm -0.11546 0.(VAR y: OGT.Item; op: INTEGER;)ashow 522 48 gm -0.37878 0.(BEGIN )ashow 536 62 gm -0.02070 0.(SimExpr\(x\);)ashow 550 62 gm -0.11595 0.(IF sym IN {eql, neq, lss, leq, gtr, geq, in, is} THEN)ashow 564 76 gm -0.11177 0.(IF sym IN {eql, neq, lss, leq, gtr, geq} THEN)ashow 578 91 gm -0.05162 0.(Relop\(op\); IF x.typ.form = Bool THEN OGE.MOp\(op, x\) END;)ashow 592 91 gm -0.03546 0.(SimExpr\(y\); OGE.Op\(op, x, y\);)ashow 606 76 gm -0.17007 0.(ELSIF sym = in THEN)ashow 620 91 gm -0.10313 0.(Get; SimExpr\(y\); OGE.In\(x, y\);)ashow 634 76 gm 0.47702 0.(ELSE)ashow 648 91 gm -0.10284 0.(Get; IF x.mode >= Typ THEN err\(112\) END;)ashow 662 91 gm -0.06053 0.(qualident\(y\); IF y.mode = Typ THEN OGE.TypTest\(x, y\) ELSE err\(52\) END;)ashow 676 76 gm -0.05427 0.(END)ashow 690 62 gm -0.05427 0.(END)ashow 704 48 gm 0.36727 0. 32 0.03672 0.(END Expression;)awidthshow F T cp %%Page: ? 20 op 0 0 xl 1 1 pen 20 125 gm (nc 746 0 781 538 6 rc)kp 29 34 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (20)show 65 34 gm (nc 55 0 727 538 6 rc)kp 10 fz bu fc 2 F /|______Helvetica fnt bn 1.61132 0. 32 0.16113 0.(A more interesting example is the following production, which also contains iterations. \(For brevity,)awidthshow 79 34 gm -0.03660 0.(semantic actions are not shown.\))ashow 107 48 gm -0.12524 0.(FormalParameters = "\(" [ FormPar { ";" FormPar} ] "\)" [":" qualident]. )ashow 135 34 gm 1 64 lw 0.08804 0. 32 0.00880 0.(The corresponding syntax graph is)awidthshow -274 -48 xl -112 158 gm (nc -121 0 0 384 6 rc)kp 2 fs 9 fz bu fc 2 F /|______Helvetica-Oblique fnt bn 0.24656 0.(opt)ashow -112 305 gm 0.24656 0.(opt)ashow -56 227 gm 0.16804 0.(iter)ashow -99 118 gm 0 fs bu fc 2 F /|______Helvetica fnt bn (\()show -99 208 gm (\))show -45 163 gm -0.16525 0.(FormPar)ashow -4 265 gm -0.16525 0.(FormPar)ashow -61 343 gm 0.06072 0.(qualident)ashow -6 232 gm (;)show -63 310 gm (:)show -100 4 gm -0.03280 0.(FormalParameters)ashow -100 85 gm bu fc 2 F /|______Symbol fnt bn (\336)show -102 126 gm (nc -121 0 0 145 6 rc)kp 0 gr -102 147 lin (nc -121 0 0 384 6 rc)kp -107 142 -97 152 165 195 4 ar -102 216 gm (nc -121 0 0 292 6 rc)kp -102 294 lin (nc -121 0 0 384 6 rc)kp -107 289 -97 299 165 195 4 ar -48 201 gm (nc -121 0 0 211 6 rc)kp -48 213 lin (nc -121 0 0 384 6 rc)kp -53 208 -43 218 165 195 4 ar -9 243 gm (nc -121 0 0 253 6 rc)kp -9 255 lin (nc -121 0 0 384 6 rc)kp -14 250 -4 260 165 195 4 ar -66 321 gm (nc -121 0 0 331 6 rc)kp -66 333 lin (nc -121 0 0 384 6 rc)kp -71 328 -61 338 165 195 4 ar 64 gr -107 150 -97 178 4 rc 0 gr -106.5 150.5 -97.5 177.5 0 rc 64 gr -107 297 -97 325 4 rc 0 gr -106.5 297.5 -97.5 324.5 0 rc 64 gr -53 219 -43 247 4 rc 0 gr -52.5 219.5 -43.5 246.5 0 rc 64 gr -98 150 -88 178 4 rc 0 gr -97.5 150.5 -88.5 177.5 0 rc 64 gr -98 297 -88 325 4 rc 0 gr -97.5 297.5 -88.5 324.5 0 rc 64 gr -44 219 -34 247 4 rc 0 gr -43.5 219.5 -34.5 246.5 0 rc -102 318 gm -102 330 lin -48 240 gm F 32pat -48 252 lin -105 330 gm 0 gr -99 330 lin -92 164 gm (nc -121 0 -58 384 6 rc)kp -56 164 lin (nc -121 0 0 384 6 rc)kp -61 159 -51 169 255 285 4 ar -92 311 gm (nc -121 0 -76 384 6 rc)kp -74 311 lin (nc -121 0 0 384 6 rc)kp -79 306 -69 316 255 285 4 ar -38 233 gm (nc -121 0 -22 384 6 rc)kp -20 233 lin (nc -121 0 0 384 6 rc)kp -25 228 -15 238 255 285 4 ar -102 171 gm (nc -121 0 0 193 6 rc)kp -102 195 lin (nc -121 0 0 384 6 rc)kp -107 190 -97 200 165 195 4 ar -8 303 gm 32 gr -8 315 lin F 32pat -41 315 lin (nc -121 251 0 384 6 rc)kp F 32pat -41 249 lin (nc -121 0 0 384 6 rc)kp -46 244 -36 254 345 375 4 ar -74 252 gm F 32pat -48 252 lin -74 252 gm F 32pat -74 207 lin (nc -90 0 0 384 6 rc)kp F 32pat -92 207 lin (nc -121 0 0 384 6 rc)kp -97 202 -87 212 75 105 4 ar 64 1 lw 1 1 lw 274 48 xl 288 34 gm (nc 55 0 727 538 6 rc)kp F 1 setTxMode 10 fz bu fc 2 F /|______Helvetica fnt bn 0.24398 0. 32 0.02439 0.(Dotted arrows denote pointers to the successors of inner structures. They help in the computation of start)awidthshow 302 34 gm 0.04760 0. 32 0.00476 0.(and successor sets. The graph is translated into the following procedure:)awidthshow 330 48 gm -0.08494 0.(PROCEDURE FormalParameters;)ashow 344 48 gm -0.27894 0.(BEGIN)ashow 358 62 gm 0.08129 0.(Expect\(leftpar\);)ashow 372 62 gm -0.24386 0.(IF sym IN {ident, var} THEN)ashow 386 76 gm -0.09397 0.(FormPar;)ashow 400 76 gm -0.15408 0.(WHILE sym = semicolon DO Get; FormPar END)ashow 414 62 gm 0.03778 0.(END;)ashow 428 62 gm 0.06941 0.(Expect\(rightpar\);)ashow 442 62 gm -0.11325 0.(IF sym = colon THEN Get; qualident END)ashow 456 48 gm -0.12164 0.(END FormalParameters;)ashow 498 34 gm 1 fs bu fc 2 F /|______Helvetica-Bold fnt bn 3.53759 0. 32 0.35375 0.(5.3 Error Recovery)awidthshow 526 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.37948 0. 32 0.03794 0.(Good and efficient error recovery is difficult in recursive descent parsers since little information about the)awidthshow 540 34 gm -0.09342 0.(parsing process is available when an error occurs. What has to be done in case of an error:)ashow 568 34 gm 0.66255 0.(1.)ashow 568 48 gm -0.02464 0.(Find all symbols with which parsing can be resumed at a certain location in the grammar reachable from)ashow 582 48 gm -0.02687 0.(the error location \(recovery symbols\).)ashow 596 34 gm 0.66255 0.(2.)ashow 596 48 gm -0.01962 0.(Skip the input up to the first symbol that is in the recovery set.)ashow 610 34 gm 0.66255 0.(3.)ashow 610 48 gm -0.01808 0.(Drive the parser to the location where the recovery symbol can be recognized. )ashow 624 34 gm 0.66255 0.(4.)ashow 624 48 gm 0.01892 0. 32 0.00189 0.(Resume parsing from there.)awidthshow 652 34 gm 0.68267 0. 32 0.06826 0.(In recursive descent parsers, information about the parsing location and about the expected symbols is)awidthshow 666 34 gm 0.53787 0. 32 0.05378 0.(only implicitly contained in the parser code \(and in the procedure call stack\) and cannot be exploited for)awidthshow 680 34 gm 0.35415 0. 32 0.03541 0.(error recovery. One method to overcome this is to compute the recovery set dynamically during parsing.)awidthshow 694 34 gm 0.24993 0. 32 0.02499 0.(Then, when an error occurs, the recovery symbols are already known and all that one has to do is to skip)awidthshow 708 34 gm 1.62490 0. 32 0.16249 0.(erroneous input and to "unroll" the procedure stack up to a legal continuation point [Wirth76]. This)awidthshow 722 34 gm 0.21347 0. 32 0.02134 0.(technique, although systematically applicable, slows down error-free parsing and inflates the parser code.)awidthshow F T cp %%Page: ? 21 op 0 0 xl 1 1 pen 20 505 gm (nc 746 0 781 538 6 rc)kp 29 495 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (21)show 56 34 gm (nc 46 0 713 538 6 rc)kp 10 fz bu fc 2 F /|______Helvetica fnt bn 1.53854 0. 32 0.15385 0.(Another technique has therefore been suggested in [Wirth86]. Recovery takes place only at certain)awidthshow 70 34 gm 0.21148 0. 32 0.02114 0.(synchronization points in the grammar. Errors at other points are reported but cause no recovery. Parsing)awidthshow 84 34 gm 0.32363 0. 32 0.03236 0.(simply continues up to the next synchronization point where the grammar and the input are synchronized)awidthshow 98 34 gm 0.47531 0. 32 0.04753 0.(again. This requires the designer of the grammar to specify synchronization points explicitly \320 not a very)awidthshow 112 34 gm -0.01246 0.(difficult task if one thinks for a moment. The advantage is that no recovery sets have to be computed at run)ashow 126 34 gm -0.13258 0.(time. This makes the parser small and fast.)ashow 154 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 2.76977 0. 32 0.27697 0.(Synchronization points)awidthshow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.51718 0. 32 0.15171 0.(. In Cocol/R a synchronization point is specified by the keyword SYNC \(see)awidthshow 168 34 gm -0.04789 0.(Section 2.3\). A good synchronization point is a location in the grammar where particularly safe symbols \(like)ashow 182 34 gm 0.39718 0. 32 0.03971 0.(keywords\) are expected and that is often visited by the parser. Typical candidates are the beginning of a)awidthshow 196 34 gm 0.32516 0. 32 0.03251 0.(statement, the beginning of a declaration or the beginning of a structured type. A synchronization point is)awidthshow 210 34 gm 0.12664 0. 32 0.01266 0.(translated into a loop that skips all symbols not expected at this point \(except end-of-file\). The set of these)awidthshow 224 34 gm -0.00193 0.(symbols can be precomputed at parser generation time. The following example shows two synchronization)ashow 238 34 gm 0.11245 0. 32 0.01124 0.(points and their counterparts in the generated parser.)awidthshow 266 45 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.25784 0.(production)ashow 266 215 gm 0.57189 0. 32 0.05718 0.(generated parsing procedure)awidthshow 288 45 gm 0 fs bu fc 2 F /|______Helvetica fnt bn -0.09054 0.(Declarations =)ashow 302 57 gm -0.25939 0.(SYNC)ashow 302 215 gm -0.06390 0.(WHILE ~\(sym IN {const, type, var, proc, begin, end, eof}\) DO)ashow 316 227 gm -0.12832 0.(Error\(\311\); Get)ashow 330 215 gm 0.03778 0.(END;)ashow 344 57 gm -0.94821 0.({ )ashow 344 215 gm -0.14295 0.(WHILE sym IN {const, type, var, proc} DO)ashow 358 68 gm -0.01783 0.(\( "CONST" {ConstDecl ";"})ashow 358 227 gm -0.21191 0.(IF sym = const THEN Get; \311 )ashow 372 68 gm -0.04234 0.(| "TYPE" {TypeDecl ";"})ashow 372 227 gm -0.13441 0.(ELSIF sym = type THEN Get; \311)ashow 386 68 gm -0.08518 0.(| "VAR" {VarDecl ";"})ashow 386 227 gm -0.21615 0.(ELSIF sym = var THEN Get; \311)ashow 400 68 gm -0.10333 0.(| ProcDecl)ashow 400 227 gm 0.49942 0. 32 0.04994 0.(ELSE ProcDecl)awidthshow 414 68 gm (\))show 414 227 gm 0.03778 0.(END;)ashow 428 57 gm -1.55661 0.( )ashow 428 68 gm -0.25939 0.(SYNC)ashow 428 227 gm -0.06390 0.(WHILE ~\(sym IN {const, type, var, proc, begin, end, eof}\) DO)ashow 442 238 gm -0.12832 0.(Error\(\311\); Get)ashow 456 227 gm -0.05427 0.(END)ashow 470 57 gm -0.11819 0.(}.)ashow 470 215 gm -0.05427 0.(END)ashow 498 34 gm 1.13723 0. 32 0.11372 0.(To avoid spurious error messages, an error is only reported when a certain amount of text has been)awidthshow 512 34 gm -0.05123 0.(correctly parsed since the last error.)ashow 540 34 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 2.03826 0. 32 0.20382 0.(Weak symbols)awidthshow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.25778 0. 32 0.12577 0.(. The knowledge of synchronization points is already sufficient to recover from errors.)awidthshow 554 34 gm -0.01696 0.(However, recovery can be improved if the parser also knows about "weak" symbols that are often mistyped)ashow 568 34 gm -0.03468 0.(or missing \(like semicolon\). These symbols are marked in the grammar by the keyword WEAK \(see Section)ashow 582 34 gm 0.50109 0. 32 0.05010 0.(2.3\). If the parser tries to recognize a weak symbol and finds it missing, it reports an error and skips the)awidthshow 596 34 gm 0.54061 0. 32 0.05406 0.(input until a legal successor of the symbol is found \(or a symbol that is expected at any synchronization)awidthshow 610 34 gm 1.30371 0. 32 0.13037 0.(point; this is a useful heuristic that avoids skipping safe symbols\). The following example shows the)awidthshow 624 34 gm -0.10389 0.(translation of a weak symbol.)ashow 652 227 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.47882 0. 32 0.04788 0.(generated parsing code)awidthshow 666 48 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.40634 0. 32 0.04063 0.(Statement =)awidthshow 680 62 gm 0.36468 0. 32 0.03646 0.(ident )awidthshow 680 227 gm 0.17887 0.(Expect\(ident\);)ashow 694 62 gm 0.09552 0. 32 0.00955 0.(WEAK ":=" )awidthshow 694 227 gm -0.02549 0.(Weak\(becomes, {)ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.02210 0.(start symbols of Expression)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn (}\);)show 708 62 gm 0.47164 0. 32 0.04716 0.(Expression .)awidthshow 708 227 gm 0.17187 0.(Expression)ashow F T cp %%Page: ? 22 op 0 0 xl 1 1 pen 20 278 gm (nc 746 0 781 538 6 rc)kp 29 34 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (22)show 66 34 gm (nc 56 0 726 538 6 rc)kp 10 fz bu fc 2 F /|______Helvetica fnt bn -0.02357 0.(The procedure )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.03109 0.(Weak)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.02272 0.( is implemented as follows)ashow 94 48 gm -0.03283 0.(PROCEDURE Weak\(s: INTEGER; expected: Set\);)ashow 108 48 gm -0.27894 0.(BEGIN)ashow 122 62 gm -0.29327 0.(IF sym = s THEN Get)ashow 136 62 gm 0.46615 0. 32 0.04661 0.(ELSE )awidthshow 151 76 gm -0.23730 0.(Error\(s\); WHILE sym )ashow bu fc 2 F /|______Symbol fnt bn (\317)show 151 174 gm bu fc 2 F /|______Helvetica fnt bn 0.05462 0. 32 0.00546 0.( expected )awidthshow bu fc 2 F /|______Symbol fnt bn (\310)show 151 229 gm bu fc 2 F /|______Helvetica fnt bn ( {)show 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.03208 0.(symbols expected at synchronization points)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.04058 0.(} DO Get END)ashow 165 62 gm -0.05427 0.(END)ashow 179 48 gm -0.15269 0.(END Weak;)ashow 207 34 gm 1.39160 0. 32 0.13916 0.(Weak symbols give the parser another chance to synchronize in case of an error. Again, the set of)awidthshow 221 34 gm -0.00755 0.(expected symbols can be precomputed at parser generation time and cause no run time overhead in error-)ashow 235 34 gm 0.19805 0. 32 0.01980 0.(free parsing.)awidthshow 263 34 gm 0.50964 0. 32 0.05096 0.(When an iteration starts with a weak symbol, this symbol is called a )awidthshow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.96069 0. 32 0.09606 0.(weak separator)awidthshow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.42388 0. 32 0.04238 0.( and is handled in a)awidthshow 277 34 gm 0.44479 0. 32 0.04447 0.(special way. If it cannot be recognized, the input is skipped until a symbol that is contained in one of the)awidthshow 291 34 gm 0.27008 0. 32 0.02700 0.(following three sets is found:)awidthshow 320 48 gm bu fc 2 F /|______Symbol fnt bn (a)show 320 62 gm bu fc 2 F /|______Helvetica fnt bn -0.09547 0.(symbols that may follow the weak separator)ashow 335 48 gm bu fc 2 F /|______Symbol fnt bn (b)show 335 62 gm bu fc 2 F /|______Helvetica fnt bn -0.05908 0.(symbols that may follow the iteration)ashow 350 48 gm bu fc 2 F /|______Symbol fnt bn (g)show 350 62 gm bu fc 2 F /|______Helvetica fnt bn 0.13229 0. 32 0.01322 0.(symbols expected at any synchronization point \(including eof\))awidthshow 378 34 gm -0.06004 0.(The following example shows the translation of a weak separator)ashow 406 227 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.57189 0. 32 0.05718 0.(generated parsing procedure)awidthshow 420 48 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 1.11831 0. 32 0.11183 0.(StatSequence =)awidthshow 434 62 gm 0.07147 0.(Stat)ashow 434 227 gm 0.10903 0.(Stat;)ashow 449 62 gm -0.05657 0.({ WEAK ";" Stat}.)ashow 449 227 gm -0.03753 0.(WHILE WeakSep\(semicolon, )ashow bu fc 2 F /|______Symbol fnt bn (a)show 449 365 gm bu fc 2 F /|______Helvetica fnt bn -0.26284 0.(, )ashow bu fc 2 F /|______Symbol fnt bn (b)show 449 376 gm bu fc 2 F /|______Helvetica fnt bn -0.21281 0.(\) DO Stat END)ashow 478 34 gm 0.17623 0. 32 0.01762 0.(In this example, )awidthshow bu fc 2 F /|______Symbol fnt bn (a)show 478 115 gm bu fc 2 F /|______Helvetica fnt bn 0.62271 0. 32 0.06227 0.( is the set of start symbols of a statement \(ident, IF, WHILE, etc.\) and )awidthshow bu fc 2 F /|______Symbol fnt bn (b)show 478 444 gm bu fc 2 F /|______Helvetica fnt bn 1.33895 0. 32 0.13389 0.( is the set of)awidthshow 492 34 gm 0.30502 0. 32 0.03050 0.(successors of a statement sequence \(END, ELSE, UNTIL, etc.\). Both sets can be precomputed at parser)awidthshow 506 34 gm -0.00468 0.(generation time. )ashow 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn (WeakSep)show 0 fs bu fc 2 F /|______Helvetica fnt bn -0.00491 0.( is implemented as follows:)ashow 534 48 gm -0.00592 0.(PROCEDURE WeakSep\(s: INTEGER; sySucc, iterSucc: Set\): BOOLEAN;)ashow 548 48 gm -0.27894 0.(BEGIN)ashow 562 62 gm -0.24145 0.(IF sym = s THEN Get; RETURN TRUE)ashow 577 62 gm -0.24598 0.(ELSIF sym )ashow bu fc 2 F /|______Symbol fnt bn (\316)show 577 119 gm bu fc 2 F /|______Helvetica fnt bn -0.06834 0.( iterSucc THEN RETURN FALSE)ashow 592 62 gm -0.16822 0.(ELSE Error\(s\); WHILE sym )ashow bu fc 2 F /|______Symbol fnt bn (\317)show 592 189 gm bu fc 2 F /|______Helvetica fnt bn -0.15206 0.( sySucc )ashow bu fc 2 F /|______Symbol fnt bn (\310)show 592 234 gm bu fc 2 F /|______Helvetica fnt bn -0.11381 0.( iterSucc )ashow bu fc 2 F /|______Symbol fnt bn (\310)show 592 283 gm bu fc 2 F /|______Helvetica fnt bn -0.15223 0.( )ashow bu fc 2 F /|______Symbol fnt bn -0.22514 0.(g)ashow bu fc 2 F /|______Helvetica fnt bn -0.30187 0.( DO Get END;)ashow 607 76 gm -0.30075 0.(RETURN sym )ashow bu fc 2 F /|______Symbol fnt bn (\316)show 607 146 gm bu fc 2 F /|______Helvetica fnt bn -0.06329 0.( sySucc \(*TRUE means "s inserted"*\))ashow 621 62 gm -0.05427 0.(END)ashow 635 48 gm (END WeakSep;)show 664 34 gm -0.04249 0.(The observant reader may have noticed that the set )ashow bu fc 2 F /|______Symbol fnt bn (b)show 664 270 gm bu fc 2 F /|______Helvetica fnt bn 0.20858 0. 32 0.02085 0.( contains the successors of a statement sequence in)awidthshow 678 34 gm 1.64077 0. 32 0.16407 0.(any possible context. This set may be too large. If the statement sequence occurs within a repeat)awidthshow 692 34 gm -0.02770 0.(statement, only UNTIL is a legal successor, but not END or ELSE. We accept this fault, since it allows us to)ashow 707 34 gm 0.79818 0. 32 0.07981 0.(precompute the set )awidthshow bu fc 2 F /|______Symbol fnt bn (b)show 707 133 gm bu fc 2 F /|______Helvetica fnt bn 0.49346 0. 32 0.04934 0.( at parser generation time. The occurrence of END or ELSE is very unlikely in this)awidthshow 721 34 gm -0.00930 0.(context and can only lead to incorrect synchronization, causing the parser to synchronize again.)ashow F T cp %%Page: ? 23 op 0 0 xl 1 1 pen 20 456 gm (nc 746 0 781 538 6 rc)kp 29 495 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (23)show 69 34 gm (nc 45 0 706 538 6 rc)kp 10 fz bu fc 2 F /|______Helvetica fnt bn 1.56097 0. 32 0.15609 0.(The following example demonstrates that our method yields good error recovery. We generated an)awidthshow 83 34 gm 1.98425 0. 32 0.19842 0.(Oberon compiler and compiled the following erroneous program taken from [Wirth86]. The parser)awidthshow 97 34 gm 0.09552 0. 32 0.00955 0.(recovered surprisingly well.)awidthshow 123 71 gm bu fc {}mark T /Courier /|______Courier 0 rf bn 8.33332 fz bu fc 2 F /|______Courier fnt bn (MODULE Error;)show 133 71 gm (CONST M := 10, N = 100 X = 10;)show 143 48 gm (***)show 143 71 gm ( ^ "=" expected)show 153 48 gm (***)show 153 71 gm ( ^ ";" expected)show 163 48 gm (***)show 163 71 gm ( ^ ";" expected)show 173 71 gm (VAR , a, b, c;)show 183 48 gm (***)show 183 71 gm ( ^ unexpected symbol in Block)show 203 71 gm (PROCEDURE P;)show 213 71 gm (BEGIN)show 223 71 gm ( s := 0; a = 5 * \(b - 1 END;)show 233 48 gm (***)show 233 71 gm ( ^ error in Stat)show 243 48 gm (***)show 243 71 gm ( ^ error in Stat)show 253 48 gm (***)show 253 71 gm 0.00152 0. 32 0.00015 0.( ^ ident expected)awidthshow 273 71 gm (BEGIN)show 283 71 gm ( > a > b;)show 293 48 gm (***)show 293 71 gm ( ^ unexpected symbol in Stat)show 303 48 gm (***)show 303 71 gm ( ^ error in Stat)show 313 71 gm ( WHILE a DO)show 323 71 gm ( BEGIN > b; - c := 0;)show 333 48 gm (***)show 333 71 gm ( ^ unexpected symbol in Stat)show 343 48 gm (***)show 343 71 gm ( ^ unexpected symbol in Stat)show 353 48 gm (***)show 353 71 gm 0.00228 0. 32 0.00022 0.( ^ unexpected symbol in Stat)awidthshow 363 71 gm ( WHILE a > 0 BEGIN)show 373 48 gm (***)show 373 71 gm ( ^ "DO" expected)show 383 71 gm ( IF ODD a c := c * - b;)show 393 48 gm (***)show 393 71 gm ( ^ error in Factor)show 403 48 gm (***)show 403 71 gm ( ^ error in Stat)show 413 48 gm (***)show 413 71 gm 0.00167 0. 32 0.00016 0.( ^ error in Factor)awidthshow 423 71 gm ( b := 2 * b a := a / 2)show 433 48 gm (***)show 433 71 gm ( ^ error in Factor)show 443 71 gm ( END;)show 453 71 gm ( P := 0; P; 666;)show 463 48 gm (***)show 463 71 gm 0.00228 0. 32 0.00022 0.( ^ unexpected symbol in Stat)awidthshow 473 71 gm ( END .)show 483 48 gm (***)show 483 71 gm ( ^ ";" expected)show 493 48 gm (***)show 493 71 gm ( ^ "END" expected)show 519 34 gm 10 fz bu fc 2 F /|______Helvetica fnt bn -0.01786 0.(The error messages are kept short and simple. This is due to our conviction that experienced programmers)ashow 533 34 gm 0.09002 0. 32 0.00900 0.(do not need a detailed explanation of what actions the parser performed in order to recover from the error.)awidthshow 547 34 gm -0.07328 0.(In almost all cases it is sufficient to point to the error location and to give a rough hint.)ashow 575 34 gm 0.30853 0. 32 0.03085 0.(The proposed error recovery technique is cheap. It costs only a check at every synchronization point and)awidthshow 589 34 gm 0.23818 0. 32 0.02381 0.(therefore does not slow down error-free parsing. The code for error handling makes up 10% of the parser)awidthshow 603 34 gm 0.03356 0. 32 0.00335 0.(code \(without semantic actions\).)awidthshow 631 48 gm -0.02465 0.(Oberon parser without error handling )ashow 631 249 gm 1.04125 0. 32 0.10412 0.(3019 Bytes)awidthshow 631 306 gm 0.55191 0. 32 0.05519 0.(\(object code\))awidthshow 645 48 gm -0.01197 0.(Error handling procedures \(fixed size\) )ashow 645 255 gm 0.85403 0. 32 0.08540 0.(248 Bytes)awidthshow 659 48 gm 0.03997 0. 32 0.00399 0.(Synchronization points, weak symbols )awidthshow 659 261 gm 0.64498 0. 32 0.06449 0.(81 Bytes)awidthshow F T cp %%Page: ? 24 op 0 0 xl 1 1 pen 20 301 gm (nc 746 0 781 538 6 rc)kp 29 34 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (24)show 64 34 gm (nc 54 0 727 538 6 rc)kp 1 fs 10 fz bu fc 2 F /|______Helvetica-Bold fnt bn 4.94964 0. 32 0.49496 0.(6. Measurements)awidthshow 92 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.43884 0. 32 0.04388 0.(We compared an Oberon compiler generated by Coco/R with a manually implemented Oberon compiler.)awidthshow 106 34 gm 0.15670 0. 32 0.01567 0.(The back-end modules of both compilers are the same. Only the scanner and the parser are different. We)awidthshow 120 34 gm 0.03555 0. 32 0.00355 0.(measured the time to compile a 867-line Oberon program \(7169 tokens or 24254 characters\) on a Ceres-2)awidthshow 134 34 gm -0.01515 0.(workstation with a NS32532 processor running at 25 MHz.)ashow 162 48 gm -0.06185 0.(Original compiler)ashow 162 165 gm 0.47897 0. 32 0.04789 0.(3.9 sec)awidthshow 176 48 gm 0.07843 0. 32 0.00784 0.(Generated compiler)awidthshow 176 165 gm 0.47897 0. 32 0.04789 0.(3.0 sec)awidthshow 204 34 gm 0.10498 0. 32 0.01049 0.(The generated compiler is 23 % faster than the original compiler. This is due to the fact that the generated)awidthshow 218 34 gm 0.19653 0. 32 0.01965 0.(compiler reads the source text into main memory at once, while the original compiler reads it character by)awidthshow 232 34 gm 0.73272 0. 32 0.07327 0.(character. Without this improvement the generated compiler is about 10% slower than the original one.)awidthshow 246 34 gm -0.00640 0.(Scanning and parsing contribute to the overall run time of the generated compiler in the following way:)ashow 274 48 gm 0.18791 0.(Scanning)ashow 274 188 gm 0.70999 0. 32 0.07099 0.(0.61 sec)awidthshow 274 261 gm 0.16494 0. 32 0.01649 0.(20 %)awidthshow 288 48 gm 0.01766 0.(Parsing)ashow 288 188 gm 0.70999 0. 32 0.07099 0.(0.12 sec)awidthshow 288 267 gm -0.11329 0.(4 %)ashow 316 34 gm -0.02523 0.(This gives a compilation speed of)ashow 344 48 gm 0.18791 0.(Scanning)ashow 344 169 gm 0.44189 0. 32 0.04418 0.(11 625 tokens/sec)awidthshow 358 48 gm 0.01766 0.(Parsing)ashow 358 169 gm 0.44189 0. 32 0.04418 0.(51 127 tokens/sec)awidthshow 372 48 gm 0.10086 0. 32 0.01008 0.(Total compilation speed)awidthshow 372 175 gm 0.35552 0. 32 0.03555 0.(2 395 tokens/sec)awidthshow 400 34 gm 0.03906 0. 32 0.00390 0.(Comparing the object code of the two compilers yields the following measures:)awidthshow 428 156 gm -0.06185 0.(Original compiler)ashow 428 266 gm 0.07843 0. 32 0.00784 0.(Generated compiler)awidthshow 442 48 gm 0.12763 0.(Scanner)ashow 442 167 gm 0.39993 0. 32 0.03999 0.(3 672 Bytes)awidthshow 442 286 gm 0.39993 0. 32 0.03999 0.(3 944 Bytes)awidthshow 442 385 gm -0.02217 0.(+ 7%)ashow 456 48 gm -0.08868 0.(Parser)ashow 456 161 gm 0.52917 0. 32 0.05291 0.(11 740 Bytes)awidthshow 456 280 gm 0.52917 0. 32 0.05291 0.(12 236 Bytes)awidthshow 456 385 gm -0.02217 0.(+ 4%)ashow 470 48 gm -0.07237 0.(\(incl. semantic actions\))ashow 512 34 gm 1 fs bu fc 2 F /|______Helvetica-Bold fnt bn 3.32656 0. 32 0.33265 0.(7. Summary)awidthshow 540 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 1.57119 0. 32 0.15711 0.(Attributed grammars, when regarded as an algorithmic notation, are a special purpose language to)awidthshow 554 34 gm 0.23330 0. 32 0.02333 0.(describe translation processes. They serve three purposes:)awidthshow 582 34 gm (\245)show 582 45 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.43962 0.(Specification)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 1.56982 0. 32 0.15698 0.(. A translator can be specified and designed this way before it is implemented in a)awidthshow 596 45 gm 0.28656 0. 32 0.02865 0.(conventional programming language.)awidthshow 610 34 gm (\245)show 610 45 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn 0.08145 0.(Documentation)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn 0.27984 0. 32 0.02798 0.(. An attributed grammar is a concise documentation of a translation process. It contains)awidthshow 624 45 gm -0.06274 0.(the same information as the program that implements the translator but in more compact form.)ashow 638 34 gm (\245)show 638 45 gm 2 fs bu fc 2 F /|______Helvetica-Oblique fnt bn -0.00648 0.(Implementation)ashow 0 fs bu fc 2 F /|______Helvetica fnt bn -0.00572 0.(. If a tool like Coco/R is available, an attributed grammar is already the implementation of)ashow 652 45 gm -0.00859 0.(the translator.)ashow 680 34 gm -0.02790 0.(Attributed grammars can be used to specify all kinds of programs that process a single stream of structured)ashow 694 34 gm 0.17501 0. 32 0.01750 0.(input data. They can be applied not only to proper compilers but also to compiler-like programs like cross-)awidthshow 708 34 gm 1.15875 0. 32 0.11587 0.(reference generators, pretty printers or complexity analyzers and even to tasks that do not fall in the)awidthshow 722 34 gm 0.08132 0. 32 0.00813 0.(traditional scope of compiler construction, like the processing of data files that describe pictures, formatted)awidthshow F T cp %%Page: ? 25 op 0 0 xl 1 1 pen 20 505 gm (nc 746 0 781 538 6 rc)kp 29 495 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (25)show 56 34 gm (nc 46 0 159 538 6 rc)kp 10 fz bu fc 2 F /|______Helvetica fnt bn -0.02478 0.(text or database information.)ashow 84 34 gm 0.29708 0. 32 0.02970 0.(Among the advantages of using a tool like Coco/R are a fast and safe implementation of translators, high)awidthshow 98 34 gm 0.58059 0. 32 0.05805 0.(flexibility in experimenting with a language design, and a translator description that is more concise and)awidthshow 112 34 gm 0.64208 0. 32 0.06420 0.(more readable than an implementation in a conventional programming language. The effort to learn the)awidthshow 126 34 gm 0.73089 0. 32 0.07308 0.(description language is small, since semantic parts are written in a familiar programming language and)awidthshow 140 34 gm 0.38848 0. 32 0.03884 0.(syntactic parts are based on the well-known formalism of EBNF grammars. The translators generated by)awidthshow 154 34 gm 0.10986 0. 32 0.01098 0.(Coco/R are fast enough to compete with production-quality compilers.)awidthshow F T cp %%Page: ? 26 op 0 0 xl 1 1 pen 20 344 gm (nc 746 0 781 538 6 rc)kp 29 34 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (26)show 60 34 gm (nc 50 0 583 538 6 rc)kp 1 fs 10 fz bu fc 2 F /|______Helvetica-Bold fnt bn 1.96319 0. 32 0.19631 0.(Appendix A Cocol/R Grammar)awidthshow 102 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn -0.06701 0.(Cocol )ashow 102 113 gm -0.61819 0.(= )ashow 102 125 gm 0.49041 0. 32 0.04904 0.("COMPILER" ident)awidthshow 116 34 gm -0.93397 0.( )ashow 116 125 gm -0.46589 0.({ ANY })ashow 130 34 gm -0.93397 0.( )ashow 130 125 gm -0.19964 0.({ Declaration })ashow 144 34 gm -0.93397 0.( )ashow 144 125 gm ("PRODUCTIONS")show 158 34 gm -0.93397 0.( )ashow 158 125 gm 0.21514 0. 32 0.02151 0.({ ident [Attributes] [SemText] "=" Expression "."} )awidthshow 172 34 gm -0.93397 0.( )ashow 172 125 gm 0.54412 0. 32 0.05441 0.("END" ident ".".)awidthshow 186 34 gm -0.12156 0.(Declaration )ashow 186 113 gm -0.61819 0.(= )ashow 186 125 gm -0.07426 0.( "CHARACTERS" { SetDecl })ashow 200 34 gm -1.03775 0.( )ashow 200 113 gm (|)show 200 125 gm -0.12507 0.("TOKENS" { TokenDecl })ashow 214 34 gm -1.03775 0.( )ashow 214 113 gm -1.37599 0.(| )ashow 214 125 gm -0.20979 0.("PRAGMAS" { PragmaDecl })ashow 228 34 gm -1.03775 0.( )ashow 228 113 gm -1.37599 0.(| )ashow 228 125 gm 0.32089 0. 32 0.03208 0.("COMMENTS" "FROM" TokenExpr "TO" TokenExpr ["NESTED"])awidthshow 242 34 gm -1.03775 0.( )ashow 242 113 gm -1.37599 0.(| )ashow 242 125 gm -0.11203 0.("IGNORE" \( "CASE" | Set \).)ashow 270 34 gm 0.12756 0. 32 0.01275 0.(SetDecl )awidthshow 270 113 gm (=)show 270 125 gm 0.50796 0. 32 0.05079 0.(ident "=" Set ".".)awidthshow 284 34 gm 0.16494 0. 32 0.01649 0.(Set )awidthshow 284 113 gm -0.61819 0.(= )ashow 284 125 gm -0.07481 0.(SimSet { "+" SimSet | "-" SimSet }.)ashow 298 34 gm (SimSet )show 298 113 gm (=)show 298 125 gm -0.08566 0.(ident | string | "CHR" "\(" number "\)" | "ANY".)ashow 326 34 gm 0.23071 0. 32 0.02307 0.(TokenDecl )awidthshow 326 113 gm (=)show 326 125 gm 0.50643 0. 32 0.05064 0.(Symbol ["=" TokenExpr "."].)awidthshow 340 34 gm 0.46264 0. 32 0.04626 0.(TokenExpr )awidthshow 340 113 gm (=)show 340 125 gm -0.05503 0.(TokenTerm { "|" TokenTerm }.)ashow 354 34 gm 0.05966 0. 32 0.00596 0.(TokenTerm )awidthshow 354 113 gm -0.61819 0.(= )ashow 354 125 gm -0.02670 0.(TokenFactor { TokenFactor} [ "CONTEXT" "\(" TokenExpr "\)" ].)ashow 368 34 gm 0.08819 0.(TokenFactor)ashow 368 113 gm (=)show 368 125 gm -0.07270 0.(\( Symbol | "\(" TokenExpr "\)" | "[" TokenExpr "]" | "{" TokenExpr "}" \).)ashow 396 34 gm -0.11114 0.(PragmaDecl)ashow 396 113 gm (=)show 396 125 gm 0.72433 0. 32 0.07243 0.(TokenDecl [SemText].)awidthshow 424 34 gm 0.38421 0. 32 0.03842 0.(Expression )awidthshow 424 113 gm -0.61819 0.(= )ashow 424 125 gm -0.23023 0.(Term { "|" Term }.)ashow 438 34 gm -0.27529 0.(Term )ashow 438 113 gm -0.61819 0.(= )ashow 438 125 gm -0.16748 0.(Factor { Factor}.)ashow 452 34 gm -0.18513 0.(Factor )ashow 452 113 gm -0.69828 0.(= )ashow 452 125 gm -0.94216 0.( \( )ashow 452 136 gm 0.68481 0. 32 0.06848 0.(["WEAK"] Symbol [Attributes])awidthshow 466 34 gm -1.16746 0.( )ashow 466 113 gm -1.37599 0.(| )ashow 466 125 gm 0.16622 0.(SemText)ashow 480 34 gm -1.16746 0.( )ashow 480 113 gm -1.37599 0.(| )ashow 480 125 gm 0.08535 0.("ANY")ashow 494 34 gm -1.16746 0.( )ashow 494 113 gm -1.37599 0.(| )ashow 494 125 gm 0.02436 0.("SYNC")ashow 508 34 gm -1.16746 0.( )ashow 508 113 gm -1.37599 0.(| )ashow 508 125 gm -0.05809 0.("\(" Expression "\)" | "[" Expression "]" | "{" Expression "}" )ashow 522 34 gm -1.16746 0.( )ashow 522 113 gm -0.10592 0.(\).)ashow 536 34 gm -0.01892 0.(Symbol )ashow 536 113 gm -0.61819 0.(= )ashow 536 125 gm -0.05526 0.( ident | string.)ashow 550 34 gm 0.49621 0. 32 0.04962 0.(Attributes )awidthshow 550 113 gm -0.61819 0.(= )ashow 550 125 gm -0.13394 0.("<" { ANY } ">".)ashow 564 34 gm 0.12908 0. 32 0.01290 0.(SemText )awidthshow 564 113 gm -0.61819 0.(= )ashow 564 125 gm -0.14949 0.("\(." { ANY } ".\)".)ashow F T cp %%Page: ? 27 op 0 0 xl 1 1 pen 20 190 gm (nc 746 0 781 538 6 rc)kp 29 495 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (27)show 60 34 gm (nc 50 0 647 538 6 rc)kp 1 fs 10 fz bu fc 2 F /|______Helvetica-Bold fnt bn 2.23236 0. 32 0.22323 0.(Appendix B Sample Attributed Grammar in Cocol/R)awidthshow 88 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn -0.07089 0.(The following attributed grammar describes a compiler for a simple programming language. It uses a symbol)ashow 102 34 gm -0.01292 0.(table handler \(TL\) and a code generator \(TC\) that generates code for a stack machine. These two modules)ashow 116 34 gm 0.95993 0. 32 0.09599 0.(are not described further. The purpose of this grammar is to give a coherent example of an attributed)awidthshow 130 34 gm -0.00700 0.(grammar. It is not necessary for the reader to understand the translation process in all details, although the)ashow 144 34 gm -0.11770 0.(semantic actions in this grammar are rather similar to actions contained in any compiler.)ashow 181 34 gm 9 fz bu fc 2 F /|______Helvetica fnt bn -0.07723 0.(COMPILER Taste)ashow 203 34 gm 0.05401 0. 32 0.00540 0.(\(*-------------------------------------- imports and global declarations -----------------------------------------*\))awidthshow 214 34 gm -0.02015 0.(IMPORT TL \(*table handler*\), TC \(*code generator*\);)ashow 236 34 gm -0.37390 0.(CONST)ashow 247 34 gm -1.00094 0.( )ashow 247 45 gm -0.04061 0.(plus = 0; minus = 1; times = 2; slash = 3; equ = 4; lss = 5; gtr = 6; \(*operators*\))ashow 258 34 gm -1.00094 0.( )ashow 258 45 gm -0.02056 0.(undef = 0; int = 1; bool = 2; \(*types*\))ashow 269 34 gm -1.00094 0.( )ashow 269 45 gm 0.12619 0. 32 0.01261 0.(vars = 0; procs = 1; \(*object kinds*\))awidthshow 280 34 gm -1.00094 0.( )ashow 280 45 gm -0.10723 0.(ADD = 0; SUB = 1; MUL = 2; DIVI = 3; EQU = 4; LSS = 5; GTR = 6; \(*machine instructions*\))ashow 291 34 gm -1.00094 0.( )ashow 291 45 gm -0.17697 0.(LOAD = 7; LIT = 8; STO = 9; CALL = 10; RET = 11; RES = 12;)ashow 302 34 gm -1.00094 0.( )ashow 302 45 gm -0.16517 0.(JMP = 13; FJMP = 14; HALTc = 15; NEG = 16; READ = 17; WRITE = 18;)ashow 324 34 gm -0.16882 0.(TYPE)ashow 335 45 gm -0.27214 0.(Name = ARRAY 32 OF CHAR;)ashow 357 34 gm -0.13371 0.(PROCEDURE Err\(nr: INTEGER\);)ashow 368 34 gm -0.01593 0.(BEGIN TasteS.Error\(100 + nr, TasteS.pos\) END Err;)ashow 390 34 gm -0.13150 0.(PROCEDURE StringToVal\(s: ARRAY OF CHAR; VAR val: INTEGER\);)ashow 401 45 gm -0.10726 0.(VAR i: INTEGER;)ashow 412 34 gm (BEGIN)show 423 34 gm -1.00094 0.( )ashow 423 45 gm 0.10910 0. 32 0.01091 0.(val:=0; i := 0;)awidthshow 434 34 gm -1.00094 0.( )ashow 434 45 gm -0.10832 0.(WHILE s[i] # 0X DO val := 10 * val + ORD\(s[i]\) - ORD\("0"\); INC\(i\) END)ashow 445 34 gm -0.06695 0.(END StringToVal;)ashow 456 34 gm -1.00094 0.( )ashow 478 34 gm 0.23269 0. 32 0.02326 0.(\(*------------------------------------------ scanner specification ---------------------------------------------------*\))awidthshow 489 34 gm -0.33288 0.(CHARACTERS)ashow 500 34 gm -1.00094 0.( )ashow 500 45 gm -0.01837 0.(letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz".)ashow 511 34 gm -1.00094 0.( )ashow 511 45 gm -0.03399 0.(digit = "0123456789".)ashow 522 34 gm -1.00094 0.( )ashow 522 45 gm -0.17297 0.(eol = CHR\(13\).)ashow 533 34 gm ( )show 533 45 gm -0.17304 0.( tab = CHR\(9\).)ashow 555 34 gm -0.20079 0.(TOKENS)ashow 566 34 gm -1.00094 0.( )ashow 566 45 gm 0.04730 0. 32 0.00473 0.(ident = letter {letter | digit}.)awidthshow 577 34 gm -1.00094 0.( )ashow 577 45 gm -0.05546 0.(number = digit {digit}.)ashow 599 34 gm -0.11776 0.(IGNORE eol + tab)ashow 621 34 gm -0.25779 0.(COMMENTS FROM "\(*" TO "*\)" NESTED)ashow F T cp %%Page: ? 28 op 0 0 xl 1 1 pen 20 192 gm (nc 746 0 781 538 6 rc)kp 29 34 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (28)show 58 34 gm (nc 50 0 700 538 6 rc)kp 0.18325 0. 32 0.01832 0.(\(*------------------------------------------------------- parser specification ----------------------------------------------------------*\))awidthshow 69 34 gm -0.24917 0.(PRODUCTIONS)ashow 91 34 gm -0.43476 0.(Taste )ashow 91 181 gm (\(. )show 91 193 gm -0.04698 0.(VAR name, progName: Name; obj: TL.Object; .\))ashow 102 34 gm -0.75639 0.(= )ashow 102 45 gm -0.26518 0.("PROGRAM" )ashow 113 45 gm -0.18923 0.(Ident ";" )ashow 113 181 gm (\(. )show 113 193 gm -0.01104 0.(TC.progStart := TC.pc .\))ashow 124 34 gm -1.00094 0.( )ashow 124 45 gm 0.16357 0.(Body)ashow 135 34 gm -1.00094 0.( )ashow 135 45 gm -0.31744 0.(Ident "." )ashow 135 181 gm (\(. )show 135 193 gm -0.14088 0.(IF name # progName THEN Err\(0\) END; TC.Emit\(HALTc\) .\).)ashow 146 34 gm 0.01194 0.(\(*-----------------------------------------------------------------------------------------------------------------------------------------------*\))ashow 157 34 gm -0.44804 0.(Body )ashow 157 181 gm -0.00836 0.(\(. VAR name, name1; Name; fix, type: INTEGER; obj: TL.Object; .\))ashow 168 34 gm -0.50721 0.(= )ashow 168 181 gm -0.01840 0.(\(. TL.EnterScope; fix := TC.pc + 1; TC.Emit2\(JMP,0\) .\))ashow 179 34 gm -1.00094 0.( )ashow 179 45 gm -0.50630 0.({ )ashow 179 57 gm -0.27862 0.("VAR" )ashow 190 34 gm -0.66729 0.( )ashow 190 57 gm -0.29806 0.({ Ident ":" )ashow 190 181 gm -0.03773 0.(\(. obj := TL.NewObj\(name, vars\) .\))ashow 201 34 gm -0.60057 0.( )ashow 201 57 gm -0.19860 0.( TypeId ";" )ashow 212 34 gm -0.66729 0.( )ashow 212 57 gm (})show 234 45 gm -0.83839 0.(| )ashow 234 57 gm -0.30784 0.("PROCEDURE" )ashow 245 57 gm -0.20095 0.(Ident ";" )ashow 245 181 gm -0.04136 0.(\(. obj := TL.NewObj\(name, procs\); obj^.adr := TC.pc .\))ashow 256 57 gm (Body )show 267 57 gm -0.29203 0.(Ident ";" )ashow 267 181 gm -0.16601 0.(\(. TC.Emit\(RET\); IF name # name1 THEN Err\(0\) END .\))ashow 278 45 gm (})show 289 34 gm -1.00094 0.( )ashow 289 45 gm -0.42802 0.("BEGIN" )ashow 289 181 gm (\(. TC.Fixup\(fix\); TC.Emit2\(RES, TL.DataSpace\(\)\) .\))show 300 34 gm -1.00094 0.( )ashow 300 45 gm 0.28411 0. 32 0.02841 0.(StatSeq )awidthshow 311 34 gm -1.00094 0.( )ashow 311 45 gm -0.48342 0.("END" )ashow 311 181 gm 0.37979 0. 32 0.03797 0.(\(. TL.LeaveScope .\).)awidthshow 322 34 gm 0.01194 0.(\(*-----------------------------------------------------------------------------------------------------------------------------------------------*\))ashow 333 34 gm -0.04293 0.(TypeId)ashow 344 34 gm -0.62846 0.(= )ashow 344 45 gm -0.42356 0.("INTEGER" )ashow 344 181 gm (\(. )show 344 193 gm 0.17196 0. 32 0.01719 0.(type := int .\))awidthshow 355 34 gm -0.83839 0.(| )ashow 355 45 gm -0.40922 0.("BOOLEAN" )ashow 355 181 gm (\(. )show 355 193 gm 0.16265 0. 32 0.01626 0.(type := bool .\).)awidthshow 366 34 gm 0.01194 0.(\(*-----------------------------------------------------------------------------------------------------------------------------------------------*\))ashow 377 34 gm 0.20126 0. 32 0.02012 0.(StatSeq = Stat {";" Stat}.)awidthshow 388 34 gm 0.01194 0.(\(*-----------------------------------------------------------------------------------------------------------------------------------------------*\))ashow 399 34 gm -0.43486 0.(Stat )ashow 399 181 gm (\(. )show 399 193 gm 0.08178 0. 32 0.00817 0.(VAR name: Name; type, fix, fix2, loopstart: INTEGER; obj: TL.Object; )awidthshow 410 34 gm -0.75639 0.(= )ashow 410 45 gm ([)show 410 57 gm -0.35823 0.( Ident )ashow 410 181 gm 0.50462 0.(\(.)ashow 410 193 gm -0.05970 0.(obj := TL.Obj\(name\) .\))ashow 421 34 gm -0.66729 0.( )ashow 421 57 gm -0.49540 0.(\( )ashow 421 68 gm -0.43904 0.(":" "=" )ashow 421 181 gm (\(. )show 421 193 gm -0.10017 0.(IF obj^.kind # vars THEN Err\(4\) END .\))ashow 432 34 gm -0.60057 0.( )ashow 432 68 gm 0.56640 0. 32 0.05664 0.(Expression )awidthshow 432 181 gm (\(. )show 432 193 gm -0.07774 0.(IF type # obj^.type THEN Err\(2\) END;)ashow 443 34 gm -0.51268 0.( )ashow 443 193 gm 0.00610 0. 32 0.00061 0.(TC.Emit3\(STO, TL.curLevel - obj^.level, obj^.adr\) .\))awidthshow 454 34 gm -0.66729 0.( )ashow 454 57 gm -0.51043 0.(| )ashow 454 181 gm (\(. )show 454 193 gm -0.08921 0.(IF obj^.kind # procs THEN Err\(5\) END;)ashow 465 34 gm -0.51268 0.( )ashow 465 193 gm 0.00564 0. 32 0.00056 0.(TC.Emit3\(CALL, TL.curLevel - obj^.level, obj^.adr\) .\))awidthshow 476 34 gm -0.66729 0.( )ashow 476 57 gm (\))show 487 45 gm -0.83839 0.(| )ashow 487 57 gm 0.14251 0. 32 0.01425 0.("IF" Expression )awidthshow 487 181 gm (\(. )show 487 193 gm -0.09405 0.(IF type # bool THEN Err\(3\) END; fix := TC.pc + 1; TC.Emit2\(FJMP, 0\) .\))ashow 498 34 gm -1.00094 0.( )ashow 498 45 gm -1.00094 0.( )ashow 498 57 gm -0.10777 0.("THEN" StatSeq)ashow 509 34 gm -1.00094 0.( )ashow 509 45 gm -1.00094 0.( )ashow 509 57 gm ([ )show 509 68 gm -0.43486 0.("ELSE" )ashow 509 181 gm (\(. )show 509 193 gm 0.01464 0. 32 0.00146 0.(fix2 := TC.pc + 1; TC.Emit2\(JMP, 0\); TC.Fixup\(fix\); fix := fix2 .\))awidthshow 520 34 gm -0.75071 0.( )ashow 520 45 gm -0.75071 0.( )ashow 520 57 gm -1.00094 0.( )ashow 520 68 gm 0.28411 0. 32 0.02841 0.(StatSeq )awidthshow 531 34 gm -0.75071 0.( )ashow 531 45 gm ( )show 531 57 gm (])show 542 34 gm -0.75071 0.( )ashow 542 45 gm ( )show 542 57 gm -0.48240 0.("END" )ashow 542 181 gm (\(. )show 542 193 gm 0.20797 0. 32 0.02079 0.(TC.Fixup\(fix\) .\))awidthshow 553 45 gm -0.83839 0.(| )ashow 553 57 gm -0.43830 0.("WHILE" )ashow 553 181 gm (\(. )show 553 193 gm 0.14846 0. 32 0.01484 0.(loopstart := TC.pc .\))awidthshow 564 34 gm -0.75071 0.( )ashow 564 45 gm ( )show 564 57 gm -0.22161 0.(Expression )ashow 564 181 gm (\(. )show 564 193 gm -0.09991 0.(IF type # bool THEN Err\(3\) END; fix := TC.pc + 1; TC.Emit2\(FJMP, 0\) .\))ashow 575 34 gm -0.66729 0.( )ashow 575 57 gm -0.13479 0.("DO" StatSeq "END")ashow 575 181 gm (\(. )show 575 193 gm 0.21545 0. 32 0.02154 0.(TC.Emit2\(JMP, loopstart\); TC.Fixup\(fix\) .\))awidthshow 586 45 gm -0.83839 0.(| )ashow 586 57 gm -0.11280 0.("READ" Ident)ashow 586 181 gm (\(. )show 586 193 gm -0.08134 0.(obj := TL.Obj\(name\); IF obj^.type # int THEN Err\(1\) END;)ashow 597 34 gm -0.51268 0.( )ashow 597 193 gm -0.00839 0.(TC.Emit3\(READ, TL.curLevel - obj^.level, obj^.adr\) .\))ashow 608 45 gm -0.83839 0.(| )ashow 608 57 gm -0.03640 0.("WRITE" Expression )ashow 608 181 gm -0.11680 0.(\(. IF type # int THEN Err\(1\) END; TC.Emit\(WRITE\) .\))ashow 619 45 gm 0.99903 0.(].)ashow 630 34 gm 0.01194 0.(\(*-----------------------------------------------------------------------------------------------------------------------------------------------*\))ashow 641 34 gm (Expression)show 641 181 gm -0.01834 0.(\(. VAR type1, op: INTEGER; .\))ashow 652 34 gm -0.75639 0.(= )ashow 652 45 gm 0.04043 0.(SimExpr)ashow 663 34 gm -1.00094 0.( )ashow 663 45 gm -0.04153 0.([ RelOp SimExpr)ashow 663 181 gm -0.05953 0.(\(. IF type # type1 THEN Err\(2\) END; TC.Emit\(op\); type := bool .\))ashow 674 34 gm -0.66729 0.( )ashow 674 45 gm 0.99903 0.(].)ashow 685 34 gm 0.01194 0.(\(*-----------------------------------------------------------------------------------------------------------------------------------------------*\))ashow F T cp %%Page: ? 29 op 0 0 xl 1 1 pen 20 477 gm (nc 746 0 781 538 6 rc)kp 29 495 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (29)show 58 34 gm (nc 50 0 505 538 6 rc)kp -0.14399 0.(RelOp)ashow 69 34 gm (=)show 69 45 gm -0.49002 0.("=" )ashow 69 181 gm (\(. )show 69 193 gm -0.06990 0.(op := equ .\))ashow 80 34 gm -0.83839 0.(| )ashow 80 45 gm -0.49002 0.("<" )ashow 80 181 gm (\(. )show 80 193 gm 0.05935 0. 32 0.00593 0.(op := lss .\))awidthshow 91 34 gm -0.83839 0.(| )ashow 91 45 gm -0.49002 0.(">" )ashow 91 181 gm (\(. )show 91 193 gm 0.05752 0. 32 0.00575 0.(op := gtr .\).)awidthshow 102 34 gm 0.01194 0.(\(*-----------------------------------------------------------------------------------------------------------------------------------------------*\))ashow 113 34 gm -0.06071 0.(SimExpr)ashow 113 181 gm -0.01834 0.(\(. VAR type1, op: INTEGER; .\))ashow 124 34 gm -0.75639 0.(= )ashow 124 45 gm -0.05657 0.(Term)ashow 135 34 gm -1.00094 0.( )ashow 135 45 gm -0.09320 0.({ AddOp Term)ashow 135 181 gm -0.08276 0.(\(. IF \(type # int\) OR \(type1 # int\) THEN Err\(1\) END; TC.Emit\(op\) .\))ashow 146 34 gm -0.66729 0.( )ashow 146 45 gm 0.49362 0.(}.)ashow 157 34 gm 0.01194 0.(\(*-----------------------------------------------------------------------------------------------------------------------------------------------*\))ashow 168 34 gm -0.12066 0.(AddOp)ashow 179 34 gm -0.75639 0.(= )ashow 179 45 gm -0.49002 0.("+" )ashow 179 181 gm 0.22476 0. 32 0.02247 0.(\(. op:=plus .\))awidthshow 190 34 gm -0.61311 0.( | )ashow 190 45 gm -0.48234 0.("-" )ashow 190 181 gm 0.21331 0. 32 0.02133 0.(\(. op:=minus .\).)awidthshow 201 34 gm 0.01194 0.(\(*-----------------------------------------------------------------------------------------------------------------------------------------------*\))ashow 212 34 gm -0.11421 0.(Term)ashow 212 181 gm (\(. )show 212 193 gm -0.02072 0.(VAR type1, op: INTEGER; .\))ashow 223 34 gm -0.75639 0.(= )ashow 223 45 gm 0.08927 0.(Factor)ashow 234 34 gm -1.00094 0.( )ashow 234 45 gm -0.50630 0.({ )ashow 234 57 gm -0.08158 0.(MulOp Factor )ashow 234 181 gm -0.08276 0.(\(. IF \(type # int\) OR \(type1 # int\) THEN Err\(1\) END; TC.Emit\(op\) .\))ashow 245 34 gm -1.00094 0.( )ashow 245 45 gm 0.49362 0.(}.)ashow 256 34 gm 0.01194 0.(\(*-----------------------------------------------------------------------------------------------------------------------------------------------*\))ashow 267 34 gm -0.14387 0.(MulOp)ashow 278 34 gm -0.75639 0.(= )ashow 278 45 gm -0.46780 0.("*" )ashow 278 181 gm -0.01568 0.(\(. op := times .\))ashow 289 34 gm -0.83839 0.(| )ashow 289 45 gm -0.46781 0.("/" )ashow 289 181 gm 0.12985 0. 32 0.01298 0.(\(. op := slash .\).)awidthshow 300 34 gm 0.01194 0.(\(*-----------------------------------------------------------------------------------------------------------------------------------------------*\))ashow 311 34 gm -0.04252 0.(Factor)ashow 311 181 gm -0.16545 0.( \(. )ashow 311 193 gm -0.03045 0.(VAR name: Name; val, n: INTEGER; obj: TL.Object; .\))ashow 322 34 gm -0.75639 0.(= )ashow 322 45 gm (\()show 322 57 gm -0.04791 0.( Ident)ashow 322 181 gm -0.16545 0.( \(. )ashow 322 193 gm 0.08483 0. 32 0.00848 0.(obj := TL.Obj\(name\); type := obj^.type;)awidthshow 333 34 gm -0.51268 0.( )ashow 333 193 gm -0.11917 0.(IF obj^.kind = vars THEN )ashow 344 204 gm 0.00625 0. 32 0.00062 0.(TC.Emit3\(LOAD, TL.curLevel - obj^.level, obj^.adr\))awidthshow 355 34 gm -0.51268 0.( )ashow 355 193 gm -0.04980 0.(ELSE Err\(4\))ashow 366 34 gm -0.51268 0.( )ashow 366 193 gm -0.19869 0.(END .\))ashow 377 34 gm -1.00094 0.( )ashow 377 45 gm -0.83839 0.(| )ashow 377 57 gm -0.48233 0.("TRUE" )ashow 377 181 gm (\(. )show 377 193 gm -0.00801 0.(TC.Emit2\(LIT, 1\); type := bool .\))ashow 388 34 gm -1.00094 0.( )ashow 388 45 gm -0.83839 0.(| )ashow 388 57 gm -0.43862 0.("FALSE" )ashow 388 181 gm (\(. )show 388 193 gm -0.00801 0.(TC.Emit2\(LIT, 0\); type := bool .\))ashow 399 34 gm -1.00094 0.( )ashow 399 45 gm -0.83839 0.(| )ashow 399 57 gm -0.43153 0.(number )ashow 399 181 gm 0.50462 0.(\(.)ashow 399 193 gm 0.32882 0. 32 0.03288 0.(TasteS.GetName\(TasteS.pos, TasteS.len, name\); )awidthshow 410 193 gm 0.02166 0. 32 0.00216 0.(StringToVal\(name, n\); TC.Emit2\(LIT, n\); type:=int .\))awidthshow 421 34 gm -1.00094 0.( )ashow 421 45 gm -0.83839 0.(| )ashow 421 57 gm -0.27680 0.("-" Factor )ashow 421 181 gm 0.50462 0.(\(.)ashow 421 193 gm -0.07302 0.(IF type # int THEN Err\(1\); type := int END; TC.Emit\(NEG\) .\))ashow 432 34 gm -1.00094 0.( )ashow 432 45 gm 0.50462 0.(\).)ashow 443 34 gm 0.01194 0.(\(*-----------------------------------------------------------------------------------------------------------------------------------------------*\))ashow 454 34 gm -0.14286 0.(Ident =)ashow 465 45 gm 0.12315 0.(ident)ashow 465 181 gm 0.50462 0.(\(.)ashow 465 193 gm 0.38604 0. 32 0.03860 0.(TasteS.GetName\(TasteS.pos, TasteS.len, name\) .\).)awidthshow 487 34 gm -0.05589 0.(END Taste.)ashow F T cp %%Page: ? 30 op 0 0 xl 1 1 pen 20 80 gm (nc 746 0 781 538 6 rc)kp 29 34 gm (nc 0 0 35 538 6 rc)kp F 1 setTxMode 0 fs 9 fz bu fc 2 F /|______Helvetica fnt bn (30)show 60 34 gm (nc 50 0 611 538 6 rc)kp 1 fs 10 fz bu fc 2 F /|______Helvetica-Bold fnt bn 1.01123 0.(References)ashow 88 34 gm 0 fs bu fc 2 F /|______Helvetica fnt bn 0.42288 0.([Ben88])ashow 88 85 gm 0.17883 0. 32 0.01788 0.(J.Bentley: More Programming Pearls. Addison-Wesley 1988)awidthshow 116 34 gm 0.23678 0.([DoPi90])ashow 116 85 gm 0.08255 0. 32 0.00825 0.(H.Dobler, K.Pirklbauer: Coco-2 \320 A New Compiler-Compiler. Technical Report TR 90/1, Institut)awidthshow 130 85 gm -0.07165 0.(f\237r Informatik, Universit\212t Linz)ashow 158 34 gm -0.22354 0.([GaGi84] )ashow 158 85 gm 0.29418 0. 32 0.02941 0.(H.Ganzinger, R.Giegerich: Attribute Coupled Grammars. SIGPLAN Notices 19 \(1984\), 6, 157-)awidthshow 172 85 gm 0.66137 0.(170)ashow 200 34 gm -0.01684 0.([Gro88] )ashow 200 85 gm 0.89736 0. 32 0.08973 0.(J.Grosch: Generators for High-Speed Front-Ends. Lecture Notes in Computer Science 371,)awidthshow 214 85 gm 0.43853 0. 32 0.04385 0.(Springer Verlag, 1988)awidthshow 242 34 gm 0.32333 0. 32 0.03233 0.([KHZ82] )awidthshow 242 85 gm 0.89889 0. 32 0.08988 0.(U.Kastens, B.Hutt, E.Zimmermann: GAG: A Practical Compiler Generator. Lecture Notes in)awidthshow 256 85 gm 0.38116 0. 32 0.03811 0.(Computer Science 141, Springer Verlag, 1982)awidthshow 284 34 gm 1.03866 0. 32 0.10386 0.([John75] )awidthshow 284 85 gm 0.38330 0. 32 0.03833 0.(S.C.Johnson: YACC \320 Yet another Compiler-Compiler. Tech.Report No 32, Bell Laboratories,)awidthshow 298 85 gm 0.67077 0. 32 0.06707 0.(July 1975)awidthshow 326 34 gm 0.35018 0. 32 0.03501 0.([Knu68] )awidthshow 326 85 gm 0.85784 0. 32 0.08578 0.(D.E.Knuth: Semantics of Context-Free Languages. Mathematical Systems Theory 2 \(1968\),)awidthshow 340 85 gm 0.38630 0.(127-145)ashow 368 34 gm 0.20547 0.([M\232ss86])ashow 368 85 gm 1.18850 0. 32 0.11885 0.(H.M\232ssenb\232ck: Compilererzeugende Systeme f\237r Mikrocomputer. Ph.D. thesis, Universit\212t)awidthshow 382 85 gm 0.98403 0. 32 0.09840 0.(Linz, 1986)awidthshow 410 34 gm -0.15359 0.([R\212i83] )ashow 410 85 gm 0.45455 0. 32 0.04545 0.(K.-J. R\212ih\212, et al.: Revised Report on the Compiler Writing System HLP78. Report A-1983-1,)awidthshow 424 85 gm 0.02792 0. 32 0.00279 0.(Department of Computer Science, University of Helsinki)awidthshow 452 34 gm 0.23712 0.([ReM\23289])ashow 452 85 gm 0.11764 0. 32 0.01176 0.(P.Rechenberg, H.M\232ssenb\232ck: A Compiler Generator for Microcomputers. Prentice Hall 1989)awidthshow 480 34 gm 0.42547 0.([Senn89])ashow 480 85 gm (R.Sennhauser: \206bersetzung attributierter Grammatiken. Diploma thesis, ETH Zurich, 1989)show 508 34 gm 0.09642 0.([Waite86])ashow 508 85 gm -0.04191 0.(W.M.Waite: The Cost of Lexical Analysis. Software \320 Practice and Experience 16 \(1986\), 5, )ashow 522 85 gm 0.38630 0.(473-488)ashow 550 34 gm 0.12535 0.([Wirth76])ashow 550 85 gm -0.04763 0.(N.Wirth: Algorithms + Data Structures = Programs. Prentice-Hall, 1976)ashow 578 34 gm 0.12535 0.([Wirth86])ashow 578 85 gm 0.49133 0. 32 0.04913 0.(N.Wirth: Compilerbau. 4th edition. Teubner Studienb\237cher, 1986)awidthshow 606 34 gm 0.12535 0.([Wirth89])ashow 606 85 gm 0.17654 0. 32 0.01765 0.(N.Wirth: The Programming Language Oberon. Report 111, ETH Zurich, September 1989)awidthshow F T cp %%Trailer cd end %%Pages: 30 0 %%EOF \ No newline at end of file diff --git a/src/tools/coco/Coco.Tool b/src/tools/coco/Coco.Tool deleted file mode 100644 index 643019ff..00000000 --- a/src/tools/coco/Coco.Tool +++ /dev/null @@ -1,83 +0,0 @@ -Coco/R - the Oberon scanner and parser generator - -For a complete documentation see the postscript file Coco.Report.ps. - -Compiler.Compile - Sets.Mod CRS.Mod CRT.Mod CRA.Mod CRX.Mod CRP.Mod Coco.Mod ~ - -NOTE: the option character should be changed to "\" in Coco.Mod for Unix implementations. - - -Coco.Compile * -Coco.Compile ~ -Coco.Compile ^ -Coco.Compile @ - -(*________________________ usage ________________________*) - -Coco.Compile [options] - -The file CR.ATG is an example of an input file to Coco. If the grammar in the input file has the name X -the generated scanner has the name XS.Mod and the generated parser has the name XP.Mod. - -Options: - - /X generates a cross reference list of all syntax symbols - /S generates a list of all terminal start symbols and successors of nonterminal symbols. - -Interface of the generated scanner: - - DEFINITION XS; - IMPORT Texts; - TYPE - ErrorProc = PROCEDURE (n: INTEGER; pos: LONGINT); - VAR - Error: ErrorProc; - col, errors, len, line, nextCol, nextLen, nextLine: INTEGER; - nextPos, pos: LONGINT; - src: Texts.Text; - PROCEDURE Reset (t: Texts.Text; pos: LONGINT; errProc: ErrorProc); - PROCEDURE Get(VAR sym: INTEGER); - PROCEDURE GetName(pos: LONGINT; len: INTEGER; VAR name: ARRAY OF CHAR); - PROCEDURE StdErrorProc (n: INTEGER; pos: LONGINT); - END XS. - -Interface of the generated parser: - - DEFINITION XP; - PROCEDURE Parse; - END XP. - -Example how to use the generated parts; - - Texts.OpenScanner(s, Oberon.Par.Text, Oberon.Par.Pos); Texts.Scan(s); - IF s.class = Texts.Name THEN - NEW(text); Texts.Open(text, s.s); - XS.Reset(text, 0, MyErrorHandler); - XP.Parse; - END - - -Error handling in the generated parser: - -The grammar has to contain hints, from which Coco can generate appropriate error handling. -The hints can be placed arbitrarily on the right-hand side of a production: - - SYNC Denotes a synchronisation point. At such points symbols are skipped until a symbol - is found which is a legal continuation symbol at that point (or eof). SYNC is usually - placed at points where particularly "safe" symbols are expected, i.e., symbols that - are rarely missing or misspelled. - - WEAK s s is an arbitrary terminal symbol (e.g., ";") which is considered "weak", because it is - frequently missing or misspelled (e.g., a semicolon between statements). - -Example: - - Statement = - SYNC - ( ident WEAK ":=" Expression - | "IF" Expression "THEN" StatSeq ["ELSE" StatSeq] "END" - | "WHILE" Expression "DO" StatSeq "END" - ). - StatSeq = - Statement { WEAK ";" Statement}.þ diff --git a/src/tools/coco/Oberon.Mod b/src/tools/coco/Oberon.Mod deleted file mode 100644 index 446d7e8a..00000000 --- a/src/tools/coco/Oberon.Mod +++ /dev/null @@ -1,8 +0,0 @@ -MODULE Oberon; - -IMPORT Texts := CmdlnTexts; - -VAR Log* : Texts.Text; - - -END Oberon. diff --git a/src/tools/coco/Parser.FRM b/src/tools/coco/Parser.FRM deleted file mode 100644 index dda6c41c..00000000 --- a/src/tools/coco/Parser.FRM +++ /dev/null @@ -1,65 +0,0 @@ -(* parser module generated by Coco-R *) -MODULE -->modulename; - -IMPORT -->scanner; - -CONST - -->constants - setSize = 32; nSets = (maxT DIV setSize) + 1; - -TYPE - SymbolSet = ARRAY nSets OF SET; - -VAR - sym: INTEGER; (* current input symbol *) - symSet: ARRAY nrSets OF SymbolSet; - --->declarations - -PROCEDURE Error (n: INTEGER); -BEGIN -->errors -END Error; - -PROCEDURE Get; -BEGIN - -->scanProc -END Get; - -PROCEDURE Expect(n: INTEGER); -BEGIN IF sym = n THEN Get ELSE Error(n) END -END Expect; - -PROCEDURE StartOf(s: INTEGER): BOOLEAN; -BEGIN RETURN (sym MOD setSize) IN symSet[s, sym DIV setSize] -END StartOf; - -PROCEDURE ExpectWeak(n, follow: INTEGER); -BEGIN - IF sym = n THEN Get - ELSE Error(n); WHILE ~ StartOf(follow) DO Get END - END -END ExpectWeak; - -PROCEDURE WeakSeparator(n, syFol, repFol: INTEGER): BOOLEAN; - VAR s: SymbolSet; i: INTEGER; -BEGIN - IF sym = n THEN Get; RETURN TRUE - ELSIF StartOf(repFol) THEN RETURN FALSE - ELSE - i := 0; WHILE i < nSets DO s[i] := symSet[syFol, i] + symSet[repFol, i] + symSet[0, i]; INC(i) END; - Error(n); WHILE ~ ((sym MOD setSize) IN s[sym DIV setSize]) DO Get END; - RETURN StartOf(syFol) - END -END WeakSeparator; - --->productions - -PROCEDURE Parse*; -BEGIN - Get; --->parseRoot -END Parse; - -BEGIN --->initialization -END -->modulename. diff --git a/src/tools/coco/Scanner.FRM b/src/tools/coco/Scanner.FRM deleted file mode 100644 index 9497082b..00000000 --- a/src/tools/coco/Scanner.FRM +++ /dev/null @@ -1,103 +0,0 @@ -(* scanner module generated by Coco-R *) -MODULE -->modulename; - -IMPORT Texts := CmdlnTexts, SYSTEM; - -CONST - EOL = 0DX; - EOF = 0X; - maxLexLen = 127; --->declarations - -TYPE - ErrorProc* = PROCEDURE (n: INTEGER; pos: LONGINT); - StartTable = ARRAY 128 OF INTEGER; - -VAR - src*: Texts.Text; (*source text. To be set by the main pgm*) - pos*: LONGINT; (*position of current symbol*) - line*, col*, len*: INTEGER; (*line, column, length of current symbol*) - nextPos*: LONGINT; (*position of lookahead symbol*) - nextLine*, nextCol*, nextLen*: INTEGER; (*line, column, length of lookahead symbol*) - errors*: INTEGER; (*number of errors detected*) - Error*: ErrorProc; - - ch: CHAR; (*current input character*) - r: Texts.Reader; (*global reader*) - chPos: LONGINT; (*position of current character*) - chLine: INTEGER; (*current line number*) - lineStart: LONGINT; (*start position of current line*) - apx: INTEGER; (*length of appendix*) - oldEols: INTEGER; (*nr. of EOLs in a comment*) - - start: StartTable; (*start state for every character*) - - -PROCEDURE NextCh; (*return global variable ch*) -BEGIN - Texts.Read(r, ch); INC(chPos); - IF ch = EOL THEN INC(chLine); lineStart := chPos + 1 END -END NextCh; - - -PROCEDURE Comment(): BOOLEAN; - VAR level, startLine: INTEGER; oldLineStart: LONGINT; -BEGIN (*Comment*) - level := 1; startLine := chLine; oldLineStart := lineStart; --->comment -END Comment; - - -PROCEDURE Get*(VAR sym: INTEGER); -VAR state: INTEGER; lexeme: ARRAY maxLexLen+1 OF CHAR; - - PROCEDURE CheckLiteral; - BEGIN - IF nextLen < maxLexLen THEN lexeme[nextLen] := 0X END; --->literals - END CheckLiteral; - -BEGIN --->GetSy1 - IF ch > 7FX THEN ch := " " END; - pos := nextPos; col := nextCol; line := nextLine; len := nextLen; - nextPos := chPos; nextCol := SHORT(chPos - lineStart); nextLine := chLine; nextLen := 0; - state := start[ORD(ch)]; apx := 0; - LOOP - IF nextLen < maxLexLen THEN lexeme[nextLen] := ch END; - INC(nextLen); - NextCh; - IF state > 0 THEN - CASE state OF --->GetSy2 - END (*CASE*) - ELSE sym := noSym; RETURN (*NextCh already done*) - END (*IF*) - END (*LOOP*) -END Get; - - -PROCEDURE GetName*(pos: LONGINT; len: INTEGER; VAR s: ARRAY OF CHAR); - VAR i: INTEGER; r: Texts.Reader; -BEGIN - Texts.OpenReader(r, src, pos); - IF len >= LEN(s) THEN len := SHORT(LEN(s)) - 1 END; - i := 0; WHILE i < len DO Texts.Read(r, s[i]); INC(i) END; - s[i] := 0X -END GetName; - -PROCEDURE StdErrorProc* (n: INTEGER; pos: LONGINT); -BEGIN INC(errors) END StdErrorProc; - -PROCEDURE Reset* (t: Texts.Text; pos: LONGINT; errProc: ErrorProc); -BEGIN - src := t; Error := errProc; - Texts.OpenReader(r, src, pos); - chPos := pos - 1; chLine := 1; lineStart := 0; - oldEols := 0; apx := 0; errors := 0; - NextCh -END Reset; - -BEGIN --->initialization -END -->modulename. diff --git a/src/tools/coco/Sets.Mod b/src/tools/coco/Sets.Mod deleted file mode 100644 index d98ec028..00000000 --- a/src/tools/coco/Sets.Mod +++ /dev/null @@ -1,138 +0,0 @@ -MODULE Sets; - -IMPORT Texts := CmdlnTexts; - -CONST size* = 32; - - -PROCEDURE Clear*(VAR s: ARRAY OF SET); - VAR i: INTEGER; -BEGIN - i := 0; WHILE i < LEN(s) DO s[i] := {}; INC(i) END -END Clear; - - -PROCEDURE Fill*(VAR s: ARRAY OF SET); - VAR i: INTEGER; -BEGIN - i := 0; WHILE i < LEN(s) DO s[i] := {0 .. size-1}; INC(i) END -END Fill; - - -PROCEDURE Incl*(VAR s: ARRAY OF SET; x: INTEGER); -BEGIN INCL(s[x DIV size], x MOD size) -END Incl; - - -PROCEDURE Excl*(VAR s: ARRAY OF SET; x: INTEGER); -BEGIN EXCL(s[x DIV size], x MOD size) -END Excl; - - -PROCEDURE In*(VAR s: ARRAY OF SET; x: INTEGER): BOOLEAN; -BEGIN RETURN x MOD size IN s[x DIV size] -END In; - - -PROCEDURE Includes*(VAR s1, s2: ARRAY OF SET): BOOLEAN; - VAR i: INTEGER; -BEGIN - i := 0; - WHILE i < LEN(s1) DO - IF s1[i] + s2[i] # s1[i] THEN RETURN FALSE END; - INC(i) - END; - RETURN TRUE; -END Includes; - - -PROCEDURE Elements*(VAR s: ARRAY OF SET; VAR lastElem: INTEGER): INTEGER; - VAR i, n, max: INTEGER; -BEGIN - i := 0; n := 0; max := SHORT(LEN(s)) * size; - WHILE i < max DO - IF (i MOD size) IN s[i DIV size] THEN INC(n); lastElem := i END; - INC(i) - END; - RETURN n -END Elements; - - -PROCEDURE Empty*(VAR s: ARRAY OF SET): BOOLEAN; - VAR i: INTEGER; -BEGIN - i := 0; - WHILE i < LEN(s) DO - IF s[i] # {} THEN RETURN FALSE END; - INC(i) - END; - RETURN TRUE -END Empty; - - -PROCEDURE Equal*(VAR s1, s2: ARRAY OF SET): BOOLEAN; - VAR i: INTEGER; -BEGIN - i := 0; - WHILE i < LEN(s1) DO - IF s1[i] # s2[i] THEN RETURN FALSE END; - INC(i) - END; - RETURN TRUE -END Equal; - - -PROCEDURE Different*(VAR s1, s2: ARRAY OF SET): BOOLEAN; - VAR i: INTEGER; -BEGIN - i := 0; - WHILE i < LEN(s1) DO - IF s1[i] * s2[i] # {} THEN RETURN FALSE END; - INC(i) - END; - RETURN TRUE -END Different; - - -PROCEDURE Unite*(VAR s1, s2: ARRAY OF SET); - VAR i: INTEGER; -BEGIN - i := 0; WHILE i < LEN(s1) DO s1[i] := s1[i] + s2[i]; INC(i) END -END Unite; - - -PROCEDURE Differ*(VAR s1, s2: ARRAY OF SET); - VAR i: INTEGER; -BEGIN - i := 0; WHILE i < LEN(s1) DO s1[i] := s1[i] - s2[i]; INC(i) END -END Differ; - - -PROCEDURE Intersect*(VAR s1, s2, s3: ARRAY OF SET); - VAR i: INTEGER; -BEGIN - i := 0; WHILE i < LEN(s1) DO s3[i] := s1[i] * s2[i]; INC(i) END -END Intersect; - - -PROCEDURE Print*(VAR f: Texts.Writer; s: ARRAY OF SET; w, indent: INTEGER); - VAR col, i, max: INTEGER; -BEGIN - i := 0; col := indent; max := SHORT(LEN(s)) * size; - Texts.Write(f, "{"); - WHILE i < max DO - IF In(s, i) THEN - IF col + 4 > w THEN - Texts.WriteLn(f); - col := 0; WHILE col < indent DO Texts.Write(f, " "); INC(col) END - END; - Texts.WriteInt(f, i, 3); Texts.Write(f, ","); - INC(col, 4) - END; - INC(i) - END; - Texts.Write(f, "}") -END Print; - - -END Sets. diff --git a/src/tools/coco/v4_compat/Oberon.Mod b/src/tools/coco/v4_compat/Oberon.Mod deleted file mode 100755 index 13be167a..00000000 --- a/src/tools/coco/v4_compat/Oberon.Mod +++ /dev/null @@ -1,471 +0,0 @@ -MODULE Oberon; (*JG 6.9.90 / 23.9.93*) - - IMPORT SYSTEM, Unix, Kernel, Modules, Input, Display, Fonts, Viewers, Texts, X11; (* << *) - - CONST - - (*message ids*) - consume* = 0; track* = 1; - defocus* = 0; neutralize* = 1; mark* = 2; - - BasicCycle = 20; - - ESC = 1BX; SETUP = 0A4X; - - TYPE - - Painter* = PROCEDURE (x, y: INTEGER); - Marker* = RECORD Fade*, Draw*: Painter END; - - Cursor* = RECORD - marker*: Marker; on*: BOOLEAN; X*, Y*: INTEGER - END; - - ParList* = POINTER TO ParRec; - - ParRec* = RECORD - vwr*: Viewers.Viewer; - frame*: Display.Frame; - text*: Texts.Text; - pos*: LONGINT - END; - - InputMsg* = RECORD (Display.FrameMsg) - id*: INTEGER; - keys*: SET; - X*, Y*: INTEGER; - ch*: CHAR; - fnt*: Fonts.Font; - col*, voff*: SHORTINT - END; - - SelectionMsg* = RECORD (Display.FrameMsg) - time*: LONGINT; - text*: Texts.Text; - beg*, end*: LONGINT - END; - - ControlMsg* = RECORD (Display.FrameMsg) - id*, X*, Y*: INTEGER - END; - - CopyOverMsg* = RECORD (Display.FrameMsg) - text*: Texts.Text; - beg*, end*: LONGINT - END; - - CopyMsg* = RECORD (Display.FrameMsg) - F*: Display.Frame - END; - - Task* = POINTER TO TaskDesc; - - Handler* = PROCEDURE; - - TaskDesc* = RECORD - next: Task; - safe*: BOOLEAN; - time*: LONGINT; - handle*: Handler - END; - - VAR - User*: ARRAY 12 OF CHAR; (* << *) - - Arrow*, Star*: Marker; - Mouse*, Pointer*: Cursor; - - FocusViewer*: Viewers.Viewer; - - Log*: Texts.Text; - Par*: ParList; (*actual parameters*) - - CurTask*, PrevTask: Task; - - CurFnt*: Fonts.Font; CurCol*, CurOff*: SHORTINT; - Password*: LONGINT; - - DW, DH, CL, H0, H1, H2, H3: INTEGER; - unitW: INTEGER; - - ActCnt: INTEGER; (*action count for GC*) - Mod: Modules.Module; - ArrowFade: Painter; (* << *) - - (*user identification*) - - PROCEDURE Code(VAR s: ARRAY OF CHAR): LONGINT; - VAR i: INTEGER; a, b, c: LONGINT; - BEGIN - a := 0; b := 0; i := 0; - WHILE s[i] # 0X DO - c := b; b := a; a := (c MOD 509 + 1) * 127 + ORD(s[i]); - INC(i) - END; - IF b >= 32768 THEN b := b - 65536 END; - RETURN b * 65536 + a - END Code; - - PROCEDURE SetUser* (VAR user, password: ARRAY OF CHAR); - BEGIN COPY(user, User); Password := Code(password) - END SetUser; - - (*clocks*) - - PROCEDURE GetClock* (VAR t, d: LONGINT); - BEGIN Kernel.GetClock(t, d) - END GetClock; - - PROCEDURE SetClock* (t, d: LONGINT); - BEGIN Kernel.SetClock(t, d) - END SetClock; - - PROCEDURE Time* (): LONGINT; - BEGIN RETURN Input.Time() - END Time; - - (*cursor handling*) - - PROCEDURE FlipArrow (X, Y: INTEGER); (* << *) - END FlipArrow; - - PROCEDURE FlipStar (X, Y: INTEGER); - BEGIN - IF X < CL THEN - IF X < 7 THEN X := 7 ELSIF X > DW - 8 THEN X := DW - 8 END - ELSE - IF X < CL + 7 THEN X := CL + 7 ELSIF X > CL + DW - 8 THEN X := CL + DW - 8 END - END ; - IF Y < 7 THEN Y := 7 ELSIF Y > DH - 8 THEN Y := DH - 8 END; - Display.CopyPattern(Display.white, Display.star, X - 7, Y - 7, 2) - END FlipStar; - - PROCEDURE OpenCursor* (VAR c: Cursor); - BEGIN c.on := FALSE; c.X := 0; c.Y := 0 - END OpenCursor; - - PROCEDURE FadeCursor* (VAR c: Cursor); - BEGIN IF c.on THEN c.marker.Fade(c.X, c.Y); c.on := FALSE END - END FadeCursor; - - PROCEDURE DrawCursor* (VAR c: Cursor; VAR m: Marker; X, Y: INTEGER); (* << RC *) - BEGIN - IF c.on & ((X # c.X) OR (Y # c.Y) OR (m.Draw # c.marker.Draw)) THEN - c.marker.Fade(c.X, c.Y); c.on := FALSE - END; - IF c.marker.Fade = ArrowFade THEN - IF m.Fade # ArrowFade THEN X11.DefineCursor(X11.display, X11.primary, X11.noCursor) END - ELSE - IF m.Fade = ArrowFade THEN X11.DefineCursor(X11.display, X11.primary, X11.arrow) END - END ; - IF ~c.on THEN - m.Draw(X, Y); c.marker := m; c.X := X; c.Y := Y; c.on := TRUE - END - END DrawCursor; - - (*display management*) - - PROCEDURE RemoveMarks* (X, Y, W, H: INTEGER); - BEGIN - IF (Mouse.X > X - 16) & (Mouse.X < X + W + 16) & (Mouse.Y > Y - 16) & (Mouse.Y < Y + H + 16) THEN - FadeCursor(Mouse) - END; - IF (Pointer.X > X - 8) & (Pointer.X < X + W + 8) & (Pointer.Y > Y - 8) & (Pointer.Y < Y + H + 8) THEN - FadeCursor(Pointer) - END - END RemoveMarks; - - PROCEDURE HandleFiller (V: Display.Frame; VAR M: Display.FrameMsg); - BEGIN - WITH V: Viewers.Viewer DO - IF M IS InputMsg THEN - WITH M: InputMsg DO - IF M.id = track THEN DrawCursor(Mouse, Arrow, M.X, M.Y) END - END; - ELSIF M IS ControlMsg THEN - WITH M: ControlMsg DO - IF M.id = mark THEN DrawCursor(Pointer, Star, M.X, M.Y) END - END - ELSIF M IS Viewers.ViewerMsg THEN - WITH M: Viewers.ViewerMsg DO - IF (M.id = Viewers.restore) & (V.W > 0) & (V.H > 0) THEN - RemoveMarks(V.X, V.Y, V.W, V.H); - Display.ReplConst(Display.black, V.X, V.Y, V.W, V.H, 0) - ELSIF (M.id = Viewers.modify) & (M.Y < V.Y) THEN - RemoveMarks(V.X, M.Y, V.W, V.Y - M.Y); - Display.ReplConst(Display.black, V.X, M.Y, V.W, V.Y - M.Y, 0) - END - END - END - END - END HandleFiller; - - PROCEDURE OpenDisplay* (UW, SW, H: INTEGER); - VAR Filler: Viewers.Viewer; - BEGIN - Input.SetMouseLimits(Viewers.curW + UW + SW, H); - Display.ReplConst(Display.black, Viewers.curW, 0, UW + SW, H, 0); - NEW(Filler); Filler.handle := HandleFiller; - Viewers.InitTrack(UW, H, Filler); (*init user track*) - NEW(Filler); Filler.handle := HandleFiller; - Viewers.InitTrack(SW, H, Filler) (*init system track*) - END OpenDisplay; - - PROCEDURE DisplayWidth* (X: INTEGER): INTEGER; - BEGIN RETURN DW - END DisplayWidth; - - PROCEDURE DisplayHeight* (X: INTEGER): INTEGER; - BEGIN RETURN DH - END DisplayHeight; - - PROCEDURE OpenTrack* (X, W: INTEGER); - VAR Filler: Viewers.Viewer; - BEGIN - NEW(Filler); Filler.handle := HandleFiller; - Viewers.OpenTrack(X, W, Filler) - END OpenTrack; - - PROCEDURE UserTrack* (X: INTEGER): INTEGER; - BEGIN RETURN X DIV DW * DW - END UserTrack; - - PROCEDURE SystemTrack* (X: INTEGER): INTEGER; - BEGIN RETURN X DIV DW * DW + DW DIV 8 * 5 - END SystemTrack; - - PROCEDURE UY (X: INTEGER): INTEGER; - VAR fil, bot, alt, max: Display.Frame; - BEGIN - Viewers.Locate(X, 0, fil, bot, alt, max); - IF fil.H >= DH DIV 8 THEN RETURN DH END; - RETURN max.Y + max.H DIV 2 - END UY; - - PROCEDURE AllocateUserViewer* (DX: INTEGER; VAR X, Y: INTEGER); - BEGIN - IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y - ELSE X := DX DIV DW * DW; Y := UY(X) - END - END AllocateUserViewer; - - PROCEDURE SY (X: INTEGER): INTEGER; - VAR fil, bot, alt, max: Display.Frame; - BEGIN - Viewers.Locate(X, DH, fil, bot, alt, max); - IF fil.H >= DH DIV 8 THEN RETURN DH END; - IF max.H >= DH - H0 THEN RETURN max.Y + H3 END; - IF max.H >= H3 - H0 THEN RETURN max.Y + H2 END; - IF max.H >= H2 - H0 THEN RETURN max.Y + H1 END; - IF max # bot THEN RETURN max.Y + max.H DIV 2 END; - IF bot.H >= H1 THEN RETURN bot.H DIV 2 END; - RETURN alt.Y + alt.H DIV 2 - END SY; - - PROCEDURE AllocateSystemViewer* (DX: INTEGER; VAR X, Y: INTEGER); - BEGIN - IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y - ELSE X := DX DIV DW * DW + DW DIV 8 * 5; Y := SY(X) - END - END AllocateSystemViewer; - - PROCEDURE MarkedViewer* (): Viewers.Viewer; - BEGIN RETURN Viewers.This(Pointer.X, Pointer.Y) - END MarkedViewer; - - PROCEDURE PassFocus* (V: Viewers.Viewer); - VAR M: ControlMsg; - BEGIN M.id := defocus; FocusViewer.handle(FocusViewer, M); FocusViewer := V - END PassFocus; - - (*command interpretation*) - - PROCEDURE Call* (name: ARRAY OF CHAR; par: ParList; new: BOOLEAN; VAR res: INTEGER); - VAR Mod: Modules.Module; P: Modules.Command; i, j: INTEGER; - BEGIN res := 1; - i := 0; j := 0; - WHILE name[j] # 0X DO - IF name[j] = "." THEN i := j END; - INC(j) - END; - IF i > 0 THEN - name[i] := 0X; - Mod := Modules.ThisMod(name); - IF Modules.res = 0 THEN - INC(i); j := i; - WHILE name[j] # 0X DO name[j - i] := name[j]; INC(j) END; - name[j - i] := 0X; - P := Modules.ThisCommand(Mod, name); - IF Modules.res = 0 THEN - Par := par; Par.vwr := Viewers.This(par.frame.X, par.frame.Y); P; res := 0 - ELSE res := -1 - END - ELSE res := Modules.res - END - ELSE res := -1 - END - END Call; - - PROCEDURE GetSelection* (VAR text: Texts.Text; VAR beg, end, time: LONGINT); - VAR M: SelectionMsg; - BEGIN - M.time := -1; Viewers.Broadcast(M); time := M.time; - IF time >= 0 THEN text := M.text; beg := M.beg; end := M.end END - END GetSelection; - - PROCEDURE GC; - BEGIN IF ActCnt <= 0 THEN Kernel.GC(FALSE); ActCnt := BasicCycle END - END GC; - - PROCEDURE Install* (T: Task); - VAR t: Task; - BEGIN t := PrevTask; - WHILE (t.next # PrevTask) & (t.next # T) DO t := t.next END; - IF (t.next # T) & (CurTask # T) THEN - IF CurTask # NIL THEN (* called from a task *) - T.next := CurTask.next; CurTask.next := T - ELSE (* no task is currently running *) - T.next := PrevTask.next; PrevTask.next := T - END - END - END Install; - - PROCEDURE Remove* (T: Task); - VAR t: Task; - BEGIN t := PrevTask; - WHILE (t.next # T) & (t.next # PrevTask) DO t := t.next END; - IF t.next = T THEN t.next := t.next.next; PrevTask := t.next END; - IF CurTask = T THEN CurTask := PrevTask.next END - END Remove; - - PROCEDURE Collect* (count: INTEGER); - BEGIN ActCnt := count - END Collect; - - PROCEDURE SetFont* (fnt: Fonts.Font); - BEGIN CurFnt := fnt - END SetFont; - - PROCEDURE SetColor* (col: SHORTINT); - BEGIN CurCol := col - END SetColor; - - PROCEDURE SetOffset* (voff: SHORTINT); - BEGIN CurOff := voff - END SetOffset; - - PROCEDURE MinTime(): LONGINT; (* << *) - VAR minTime: LONGINT; t: Task; - BEGIN - minTime := MAX(LONGINT); t := PrevTask; - REPEAT - IF (t.time # -1) & (t.time < minTime) THEN minTime := t.time END ; - t := t.next; - UNTIL t = PrevTask ; - RETURN minTime - END MinTime; - - PROCEDURE NotifyTasks; (* << *) - VAR t0, p: Task; - BEGIN t0 := PrevTask; - REPEAT - CurTask := PrevTask.next; - IF CurTask.time = -1 THEN - IF ~CurTask.safe THEN PrevTask.next := CurTask.next END; - p := CurTask; CurTask.handle; PrevTask.next := CurTask; - IF CurTask # p THEN RETURN END (*detect Remove(CurTask)*) - END; - PrevTask := CurTask - UNTIL CurTask = t0 - END NotifyTasks; - - PROCEDURE Loop*; - VAR V: Viewers.Viewer; M: InputMsg; N: ControlMsg; - prevX, prevY, X, Y: INTEGER; keys: SET; ch: CHAR; - VM: Viewers.ViewerMsg; i: INTEGER; res: LONGINT; (* << *) - BEGIN - res := Kernel.sigsetjmp(Kernel.trapEnv, 1); (* << *) - LOOP - CurTask := NIL; - Input.Mouse(keys, X, Y); - IF Input.Available() > 0 THEN Input.Read(ch); - IF ch < 0F0X THEN - IF ch = ESC THEN - N.id := neutralize; Viewers.Broadcast(N); FadeCursor(Pointer) - ELSIF ch = SETUP THEN - N.id := mark; N.X := X; N.Y := Y; V := Viewers.This(X, Y); V.handle(V, N) - ELSIF ch = 0CX THEN (* << *) - N.id := neutralize; Viewers.Broadcast(N); FadeCursor(Pointer); - VM.id := Viewers.suspend; Viewers.Broadcast(VM); - VM.id := Viewers.restore; Viewers.Broadcast(VM) - ELSE - M.id := consume; M.ch := ch; M.fnt := CurFnt; M.col := CurCol; M.voff := CurOff; - FocusViewer.handle(FocusViewer, M); - DEC(ActCnt); NotifyTasks - END - ELSIF ch = 0F1X THEN Display.SetMode(0, {}) - ELSIF ch = 0F2X THEN Display.SetMode(0, {0}) - ELSIF ch = 0F3X THEN Display.SetMode(0, {2}) - ELSIF ch = 0F4X THEN X11.InitColors - ELSIF Kernel.FKey[ORD(ch) - 0F0H] # NIL THEN Kernel.FKey[ORD(ch) - 0F0H] - END - ELSIF keys # {} THEN - M.id := track; M.X := X; M.Y := Y; M.keys := keys; - REPEAT - V := Viewers.This(M.X, M.Y); V.handle(V, M); - Input.Mouse(M.keys, M.X, M.Y) - UNTIL M.keys = {}; - DEC(ActCnt); NotifyTasks - ELSE - IF (X # prevX) OR (Y # prevY) OR ~Mouse.on THEN - M.id := track; M.X := X; M.Y := Y; M.keys := keys; V := Viewers.This(X, Y); V.handle(V, M); - prevX := X; prevY := Y - END; - X11.DoSync; (* << *) - IF X11.EventsQueued(X11.display, X11.QueuedAfterReading) = 0 THEN (* << *) - Kernel.Select(MinTime() - Input.Time()); NotifyTasks; - FOR i := 0 TO 7 DO Kernel.readySet[i] := {} END - END ; - CurTask := PrevTask.next; - IF (CurTask.time <= Input.Time()) & (CurTask.time # -1) THEN - IF ~CurTask.safe THEN PrevTask.next := CurTask.next END; - CurTask.handle; PrevTask.next := CurTask - END; - PrevTask := CurTask - END - END - END Loop; - -BEGIN User[0] := 0X; - Arrow.Fade := FlipArrow; Arrow.Draw := FlipArrow; - ArrowFade := FlipArrow; (* << *) - Star.Fade := FlipStar; Star.Draw := FlipStar; - OpenCursor(Mouse); OpenCursor(Pointer); - - DW := Display.Width; DH := Display.Height; CL := Display.ColLeft; - H3 := DH - DH DIV 3; - H2 := H3 - H3 DIV 2; - H1 := DH DIV 5; - H0 := DH DIV 10; - -(* moved into Configuration.Mod - unitW := DW DIV 8; - OpenDisplay(unitW * 5, unitW * 3, DH); - FocusViewer := Viewers.This(0, 0); -*) - - CurFnt := Fonts.Default; - CurCol := Display.white; - CurOff := 0; - - Collect(BasicCycle); - NEW(PrevTask); - PrevTask.handle := GC; - PrevTask.safe := TRUE; - PrevTask.time := -1; (* << *) - PrevTask.next := PrevTask; - CurTask := NIL; - - Display.SetMode(0, {}); - -END Oberon. diff --git a/src/tools/coco/v4_compat/Oberon.Mod_orig b/src/tools/coco/v4_compat/Oberon.Mod_orig deleted file mode 100644 index 13be167a..00000000 --- a/src/tools/coco/v4_compat/Oberon.Mod_orig +++ /dev/null @@ -1,471 +0,0 @@ -MODULE Oberon; (*JG 6.9.90 / 23.9.93*) - - IMPORT SYSTEM, Unix, Kernel, Modules, Input, Display, Fonts, Viewers, Texts, X11; (* << *) - - CONST - - (*message ids*) - consume* = 0; track* = 1; - defocus* = 0; neutralize* = 1; mark* = 2; - - BasicCycle = 20; - - ESC = 1BX; SETUP = 0A4X; - - TYPE - - Painter* = PROCEDURE (x, y: INTEGER); - Marker* = RECORD Fade*, Draw*: Painter END; - - Cursor* = RECORD - marker*: Marker; on*: BOOLEAN; X*, Y*: INTEGER - END; - - ParList* = POINTER TO ParRec; - - ParRec* = RECORD - vwr*: Viewers.Viewer; - frame*: Display.Frame; - text*: Texts.Text; - pos*: LONGINT - END; - - InputMsg* = RECORD (Display.FrameMsg) - id*: INTEGER; - keys*: SET; - X*, Y*: INTEGER; - ch*: CHAR; - fnt*: Fonts.Font; - col*, voff*: SHORTINT - END; - - SelectionMsg* = RECORD (Display.FrameMsg) - time*: LONGINT; - text*: Texts.Text; - beg*, end*: LONGINT - END; - - ControlMsg* = RECORD (Display.FrameMsg) - id*, X*, Y*: INTEGER - END; - - CopyOverMsg* = RECORD (Display.FrameMsg) - text*: Texts.Text; - beg*, end*: LONGINT - END; - - CopyMsg* = RECORD (Display.FrameMsg) - F*: Display.Frame - END; - - Task* = POINTER TO TaskDesc; - - Handler* = PROCEDURE; - - TaskDesc* = RECORD - next: Task; - safe*: BOOLEAN; - time*: LONGINT; - handle*: Handler - END; - - VAR - User*: ARRAY 12 OF CHAR; (* << *) - - Arrow*, Star*: Marker; - Mouse*, Pointer*: Cursor; - - FocusViewer*: Viewers.Viewer; - - Log*: Texts.Text; - Par*: ParList; (*actual parameters*) - - CurTask*, PrevTask: Task; - - CurFnt*: Fonts.Font; CurCol*, CurOff*: SHORTINT; - Password*: LONGINT; - - DW, DH, CL, H0, H1, H2, H3: INTEGER; - unitW: INTEGER; - - ActCnt: INTEGER; (*action count for GC*) - Mod: Modules.Module; - ArrowFade: Painter; (* << *) - - (*user identification*) - - PROCEDURE Code(VAR s: ARRAY OF CHAR): LONGINT; - VAR i: INTEGER; a, b, c: LONGINT; - BEGIN - a := 0; b := 0; i := 0; - WHILE s[i] # 0X DO - c := b; b := a; a := (c MOD 509 + 1) * 127 + ORD(s[i]); - INC(i) - END; - IF b >= 32768 THEN b := b - 65536 END; - RETURN b * 65536 + a - END Code; - - PROCEDURE SetUser* (VAR user, password: ARRAY OF CHAR); - BEGIN COPY(user, User); Password := Code(password) - END SetUser; - - (*clocks*) - - PROCEDURE GetClock* (VAR t, d: LONGINT); - BEGIN Kernel.GetClock(t, d) - END GetClock; - - PROCEDURE SetClock* (t, d: LONGINT); - BEGIN Kernel.SetClock(t, d) - END SetClock; - - PROCEDURE Time* (): LONGINT; - BEGIN RETURN Input.Time() - END Time; - - (*cursor handling*) - - PROCEDURE FlipArrow (X, Y: INTEGER); (* << *) - END FlipArrow; - - PROCEDURE FlipStar (X, Y: INTEGER); - BEGIN - IF X < CL THEN - IF X < 7 THEN X := 7 ELSIF X > DW - 8 THEN X := DW - 8 END - ELSE - IF X < CL + 7 THEN X := CL + 7 ELSIF X > CL + DW - 8 THEN X := CL + DW - 8 END - END ; - IF Y < 7 THEN Y := 7 ELSIF Y > DH - 8 THEN Y := DH - 8 END; - Display.CopyPattern(Display.white, Display.star, X - 7, Y - 7, 2) - END FlipStar; - - PROCEDURE OpenCursor* (VAR c: Cursor); - BEGIN c.on := FALSE; c.X := 0; c.Y := 0 - END OpenCursor; - - PROCEDURE FadeCursor* (VAR c: Cursor); - BEGIN IF c.on THEN c.marker.Fade(c.X, c.Y); c.on := FALSE END - END FadeCursor; - - PROCEDURE DrawCursor* (VAR c: Cursor; VAR m: Marker; X, Y: INTEGER); (* << RC *) - BEGIN - IF c.on & ((X # c.X) OR (Y # c.Y) OR (m.Draw # c.marker.Draw)) THEN - c.marker.Fade(c.X, c.Y); c.on := FALSE - END; - IF c.marker.Fade = ArrowFade THEN - IF m.Fade # ArrowFade THEN X11.DefineCursor(X11.display, X11.primary, X11.noCursor) END - ELSE - IF m.Fade = ArrowFade THEN X11.DefineCursor(X11.display, X11.primary, X11.arrow) END - END ; - IF ~c.on THEN - m.Draw(X, Y); c.marker := m; c.X := X; c.Y := Y; c.on := TRUE - END - END DrawCursor; - - (*display management*) - - PROCEDURE RemoveMarks* (X, Y, W, H: INTEGER); - BEGIN - IF (Mouse.X > X - 16) & (Mouse.X < X + W + 16) & (Mouse.Y > Y - 16) & (Mouse.Y < Y + H + 16) THEN - FadeCursor(Mouse) - END; - IF (Pointer.X > X - 8) & (Pointer.X < X + W + 8) & (Pointer.Y > Y - 8) & (Pointer.Y < Y + H + 8) THEN - FadeCursor(Pointer) - END - END RemoveMarks; - - PROCEDURE HandleFiller (V: Display.Frame; VAR M: Display.FrameMsg); - BEGIN - WITH V: Viewers.Viewer DO - IF M IS InputMsg THEN - WITH M: InputMsg DO - IF M.id = track THEN DrawCursor(Mouse, Arrow, M.X, M.Y) END - END; - ELSIF M IS ControlMsg THEN - WITH M: ControlMsg DO - IF M.id = mark THEN DrawCursor(Pointer, Star, M.X, M.Y) END - END - ELSIF M IS Viewers.ViewerMsg THEN - WITH M: Viewers.ViewerMsg DO - IF (M.id = Viewers.restore) & (V.W > 0) & (V.H > 0) THEN - RemoveMarks(V.X, V.Y, V.W, V.H); - Display.ReplConst(Display.black, V.X, V.Y, V.W, V.H, 0) - ELSIF (M.id = Viewers.modify) & (M.Y < V.Y) THEN - RemoveMarks(V.X, M.Y, V.W, V.Y - M.Y); - Display.ReplConst(Display.black, V.X, M.Y, V.W, V.Y - M.Y, 0) - END - END - END - END - END HandleFiller; - - PROCEDURE OpenDisplay* (UW, SW, H: INTEGER); - VAR Filler: Viewers.Viewer; - BEGIN - Input.SetMouseLimits(Viewers.curW + UW + SW, H); - Display.ReplConst(Display.black, Viewers.curW, 0, UW + SW, H, 0); - NEW(Filler); Filler.handle := HandleFiller; - Viewers.InitTrack(UW, H, Filler); (*init user track*) - NEW(Filler); Filler.handle := HandleFiller; - Viewers.InitTrack(SW, H, Filler) (*init system track*) - END OpenDisplay; - - PROCEDURE DisplayWidth* (X: INTEGER): INTEGER; - BEGIN RETURN DW - END DisplayWidth; - - PROCEDURE DisplayHeight* (X: INTEGER): INTEGER; - BEGIN RETURN DH - END DisplayHeight; - - PROCEDURE OpenTrack* (X, W: INTEGER); - VAR Filler: Viewers.Viewer; - BEGIN - NEW(Filler); Filler.handle := HandleFiller; - Viewers.OpenTrack(X, W, Filler) - END OpenTrack; - - PROCEDURE UserTrack* (X: INTEGER): INTEGER; - BEGIN RETURN X DIV DW * DW - END UserTrack; - - PROCEDURE SystemTrack* (X: INTEGER): INTEGER; - BEGIN RETURN X DIV DW * DW + DW DIV 8 * 5 - END SystemTrack; - - PROCEDURE UY (X: INTEGER): INTEGER; - VAR fil, bot, alt, max: Display.Frame; - BEGIN - Viewers.Locate(X, 0, fil, bot, alt, max); - IF fil.H >= DH DIV 8 THEN RETURN DH END; - RETURN max.Y + max.H DIV 2 - END UY; - - PROCEDURE AllocateUserViewer* (DX: INTEGER; VAR X, Y: INTEGER); - BEGIN - IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y - ELSE X := DX DIV DW * DW; Y := UY(X) - END - END AllocateUserViewer; - - PROCEDURE SY (X: INTEGER): INTEGER; - VAR fil, bot, alt, max: Display.Frame; - BEGIN - Viewers.Locate(X, DH, fil, bot, alt, max); - IF fil.H >= DH DIV 8 THEN RETURN DH END; - IF max.H >= DH - H0 THEN RETURN max.Y + H3 END; - IF max.H >= H3 - H0 THEN RETURN max.Y + H2 END; - IF max.H >= H2 - H0 THEN RETURN max.Y + H1 END; - IF max # bot THEN RETURN max.Y + max.H DIV 2 END; - IF bot.H >= H1 THEN RETURN bot.H DIV 2 END; - RETURN alt.Y + alt.H DIV 2 - END SY; - - PROCEDURE AllocateSystemViewer* (DX: INTEGER; VAR X, Y: INTEGER); - BEGIN - IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y - ELSE X := DX DIV DW * DW + DW DIV 8 * 5; Y := SY(X) - END - END AllocateSystemViewer; - - PROCEDURE MarkedViewer* (): Viewers.Viewer; - BEGIN RETURN Viewers.This(Pointer.X, Pointer.Y) - END MarkedViewer; - - PROCEDURE PassFocus* (V: Viewers.Viewer); - VAR M: ControlMsg; - BEGIN M.id := defocus; FocusViewer.handle(FocusViewer, M); FocusViewer := V - END PassFocus; - - (*command interpretation*) - - PROCEDURE Call* (name: ARRAY OF CHAR; par: ParList; new: BOOLEAN; VAR res: INTEGER); - VAR Mod: Modules.Module; P: Modules.Command; i, j: INTEGER; - BEGIN res := 1; - i := 0; j := 0; - WHILE name[j] # 0X DO - IF name[j] = "." THEN i := j END; - INC(j) - END; - IF i > 0 THEN - name[i] := 0X; - Mod := Modules.ThisMod(name); - IF Modules.res = 0 THEN - INC(i); j := i; - WHILE name[j] # 0X DO name[j - i] := name[j]; INC(j) END; - name[j - i] := 0X; - P := Modules.ThisCommand(Mod, name); - IF Modules.res = 0 THEN - Par := par; Par.vwr := Viewers.This(par.frame.X, par.frame.Y); P; res := 0 - ELSE res := -1 - END - ELSE res := Modules.res - END - ELSE res := -1 - END - END Call; - - PROCEDURE GetSelection* (VAR text: Texts.Text; VAR beg, end, time: LONGINT); - VAR M: SelectionMsg; - BEGIN - M.time := -1; Viewers.Broadcast(M); time := M.time; - IF time >= 0 THEN text := M.text; beg := M.beg; end := M.end END - END GetSelection; - - PROCEDURE GC; - BEGIN IF ActCnt <= 0 THEN Kernel.GC(FALSE); ActCnt := BasicCycle END - END GC; - - PROCEDURE Install* (T: Task); - VAR t: Task; - BEGIN t := PrevTask; - WHILE (t.next # PrevTask) & (t.next # T) DO t := t.next END; - IF (t.next # T) & (CurTask # T) THEN - IF CurTask # NIL THEN (* called from a task *) - T.next := CurTask.next; CurTask.next := T - ELSE (* no task is currently running *) - T.next := PrevTask.next; PrevTask.next := T - END - END - END Install; - - PROCEDURE Remove* (T: Task); - VAR t: Task; - BEGIN t := PrevTask; - WHILE (t.next # T) & (t.next # PrevTask) DO t := t.next END; - IF t.next = T THEN t.next := t.next.next; PrevTask := t.next END; - IF CurTask = T THEN CurTask := PrevTask.next END - END Remove; - - PROCEDURE Collect* (count: INTEGER); - BEGIN ActCnt := count - END Collect; - - PROCEDURE SetFont* (fnt: Fonts.Font); - BEGIN CurFnt := fnt - END SetFont; - - PROCEDURE SetColor* (col: SHORTINT); - BEGIN CurCol := col - END SetColor; - - PROCEDURE SetOffset* (voff: SHORTINT); - BEGIN CurOff := voff - END SetOffset; - - PROCEDURE MinTime(): LONGINT; (* << *) - VAR minTime: LONGINT; t: Task; - BEGIN - minTime := MAX(LONGINT); t := PrevTask; - REPEAT - IF (t.time # -1) & (t.time < minTime) THEN minTime := t.time END ; - t := t.next; - UNTIL t = PrevTask ; - RETURN minTime - END MinTime; - - PROCEDURE NotifyTasks; (* << *) - VAR t0, p: Task; - BEGIN t0 := PrevTask; - REPEAT - CurTask := PrevTask.next; - IF CurTask.time = -1 THEN - IF ~CurTask.safe THEN PrevTask.next := CurTask.next END; - p := CurTask; CurTask.handle; PrevTask.next := CurTask; - IF CurTask # p THEN RETURN END (*detect Remove(CurTask)*) - END; - PrevTask := CurTask - UNTIL CurTask = t0 - END NotifyTasks; - - PROCEDURE Loop*; - VAR V: Viewers.Viewer; M: InputMsg; N: ControlMsg; - prevX, prevY, X, Y: INTEGER; keys: SET; ch: CHAR; - VM: Viewers.ViewerMsg; i: INTEGER; res: LONGINT; (* << *) - BEGIN - res := Kernel.sigsetjmp(Kernel.trapEnv, 1); (* << *) - LOOP - CurTask := NIL; - Input.Mouse(keys, X, Y); - IF Input.Available() > 0 THEN Input.Read(ch); - IF ch < 0F0X THEN - IF ch = ESC THEN - N.id := neutralize; Viewers.Broadcast(N); FadeCursor(Pointer) - ELSIF ch = SETUP THEN - N.id := mark; N.X := X; N.Y := Y; V := Viewers.This(X, Y); V.handle(V, N) - ELSIF ch = 0CX THEN (* << *) - N.id := neutralize; Viewers.Broadcast(N); FadeCursor(Pointer); - VM.id := Viewers.suspend; Viewers.Broadcast(VM); - VM.id := Viewers.restore; Viewers.Broadcast(VM) - ELSE - M.id := consume; M.ch := ch; M.fnt := CurFnt; M.col := CurCol; M.voff := CurOff; - FocusViewer.handle(FocusViewer, M); - DEC(ActCnt); NotifyTasks - END - ELSIF ch = 0F1X THEN Display.SetMode(0, {}) - ELSIF ch = 0F2X THEN Display.SetMode(0, {0}) - ELSIF ch = 0F3X THEN Display.SetMode(0, {2}) - ELSIF ch = 0F4X THEN X11.InitColors - ELSIF Kernel.FKey[ORD(ch) - 0F0H] # NIL THEN Kernel.FKey[ORD(ch) - 0F0H] - END - ELSIF keys # {} THEN - M.id := track; M.X := X; M.Y := Y; M.keys := keys; - REPEAT - V := Viewers.This(M.X, M.Y); V.handle(V, M); - Input.Mouse(M.keys, M.X, M.Y) - UNTIL M.keys = {}; - DEC(ActCnt); NotifyTasks - ELSE - IF (X # prevX) OR (Y # prevY) OR ~Mouse.on THEN - M.id := track; M.X := X; M.Y := Y; M.keys := keys; V := Viewers.This(X, Y); V.handle(V, M); - prevX := X; prevY := Y - END; - X11.DoSync; (* << *) - IF X11.EventsQueued(X11.display, X11.QueuedAfterReading) = 0 THEN (* << *) - Kernel.Select(MinTime() - Input.Time()); NotifyTasks; - FOR i := 0 TO 7 DO Kernel.readySet[i] := {} END - END ; - CurTask := PrevTask.next; - IF (CurTask.time <= Input.Time()) & (CurTask.time # -1) THEN - IF ~CurTask.safe THEN PrevTask.next := CurTask.next END; - CurTask.handle; PrevTask.next := CurTask - END; - PrevTask := CurTask - END - END - END Loop; - -BEGIN User[0] := 0X; - Arrow.Fade := FlipArrow; Arrow.Draw := FlipArrow; - ArrowFade := FlipArrow; (* << *) - Star.Fade := FlipStar; Star.Draw := FlipStar; - OpenCursor(Mouse); OpenCursor(Pointer); - - DW := Display.Width; DH := Display.Height; CL := Display.ColLeft; - H3 := DH - DH DIV 3; - H2 := H3 - H3 DIV 2; - H1 := DH DIV 5; - H0 := DH DIV 10; - -(* moved into Configuration.Mod - unitW := DW DIV 8; - OpenDisplay(unitW * 5, unitW * 3, DH); - FocusViewer := Viewers.This(0, 0); -*) - - CurFnt := Fonts.Default; - CurCol := Display.white; - CurOff := 0; - - Collect(BasicCycle); - NEW(PrevTask); - PrevTask.handle := GC; - PrevTask.safe := TRUE; - PrevTask.time := -1; (* << *) - PrevTask.next := PrevTask; - CurTask := NIL; - - Display.SetMode(0, {}); - -END Oberon. diff --git a/src/tools/coco/v4_compat/TextFrames.Mod b/src/tools/coco/v4_compat/TextFrames.Mod deleted file mode 100755 index 1b9ab5a6..00000000 --- a/src/tools/coco/v4_compat/TextFrames.Mod +++ /dev/null @@ -1,1363 +0,0 @@ -MODULE TextFrames; (** CAS/MH/HM 20.4.94/JT 1.5.95 **) - (* IMPORT SYSTEM, Modules, Input, Display, Fonts, Viewers, Oberon, MenuViewers, Texts;*) - IMPORT Oberon, Texts; - - CONST - (** update message IDs **) - replace* = 0; insert* = 1; delete* = 2; - (** units **) - mm* = 36000; Unit* = 10000; - (** parc options **) - gridAdj* = 0; leftAdj* = 1; rightAdj* = 2; pageBreak* = 3; twoColumns* = 4; - (** maximum number of TAB stops in Parc **) - MaxTabs* = 32; - - AdjMask = {leftAdj, rightAdj}; - TAB = 9X; LF = 0AX; CR = 0DX; DEL = 7FX; BRK = 0ACX; ShiftBRK = 0ADX; CRSL = 0C4X; CRSR = 0C3X; - AdjustSpan = 30; MinTabWidth = 1 * mm; StdTabWidth = 4 * mm; - rightKey = 0; middleKey = 1; leftKey = 2; cancel = {rightKey, middleKey, leftKey}; - - - TYPE - Parc* = POINTER TO ParcDesc; - ParcDesc* = RECORD (Texts.ElemDesc) - left*: LONGINT; (** distance from (F.X + F.left); in units **) - first*: LONGINT; (** first line indentation from P.left; in units **) - width*: LONGINT; (** parc width; in units **) - lead*: LONGINT; (** distance to previous line; in units **) - lsp*: LONGINT; (** line spacing of text after P; in units **) - dsr*: LONGINT; (** descender of text after P; in units **) - opts*: SET; - nofTabs*: INTEGER; - tab*: ARRAY MaxTabs OF LONGINT (** in units **) - END; - - TextLine = POINTER TO TextLineDesc; - Location* = RECORD - org*, pos*: LONGINT; - x*, y*, dx*, dy*: INTEGER; - line: TextLine - END; - TextLineDesc = RECORD - next: TextLine; - eot: BOOLEAN; (* contains end of text *) - indent: LONGINT; (* line indentation in units *) - w, h, dsr: INTEGER; (* bounding box clipped to frame (w including indent) *) - w0, nob: INTEGER; (* unclipped width (including indent), number of contained blanks: nob > 0 if text line wraps around *) - org, len, span: LONGINT; (* len ... characters w/o; span ... w/ trailing CR or white space, if any *) - P: Parc; (* last parc before this text line *) - pbeg: LONGINT (* position of P *) - END; - - Frame* = POINTER TO FrameDesc; - FrameDesc* = RECORD (Display.FrameDesc) - text*: Texts.Text; - org*: LONGINT; - col*, left*, right*, top*, bot*: INTEGER; - markH*: INTEGER; (** position of tick mark in scroll bar (< 0 => no tick mark) **) - barW*: INTEGER; (** scroll bar width **) - time*: LONGINT; (** selection time **) - hasCar*, hasSel*, showsParcs*: BOOLEAN; (** caret/selection present; parcs visible **) - carloc*, selbeg*, selend*: Location; - focus*: Display.Frame; (** frame of nested element if this element contains the focus **) - trailer: TextLine (* ring with trailer and header *) - END; - - DisplayMsg* = RECORD (Texts.ElemMsg) - prepare*: BOOLEAN; - fnt*: Fonts.Font; - col*: SHORTINT; - pos*: LONGINT; (** position in host text **) - frame*: Display.Frame; (** ~prepare => host frame **) - X0*, Y0*: INTEGER; (** ~prepare => receiver origin in screen space **) - indent*: LONGINT; (** prepare => width already consumed in line, in units **) - elemFrame*: Display.Frame (** optional return parameter **) - END; - - TrackMsg* = RECORD (Texts.ElemMsg) - X*, Y*: INTEGER; - keys*: SET; - fnt*: Fonts.Font; - col*: SHORTINT; - pos*: LONGINT; (** position in host text **) - frame*: Display.Frame; (** host frame **) - X0*, Y0*: INTEGER (** receiver origin in screen space **) - END; - - FocusMsg* = RECORD (Texts.ElemMsg) - focus*: BOOLEAN; (** whether to focus or to defocus **) - elemFrame*: Display.Frame; (** focus/defocus target **) - frame*: Display.Frame (** host frame **) - END; -(* - NotifyMsg* = RECORD (Display.FrameMsg) - frame*: Display.Frame (** host frame **) - END; - - UpdateMsg* = RECORD (Display.FrameMsg) - id*: INTEGER; - text*: Texts.Text; - beg*, end*: LONGINT - END; - - InsertElemMsg* = RECORD (Display.FrameMsg) - e*: Texts.Elem - END; - - SelectMsg = RECORD (Display.FrameMsg) - text: Texts.Text; - beg, end: LONGINT; - time: LONGINT - END; - -*) - VAR - menuH*, barW*, left*, right*, top*, bot*: INTEGER; - defParc*: Parc; - - (*shared globals => get rid off in a later version?*) - W, W0: Texts.Writer; - B: Texts.Buffer; - - P: Parc; - pbeg: LONGINT; (*inv T[pbeg] = P*) - R: Texts.Reader; - nextCh: CHAR; (*inv Base(R) = T => T[Pos(R)-1] = nextCh]*) - par: Oberon.ParList; - neutralize: Oberon.ControlMsg; - - - PROCEDURE Min (x, y: INTEGER): INTEGER; - BEGIN IF x < y THEN RETURN x ELSE RETURN y END - END Min; - - PROCEDURE Max (x, y: INTEGER): INTEGER; - BEGIN IF x > y THEN RETURN x ELSE RETURN y END - END Max; -(* - PROCEDURE MarkMenu (F: Frame); - VAR R: Texts.Reader; V: Viewers.Viewer; T: Texts.Text; ch: CHAR; - BEGIN V := Viewers.This(F.X, F.Y); - IF (V IS MenuViewers.Viewer) & (V.dsc IS Frame) & (F # V.dsc) THEN - T := V.dsc(Frame).text; - IF T.len > 0 THEN Texts.OpenReader(R, T, T.len - 1); Texts.Read(R, ch) ELSE ch := 0X END; - IF ch # "!" THEN Texts.Write(W0, "!"); Texts.Append(T, W0.buf) END - END - END MarkMenu; - -*) - (* Element Subframes *) -(* - PROCEDURE InvertBorder (F: Display.Frame); - BEGIN - Display.ReplPattern(Display.white, Display.grey1, F.X-1, F.Y-1, F.W+2, 1, Display.invert); - Display.ReplPattern(Display.white, Display.grey1, F.X-1, F.Y+F.H, F.W+2, 1, Display.invert); - Display.ReplPattern(Display.white, Display.grey1, F.X-1, F.Y, 1, F.H, Display.invert); - Display.ReplPattern(Display.white, Display.grey1, F.X+F.W, F.Y, 1, F.H, Display.invert) - END InvertBorder; - - PROCEDURE InvalSubFrames (F: Frame; x, y, w, h: INTEGER); (* removes and suspends all subframes partly in (x, y, w, h) *) - VAR p, f: Display.Frame; msg: MenuViewers.ModifyMsg; - BEGIN - IF (w > 0) & (h > 0) THEN f := F.dsc; - IF f # NIL THEN p := f; f := p.next END; - WHILE f # NIL DO - IF (f.X < x + w) & (f.X + f.W > x) & (f.Y < y + h) & (f.Y + f.H > y) THEN p.next := f.next; - msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := 0; - f.handle(f, msg) - ELSE p := f - END; - f := p.next - END; - f := F.dsc; - IF (f # NIL) & (f.X < x + w) & (f.X + f.W > x) & (f.Y < y + h) & (f.Y + f.H > y) THEN F.dsc := F.dsc.next; - msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := 0; - f.handle(f, msg) - END - END - END InvalSubFrames; - - PROCEDURE ShiftSubFrames (F: Frame; oldY, newY, h: INTEGER); (* shift (F.X, oldY, F.W, h) to (F.X, newY, F.W, h) *) - VAR f: Display.Frame; msg: MenuViewers.ModifyMsg; - BEGIN - IF oldY > newY THEN InvalSubFrames(F, F.X, newY, F.W, oldY - newY) - ELSE InvalSubFrames(F, F.X, oldY + h, F.W, newY - oldY) - END; - f := F.dsc; - WHILE f # NIL DO - IF (f.Y < oldY + h) & (f.Y + f.H > oldY) THEN INC(f.Y, newY - oldY); - msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := f.H; - f.handle(f, msg) - END; - f := f.next - END - END ShiftSubFrames; - - PROCEDURE NotifySubFrames (F: Frame; VAR msg: Display.FrameMsg); - VAR p, f: Display.Frame; - BEGIN f := F.dsc; - IF msg IS NotifyMsg THEN msg(NotifyMsg).frame := F END; - WHILE f # NIL DO p := f; f := f.next; p.handle(p, msg) END - END NotifySubFrames; - -*) - (* Display Primitives *) -(* - PROCEDURE DrawCursor (x, y: INTEGER); - BEGIN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y) - END DrawCursor; - - PROCEDURE TrackMouse (VAR x, y: INTEGER; VAR keys, keysum: SET); - BEGIN Input.Mouse(keys, x, y); keysum := keysum + keys; DrawCursor(x, y) - END TrackMouse; - - PROCEDURE EraseRect (F: Frame; x, y, w, h: INTEGER); - BEGIN Display.ReplConst(F.col, x, y, w, h, Display.replace); InvalSubFrames(F, x, y, w, h) - END EraseRect; - - PROCEDURE Erase (F: Frame; x, y, w, h: INTEGER); (*RemoveMarks optimization*) - BEGIN - IF h > 0 THEN Oberon.RemoveMarks(x, y, w, h); EraseRect(F, x, y, w, h) END - END Erase; - - PROCEDURE Shift (F: Frame; oldY, newY, h: INTEGER); (*RemoveMarks optimization*) - BEGIN - IF (oldY # newY) & (h > 0) THEN - Oberon.RemoveMarks(F.X + F.left, Min(oldY, newY), F.W - F.left, Max(oldY, newY) + h); - Display.CopyBlock(F.X + F.left, oldY, F.W - F.left, h, F.X + F.left, newY, Display.replace); - ShiftSubFrames(F, oldY, newY, h) - END - END Shift; - - PROCEDURE InvertCaret (F: Frame); - VAR loc: Location; bot: INTEGER; - BEGIN loc := F.carloc; bot := loc.y + loc.line.dsr - 6; - Display.CopyPatternC(F, Display.white, Display.hook, loc.x, bot, Display.invert) - END InvertCaret; - - PROCEDURE InvertRect (F: Frame; x, y, w, h: INTEGER); (*clips to right and bottom frame margin*) - BEGIN - IF x + w > F.X + F.W - F.right THEN w := F.X + F.W - F.right - x END; - IF y >= F.Y + F.bot THEN Display.ReplConst(Display.white, x, y, w, h, Display.invert) END - END InvertRect; - - PROCEDURE InvertSelection (F: Frame; beg, end: Location); - VAR t: TextLine; ex, rx, w, py: INTEGER; - BEGIN - rx := F.X + F.W - F.right; t := end.line; - IF t.eot OR (end.pos <= t.org + t.len) THEN ex := end.x ELSE ex := rx END; - IF beg.line = end.line THEN InvertRect(F, beg.x, beg.y, ex - beg.x, beg.line.h) - ELSE t := beg.line; py := beg.y; w := F.W - F.left - F.right; - InvertRect(F, beg.x, py, rx - beg.x, t.h); t := t.next; DEC(py, t.h); - WHILE t # end.line DO InvertRect(F, F.X + F.left, py, w, t.h); t := t.next; DEC(py, t.h) END; - InvertRect(F, F.X + F.left, py, ex - (F.X + F.left), t.h) - END - END InvertSelection; - - PROCEDURE CoordToPos (F: Frame; mh: INTEGER): LONGINT; - VAR h: INTEGER; - BEGIN h := F.H - 1; - IF h > 0 THEN RETURN ENTIER(F.text.len / h * (h - mh)) ELSE RETURN 0 END - END CoordToPos; - - PROCEDURE ShowBar (F: Frame; botH, topH: INTEGER); - BEGIN - IF (F.left > F.barW) & (F.barW > 0) THEN - Display.ReplConst(Display.white, F.X + F.barW - 1, F.Y + botH, 1, topH - botH, Display.replace) - END - END ShowBar; - - PROCEDURE Tick (F: Frame); - BEGIN - IF (0 <= F.markH) & (F.markH < F.H) & (F.left > F.barW) & (F.barW > 6) & (F.H > 2) THEN - Display.ReplConst(Display.white, F.X + 1, F.Y + F.markH, F.barW - 6, 2, Display.invert) - END - END Tick; - - PROCEDURE ShowTick (F: Frame); (* removes global marks as needed *) - VAR h, mh: INTEGER; len: LONGINT; - BEGIN - h := F.H - 2; len := F.text.len; - IF len > 0 THEN mh := SHORT(ENTIER(h - F.org / len * h)) ELSE mh := h END; - IF F.markH # mh THEN Oberon.RemoveMarks(F.X, F.Y, F.barW, F.H); - Tick(F); F.markH := mh; Tick(F) - END - END ShowTick; - - PROCEDURE Mark* (F: Frame; mark: INTEGER); - BEGIN - Erase(F, F.X, F.Y, F.barW - 1, F.H); F.markH := -1; - IF (mark < 0) & (F.H >= 16) THEN - Display.CopyPattern(Display.white, Display.downArrow, F.X, F.Y, Display.invert) - ELSIF mark > 0 THEN - ShowTick(F) - END - END Mark; -*) - - (** Parcs **) - - PROCEDURE ParcBefore* (T: Texts.Text; pos: LONGINT; VAR P: Parc; VAR beg: LONGINT); - VAR R: Texts.Reader; - BEGIN Texts.OpenReader(R, T, pos + 1); - REPEAT Texts.ReadPrevElem(R) UNTIL R.eot OR (R.elem IS Parc); - IF R.eot THEN P := defParc; beg := -1 ELSE P := R.elem(Parc); beg := Texts.Pos(R) END - END ParcBefore; - - PROCEDURE -InitDefParc() "ParcElems__init()"; - - (* Screen Metrics *) - - PROCEDURE Tab (dw: INTEGER; VAR dx: INTEGER); (*P set*) - (* dw = line width from left margin to caret (in pixels); dx = distance from caret to next tab stop (in pixels) *) - VAR i, n: INTEGER; w: LONGINT; - BEGIN - i := 0; n := P.nofTabs; w := LONG(dw) * Unit + MinTabWidth; - IF dw < 0 THEN dx := -dw - ELSE - WHILE (i < n) & (P.tab[i] < w) DO INC(i) END; - IF i < n THEN dx := SHORT((P.tab[i] - LONG(dw) * Unit) DIV Unit) - ELSE dx := StdTabWidth DIV Unit - END - END - END Tab; -(* - PROCEDURE MeasureSpecial (dw: INTEGER; VAR dx, x, y, w, h: INTEGER); - (* returns metrics of nextCh (nextCh <= " "); sends prepare message to elements; P, R, nextCh set *) - VAR e: Texts.Elem; pat: Display.Pattern; msg: DisplayMsg; - BEGIN - IF nextCh = " " THEN Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat); - x := 0; y := 0; w := dx; h := 0 - ELSIF nextCh = TAB THEN Tab(dw, dx); x := 0; y := 0; w := dx; h := 0 - ELSIF R.elem # NIL THEN e := R.elem; - msg.prepare := TRUE; msg.indent := LONG(dw) * Unit; - msg.fnt := R.fnt; msg.col := R.col; msg.pos := Texts.Pos(R)-1; - msg.Y0 := -SHORT(P.dsr DIV Unit); (*<<< 18-Nov-91*) - e.handle(e, msg); - w := SHORT(e.W DIV Unit); - dx := w; x := 0; y := msg.Y0; h := SHORT(e.H DIV Unit) (*<<< 18-Nov-91*) - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat) - END - END MeasureSpecial; - - PROCEDURE GetSpecial (F: Frame; VAR n: INTEGER; cn, ddx, dw: INTEGER; VAR dx, x, y, w, h: INTEGER); - (* returns metrics of nextCh (nextCh <= " "); no prepare message to elements; extends blanks for block adjust *) - (* cn ... add 1 pixel to first cn blanks (block adjust); ddx ... add ddx pixels to every blank (block adjust) *) - (*P, R, nextCh set*) - VAR e: Texts.Elem; pat: Display.Pattern; - BEGIN - IF nextCh = " " THEN Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat); - x := 0; y := 0; INC(dx, ddx); INC(n); IF n <= cn THEN INC(dx) END; (*space correction for block adjustment*) - w := dx; h := 0 - ELSIF nextCh = TAB THEN Tab(dw, dx); x := 0; y := 0; w := dx; h := 0 - ELSIF R.elem # NIL THEN e := R.elem; - IF (e IS Parc) & (P.W = 9999 * Unit) THEN (* P gets this value in prepare message *) - w := Min(SHORT((P.width + P.left) DIV Unit), F.W - F.right - F.left); - e.W := LONG(w) * Unit - ELSE w := SHORT(e.W DIV Unit) - END; - dx := w; x := 0; y := -SHORT(P.dsr DIV Unit); h := SHORT(e.H DIV Unit) - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat) - END - END GetSpecial; - - PROCEDURE NextLine (T: Texts.Text; VAR org: LONGINT); (*R, nextCh set; org = Texts.Pos(R)-1*) - VAR pat: Display.Pattern; pos, bk, d: LONGINT; width, tw, dx, x, y, w, h: INTEGER; - R1: Texts.Reader; peekCh: CHAR; indent: INTEGER; - BEGIN - tw := 0; dx := 0; w := 0; bk := -999; (* bk = pos of last seperator *) - pos := org; ParcBefore(T, pos, P, pbeg); width := SHORT(P.width DIV Unit); - indent := 0; - IF org > 0 THEN Texts.OpenReader(R1, T, org - 1); Texts.Read(R1, peekCh); - IF (peekCh = CR) OR (R1.elem # NIL) & (R1.elem IS Parc) THEN indent := SHORT(P.first DIV Unit) END; - END; - INC(tw, indent); - LOOP INC(pos); (*inv pos = Texts.Pos(R), ~R.eof => nextCh = text[pos-1]*) - IF R.eot OR (nextCh = CR) THEN EXIT END; - INC(tw, dx); - IF nextCh <= " " THEN MeasureSpecial(tw, dx, x, y, w, h) - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat) - END; - IF tw + x + w > width THEN d := pos - bk; - IF (d < AdjustSpan) & (nextCh > " ") THEN pos := bk - ELSIF ((nextCh > " ") OR (nextCh = Texts.ElemChar)) & (pos > org + 1) THEN DEC(pos) - END; - Texts.OpenReader(R, T, pos); Texts.Read(R, nextCh); - EXIT - END; - IF (nextCh <= " ") & (nextCh # Texts.ElemChar) THEN bk := pos END; - Texts.Read(R, nextCh) - END; - org := pos - END NextLine; - - PROCEDURE BegOfLine (T: Texts.Text; VAR pos: LONGINT; adjust: BOOLEAN); - (* returns origin of line containing pos *) - VAR p, org: LONGINT; - BEGIN - IF pos <= 0 THEN pos := 0 - ELSE - IF pos <= T.len THEN org := pos ELSE org := T.len END; - LOOP (*search backwards for CR*) - IF org = 0 THEN EXIT END; - Texts.OpenReader(R, T, org - 1); Texts.Read(R, nextCh); - IF nextCh = CR THEN EXIT END; - DEC(org) - END; - IF adjust THEN (*search forward for actual line origin*) - Texts.OpenReader(R, T, org); Texts.Read(R, nextCh); p := org; - REPEAT org := p; NextLine(T, p) UNTIL (p > pos) OR R.eot - END; - pos := org - END - END BegOfLine; - - PROCEDURE AdjustMetrics (F: Frame; t: TextLine; VAR pw, tw, ddx, cn: INTEGER); (*t.org set*) - (* pw ... x-coord of first char in line (in pixels); tw ... width of text line; ddx, cn ... see GetSpecial *) - BEGIN - P := t.P; pbeg := t.pbeg; - pw := F.left; tw := t.w; ddx := 0; cn := 0; - IF t.pbeg # t.org THEN - INC(pw, SHORT((P.left + t.indent) DIV Unit)); - IF leftAdj IN P.opts THEN - IF (rightAdj IN P.opts) & (t.nob > 0) THEN - tw := SHORT(P.width DIV Unit); ddx := (tw - t.w0) DIV t.nob; cn := (tw - t.w0) MOD t.nob - END - ELSIF rightAdj IN P.opts THEN INC(pw, SHORT(P.width DIV Unit) - t.w0) - ELSE (*center*) INC(pw, (SHORT(P.width DIV Unit) - t.w0) DIV 2) - END; - DEC(tw, SHORT(t.indent DIV Unit)); - END - END AdjustMetrics; - -*) - (* Screen Placement *) -(* - PROCEDURE DrawSpecial (F: Frame; px, py, x, y: INTEGER); (*R, nextCh set*) - VAR e: Texts.Elem; pat: Display.Pattern; dx, w, h: INTEGER; msg: DisplayMsg; - BEGIN - IF (nextCh = TAB) OR (nextCh = CR) THEN (*skip*) - ELSIF R.elem # NIL THEN e := R.elem; - IF ~(e IS Parc) OR F.showsParcs THEN - msg.prepare := FALSE; msg.fnt := R.fnt; msg.col := R.col; msg.pos := Texts.Pos(R) - 1; - msg.frame := F; msg.X0 := px + x; msg.Y0 := py + y; msg.elemFrame := NIL; - e.handle(e, msg); - IF msg.elemFrame # NIL THEN msg.elemFrame.next := F.dsc; F.dsc := msg.elemFrame END; - ELSIF pageBreak IN e(Parc).opts THEN (*(e IS Parc) & ~F.showsParcs*) - Display.ReplPattern(Display.white, Display.grey1, px + x, py, SHORT(e.W DIV Unit), 1, Display.replace) - END - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat); - Display.CopyPattern(R.col, pat, px + x, py + y, Display.invert) - END; - END DrawSpecial; - - PROCEDURE ShowLine (F: Frame; t: TextLine; left, right, py: INTEGER); - VAR pat: Display.Pattern; i: LONGINT; n, cn, lm, px, pw, tw, ddx, dx, x, y, w, h: INTEGER; - BEGIN - (* lm ... left parc margin in screen coord; pw ... x of first char in frame coord *) - Texts.OpenReader(R, F.text, t.org); AdjustMetrics(F, t, pw, tw, ddx, cn); - lm := F.X + F.left + SHORT(P.left DIV Unit); px := F.X + pw; INC(py, t.dsr); i := 0; n := 0; - WHILE i < t.len DO Texts.Read(R, nextCh); - IF nextCh <= " " THEN GetSpecial(F, n, cn, ddx, px - lm, dx, x, y, w, h) - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat) - END; - INC(y, R.fnt.height * R.voff DIV 64); - IF px + x + w <= right THEN - IF px + x >= left THEN - IF nextCh <= " " THEN DrawSpecial(F, px, py, x, y) - ELSE Display.CopyPattern(R.col, pat, px + x, py + y, Display.invert) - END - END; - INC(px, dx); INC(i) - ELSE i := t.len - END - END - END ShowLine; - - PROCEDURE ShowLines (F: Frame; botH, topH: INTEGER; erase: BOOLEAN); - VAR t: TextLine; ph: INTEGER; - BEGIN - t := F.trailer.next; ph := F.H - F.top; - WHILE (t # F.trailer) & (ph - t.h >= topH) DO DEC(ph, t.h); t := t.next END; - WHILE (t # F.trailer) & (ph - t.h >= botH) DO DEC(ph, t.h); - IF erase THEN Erase(F, F.X + F.left, F.Y + ph, F.W - F.right - F.left, t.h) END; - ShowLine(F, t, F.X + F.left, F.X + F.W - F.right, F.Y + ph); t := t.next - END - END ShowLines; - -*) - (* Screen Casting *) -(* - PROCEDURE MeasureLine (F: Frame; maxW: INTEGER; t: TextLine); (* R, nextCh set *) - VAR pat: Display.Pattern; len, bklen, d: LONGINT; eol: BOOLEAN; - nob, bknob, width, minY, bkminY, maxY, bkmaxY, tw, bktw, lsp, dsr, dx, x, y, w, h: INTEGER; - R1: Texts.Reader; peekCh: CHAR; - (* bk* ... backup for last blank *) - BEGIN - len := 0; nob := 0; bklen := -999; tw := 0; dx := 0; minY := 0; maxY := 0; - ParcBefore(F.text, t.org, P, pbeg); - lsp := SHORT(P.lsp DIV Unit); dsr := SHORT(P.dsr DIV Unit); width := SHORT(P.width DIV Unit); - t.indent := 0; - IF t.org > 0 THEN Texts.OpenReader(R1, F.text, t.org - 1); Texts.Read(R1, peekCh); - IF (peekCh = CR) OR (R1.elem # NIL) & (R1.elem IS Parc) THEN t.indent := P.first END; - END; - INC(tw, SHORT(t.indent DIV Unit)); - LOOP - IF R.eot OR (nextCh = CR) THEN nob := 0; eol := ~R.eot; EXIT END; - IF nextCh <= " " THEN MeasureSpecial(tw, dx, x, y, w, h) - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat) - END; - IF tw + x + w > width THEN d := len - bklen; - IF (d < AdjustSpan) & (nextCh > " ") THEN eol := TRUE; - Texts.OpenReader(R, F.text, Texts.Pos(R) - d); - nob := bknob; len := bklen; tw := bktw; minY := bkminY; maxY := bkmaxY - ELSIF len = 0 THEN (* force at least one character on each line *) - INC(len); INC(y, R.fnt.height * R.voff DIV 64); minY := Min(minY, y); maxY := Max(maxY, y + h); - Texts.Read(R, nextCh); eol := FALSE; tw := maxW - ELSE eol := (nextCh <= " ") & (nextCh # Texts.ElemChar) - END; - EXIT - END; - IF (nextCh <= " ") & (nextCh # Texts.ElemChar) THEN - bknob := nob; bklen := len; bktw := tw; bkminY := minY; bkmaxY := maxY; - IF nextCh = " " THEN INC(nob) END - END; - INC(len); INC(tw, dx); INC(y, R.fnt.height * R.voff DIV 64); - IF y < minY THEN minY := y END; - IF y + h > maxY THEN maxY := y + h END; - Texts.Read(R, nextCh) - END; - IF ~F.showsParcs & (pbeg = t.org) THEN dsr := 0; t.h := SHORT(P.lead DIV Unit) + 1 - ELSIF gridAdj IN P.opts THEN - WHILE dsr < -minY DO INC(dsr, lsp) END; - t.h := Max(lsp, dsr + maxY); INC(t.h, (-t.h) MOD lsp) - ELSE dsr := Max(dsr, -minY); t.h := Max(lsp, dsr + maxY) - END; - t.len := len; t.w0 := tw; t.w := Min(tw, maxW); t.dsr := dsr; t.nob := nob; t.eot := R.eot; t.P := P; t.pbeg := pbeg; - IF eol THEN Texts.Read(R, nextCh); t.span := len + 1 ELSE t.span := len END - END MeasureLine; - - PROCEDURE MeasureLines (F: Frame; org: LONGINT; VAR trailer: TextLine); - VAR s, t: TextLine; ph: INTEGER; - BEGIN - NEW(trailer); s := trailer; - Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh); ph := F.H - F.top; - LOOP NEW(t); t.org := org; MeasureLine(F, F.W - F.left - F.right, t); - IF ph - t.h < F.bot THEN EXIT END; - s.next := t; s := t; INC(org, s.span); DEC(ph, s.h); - IF R.eot THEN EXIT END - END; - s.next := trailer; trailer.eot := TRUE; trailer.org := org; (* start of first invisible line *) trailer.len := 0; trailer.w := 0; - trailer.h := SHORT(defParc.lsp DIV Unit); trailer.P := P (* P set by MeasureLine *) ; trailer.pbeg := pbeg - END MeasureLines; - -*) - (** Locators **) -(* - PROCEDURE LocateLineTop (F: Frame; trailer: TextLine; org: LONGINT; VAR loc: Location); - VAR t: TextLine; ph: INTEGER; - BEGIN - ph := F.H - F.top; t := trailer.next; - WHILE (t # trailer) & (t.org # org) DO DEC(ph, t.h); t := t.next END; - loc.org := org; loc.line := t; loc.y := F.Y + ph - END LocateLineTop; - - PROCEDURE Width (F: Frame; t: TextLine; pos: LONGINT; VAR pw, dx, dy: INTEGER); - VAR pat: Display.Pattern; i: LONGINT; n, mw, lm, tw, ddx, cn, x, y, w, h: INTEGER; - BEGIN - AdjustMetrics(F, t, pw, tw, ddx, cn); dy := 0; lm := F.left + SHORT(P.left DIV Unit); - IF t # F.trailer THEN Texts.OpenReader(R, F.text, t.org); Texts.Read(R, nextCh); - i := 0; n := 0; DEC(pos, t.org); dx := 0; mw := F.W - F.right; - WHILE ~R.eot & (i < t.len) & (i <= pos) & (pw + dx <= mw) DO - (* i ... pos of nextCh; dx ... width of char before nextCh; pw ... line width up to pos (or up to right margin) *) - INC(i); INC(pw, dx); - IF nextCh <= " " THEN GetSpecial(F, n, cn, ddx, pw - lm, dx, x, y, w, h) - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat) - END; - dy := R.fnt.height * R.voff DIV 64; - Texts.Read(R, nextCh) - END; - IF (i <= pos) & (pw + dx <= mw) THEN INC(i); INC(pw, dx) END - ELSE dx := 4 - END - END Width; - - - PROCEDURE LocatePos* (F: Frame; pos: LONGINT; VAR loc: Location); (* loc.dx = dx of char at pos *) - VAR t: TextLine; pw, dx, dy: INTEGER; - BEGIN - IF pos < F.org THEN pos := F.org; t := F.trailer.next - ELSIF pos < F.trailer.org THEN t := F.trailer; - WHILE (t.next # F.trailer) & (t.next.org <= pos) DO t := t.next END - ELSE pos := F.trailer.org; t := F.trailer.next; - WHILE ~t.eot DO t := t.next END - END; - Width(F, t, pos, pw, dx, dy); LocateLineTop(F, F.trailer, t.org, loc); DEC(loc.y, loc.line.h); - loc.org := t.org; loc.pos := pos; loc.x := F.X + pw; loc.dx := dx; loc.dy := dy; loc.line := t - END LocatePos; - - PROCEDURE LocateLine* (F: Frame; y: INTEGER; VAR loc: Location); - (* loc.x = line start; loc.y = line bottom; loc.dx = line width *) - VAR t: TextLine; h, ph, pw, tw, ddx, cn: INTEGER; - BEGIN - t := F.trailer.next; h := y - F.Y; ph := F.H - F.top - t.h; - WHILE ~t.eot & (ph - t.next.h >= F.bot) & (ph > h) DO t := t.next; DEC(ph, t.h) END; - AdjustMetrics(F, t, pw, tw, ddx, cn); - IF pw >= F.W - F.right THEN pw := F.W - F.right - 4 END; - loc.org := t.org; loc.pos := loc.org; loc.x := F.X + pw; loc.y := F.Y + ph; loc.dx := tw; loc.dy := 0; loc.line := t - END LocateLine; - - PROCEDURE LocateChar* (F: Frame; x, y: INTEGER; VAR loc: Location); - VAR t: TextLine; pat: Display.Pattern; i: LONGINT; n, w, lm, pw, tw, ddx, cn, dx, xc, yc, wc, hc: INTEGER; - BEGIN - LocateLine(F, y, loc); t := loc.line; w := x - F.X; AdjustMetrics(F, t, pw, tw, ddx, cn); - lm := F.left + SHORT(P.left DIV Unit); - IF (t # F.trailer) & (w > pw) THEN Texts.OpenReader(R, F.text, t.org); - i := 0; n := 0; dx := 0; nextCh := 0X; - WHILE (i < t.len) & (pw + dx < w) DO - (* i = pos after nextCh; dx = width of nextCh; pw = line width without nextCh *) - Texts.Read(R, nextCh); INC(i); INC(pw, dx); - IF nextCh <= " " THEN GetSpecial(F, n, cn, ddx, pw - lm, dx, xc, yc, wc, hc) - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, xc, yc, wc, hc, pat) - END - END; - IF pw + dx < w THEN INC(i); INC(pw, dx); R.elem := NIL END; - INC(loc.pos, i - 1); loc.x := F.X + pw; - IF i < t.len THEN loc.dx := dx; loc.dy := R.fnt.height * R.voff DIV 64 ELSE loc.dx := 4 END - ELSE loc.dx := 4; R.elem := NIL - END - END LocateChar; - - PROCEDURE LocateWord* (F: Frame; x, y: INTEGER; VAR loc: Location); - VAR t: TextLine; pos, i: LONGINT; px, rx: INTEGER; pat: Display.Pattern; dx, xc, yc, wc, hc: INTEGER; - BEGIN - LocateChar(F, x, y, loc); pos := loc.pos + 1; - REPEAT DEC(pos); Texts.OpenReader(R, F.text, pos); Texts.Read(R, nextCh) - UNTIL (pos < loc.org) OR (nextCh > " "); - INC(pos); - REPEAT DEC(pos); Texts.OpenReader(R, F.text, pos); Texts.Read(R, nextCh) - UNTIL (pos < loc.org) OR (nextCh <= " "); - LocatePos(F, pos + 1, loc); t := loc.line; i := loc.pos - loc.org; - IF i < t.len THEN px := loc.x; rx := F.X + F.W - F.right; - Texts.OpenReader(R, F.text, loc.pos); dx := 0; wc := 0; nextCh := "x"; - WHILE (i < t.len) & (nextCh > " ") & (px + dx < rx) DO - Texts.Read(R, nextCh); INC(i); INC(px, dx); - Display.GetChar(R.fnt.raster, nextCh, dx, xc, yc, wc, hc, pat) - END; - IF (nextCh > " ") & (px + dx < rx) THEN INC(i); INC(px, dx) END; - loc.dx := px - loc.x - ELSE loc.dx := 0 - END - END LocateWord; - - PROCEDURE Pos* (F: Frame; x, y: INTEGER): LONGINT; - VAR loc: Location; - BEGIN LocateChar(F, x, y, loc); RETURN loc.pos - END Pos; - - PROCEDURE ThisSubFrame (F: Frame; x, y: INTEGER): Display.Frame; - VAR f: Display.Frame; - BEGIN f := F.dsc; - WHILE (f # NIL) & ((x < f.X) OR (x >= f.X + f.W) OR (y < f.Y) OR (y >= f.Y + f.H)) DO f := f.next END; - RETURN f - END ThisSubFrame; - -*) - (** Caret & Selection **) -(* - PROCEDURE PassSubFocus (F: Frame; f: Display.Frame); - (* pass focus from F.focus to f (f is also an element frame in F) *) - VAR loc: Location; f1: Display.Frame; ctrl: Oberon.ControlMsg; focus: FocusMsg; - BEGIN - IF F.focus # NIL THEN f1 := F.focus; - ctrl.id := Oberon.defocus; f1.handle(f1, ctrl); - LocateChar(F, f1.X + 1, f1.Y + 1, loc); - InvertBorder(f1); F.focus := NIL; - focus.focus := FALSE; focus.elemFrame := f1; focus.frame := F; R.elem.handle(R.elem, focus) - END; - IF f # NIL THEN - LocateChar(F, f.X + 1, f.Y + 1, loc); (* side effect: set R to element *) - focus.focus := TRUE; focus.elemFrame := f; focus.frame := F; R.elem.handle(R.elem, focus); - InvertBorder(f) - END; - F.focus := f - END PassSubFocus; - - PROCEDURE RemoveSelection* (F: Frame); - BEGIN - IF F.hasSel THEN InvertSelection(F, F.selbeg, F.selend); F.hasSel := FALSE END - END RemoveSelection; - - PROCEDURE SetSelection* (F: Frame; beg, end: LONGINT); (** forces range to visible bounds **) - VAR loc: Location; - BEGIN - IF end > F.text.len THEN end := F.text.len END; - IF end > beg THEN - IF F.hasSel & (F.selbeg.pos = beg) THEN - IF (F.selend.pos < end) & (F.selend.pos < F.trailer.org) THEN - LocatePos(F, F.selend.pos, loc); LocatePos(F, end, F.selend); InvertSelection(F, loc, F.selend) - ELSIF end < F.selend.pos THEN - LocatePos(F, end, loc); InvertSelection(F, loc, F.selend); LocatePos(F, end, F.selend) - END - ELSE RemoveSelection(F); PassSubFocus(F, NIL); - LocatePos(F, beg, F.selbeg); LocatePos(F, end, F.selend); InvertSelection(F, F.selbeg, F.selend) - END; - F.hasSel := TRUE; F.time := Oberon.Time() - END - END SetSelection; - - - PROCEDURE RemoveCaret* (F: Frame); - VAR msg: Oberon.ControlMsg; - BEGIN - IF F.focus # NIL THEN msg.id := Oberon.defocus; F.focus.handle(F.focus, msg) END; - IF F.hasCar THEN InvertCaret(F); F.hasCar := FALSE END - END RemoveCaret; - - PROCEDURE SetCaret* (F: Frame; pos: LONGINT); (** only done if within visible bounds **) - BEGIN - IF ~F.hasCar OR (F.carloc.pos # pos) THEN RemoveCaret(F); PassSubFocus(F, NIL); - LocatePos(F, pos, F.carloc); - IF F.carloc.x <= F.X + F.W - F.right THEN InvertCaret(F); F.hasCar := TRUE END - END - END SetCaret; - - -*) - (** Display Range **) -(* - PROCEDURE Complete (F: Frame; trailer: TextLine; s: TextLine; org: LONGINT; ph: INTEGER); - VAR u: TextLine; - BEGIN - IF ph > F.bot THEN (*try to add new lines to the bottom*) - Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh); - LOOP - IF R.eot THEN EXIT END; - NEW(u); u.org := org; MeasureLine(F, F.W - F.left - F.right, u); - IF ph - u.h < F.bot THEN EXIT END; - s.next := u; s := s.next; DEC(ph, s.h); INC(org, s.span) - END - END; - s.next := trailer; trailer.eot := TRUE; trailer.org := org; trailer.len := 0; trailer.w := 0; - trailer.h := SHORT(defParc.lsp DIV Unit); trailer.P := P; trailer.pbeg := pbeg - END Complete; - - PROCEDURE ShowFrom (F: Frame; pos: LONGINT); (* removes global marks as needed and neutralizes F *) - VAR new, s: TextLine; beg, end: Location; org: LONGINT; ph, y0, dy: INTEGER; - BEGIN - F.handle(F, neutralize); - IF (F.trailer # NIL) & (F.org < pos) & (pos < F.trailer.org) THEN (* shift up and extend to the bottom *) - LocateLineTop(F, F.trailer, pos, beg); LocateLineTop(F, F.trailer, F.trailer.org, end); - dy := (F.Y + F.H - F.top) - beg.y; Shift(F, end.y, end.y + dy, beg.y - end.y); - Erase(F, F.X + F.left, end.y, F.W - F.left, dy); - s := F.trailer.next; WHILE s.org # pos DO s := s.next END; - F.trailer.next := s; org := s.org + s.span; ph := F.H - F.top - s.h; - WHILE s.next # F.trailer DO s := s.next; org := org + s.span; ph := ph - s.h END; - Complete(F, F.trailer, s, org, ph); F.org := pos; ShowLines(F, F.bot, end.y + dy - F.Y, FALSE) - ELSIF (F.trailer = NIL) OR (pos # F.org) THEN - MeasureLines(F, pos, new); - IF (F.trailer # NIL) & (pos < F.org) & (F.org <= new.org) THEN (* shift down and extend to the top *) - LocateLineTop(F, new, F.org, beg); LocateLineTop(F, new, new.org, end); - y0 := F.Y + F.H - F.top; Shift(F, y0 - (beg.y - end.y), end.y, beg.y - end.y); - Erase(F, F.X + F.left, beg.y, F.W - F.left, y0 - beg.y); - Erase(F, F.X + F.left, F.Y + F.bot, F.W - F.left, end.y - (F.Y + F.bot)); - F.org := pos; F.trailer := new; ShowLines(F, beg.y - F.Y, F.H - F.top, FALSE) - ELSE (* full redisplay *) - IF F.trailer = NIL THEN Erase(F, F.X, F.Y, F.W, F.H); ShowBar(F, 0, F.H); F.markH := -1 - ELSE Erase(F, F.X + F.left, F.Y + F.bot, F.W - F.left, F.H - F.bot - F.top) - END; - F.org := pos; F.trailer := new; ShowLines(F, F.bot, F.H - F.top, FALSE) - END - END; - ShowTick(F) - END ShowFrom; - - PROCEDURE Show* (F: Frame; pos: LONGINT); (** removes global marks as needed and neutralizes F **) - BEGIN BegOfLine(F.text, pos, TRUE); ShowFrom(F, pos) - END Show; - - - PROCEDURE Resize (F: Frame; x, y, w, h: INTEGER); - VAR oldY, oldH, dh, ph: INTEGER; t: TextLine; - BEGIN - IF (w = 0) OR (h = 0) THEN InvalSubFrames(F, F.X, F.Y, F.W, F.H); - F.X := x; F.Y := y; F.W := w; F.H := h; F.trailer := NIL - ELSIF (F.trailer # NIL) & (x = F.X) & (w = F.W) THEN - oldY := F.Y; oldH := F.H; Tick(F); F.markH := -1; F.Y := y; F.H := h; - IF h > oldH THEN dh := h - oldH; (* extend *) - IF y + h # oldY + oldH THEN - Display.CopyBlock(x, oldY, w, oldH, x, y + dh, Display.replace); - ShiftSubFrames(F, oldY, y + dh, oldH) - END; - EraseRect(F, x, y, w, dh); ShowBar(F, 0, dh); - t := F.trailer; ph := F.H - F.top; - WHILE t.next # F.trailer DO t := t.next; ph := ph - t.h END; - Complete(F, F.trailer, t, F.trailer.org, ph); ShowLines(F, F.bot, ph, FALSE) - ELSE dh := oldH - h; (* reduce *) - IF y + h # oldY + oldH THEN - Display.CopyBlock(x, oldY + dh, w, h, x, y, Display.replace); - ShiftSubFrames(F, oldY + dh, y, h) - END; - t := F.trailer; ph := F.H - F.top; - WHILE (t.next # F.trailer) & (ph - t.next.h >= F.bot) DO t := t.next; DEC(ph, t.h) END; - IF t = F.trailer THEN t.org := F.org; t.span := 0 END; - Complete(F, F.trailer, t, t.org + t.span, ph); - EraseRect(F, x + F.left, y, w - F.left, ph); - InvalSubFrames(F, x, oldY, w, y - oldY); InvalSubFrames(F, x, y + h, w, dh - (y - oldY)) - END; - ShowTick(F) - ELSE F.X := x; F.Y := y; F.W := w; F.H := h; F.trailer := NIL; Show(F, F.org) - END - END Resize; - -*) - (** Contents Update **) -(* - PROCEDURE Update (F: Frame; VAR msg: UpdateMsg); (** removes global marks as needed **) - VAR t: TextLine; org, d, Fbeg, Fend: LONGINT; - foc: Display.Frame; beg, end: LONGINT; ch: CHAR; r: Texts.Reader; loc: Location; - - PROCEDURE Begin (VAR beg: LONGINT; VAR org0: LONGINT; VAR q: TextLine); - (* org0 = origin of first affected line; beg = pos of first modified character; q = first affected line (if line origin has not moved).*) - (* q = NIL => beg = org0; q # NIL => first (beg-org0) characters of q need not be redrawn *) - VAR trailer, t: TextLine; - BEGIN - trailer := F.trailer; t := trailer; - WHILE (t.next # trailer) & (beg >= t.next.org + t.next.span) & ~t.next.eot DO t := t.next END; - q := t.next; - IF (t # trailer) & (q # trailer) & (beg <= q.org + q.span) THEN - Texts.OpenReader(R, F.text, t.org); Texts.Read(R, nextCh); org0 := t.org; NextLine(F.text, org0) - ELSE org0 := beg; BegOfLine(F.text, org0, TRUE) - END; - IF org0 # q.org THEN - IF t = trailer THEN org0 := q.org ELSE org0 := t.org END; - beg := org0; q := NIL - END - END Begin; - - PROCEDURE Adjust (end, delta: LONGINT); - (* H1 = top of synchronization line in old frame *) - (* h0 = top of line that was modified *) - (* h1 = top of block in new frame that could be reused *) - (* h2 = bottom of last line in new frame *) - (* h1 - h2 = height of block that could be reused *) - VAR new, old, s, t, u, p, q: TextLine; bot: Location; - org, org0, beg: LONGINT; ph, h0, h1, H1, h2, lm, dx, dy: INTEGER; - BEGIN - q := NIL; LocateLineTop(F, F.trailer, F.trailer.org, bot); - IF msg.beg < F.org THEN org0 := F.org; beg := org0 ELSE beg := msg.beg; Begin(beg, org0, q) END; - NEW(new); s := new; old := F.trailer; t := old; org := F.org; ph := F.H - F.top; - WHILE (t.next # old) & (t.next.org # org0) DO t := t.next; (*transfer unchanged prefix*) - s.next := t; s := t; DEC(ph, s.h); INC(org, s.span) - END; - h0 := ph; H1 := h0; t := t.next; p := s; - Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh); (*rebuild at least one line descriptor*) - LOOP NEW(u); u.org := org; MeasureLine(F, F.W - F.left - F.right, u); - IF ph - u.h < F.bot THEN h1 := ph; h2 := h1; EXIT END; - s.next := u; s := s.next; DEC(ph, s.h); INC(org, s.span); - IF R.eot THEN h1 := ph; h2 := h1; EXIT END; - IF org > end THEN - WHILE (t # old) & (org > t.org + delta) DO DEC(H1, t.h); t := t.next END; - IF (org = t.org + delta) & (P = t.P) THEN h1 := ph; (*resynchronized*) - WHILE (t # old) & (ph - t.h >= F.bot) DO (*transfer unchanged suffix*) - s.next := t; s := t; s.org := org; ParcBefore(F.text, s.org, s.P, s.pbeg); - DEC(ph, s.h); INC(org, s.span); t := t.next - END; - h2 := ph; EXIT - END - END - END; - Shift(F, F.Y + H1 - (h1 - h2), F.Y + h2, h1 - h2); - Complete(F, new, s, org, ph); F.trailer := new; t := p.next; - IF (q # NIL) & (t # F.trailer) & (q.h = t.h) & (q.dsr = t.dsr) & (q.org = t.org) & (q.P = t.P) & (end <= t.org + t.span) THEN - P := t.P; pbeg := t.pbeg; - IF (P.opts * AdjMask = {leftAdj}) OR (P.opts * AdjMask = AdjMask) & (q.nob = 0) & (t.nob = 0) THEN - Width(F, t, beg, lm, dx, dy); (*preserve prefix of first affected line*) - DEC(h0, t.h); Erase(F, F.X + lm, F.Y + h0, F.W - lm, t.h); - ShowLine(F, t, F.X + lm, F.X + F.W - F.right, F.Y + h0) - END - END; - ShowLines(F, h1, h0, TRUE); - Erase(F, F.X + F.left, bot.y, F.W - F.left, h2 - (bot.y - F.Y)); ShowLines(F, F.bot, h2, FALSE) - END Adjust; - - BEGIN - foc := F.focus; beg := msg.beg; end := msg.end; - F.handle(F, neutralize); MarkMenu(F); Fbeg := F.org; Fend := F.trailer.org; - IF (msg.id = Texts.insert) & (msg.beg < F.org) THEN t := F.trailer; d := msg.end - msg.beg; INC(F.org, d); - REPEAT INC(t.org, d); t := t.next UNTIL t = F.trailer - ELSIF msg.id = Texts.delete THEN - IF msg.end <= F.org THEN t := F.trailer; d := msg.end - msg.beg; DEC(F.org, d); - REPEAT DEC(t.org, d); t := t.next UNTIL t = F.trailer - ELSIF msg.beg < F.org THEN F.org := msg.beg - END - END; - org := F.org; - IF msg.beg <= Fbeg + AdjustSpan THEN BegOfLine(F.text, org, TRUE) END; - ParcBefore(F.text, org, P, d); - IF (org # F.org) OR (P # F.trailer.next.P) THEN - F.trailer := NIL; Show(F, F.org) - ELSIF (msg.end > Fbeg) & (msg.beg < Fend + AdjustSpan) THEN - IF msg.id = Texts.replace THEN Adjust(msg.end, 0); - (* refocus element if necessary *) - IF (foc # NIL) & (end-beg = 1) THEN - Texts.OpenReader(r, F.text, beg); Texts.Read(r, ch); - IF r.elem # NIL THEN - LocatePos(F, beg, loc); foc := ThisSubFrame(F, loc.x, loc.y); PassSubFocus(F, foc); - END - END - ELSIF msg.id = Texts.insert THEN Adjust(msg.end, msg.end - msg.beg) - ELSIF msg.id = Texts.delete THEN Adjust(msg.beg, msg.beg - msg.end) - END - END; - ShowTick(F) - END Update; - -*) - (** User Interface **) -(* - PROCEDURE Back (F: Frame; dY: INTEGER; (*inout*) VAR org: LONGINT); (* mh 10.10.92 *) - (* computes new org such that old org is (at most) dY pixels below new org *) - VAR H: INTEGER; oldOrg: LONGINT; - - PROCEDURE TotalHeight (org1, org2: LONGINT): INTEGER; - (* measures total height of text-lines starting at org1 and ending at the line before the line containing org2 *) - VAR h: INTEGER; line: TextLine; - BEGIN - Texts.OpenReader(R, F.text, org1); Texts.Read(R, nextCh); NEW(line); h := 0; - LOOP line.org := org1; - MeasureLine(F, F.W - F.left - F.right, line); INC(org1, line.span); - IF Texts.Pos(R)-1 > org2 THEN EXIT END; - INC(h, line.h); - IF R.eot THEN EXIT END; - END; - RETURN h - END TotalHeight; - - PROCEDURE Forward (h: INTEGER); - (* increase org by n text-lines such that the sum of the n line-heights > h *) - VAR line: TextLine; - BEGIN - Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh); NEW(line); - WHILE h > 0 DO line.org := org; - MeasureLine(F, F.W - F.left - F.right, line); INC(org, line.span); DEC(h, line.h); - END; - org := Texts.Pos(R)-1; - END Forward; - - BEGIN H := 0; - LOOP oldOrg := org; - IF org = 0 THEN EXIT END; - DEC(org, 800); BegOfLine(F.text, org, FALSE); - INC(H, TotalHeight(org, oldOrg)); - IF H > dY THEN EXIT END; - END; - Forward(H - dY); - END Back; - - PROCEDURE TrackLine* (F: Frame; VAR x, y: INTEGER; VAR org: LONGINT; VAR keysum: SET); - VAR keys: SET; new, old: Location; - BEGIN - LocateLine(F, y, old); InvertRect(F, old.x, old.y, old.dx + 4, 2); keysum := {}; - REPEAT TrackMouse(x, y, keys, keysum); LocateLine(F, y, new); - IF new.org # old.org THEN - InvertRect(F, new.x, new.y, new.dx + 4, 2); InvertRect(F, old.x, old.y, old.dx + 4, 2); old := new - END - UNTIL keys = {}; - InvertRect(F, new.x, new.y, new.dx + 4, 2); org := new.org - END TrackLine; - - PROCEDURE TrackWord* (F: Frame; VAR x, y: INTEGER; VAR pos: LONGINT; VAR keysum: SET); - VAR keys: SET; new, old: Location; - BEGIN - LocateWord(F, x, y, old); InvertRect(F, old.x, old.y, old.dx, 2); keysum := {}; - REPEAT TrackMouse(x, y, keys, keysum); LocateWord(F, x, y, new); - IF new.pos # old.pos THEN - InvertRect(F, new.x, new.y, new.dx, 2); InvertRect(F, old.x, old.y, old.dx, 2); old := new - END - UNTIL keys = {}; - InvertRect(F, new.x, new.y, new.dx, 2); pos := new.pos - END TrackWord; - - PROCEDURE TrackCaret* (F: Frame; VAR x, y: INTEGER; VAR keysum: SET); - VAR keys: SET; - BEGIN keysum := {}; - REPEAT TrackMouse(x, y, keys, keysum); SetCaret(F, Pos(F, x, y)) UNTIL keys = {} - END TrackCaret; - - PROCEDURE TrackSelection* (F: Frame; VAR x, y: INTEGER; VAR keysum: SET); - VAR keys: SET; pos: LONGINT; V: Viewers.Viewer; f: Frame; - BEGIN - V := Viewers.This(F.X, F.Y); V := V.next(Viewers.Viewer); - IF (V.dsc # NIL) & (V.dsc.next # NIL) & (V.dsc.next IS Frame) THEN f := V.dsc.next(Frame); - IF f.hasSel & (f.text = F.text) THEN - IF (f.selbeg.pos < f.trailer.org) & (f.org < f.selend.pos) & (f.selbeg.pos <= Pos(F, x, y)) THEN - SetSelection(F, f.selbeg.pos, Pos(F, x, y) + 1) - ELSE RemoveSelection(f); f := NIL - END - ELSE f := NIL - END - ELSE f := NIL - END; - IF f = NIL THEN - IF F.hasSel & (F.selbeg.pos + 1 = F.selend.pos) & (Pos(F, x, y) = F.selbeg.pos) THEN - SetSelection(F, F.selbeg.org, Pos(F, x, y) + 1) - ELSE SetSelection(F, Pos(F, x, y), Pos(F, x, y) + 1) - END - END; - keysum := {}; - REPEAT TrackMouse(x, y, keys, keysum); - IF F.hasSel THEN - pos := Pos(F, x, Min(y, F.selbeg.y)) + 1; - IF pos <= F.selbeg.pos THEN pos := F.selbeg.pos + 1 END; - SetSelection(F, F.selbeg.pos, pos); - IF f # NIL THEN SetSelection(f, f.selbeg.pos, pos); f.selend.pos := F.selend.pos END - ELSE SetSelection(F, Pos(F, x, y), Pos(F, x, y) + 1) - END - UNTIL keys = {}; - IF f # NIL THEN F.selbeg.pos := f.selbeg.pos END - END TrackSelection; - - PROCEDURE Call (F: Frame; pos: LONGINT; keysum: SET); - VAR S: Texts.Scanner; res, i, j: INTEGER; - BEGIN - Texts.OpenScanner(S, F.text, pos); Texts.Scan(S); - IF (S.class = Texts.Name) & (S.line = 0) THEN i := 0; - WHILE (i < S.len) & (S.s[i] # ".") DO INC(i) END; - j := i + 1; - WHILE (j < S.len) & (S.s[j] # ".") DO INC(j) END; - IF (j >= S.len) & (S.s[i] = ".") OR (rightKey IN keysum) THEN - par.vwr := Viewers.This(F.X, F.Y); - IF rightKey IN keysum THEN S.s:="Edit.Open"; par.pos := pos ELSE par.pos := pos + S.len END; - par.frame := F; par.text := F.text; Oberon.Call(S.s, par, keysum = {middleKey, leftKey}, res); - IF res > 0 THEN - Texts.WriteString(W0, "Call error: "); Texts.WriteString(W0, Modules.importing); - IF res = 1 THEN - Texts.WriteString(W0, " not found") - ELSIF res = 2 THEN - Texts.WriteString(W0, " not an obj-file") - ELSIF res = 3 THEN - Texts.WriteString(W0, " imports "); - Texts.WriteString(W0, Modules.imported); Texts.WriteString(W0, " with bad key"); - ELSIF res = 4 THEN - Texts.WriteString(W0, " corrupted obj file") - ELSIF res = 6 THEN - Texts.WriteString(W0, " has too many imports") - ELSIF res = 7 THEN - Texts.WriteString(W0, " not enough space") - END - ELSIF res < 0 THEN - INC(i); WHILE i < S.len DO Texts.Write(W0, S.s[i]); INC(i) END; - Texts.WriteString(W0, " not found") - END; - IF res # 0 THEN Texts.WriteLn(W0); Texts.Append(Oberon.Log, W0.buf) END - END - END - END Call; - - PROCEDURE PickAttributes (VAR W: Texts.Writer; T: Texts.Text; pos: LONGINT; font: Fonts.Font; col, voff: SHORTINT); - VAR R: Texts.Reader; ch: CHAR; - BEGIN - IF T.len > 0 THEN - IF pos < T.len THEN Texts.OpenReader(R, T, pos); Texts.Read(R, ch) END; - IF (pos > 0) & ((pos = T.len) OR (ch <= " ")) THEN - Texts.OpenReader(R, T, pos - 1); Texts.Read(R, ch) - END; - Texts.SetFont(W, R.fnt); Texts.SetColor(W, R.col); - IF (ch = CR) OR (ch = TAB) OR (ch = LF) THEN Texts.SetOffset(W, voff) ELSE Texts.SetOffset(W, R.voff) END - ELSE Texts.SetFont(W, font); Texts.SetColor(W, col); Texts.SetOffset(W, voff) - END - END PickAttributes; - - PROCEDURE ShiftBlock (F: Frame; delta: INTEGER); (* shift selected lines to left or right *) - VAR text: Texts.Text; pos, beg, end, time: LONGINT; select: SelectMsg; ch: CHAR; - BEGIN - Oberon.GetSelection(text, beg, end, time); - IF (time >= 0) & (text = F.text) THEN BegOfLine(F.text, beg, FALSE); pos := beg; - WHILE pos < end DO Texts.OpenReader(R, F.text, pos); Texts.Read(R, ch); - WHILE (R.elem # NIL) & (R.elem IS Parc) & (pos < end) DO Texts.Read(R, ch); INC(pos) END; - IF pos < end THEN - IF delta < 0 THEN - IF (ch <= " ") & (ch # CR) & (ch # Texts.ElemChar) THEN - Texts.Delete(F.text, pos, pos + 1); DEC(end) - END - ELSE - PickAttributes(W, text, pos, Oberon.CurFnt, Oberon.CurCol, Oberon.CurOff); - IF (ch <= " ") & (ch # CR) & (ch # Texts.ElemChar) THEN Texts.Write(W, ch) (* first char extension *) - ELSE Texts.Write(W, TAB) - END; - Texts.Insert(F.text, pos, W.buf); INC(end); INC(pos) - END; - Texts.OpenReader(R, F.text, pos); - REPEAT Texts.Read(R, ch) UNTIL R.eot OR (ch = CR); - pos := Texts.Pos(R) - END - END; - select.text := F.text; select.beg := beg; select.end := pos; select.time := Oberon.Time(); - Viewers.Broadcast(select) - END - END ShiftBlock; - - PROCEDURE Write (F: Frame; ch: CHAR; fnt: Fonts.Font; col, voff: SHORTINT); - VAR loc: Location; parc: Parc; org, pos, pbeg: LONGINT; i: INTEGER; ch0: CHAR; - buf: ARRAY 32 OF CHAR; - copy: Texts.CopyMsg; input: Oberon.InputMsg; - - PROCEDURE Visible(ch: CHAR): BOOLEAN; - VAR pat: Display.Pattern; dx, x, y, w, h: INTEGER; - BEGIN Display.GetChar(W.fnt.raster, ch, dx, x, y, w, h, pat); RETURN dx > 0 - END Visible; - - PROCEDURE InsertBuffer; - VAR i, j: INTEGER; ch: CHAR; - BEGIN i := 0; j := 0; ch := buf[i]; - WHILE ch # 0X DO - IF (ch = TAB) OR (ch = CR) OR (ch = " ") OR Visible(ch) THEN Texts.Write(W, ch); INC(j) END; - INC(i); ch := buf[i] - END; - IF j > 0 THEN Texts.Insert(F.text, pos, W.buf); INC(pos, LONG(j)) END - END InsertBuffer; - - PROCEDURE Flush; - VAR ch: CHAR; - BEGIN - WHILE Input.Available() > 0 DO Input.Read(ch) END - END Flush; - - BEGIN - IF F.hasSel & (ch = CRSL) THEN ShiftBlock(F, -1) - ELSIF F.hasSel & (ch = CRSR) THEN ShiftBlock(F, 1) - ELSIF F.hasCar THEN pos := F.carloc.pos; - IF (ch = DEL) & (pos > F.org) THEN DEC(pos); Texts.Delete(F.text, pos, pos + 1); Flush - ELSIF (ch = CRSL) & (pos > 0) THEN DEC(pos) - ELSIF (ch = CRSR) & (pos < F.text.len) THEN INC(pos) - ELSIF (ch = BRK) OR (ch = ShiftBRK) THEN - ParcBefore(F.text, pos, P, pbeg); P.handle(P, copy); parc := copy.e(Parc); - IF ch = BRK THEN EXCL(parc.opts, pageBreak) ELSE INCL(parc.opts, pageBreak) END; - PickAttributes(W, F.text, pos, fnt, col, voff); - Texts.WriteElem(W, parc); Texts.Insert(F.text, pos, W.buf); INC(pos) - ELSIF (ch = TAB) OR (ch = LF) OR (ch = CR) OR (ch >= " ") THEN - PickAttributes(W, F.text, pos, fnt, col, voff); - IF ch = LF THEN buf[0] := CR; i := 1; org := F.carloc.org; BegOfLine(F.text, org, FALSE); - Texts.OpenReader(R, F.text, org); - REPEAT Texts.Read(R, ch) UNTIL (R.elem = NIL) OR ~(R.elem IS Parc); - WHILE (Texts.Pos(R) <= pos) & (ch <= " ") & (ch # Texts.ElemChar) & (i < 31) DO - buf[i] := ch; INC(i); Texts.Read(R, ch) - END - ELSE buf[0] := ch; i := 1 - END; - WHILE (Input.Available() > 0) & (i < 31) & (ch >= " ") & (ch < DEL) DO Input.Read(buf[i]); INC(i) END; - buf[i] := 0X; InsertBuffer - END; - IF pos < F.org THEN Show(F, F.org - 1) - ELSIF pos < F.text.len THEN org := -1; - WHILE (pos >= F.trailer.org) & (pos > F.org) DO - org := F.trailer.next.next.org; IF org = F.org THEN INC(org) END; - ShowFrom(F, org); Flush - END - ELSE LocatePos(F, pos, loc); LocateChar(F, loc.x + 1, loc.y, loc); - IF pos # loc.pos THEN Show(F, F.trailer.next.next.org); Flush END - END; - SetCaret(F, pos) - ELSIF F.focus # NIL THEN input.id := Oberon.consume; input.ch := ch; - input.fnt := fnt; input.col := col; input.voff := voff; F.focus.handle(F.focus, input) - END - END Write; - - - PROCEDURE TouchElem (F: Frame; VAR x, y: INTEGER; VAR keysum: SET); - VAR loc: Location; e: Texts.Elem; pbeg: LONGINT; y0: INTEGER; - track: TrackMsg; - BEGIN - LocateChar(F, x, y, loc); e := R.elem; - IF (e # NIL) & (loc.x + e.W DIV Unit <= F.X + F.W - F.right) THEN - ParcBefore(F.text, loc.pos, P, pbeg); y0 := loc.y + loc.line.dsr - SHORT(P.dsr DIV Unit) + loc.dy; - IF (loc.x <= x) & (x < loc.x + e.W DIV Unit) & (keysum= {middleKey}) THEN - track.X := x; track.Y := y; track.keys := keysum; - track.fnt := R.fnt; track.col := R.col; track.pos := Texts.Pos(R) - 1; - track.frame := F; track.X0 := loc.x; track.Y0 := y0; - e.handle(e, track); keysum := {} - END - END - END TouchElem; - - - PROCEDURE Edit (F: Frame; x, y: INTEGER; keysum: SET); - VAR ef: Display.Frame; text: Texts.Text; beg, end, time, pos: LONGINT; keys: SET; ch: CHAR; - loc: Location; delta: INTEGER; copyover: Oberon.CopyOverMsg; input: Oberon.InputMsg; - BEGIN - IF x < F.X + F.barW THEN pos := F.org; (* scroll bar *) - IF leftKey IN keysum THEN TrackLine(F, x, y, pos, keysum) - ELSIF rightKey IN keysum THEN TrackLine(F, x, y, pos, keysum); LocateLine(F, y, loc); - pos := F.org; delta := loc.y - (F.Y + F.bot); Back(F, delta, pos) - ELSIF middleKey IN keysum THEN - REPEAT TrackMouse(x, y, keys, keysum) UNTIL keys = {}; - IF keysum = {middleKey, leftKey} THEN pos := F.text.len; (*BegOfLine(F.text, pos, TRUE);*) - Back(F, F.H - F.bot - F.top - 30 (*heuristic*), pos); - ELSIF keysum = {middleKey, rightKey} THEN pos := 0 - ELSIF (F.Y <= y) & (y <= F.Y + F.H) THEN pos := CoordToPos(F, y - F.Y); BegOfLine(F.text, pos, TRUE) - END - ELSE DrawCursor(x, y); keysum := cancel - END; - IF keysum # cancel THEN ShowFrom(F, pos) END - ELSE (* text area *) - ef := ThisSubFrame(F, x, y); - IF ef # NIL THEN (* within sub-frame *) - IF (F.focus # ef) & (keysum = {leftKey}) THEN - REPEAT TrackMouse(x, y, keys, keysum) UNTIL keys = {}; - IF keysum = {leftKey} THEN RemoveSelection(F); RemoveCaret(F); PassSubFocus(F, ef); RETURN END - ELSIF F.focus = ef THEN input.id := Oberon.track; input.keys := keysum; input.X := x; input.Y := y; - ef.handle(ef, input); RETURN - END - END; - IF keysum # {} THEN TouchElem(F, x, y, keysum); - IF keysum = {} THEN RETURN END - END; - IF leftKey IN keysum THEN Oberon.PassFocus(Viewers.This(F.X, F.Y)); TrackCaret(F, x, y, keysum); - IF (keysum = {leftKey, middleKey}) & F.hasCar THEN Oberon.GetSelection(text, beg, end, time); - IF time >= 0 THEN Texts.Save(text, beg, end, B); - Texts.Insert(F.text, F.carloc.pos, B); SetCaret(F, F.carloc.pos + (end - beg)) - END - ELSIF (keysum = {leftKey, rightKey}) & F.hasCar & (F.carloc.pos < F.text.len) THEN - Oberon.GetSelection(text, beg, end, time); - IF time >= 0 THEN Texts.OpenReader(R, F.text, F.carloc.pos); Texts.Read(R, ch); - Texts.ChangeLooks(text, beg, end, {0, 1, 2}, R.fnt, R.col, R.voff) - END - END - ELSIF middleKey IN keysum THEN TrackWord(F, x, y, pos, keysum); - IF keysum # cancel THEN Call(F, pos, keysum) END - ELSIF rightKey IN keysum THEN TrackSelection(F, x, y, keysum); - IF (keysum = {rightKey, middleKey}) & F.hasSel THEN - copyover.text := F.text; copyover.beg := F.selbeg.pos; copyover.end := F.selend.pos; - Oberon.FocusViewer.handle(Oberon.FocusViewer, copyover) - ELSIF (keysum = {rightKey, leftKey}) & F.hasSel THEN Oberon.PassFocus(Viewers.This(F.X, F.Y)); - Texts.Delete(F.text, F.selbeg.pos, F.selend.pos); SetCaret(F, F.selbeg.pos) - END - ELSE DrawCursor(x, y) - END - END - END Edit; - -*) - (** General **) - - - PROCEDURE Copy (SF, DF: Frame); - BEGIN - DF.handle := SF.handle; DF.text := SF.text; DF.org := SF.org; - DF.col := SF.col; DF.left := SF.left; DF.right := SF.right; DF.top := SF.top; DF.bot := SF.bot; - DF.barW := SF.barW; DF.hasCar := FALSE; DF.hasSel := FALSE; DF.showsParcs := SF.showsParcs; - DF.focus := NIL; DF.trailer := NIL - END Copy; -(* - PROCEDURE Handle* (f: Display.Frame; VAR msg: Display.FrameMsg); - VAR F, F1: Frame; pos: LONGINT; - BEGIN F := f(Frame); - IF msg IS Oberon.InputMsg THEN - WITH msg: Oberon.InputMsg DO - IF msg.id = Oberon.consume THEN Write(F, msg.ch, msg.fnt, msg.col, msg.voff) - ELSIF msg.id = Oberon.track THEN Edit(F, msg.X, msg.Y, msg.keys) - END - END - ELSIF msg IS Oberon.ControlMsg THEN - WITH msg: Oberon.ControlMsg DO - IF msg.id = Oberon.defocus THEN RemoveCaret(F) - ELSIF msg.id = Oberon.neutralize THEN - RemoveCaret(F); RemoveSelection(F); PassSubFocus(F, NIL); NotifySubFrames(F, msg) - ELSE NotifySubFrames(F, msg) - END - END - ELSIF msg IS Oberon.CopyMsg THEN - WITH msg: Oberon.CopyMsg DO - IF msg.F = NIL THEN NEW(F1); msg.F := F1 END; - Copy(F, msg.F(Frame)) - END - ELSIF msg IS UpdateMsg THEN NotifySubFrames(F, msg); - WITH msg: UpdateMsg DO - IF msg.text = F.text THEN Update(F, msg) END - END - ELSIF msg IS InsertElemMsg THEN - IF F.hasCar THEN pos := F.carloc.pos; - PickAttributes(W, F.text, pos, Oberon.CurFnt, Oberon.CurCol, Oberon.CurOff); - Texts.WriteElem(W, msg(InsertElemMsg).e); - Texts.Insert(F.text, pos, W.buf); - SetCaret(F, pos + 1) - END - ELSIF msg IS Oberon.SelectionMsg THEN NotifySubFrames(F, msg); - WITH msg: Oberon.SelectionMsg DO - IF F.hasSel & (F.time > msg.time) THEN - msg.text := F.text; msg.beg := F.selbeg.pos; msg.end := F.selend.pos; msg.time := F.time - END - END - ELSIF msg IS Oberon.CopyOverMsg THEN NotifySubFrames(F, msg); - WITH msg: Oberon.CopyOverMsg DO - IF F.hasCar THEN Texts.Save(msg.text, msg.beg, msg.end, B); - Texts.Insert(F.text, F.carloc.pos, B); SetCaret(F, F.carloc.pos + (msg.end - msg.beg)) - END - END - ELSIF msg IS MenuViewers.ModifyMsg THEN - WITH msg: MenuViewers.ModifyMsg DO - F.handle(F, neutralize); Resize(F, F.X, msg.Y, F.W, msg.H) - END - ELSIF msg IS SelectMsg THEN NotifySubFrames(F, msg); - WITH msg: SelectMsg DO - IF (msg.text = F.text) & ~F.hasSel THEN Oberon.RemoveMarks(F.X, F.Y, F.W, F.H); - F.handle(F, neutralize); - SetSelection(F, msg.beg, msg.end); F.time := msg.time; - IF F.hasSel THEN F.selbeg.pos := msg.beg; F.selend.pos := msg.end END - END - END - ELSE NotifySubFrames(F, msg) - END - END Handle; - -*) - PROCEDURE Open* (F: Frame; T: Texts.Text; pos: LONGINT); - BEGIN - F.handle := Handle; F.text := T; F.org := pos; F.col := Display.black; - F.left := left; F.right := right; F.top := top; F.bot := bot; - F.barW := barW; F.hasCar := FALSE; F.hasSel := FALSE; F.showsParcs := FALSE; F.trailer := NIL - END Open; - -(* - PROCEDURE NotifyDisplay* (T: Texts.Text; op: INTEGER; beg, end: LONGINT); - VAR msg: UpdateMsg; - BEGIN - msg.text := T; msg.id := op; msg.beg := beg; msg.end := end; Viewers.Broadcast(msg) - END NotifyDisplay; - - PROCEDURE Text* (name: ARRAY OF CHAR): Texts.Text; - VAR text: Texts.Text; - BEGIN - NEW(text); Texts.Open(text, name); text.notify := NotifyDisplay; RETURN text - END Text; -*) - PROCEDURE NewText* (T: Texts.Text; pos: LONGINT): Frame; - VAR frame: Frame; - BEGIN - NEW(frame); Open(frame, T, pos); - RETURN frame - END NewText; -(* - PROCEDURE NewMenu* (name, commands: ARRAY OF CHAR): Frame; - VAR T: Texts.Text; frame: Frame; - BEGIN - T := Text(""); - Texts.WriteString(W0, name); Texts.WriteString(W0, " | "); Texts.WriteString(W0, commands); - Texts.Append(T, W0.buf); - NEW(frame); Open(frame, T, 0); - frame.col := Display.white; frame.left := 6; frame.top := 0; frame.bot := 0; frame.barW := 0; - RETURN frame - END NewMenu; -*) -BEGIN - Texts.OpenWriter(W); Texts.OpenWriter(W0); - Texts.SetFont(W0, Fonts.Default); Texts.SetColor(W0, Display.white); Texts.SetOffset(W0, 0); - neutralize.id := Oberon.neutralize; - NEW(par); - NEW(B); Texts.OpenBuf(B); - menuH := Fonts.Default.height + 2; - barW := 14; left := barW + 6; right := 8; top := 6; bot := 6; - Oberon.Log := Text(""); - InitDefParc -END TextFrames. diff --git a/src/tools/coco/v4_compat/TextFrames.Mod_orig b/src/tools/coco/v4_compat/TextFrames.Mod_orig deleted file mode 100644 index 421cb30f..00000000 --- a/src/tools/coco/v4_compat/TextFrames.Mod_orig +++ /dev/null @@ -1,1362 +0,0 @@ -MODULE TextFrames; (** CAS/MH/HM 20.4.94/JT 1.5.95 **) - IMPORT SYSTEM, Modules, Input, Display, Fonts, Viewers, Oberon, MenuViewers, Texts; - - CONST - (** update message IDs **) - replace* = 0; insert* = 1; delete* = 2; - (** units **) - mm* = 36000; Unit* = 10000; - (** parc options **) - gridAdj* = 0; leftAdj* = 1; rightAdj* = 2; pageBreak* = 3; twoColumns* = 4; - (** maximum number of TAB stops in Parc **) - MaxTabs* = 32; - - AdjMask = {leftAdj, rightAdj}; - TAB = 9X; LF = 0AX; CR = 0DX; DEL = 7FX; BRK = 0ACX; ShiftBRK = 0ADX; CRSL = 0C4X; CRSR = 0C3X; - AdjustSpan = 30; MinTabWidth = 1 * mm; StdTabWidth = 4 * mm; - rightKey = 0; middleKey = 1; leftKey = 2; cancel = {rightKey, middleKey, leftKey}; - - - TYPE - Parc* = POINTER TO ParcDesc; - ParcDesc* = RECORD (Texts.ElemDesc) - left*: LONGINT; (** distance from (F.X + F.left); in units **) - first*: LONGINT; (** first line indentation from P.left; in units **) - width*: LONGINT; (** parc width; in units **) - lead*: LONGINT; (** distance to previous line; in units **) - lsp*: LONGINT; (** line spacing of text after P; in units **) - dsr*: LONGINT; (** descender of text after P; in units **) - opts*: SET; - nofTabs*: INTEGER; - tab*: ARRAY MaxTabs OF LONGINT (** in units **) - END; - - TextLine = POINTER TO TextLineDesc; - Location* = RECORD - org*, pos*: LONGINT; - x*, y*, dx*, dy*: INTEGER; - line: TextLine - END; - TextLineDesc = RECORD - next: TextLine; - eot: BOOLEAN; (* contains end of text *) - indent: LONGINT; (* line indentation in units *) - w, h, dsr: INTEGER; (* bounding box clipped to frame (w including indent) *) - w0, nob: INTEGER; (* unclipped width (including indent), number of contained blanks: nob > 0 if text line wraps around *) - org, len, span: LONGINT; (* len ... characters w/o; span ... w/ trailing CR or white space, if any *) - P: Parc; (* last parc before this text line *) - pbeg: LONGINT (* position of P *) - END; - - Frame* = POINTER TO FrameDesc; - FrameDesc* = RECORD (Display.FrameDesc) - text*: Texts.Text; - org*: LONGINT; - col*, left*, right*, top*, bot*: INTEGER; - markH*: INTEGER; (** position of tick mark in scroll bar (< 0 => no tick mark) **) - barW*: INTEGER; (** scroll bar width **) - time*: LONGINT; (** selection time **) - hasCar*, hasSel*, showsParcs*: BOOLEAN; (** caret/selection present; parcs visible **) - carloc*, selbeg*, selend*: Location; - focus*: Display.Frame; (** frame of nested element if this element contains the focus **) - trailer: TextLine (* ring with trailer and header *) - END; - - DisplayMsg* = RECORD (Texts.ElemMsg) - prepare*: BOOLEAN; - fnt*: Fonts.Font; - col*: SHORTINT; - pos*: LONGINT; (** position in host text **) - frame*: Display.Frame; (** ~prepare => host frame **) - X0*, Y0*: INTEGER; (** ~prepare => receiver origin in screen space **) - indent*: LONGINT; (** prepare => width already consumed in line, in units **) - elemFrame*: Display.Frame (** optional return parameter **) - END; - - TrackMsg* = RECORD (Texts.ElemMsg) - X*, Y*: INTEGER; - keys*: SET; - fnt*: Fonts.Font; - col*: SHORTINT; - pos*: LONGINT; (** position in host text **) - frame*: Display.Frame; (** host frame **) - X0*, Y0*: INTEGER (** receiver origin in screen space **) - END; - - FocusMsg* = RECORD (Texts.ElemMsg) - focus*: BOOLEAN; (** whether to focus or to defocus **) - elemFrame*: Display.Frame; (** focus/defocus target **) - frame*: Display.Frame (** host frame **) - END; - - NotifyMsg* = RECORD (Display.FrameMsg) - frame*: Display.Frame (** host frame **) - END; - - UpdateMsg* = RECORD (Display.FrameMsg) - id*: INTEGER; - text*: Texts.Text; - beg*, end*: LONGINT - END; - - InsertElemMsg* = RECORD (Display.FrameMsg) - e*: Texts.Elem - END; - - SelectMsg = RECORD (Display.FrameMsg) - text: Texts.Text; - beg, end: LONGINT; - time: LONGINT - END; - - - VAR - menuH*, barW*, left*, right*, top*, bot*: INTEGER; - defParc*: Parc; - - (*shared globals => get rid off in a later version?*) - W, W0: Texts.Writer; - B: Texts.Buffer; - - P: Parc; - pbeg: LONGINT; (*inv T[pbeg] = P*) - R: Texts.Reader; - nextCh: CHAR; (*inv Base(R) = T => T[Pos(R)-1] = nextCh]*) - par: Oberon.ParList; - neutralize: Oberon.ControlMsg; - - - PROCEDURE Min (x, y: INTEGER): INTEGER; - BEGIN IF x < y THEN RETURN x ELSE RETURN y END - END Min; - - PROCEDURE Max (x, y: INTEGER): INTEGER; - BEGIN IF x > y THEN RETURN x ELSE RETURN y END - END Max; - - PROCEDURE MarkMenu (F: Frame); - VAR R: Texts.Reader; V: Viewers.Viewer; T: Texts.Text; ch: CHAR; - BEGIN V := Viewers.This(F.X, F.Y); - IF (V IS MenuViewers.Viewer) & (V.dsc IS Frame) & (F # V.dsc) THEN - T := V.dsc(Frame).text; - IF T.len > 0 THEN Texts.OpenReader(R, T, T.len - 1); Texts.Read(R, ch) ELSE ch := 0X END; - IF ch # "!" THEN Texts.Write(W0, "!"); Texts.Append(T, W0.buf) END - END - END MarkMenu; - - - (* Element Subframes *) - - PROCEDURE InvertBorder (F: Display.Frame); - BEGIN - Display.ReplPattern(Display.white, Display.grey1, F.X-1, F.Y-1, F.W+2, 1, Display.invert); - Display.ReplPattern(Display.white, Display.grey1, F.X-1, F.Y+F.H, F.W+2, 1, Display.invert); - Display.ReplPattern(Display.white, Display.grey1, F.X-1, F.Y, 1, F.H, Display.invert); - Display.ReplPattern(Display.white, Display.grey1, F.X+F.W, F.Y, 1, F.H, Display.invert) - END InvertBorder; - - PROCEDURE InvalSubFrames (F: Frame; x, y, w, h: INTEGER); (* removes and suspends all subframes partly in (x, y, w, h) *) - VAR p, f: Display.Frame; msg: MenuViewers.ModifyMsg; - BEGIN - IF (w > 0) & (h > 0) THEN f := F.dsc; - IF f # NIL THEN p := f; f := p.next END; - WHILE f # NIL DO - IF (f.X < x + w) & (f.X + f.W > x) & (f.Y < y + h) & (f.Y + f.H > y) THEN p.next := f.next; - msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := 0; - f.handle(f, msg) - ELSE p := f - END; - f := p.next - END; - f := F.dsc; - IF (f # NIL) & (f.X < x + w) & (f.X + f.W > x) & (f.Y < y + h) & (f.Y + f.H > y) THEN F.dsc := F.dsc.next; - msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := 0; - f.handle(f, msg) - END - END - END InvalSubFrames; - - PROCEDURE ShiftSubFrames (F: Frame; oldY, newY, h: INTEGER); (* shift (F.X, oldY, F.W, h) to (F.X, newY, F.W, h) *) - VAR f: Display.Frame; msg: MenuViewers.ModifyMsg; - BEGIN - IF oldY > newY THEN InvalSubFrames(F, F.X, newY, F.W, oldY - newY) - ELSE InvalSubFrames(F, F.X, oldY + h, F.W, newY - oldY) - END; - f := F.dsc; - WHILE f # NIL DO - IF (f.Y < oldY + h) & (f.Y + f.H > oldY) THEN INC(f.Y, newY - oldY); - msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := f.H; - f.handle(f, msg) - END; - f := f.next - END - END ShiftSubFrames; - - PROCEDURE NotifySubFrames (F: Frame; VAR msg: Display.FrameMsg); - VAR p, f: Display.Frame; - BEGIN f := F.dsc; - IF msg IS NotifyMsg THEN msg(NotifyMsg).frame := F END; - WHILE f # NIL DO p := f; f := f.next; p.handle(p, msg) END - END NotifySubFrames; - - - (* Display Primitives *) - - PROCEDURE DrawCursor (x, y: INTEGER); - BEGIN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y) - END DrawCursor; - - PROCEDURE TrackMouse (VAR x, y: INTEGER; VAR keys, keysum: SET); - BEGIN Input.Mouse(keys, x, y); keysum := keysum + keys; DrawCursor(x, y) - END TrackMouse; - - PROCEDURE EraseRect (F: Frame; x, y, w, h: INTEGER); - BEGIN Display.ReplConst(F.col, x, y, w, h, Display.replace); InvalSubFrames(F, x, y, w, h) - END EraseRect; - - PROCEDURE Erase (F: Frame; x, y, w, h: INTEGER); (*RemoveMarks optimization*) - BEGIN - IF h > 0 THEN Oberon.RemoveMarks(x, y, w, h); EraseRect(F, x, y, w, h) END - END Erase; - - PROCEDURE Shift (F: Frame; oldY, newY, h: INTEGER); (*RemoveMarks optimization*) - BEGIN - IF (oldY # newY) & (h > 0) THEN - Oberon.RemoveMarks(F.X + F.left, Min(oldY, newY), F.W - F.left, Max(oldY, newY) + h); - Display.CopyBlock(F.X + F.left, oldY, F.W - F.left, h, F.X + F.left, newY, Display.replace); - ShiftSubFrames(F, oldY, newY, h) - END - END Shift; - - PROCEDURE InvertCaret (F: Frame); - VAR loc: Location; bot: INTEGER; - BEGIN loc := F.carloc; bot := loc.y + loc.line.dsr - 6; - Display.CopyPatternC(F, Display.white, Display.hook, loc.x, bot, Display.invert) - END InvertCaret; - - PROCEDURE InvertRect (F: Frame; x, y, w, h: INTEGER); (*clips to right and bottom frame margin*) - BEGIN - IF x + w > F.X + F.W - F.right THEN w := F.X + F.W - F.right - x END; - IF y >= F.Y + F.bot THEN Display.ReplConst(Display.white, x, y, w, h, Display.invert) END - END InvertRect; - - PROCEDURE InvertSelection (F: Frame; beg, end: Location); - VAR t: TextLine; ex, rx, w, py: INTEGER; - BEGIN - rx := F.X + F.W - F.right; t := end.line; - IF t.eot OR (end.pos <= t.org + t.len) THEN ex := end.x ELSE ex := rx END; - IF beg.line = end.line THEN InvertRect(F, beg.x, beg.y, ex - beg.x, beg.line.h) - ELSE t := beg.line; py := beg.y; w := F.W - F.left - F.right; - InvertRect(F, beg.x, py, rx - beg.x, t.h); t := t.next; DEC(py, t.h); - WHILE t # end.line DO InvertRect(F, F.X + F.left, py, w, t.h); t := t.next; DEC(py, t.h) END; - InvertRect(F, F.X + F.left, py, ex - (F.X + F.left), t.h) - END - END InvertSelection; - - PROCEDURE CoordToPos (F: Frame; mh: INTEGER): LONGINT; - VAR h: INTEGER; - BEGIN h := F.H - 1; - IF h > 0 THEN RETURN ENTIER(F.text.len / h * (h - mh)) ELSE RETURN 0 END - END CoordToPos; - - PROCEDURE ShowBar (F: Frame; botH, topH: INTEGER); - BEGIN - IF (F.left > F.barW) & (F.barW > 0) THEN - Display.ReplConst(Display.white, F.X + F.barW - 1, F.Y + botH, 1, topH - botH, Display.replace) - END - END ShowBar; - - PROCEDURE Tick (F: Frame); - BEGIN - IF (0 <= F.markH) & (F.markH < F.H) & (F.left > F.barW) & (F.barW > 6) & (F.H > 2) THEN - Display.ReplConst(Display.white, F.X + 1, F.Y + F.markH, F.barW - 6, 2, Display.invert) - END - END Tick; - - PROCEDURE ShowTick (F: Frame); (* removes global marks as needed *) - VAR h, mh: INTEGER; len: LONGINT; - BEGIN - h := F.H - 2; len := F.text.len; - IF len > 0 THEN mh := SHORT(ENTIER(h - F.org / len * h)) ELSE mh := h END; - IF F.markH # mh THEN Oberon.RemoveMarks(F.X, F.Y, F.barW, F.H); - Tick(F); F.markH := mh; Tick(F) - END - END ShowTick; - - PROCEDURE Mark* (F: Frame; mark: INTEGER); - BEGIN - Erase(F, F.X, F.Y, F.barW - 1, F.H); F.markH := -1; - IF (mark < 0) & (F.H >= 16) THEN - Display.CopyPattern(Display.white, Display.downArrow, F.X, F.Y, Display.invert) - ELSIF mark > 0 THEN - ShowTick(F) - END - END Mark; - - - (** Parcs **) - - PROCEDURE ParcBefore* (T: Texts.Text; pos: LONGINT; VAR P: Parc; VAR beg: LONGINT); - VAR R: Texts.Reader; - BEGIN Texts.OpenReader(R, T, pos + 1); - REPEAT Texts.ReadPrevElem(R) UNTIL R.eot OR (R.elem IS Parc); - IF R.eot THEN P := defParc; beg := -1 ELSE P := R.elem(Parc); beg := Texts.Pos(R) END - END ParcBefore; - - PROCEDURE -InitDefParc() "ParcElems__init()"; - - (* Screen Metrics *) - - PROCEDURE Tab (dw: INTEGER; VAR dx: INTEGER); (*P set*) - (* dw = line width from left margin to caret (in pixels); dx = distance from caret to next tab stop (in pixels) *) - VAR i, n: INTEGER; w: LONGINT; - BEGIN - i := 0; n := P.nofTabs; w := LONG(dw) * Unit + MinTabWidth; - IF dw < 0 THEN dx := -dw - ELSE - WHILE (i < n) & (P.tab[i] < w) DO INC(i) END; - IF i < n THEN dx := SHORT((P.tab[i] - LONG(dw) * Unit) DIV Unit) - ELSE dx := StdTabWidth DIV Unit - END - END - END Tab; - - PROCEDURE MeasureSpecial (dw: INTEGER; VAR dx, x, y, w, h: INTEGER); - (* returns metrics of nextCh (nextCh <= " "); sends prepare message to elements; P, R, nextCh set *) - VAR e: Texts.Elem; pat: Display.Pattern; msg: DisplayMsg; - BEGIN - IF nextCh = " " THEN Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat); - x := 0; y := 0; w := dx; h := 0 - ELSIF nextCh = TAB THEN Tab(dw, dx); x := 0; y := 0; w := dx; h := 0 - ELSIF R.elem # NIL THEN e := R.elem; - msg.prepare := TRUE; msg.indent := LONG(dw) * Unit; - msg.fnt := R.fnt; msg.col := R.col; msg.pos := Texts.Pos(R)-1; - msg.Y0 := -SHORT(P.dsr DIV Unit); (*<<< 18-Nov-91*) - e.handle(e, msg); - w := SHORT(e.W DIV Unit); - dx := w; x := 0; y := msg.Y0; h := SHORT(e.H DIV Unit) (*<<< 18-Nov-91*) - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat) - END - END MeasureSpecial; - - PROCEDURE GetSpecial (F: Frame; VAR n: INTEGER; cn, ddx, dw: INTEGER; VAR dx, x, y, w, h: INTEGER); - (* returns metrics of nextCh (nextCh <= " "); no prepare message to elements; extends blanks for block adjust *) - (* cn ... add 1 pixel to first cn blanks (block adjust); ddx ... add ddx pixels to every blank (block adjust) *) - (*P, R, nextCh set*) - VAR e: Texts.Elem; pat: Display.Pattern; - BEGIN - IF nextCh = " " THEN Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat); - x := 0; y := 0; INC(dx, ddx); INC(n); IF n <= cn THEN INC(dx) END; (*space correction for block adjustment*) - w := dx; h := 0 - ELSIF nextCh = TAB THEN Tab(dw, dx); x := 0; y := 0; w := dx; h := 0 - ELSIF R.elem # NIL THEN e := R.elem; - IF (e IS Parc) & (P.W = 9999 * Unit) THEN (* P gets this value in prepare message *) - w := Min(SHORT((P.width + P.left) DIV Unit), F.W - F.right - F.left); - e.W := LONG(w) * Unit - ELSE w := SHORT(e.W DIV Unit) - END; - dx := w; x := 0; y := -SHORT(P.dsr DIV Unit); h := SHORT(e.H DIV Unit) - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat) - END - END GetSpecial; - - PROCEDURE NextLine (T: Texts.Text; VAR org: LONGINT); (*R, nextCh set; org = Texts.Pos(R)-1*) - VAR pat: Display.Pattern; pos, bk, d: LONGINT; width, tw, dx, x, y, w, h: INTEGER; - R1: Texts.Reader; peekCh: CHAR; indent: INTEGER; - BEGIN - tw := 0; dx := 0; w := 0; bk := -999; (* bk = pos of last seperator *) - pos := org; ParcBefore(T, pos, P, pbeg); width := SHORT(P.width DIV Unit); - indent := 0; - IF org > 0 THEN Texts.OpenReader(R1, T, org - 1); Texts.Read(R1, peekCh); - IF (peekCh = CR) OR (R1.elem # NIL) & (R1.elem IS Parc) THEN indent := SHORT(P.first DIV Unit) END; - END; - INC(tw, indent); - LOOP INC(pos); (*inv pos = Texts.Pos(R), ~R.eof => nextCh = text[pos-1]*) - IF R.eot OR (nextCh = CR) THEN EXIT END; - INC(tw, dx); - IF nextCh <= " " THEN MeasureSpecial(tw, dx, x, y, w, h) - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat) - END; - IF tw + x + w > width THEN d := pos - bk; - IF (d < AdjustSpan) & (nextCh > " ") THEN pos := bk - ELSIF ((nextCh > " ") OR (nextCh = Texts.ElemChar)) & (pos > org + 1) THEN DEC(pos) - END; - Texts.OpenReader(R, T, pos); Texts.Read(R, nextCh); - EXIT - END; - IF (nextCh <= " ") & (nextCh # Texts.ElemChar) THEN bk := pos END; - Texts.Read(R, nextCh) - END; - org := pos - END NextLine; - - PROCEDURE BegOfLine (T: Texts.Text; VAR pos: LONGINT; adjust: BOOLEAN); - (* returns origin of line containing pos *) - VAR p, org: LONGINT; - BEGIN - IF pos <= 0 THEN pos := 0 - ELSE - IF pos <= T.len THEN org := pos ELSE org := T.len END; - LOOP (*search backwards for CR*) - IF org = 0 THEN EXIT END; - Texts.OpenReader(R, T, org - 1); Texts.Read(R, nextCh); - IF nextCh = CR THEN EXIT END; - DEC(org) - END; - IF adjust THEN (*search forward for actual line origin*) - Texts.OpenReader(R, T, org); Texts.Read(R, nextCh); p := org; - REPEAT org := p; NextLine(T, p) UNTIL (p > pos) OR R.eot - END; - pos := org - END - END BegOfLine; - - PROCEDURE AdjustMetrics (F: Frame; t: TextLine; VAR pw, tw, ddx, cn: INTEGER); (*t.org set*) - (* pw ... x-coord of first char in line (in pixels); tw ... width of text line; ddx, cn ... see GetSpecial *) - BEGIN - P := t.P; pbeg := t.pbeg; - pw := F.left; tw := t.w; ddx := 0; cn := 0; - IF t.pbeg # t.org THEN - INC(pw, SHORT((P.left + t.indent) DIV Unit)); - IF leftAdj IN P.opts THEN - IF (rightAdj IN P.opts) & (t.nob > 0) THEN - tw := SHORT(P.width DIV Unit); ddx := (tw - t.w0) DIV t.nob; cn := (tw - t.w0) MOD t.nob - END - ELSIF rightAdj IN P.opts THEN INC(pw, SHORT(P.width DIV Unit) - t.w0) - ELSE (*center*) INC(pw, (SHORT(P.width DIV Unit) - t.w0) DIV 2) - END; - DEC(tw, SHORT(t.indent DIV Unit)); - END - END AdjustMetrics; - - - (* Screen Placement *) - - PROCEDURE DrawSpecial (F: Frame; px, py, x, y: INTEGER); (*R, nextCh set*) - VAR e: Texts.Elem; pat: Display.Pattern; dx, w, h: INTEGER; msg: DisplayMsg; - BEGIN - IF (nextCh = TAB) OR (nextCh = CR) THEN (*skip*) - ELSIF R.elem # NIL THEN e := R.elem; - IF ~(e IS Parc) OR F.showsParcs THEN - msg.prepare := FALSE; msg.fnt := R.fnt; msg.col := R.col; msg.pos := Texts.Pos(R) - 1; - msg.frame := F; msg.X0 := px + x; msg.Y0 := py + y; msg.elemFrame := NIL; - e.handle(e, msg); - IF msg.elemFrame # NIL THEN msg.elemFrame.next := F.dsc; F.dsc := msg.elemFrame END; - ELSIF pageBreak IN e(Parc).opts THEN (*(e IS Parc) & ~F.showsParcs*) - Display.ReplPattern(Display.white, Display.grey1, px + x, py, SHORT(e.W DIV Unit), 1, Display.replace) - END - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat); - Display.CopyPattern(R.col, pat, px + x, py + y, Display.invert) - END; - END DrawSpecial; - - PROCEDURE ShowLine (F: Frame; t: TextLine; left, right, py: INTEGER); - VAR pat: Display.Pattern; i: LONGINT; n, cn, lm, px, pw, tw, ddx, dx, x, y, w, h: INTEGER; - BEGIN - (* lm ... left parc margin in screen coord; pw ... x of first char in frame coord *) - Texts.OpenReader(R, F.text, t.org); AdjustMetrics(F, t, pw, tw, ddx, cn); - lm := F.X + F.left + SHORT(P.left DIV Unit); px := F.X + pw; INC(py, t.dsr); i := 0; n := 0; - WHILE i < t.len DO Texts.Read(R, nextCh); - IF nextCh <= " " THEN GetSpecial(F, n, cn, ddx, px - lm, dx, x, y, w, h) - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat) - END; - INC(y, R.fnt.height * R.voff DIV 64); - IF px + x + w <= right THEN - IF px + x >= left THEN - IF nextCh <= " " THEN DrawSpecial(F, px, py, x, y) - ELSE Display.CopyPattern(R.col, pat, px + x, py + y, Display.invert) - END - END; - INC(px, dx); INC(i) - ELSE i := t.len - END - END - END ShowLine; - - PROCEDURE ShowLines (F: Frame; botH, topH: INTEGER; erase: BOOLEAN); - VAR t: TextLine; ph: INTEGER; - BEGIN - t := F.trailer.next; ph := F.H - F.top; - WHILE (t # F.trailer) & (ph - t.h >= topH) DO DEC(ph, t.h); t := t.next END; - WHILE (t # F.trailer) & (ph - t.h >= botH) DO DEC(ph, t.h); - IF erase THEN Erase(F, F.X + F.left, F.Y + ph, F.W - F.right - F.left, t.h) END; - ShowLine(F, t, F.X + F.left, F.X + F.W - F.right, F.Y + ph); t := t.next - END - END ShowLines; - - - (* Screen Casting *) - - PROCEDURE MeasureLine (F: Frame; maxW: INTEGER; t: TextLine); (* R, nextCh set *) - VAR pat: Display.Pattern; len, bklen, d: LONGINT; eol: BOOLEAN; - nob, bknob, width, minY, bkminY, maxY, bkmaxY, tw, bktw, lsp, dsr, dx, x, y, w, h: INTEGER; - R1: Texts.Reader; peekCh: CHAR; - (* bk* ... backup for last blank *) - BEGIN - len := 0; nob := 0; bklen := -999; tw := 0; dx := 0; minY := 0; maxY := 0; - ParcBefore(F.text, t.org, P, pbeg); - lsp := SHORT(P.lsp DIV Unit); dsr := SHORT(P.dsr DIV Unit); width := SHORT(P.width DIV Unit); - t.indent := 0; - IF t.org > 0 THEN Texts.OpenReader(R1, F.text, t.org - 1); Texts.Read(R1, peekCh); - IF (peekCh = CR) OR (R1.elem # NIL) & (R1.elem IS Parc) THEN t.indent := P.first END; - END; - INC(tw, SHORT(t.indent DIV Unit)); - LOOP - IF R.eot OR (nextCh = CR) THEN nob := 0; eol := ~R.eot; EXIT END; - IF nextCh <= " " THEN MeasureSpecial(tw, dx, x, y, w, h) - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat) - END; - IF tw + x + w > width THEN d := len - bklen; - IF (d < AdjustSpan) & (nextCh > " ") THEN eol := TRUE; - Texts.OpenReader(R, F.text, Texts.Pos(R) - d); - nob := bknob; len := bklen; tw := bktw; minY := bkminY; maxY := bkmaxY - ELSIF len = 0 THEN (* force at least one character on each line *) - INC(len); INC(y, R.fnt.height * R.voff DIV 64); minY := Min(minY, y); maxY := Max(maxY, y + h); - Texts.Read(R, nextCh); eol := FALSE; tw := maxW - ELSE eol := (nextCh <= " ") & (nextCh # Texts.ElemChar) - END; - EXIT - END; - IF (nextCh <= " ") & (nextCh # Texts.ElemChar) THEN - bknob := nob; bklen := len; bktw := tw; bkminY := minY; bkmaxY := maxY; - IF nextCh = " " THEN INC(nob) END - END; - INC(len); INC(tw, dx); INC(y, R.fnt.height * R.voff DIV 64); - IF y < minY THEN minY := y END; - IF y + h > maxY THEN maxY := y + h END; - Texts.Read(R, nextCh) - END; - IF ~F.showsParcs & (pbeg = t.org) THEN dsr := 0; t.h := SHORT(P.lead DIV Unit) + 1 - ELSIF gridAdj IN P.opts THEN - WHILE dsr < -minY DO INC(dsr, lsp) END; - t.h := Max(lsp, dsr + maxY); INC(t.h, (-t.h) MOD lsp) - ELSE dsr := Max(dsr, -minY); t.h := Max(lsp, dsr + maxY) - END; - t.len := len; t.w0 := tw; t.w := Min(tw, maxW); t.dsr := dsr; t.nob := nob; t.eot := R.eot; t.P := P; t.pbeg := pbeg; - IF eol THEN Texts.Read(R, nextCh); t.span := len + 1 ELSE t.span := len END - END MeasureLine; - - PROCEDURE MeasureLines (F: Frame; org: LONGINT; VAR trailer: TextLine); - VAR s, t: TextLine; ph: INTEGER; - BEGIN - NEW(trailer); s := trailer; - Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh); ph := F.H - F.top; - LOOP NEW(t); t.org := org; MeasureLine(F, F.W - F.left - F.right, t); - IF ph - t.h < F.bot THEN EXIT END; - s.next := t; s := t; INC(org, s.span); DEC(ph, s.h); - IF R.eot THEN EXIT END - END; - s.next := trailer; trailer.eot := TRUE; trailer.org := org; (* start of first invisible line *) trailer.len := 0; trailer.w := 0; - trailer.h := SHORT(defParc.lsp DIV Unit); trailer.P := P (* P set by MeasureLine *) ; trailer.pbeg := pbeg - END MeasureLines; - - - (** Locators **) - - PROCEDURE LocateLineTop (F: Frame; trailer: TextLine; org: LONGINT; VAR loc: Location); - VAR t: TextLine; ph: INTEGER; - BEGIN - ph := F.H - F.top; t := trailer.next; - WHILE (t # trailer) & (t.org # org) DO DEC(ph, t.h); t := t.next END; - loc.org := org; loc.line := t; loc.y := F.Y + ph - END LocateLineTop; - - PROCEDURE Width (F: Frame; t: TextLine; pos: LONGINT; VAR pw, dx, dy: INTEGER); - VAR pat: Display.Pattern; i: LONGINT; n, mw, lm, tw, ddx, cn, x, y, w, h: INTEGER; - BEGIN - AdjustMetrics(F, t, pw, tw, ddx, cn); dy := 0; lm := F.left + SHORT(P.left DIV Unit); - IF t # F.trailer THEN Texts.OpenReader(R, F.text, t.org); Texts.Read(R, nextCh); - i := 0; n := 0; DEC(pos, t.org); dx := 0; mw := F.W - F.right; - WHILE ~R.eot & (i < t.len) & (i <= pos) & (pw + dx <= mw) DO - (* i ... pos of nextCh; dx ... width of char before nextCh; pw ... line width up to pos (or up to right margin) *) - INC(i); INC(pw, dx); - IF nextCh <= " " THEN GetSpecial(F, n, cn, ddx, pw - lm, dx, x, y, w, h) - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat) - END; - dy := R.fnt.height * R.voff DIV 64; - Texts.Read(R, nextCh) - END; - IF (i <= pos) & (pw + dx <= mw) THEN INC(i); INC(pw, dx) END - ELSE dx := 4 - END - END Width; - - - PROCEDURE LocatePos* (F: Frame; pos: LONGINT; VAR loc: Location); (* loc.dx = dx of char at pos *) - VAR t: TextLine; pw, dx, dy: INTEGER; - BEGIN - IF pos < F.org THEN pos := F.org; t := F.trailer.next - ELSIF pos < F.trailer.org THEN t := F.trailer; - WHILE (t.next # F.trailer) & (t.next.org <= pos) DO t := t.next END - ELSE pos := F.trailer.org; t := F.trailer.next; - WHILE ~t.eot DO t := t.next END - END; - Width(F, t, pos, pw, dx, dy); LocateLineTop(F, F.trailer, t.org, loc); DEC(loc.y, loc.line.h); - loc.org := t.org; loc.pos := pos; loc.x := F.X + pw; loc.dx := dx; loc.dy := dy; loc.line := t - END LocatePos; - - PROCEDURE LocateLine* (F: Frame; y: INTEGER; VAR loc: Location); - (* loc.x = line start; loc.y = line bottom; loc.dx = line width *) - VAR t: TextLine; h, ph, pw, tw, ddx, cn: INTEGER; - BEGIN - t := F.trailer.next; h := y - F.Y; ph := F.H - F.top - t.h; - WHILE ~t.eot & (ph - t.next.h >= F.bot) & (ph > h) DO t := t.next; DEC(ph, t.h) END; - AdjustMetrics(F, t, pw, tw, ddx, cn); - IF pw >= F.W - F.right THEN pw := F.W - F.right - 4 END; - loc.org := t.org; loc.pos := loc.org; loc.x := F.X + pw; loc.y := F.Y + ph; loc.dx := tw; loc.dy := 0; loc.line := t - END LocateLine; - - PROCEDURE LocateChar* (F: Frame; x, y: INTEGER; VAR loc: Location); - VAR t: TextLine; pat: Display.Pattern; i: LONGINT; n, w, lm, pw, tw, ddx, cn, dx, xc, yc, wc, hc: INTEGER; - BEGIN - LocateLine(F, y, loc); t := loc.line; w := x - F.X; AdjustMetrics(F, t, pw, tw, ddx, cn); - lm := F.left + SHORT(P.left DIV Unit); - IF (t # F.trailer) & (w > pw) THEN Texts.OpenReader(R, F.text, t.org); - i := 0; n := 0; dx := 0; nextCh := 0X; - WHILE (i < t.len) & (pw + dx < w) DO - (* i = pos after nextCh; dx = width of nextCh; pw = line width without nextCh *) - Texts.Read(R, nextCh); INC(i); INC(pw, dx); - IF nextCh <= " " THEN GetSpecial(F, n, cn, ddx, pw - lm, dx, xc, yc, wc, hc) - ELSE Display.GetChar(R.fnt.raster, nextCh, dx, xc, yc, wc, hc, pat) - END - END; - IF pw + dx < w THEN INC(i); INC(pw, dx); R.elem := NIL END; - INC(loc.pos, i - 1); loc.x := F.X + pw; - IF i < t.len THEN loc.dx := dx; loc.dy := R.fnt.height * R.voff DIV 64 ELSE loc.dx := 4 END - ELSE loc.dx := 4; R.elem := NIL - END - END LocateChar; - - PROCEDURE LocateWord* (F: Frame; x, y: INTEGER; VAR loc: Location); - VAR t: TextLine; pos, i: LONGINT; px, rx: INTEGER; pat: Display.Pattern; dx, xc, yc, wc, hc: INTEGER; - BEGIN - LocateChar(F, x, y, loc); pos := loc.pos + 1; - REPEAT DEC(pos); Texts.OpenReader(R, F.text, pos); Texts.Read(R, nextCh) - UNTIL (pos < loc.org) OR (nextCh > " "); - INC(pos); - REPEAT DEC(pos); Texts.OpenReader(R, F.text, pos); Texts.Read(R, nextCh) - UNTIL (pos < loc.org) OR (nextCh <= " "); - LocatePos(F, pos + 1, loc); t := loc.line; i := loc.pos - loc.org; - IF i < t.len THEN px := loc.x; rx := F.X + F.W - F.right; - Texts.OpenReader(R, F.text, loc.pos); dx := 0; wc := 0; nextCh := "x"; - WHILE (i < t.len) & (nextCh > " ") & (px + dx < rx) DO - Texts.Read(R, nextCh); INC(i); INC(px, dx); - Display.GetChar(R.fnt.raster, nextCh, dx, xc, yc, wc, hc, pat) - END; - IF (nextCh > " ") & (px + dx < rx) THEN INC(i); INC(px, dx) END; - loc.dx := px - loc.x - ELSE loc.dx := 0 - END - END LocateWord; - - PROCEDURE Pos* (F: Frame; x, y: INTEGER): LONGINT; - VAR loc: Location; - BEGIN LocateChar(F, x, y, loc); RETURN loc.pos - END Pos; - - PROCEDURE ThisSubFrame (F: Frame; x, y: INTEGER): Display.Frame; - VAR f: Display.Frame; - BEGIN f := F.dsc; - WHILE (f # NIL) & ((x < f.X) OR (x >= f.X + f.W) OR (y < f.Y) OR (y >= f.Y + f.H)) DO f := f.next END; - RETURN f - END ThisSubFrame; - - - (** Caret & Selection **) - - PROCEDURE PassSubFocus (F: Frame; f: Display.Frame); - (* pass focus from F.focus to f (f is also an element frame in F) *) - VAR loc: Location; f1: Display.Frame; ctrl: Oberon.ControlMsg; focus: FocusMsg; - BEGIN - IF F.focus # NIL THEN f1 := F.focus; - ctrl.id := Oberon.defocus; f1.handle(f1, ctrl); - LocateChar(F, f1.X + 1, f1.Y + 1, loc); - InvertBorder(f1); F.focus := NIL; - focus.focus := FALSE; focus.elemFrame := f1; focus.frame := F; R.elem.handle(R.elem, focus) - END; - IF f # NIL THEN - LocateChar(F, f.X + 1, f.Y + 1, loc); (* side effect: set R to element *) - focus.focus := TRUE; focus.elemFrame := f; focus.frame := F; R.elem.handle(R.elem, focus); - InvertBorder(f) - END; - F.focus := f - END PassSubFocus; - - PROCEDURE RemoveSelection* (F: Frame); - BEGIN - IF F.hasSel THEN InvertSelection(F, F.selbeg, F.selend); F.hasSel := FALSE END - END RemoveSelection; - - PROCEDURE SetSelection* (F: Frame; beg, end: LONGINT); (** forces range to visible bounds **) - VAR loc: Location; - BEGIN - IF end > F.text.len THEN end := F.text.len END; - IF end > beg THEN - IF F.hasSel & (F.selbeg.pos = beg) THEN - IF (F.selend.pos < end) & (F.selend.pos < F.trailer.org) THEN - LocatePos(F, F.selend.pos, loc); LocatePos(F, end, F.selend); InvertSelection(F, loc, F.selend) - ELSIF end < F.selend.pos THEN - LocatePos(F, end, loc); InvertSelection(F, loc, F.selend); LocatePos(F, end, F.selend) - END - ELSE RemoveSelection(F); PassSubFocus(F, NIL); - LocatePos(F, beg, F.selbeg); LocatePos(F, end, F.selend); InvertSelection(F, F.selbeg, F.selend) - END; - F.hasSel := TRUE; F.time := Oberon.Time() - END - END SetSelection; - - - PROCEDURE RemoveCaret* (F: Frame); - VAR msg: Oberon.ControlMsg; - BEGIN - IF F.focus # NIL THEN msg.id := Oberon.defocus; F.focus.handle(F.focus, msg) END; - IF F.hasCar THEN InvertCaret(F); F.hasCar := FALSE END - END RemoveCaret; - - PROCEDURE SetCaret* (F: Frame; pos: LONGINT); (** only done if within visible bounds **) - BEGIN - IF ~F.hasCar OR (F.carloc.pos # pos) THEN RemoveCaret(F); PassSubFocus(F, NIL); - LocatePos(F, pos, F.carloc); - IF F.carloc.x <= F.X + F.W - F.right THEN InvertCaret(F); F.hasCar := TRUE END - END - END SetCaret; - - - - (** Display Range **) - - PROCEDURE Complete (F: Frame; trailer: TextLine; s: TextLine; org: LONGINT; ph: INTEGER); - VAR u: TextLine; - BEGIN - IF ph > F.bot THEN (*try to add new lines to the bottom*) - Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh); - LOOP - IF R.eot THEN EXIT END; - NEW(u); u.org := org; MeasureLine(F, F.W - F.left - F.right, u); - IF ph - u.h < F.bot THEN EXIT END; - s.next := u; s := s.next; DEC(ph, s.h); INC(org, s.span) - END - END; - s.next := trailer; trailer.eot := TRUE; trailer.org := org; trailer.len := 0; trailer.w := 0; - trailer.h := SHORT(defParc.lsp DIV Unit); trailer.P := P; trailer.pbeg := pbeg - END Complete; - - PROCEDURE ShowFrom (F: Frame; pos: LONGINT); (* removes global marks as needed and neutralizes F *) - VAR new, s: TextLine; beg, end: Location; org: LONGINT; ph, y0, dy: INTEGER; - BEGIN - F.handle(F, neutralize); - IF (F.trailer # NIL) & (F.org < pos) & (pos < F.trailer.org) THEN (* shift up and extend to the bottom *) - LocateLineTop(F, F.trailer, pos, beg); LocateLineTop(F, F.trailer, F.trailer.org, end); - dy := (F.Y + F.H - F.top) - beg.y; Shift(F, end.y, end.y + dy, beg.y - end.y); - Erase(F, F.X + F.left, end.y, F.W - F.left, dy); - s := F.trailer.next; WHILE s.org # pos DO s := s.next END; - F.trailer.next := s; org := s.org + s.span; ph := F.H - F.top - s.h; - WHILE s.next # F.trailer DO s := s.next; org := org + s.span; ph := ph - s.h END; - Complete(F, F.trailer, s, org, ph); F.org := pos; ShowLines(F, F.bot, end.y + dy - F.Y, FALSE) - ELSIF (F.trailer = NIL) OR (pos # F.org) THEN - MeasureLines(F, pos, new); - IF (F.trailer # NIL) & (pos < F.org) & (F.org <= new.org) THEN (* shift down and extend to the top *) - LocateLineTop(F, new, F.org, beg); LocateLineTop(F, new, new.org, end); - y0 := F.Y + F.H - F.top; Shift(F, y0 - (beg.y - end.y), end.y, beg.y - end.y); - Erase(F, F.X + F.left, beg.y, F.W - F.left, y0 - beg.y); - Erase(F, F.X + F.left, F.Y + F.bot, F.W - F.left, end.y - (F.Y + F.bot)); - F.org := pos; F.trailer := new; ShowLines(F, beg.y - F.Y, F.H - F.top, FALSE) - ELSE (* full redisplay *) - IF F.trailer = NIL THEN Erase(F, F.X, F.Y, F.W, F.H); ShowBar(F, 0, F.H); F.markH := -1 - ELSE Erase(F, F.X + F.left, F.Y + F.bot, F.W - F.left, F.H - F.bot - F.top) - END; - F.org := pos; F.trailer := new; ShowLines(F, F.bot, F.H - F.top, FALSE) - END - END; - ShowTick(F) - END ShowFrom; - - PROCEDURE Show* (F: Frame; pos: LONGINT); (** removes global marks as needed and neutralizes F **) - BEGIN BegOfLine(F.text, pos, TRUE); ShowFrom(F, pos) - END Show; - - - PROCEDURE Resize (F: Frame; x, y, w, h: INTEGER); - VAR oldY, oldH, dh, ph: INTEGER; t: TextLine; - BEGIN - IF (w = 0) OR (h = 0) THEN InvalSubFrames(F, F.X, F.Y, F.W, F.H); - F.X := x; F.Y := y; F.W := w; F.H := h; F.trailer := NIL - ELSIF (F.trailer # NIL) & (x = F.X) & (w = F.W) THEN - oldY := F.Y; oldH := F.H; Tick(F); F.markH := -1; F.Y := y; F.H := h; - IF h > oldH THEN dh := h - oldH; (* extend *) - IF y + h # oldY + oldH THEN - Display.CopyBlock(x, oldY, w, oldH, x, y + dh, Display.replace); - ShiftSubFrames(F, oldY, y + dh, oldH) - END; - EraseRect(F, x, y, w, dh); ShowBar(F, 0, dh); - t := F.trailer; ph := F.H - F.top; - WHILE t.next # F.trailer DO t := t.next; ph := ph - t.h END; - Complete(F, F.trailer, t, F.trailer.org, ph); ShowLines(F, F.bot, ph, FALSE) - ELSE dh := oldH - h; (* reduce *) - IF y + h # oldY + oldH THEN - Display.CopyBlock(x, oldY + dh, w, h, x, y, Display.replace); - ShiftSubFrames(F, oldY + dh, y, h) - END; - t := F.trailer; ph := F.H - F.top; - WHILE (t.next # F.trailer) & (ph - t.next.h >= F.bot) DO t := t.next; DEC(ph, t.h) END; - IF t = F.trailer THEN t.org := F.org; t.span := 0 END; - Complete(F, F.trailer, t, t.org + t.span, ph); - EraseRect(F, x + F.left, y, w - F.left, ph); - InvalSubFrames(F, x, oldY, w, y - oldY); InvalSubFrames(F, x, y + h, w, dh - (y - oldY)) - END; - ShowTick(F) - ELSE F.X := x; F.Y := y; F.W := w; F.H := h; F.trailer := NIL; Show(F, F.org) - END - END Resize; - - - (** Contents Update **) - - PROCEDURE Update (F: Frame; VAR msg: UpdateMsg); (** removes global marks as needed **) - VAR t: TextLine; org, d, Fbeg, Fend: LONGINT; - foc: Display.Frame; beg, end: LONGINT; ch: CHAR; r: Texts.Reader; loc: Location; - - PROCEDURE Begin (VAR beg: LONGINT; VAR org0: LONGINT; VAR q: TextLine); - (* org0 = origin of first affected line; beg = pos of first modified character; q = first affected line (if line origin has not moved).*) - (* q = NIL => beg = org0; q # NIL => first (beg-org0) characters of q need not be redrawn *) - VAR trailer, t: TextLine; - BEGIN - trailer := F.trailer; t := trailer; - WHILE (t.next # trailer) & (beg >= t.next.org + t.next.span) & ~t.next.eot DO t := t.next END; - q := t.next; - IF (t # trailer) & (q # trailer) & (beg <= q.org + q.span) THEN - Texts.OpenReader(R, F.text, t.org); Texts.Read(R, nextCh); org0 := t.org; NextLine(F.text, org0) - ELSE org0 := beg; BegOfLine(F.text, org0, TRUE) - END; - IF org0 # q.org THEN - IF t = trailer THEN org0 := q.org ELSE org0 := t.org END; - beg := org0; q := NIL - END - END Begin; - - PROCEDURE Adjust (end, delta: LONGINT); - (* H1 = top of synchronization line in old frame *) - (* h0 = top of line that was modified *) - (* h1 = top of block in new frame that could be reused *) - (* h2 = bottom of last line in new frame *) - (* h1 - h2 = height of block that could be reused *) - VAR new, old, s, t, u, p, q: TextLine; bot: Location; - org, org0, beg: LONGINT; ph, h0, h1, H1, h2, lm, dx, dy: INTEGER; - BEGIN - q := NIL; LocateLineTop(F, F.trailer, F.trailer.org, bot); - IF msg.beg < F.org THEN org0 := F.org; beg := org0 ELSE beg := msg.beg; Begin(beg, org0, q) END; - NEW(new); s := new; old := F.trailer; t := old; org := F.org; ph := F.H - F.top; - WHILE (t.next # old) & (t.next.org # org0) DO t := t.next; (*transfer unchanged prefix*) - s.next := t; s := t; DEC(ph, s.h); INC(org, s.span) - END; - h0 := ph; H1 := h0; t := t.next; p := s; - Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh); (*rebuild at least one line descriptor*) - LOOP NEW(u); u.org := org; MeasureLine(F, F.W - F.left - F.right, u); - IF ph - u.h < F.bot THEN h1 := ph; h2 := h1; EXIT END; - s.next := u; s := s.next; DEC(ph, s.h); INC(org, s.span); - IF R.eot THEN h1 := ph; h2 := h1; EXIT END; - IF org > end THEN - WHILE (t # old) & (org > t.org + delta) DO DEC(H1, t.h); t := t.next END; - IF (org = t.org + delta) & (P = t.P) THEN h1 := ph; (*resynchronized*) - WHILE (t # old) & (ph - t.h >= F.bot) DO (*transfer unchanged suffix*) - s.next := t; s := t; s.org := org; ParcBefore(F.text, s.org, s.P, s.pbeg); - DEC(ph, s.h); INC(org, s.span); t := t.next - END; - h2 := ph; EXIT - END - END - END; - Shift(F, F.Y + H1 - (h1 - h2), F.Y + h2, h1 - h2); - Complete(F, new, s, org, ph); F.trailer := new; t := p.next; - IF (q # NIL) & (t # F.trailer) & (q.h = t.h) & (q.dsr = t.dsr) & (q.org = t.org) & (q.P = t.P) & (end <= t.org + t.span) THEN - P := t.P; pbeg := t.pbeg; - IF (P.opts * AdjMask = {leftAdj}) OR (P.opts * AdjMask = AdjMask) & (q.nob = 0) & (t.nob = 0) THEN - Width(F, t, beg, lm, dx, dy); (*preserve prefix of first affected line*) - DEC(h0, t.h); Erase(F, F.X + lm, F.Y + h0, F.W - lm, t.h); - ShowLine(F, t, F.X + lm, F.X + F.W - F.right, F.Y + h0) - END - END; - ShowLines(F, h1, h0, TRUE); - Erase(F, F.X + F.left, bot.y, F.W - F.left, h2 - (bot.y - F.Y)); ShowLines(F, F.bot, h2, FALSE) - END Adjust; - - BEGIN - foc := F.focus; beg := msg.beg; end := msg.end; - F.handle(F, neutralize); MarkMenu(F); Fbeg := F.org; Fend := F.trailer.org; - IF (msg.id = Texts.insert) & (msg.beg < F.org) THEN t := F.trailer; d := msg.end - msg.beg; INC(F.org, d); - REPEAT INC(t.org, d); t := t.next UNTIL t = F.trailer - ELSIF msg.id = Texts.delete THEN - IF msg.end <= F.org THEN t := F.trailer; d := msg.end - msg.beg; DEC(F.org, d); - REPEAT DEC(t.org, d); t := t.next UNTIL t = F.trailer - ELSIF msg.beg < F.org THEN F.org := msg.beg - END - END; - org := F.org; - IF msg.beg <= Fbeg + AdjustSpan THEN BegOfLine(F.text, org, TRUE) END; - ParcBefore(F.text, org, P, d); - IF (org # F.org) OR (P # F.trailer.next.P) THEN - F.trailer := NIL; Show(F, F.org) - ELSIF (msg.end > Fbeg) & (msg.beg < Fend + AdjustSpan) THEN - IF msg.id = Texts.replace THEN Adjust(msg.end, 0); - (* refocus element if necessary *) - IF (foc # NIL) & (end-beg = 1) THEN - Texts.OpenReader(r, F.text, beg); Texts.Read(r, ch); - IF r.elem # NIL THEN - LocatePos(F, beg, loc); foc := ThisSubFrame(F, loc.x, loc.y); PassSubFocus(F, foc); - END - END - ELSIF msg.id = Texts.insert THEN Adjust(msg.end, msg.end - msg.beg) - ELSIF msg.id = Texts.delete THEN Adjust(msg.beg, msg.beg - msg.end) - END - END; - ShowTick(F) - END Update; - - - (** User Interface **) - - PROCEDURE Back (F: Frame; dY: INTEGER; (*inout*) VAR org: LONGINT); (* mh 10.10.92 *) - (* computes new org such that old org is (at most) dY pixels below new org *) - VAR H: INTEGER; oldOrg: LONGINT; - - PROCEDURE TotalHeight (org1, org2: LONGINT): INTEGER; - (* measures total height of text-lines starting at org1 and ending at the line before the line containing org2 *) - VAR h: INTEGER; line: TextLine; - BEGIN - Texts.OpenReader(R, F.text, org1); Texts.Read(R, nextCh); NEW(line); h := 0; - LOOP line.org := org1; - MeasureLine(F, F.W - F.left - F.right, line); INC(org1, line.span); - IF Texts.Pos(R)-1 > org2 THEN EXIT END; - INC(h, line.h); - IF R.eot THEN EXIT END; - END; - RETURN h - END TotalHeight; - - PROCEDURE Forward (h: INTEGER); - (* increase org by n text-lines such that the sum of the n line-heights > h *) - VAR line: TextLine; - BEGIN - Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh); NEW(line); - WHILE h > 0 DO line.org := org; - MeasureLine(F, F.W - F.left - F.right, line); INC(org, line.span); DEC(h, line.h); - END; - org := Texts.Pos(R)-1; - END Forward; - - BEGIN H := 0; - LOOP oldOrg := org; - IF org = 0 THEN EXIT END; - DEC(org, 800); BegOfLine(F.text, org, FALSE); - INC(H, TotalHeight(org, oldOrg)); - IF H > dY THEN EXIT END; - END; - Forward(H - dY); - END Back; - - PROCEDURE TrackLine* (F: Frame; VAR x, y: INTEGER; VAR org: LONGINT; VAR keysum: SET); - VAR keys: SET; new, old: Location; - BEGIN - LocateLine(F, y, old); InvertRect(F, old.x, old.y, old.dx + 4, 2); keysum := {}; - REPEAT TrackMouse(x, y, keys, keysum); LocateLine(F, y, new); - IF new.org # old.org THEN - InvertRect(F, new.x, new.y, new.dx + 4, 2); InvertRect(F, old.x, old.y, old.dx + 4, 2); old := new - END - UNTIL keys = {}; - InvertRect(F, new.x, new.y, new.dx + 4, 2); org := new.org - END TrackLine; - - PROCEDURE TrackWord* (F: Frame; VAR x, y: INTEGER; VAR pos: LONGINT; VAR keysum: SET); - VAR keys: SET; new, old: Location; - BEGIN - LocateWord(F, x, y, old); InvertRect(F, old.x, old.y, old.dx, 2); keysum := {}; - REPEAT TrackMouse(x, y, keys, keysum); LocateWord(F, x, y, new); - IF new.pos # old.pos THEN - InvertRect(F, new.x, new.y, new.dx, 2); InvertRect(F, old.x, old.y, old.dx, 2); old := new - END - UNTIL keys = {}; - InvertRect(F, new.x, new.y, new.dx, 2); pos := new.pos - END TrackWord; - - PROCEDURE TrackCaret* (F: Frame; VAR x, y: INTEGER; VAR keysum: SET); - VAR keys: SET; - BEGIN keysum := {}; - REPEAT TrackMouse(x, y, keys, keysum); SetCaret(F, Pos(F, x, y)) UNTIL keys = {} - END TrackCaret; - - PROCEDURE TrackSelection* (F: Frame; VAR x, y: INTEGER; VAR keysum: SET); - VAR keys: SET; pos: LONGINT; V: Viewers.Viewer; f: Frame; - BEGIN - V := Viewers.This(F.X, F.Y); V := V.next(Viewers.Viewer); - IF (V.dsc # NIL) & (V.dsc.next # NIL) & (V.dsc.next IS Frame) THEN f := V.dsc.next(Frame); - IF f.hasSel & (f.text = F.text) THEN - IF (f.selbeg.pos < f.trailer.org) & (f.org < f.selend.pos) & (f.selbeg.pos <= Pos(F, x, y)) THEN - SetSelection(F, f.selbeg.pos, Pos(F, x, y) + 1) - ELSE RemoveSelection(f); f := NIL - END - ELSE f := NIL - END - ELSE f := NIL - END; - IF f = NIL THEN - IF F.hasSel & (F.selbeg.pos + 1 = F.selend.pos) & (Pos(F, x, y) = F.selbeg.pos) THEN - SetSelection(F, F.selbeg.org, Pos(F, x, y) + 1) - ELSE SetSelection(F, Pos(F, x, y), Pos(F, x, y) + 1) - END - END; - keysum := {}; - REPEAT TrackMouse(x, y, keys, keysum); - IF F.hasSel THEN - pos := Pos(F, x, Min(y, F.selbeg.y)) + 1; - IF pos <= F.selbeg.pos THEN pos := F.selbeg.pos + 1 END; - SetSelection(F, F.selbeg.pos, pos); - IF f # NIL THEN SetSelection(f, f.selbeg.pos, pos); f.selend.pos := F.selend.pos END - ELSE SetSelection(F, Pos(F, x, y), Pos(F, x, y) + 1) - END - UNTIL keys = {}; - IF f # NIL THEN F.selbeg.pos := f.selbeg.pos END - END TrackSelection; - - PROCEDURE Call (F: Frame; pos: LONGINT; keysum: SET); - VAR S: Texts.Scanner; res, i, j: INTEGER; - BEGIN - Texts.OpenScanner(S, F.text, pos); Texts.Scan(S); - IF (S.class = Texts.Name) & (S.line = 0) THEN i := 0; - WHILE (i < S.len) & (S.s[i] # ".") DO INC(i) END; - j := i + 1; - WHILE (j < S.len) & (S.s[j] # ".") DO INC(j) END; - IF (j >= S.len) & (S.s[i] = ".") OR (rightKey IN keysum) THEN - par.vwr := Viewers.This(F.X, F.Y); - IF rightKey IN keysum THEN S.s:="Edit.Open"; par.pos := pos ELSE par.pos := pos + S.len END; - par.frame := F; par.text := F.text; Oberon.Call(S.s, par, keysum = {middleKey, leftKey}, res); - IF res > 0 THEN - Texts.WriteString(W0, "Call error: "); Texts.WriteString(W0, Modules.importing); - IF res = 1 THEN - Texts.WriteString(W0, " not found") - ELSIF res = 2 THEN - Texts.WriteString(W0, " not an obj-file") - ELSIF res = 3 THEN - Texts.WriteString(W0, " imports "); - Texts.WriteString(W0, Modules.imported); Texts.WriteString(W0, " with bad key"); - ELSIF res = 4 THEN - Texts.WriteString(W0, " corrupted obj file") - ELSIF res = 6 THEN - Texts.WriteString(W0, " has too many imports") - ELSIF res = 7 THEN - Texts.WriteString(W0, " not enough space") - END - ELSIF res < 0 THEN - INC(i); WHILE i < S.len DO Texts.Write(W0, S.s[i]); INC(i) END; - Texts.WriteString(W0, " not found") - END; - IF res # 0 THEN Texts.WriteLn(W0); Texts.Append(Oberon.Log, W0.buf) END - END - END - END Call; - - PROCEDURE PickAttributes (VAR W: Texts.Writer; T: Texts.Text; pos: LONGINT; font: Fonts.Font; col, voff: SHORTINT); - VAR R: Texts.Reader; ch: CHAR; - BEGIN - IF T.len > 0 THEN - IF pos < T.len THEN Texts.OpenReader(R, T, pos); Texts.Read(R, ch) END; - IF (pos > 0) & ((pos = T.len) OR (ch <= " ")) THEN - Texts.OpenReader(R, T, pos - 1); Texts.Read(R, ch) - END; - Texts.SetFont(W, R.fnt); Texts.SetColor(W, R.col); - IF (ch = CR) OR (ch = TAB) OR (ch = LF) THEN Texts.SetOffset(W, voff) ELSE Texts.SetOffset(W, R.voff) END - ELSE Texts.SetFont(W, font); Texts.SetColor(W, col); Texts.SetOffset(W, voff) - END - END PickAttributes; - - PROCEDURE ShiftBlock (F: Frame; delta: INTEGER); (* shift selected lines to left or right *) - VAR text: Texts.Text; pos, beg, end, time: LONGINT; select: SelectMsg; ch: CHAR; - BEGIN - Oberon.GetSelection(text, beg, end, time); - IF (time >= 0) & (text = F.text) THEN BegOfLine(F.text, beg, FALSE); pos := beg; - WHILE pos < end DO Texts.OpenReader(R, F.text, pos); Texts.Read(R, ch); - WHILE (R.elem # NIL) & (R.elem IS Parc) & (pos < end) DO Texts.Read(R, ch); INC(pos) END; - IF pos < end THEN - IF delta < 0 THEN - IF (ch <= " ") & (ch # CR) & (ch # Texts.ElemChar) THEN - Texts.Delete(F.text, pos, pos + 1); DEC(end) - END - ELSE - PickAttributes(W, text, pos, Oberon.CurFnt, Oberon.CurCol, Oberon.CurOff); - IF (ch <= " ") & (ch # CR) & (ch # Texts.ElemChar) THEN Texts.Write(W, ch) (* first char extension *) - ELSE Texts.Write(W, TAB) - END; - Texts.Insert(F.text, pos, W.buf); INC(end); INC(pos) - END; - Texts.OpenReader(R, F.text, pos); - REPEAT Texts.Read(R, ch) UNTIL R.eot OR (ch = CR); - pos := Texts.Pos(R) - END - END; - select.text := F.text; select.beg := beg; select.end := pos; select.time := Oberon.Time(); - Viewers.Broadcast(select) - END - END ShiftBlock; - - PROCEDURE Write (F: Frame; ch: CHAR; fnt: Fonts.Font; col, voff: SHORTINT); - VAR loc: Location; parc: Parc; org, pos, pbeg: LONGINT; i: INTEGER; ch0: CHAR; - buf: ARRAY 32 OF CHAR; - copy: Texts.CopyMsg; input: Oberon.InputMsg; - - PROCEDURE Visible(ch: CHAR): BOOLEAN; - VAR pat: Display.Pattern; dx, x, y, w, h: INTEGER; - BEGIN Display.GetChar(W.fnt.raster, ch, dx, x, y, w, h, pat); RETURN dx > 0 - END Visible; - - PROCEDURE InsertBuffer; - VAR i, j: INTEGER; ch: CHAR; - BEGIN i := 0; j := 0; ch := buf[i]; - WHILE ch # 0X DO - IF (ch = TAB) OR (ch = CR) OR (ch = " ") OR Visible(ch) THEN Texts.Write(W, ch); INC(j) END; - INC(i); ch := buf[i] - END; - IF j > 0 THEN Texts.Insert(F.text, pos, W.buf); INC(pos, LONG(j)) END - END InsertBuffer; - - PROCEDURE Flush; - VAR ch: CHAR; - BEGIN - WHILE Input.Available() > 0 DO Input.Read(ch) END - END Flush; - - BEGIN - IF F.hasSel & (ch = CRSL) THEN ShiftBlock(F, -1) - ELSIF F.hasSel & (ch = CRSR) THEN ShiftBlock(F, 1) - ELSIF F.hasCar THEN pos := F.carloc.pos; - IF (ch = DEL) & (pos > F.org) THEN DEC(pos); Texts.Delete(F.text, pos, pos + 1); Flush - ELSIF (ch = CRSL) & (pos > 0) THEN DEC(pos) - ELSIF (ch = CRSR) & (pos < F.text.len) THEN INC(pos) - ELSIF (ch = BRK) OR (ch = ShiftBRK) THEN - ParcBefore(F.text, pos, P, pbeg); P.handle(P, copy); parc := copy.e(Parc); - IF ch = BRK THEN EXCL(parc.opts, pageBreak) ELSE INCL(parc.opts, pageBreak) END; - PickAttributes(W, F.text, pos, fnt, col, voff); - Texts.WriteElem(W, parc); Texts.Insert(F.text, pos, W.buf); INC(pos) - ELSIF (ch = TAB) OR (ch = LF) OR (ch = CR) OR (ch >= " ") THEN - PickAttributes(W, F.text, pos, fnt, col, voff); - IF ch = LF THEN buf[0] := CR; i := 1; org := F.carloc.org; BegOfLine(F.text, org, FALSE); - Texts.OpenReader(R, F.text, org); - REPEAT Texts.Read(R, ch) UNTIL (R.elem = NIL) OR ~(R.elem IS Parc); - WHILE (Texts.Pos(R) <= pos) & (ch <= " ") & (ch # Texts.ElemChar) & (i < 31) DO - buf[i] := ch; INC(i); Texts.Read(R, ch) - END - ELSE buf[0] := ch; i := 1 - END; - WHILE (Input.Available() > 0) & (i < 31) & (ch >= " ") & (ch < DEL) DO Input.Read(buf[i]); INC(i) END; - buf[i] := 0X; InsertBuffer - END; - IF pos < F.org THEN Show(F, F.org - 1) - ELSIF pos < F.text.len THEN org := -1; - WHILE (pos >= F.trailer.org) & (pos > F.org) DO - org := F.trailer.next.next.org; IF org = F.org THEN INC(org) END; - ShowFrom(F, org); Flush - END - ELSE LocatePos(F, pos, loc); LocateChar(F, loc.x + 1, loc.y, loc); - IF pos # loc.pos THEN Show(F, F.trailer.next.next.org); Flush END - END; - SetCaret(F, pos) - ELSIF F.focus # NIL THEN input.id := Oberon.consume; input.ch := ch; - input.fnt := fnt; input.col := col; input.voff := voff; F.focus.handle(F.focus, input) - END - END Write; - - - PROCEDURE TouchElem (F: Frame; VAR x, y: INTEGER; VAR keysum: SET); - VAR loc: Location; e: Texts.Elem; pbeg: LONGINT; y0: INTEGER; - track: TrackMsg; - BEGIN - LocateChar(F, x, y, loc); e := R.elem; - IF (e # NIL) & (loc.x + e.W DIV Unit <= F.X + F.W - F.right) THEN - ParcBefore(F.text, loc.pos, P, pbeg); y0 := loc.y + loc.line.dsr - SHORT(P.dsr DIV Unit) + loc.dy; - IF (loc.x <= x) & (x < loc.x + e.W DIV Unit) & (keysum= {middleKey}) THEN - track.X := x; track.Y := y; track.keys := keysum; - track.fnt := R.fnt; track.col := R.col; track.pos := Texts.Pos(R) - 1; - track.frame := F; track.X0 := loc.x; track.Y0 := y0; - e.handle(e, track); keysum := {} - END - END - END TouchElem; - - - PROCEDURE Edit (F: Frame; x, y: INTEGER; keysum: SET); - VAR ef: Display.Frame; text: Texts.Text; beg, end, time, pos: LONGINT; keys: SET; ch: CHAR; - loc: Location; delta: INTEGER; copyover: Oberon.CopyOverMsg; input: Oberon.InputMsg; - BEGIN - IF x < F.X + F.barW THEN pos := F.org; (* scroll bar *) - IF leftKey IN keysum THEN TrackLine(F, x, y, pos, keysum) - ELSIF rightKey IN keysum THEN TrackLine(F, x, y, pos, keysum); LocateLine(F, y, loc); - pos := F.org; delta := loc.y - (F.Y + F.bot); Back(F, delta, pos) - ELSIF middleKey IN keysum THEN - REPEAT TrackMouse(x, y, keys, keysum) UNTIL keys = {}; - IF keysum = {middleKey, leftKey} THEN pos := F.text.len; (*BegOfLine(F.text, pos, TRUE);*) - Back(F, F.H - F.bot - F.top - 30 (*heuristic*), pos); - ELSIF keysum = {middleKey, rightKey} THEN pos := 0 - ELSIF (F.Y <= y) & (y <= F.Y + F.H) THEN pos := CoordToPos(F, y - F.Y); BegOfLine(F.text, pos, TRUE) - END - ELSE DrawCursor(x, y); keysum := cancel - END; - IF keysum # cancel THEN ShowFrom(F, pos) END - ELSE (* text area *) - ef := ThisSubFrame(F, x, y); - IF ef # NIL THEN (* within sub-frame *) - IF (F.focus # ef) & (keysum = {leftKey}) THEN - REPEAT TrackMouse(x, y, keys, keysum) UNTIL keys = {}; - IF keysum = {leftKey} THEN RemoveSelection(F); RemoveCaret(F); PassSubFocus(F, ef); RETURN END - ELSIF F.focus = ef THEN input.id := Oberon.track; input.keys := keysum; input.X := x; input.Y := y; - ef.handle(ef, input); RETURN - END - END; - IF keysum # {} THEN TouchElem(F, x, y, keysum); - IF keysum = {} THEN RETURN END - END; - IF leftKey IN keysum THEN Oberon.PassFocus(Viewers.This(F.X, F.Y)); TrackCaret(F, x, y, keysum); - IF (keysum = {leftKey, middleKey}) & F.hasCar THEN Oberon.GetSelection(text, beg, end, time); - IF time >= 0 THEN Texts.Save(text, beg, end, B); - Texts.Insert(F.text, F.carloc.pos, B); SetCaret(F, F.carloc.pos + (end - beg)) - END - ELSIF (keysum = {leftKey, rightKey}) & F.hasCar & (F.carloc.pos < F.text.len) THEN - Oberon.GetSelection(text, beg, end, time); - IF time >= 0 THEN Texts.OpenReader(R, F.text, F.carloc.pos); Texts.Read(R, ch); - Texts.ChangeLooks(text, beg, end, {0, 1, 2}, R.fnt, R.col, R.voff) - END - END - ELSIF middleKey IN keysum THEN TrackWord(F, x, y, pos, keysum); - IF keysum # cancel THEN Call(F, pos, keysum) END - ELSIF rightKey IN keysum THEN TrackSelection(F, x, y, keysum); - IF (keysum = {rightKey, middleKey}) & F.hasSel THEN - copyover.text := F.text; copyover.beg := F.selbeg.pos; copyover.end := F.selend.pos; - Oberon.FocusViewer.handle(Oberon.FocusViewer, copyover) - ELSIF (keysum = {rightKey, leftKey}) & F.hasSel THEN Oberon.PassFocus(Viewers.This(F.X, F.Y)); - Texts.Delete(F.text, F.selbeg.pos, F.selend.pos); SetCaret(F, F.selbeg.pos) - END - ELSE DrawCursor(x, y) - END - END - END Edit; - - - (** General **) - - - PROCEDURE Copy (SF, DF: Frame); - BEGIN - DF.handle := SF.handle; DF.text := SF.text; DF.org := SF.org; - DF.col := SF.col; DF.left := SF.left; DF.right := SF.right; DF.top := SF.top; DF.bot := SF.bot; - DF.barW := SF.barW; DF.hasCar := FALSE; DF.hasSel := FALSE; DF.showsParcs := SF.showsParcs; - DF.focus := NIL; DF.trailer := NIL - END Copy; - - PROCEDURE Handle* (f: Display.Frame; VAR msg: Display.FrameMsg); - VAR F, F1: Frame; pos: LONGINT; - BEGIN F := f(Frame); - IF msg IS Oberon.InputMsg THEN - WITH msg: Oberon.InputMsg DO - IF msg.id = Oberon.consume THEN Write(F, msg.ch, msg.fnt, msg.col, msg.voff) - ELSIF msg.id = Oberon.track THEN Edit(F, msg.X, msg.Y, msg.keys) - END - END - ELSIF msg IS Oberon.ControlMsg THEN - WITH msg: Oberon.ControlMsg DO - IF msg.id = Oberon.defocus THEN RemoveCaret(F) - ELSIF msg.id = Oberon.neutralize THEN - RemoveCaret(F); RemoveSelection(F); PassSubFocus(F, NIL); NotifySubFrames(F, msg) - ELSE NotifySubFrames(F, msg) - END - END - ELSIF msg IS Oberon.CopyMsg THEN - WITH msg: Oberon.CopyMsg DO - IF msg.F = NIL THEN NEW(F1); msg.F := F1 END; - Copy(F, msg.F(Frame)) - END - ELSIF msg IS UpdateMsg THEN NotifySubFrames(F, msg); - WITH msg: UpdateMsg DO - IF msg.text = F.text THEN Update(F, msg) END - END - ELSIF msg IS InsertElemMsg THEN - IF F.hasCar THEN pos := F.carloc.pos; - PickAttributes(W, F.text, pos, Oberon.CurFnt, Oberon.CurCol, Oberon.CurOff); - Texts.WriteElem(W, msg(InsertElemMsg).e); - Texts.Insert(F.text, pos, W.buf); - SetCaret(F, pos + 1) - END - ELSIF msg IS Oberon.SelectionMsg THEN NotifySubFrames(F, msg); - WITH msg: Oberon.SelectionMsg DO - IF F.hasSel & (F.time > msg.time) THEN - msg.text := F.text; msg.beg := F.selbeg.pos; msg.end := F.selend.pos; msg.time := F.time - END - END - ELSIF msg IS Oberon.CopyOverMsg THEN NotifySubFrames(F, msg); - WITH msg: Oberon.CopyOverMsg DO - IF F.hasCar THEN Texts.Save(msg.text, msg.beg, msg.end, B); - Texts.Insert(F.text, F.carloc.pos, B); SetCaret(F, F.carloc.pos + (msg.end - msg.beg)) - END - END - ELSIF msg IS MenuViewers.ModifyMsg THEN - WITH msg: MenuViewers.ModifyMsg DO - F.handle(F, neutralize); Resize(F, F.X, msg.Y, F.W, msg.H) - END - ELSIF msg IS SelectMsg THEN NotifySubFrames(F, msg); - WITH msg: SelectMsg DO - IF (msg.text = F.text) & ~F.hasSel THEN Oberon.RemoveMarks(F.X, F.Y, F.W, F.H); - F.handle(F, neutralize); - SetSelection(F, msg.beg, msg.end); F.time := msg.time; - IF F.hasSel THEN F.selbeg.pos := msg.beg; F.selend.pos := msg.end END - END - END - ELSE NotifySubFrames(F, msg) - END - END Handle; - - - PROCEDURE Open* (F: Frame; T: Texts.Text; pos: LONGINT); - BEGIN - F.handle := Handle; F.text := T; F.org := pos; F.col := Display.black; - F.left := left; F.right := right; F.top := top; F.bot := bot; - F.barW := barW; F.hasCar := FALSE; F.hasSel := FALSE; F.showsParcs := FALSE; F.trailer := NIL - END Open; - - - PROCEDURE NotifyDisplay* (T: Texts.Text; op: INTEGER; beg, end: LONGINT); - VAR msg: UpdateMsg; - BEGIN - msg.text := T; msg.id := op; msg.beg := beg; msg.end := end; Viewers.Broadcast(msg) - END NotifyDisplay; - - PROCEDURE Text* (name: ARRAY OF CHAR): Texts.Text; - VAR text: Texts.Text; - BEGIN - NEW(text); Texts.Open(text, name); text.notify := NotifyDisplay; RETURN text - END Text; - - PROCEDURE NewText* (T: Texts.Text; pos: LONGINT): Frame; - VAR frame: Frame; - BEGIN - NEW(frame); Open(frame, T, pos); - RETURN frame - END NewText; - - PROCEDURE NewMenu* (name, commands: ARRAY OF CHAR): Frame; - VAR T: Texts.Text; frame: Frame; - BEGIN - T := Text(""); - Texts.WriteString(W0, name); Texts.WriteString(W0, " | "); Texts.WriteString(W0, commands); - Texts.Append(T, W0.buf); - NEW(frame); Open(frame, T, 0); - frame.col := Display.white; frame.left := 6; frame.top := 0; frame.bot := 0; frame.barW := 0; - RETURN frame - END NewMenu; - -BEGIN - Texts.OpenWriter(W); Texts.OpenWriter(W0); - Texts.SetFont(W0, Fonts.Default); Texts.SetColor(W0, Display.white); Texts.SetOffset(W0, 0); - neutralize.id := Oberon.neutralize; - NEW(par); - NEW(B); Texts.OpenBuf(B); - menuH := Fonts.Default.height + 2; - barW := 14; left := barW + 6; right := 8; top := 6; bot := 6; - Oberon.Log := Text(""); - InitDefParc -END TextFrames. diff --git a/voc.REMOVED.git-id b/voc.REMOVED.git-id index 2973060c..df30639e 100644 --- a/voc.REMOVED.git-id +++ b/voc.REMOVED.git-id @@ -1 +1 @@ -6f1a5b8457e70e043eab08632b20cf5a4f13f80b \ No newline at end of file +685238d2fdf5c7fca23acb75dba7cff77f0eef8c \ No newline at end of file