From 8a0e5a60cb86b9f7b59199040e01fd5a03f69b22 Mon Sep 17 00:00:00 2001 From: Paul Kimpel Date: Sat, 16 Jul 2016 17:47:15 -0700 Subject: [PATCH] 1. Commit proofreading corrections to PASCAL.PATCHES.card. 2. Commit listings and updated compiler source from running PASCAL.PATCHES.card under Mark XV system software. See README.txt for details. 3. Minor change to HMMS2.TEST.card and .lst to reflect symmetry in the chimney temperature profile. --- PASCAL-Heriot-Watt/HMSS2.TEST.card | 3 + PASCAL-Heriot-Watt/HMSS2.TEST.lst | 1459 +--- PASCAL-Heriot-Watt/PASCAL.MKXV-Compile.lst | 3805 +++++++++ .../PATCHES.PASCAL.MKXV-Compile.lst | 7255 +++++++++++++++++ PASCAL-Heriot-Watt/PATCHES.PASCAL.card | 464 +- PASCAL-Heriot-Watt/README.txt | 66 +- PASCAL-Heriot-Watt/SYMNEW.PASCAL.alg_m | 4243 ++++++++++ 7 files changed, 15827 insertions(+), 1468 deletions(-) create mode 100644 PASCAL-Heriot-Watt/PASCAL.MKXV-Compile.lst create mode 100644 PASCAL-Heriot-Watt/PATCHES.PASCAL.MKXV-Compile.lst create mode 100644 PASCAL-Heriot-Watt/SYMNEW.PASCAL.alg_m diff --git a/PASCAL-Heriot-Watt/HMSS2.TEST.card b/PASCAL-Heriot-Watt/HMSS2.TEST.card index 3635074..380d1da 100644 --- a/PASCAL-Heriot-Watt/HMSS2.TEST.card +++ b/PASCAL-Heriot-Watt/HMSS2.TEST.card @@ -171,6 +171,9 @@ FOR J:= 0 TO YMAX DO WRITE (J:4, " "); FOR I:= 0 TO XMAX DO WRITE (CODE[TRUNC(T[I,J]/20)]); + (* REFLECT SYMMETRY OF RIGHT HALF OF CHIMNEY *) + FOR I:= XMAX-1 DOWNTO 0 DO + WRITE (CODE[TRUNC(T[I,J]/20)]); WRITELN; END (*FOR J*); diff --git a/PASCAL-Heriot-Watt/HMSS2.TEST.lst b/PASCAL-Heriot-Watt/HMSS2.TEST.lst index 8ef73dc..7817732 100644 --- a/PASCAL-Heriot-Watt/HMSS2.TEST.lst +++ b/PASCAL-Heriot-Watt/HMSS2.TEST.lst @@ -1,10 +1,10 @@ - LABEL 000000000LINES 00186183?RUN PASCAL/DISK PASCAL /DISK + LABEL 000000000LINES 00186197?RUN PASCAL/DISK PASCAL /DISK - PASCAL(2.3)/B-5700 02/07/86 18:20 PAGE 1 + PASCAL(2.3)/B-5700 16/07/86 12:57 PAGE 1 00001=> (*$L+,C-,A+*) 00002=> PROGRAM HMSS2 (OUTPUT); @@ -64,7 +64,7 @@ 00056=> (*--------------------------------------------------------------------*) - PASCAL(2.3)/B-5700 02/07/86 18:20 PAGE 2 + PASCAL(2.3)/B-5700 16/07/86 12:57 PAGE 2 00057=> BEGIN (*HMSS*) B2 00058=> ET:= TIME; @@ -124,7 +124,7 @@ 00112=> (XNUTAIR + 0.5 * (2.0 * T[I,1] + T[I+1,0] + T[I-1,0])) / - PASCAL(2.3)/B-5700 02/07/86 18:20 PAGE 3 + PASCAL(2.3)/B-5700 16/07/86 12:57 PAGE 3 00113=> (XNU + 2.0)); 00114=> @@ -184,19 +184,22 @@ 00168=> BEGIN B7 - PASCAL(2.3)/B-5700 02/07/86 18:20 PAGE 4 + PASCAL(2.3)/B-5700 16/07/86 12:57 PAGE 4 00169=> WRITE (J:4, " "); 00170=> FOR I:= 0 TO XMAX DO 00171=> WRITE (CODE[TRUNC(T[I,J]/20)]); -00172=> -00173=> WRITELN; -00174=> END (*FOR J*); E7 +00172=> (* REFLECT SYMMETRY OF RIGHT HALF OF CHIMNEY *) +00173=> FOR I:= XMAX-1 DOWNTO 0 DO +00174=> WRITE (CODE[TRUNC(T[I,J]/20)]); 00175=> -00176=> WRITELN; -00177=> WRITELN (" TIMES: ET=", (TIME-ET):8:2, ", PT=", ELAPSED:8:2, -00178=> ", IO=", IOTIME:8:2); -00179=> END (*HMSS*). E2 +00176=> WRITELN; +00177=> END (*FOR J*); E7 +00178=> +00179=> WRITELN; +00180=> WRITELN (" TIMES: ET=", (TIME-ET):8:2, ", PT=", ELAPSED:8:2, +00181=> ", IO=", IOTIME:8:2); +00182=> END (*HMSS*). E2 @@ -205,1144 +208,145 @@ NO ERRORS DETECTED. + LABEL 000000000LINES 00186197?RUN PASCAL/DISK PASCAL /DISK - LABEL 000000000LINES 00186183?RUN PASCAL/DISK PASCAL /DISK + LABEL 0XALGOL 0COMPILE00186197CC USER=0000000; COMPILE HMSS2/0000000 XALGOL ;XALGOL FILE CARD=PASC00 XALGOL /HMSS2 - + BURROUGHS B-5700 XALGOL COMPILER MARK XV.3.00 WEDNESDAY, 07/16/86, 12:57 PM. - LABEL 0XALGOL 0COMPILE00186183CC USER=0000000; COMPILE HMSS2/0000000 XALGOL ;XALGOL FILE CARD=PASC85 XALGOL /HMSS2 + HMSS2 /0000000 + =============== - - - - BURROUGHS B-5700 XALGOL COMPILER MARK XIII.0 WEDNESDAY, 07/02/86, 6:20 PM. - - - - - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00000000 0000 - - % % 00000000 0000 - - % THE PASCAL RUN TIME-SYSTEM. % 00000000 0000 - - % --------------------------- % 00000000 0000 - - % % 00000000 0000 - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00000000 0000 - - BEGIN% 00000000 0000 - - START OF SEGMENT ********** 2 - - INTEGER V00167,V00168,V00169;% 00000000 0000 - - FILE INPUT "INPUT" (2,10);% 00000000 0000 - - FILE OUTPUT 1 (2,17);% 00000000 0003 - - % 00000000 0007 - - DEFINE PROCEDU =PROCEDURE#,% 00000000 0007 - - FUNCTN =REAL PROCEDURE#,% 00000000 0007 - - DOWNTO =STEP -1 UNTIL#,% 00000000 0007 - - UPTO =STEP 1 UNTIL#,% 00000000 0007 - - B =BOOLEAN#,% 00000000 0007 - - F00603 =INPUT#,% 00000000 0007 - - F00742 =OUTPUT#,% 00000000 0007 - - LASTCH =[5:6]#,% 00000000 0007 - - BUFSIZE =[13:8]#,% 00000000 0007 - - BUFPNT =[21:8]#,% 00000000 0007 - - EOF =[22:1]#,% 00000000 0007 - - EOLN =[23:1]#,% 00000000 0007 - - INP =[24:1]#,% 00000000 0007 - - OUTP =[25:1]#,% 00000000 0007 - - ENDFOUND=[26:1]#,% 00000000 0007 - - MEMSIZE =10000#,% 00000000 0007 - - MAXINT =549755813887#;% 00000000 0007 - - % 00000000 0007 - - ARRAY MEM[0:MEMSIZE DIV 1022,0:1022], TEXT,CHAR[0:0], TEMPTEXT[0:19],% 00000000 0007 - - V00603[0:9], V00742[0:16];% 00000000 0014 - - INTEGER MEMPNT,T,T1,I00603,I00742;% 00000000 0017 - - POINTER CHARPNT,TEXTPNT;% 00000000 0017 - - LABEL TERMINATE;% 00000000 0017 - - FORMAT TERMMESS ("**** PROGRAM EXECUTION TERMINATED AT LINE ",I*,"."),% 00000000 0017 - - START OF SEGMENT ********** 3 - - CHECKERR ("**** THE VALUE ",I*," IS NOT IN THE RANGE ",I*,"..",% 00000000 0017 - - I*,"."),% 00000000 0017 - - ERRMARK (X*,"|"),% 00000000 0017 - - CONCATERR("**** CONCAT ERROR: [",I*,":",I*,":",I*,"]"),% 00000000 0017 - - ILLEGALCC("**** ILLEGAL CARRIAGE CONTROL CHARACTER:"""",I7,""");% 00000000 0017 - - 3 IS 58 LONG, NEXT SEG 2 - - SWITCH FORMAT ERRMESS :=% 00000000 0017 - - START OF SEGMENT ********** 4 - - (),% 00000000 0017 - - ("**** NO READING WHILE EOF IS TRUE."), %1 00000000 0017 - - ("**** NO WRITING WHILE EOF IS FALSE."), %2 00000000 0017 - - ("**** ILLEGAL CHARACTER,"), %3 00000000 0017 - - ("**** OVERFLOW ERROR."), %4 00000000 0017 - - ("**** NO RESET/REWRITE ON INPUT/OUTPUT."), %5 00000000 0017 - - ("**** LINE IMAGE OVERFLOW."); %6 00000000 0017 - - 4 IS 60 LONG, NEXT SEG 2 - - MONITOR EXPOVR:=REALOVERFLOW;% 00000000 0017 - - % 00000000 0020 - - INTEGER PROCEDURE NUMDIGITS(N);% 00000000 0020 - - VALUE N; INTEGER N;% 00000000 0022 - - NUMDIGITS:=IF N<0 THEN 1+NUMDIGITS(-N) ELSE% 00000000 0022 - - IF N>9 THEN 1+NUMDIGITS(N DIV 10) ELSE 1;% 00000000 0025 - - % 00000000 0032 - - PROCEDURE RUNERR(ERRNUM,LINENUM); %*** RUN TIME ERROR *** 00000000 0032 - - VALUE ERRNUM,LINENUM;% 00000000 0032 - - INTEGER ERRNUM,LINENUM;% 00000000 0032 - - BEGIN% 00000000 0032 - - WRITE(OUTPUT,ERRMESS[ERRNUM]);% 00000000 0032 - - WRITE(OUTPUT,TERMMESS,NUMDIGITS(LINENUM),LINENUM);% 00000000 0036 - - GO TO TERMINATE;% 00000000 0046 - - END OF RUNNER;% 00000000 0048 - - % 00000000 0051 - - INTEGER PROCEDURE CHECK(VAL,LIM1,LIM2,LINENUM);% 00000000 0051 - - VALUE VAL,LIM1,LIM2,LINENUM;% 00000000 0051 - - INTEGER VAL,LIM1,LIM2,LINENUM;% 00000000 0051 - - BEGIN% 00000000 0051 - - IF VALLIM2 THEN% 00000000 0051 - - BEGIN WRITE(OUTPUT,CHECKERR,NUMDIGITS(VAL),VAL,NUMDIGITS(LIM1),% 00000000 0053 - - LIM1,NUMDIGITS(LIM2),LIM2);% 00000000 0064 - - RUNERR(4,LINENUM);% 00000000 0072 - - END;% 00000000 0073 - - CHECK:=VAL;% 00000000 0073 - - END OF CHECK;% 00000000 0074 - - % 00000000 0077 - - ALPHA PROCEDURE CURDAT;% 00000000 0077 - - CURDAT:=" "&TIME(5)[41:35:36];% 00000000 0077 - - % 00000000 0082 - - ALPHA PROCEDURE WEEKDA;% 00000000 0082 - - WEEKDA:=TIME(6)&" "[41:5:6];% 00000000 0082 - - % 00000000 0087 - - INTEGER PROCEDURE TRUNC(X,LINENUM);% 00000000 0087 - - VALUE X,LINENUM;% 00000000 0087 - - REAL X; INTEGER LINENUM;% 00000000 0087 - - BEGIN% 00000000 0087 - - IF ABS(X)>MAXINT THEN RUNERR(4,LINENUM);% 00000000 0087 - - TRUNC:=IF X<0 THEN -ENTIER(-X) ELSE ENTIER(X);% 00000000 0089 - - END OF TRUNC;% 00000000 0094 - - % 00000000 0100 - - INTEGER PROCEDURE ROUND(X,LINENUM);% 00000000 0100 - - VALUE X,LINENUM;% 00000000 0100 - - REAL X; INTEGER LINENUM;% 00000000 0100 - - BEGIN% 00000000 0100 - - IF ABS(X)>MAXINT THEN RUNERR(4,LINENUM);% 00000000 0100 - - ROUND:=X;% 00000000 0102 - - END OF ROUND;% 00000000 0103 - - % 00000000 0107 - - BOOLEAN PROCEDURE ODD(N);% 00000000 0107 - - VALUE N; INTEGER N;% 00000000 0107 - - ODD:=N MOD 2 = 1;% 00000000 0107 - - % 00000000 0112 - - REAL PROCEDURE SQR(X,LINENUM);% 00000000 0112 - - VALUE X,LINENUM;% 00000000 0112 - - REAL X; INTEGER LINENUM;% 00000000 0112 - - BEGIN% 00000000 0112 - - IF ABS(X)>2.0769187@34 THEN RUNERR(4,LINENUM);% 00000000 0112 - - SQR:=X|X;% 00000000 0114 - - END OF SQR;% 00000000 0115 - - % 00000000 0120 - - BOOLEAN PROCEDURE INCL1(A,B); %*** IS THE SET "A" INCLUDED 00000000 0120 - - VALUE A,B; REAL A,B; %*** IN THE SET "B". 00000000 0120 - - INCL1:=REAL(BOOLEAN(A) AND NOT BOOLEAN(B))=0;% 00000000 0120 - - % 00000000 0125 - - BOOLEAN PROCEDURE INCL2(A,B); %*** IS THE SET "B" INCLUDED 00000000 0125 - - VALUE A,B; REAL A,B; %*** IN THE SET "A". 00000000 0125 - - INCL2:=REAL(BOOLEAN(B) AND NOT BOOLEAN(A))=0;% 00000000 0125 - - % 00000000 0130 - - BOOLEAN PROCEDURE INTST(A,B); %*** IS THE VALUE "A" AN ELEMENT 00000000 0130 - - VALUE A,B; REAL A,B; %*** IN THE SET "B". 00000000 0130 - - INTST:=IF A<0 OR B>38 THEN FALSE ELSE 0&B[0:38-A:1]=1;% 00000000 0130 - - % 00000000 0140 - - PROCEDURE NEW(P,SIZE);% 00000000 0140 - - VALUE SIZE; REAL P; INTEGER SIZE;% 00000000 0140 - - BEGIN% 00000000 0140 - - P:=IF MEMPNT+SIZE>MEMSIZE THEN 0 ELSE MEMPNT;% 00000000 0140 - - MEMPNT:=MEMPNT+SIZE;% 00000000 0143 - - END OF NEW;% 00000000 0144 - - % 00000000 0146 - - PROCEDURE DISPOSE(P,SIZE);% 00000000 0146 - - VALUE SIZE; REAL P; INTEGER SIZE;% 00000000 0146 - - BEGIN% 00000000 0146 - - END OF DISPOSE;% 00000000 0146 - - % 00000000 0146 - - PROCEDURE PACK(A,LLIM,ULIM,I,Z,LINENUM);% 00000000 0146 - - VALUE LLIM,ULIM,I,LINENUM;% 00000000 0146 - - ARRAY A[*]; ALPHA Z;% 00000000 0146 - - INTEGER LLIM,ULIM,I,LINENUM;% 00000000 0146 - - BEGIN;% 00000000 0146 - - Z:=0;% 00000000 0147 - - FOR T1:=0 STEP 1 UNTIL 6 DO% 00000000 0148 - - Z:=A[CHECK(I+T1,LLIM,ULIM,LINENUM)] & Z [41:35:36];% 00000000 0149 - - END;% 00000000 0155 - - % 00000000 0156 - - PROCEDURE UNPACK(Z,A,LLIM,ULIM,I,LINENUM);% 00000000 0156 - - VALUE Z,LLIM,ULIM,I,LINENUM;% 00000000 0156 - - ARRAY A[*]; ALPHA Z;% 00000000 0156 - - INTEGER LLIM,ULIM,I,LINENUM;% 00000000 0156 - - FOR T1:=0 STEP 1 UNTIL 6 DO% 00000000 0156 - - A[CHECK(I+T1,LLIM,ULIM,LINENUM)]:= 0 & Z [5:41-6|T1:6];% 00000000 0157 - - % 00000000 0166 - - REAL PROCEDURE CONCAT(A,B,AS,BS,N,LINENUM);% 00000000 0166 - - VALUE A,B,AS,BS,N,LINENUM;% 00000000 0166 - - REAL A,B; INTEGER AS,BS,N,LINENUM;% 00000000 0166 - - BEGIN% 00000000 0166 - - IF AS<1 OR BS<1 OR N<0 OR AS+N>48 OR BS+N>48 THEN% 00000000 0166 - - BEGIN% 00000000 0172 - - WRITE(OUTPUT,CONCATERR,NUMDIGITS(AS),AS,NUMDIGITS(BS),% 00000000 0173 - - BS,NUMDIGITS(N),N);% 00000000 0183 - - RUNERR(0,LINENUM);% 00000000 0191 - - END;% 00000000 0192 - - CONCAT:=A & B [47-AS:47-BS:N];% 00000000 0192 - - END OF CONCAT;% 00000000 0197 - - % 00000000 0200 - - BOOLEAN PROCEDURE BIT(N,LINENUM);% %*** SET BIT NO "N" IN A WORD. 00000000 0200 - - VALUE N,LINENUM; INTEGER N,LINENUM;% 00000000 0200 - - BIT:=BOOLEAN(0 & 1 [38-CHECK(N,0,38,LINENUM):0:1]);% 00000000 0200 - - % 00000000 0208 - - BOOLEAN PROCEDURE BITS(N1,N2,LINENUM); %*** SET BITS "N1".."N2". 00000000 0208 - - VALUE N1,N2,LINENUM;% 00000000 0208 - - INTEGER N1,N2,LINENUM;% 00000000 0208 - - BITS:=BOOLEAN(0 & 3"7777777777777" [38-CHECK(N1,0,38,LINENUM):38:% 00000000 0208 - - CHECK(N2,0,38,LINENUM)-N1+1]);% 00000000 0211 - - % 00000000 0219 - - PROCEDURE RLINE(F,BUF,INFO);% 00000000 0219 - - FILE F; ARRAY BUF[0]; INTEGER INFO;% 00000000 0219 - - BEGIN% 00000000 0219 - - LABEL ENDFILE;% 00000000 0219 - - START OF SEGMENT ********** 5 - - INFO.EOLN:=0; INFO.BUFPNT:=1;% 00000000 0000 - - READ(F,999,BUF[*]) [ENDFILE];% 00000000 0004 - - REPLACE CHARPNT BY POINTER(BUF[*]) FOR 1;% 00000000 0009 - - INFO.LASTCH:=CHAR[0];% 00000000 0013 - - IF FALSE THEN% 00000000 0015 - - BEGIN ENDFILE: INFO.ENDFOUND:=1;% 00000000 0015 - - END;% 00000000 0019 - - END OF RLINE;% 00000000 0019 - - 5 IS 24 LONG, NEXT SEG 2 - - % 00000000 0219 - - REAL PROCEDURE PREAD(F,BUF,INFO,MODE,LINENUM);% 00000000 0219 - - VALUE MODE,LINENUM;% 00000000 0219 - - FILE F; ARRAY BUF[0];% 00000000 0219 - - INTEGER INFO,MODE,LINENUM;% 00000000 0219 - - BEGIN% 00000000 0219 - - DEFINE GETCHAR=% 00000000 0219 - - START OF SEGMENT ********** 6 - - BEGIN% 00000000 0000 - - IF BOOLEAN(INFO.EOLN) THEN% 00000000 0000 - - BEGIN% 00000000 0000 - - RLINE(F,BUF,INFO); CH:=INFO.LASTCH;% 00000000 0000 - - END ELSE% 00000000 0000 - - IF INFO.BUFPNT=INFO.BUFSIZE THEN% 00000000 0000 - - BEGIN CH:=" "; INFO.EOLN:=1 END ELSE% 00000000 0000 - - BEGIN% 00000000 0000 - - REPLACE CHARPNT BY POINTER(BUF[*])+INFO.BUFPNT FOR 1;% 00000000 0000 - - CH:=CHAR[0]; INFO.BUFPNT:=INFO.BUFPNT+1;% 00000000 0000 - - END END OF GETCHAR#;% 00000000 0000 - - % 00000000 0000 - - DEFINE READERR(ERRNUM)=% 00000000 0000 - - BEGIN% 00000000 0000 - - WRITE(OUTPUT,999,BUF[*]);% 00000000 0000 - - WRITE(OUTPUT,ERRMARK,INFO.BUFPNT-1);% 00000000 0000 - - RUNERR(ERRNUM,LINENUM);% 00000000 0000 - - END READERR#;% 00000000 0000 - - % 00000000 0000 - - REAL RES; ALPHA CH;% 00000000 0000 - - BOOLEAN NEGATIVE,NEGEXP; INTEGER POWER,EXP;% 00000000 0000 - - LABEL OVERFLOW,RETURN;% 00000000 0000 - - % 00000000 0000 - - IF BOOLEAN(INFO.EOF) THEN RUNERR(1,LINENUM);% 00000000 0000 - - IF BOOLEAN(INFO.ENDFOUND) THEN% 00000000 0002 - - BEGIN% 00000000 0003 - - INFO.EOF:=1; PREAD:=0;% 00000000 0003 - - GO TO RETURN;% 00000000 0006 - - END;% 00000000 0007 - - IF MODE=1 THEN %*** MODE = CHAR *** 00000000 0007 - - BEGIN% 00000000 0007 - - PREAD:=INFO.LASTCH; GETCHAR; INFO.LASTCH:=CH;% 00000000 0008 - - END ELSE% 00000000 0032 - - BEGIN %*** MODE = REAL/INTEGER *** 00000000 0032 - - CH:=INFO.LASTCH;% 00000000 0033 - - WHILE CH=" " AND NOT BOOLEAN(INFO.ENDFOUND) DO GETCHAR;% 00000000 0034 - - IF BOOLEAN(INFO.ENDFOUND) THEN% 00000000 0058 - - BEGIN% 00000000 0059 - - INFO.EOF:=1; PREAD:=0;% 00000000 0059 - - GO TO RETURN;% 00000000 0062 - - END;% 00000000 0063 - - IF CH="+" OR CH="-" THEN BEGIN NEGATIVE:=CH="-"; GETCHAR END;% 00000000 0063 - - IF CH>9 THEN READERR(3);% 00000000 0087 - - RES:=CH; GETCHAR;% 00000000 0104 - - WHILE CH{9 DO BEGIN RES:=10|RES+CH; GETCHAR END;% 00000000 0126 - - IF MODE=3 THEN % MODE = REAL. 00000000 0150 - - BEGIN% 00000000 0151 - - IF CH="." THEN% 00000000 0151 - - BEGIN% 00000000 0152 - - GETCHAR; IF CH>9 THEN READERR(3);% 00000000 0153 - - WHILE CH{9 DO BEGIN RES:=10|RES+CH;POWER:=POWER-1;GETCHAR END; 00000000 0190 - - END;% 00000000 0215 - - IF CH="E" THEN% 00000000 0216 - - BEGIN% 00000000 0216 - - GETCHAR;% 00000000 0217 - - IF CH="+" OR CH="-" THEN BEGIN NEGEXP:=CH="-"; GETCHAR END;% 00000000 0238 - - IF CH>9 THEN READERR(3);% 00000000 0262 - - WHILE CH{9 DO BEGIN EXP:=10|EXP+CH; GETCHAR END;% 00000000 0279 - - IF NEGEXP THEN EXP:=-EXP;% 00000000 0303 - - END;% 00000000 0305 - - POWER:=POWER+EXP;% 00000000 0305 - - REALOVERFLOW:=OVERFLOW; RES:=RES|10*POWER;% 00000000 0306 - - IF FALSE THEN OVERFLOW: READERR(4);% 00000000 0311 - - REALOVERFLOW:=0;% 00000000 0328 - - END ELSE IF RES>MAXINT THEN READERR(4);% 00000000 0329 - - PREAD:=IF NEGATIVE THEN -RES ELSE RES;% 00000000 0346 - - INFO.LASTCH:=CH;% 00000000 0348 - - END;% 00000000 0351 - - RETURN:% 00000000 0351 - - END OF PREAD;% 00000000 0351 - - 6 IS 357 LONG, NEXT SEG 2 - - % 00000000 0219 - - % 00000000 0219 - - PROCEDURE WLINE(F,BUF,INFO); %*** PRINT A LINE.*** 00000000 0219 - - FILE F; ARRAY BUF[0]; INTEGER INFO;% 00000000 0219 - - BEGIN% 00000000 0219 - - ALPHA CC;% 00000000 0219 - - START OF SEGMENT ********** 7 - - IF BOOLEAN(INFO.OUTP) THEN% 00000000 0000 - - BEGIN% 00000000 0000 - - REPLACE CHARPNT BY POINTER(BUF[*]) FOR 1; CC:=CHAR[0];% 00000000 0001 - - REPLACE POINTER(BUF[*]) BY " ";% 00000000 0005 - - IF CC=" " THEN WRITE(OUTPUT,999,BUF[*]) ELSE% 00000000 0009 - - IF CC="+" THEN WRITE(OUTPUT[NO],999,BUF[*]) ELSE% 00000000 0015 - - BEGIN% 00000000 0021 - - IF CC="0" THEN WRITE(OUTPUT) ELSE% 00000000 0021 - - IF CC="-" THEN WRITE(OUTPUT[DBL]) ELSE% 00000000 0026 - - IF CC="1" THEN WRITE(OUTPUT[PAGE]) ELSE% 00000000 0032 - - WRITE(OUTPUT,ILLEGALCC,CC);% 00000000 0038 - - WRITE(OUTPUT,999,BUF[*]);% 00000000 0046 - - END;% 00000000 0050 - - END ELSE WRITE(F,999,BUF[*]);% 00000000 0050 - - REPLACE POINTER(BUF[*]) BY " " FOR INFO.BUFSIZE;% 00000000 0055 - - INFO.BUFPNT:=0;% 00000000 0059 - - END OF WLINE;% 00000000 0062 - - 7 IS 65 LONG, NEXT SEG 2 - - % 00000000 0219 - - % 00000000 0219 - - PROCEDURE CHFIL(F);% 00000000 0219 - - FILE F;% 00000000 0219 - - BEGIN% 00000000 0219 - - ARRAY A[0:6];% 00000000 0219 - - START OF SEGMENT ********** 8 - - SEARCH(F,A[*]);% 00000000 0001 - - IF A[0]=-1 THEN% 00000000 0003 - - BEGIN% 00000000 0004 - - F.AREAS := 20;% 00000000 0005 - - F.AREASIZE := 300;% 00000000 0007 - - END;% 00000000 0010 - - END OF CHFIL;% 00000000 0010 - - 8 IS 16 LONG, NEXT SEG 2 - - % 00000000 0219 - - % 00000000 0219 - - PROCEDURE WALFA(F,BUF,INFO,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,ALENG, 00000000 0219 - - LINENUM);% 00000000 0219 - - VALUE A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,ALENG,LINENUM;% 00000000 0219 - - FILE F; ARRAY BUF[0]; INTEGER INFO,ALENG,LINENUM;% 00000000 0219 - - ALPHA A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12;% 00000000 0219 - - BEGIN% 00000000 0219 - - ALPHA A; POINTER PNT;% 00000000 0219 - - START OF SEGMENT ********** 9 - - LABEL EXIT;% 00000000 0000 - - IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00000000 0000 - - IF INFO.BUFPNT+ALENG}INFO.BUFSIZE THEN WLINE(F,BUF,INFO);% 00000000 0002 - - PNT:=POINTER(BUF[*])+INFO.BUFPNT;% 00000000 0007 - - INFO.BUFPNT:=INFO.BUFPNT+ALENG;% 00000000 0011 - - FOR A:=A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12 DO% 00000000 0014 - - BEGIN% 00000000 0039 - - TEXT[0]:=A;% 00000000 0039 - - REPLACE PNT:PNT BY TEXTPNT FOR MIN(ALENG,7);% 00000000 0040 - - ALENG:=ALENG-7; IF ALENG{0 THEN GO TO EXIT;% 00000000 0045 - - END;% 00000000 0047 - - EXIT:% 00000000 0048 - - END OF WALFA;% 00000000 0049 - - 9 IS 53 LONG, NEXT SEG 2 - - % 00000000 0219 - - % 00000000 0219 - - PROCEDURE PWRITE(F,BUF,INFO,E,EMODE,M,N,LINENUM);% 00000000 0219 - - VALUE E,EMODE,M,N,LINENUM;% 00000000 0219 - - FILE F; ARRAY BUF[0]; REAL E;% 00000000 0219 - - INTEGER INFO,EMODE,M,N,LINENUM;% 00000000 0219 - - BEGIN% 00000000 0219 - - INTEGER NCHARS,NEXP,I; POINTER CPNT;% 00000000 0219 - - START OF SEGMENT ********** 10 - - DEFINE PUTCHAR(C)= % PUTS A CHARACTER INTO TEMPTEXT 00000000 0000 - - BEGIN CHAR[0]:=C; NCHARS:=NCHARS+1;% 00000000 0000 - - REPLACE CPNT:CPNT BY CHARPNT FOR 1;% 00000000 0000 - - END#;% 00000000 0000 - - % 00000000 0000 - - PROCEDURE PUTINT(N); % PUTS AN INTEGER INTO TEMPTEXT 00000000 0000 - - VALUE N; INTEGER N; % WITH ZERO SUPPRESSION. 00000000 0000 - - IF N{9 THEN PUTCHAR(N) ELSE% 00000000 0000 - - BEGIN PUTINT(N DIV 10); PUTCHAR(ENTIER(N MOD 10)) END;% 00000000 0007 - - % 00000000 0019 - - CPNT:=POINTER(TEMPTEXT[*]);% 00000000 0019 - - IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00000000 0020 - - IF EMODE=1 THEN %*** MODE = INTEGER *** 00000000 0023 - - BEGIN% 00000000 0023 - - IF E<0 THEN BEGIN PUTCHAR("-"); E:=-E END;% 00000000 0024 - - PUTINT(E);% 00000000 0031 - - END ELSE% 00000000 0033 - - IF EMODE=2 THEN %*** MODE = REAL *** 00000000 0033 - - BEGIN% 00000000 0034 - - PUTCHAR(" ");% 00000000 0034 - - IF E<0 THEN BEGIN PUTCHAR("-"); E:=-E END;% 00000000 0040 - - IF E>MAXINT OR N<0 THEN % FLOATING-POINT. 00000000 0047 - - BEGIN% 00000000 0049 - - IF E>0 THEN% 00000000 0049 - - BEGIN% 00000000 0050 - - WHILE E<1 DO BEGIN NEXP:=NEXP-1; E:=10|E END;% 00000000 0051 - - WHILE E}10 DO BEGIN NEXP:=NEXP+1; E:=E/10 END;% 00000000 0057 - - END;% 00000000 0061 - - I:=MAX(M-8,1);% 00000000 0061 - - E:=E+0.5|10*(-I);% 00000000 0064 - - IF E GEQ 10 THEN BEGIN NEXP:=NEXP+1; E:=E/10 END;% 00000000 0068 - - PUTCHAR(ENTIER(E)); E:=E-ENTIER(E); PUTCHAR(".");% 00000000 0072 - - DO BEGIN% 00000000 0086 - - E:=10|E; PUTCHAR(ENTIER(E));% 00000000 0086 - - E:=E-ENTIER(E); I:=I-1;% 00000000 0093 - - END UNTIL I{0;% 00000000 0097 - - PUTCHAR("E");% 00000000 0098 - - IF NEXP<0 THEN BEGIN PUTCHAR("-"); NEXP:=-NEXP END% 00000000 0103 - - ELSE PUTCHAR("+");% 00000000 0111 - - PUTCHAR(NEXP DIV 10); PUTCHAR(ENTIER(NEXP MOD 10));% 00000000 0118 - - END ELSE% 00000000 0130 - - BEGIN % FIXED-POINT. 00000000 0130 - - E:=E+0.5|10*(-N);% 00000000 0133 - - PUTINT(ENTIER(E)); PUTCHAR("."); E:=E-ENTIER(E);% 00000000 0137 - - IF N>150 THEN RUNERR(6,LINENUM);% 00000000 0146 - - FOR I:=1 STEP 1 UNTIL N DO% 00000000 0149 - - BEGIN E:=10|E; PUTCHAR(ENTIER(E));% 00000000 0151 - - E:=E-ENTIER(E);% 00000000 0158 - - END END END ELSE% 00000000 0160 - - IF EMODE=3 THEN %*** MODE = BOOLEAN *** 00000000 0163 - - BEGIN% 00000000 0165 - - IF E<0.5 THEN REPLACE CPNT BY "FALSE" ELSE REPLACE CPNT BY "TRUE"; 00000000 0166 - - NCHARS:=IF E<0.5 THEN 5 ELSE 4;% 00000000 0174 - - END ELSE% 00000000 0178 - - IF EMODE=5 THEN %*** MODE = ALFA *** 00000000 0178 - - BEGIN% 00000000 0182 - - TEXT[0]:=E; NCHARS:=MIN(M,7);% 00000000 0183 - - REPLACE CPNT:CPNT BY TEXTPNT FOR 7;% 00000000 0187 - - END ELSE% 00000000 0190 - - BEGIN %*** MODE = CHAR *** 00000000 0190 - - PUTCHAR(E);% 00000000 0190 - - END;% 00000000 0196 - - IF NCHARS>M THEN M:=NCHARS;% 00000000 0196 - - IF INFO.BUFPNT+M>INFO.BUFSIZE THEN WLINE(F,BUF,INFO);% 00000000 0198 - - IF M>INFO.BUFSIZE THEN RUNERR(6,LINENUM);% 00000000 0202 - - REPLACE POINTER(BUF[*])+(INFO.BUFPNT+M-NCHARS) BY% 00000000 0205 - - POINTER(TEMPTEXT[*]) FOR NCHARS;% 00000000 0210 - - INFO.BUFPNT:=INFO.BUFPNT+M;% 00000000 0213 - - END OF PWRITE;% 00000000 0216 - - 10 IS 223 LONG, NEXT SEG 2 - - % 00000000 0219 - - % 00000000 0219 - - PROCEDURE PUT(F,BUF,INFO,LINENUM);% 00000000 0219 - - VALUE LINENUM;% 00000000 0219 - - FILE F; ARRAY BUF[*];% 00000000 0219 - - INTEGER INFO,LINENUM;% 00000000 0219 - - BEGIN% 00000000 0219 - - IF INFO.BUFSIZE=0 THEN% 00000000 0219 - - BEGIN% 00000000 0220 - - IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00000000 0220 - - WRITE(F,1023,BUF[*]);% 00000000 0223 - - END ELSE PWRITE(F,BUF,INFO,INFO.LASTCH,4,1,1,LINENUM);% 00000000 0227 - - END OF PUT;% 00000000 0231 - - % 00000000 0231 - - % 00000000 0231 - - PROCEDURE GET(F,BUF,INFO,LINENUM);% 00000000 0231 - - VALUE LINENUM;% 00000000 0231 - - FILE F; ARRAY BUF[*];% 00000000 0231 - - INTEGER INFO,LINENUM;% 00000000 0231 - - BEGIN% 00000000 0231 - - ALPHA X; LABEL ENDFILE;% 00000000 0231 - - START OF SEGMENT ********** 11 - - IF INFO.BUFSIZE=0 THEN% 00000000 0000 - - BEGIN% 00000000 0001 - - IF BOOLEAN(INFO.EOF) THEN RUNERR(1,LINENUM);% 00000000 0001 - - READ(F,1023,BUF[*]) [ENDFILE];% 00000000 0004 - - IF FALSE THEN ENDFILE: INFO.EOF:=1;% 00000000 0009 - - END ELSE X:=PREAD(F,BUF,INFO,1,LINENUM);% 00000000 0012 - - END OF GET;% 00000000 0015 - - 11 IS 21 LONG, NEXT SEG 2 - - % 00000000 0231 - - % 00000000 0231 - - PROCEDURE PPAGE(F,BUF,INFO,LINENUM);% 00000000 0231 - - VALUE LINENUM;% 00000000 0231 - - FILE F; ARRAY BUF[*];% 00000000 0231 - - INTEGER INFO,LINENUM;% 00000000 0231 - - BEGIN% 00000000 0231 - - IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00000000 0231 - - WRITE(F[PAGE]);% 00000000 0234 - - END OF PPAGE;% 00000000 0238 - - % 00000000 0238 - - % 00000000 0238 - - PROCEDURE RESET(F,BUF,INFO,LINENUM);% 00000000 0238 - - VALUE LINENUM;% 00000000 0238 - - FILE F; ARRAY BUF[*];% 00000000 0238 - - INTEGER INFO,LINENUM;% 00000000 0238 - - BEGIN% 00000000 0238 - - IF BOOLEAN(INFO.INP) OR BOOLEAN(INFO.OUTP) THEN RUNERR(5,LINENUM);% 00000000 0238 - - REWIND(F); INFO.EOF:=0; INFO.EOLN:=0; INFO.BUFPNT:=0;% 00000000 0242 - - INFO.ENDFOUND:=0;% 00000000 0251 - - IF INFO.BUFSIZE=0 THEN GET(F,BUF,INFO,LINENUM)% 00000000 0253 - - ELSE RLINE(F,BUF,INFO);% 00000000 0257 - - END OF RESET;% 00000000 0260 - - % 00000000 0260 - - PROCEDURE REWRITE(F,BUF,INFO,LINENUM);% 00000000 0260 - - VALUE LINENUM;% 00000000 0260 - - FILE F; ARRAY BUF[*];% 00000000 0260 - - INTEGER INFO,LINENUM;% 00000000 0260 - - BEGIN% 00000000 0260 - - IF BOOLEAN(INFO.INP) OR BOOLEAN(INFO.OUTP) THEN RUNERR(5,LINENUM);% 00000000 0260 - - REWIND(F); INFO.EOF:=1; INFO.BUFPNT:=0; INFO.ENDFOUND:=0;% 00000000 0264 - - IF INFO.BUFSIZE>0 THEN% 00000000 0273 - - REPLACE POINTER(BUF[*]) BY " " FOR INFO.BUFSIZE;% 00000000 0274 - - END OF REWRITE;% 00000000 0279 - - % 00000000 0280 - - % 00000000 0280 - - PROCEDURE INIT(INPUTDECL);% 00000000 0280 - - VALUE INPUTDECL;% 00000000 0280 - - BOOLEAN INPUTDECL;% 00000000 0280 - - BEGIN% 00000000 0280 - - MEMPNT:=1;% 00000000 0280 - - CHARPNT:=POINTER(CHAR[*])+7; TEXTPNT:=POINTER(TEXT[*])+1;% 00000000 0280 - - T:=0; T.BUFSIZE:=80; T.BUFPNT:=80; T.EOLN:=1; T.INP:=1;% 00000000 0287 - - I00603:=T; IF INPUTDECL THEN RLINE(INPUT,V00603,I00603);% 00000000 0295 - - T:=0; T.BUFSIZE:=132; T.EOLN:=1; T.OUTP:=1; T.EOF:=1;% 00000000 0299 - - I00742:=T;% 00000000 0306 - - REPLACE POINTER(V00742[*]) BY " " FOR 17 WORDS;% 00000000 0307 - - END OF INIT;% 00000000 0311 - - REAL V01025,V01033;ARRAY V01051[0:050,0:100],V01980[0:050,0:100],V01142 00000044 0312 - [0:027];REAL V01479,V01290,V01384,V01833,V01398;PROCEDU V01794(V02025, 00000044 0316 - V02033,V02931);VALUE V02025,V02033,V02931;REAL V02025,V02033,V02931; 00000045 0317 - BEGIN REAL V02041;INTEGER T01,T02,T03,T04,T05;BEGIN V02041 := ABS ( 00000049 0317 + REAL V01025,V01033;ARRAY V01051[0:050,0:100],V01980[0:050,0:100],V01142 00000044 C 0312 + [0:027];REAL V01479,V01290,V01384,V01833,V01398;PROCEDU V01794(V02025, 00000044 C 0316 + V02033,V02931);VALUE V02025,V02033,V02931;REAL V02025,V02033,V02931; 00000045 C 0317 + BEGIN REAL V02041;INTEGER T01,T02,T03,T04,T05;BEGIN V02041 := ABS ( 00000049 C 0317 START OF SEGMENT ********** 12 - V02931 -V01051 [V02025 ,V02033 ]);IF V02041 >V01290 THEN V01290 := 00000051 0000 - V02041 ;V01980 [V02025 ,V02033 ]:=V02931 ;; END END ;INTEGER T01,T02, 00000057 0003 + V02931 -V01051 [V02025 ,V02033 ]);IF V02041 >V01290 THEN V01290 := 00000051 C 0000 + V02041 ;V01980 [V02025 ,V02033 ]:=V02931 ;; END END ;INTEGER T01,T02, 00000057 C 0003 12 IS 11 LONG, NEXT SEG 2 - T03,T04,T05;INIT(FALSE);BEGIN V01398 :=(TIME( 1)/60) ;V01479 :=0;BEGIN 00000061 0317 - V01025~0;T01~027;FOR V01025~V01025 UPTO T01 DO V01142 [V01025 ]:=048 00000062 0321 - END ;BEGIN V01025~1;T01~9;FOR V01025~V01025 UPTO T01 DO V01142 [ 00000064 0324 - V01025 |2-1]:=CHECK( (017)+V01025 -1,0,063,064) END ;BEGIN V01025~010; 00000065 0330 - T01~014;FOR V01025~V01025 UPTO T01 DO V01142 [V01025 |2-1]:=CHECK( (033 00000066 0337 - )+V01025 -010,0,063,066) END ;BEGIN V01025~0;T01~025;FOR V01025~V01025 00000070 0340 - UPTO T01 DO BEGIN V01033~0;T02~100;FOR V01033~V01033 UPTO T02 DO 00000071 0347 - V01980 [V01025 ,V01033 ]:=(3500000.000000@-04-2000000.000000@-05)| 00000071 0351 - V01025 /050+2000000.000000@-05 END END ;BEGIN V01033~025;T01~075;FOR 00000074 0353 - V01033~V01033 UPTO T01 DO V01980 [025,V01033 ]:=3500000.000000@-04 END 00000074 0361 - ;BEGIN V01025~025;T01~050;FOR V01025~V01025 UPTO T01 DO BEGIN V01980 [ 00000078 0368 - V01025 ,025]:=3500000.000000@-04;V01980 [V01025 ,075]:= 00000079 0372 - 3500000.000000@-04;BEGIN V01033~0;T02~025;FOR V01033~V01033 UPTO T02 00000081 0375 - DO V01980 [V01025 ,V01033 ]:=(3500000.000000@-04- 00000081 0377 - 2000000.000000@-05)|V01025 /050+2000000.000000@-05 END ;BEGIN V01033~ 00000082 0381 - 025+1;T02~075-1;FOR V01033~V01033 UPTO T02 DO V01980 [V01025 ,V01033 ] 00000083 0386 - :=3500000.000000@-04+2000000.000000@-05 END ;BEGIN V01033~075;T02~100; 00000085 0393 - FOR V01033~V01033 UPTO T02 DO V01980 [V01025 ,V01033 ]:=( 00000085 0398 - 3500000.000000@-04-2000000.000000@-05)|V01025 /050+ 00000085 0402 - 2000000.000000@-05 END ;; END END ;V01384 :=2000000.000000@-06| 00000088 0404 - 2000000.000003@-08/6000000.000000@-07;V01833 :=V01384 | 00000089 0409 - 2000000.000000@-05;DO BEGIN V01479 :=V01479 +1; BEGIN PWRITE(F00742, 00000093 0411 - V00742,I00742," PASS ",5,5,-1,093);PWRITE(F00742,V00742,I00742,V01479 00000093 0414 - ,1,5,-1,093);PWRITE(F00742,V00742,I00742,": ",5,2,-1,093);END ; 00000094 0419 - V01290 :=0;BEGIN V01025~0;T01~050;FOR V01025~V01025 UPTO T01 DO BEGIN 00000098 0424 - V01033~0;T02~100;FOR V01033~V01033 UPTO T02 DO V01051 [V01025 ,V01033 ] 00000099 0435 - :=V01980 [V01025 ,V01033 ] END END ;BEGIN V01025~1;T01~050-1;FOR 00000102 0439 - V01025~V01025 UPTO T01 DO BEGIN BEGIN V01033~1;T02~100-1;FOR V01033~ 00000104 0447 - V01033 UPTO T02 DO BEGIN IF (V01025 <025) OR (V01033 <025) OR ( 00000105 0451 - V01033 >075) THEN V01794 (V01025 ,V01033 ,2500000.000000@-07|(V01051 [ 00000107 0453 - V01025 +1,V01033 ]+V01051 [V01025 -1,V01033 ]+V01051 [V01025 ,V01033 +1 00000107 0456 - ]+V01051 [V01025 ,V01033 -1]));; END END ;V01794 (V01025 ,0,(V01833 + 00000113 0461 - 5000000.000000@-07|(2000000.000000@-06|V01051 [V01025 ,1]+V01051 [ 00000113 0467 - V01025 +1,0]+V01051 [V01025 -1,0]))/(V01384 +2000000.000000@-06)); 00000117 0469 - V01794 (V01025 ,100,2500000.000000@-07|(V01051 [V01025 +1,100]+V01051 [ 00000117 0475 - V01025 -1,100]+2000000.000000@-06|V01051 [V01025 ,100-1]));; END END ; 00000120 0478 - BEGIN V01033~1;T01~100-1;FOR V01033~V01033 UPTO T01 DO BEGIN V01794 (0, 00000125 0485 - V01033 ,(V01833 +5000000.000000@-07|(2000000.000000@-06|V01051 [1, 00000125 0492 - V01033 ]+V01051 [0,V01033 +1]+V01051 [0,V01033 -1]))/(V01384 + 00000125 0494 - 2000000.000000@-06));IF (V01033 <025) OR (V01033 >075) THEN V01794 ( 00000130 0499 - 050,V01033 ,2500000.000000@-07|(V01051 [050,V01033 +1]+V01051 [050, 00000130 0503 - V01033 -1]+2000000.000000@-06|V01051 [050-1,V01033 ]));; END END ; 00000134 0506 - V01794 (050,100,5000000.000000@-07|(V01051 [050-1,100]+V01051 [050,100- 00000134 0513 - 1]));V01794 (0,100,(V01833 -V01051 [0,100-1]+V01051 [1,100])/V01384 ); 00000140 0516 - V01794 (050,0,(V01833 -V01051 [050-1,0]+V01051 [050,1])/V01384 ); 00000144 0523 - V01794 (0,0,(2000000.000000@-06|V01833 +V01051 [1,0]+V01051 [0,1])/ 00000144 0528 - 2000000.000000@-06/(V01384 +1000000.000000@-06)); BEGIN PWRITE(F00742, 00000146 0533 - V00742,I00742,"RMAX = ",5,7,-1,146);PWRITE(F00742,V00742,I00742,V01290 00000146 0535 - ,2,8,4,146);WLINE(F00742,V00742,I00742)END ;; END UNTIL V01290 { 00000147 0540 - 5000000.000000@-07; BEGIN WLINE(F00742,V00742,I00742)END ; BEGIN WALFA( 00000150 0544 - F00742,V00742,I00742," FINAL ","RMAX = ",0,0,0,0,0,0,0,0,0,0,014,150); 00000150 0547 - PWRITE(F00742,V00742,I00742,V01290 ,2,016,-1,150);WLINE(F00742,V00742, 00000150 0552 - I00742)END ; BEGIN WLINE(F00742,V00742,I00742)END ; BEGIN WALFA(F00742, 00000152 0557 - V00742,I00742," TIMES:"," ET= = ",0,0,0,0,0,0,0,0,0,0,011,152);PWRITE( 00000152 0560 - F00742,V00742,I00742,((TIME( 1)/60) -V01398 ),2,8,2,152);PWRITE(F00742, 00000152 0565 - V00742,I00742,", PT= ",5,5,-1,152);PWRITE(F00742,V00742,I00742,(TIME( 00000152 0571 - 2)/60) ,2,8,2,152);PWRITE(F00742,V00742,I00742,", IO= ",5,5,-1,153); 00000153 0575 - PWRITE(F00742,V00742,I00742,(TIME( 3)/60) ,2,8,2,153);WLINE(F00742, 00000153 0581 - V00742,I00742)END ; BEGIN WLINE(F00742,V00742,I00742)END ; BEGIN WALFA( 00000155 0586 - F00742,V00742,I00742," TEMPER","ATURE P","ROFILE0",0,0,0,0,0,0,0,0,0, 00000155 0590 - 020,155);WLINE(F00742,V00742,I00742)END ; BEGIN WALFA(F00742,V00742, 00000156 0594 - I00742," KEY ","A = 21","- 40LE0",0,0,0,0,0,0,0,0,0,018,156);WLINE( 00000156 0612 - F00742,V00742,I00742)END ; BEGIN WALFA(F00742,V00742,I00742," ", 00000157 0616 - "B = 61","- 80LE0",0,0,0,0,0,0,0,0,0,018,157);WLINE(F00742,V00742, 00000157 0620 - I00742)END ; BEGIN WALFA(F00742,V00742,I00742," ","C = 101", 00000158 0625 - "-120LE0",0,0,0,0,0,0,0,0,0,018,158);WLINE(F00742,V00742,I00742)END ; 00000159 0628 - BEGIN WALFA(F00742,V00742,I00742," ","D = 141","-160LE0",0,0,0, 00000159 0633 - 0,0,0,0,0,0,018,159);WLINE(F00742,V00742,I00742)END ; BEGIN WALFA( 00000160 0636 - F00742,V00742,I00742," ","E = 181","-200LE0",0,0,0,0,0,0,0,0,0, 00000160 0641 - 018,160);WLINE(F00742,V00742,I00742)END ; BEGIN WALFA(F00742,V00742, 00000161 0645 - I00742," ","F = 221","-240LE0",0,0,0,0,0,0,0,0,0,018,161);WLINE( 00000161 0650 - F00742,V00742,I00742)END ; BEGIN WALFA(F00742,V00742,I00742," ", 00000162 0654 - "G = 261","-280LE0",0,0,0,0,0,0,0,0,0,018,162);WLINE(F00742,V00742, 00000162 0658 - I00742)END ; BEGIN WALFA(F00742,V00742,I00742," ","H = 301", 00000163 0663 - "-320LE0",0,0,0,0,0,0,0,0,0,018,163);WLINE(F00742,V00742,I00742)END ; 00000164 0665 - BEGIN WALFA(F00742,V00742,I00742," ","I = 341","-360LE0",0,0,0, 00000164 0671 - 0,0,0,0,0,0,018,164);WLINE(F00742,V00742,I00742)END ; BEGIN WLINE( 00000165 0674 - F00742,V00742,I00742)END ;BEGIN V01033~0;T01~100;FOR V01033~V01033 00000168 0678 - UPTO T01 DO BEGIN BEGIN PWRITE(F00742,V00742,I00742,V01033 ,1,4,-1,169 00000169 0682 - );PWRITE(F00742,V00742,I00742,048,4,1,-1,169);END ;BEGIN V01025~0;T02~ 00000170 0706 - 050;FOR V01025~V01025 UPTO T02 DO BEGIN PWRITE(F00742,V00742,I00742, 00000171 0710 - V01142 [ TRUNC (V01051 [V01025 ,V01033 ]/020,171)],4,1,-1,171);END 00000171 0714 - END ; BEGIN WLINE(F00742,V00742,I00742)END ;; END END ; BEGIN WLINE( 00000176 0719 - F00742,V00742,I00742)END ; BEGIN WALFA(F00742,V00742,I00742," TIMES:", 00000177 0725 - " ET=341",0,0,0,0,0,0,0,0,0,0,011,177);PWRITE(F00742,V00742,I00742,( 00000177 0729 - (TIME( 1)/60) -V01398 ),2,8,2,177);PWRITE(F00742,V00742,I00742, 00000177 0734 - ", PT= ",5,5,-1,177);PWRITE(F00742,V00742,I00742,(TIME( 2)/60) ,2,8,2, 00000177 0739 - 177);PWRITE(F00742,V00742,I00742,", IO= ",5,5,-1,178);PWRITE(F00742, 00000178 0745 - V00742,I00742,(TIME( 3)/60) ,2,8,2,178);WLINE(F00742,V00742,I00742)END 00000178 0749 - ;; END 00000179 0755 - ; TERMINATE: END OF PASCAL PROGRAM. 0755 - 2 IS 764 LONG, NEXT SEG 1 + T03,T04,T05;INIT(FALSE);BEGIN V01398 :=(TIME( 1)/60) ;V01479 :=0;BEGIN 00000061 C 0317 + V01025~0;T01~027;FOR V01025~V01025 UPTO T01 DO V01142 [V01025 ]:=048 00000062 C 0321 + END ;BEGIN V01025~1;T01~9;FOR V01025~V01025 UPTO T01 DO V01142 [ 00000064 C 0324 + V01025 |2-1]:=CHECK( (017)+V01025 -1,0,063,064) END ;BEGIN V01025~010; 00000065 C 0330 + T01~014;FOR V01025~V01025 UPTO T01 DO V01142 [V01025 |2-1]:=CHECK( (033 00000066 C 0337 + )+V01025 -010,0,063,066) END ;BEGIN V01025~0;T01~025;FOR V01025~V01025 00000070 C 0340 + UPTO T01 DO BEGIN V01033~0;T02~100;FOR V01033~V01033 UPTO T02 DO 00000071 C 0347 + V01980 [V01025 ,V01033 ]:=(3500000.000000@-04-2000000.000000@-05)| 00000071 C 0351 + V01025 /050+2000000.000000@-05 END END ;BEGIN V01033~025;T01~075;FOR 00000074 C 0353 + V01033~V01033 UPTO T01 DO V01980 [025,V01033 ]:=3500000.000000@-04 END 00000074 C 0361 + ;BEGIN V01025~025;T01~050;FOR V01025~V01025 UPTO T01 DO BEGIN V01980 [ 00000078 C 0368 + V01025 ,025]:=3500000.000000@-04;V01980 [V01025 ,075]:= 00000079 C 0372 + 3500000.000000@-04;BEGIN V01033~0;T02~025;FOR V01033~V01033 UPTO T02 00000081 C 0375 + DO V01980 [V01025 ,V01033 ]:=(3500000.000000@-04- 00000081 C 0377 + 2000000.000000@-05)|V01025 /050+2000000.000000@-05 END ;BEGIN V01033~ 00000082 C 0381 + 025+1;T02~075-1;FOR V01033~V01033 UPTO T02 DO V01980 [V01025 ,V01033 ] 00000083 C 0386 + :=3500000.000000@-04+2000000.000000@-05 END ;BEGIN V01033~075;T02~100; 00000085 C 0393 + FOR V01033~V01033 UPTO T02 DO V01980 [V01025 ,V01033 ]:=( 00000085 C 0398 + 3500000.000000@-04-2000000.000000@-05)|V01025 /050+ 00000085 C 0402 + 2000000.000000@-05 END ;; END END ;V01384 :=2000000.000000@-06| 00000088 C 0404 + 2000000.000003@-08/6000000.000000@-07;V01833 :=V01384 | 00000089 C 0409 + 2000000.000000@-05;DO BEGIN V01479 :=V01479 +1; BEGIN PWRITE(F00742, 00000093 C 0411 + V00742,I00742," PASS ",5,5,-1,093);PWRITE(F00742,V00742,I00742,V01479 00000093 C 0415 + ,1,5,-1,093);PWRITE(F00742,V00742,I00742,": ",5,2,-1,093);END ; 00000094 C 0419 + V01290 :=0;BEGIN V01025~0;T01~050;FOR V01025~V01025 UPTO T01 DO BEGIN 00000098 C 0424 + V01033~0;T02~100;FOR V01033~V01033 UPTO T02 DO V01051 [V01025 ,V01033 ] 00000099 C 0435 + :=V01980 [V01025 ,V01033 ] END END ;BEGIN V01025~1;T01~050-1;FOR 00000102 C 0439 + V01025~V01025 UPTO T01 DO BEGIN BEGIN V01033~1;T02~100-1;FOR V01033~ 00000104 C 0447 + V01033 UPTO T02 DO BEGIN IF (V01025 <025) OR (V01033 <025) OR ( 00000105 C 0451 + V01033 >075) THEN V01794 (V01025 ,V01033 ,2500000.000000@-07|(V01051 [ 00000107 C 0453 + V01025 +1,V01033 ]+V01051 [V01025 -1,V01033 ]+V01051 [V01025 ,V01033 +1 00000107 C 0456 + ]+V01051 [V01025 ,V01033 -1]));; END END ;V01794 (V01025 ,0,(V01833 + 00000113 C 0461 + 5000000.000000@-07|(2000000.000000@-06|V01051 [V01025 ,1]+V01051 [ 00000113 C 0467 + V01025 +1,0]+V01051 [V01025 -1,0]))/(V01384 +2000000.000000@-06)); 00000117 C 0469 + V01794 (V01025 ,100,2500000.000000@-07|(V01051 [V01025 +1,100]+V01051 [ 00000117 C 0475 + V01025 -1,100]+2000000.000000@-06|V01051 [V01025 ,100-1]));; END END ; 00000120 C 0478 + BEGIN V01033~1;T01~100-1;FOR V01033~V01033 UPTO T01 DO BEGIN V01794 (0, 00000125 C 0485 + V01033 ,(V01833 +5000000.000000@-07|(2000000.000000@-06|V01051 [1, 00000125 C 0492 + V01033 ]+V01051 [0,V01033 +1]+V01051 [0,V01033 -1]))/(V01384 + 00000125 C 0494 + 2000000.000000@-06));IF (V01033 <025) OR (V01033 >075) THEN V01794 ( 00000130 C 0499 + 050,V01033 ,2500000.000000@-07|(V01051 [050,V01033 +1]+V01051 [050, 00000130 C 0503 + V01033 -1]+2000000.000000@-06|V01051 [050-1,V01033 ]));; END END ; 00000134 C 0506 + V01794 (050,100,5000000.000000@-07|(V01051 [050-1,100]+V01051 [050,100- 00000134 C 0513 + 1]));V01794 (0,100,(V01833 -V01051 [0,100-1]+V01051 [1,100])/V01384 ); 00000140 C 0516 + V01794 (050,0,(V01833 -V01051 [050-1,0]+V01051 [050,1])/V01384 ); 00000144 C 0523 + V01794 (0,0,(2000000.000000@-06|V01833 +V01051 [1,0]+V01051 [0,1])/ 00000144 C 0528 + 2000000.000000@-06/(V01384 +1000000.000000@-06)); BEGIN PWRITE(F00742, 00000146 C 0533 + V00742,I00742,"RMAX = ",5,7,-1,146);PWRITE(F00742,V00742,I00742,V01290 00000146 C 0535 + ,2,8,4,146);WLINE(F00742,V00742,I00742)END ;; END UNTIL V01290 { 00000147 C 0540 + 5000000.000000@-07; BEGIN WLINE(F00742,V00742,I00742)END ; BEGIN WALFA( 00000150 C 0544 + F00742,V00742,I00742," FINAL ","RMAX = ",0,0,0,0,0,0,0,0,0,0,014,150); 00000150 C 0547 + PWRITE(F00742,V00742,I00742,V01290 ,2,016,-1,150);WLINE(F00742,V00742, 00000150 C 0552 + I00742)END ; BEGIN WLINE(F00742,V00742,I00742)END ; BEGIN WALFA(F00742, 00000152 C 0557 + V00742,I00742," TIMES:"," ET= = ",0,0,0,0,0,0,0,0,0,0,011,152);PWRITE( 00000152 C 0560 + F00742,V00742,I00742,((TIME( 1)/60) -V01398 ),2,8,2,152);PWRITE(F00742, 00000152 C 0565 + V00742,I00742,", PT= ",5,5,-1,152);PWRITE(F00742,V00742,I00742,(TIME( 00000152 C 0571 + 2)/60) ,2,8,2,152);PWRITE(F00742,V00742,I00742,", IO= ",5,5,-1,153); 00000153 C 0575 + PWRITE(F00742,V00742,I00742,(TIME( 3)/60) ,2,8,2,153);WLINE(F00742, 00000153 C 0581 + V00742,I00742)END ; BEGIN WLINE(F00742,V00742,I00742)END ; BEGIN WALFA( 00000155 C 0586 + F00742,V00742,I00742," TEMPER","ATURE P","ROFILE0",0,0,0,0,0,0,0,0,0, 00000155 C 0590 + 020,155);WLINE(F00742,V00742,I00742)END ; BEGIN WALFA(F00742,V00742, 00000156 C 0594 + I00742," KEY ","A = 21","- 40LE0",0,0,0,0,0,0,0,0,0,018,156);WLINE( 00000156 C 0612 + F00742,V00742,I00742)END ; BEGIN WALFA(F00742,V00742,I00742," ", 00000157 C 0616 + "B = 61","- 80LE0",0,0,0,0,0,0,0,0,0,018,157);WLINE(F00742,V00742, 00000157 C 0620 + I00742)END ; BEGIN WALFA(F00742,V00742,I00742," ","C = 101", 00000158 C 0625 + "-120LE0",0,0,0,0,0,0,0,0,0,018,158);WLINE(F00742,V00742,I00742)END ; 00000159 C 0628 + BEGIN WALFA(F00742,V00742,I00742," ","D = 141","-160LE0",0,0,0, 00000159 C 0633 + 0,0,0,0,0,0,018,159);WLINE(F00742,V00742,I00742)END ; BEGIN WALFA( 00000160 C 0636 + F00742,V00742,I00742," ","E = 181","-200LE0",0,0,0,0,0,0,0,0,0, 00000160 C 0641 + 018,160);WLINE(F00742,V00742,I00742)END ; BEGIN WALFA(F00742,V00742, 00000161 C 0645 + I00742," ","F = 221","-240LE0",0,0,0,0,0,0,0,0,0,018,161);WLINE( 00000161 C 0650 + F00742,V00742,I00742)END ; BEGIN WALFA(F00742,V00742,I00742," ", 00000162 C 0654 + "G = 261","-280LE0",0,0,0,0,0,0,0,0,0,018,162);WLINE(F00742,V00742, 00000162 C 0658 + I00742)END ; BEGIN WALFA(F00742,V00742,I00742," ","H = 301", 00000163 C 0663 + "-320LE0",0,0,0,0,0,0,0,0,0,018,163);WLINE(F00742,V00742,I00742)END ; 00000164 C 0665 + BEGIN WALFA(F00742,V00742,I00742," ","I = 341","-360LE0",0,0,0, 00000164 C 0671 + 0,0,0,0,0,0,018,164);WLINE(F00742,V00742,I00742)END ; BEGIN WLINE( 00000165 C 0674 + F00742,V00742,I00742)END ;BEGIN V01033~0;T01~100;FOR V01033~V01033 00000168 C 0678 + UPTO T01 DO BEGIN BEGIN PWRITE(F00742,V00742,I00742,V01033 ,1,4,-1,169 00000169 C 0682 + );PWRITE(F00742,V00742,I00742,048,4,1,-1,169);END ;BEGIN V01025~0;T02~ 00000170 C 0706 + 050;FOR V01025~V01025 UPTO T02 DO BEGIN PWRITE(F00742,V00742,I00742, 00000171 C 0710 + V01142 [ TRUNC (V01051 [V01025 ,V01033 ]/020,171)],4,1,-1,171);END 00000171 C 0714 + END ;BEGIN V01025~050-1;T02~0;FOR V01025~V01025 DOWNTO T02 DO BEGIN 00000174 C 0719 + PWRITE(F00742,V00742,I00742,V01142 [ TRUNC (V01051 [V01025 ,V01033 ]/ 00000174 C 0724 + 020,174)],4,1,-1,174);END END ; BEGIN WLINE(F00742,V00742,I00742)END ; 00000177 C 0727 + ; END END ; BEGIN WLINE(F00742,V00742,I00742)END ; BEGIN WALFA(F00742, 00000180 C 0734 + V00742,I00742," TIMES:"," ET=341",0,0,0,0,0,0,0,0,0,0,011,180);PWRITE( 00000180 C 0739 + F00742,V00742,I00742,((TIME( 1)/60) -V01398 ),2,8,2,180);PWRITE(F00742, 00000180 C 0744 + V00742,I00742,", PT= ",5,5,-1,180);PWRITE(F00742,V00742,I00742,(TIME( 00000180 C 0749 + 2)/60) ,2,8,2,180);PWRITE(F00742,V00742,I00742,", IO= ",5,5,-1,181); 00000181 C 0754 + PWRITE(F00742,V00742,I00742,(TIME( 3)/60) ,2,8,2,181);WLINE(F00742, 00000181 C 0760 + V00742,I00742)END ;; END 00000182 C 0765 + ; TERMINATE: END OF PASCAL PROGRAM. C 0766 + 2 IS 775 LONG, NEXT SEG 1 1 IS 2 LONG, NEXT SEG 0 25 IS 69 LONG, NEXT SEG 0 -NUMBER OF ERRORS DETECTED = 0. COMPILATION TIME = 36 SECONDS. - -PRT SIZE = 112; TOTAL SEGMENT SIZE = 1723 WORDS; DISK SIZE = 88 SEGS; NO. PGM. SEGS = 25 - +NUMBER OF ERRORS DETECTED = 0. COMPILATION TIME = 35 SECONDS. +PRT SIZE = 112; TOTAL SEGMENT SIZE = 1736 WORDS; DISK SIZE = 88 SEGS; NO. PGM. SEGS = 25 ESTIMATED CORE STORAGE REQUIRED = 6769 WORDS. - ESTIMATED AUXILIARY MEMORY REQUIRED = 0 WORDS. +NUMBER OF CARD-IMAGES PROCESSED = 573. - LABEL 0XALGOL 0COMPILE00186183CC USER=0000000; COMPILE HMSS2/0000000 XALGOL ;XALGOL FILE CARD=PASC85 XALGOL /HMSS2 +LABEL 0XALGOL 0COMPILE00186197CC USER=0000000; COMPILE HMSS2/0000000 XALGOL ;XALGOL FILE CARD=PASC00 XALGOL /HMSS2 - - - - - - - LABEL 000000000OUTPUT 00186183CC USER=0000000; COMPILE HMSS2/0000000 XALGOL ;XALGOL FILE CARD=PASC85 HMSS2 /0000000 + LABEL 000000000OUTPUT 00186197CC USER=0000000; COMPILE HMSS2/0000000 XALGOL ;XALGOL FILE CARD=PASC00 HMSS2 /0000000 @@ -1546,7 +550,7 @@ ESTIMATED AUXILIARY MEMORY REQUIRED = 0 WORDS. FINAL RMAX = 4.99680577E-00 - TIMES: ET= 507.55, PT= 504.57, IO= 8.75 + TIMES: ET= 503.98, PT= 502.57, IO= 10.28 TEMPERATURE PROFILE KEY A = 21- 40 @@ -1559,116 +563,111 @@ ESTIMATED AUXILIARY MEMORY REQUIRED = 0 WORDS. H = 301-320 I = 341-360 - 0 BBBBBB CCCCC DDDDD EEEEEEEEEEE - 1 BBBBBB CCCCC DDDDD EEEEEEE - 2 BBBBB CCCCC DDDD EEEEE - 3 BBBBBB CCCCC DDDD EEEEE FFFFFF - 4 BBBBBB CCCC DDDD EEEE FFFFFFFFFF - 5 BBBBB CCCC DDDD EEEEE FFFFFFF - 6 BBBBBB CCCC DDDD EEEE FFFFF - 7 BBBBBB CCCC DDDD EEE FFFFF - 8 BBBBB CCCC DDD EEE FFFFF GGGGG - 9 BBBBBB CCCC DDDD EEEE FFFFF GGGGGGG - 10 BBBBBB CCC DDD EEE FFFF GGGGGGGGG - 10 BBBBB CCCC DDDD EEEE FFFF GGGGGGGGG - 12 BBBBB CCCC DDD EEE FFF GGGGGG - 13 BBBBBB CCC DDD EEEE FFFF GGGGG - 14 BBBBBB CCC DDDD EEE FFF GGGGG - 15 BBBBBB CCC DDD EEE FFF GGGG - 16 BBBBB CCCC DDD EEEE FFFF GGGGG - 17 BBBBB CCC DDD EEE FFFF GGGG HH - 18 BBBBB CCC DDD EEEE FFF GGGG HHHH - 19 BBBBB CCC DD EEEE FFF GGG HHHHH - 20 BBBBB CCC DDD EEEE FFF GGG HHHHHH - 20 BBBBB CCC DD EEEEE FFF GGGG HHHHHH - 22 BBBBB CCC DD EEEE FFF GGGG HHHHHH - 23 BBBBBB CCC DD EE FFF GGG HHHH - 24 BBBBBB CCC DD EE E FFF GGG HHHH - 25 BBBBB CC D EE FFFEEE FFF GGG HHH II - 26 BBBBB CC DD E F G - 27 BBBBB CCC DD EE F G - 28 BBBBB CCC DD E F GH - 29 BBBBB CCC D E F G H - 30 BBBBB CC DD E F G HI - 30 BBBBB CC DD EE F G HI - 32 BBBBB CC DD E F G I - 33 BBBBB CC DD E F G I - 34 BBBBB CC DD E FF H I - 35 BBBBB CC D E F G H I - 36 BBBBB CC D E F G H I - 37 BBBBB CC D E F G H I - 38 BBBBB CC D E F G H I - 39 BBBBB CC D E F G H I - 40 BBBBB CC D E F G H I - 40 BBBBB CC D E F G H I - 42 BBBBB CC D E F G H I - 43 BBBBB CC D E F G H I - 44 BBBBB CC D E F G H I - 45 BBBBB CC D E F G H I - 46 BBBBB CC D E F G H I - 47 BBBBB CC D E F G H I - 48 BBBBB CC D E F G H I - 49 BBBBB CCC D E F G H I - 50 BBBBB CCC D E F G H I - 50 BBBBB CCC D E F G H I - 52 BBBBB CC D E F G H I - 53 BBBBB CC D E F G H I - 54 BBBBB CC D E F G H I - 55 BBBBB CC D E F G H I - 56 BBBBB CC D E F G H I - 57 BBBBB CC D E F G H I - 58 BBBBB CC D E F G H I - 59 BBBBB CC D E F G H I - 60 BBBBB CC D E F G H I - 60 BBBBB CC D E F G H I - 62 BBBBB CC D E F G H I - 63 BBBBB CC D E F G H I - 64 BBBBB CC D E F G H I - 65 BBBBB CC D E F G H I - 66 BBBBB CC DD E FF H I - 67 BBBBB CC DD E F G I - 68 BBBBB CC DD E F G I - 69 BBBBB CC DD EE F G HI - 70 BBBBB CC DD E F G HI - 70 BBBBB CCC D E F G H - 72 BBBBB CCC DD E F GH - 73 BBBBB CCC DD EE F G - 74 BBBBB CC DD E F G - 75 BBBBB CC D EE FFFEEE FFF GGG HHH II - 76 BBBBB CCC DD EE E FFF GGG HHHH - 77 BBBBBB CCC DD EEE FFF GGG HHH - 78 BBBBBB CCC DDD EEEE FFFF GGG HHHHH - 79 BBBBB CCC DD EEEEE FFFF GGGG HHHHHHH - 80 BBBBB CCC DDD EEEE FFFF GGGG HHHHHH - 80 BBBBB CCC DD EEEE FFFF GGGG HHHHHH - 82 BBBBB CCC DDD EEEE FFFF GGGG HHHHH - 83 BBBBB CCC DDD EEEE FFFF GGGG HHHHH - 84 BBBBB CCC DDD EEE FFF GGGG HHHH - 85 BBBBB CCC DDD EEE FFF GGGG HHHH - 86 BBBBB CCCC DDD EEE FFF GGGG HHH - 87 BBBBB CCCC DDD EEE FFF GGGG HH - 88 BBBBB CCCC DDD EEEE FFF GGGG HH - 89 BBBBB CCCC DDD EEEE FFF GGGG - 90 BBBBB CCCC DDD EEEE FFF GGGG - 90 BBBBB CCCC DDD EEE FFF GGGG - 92 BBBBB CCCC DDD EEE FFF GGGG - 93 BBBBB CCCC DDD EEE FFF GGGG - 94 BBBBB CCC DDDD EEE FFF GGGG - 95 BBBBB CCC DDDD EEE FFF GGGG - 96 BBBBBB CCC DDDD EEE FFF GGGG - 97 BBBBBB CCC DDDD EEE FFF GGGG - 98 BBBBBB CCC DDDD EEE FFF GGGG - 99 BBBBBB CCC DDDD EEE FFF GGGG - 100 BBBBBB CCC DDDD EEE FFF GGGG - - TIMES: ET= 526.93, PT= 523.87, IO= 9.37 - - - - - LABEL 000000000OUTPUT 00186183CC USER=0000000; COMPILE HMSS2/0000000 XALGOL ;XALGOL FILE CARD=PASC85 HMSS2 /0000000 + 0 BBBBBB CCCCC DDDDD EEEEEEEEEEEEEEEEEEEEE DDDDD CCCCC BBBBBB + 1 BBBBBB CCCCC DDDDD EEEEEEE EEEEEEE DDDDD CCCCC BBBBBB + 2 BBBBB CCCCC DDDD EEEEE EEEEE DDDD CCCCC BBBBB + 3 BBBBBB CCCCC DDDD EEEEE FFFFFFFFFFF EEEEE DDDD CCCCC BBBBBB + 4 BBBBBB CCCC DDDD EEEE FFFFFFFFFFFFFFFFFFF EEEE DDDD CCCC BBBBBB + 5 BBBBB CCCC DDDD EEEEE FFFFFFF FFFFFFF EEEEE DDDD CCCC BBBBB + 6 BBBBBB CCCC DDDD EEEE FFFFF FFFFF EEEE DDDD CCCC BBBBBB + 7 BBBBBB CCCC DDDD EEE FFFFF FFFFF EEE DDDD CCCC BBBBBB + 8 BBBBB CCCC DDD EEE FFFFF GGGGGGGGG FFFFF EEE DDD CCCC BBBBB + 9 BBBBBB CCCC DDDD EEEE FFFFF GGGGGGGGGGGGG FFFFF EEEE DDDD CCCC BBBBBB + 10 BBBBBB CCC DDD EEE FFFF GGGGGGGGGGGGGGGGG FFFF EEE DDD CCC BBBBBB + 10 BBBBB CCCC DDDD EEEE FFFF GGGGGGGGG GGGGGGGGG FFFF EEEE DDDD CCCC BBBBB + 12 BBBBB CCCC DDD EEE FFF GGGGGG GGGGGG FFF EEE DDD CCCC BBBBB + 13 BBBBBB CCC DDD EEEE FFFF GGGGG GGGGG FFFF EEEE DDD CCC BBBBBB + 14 BBBBBB CCC DDDD EEE FFF GGGGG GGGGG FFF EEE DDDD CCC BBBBBB + 15 BBBBBB CCC DDD EEE FFF GGGG GGGG FFF EEE DDD CCC BBBBBB + 16 BBBBB CCCC DDD EEEE FFFF GGGGG GGGGG FFFF EEEE DDD CCCC BBBBB + 17 BBBBB CCC DDD EEE FFFF GGGG HHH GGGG FFFF EEE DDD CCC BBBBB + 18 BBBBB CCC DDD EEEE FFF GGGG HHHHHHH GGGG FFF EEEE DDD CCC BBBBB + 19 BBBBB CCC DD EEEE FFF GGG HHHHHHHHH GGG FFF EEEE DD CCC BBBBB + 20 BBBBB CCC DDD EEEE FFF GGG HHHHHHHHHHH GGG FFF EEEE DDD CCC BBBBB + 20 BBBBB CCC DD EEEEE FFF GGGG HHHHHHHHHHH GGGG FFF EEEEE DD CCC BBBBB + 22 BBBBB CCC DD EEEE FFF GGGG HHHHHH HHHHHH GGGG FFF EEEE DD CCC BBBBB + 23 BBBBBB CCC DD EE FFF GGG HHHH HHHH GGG FFF EE DD CCC BBBBBB + 24 BBBBBB CCC DD EE E FFF GGG HHHH HHHH GGG FFF E EE DD CCC BBBBBB + 25 BBBBB CC D EE FFFEEE FFF GGG HHH III HHH GGG FFF EEEFFF EE D CC BBBBB + 26 BBBBB CC DD E F G G F E DD CC BBBBB + 27 BBBBB CCC DD EE F G G F EE DD CCC BBBBB + 28 BBBBB CCC DD E F GH HG F E DD CCC BBBBB + 29 BBBBB CCC D E F G H H G F E D CCC BBBBB + 30 BBBBB CC DD E F G HI IH G F E DD CC BBBBB + 30 BBBBB CC DD EE F G HI IH G F EE DD CC BBBBB + 32 BBBBB CC DD E F G I I G F E DD CC BBBBB + 33 BBBBB CC DD E F G I I G F E DD CC BBBBB + 34 BBBBB CC DD E FF H I I H FF E DD CC BBBBB + 35 BBBBB CC D E F G H I I H G F E D CC BBBBB + 36 BBBBB CC D E F G H I I H G F E D CC BBBBB + 37 BBBBB CC D E F G H I I H G F E D CC BBBBB + 38 BBBBB CC D E F G H I I H G F E D CC BBBBB + 39 BBBBB CC D E F G H I I H G F E D CC BBBBB + 40 BBBBB CC D E F G H I I H G F E D CC BBBBB + 40 BBBBB CC D E F G H I I H G F E D CC BBBBB + 42 BBBBB CC D E F G H I I H G F E D CC BBBBB + 43 BBBBB CC D E F G H I I H G F E D CC BBBBB + 44 BBBBB CC D E F G H I I H G F E D CC BBBBB + 45 BBBBB CC D E F G H I I H G F E D CC BBBBB + 46 BBBBB CC D E F G H I I H G F E D CC BBBBB + 47 BBBBB CC D E F G H I I H G F E D CC BBBBB + 48 BBBBB CC D E F G H I I H G F E D CC BBBBB + 49 BBBBB CCC D E F G H I I H G F E D CCC BBBBB + 50 BBBBB CCC D E F G H I I H G F E D CCC BBBBB + 50 BBBBB CCC D E F G H I I H G F E D CCC BBBBB + 52 BBBBB CC D E F G H I I H G F E D CC BBBBB + 53 BBBBB CC D E F G H I I H G F E D CC BBBBB + 54 BBBBB CC D E F G H I I H G F E D CC BBBBB + 55 BBBBB CC D E F G H I I H G F E D CC BBBBB + 56 BBBBB CC D E F G H I I H G F E D CC BBBBB + 57 BBBBB CC D E F G H I I H G F E D CC BBBBB + 58 BBBBB CC D E F G H I I H G F E D CC BBBBB + 59 BBBBB CC D E F G H I I H G F E D CC BBBBB + 60 BBBBB CC D E F G H I I H G F E D CC BBBBB + 60 BBBBB CC D E F G H I I H G F E D CC BBBBB + 62 BBBBB CC D E F G H I I H G F E D CC BBBBB + 63 BBBBB CC D E F G H I I H G F E D CC BBBBB + 64 BBBBB CC D E F G H I I H G F E D CC BBBBB + 65 BBBBB CC D E F G H I I H G F E D CC BBBBB + 66 BBBBB CC DD E FF H I I H FF E DD CC BBBBB + 67 BBBBB CC DD E F G I I G F E DD CC BBBBB + 68 BBBBB CC DD E F G I I G F E DD CC BBBBB + 69 BBBBB CC DD EE F G HI IH G F EE DD CC BBBBB + 70 BBBBB CC DD E F G HI IH G F E DD CC BBBBB + 70 BBBBB CCC D E F G H H G F E D CCC BBBBB + 72 BBBBB CCC DD E F GH HG F E DD CCC BBBBB + 73 BBBBB CCC DD EE F G G F EE DD CCC BBBBB + 74 BBBBB CC DD E F G G F E DD CC BBBBB + 75 BBBBB CC D EE FFFEEE FFF GGG HHH III HHH GGG FFF EEEFFF EE D CC BBBBB + 76 BBBBB CCC DD EE E FFF GGG HHHH HHHH GGG FFF E EE DD CCC BBBBB + 77 BBBBBB CCC DD EEE FFF GGG HHH HHH GGG FFF EEE DD CCC BBBBBB + 78 BBBBBB CCC DDD EEEE FFFF GGG HHHHH HHHHH GGG FFFF EEEE DDD CCC BBBBBB + 79 BBBBB CCC DD EEEEE FFFF GGGG HHHHHHHHHHHHH GGGG FFFF EEEEE DD CCC BBBBB + 80 BBBBB CCC DDD EEEE FFFF GGGG HHHHHHHHHHH GGGG FFFF EEEE DDD CCC BBBBB + 80 BBBBB CCC DD EEEE FFFF GGGG HHHHHHHHHHH GGGG FFFF EEEE DD CCC BBBBB + 82 BBBBB CCC DDD EEEE FFFF GGGG HHHHHHHHH GGGG FFFF EEEE DDD CCC BBBBB + 83 BBBBB CCC DDD EEEE FFFF GGGG HHHHHHHHH GGGG FFFF EEEE DDD CCC BBBBB + 84 BBBBB CCC DDD EEE FFF GGGG HHHHHHH GGGG FFF EEE DDD CCC BBBBB + 85 BBBBB CCC DDD EEE FFF GGGG HHHHHHH GGGG FFF EEE DDD CCC BBBBB + 86 BBBBB CCCC DDD EEE FFF GGGG HHHHH GGGG FFF EEE DDD CCCC BBBBB + 87 BBBBB CCCC DDD EEE FFF GGGG HHH GGGG FFF EEE DDD CCCC BBBBB + 88 BBBBB CCCC DDD EEEE FFF GGGG HHH GGGG FFF EEEE DDD CCCC BBBBB + 89 BBBBB CCCC DDD EEEE FFF GGGG GGGG FFF EEEE DDD CCCC BBBBB + 90 BBBBB CCCC DDD EEEE FFF GGGG GGGG FFF EEEE DDD CCCC BBBBB + 90 BBBBB CCCC DDD EEE FFF GGGG GGGG FFF EEE DDD CCCC BBBBB + 92 BBBBB CCCC DDD EEE FFF GGGG GGGG FFF EEE DDD CCCC BBBBB + 93 BBBBB CCCC DDD EEE FFF GGGG GGGG FFF EEE DDD CCCC BBBBB + 94 BBBBB CCC DDDD EEE FFF GGGG GGGG FFF EEE DDDD CCC BBBBB + 95 BBBBB CCC DDDD EEE FFF GGGG GGGG FFF EEE DDDD CCC BBBBB + 96 BBBBBB CCC DDDD EEE FFF GGGG GGGG FFF EEE DDDD CCC BBBBBB + 97 BBBBBB CCC DDDD EEE FFF GGGG GGGG FFF EEE DDDD CCC BBBBBB + 98 BBBBBB CCC DDDD EEE FFF GGGG GGGG FFF EEE DDDD CCC BBBBBB + 99 BBBBBB CCC DDDD EEE FFF GGGG GGGG FFF EEE DDDD CCC BBBBBB + 100 BBBBBB CCC DDDD EEE FFF GGGG GGGG FFF EEE DDDD CCC BBBBBB + TIMES: ET= 542.65, PT= 540.17, IO= 10.88 + LABEL 000000000OUTPUT 00186197CC USER=0000000; COMPILE HMSS2/0000000 XALGOL ;XALGOL FILE CARD=PASC00 HMSS2 /0000000 diff --git a/PASCAL-Heriot-Watt/PASCAL.MKXV-Compile.lst b/PASCAL-Heriot-Watt/PASCAL.MKXV-Compile.lst new file mode 100644 index 0000000..1797f1f --- /dev/null +++ b/PASCAL-Heriot-Watt/PASCAL.MKXV-Compile.lst @@ -0,0 +1,3805 @@ + LABEL 000000000LINE 00186197?RUN OBJECT/LISTER;FILE DISK=PASCAL SERIAL;END← OBJECT /LISTER + + + + + + BURROUGHS B-5700 XALGOL COUPILER MARK XV.3.00 WEDNESDAY, 07/16/86, 9:50 AM. + + + + PASCAL /NEW + =============== + + + 10001000 C 0000 + 10002000 C 0000 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10003000 C 0000 + % % 10004000 C 0000 + % % 10005000 C 0000 + % * * % 10006000 C 0000 + % * P A S C A L C O M P I L E R * % 10007000 C 0000 + % *********************************** % 10008000 C 0000 + % % 10009000 C 0000 + % % 10010000 C 0000 + % WRITTEN 1975 BY % 10011000 C 0000 + % DAG F. LANGMYHR, % 10012000 C 0000 + % HERIOT-WATT UNIVERSITY, % 10013000 C 0000 + % EDINBURGH. % 10014000 C 0000 + % % 10015000 C 0000 + % % 10016000 C 0000 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10017000 C 0000 + % % 10018000 C 0000 + % % 10019000 C 0000 + % PART 1: DECLARATIONS. % 10020000 C 0000 + % ------------- % 10021000 C 0000 + % % 10022000 C 0000 + % % 10023000 C 0000 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10024000 C 0000 + 10025000 C 0000 + 10026000 C 0000 + BEGIN 10027000 C 0000 + START OF SEGMENT ********** 2 + DEFINE EDITION="2.3"#; 10028000 C 0000 + INTEGER NUMERRS, % @R+21: NUMBER OF ERRORS IN PROGRAM. 10029000 C 0000 + SAVEFACTOR, % @R+22: SAVEFACTOR FOR CODE FILE. 10030000 C 0000 + % >0 COMPILE TO LIBRARY. 10031000 C 0000 + % =0 COMPILE AND RUN. 10032000 C 0000 + % <0 COMPILE FOR SYNTAX. 10033000 C 0000 + CARDCNT; % @R+23: NUMBER OF CARDS READ. 10034000 C 0000 + FILE CARD "SOURCE" (2,10,150); % SOURCE CODE INPUT FILE 10035000 C 0000 + FILE LINES 1 (2,17); % PRINT FILE. 10036000 C 0003 + FILE PASCALGOL DISK SERIAL [20:600] (2,10,150,SAVE 0); % CODE FILE 10037000 C 0007 + DEFINE LINESPERPAGE=58#, 10038000 C 0013 + MAXINT=549755813887#; 10039000 C 0013 + 10040000 C 0013 + %*** COMPILER CONSTANTS *** 10041000 C 0013 + DEFINE MAXTABLES =50#, %MAX NUMBER OF NAME TABLES. 10042000 C 0013 + MAXNAMES =997#, %MAX NAMES IN EACH TABLE. 10043000 C 0013 + MAXLEVEL =15#, %MAX DEPTH OF PROCEDURE DECLARATIONS. 10044000 C 0013 + MAXCASES =211#, %MAX LABELS IN A CASE-STATEMENT. 10045000 C 0013 + MAXLABS =100#, %MAX NUMBER OF LABELS. 10046000 C 0013 + MAXPARAMS =200#, %MAX NUMBER OF PARAMETERS IN WHOLE PROGRAM. 10047000 C 0013 + MAXTYPES =1022#, %MAX NUMBER OF DIFFERENT TYPES. 10048000 C 0013 + MAXCONSTS =200#, %SIZE OF CONSTANT TABLE. 10049000 C 0013 + MAXTEMPS =5#, %NUMBER OF EXTRA VARS IN EACH PROCEDURE. 10050000 C 0013 + MAXWITHSYMS=250#, %MAX NUMBER OF SYMBOLS USED BY WITH-STATMS. 10051000 C 0013 + MAXSYMS =800#, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 C 0013 + LISTLENGTH =800#, %MAX LENGTH OF VAR AND PARAM LISTS. 10053000 C 0013 + MAXEXTFILES=20#, %MAX NUMBER OF EXTERNAL FILES. 10054000 C 0013 + MAXFILES =20#, %MAX NUMBER OF FILES DECLARED AT ONE TIME. 10055000 C 0013 + MAXPNTRS =50#; %MAX NUMBER OF UNDECLARED POINTERS. 10056000 C 0013 + 10057000 C 0013 + %*** NAME TABLES *** 10058000 C 0013 + ARRAY NAMETAB1,NAMETAB2,NAMETAB3[0:MAXTABLES,0:MAXNAMES]; 10059000 C 0013 + DEFINE NAMELENGTH =[41:6]#, 10060000 C 0015 + TYPE =[9:10]#, 10061000 C 0015 + IDCLASS =[12:3]#, 10062000 C 0015 + VAR =0#, 10063000 C 0015 + CONST=1#, 10064000 C 0015 + FUNC =2#, 10065000 C 0015 + PROC =3#, 10066000 C 0015 + TYPES=4#, 10067000 C 0015 + INFO =[23:11]#, 10068000 C 0015 + FORMAL =[24:1]#, 10069000 C 0015 + FORWARDDEF =[25:1]#, 10070000 C 0015 + EXTERNALFILE=[26:1]#; 10071000 C 0015 + 10072000 C 0015 + %*** DISPLAY VECTOR *** 10073000 C 0015 + ARRAY DISPLAY[0:MAXLEVEL]; 10074000 C 0015 + DEFINE RECTYPE =[9:10]#, 10075000 C 0017 + FIRSTWITHSYM =[19:10]#, 10076000 C 0017 + LASTWITHSYM =[29:10]#, 10077000 C 0017 + NUMPNTRSINWITH=[35:6]#, 10078000 C 0017 + BRACKETSINWITH=[36:1]#, 10079000 C 0017 + NAMETAB =[46:7]#; 10080000 C 0017 + 10081000 C 0017 + %*** TYPE TABLES *** 10082000 C 0017 + ARRAY TYPETAB1,TYPETAB2,TYPETAB3[0:MAXTYPES]; 10083000 C 0017 + DEFINE FORM =[3:4]#, 10084000 C 0019 + NUMERIC =0#, 10085000 C 0019 + SYMBOLIC=1#, 10086000 C 0019 + SUBTYPE =2#, 10087000 C 0019 + MAINTYPE=[33:10]#, 10088000 C 0019 + CHAR =3#, 10089000 C 0019 + FLOATING=4#, 10090000 C 0019 + ALFA =5#, 10091000 C 0019 + SET =6#, 10092000 C 0019 + SETTYPE =[33:10]#, 10093000 C 0019 + POINTERS=7#, 10094000 C 0019 + POINTTYPE=[33:10]#, 10095000 C 0019 + ARRAYS =8#, 10096000 C 0019 + INXTYPE =[33:10]#, 10097000 C 0019 + ARRTYPE =[43:10]#, 10098000 C 0019 + RECORD =9#, 10099000 C 0019 + RECTAB =[33:10]#, 10100000 C 0019 + FILES =10#, 10101000 C 0019 + FILETYPE=[33:10]#, 10102000 C 0019 + TEXTFILE=11#, 10103000 C 0019 + SIZE =[15:12]#, 10104000 C 0019 + STRUCT=[23:8]#; 10105000 C 0019 + INTEGER NUMTYPES; 10106000 C 0019 + 10107000 C 0019 + %*** PARAMETER TABLE *** 10108000 C 0019 + ARRAY PARAMTAB[0:MAXPARAMS]; 10109000 C 0019 + DEFINE PARAMNAME =[9:10]#, 10110000 C 0021 + PARAMKIND =[13:4]#, 10111000 C 0021 + PARAMLEVEL=[23:10]#, 10112000 C 0021 + PARAMTYPE =[33:10]#, 10113000 C 0021 + PARAMFILE =[34:1]#; 10114000 C 0021 + INTEGER NUMPARAMS; 10115000 C 0021 + 10116000 C 0021 + %*** CONSTANT TABLE *** 10117000 C 0021 + ARRAY CONSTTAB[0:MAXCONSTS]; 10118000 C 0021 + INTEGER NUMCONSTS; 10119000 C 0023 + 10120000 C 0023 + %*** LABEL TABLE *** 10121000 C 0023 + ARRAY LABTAB[0:MAXLABS]; 10122000 C 0023 + DEFINE LABVAL=[14:15]#, 10123000 C 0025 + LABDEF=[15:1]#; 10124000 C 0025 + INTEGER NUMLABS,FIRSTLAB; 10125000 C 0025 + 10126000 C 0025 + %*** TABLES FOR I/O AND CHARACTER HANDLING *** 10127000 C 0025 + ARRAY CH[0:0], TEXT[0:1], STRING[0:11]; 10128000 C 0025 + POINTER CHARPNT,TEXTPNT,TEXTPNT0,STRINGPNT; 10129000 C 0030 + ARRAY ICARD[0:9], LINE[0:16], XLINE[0:10], ALGOLCARD[0:9]; 10130000 C 0030 + POINTER CARDPNT,LINEPNT,XLINEPNT,ALGOLPNT; 10131000 C 0037 + INTEGER CHARCNT,ALGOLCNT,MARGINCNT; 10132000 C 0037 + ARRAY HEADTEXT[0:10], ERRLINE[0:16]; 10133000 C 0037 + INTEGER LINECNT,PAGECNT,ERRINX; 10134000 C 0040 + 10135000 C 0040 + %*** XREF FILE AND TABLE *** 10136000 C 0040 + FILE XREFFILE DISK SERIAL [20:3000] (2,3,150); 10137000 C 0040 + ARRAY BLOCKTAB[0:MAXTABLES], XREFLINE[0:16]; 10138000 C 0044 + INTEGER NUMXREF,NUMBLOCKS; POINTER XREFPNT; 10139000 C 0047 + % 10140000 C 0047 + %*** OTHER TABLES *** 10141000 C 0047 + INTEGER ARRAY VARLIST[0:LISTLENGTH]; % TEMPORARY LIST OF VARIABLES. 10142000 C 0047 + INTEGER VARINDEX,FIRSTVAR; 10143000 C 0049 + ARRAY SYMTAB[0:MAXSYMS]; % USED BY "EXPRESSION". 10144000 C 0049 + INTEGER NUMSYMS; 10145000 C 0051 + ARRAY WITHTAB[0:MAXWITHSYMS]; % USED BY "WITHSTAT". 10146000 C 0051 + INTEGER NWITHSYMS; 10147000 C 0053 + INTEGER ARRAY SYMBOL[0:64]; % USED BY "INSYMBOL". 10148000 C 0053 + INTEGER ARRAY SYMKIND[0:61]; % USED IN ERROR RECOVERY. 10149000 C 0054 + ARRAY PNTRTAB1,PNTRTAB2,PNTRTAB3[0:MAXPNTRS];% USED FOR FORWARD POINTERS 10150000 C 0056 + INTEGER NUMPNTRS; 10151000 C 0058 + ARRAY EXTFILETAB[0:MAXEXTFILES]; % EXTERNAL FILES. 10152000 C 0058 + INTEGER NUMEXTFILES; 10153000 C 0060 + ARRAY FILETAB[0:MAXFILES]; % FILES IN USE. 10154000 C 0060 + INTEGER NUMFILES; 10155000 C 0062 + BOOLEAN ARRAY ERR[0:119]; % RECORDS ERROR MESSAGES. 10156000 C 0062 + 10157000 C 0064 + %*** COMPILE TIME OPTIONS *** 10158000 C 0064 + BOOLEAN LISTOPTION,RESWORDOPTION,CHECKOPTION,DUMPOPTION,XREFOPTION; 10159000 C 0064 + INTEGER CARDLENGTH; 10160000 C 0064 + 10161000 C 0064 + %*** INTRINSIC TYPES *** 10162000 C 0064 + INTEGER INTTYPE,REALTYPE,ALFATYPE,CHARTYPE,BOOLTYPE,NILTYPE,TEXTTYPE, 10163000 C 0064 + INPUTFILE,OUTPUTFILE,EMPTYSET; 10164000 C 0064 + BOOLEAN INPUTDECL,OUTPUTDECL; 10165000 C 0064 + 10166000 C 0064 + %*** TEMPORARY VARIABLES *** 10167000 C 0064 + INTEGER T1,T2,T3,T4,T5; 10168000 C 0064 + 10169000 C 0064 + %*** OTHER VARIABLES *** 10170000 C 0064 + ALPHA USER; % THE USER NUMBER FOUND ON THE USER CARD. 10171000 C 0064 + 10172000 C 0064 + INTEGER CURLEVEL, % CURRENT PROCEDURE LEVEL. 10173000 C 0064 + TOPLEVEL, % TOP LEVEL IN DISPLAY VECTOR. 10174000 C 0064 + NUMBEGINS, % NUMBER OF "BEGIN"S IN THE PROGRAM. 10175000 C 0064 + NUMCASES, % NUMBER OF CASE-STATEMENTS IN PROGRAM. 10176000 C 0064 + NUMREPS, % NUMBER OF REPEAT-STATEMENTS IN PROGRAM. 10177000 C 0064 + NUMTEMPS, % NUMBER OF TEMPORARY VARIABLES IN USE. 10178000 C 0064 + CURFUNC, % INDEX OF FUNCTION CURRENTLY COMPILED. 10179000 C 0064 + CURSY, % LAST SYMBOL READ BY SCANNER. 10180000 C 0064 + CURTYPE, % TYPE OF ENTITY LAST COMPILED. 10181000 C 0064 + CURMODE, % CURRENT EXPRESSION MODE. 10182000 C 0064 + LASTREC; % LAST RECORD TABLE DEFINED. 10183000 C 0064 + 10184000 C 0064 + LABEL ENDOFINPUT; 10185000 C 0064 + 10186000 C 0064 + FORMAT NOERRORS ("NO ERRORS DETECTED."), 10187000 C 0064 + START OF SEGMENT ********** 3 + ERRORS (I5," ERRORS DETECTED"/), 10188000 C 0064 + ALIST ("$ SET LIST SINGLE"), 10189000 C 0064 + NOALIST ("$ RESET LIST"), 10190000 C 0064 + LASTLINE ("; TERMINATE: END OF PASCAL PROGRAM."), 10191000 C 0064 + TERMMESS ("**** END-OF-INPUT. COMPILATION TERMINATED."); 10192000 C 0064 + 3 IS 46 LONG, NEXT SEG 2 + MONITOR EXPOVR:=REALOVERFLOW; 10193000 C 0064 + 10194000 C 0066 + %*** SCANNER SYMBOLS *** 10195000 C 0066 + DEFINE IDENTIFIER=1#, INTCONST=2#, REALCONST=3#, ALFACONST=4#, 10196000 C 0066 + CHARCONST=5#, NOTSY=6#, ASTERISK=7#, SLASH=8#, 10197000 C 0066 + ANDSY=9#, DIVSY=10#, MODSY=11#, PLUS=12#, 10198000 C 0066 + MINUS=13#, ORSY=14#, LSSSY=15#, LEQSY=16#, 10199000 C 0066 + GEQSY=17#, GTRSY=18#, NEQSY=19#, EQLSY=20#, 10200000 C 0066 + INSY=21#, LPAR=22#, RPAR=23#, LBRACKET=24#, 10201000 C 0066 + RBRACKET=25#, DOUBLEDOT=26#, COMMA=27#, SEMICOLON=28#, 10202000 C 0066 + DOT=29#, ARROW=30#, COLON=31#, ASSIGNSY=32#, 10203000 C 0066 + BEGINSY=33#, ENDSY=34#, IFSY=35#, THENSY=36#, 10204000 C 0066 + ELSESY=37#, CASESY=38#, OFSY=39#, REPEATSY=40#, 10205000 C 0066 + UNTILSY=41#, WHILESY=42#, DOSY=43#, FORSY=44#, 10206000 C 0066 + TOSY=45#, DOWNTOSY=46#, GOTOSY=47#, NILSY=48#, 10207000 C 0066 + TYPESY=49#, ARRAYSY=50#, RECORDSY=51#, FILESY=52#, 10208000 C 0066 + SETSY=53#, CONSTSY=54#, VARSY=55#, LABELSY=56#, 10209000 C 0066 + FUNCSY=57#, PROCSY=58#, WITHSY=59#, PROGRAMSY=60#, 10210000 C 0066 + PACKEDSY=61#; 10211000 C 0066 + 10212000 C 0066 + DEFINE INITIAL=0#, MIDDLE=1#, TERMINAL=2#; 10213000 C 0066 + DEFINE NUMBER=0#, BITPATTERN=1#; 10214000 C 0066 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20001000 C 0066 + % % 20002000 C 0066 + % % 20003000 C 0066 + % % 20004000 C 0066 + % PART 2: COMPILER UTILITY ROUTINES. % 20005000 C 0066 + % -------------------------- % 20006000 C 0066 + % % 20007000 C 0066 + % % 20008000 C 0066 + % % 20009000 C 0066 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20010000 C 0066 + 20011000 C 0066 + 20012000 C 0066 + PROCEDURE INSYMBOL; FORWARD; 20013000 C 0066 + PROCEDURE WRITEALGOL; FORWARD; 20014000 C 0069 + PROCEDURE NEWXREF(NAME1,NAME2,TABLE,DECL); 20015000 C 0069 + VALUE NAME1, NAME2, TABLE, DECL; 20016000 C 0069 + REAL NAME1, NAME2; 20017000 C 0069 + INTEGER TABLE; 20018000 C 0069 + BOOLEAN DECL; 20019000 C 0069 + FORWARD; 20020000 C 0069 + 20021000 C 0069 + DEFINE NDIGITS(N)= 20022000 C 0069 + IF N≤ 9 THEN 1 ELSE 20023000 C 0069 + IF N≤99 THEN 2 ELSE 3 DIGITS#; 20024000 C 0069 + 20025000 C 0069 + DEFINE HEADING= 20026000 C 0069 + BEGIN COMMENT *** PRINTS A HEADING ON TOP OF A NEW PAGE. ; 20027000 C 0069 + PAGECNT:=PAGECNT+1; 20028000 C 0069 + REPLACE POINTER(HEADTEXT[*])+85 BY PAGECNT FOR NDIGITS(PAGECNT); 20029000 C 0069 + WRITE(LINES[PAGE]); 20030000 C 0069 + WRITE(LINES[DBL],11,HEADTEXT[*]); 20031000 C 0069 + LINECNT:=2; 20032000 C 0069 + END OF HEADING#; 20033000 C 0069 + 20034000 C 0069 + 20035000 C 0069 + DEFINE PRINTLINE= %*** PRINTS A SOURCE CODE LINE. 20036000 C 0069 + BEGIN 20037000 C 0069 + REPLACE LINEPNT-8 BY CARDCNT FOR 5 DIGITS; 20038000 C 0069 + IF LINECNT≥LINESPERPAGE THEN HEADING; 20039000 C 0069 + IF RESWORDOPTION THEN 20040000 C 0069 + BEGIN 20041000 C 0069 + WRITE(LINES[NO],11,XLINE[*]); 20042000 C 0069 + WRITE(LINES[NO],11,XLINE[*]); 20043000 C 0069 + END; 20044000 C 0069 + WRITE(LINES,17,LINE[*]); 20045000 C 0069 + LINECNT:=LINECNT+1; 20046000 C 0069 + END OF PRINTLINE#; 20047000 C 0069 + 20048000 C 0069 + 20049000 C 0069 + DEFINE NEWCARD= %*** READS A NEW SOURCE CODE CARD. 20050000 C 0069 + BEGIN 20051000 C 0069 + IF LISTOPTION THEN PRINTLINE; 20052000 C 0069 + IF ERRINX>0 THEN PRINTERRORS; 20053000 C 0069 + READ(CARD,10,ICARD[*]) [ENDOFINPUT]; 20054000 C 0069 + CARDPNT:=POINTER(ICARD[*]); 20055000 C 0069 + REPLACE LINEPNT BY CARDPNT FOR 10 WORDS, " " FOR 6 WORDS; 20056000 C 0069 + REPLACE XLINEPNT BY " " FOR 10 WORDS; 20057000 C 0069 + CHARCNT:=CARDLENGTH; 20058000 C 0069 + MARGINCNT:=85; 20059000 C 0069 + CARDCNT:=CARDCNT+1; 20060000 C 0069 + END#; 20061000 C 0069 + 20062000 C 0069 + 20063000 C 0069 + DEFINE GEN(T,N,START)= %*** GENERATE A TEXT "T", CONSISTING OF 20064000 C 0069 + BEGIN %*** "N" LETTERS, STARTING AT "START". 20065000 C 0069 + IF ALGOLCNT 0 THEN 20117000 C 0028 + BEGIN 20118000 C 0029 + WHILE ABSX≥1@7 DO BEGIN ABSX:=ABSX/10; POWER:=POWER+1; END; 20119000 C 0029 + WHILE ABSX<1@6 DO BEGIN ABSX:=ABSX×10; POWER:=POWER-1; END; 20120000 C 0037 + V1:=ENTIER(ABSX); 20121000 C 0043 + V2:=ENTIER((ABSX-V1)×1000000); 20122000 C 0044 + REPLACE ALGOLPNT:ALGOLPNT BY V1 FOR 7 DIGITS, ".", 20123000 C 0047 + V2 FOR 6 DIGITS, "@"; 20124000 C 0054 + ALGOLCNT:=ALGOLCNT-15; 20125000 C 0060 + IF POWER<0 THEN GEN("-",1,7); 20126000 C 0061 + POWER:=ABS(POWER); 20127000 C 0072 + REPLACE ALGOLPNT:ALGOLPNT BY POWER FOR 2 DIGITS; 20128000 C 0073 + ALGOLCNT:=ALGOLCNT-2; 20129000 C 0076 + END ELSE GEN("0",1,7); 20130000 C 0077 + IF X<0 THEN GEN(")",1,7); 20131000 C 0090 + END; 20132000 C 0100 + END OF GENREAL; 20133000 C 0100 + 4 IS 104 LONG, NEXT SEG 2 + 20134000 C 0069 + 20135000 C 0069 + INTEGER TYPEINDEX; 20136000 C 0069 + 20137000 C 0069 + DEFINE NEWTYPE= 20138000 C 0069 + BEGIN 20139000 C 0069 + IF NUMTYPES≥MAXTYPES THEN BEGIN ERROR(45);NUMTYPES:=MAXTYPES-20 END; 20140000 C 0069 + TYPEINDEX:=NUMTYPES:=NUMTYPES+1; 20141000 C 0069 + END #; 20142000 C 0069 + 20143000 C 0069 + 20144000 C 0069 + PROCEDURE WRITEALGOL; %*** WRITES A COMPLETED XALGOL CARD TO 20145000 C 0069 + BEGIN %*** THE FILE. 20146000 C 0069 + REPLACE POINTER(ALGOLCARD[9]) BY CARDCNT FOR 8 DIGITS; 20147000 C 0069 + WRITE(PASCALGOL,10,ALGOLCARD[*]); 20148000 C 0074 + IF DUMPOPTION THEN WRITE(LINES,10,ALGOLCARD[*]); 20149000 C 0079 + ALGOLPNT:=POINTER(ALGOLCARD[*]); ALGOLCNT:=71; 20150000 C 0084 + REPLACE ALGOLPNT BY " " FOR 9 WORDS; 20151000 C 0086 + END OF WRITEALGOL; 20152000 C 0089 + 20153000 C 0090 + 20154000 C 0090 + DEFINE MARGIN(LETTER,NUM)= 20155000 C 0090 + BEGIN COMMENT *** PLACES INFORMATION IN THE MARGIN. ; 20156000 C 0090 + IF MARGINCNT≤118 THEN 20157000 C 0090 + BEGIN TEXT[0]:=LETTER; 20158000 C 0090 + REPLACE LINEPNT+MARGINCNT BY TEXTPNT+5 FOR 2, 20159000 C 0090 + NUM FOR NDIGITS(NUM); 20160000 C 0090 + MARGINCNT:=MARGINCNT+6; 20161000 C 0090 + END; 20162000 C 0090 + END OF MARGIN#; 20163000 C 0090 + 20164000 C 0090 + 20165000 C 0090 + PROCEDURE SKIP(SYMBOL); %*** SKIP SYMBOLS TO RECOVER FROM ERROR 20166000 C 0090 + VALUE SYMBOL; INTEGER SYMBOL; %*** CONDITION. 20167000 C 0090 + BEGIN 20168000 C 0090 + WHILE CURSY≠SYMBOL AND SYMKIND[CURSY]=MIDDLE DO 20169000 C 0090 + IF CURSY=RECORDSY THEN 20170000 C 0092 + BEGIN DO BEGIN INSYMBOL; 20171000 C 0093 + SKIP(99); 20172000 C 0094 + END UNTIL CURSY≠SEMICOLON AND CURSY≠CASESY; 20173000 C 0095 + END ELSE INSYMBOL; 20174000 C 0097 + END OF SKIP; 20175000 C 0099 + 20176000 C 0099 + 20177000 C 0099 + PROCEDURE ERROR(ERRNUM); 20178000 C 0099 + VALUE ERRNUM; INTEGER ERRNUM; 20179000 C 0099 + BEGIN COMMENT *** ARRANGE ERROR INDICATOR. ; 20180000 C 0099 + NUMERRS:=NUMERRS+1; 20181000 C 0099 + ERR[ERRNUM]:=TRUE; 20182000 C 0101 + ERRINX:=MAX(ERRINX,CARDLENGTH-2-CHARCNT); 20183000 C 0102 + IF ERRINX≤115 THEN 20184000 C 0106 + BEGIN REPLACE POINTER(ERRLINE[1])+ERRINX BY "×", 20185000 C 0107 + ERRNUM FOR NDIGITS(ERRNUM); 20186000 C 0115 + ERRINX:=ERRINX+(IF ERRNUM≤ 9 THEN 2 ELSE 20187000 C 0122 + IF ERRNUM≤99 THEN 3 ELSE 4); 20188000 C 0124 + END END OF ERROR; 20189000 C 0127 + 20190000 C 0127 + 20191000 C 0127 + PROCEDURE PRINTERRORS; 20192000 C 0127 + BEGIN COMMENT *** PRINT ERROR INDICATORS. ; 20193000 C 0127 + IF NOT LISTOPTION THEN PRINTLINE; 20194000 C 0127 + WRITE(LINES,17,ERRLINE[*]); 20195000 C 0171 + LINECNT:=LINECNT+1; 20196000 C 0175 + REPLACE POINTER(ERRLINE[1]) BY " " FOR 16 WORDS; 20197000 C 0176 + ERRINX:=0; 20198000 C 0182 + END OF PRINT ERRORS; 20199000 C 0183 + 20200000 C 0183 + 20201000 C 0183 + DEFINE HASH(N) = (N).[35:36] MOD MAXNAMES#; 20202000 C 0183 + 20203000 C 0183 + INTEGER THISLEVEL,THISTAB,THISINDEX; 20204000 C 0183 + ALPHA THISID,TNAME; 20205000 C 0183 + BOOLEAN FOUND; 20206000 C 0183 + 20207000 C 0183 + DEFINE SEARCHTAB(TAB)= %*** SEARCH NAME TABLE "TAB" FOR THE 20208000 C 0183 + BEGIN %*** IDENTIFIER JUST READ. 20209000 C 0183 + THISINDEX:=HASH(CURNAME1); 20210000 C 0183 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20211000 C 0183 + WHILE (IF TNAME=CURNAME1 THEN NAMETAB2[TAB,THISINDEX]≠CURNAME2 20212000 C 0183 + ELSE TNAME≠0) DO 20213000 C 0183 + BEGIN 20214000 C 0183 + THISINDEX:=IF THISINDEX=0 THEN MAXNAMES ELSE THISINDEX-1; 20215000 C 0183 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20216000 C 0183 + END; 20217000 C 0183 + FOUND:=TNAME≠0; 20218000 C 0183 + IF XREFOPTION THEN 20219000 C 0183 + IF FOUND THEN NEWXREF(CURNAME1,CURNAME2,TAB,FALSE); % 20220000 C 0183 + END OF SEARCHTAB#; 20221000 C 0183 + 20222000 C 0183 + DEFINE SEARCH= %*** SEARCH ALL TABLES CURRENTLY IN USE. 20223000 C 0183 + BEGIN 20224000 C 0183 + THISLEVEL:=TOPLEVEL+1; 20225000 C 0183 + DO BEGIN 20226000 C 0183 + THISLEVEL:=THISLEVEL-1; 20227000 C 0183 + THISTAB:=IF THISLEVEL≤CURLEVEL THEN THISLEVEL 20228000 C 0183 + ELSE DISPLAY[THISLEVEL].NAMETAB; 20229000 C 0183 + SEARCHTAB(THISTAB); 20230000 C 0183 + END UNTIL FOUND OR THISLEVEL=0; 20231000 C 0183 + THISID:=NAMETAB3[THISTAB,THISINDEX]; 20232000 C 0183 + END OF SEARCH #; 20233000 C 0183 + 20234000 C 0183 + 20235000 C 0183 + DEFINE NEWNAME(NAME1,NAME2,TAB) = 20236000 C 0183 + BEGIN %*** ENTER A NEW NAME INTO THE NAME TABLE "TAB". 20237000 C 0183 + THISINDEX:=HASH(NAME1); 20238000 C 0183 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20239000 C 0183 + WHILE(IF TNAME=NAME1 THEN NAMETAB2[TAB,THISINDEX]≠NAME2 20240000 C 0183 + ELSE TNAME≠0) DO 20241000 C 0183 + BEGIN 20242000 C 0183 + THISINDEX:=IF THISINDEX=0 THEN MAXNAMES ELSE THISINDEX-1; 20243000 C 0183 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20244000 C 0183 + END; 20245000 C 0183 + IF TNAME≠0 THEN ERROR(2); 20246000 C 0183 + NAMETAB1[TAB,THISINDEX]:=NAME1; 20247000 C 0183 + NAMETAB2[TAB,THISINDEX]:=NAME2; 20248000 C 0183 + IF XREFOPTION THEN NEWXREF(NAME1,NAME2,TAB,TRUE); 20249000 C 0183 + END OF NEWNAME #; 20250000 C 0183 + 20251000 C 0183 + 20300000 C 0183 + PROCEDURE INITIALIZE; %*** INITIALIZATION *** 20301000 C 0183 + BEGIN %********************** 20302000 C 0183 + INTEGER T1,T3; 20303000 C 0183 + START OF SEGMENT ********** 5 + ALPHA A; 20304000 C 0000 + FILL SYMKIND[*] WITH 28(MIDDLE),TERMINAL,4(MIDDLE),INITIAL,TERMINAL, 20305000 C 0000 + START OF SEGMENT ********** 6 + INITIAL,MIDDLE,TERMINAL,INITIAL,MIDDLE,INITIAL,TERMINAL,INITIAL, 20306000 C 0001 + MIDDLE,INITIAL,2(MIDDLE),INITIAL,MIDDLE,INITIAL,4(MIDDLE), 20307000 C 0001 + 7(INITIAL),MIDDLE; 20308000 C 0001 + 6 IS 62 LONG, NEXT SEG 5 + 20309000 C 0001 + FILL SYMBOL[*] WITH 10(0),0,ARROW,0,COLON,GTRSY,GEQSY,PLUS,9(0), 20310000 C 0001 + START OF SEGMENT ********** 7 + DOT,LBRACKET,ANDSY,LPAR,LSSSY,ARROW,0,9(0),0,ASTERISK,MINUS, 20311000 C 0003 + RPAR,SEMICOLON,LEQSY,0,SLASH,8(0),COMMA,0,NEQSY,EQLSY,RBRACKET, 20312000 C 0003 + 0,DOUBLEDOT; 20313000 C 0003 + 7 IS 65 LONG, NEXT SEG 5 + 20314000 C 0003 + LINEPNT :=POINTER(LINE[1]); 20315000 C 0003 + XLINEPNT:=POINTER(XLINE[1]); 20316000 C 0006 + REPLACE LINEPNT-8 BY " => ", " " FOR 16 WORDS; 20317000 C 0009 + REPLACE XLINEPNT-8 BY " " FOR 11 WORDS; 20318000 C 0018 + REPLACE POINTER(ERRLINE[*]) BY "**** ", " " FOR 16 WORDS; 20319000 C 0023 + ALGOLPNT:=POINTER(ALGOLCARD[*]); ALGOLCNT:=71; 20320000 C 0032 + REPLACE ALGOLPNT BY " " FOR 9 WORDS; 20321000 C 0034 + CHARPNT:=POINTER(CH[*])+7; 20322000 C 0038 + TEXTPNT:=POINTER(TEXT[*])+1; TEXTPNT0:=TEXTPNT-1; 20323000 C 0041 + REPLACE TEXTPNT BY " " FOR 15; 20324000 C 0047 + STRINGPNT:=POINTER(STRING[*]); 20325000 C 0051 + REPLACE POINTER(HEADTEXT[*]) BY " " FOR 10 WORDS, "PAGE "; 20326000 C 0052 + REPLACE POINTER(HEADTEXT[*]) BY "PASCAL(", EDITION, ")/B-5700"; 20327000 C 0061 + TEXT[0]:=TIME(5); 20328000 C 0072 + REPLACE POINTER(HEADTEXT[*])+45 BY TEXTPNT+3 FOR 2, "/", 20329000 C 0073 + TEXTPNT+1 FOR 2, "/", TEXTPNT+5 FOR 2; 20330000 C 0084 + T1:=TIME(1)/3600; 20331000 C 0095 + REPLACE POINTER(HEADTEXT[*])+57 BY (T1 DIV 60) FOR 2 DIGITS, ":", 20332000 C 0097 + ENTIER(T1 MOD 60) FOR 2 DIGITS; 20333000 C 0107 + HEADING; 20334000 C 0111 + 20335000 C 0132 + %*** INITIALIZE INTRINSIC TYPES, CONSTANTS ETC. *** 20336000 C 0132 + 20337000 C 0132 + INTTYPE:=T3:=1; %*** "INTEGER" *** 20338000 C 0132 + T1:=NUMERIC; T1.SIZE:=1; T1.STRUCT:=0; 20339000 C 0133 + TYPETAB1[1]:=T1; TYPETAB2[1]:=-MAXINT; TYPETAB3[1]:=MAXINT; 20340000 C 0137 + NEWNAME("7INTEGE","R",0); T3.IDCLASS:=TYPES; 20341000 C 0141 + NAMETAB3[0,THISINDEX]:=T3; 20342000 C 0173 + REALTYPE:=T3:=2; %*** "REAL" *** 20343000 C 0175 + T1.FORM:=FLOATING; TYPETAB1[2]:=T1; 20344000 C 0176 + NEWNAME("400REAL",0,0); T3.IDCLASS:=TYPES; 20345000 C 0179 + NAMETAB3[0,THISINDEX]:=T3; 20346000 C 0206 + ALFATYPE:=T3:=3; %*** "ALFA" *** 20347000 C 0208 + T1.FORM:=ALFA; TYPETAB1[3]:=T1; 20348000 C 0209 + NEWNAME("400ALFA",0,0); T3.IDCLASS:=TYPES; 20349000 C 0212 + NAMETAB3[0,THISINDEX]:=T3; 20350000 C 0239 + BOOLTYPE:=T3:=4; %*** "BOOLEAN" *** 20351000 C 0241 + T1.FORM:=SYMBOLIC; TYPETAB1[4]:=T1; TYPETAB3[4]:=1; 20352000 C 0242 + NEWNAME("7BOOLEA","N",0); T3.IDCLASS:=TYPES; 20353000 C 0246 + NAMETAB3[0,THISINDEX]:=T3; 20354000 C 0273 + CHARTYPE:=T3:=5; %*** "CHAR" *** 20355000 C 0275 + T1.FORM:=CHAR; TYPETAB1[5]:=T1; TYPETAB3[5]:=63; 20356000 C 0276 + NEWNAME("400CHAR",0,0); T3.IDCLASS:=TYPES; 20357000 C 0280 + NAMETAB3[0,THISINDEX]:=T3; 20358000 C 0307 + T3:=BOOLTYPE; T3.IDCLASS:=CONST; %*** "FALSE" *** 20359000 C 0309 + NEWNAME("50FALSE",0,0); NAMETAB3[0,THISINDEX]:=T3; 20360000 C 0311 + T3.INFO:=1; %*** "TRUE" *** 20361000 C 0338 + NEWNAME("400TRUE",0,0); NAMETAB3[0,THISINDEX]:=T3; 20362000 C 0340 + NUMTYPES:=5; 20363000 C 0367 + NILTYPE:=-1; %*** TYPE OF "NIL" *** 20364000 C 0368 + EMPTYSET:=-2; %*** TYPE OF [] *** 20365000 C 0369 + NEWNAME("6MAXINT",0,0); T3:=INTTYPE; %*** "MAXINT" *** 20366000 C 0370 + T3.IDCLASS:=CONST; T3.INFO:=1024; 20367000 C 0396 + NAMETAB3[0,THISINDEX]:=T3; 20368000 C 0399 + NUMCONSTS:=1; CONSTTAB[1]:=MAXINT; 20369000 C 0401 + 20370000 C 0403 + T3:=0; T3.IDCLASS:=PROC; %*** PROCEDURES *** 20371000 C 0403 + FOR A:="3000GET", "3000NEW", "400PACK", "400PAGE", "3000PUT", 20372000 C 0406 + "400READ", "6READLN", "50RESET", "6UNPACK", "50WRITE" DO 20373000 C 0416 + BEGIN 20374000 C 0426 + NEWNAME(A,0,0); NAMETAB3[0,THISINDEX]:=T3; 20375000 C 0426 + END; 20376000 C 0464 + NEWNAME("7DISPOS","E",0); NAMETAB3[0,THISINDEX]:=T3; 20377000 C 0464 + NEWNAME("7REWRIT","E",0); NAMETAB3[0,THISINDEX]:=T3; 20378000 C 0491 + NEWNAME("7WRITEL","N",0); NAMETAB3[0,THISINDEX]:=T3; 20379000 C 0518 + 20380000 C 0545 + T3.IDCLASS:=FUNC; %*** FUNCTIONS *** 20381000 C 0545 + FOR A:="3000ABS", "6ARCTAN", "3000CHR", "3000COS", "3000EOF", 20382000 C 0547 + "400EOLN", "3000EXP", "20000LN", "3000ODD", "400PRED", 20383000 C 0557 + "400SUCC", "50ROUND", "3000SIN", "3000SQR", "400SQRT", 20384000 C 0567 + "50TRUNC", "6CONCAT", "400TIME", "400DATE", "6IOTIME", 20385000 C 0577 + "400USER", "3000ORD" 20386000 C 0587 + DO BEGIN 20387000 C 0590 + NEWNAME(A,0,0); NAMETAB3[0,THISINDEX]:=T3; 20388000 C 0591 + END; 20389000 C 0639 + NEWNAME("7ELAPSE","D",0); NAMETAB3[0,THISINDEX]:=T3; 20390000 C 0639 + NEWNAME("7WEEKDA","Y",0); NAMETAB3[0,THISINDEX]:=T3; 20391000 C 0666 + 20392000 C 0693 + TEXTTYPE:=T3:=NUMTYPES:=NUMTYPES+1; %*** "TEXT" *** 20393000 C 0693 + T1 := TEXTFILE; T1.STRUCT := 1; TYPETAB1[TEXTTYPE] := T1; % 20394000 C 0695 + T3.IDCLASS := TYPES; % 20395000 C 0699 + NEWNAME("400TEXT",0,0); NAMETAB3[0,THISINDEX]:=T3; 20396000 C 0701 + T3:=TEXTTYPE; T3.IDCLASS:=VAR; %*** "INPUT" *** 20397000 C 0728 + T3.EXTERNALFILE:=1; 20398000 C 0730 + NEWNAME("50INPUT",0,0); INPUTFILE:=THISINDEX; 20399000 C 0732 + NAMETAB3[0,THISINDEX]:=T3; 20400000 C 0758 + NEWNAME("6OUTPUT",0,0); %*** "OUTPUT" *** 20401000 C 0760 + NAMETAB3[0,THISINDEX]:=T3; OUTPUTFILE:=THISINDEX; 20402000 C 0785 + END OF INTIALIZED; 20403000 C 0788 + 5 IS 793 LONG, NEXT SEG 2 + 20404000 C 0183 + 20500000 C 0183 + 20501000 C 0183 + %*** XREF ROUTINES *** 20502000 C 0183 + %********************** 20503000 C 0183 + 20504000 C 0183 + DEFINE XREFCARD=[16:17]#, 20505000 C 0183 + XREFBLOCK=[26:10]#; 20506000 C 0183 + REAL A0,B0,A1,B1,LASTA0,LASTA1; 20507000 C 0183 + INTEGER NL,LASTBLOCK,A2,AX; 20508000 C 0183 + 20509000 C 0183 + PROCEDURE NEWXREF(NAME1,NAME2,TABLE,DECL); 20510000 C 0183 + VALUE NAME1,NAME2,TABLE,DECL; 20511000 C 0183 + REAL NAME1,NAME2; 20512000 C 0183 + INTEGER TABLE; 20513000 C 0183 + BOOLEAN DECL; 20514000 C 0183 + BEGIN 20515000 C 0183 + NL:=NAME1.NAMELENGTH; 20516000 C 0183 + IF NL<7 THEN NAME1:=0&NAME1[41:41:6]&NAME1[35:6×NL-1:6×NL] 20517000 C 0185 + ELSE NAME2:=0&NAME2[35:6×(NL-6)-1:6×(NL-6)]; 20518000 C 0192 + AX:=CARDCNT; AX.XREFBLOCK:=BLOCKTAB[TABLE]; 20519000 C 0199 + IF DECL THEN AX:=AX-100000000000; 20520000 C 0201 + WRITE(XREFFILE,*,NAME1,NAME2,AX); 20521000 C 0203 + END OF NEWXREF; 20522000 C 0215 + 20523000 C 0215 + PROCEDURE XREFMAX(A); 20524000 C 0215 + ARRAY A[0]; 20525000 C 0215 + BEGIN 20526000 C 0215 + A[0]:="AZZZZZZ"; A[1]:="ZZZZZZ"; A[2]:=9999999999; 20527000 C 0215 + END OF XREFMAX; 20528000 C 0219 + 20529000 C 0223 + 20530000 C 0223 + BOOLEAN PROCEDURE XREFCOMPARE(A,B); 20531000 C 0223 + ARRAY A,B[0]; 20532000 C 0223 + BEGIN 20533000 C 0223 + A0:=A[0]; B0:=B[0]; A1:=A[1]; B1:=B[1]; 20534000 C 0223 + XREFCOMPARE:= 20535000 C 0227 + IF A0.[35:36]≠B0.[35:36] THEN A0.[35:36]LINESPERPAGE THEN HEADING; 20561000 C 0264 + XREFPNT:=POINTER(XREFLINE[*]); NUMXREF:=0; 20562000 C 0286 + REPLACE XREFPNT BY " " FOR 17 WORDS; XREFPNT:=XREFPNT+24; 20563000 C 0288 + END; 20564000 C 0294 + REPLACE XREFPNT BY A2.XREFCARD FOR 5 DIGITS; 20565000 C 0294 + XREFPNT:=XREFPNT+7; NUMXREF:=NUMXREF+1; 20566000 C 0298 + END ELSE 20567000 C 0302 + IF A2<0 THEN 20568000 C 0302 + BEGIN 20569000 C 0304 + A2:=A2+100000000000; 20570000 C 0304 + WRITE(LINES,17,XREFLINE[*]); LINECNT:=LINECNT+1; 20571000 C 0305 + IF LINECNT>LINESPERPAGE THEN HEADING; 20572000 C 0311 + XREFPNT:=POINTER(XREFLINE[*]); NUMXREF:=0; 20573000 C 0333 + REPLACE XREFPNT BY " " FOR 17 WORDS; 20574000 C 0335 + TEXT[0]:=A0.[35:36]; LASTA0:=A0; 20575000 C 0338 + REPLACE XREFPNT BY TEXTPNT+1 FOR A0.NAMELENGTH; 20576000 C 0341 + TEXT[0]:=LASTA1:=A1; 20577000 C 0346 + IF A0.NAMELENGTH>6 THEN 20578000 C 0348 + REPLACE XREFPNT+6 BY TEXTPNT+1 FOR A0.NAMELENGTH-6; 20579000 C 0349 + REPLACE XREFPNT+17 BY A2.XREFCARD FOR 5 DIGITS; 20580000 C 0357 + XREFPNT:=XREFPNT+24; LASTBLOCK:=A2.XREFBLOCK; 20581000 C 0363 + END; 20582000 C 0367 + END; 20583000 C 0367 + END OF PRINTXREF; 20584000 C 0367 + 20585000 C 0369 + 20800000 C 0369 + 20801000 C 0369 + INTEGER TT1,TT2,F1,F2,LT,RT; 20802000 C 0369 + 20803000 C 0369 + DEFINE CHECKTYPES(LEFTTYPE,RIGHTTYPE)= 20804000 C 0369 + BEGIN 20805000 C 0369 + IF LEFTTYPE>0 AND RIGHTTYPE>0 THEN 20806000 C 0369 + IF LEFTTYPE≠RIGHTTYPE THEN 20807000 C 0369 + BEGIN 20808000 C 0369 + LT:=LEFTTYPE; RT:=RIGHTTYPE; 20809000 C 0369 + TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20810000 C 0369 + F1:=TT1.FORM; F2:=TT2.FORM; 20811000 C 0369 + IF LT≠REALTYPE OR F2≠NUMERIC THEN 20812000 C 0369 + IF(F1≠SET AND LT≠EMPTYSET)OR(F2≠SET AND RT≠EMPTYSET)THEN 20813000 C 0369 + IF(F1≠POINTERS AND LT≠NILTYPE)OR(F2≠POINTERS AND RT≠NILTYPE)THEN 20814000 C 0369 + BEGIN 20815000 C 0369 + IF F1=SET AND F2=SET THEN 20816000 C 0369 + BEGIN 20817000 C 0369 + LT:=TT1.SETTYPE; RT:=TT2.SETTYPE; 20818000 C 0369 + TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20819000 C 0369 + F1:=TT1.FORM; F2:=TT2.FORM; 20820000 C 0369 + END; 20821000 C 0369 + IF F1=POINTERS AND F2=POINTERS THEN 20822000 C 0369 + BEGIN 20823000 C 0369 + LT:=TT1.POINTTYPE; RT:=TT2.POINTTYPE; 20824000 C 0369 + TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20825000 C 0369 + F1:=TT1.FORM; F2:=TT2.FORM; 20826000 C 0369 + END; 20827000 C 0369 + WHILE F1=SUBTYPE DO 20828000 C 0369 + BEGIN LT:=TT1.MAINTYPE; TT1:=TYPETAB1[LT]; F1:=TT1.FORM END; 20829000 C 0369 + WHILE F2=SUBTYPE DO 20830000 C 0369 + BEGIN RT:=TT2.MAINTYPE; TT2:=TYPETAB1[RT]; F2:=TT2.FORM END; 20831000 C 0369 + IF LT>0 AND RT>0 THEN 20832000 C 0369 + IF LT≠RT THEN 20833000 C 0369 + IF F1≠NUMERIC OR F2≠NUMERIC THEN 20834000 C 0369 + IF F1≠CHAR OR F2≠CHAR THEN ERROR(17); 20835000 C 0369 + END; 20836000 C 0369 + END; 20837000 C 0369 + END OF CHECKTYPES#; 20838000 C 0369 + 20839000 C 0369 + 20840000 C 0369 + INTEGER FILENAME; 20841000 C 0369 + BOOLEAN LPARFOUND; 20842000 C 0369 + 20843000 C 0369 + DEFINE FILEPARAM(DEFAULTFILE)=%*** CHECKS THE FIRST PARAMETER TO SEE 20844000 C 0369 + BEGIN %*** IF IT IS A FILE. 20845000 C 0369 + INSYMBOL; FILENAME:=CURTYPE:=0; 20846000 C 0369 + LPARFOUND:=CURSY=LPAR; 20847000 C 0369 + IF LPARFOUND THEN 20848000 C 0369 + BEGIN 20849000 C 0369 + INSYMBOL; 20850000 C 0369 + IF CURSY=IDENTIFIER THEN 20851000 C 0369 + BEGIN 20852000 C 0369 + SEARCH; 20853000 C 0369 + IF FOUND THEN 20854000 C 0369 + BEGIN 20855000 C 0369 + IF THISID.IDCLASS=VAR THEN 20856000 C 0369 + BEGIN 20857000 C 0369 + CURTYPE:=THISID.TYPE; 20858000 C 0369 + IF TYPETAB1[CURTYPE].FORM≥FILES THEN 20859000 C 0369 + BEGIN 20860000 C 0369 + FILENAME:=1000×THISLEVEL+THISINDEX; 20861000 C 0369 + INSYMBOL; 20862000 C 0369 + END END END END; 20863000 C 0369 + IF SYMKIND[CURSY]=TERMINAL THEN ERROR(46); 20864000 C 0369 + END; 20865000 C 0369 + IF FILENAME=0 THEN FILENAME:=DEFAULTFILE; 20866000 C 0369 + IF (FILENAME=INPUTFILE AND NOT INPUTDECL) OR 20867000 C 0369 + (FILENAME=OUTPUTFILE AND NOT OUTPUTDECL) THEN ERROR(96); 20868000 C 0369 + END OF FILEPARAM#; 20869000 C 0369 + 20870000 C 0369 + 20871000 C 0369 + INTEGER TFORM; 20872000 C 0369 + BOOLEAN SIGNED,NEGATIVE; 20873000 C 0369 + 20874000 C 0369 + DEFINE CONSTANT(CVAL,CTYPE)= %*** *** 20875000 C 0369 + BEGIN %****************** 20876000 C 0369 + IF CURSY=MINUS OR CURSY=PLUS THEN 20877000 C 0369 + BEGIN SIGNED:=TRUE; NEGATIVE:=CURSY=MINUS; 20878000 C 0369 + INSYMBOL; 20879000 C 0369 + END ELSE SIGNED:=NEGATIVE:=FALSE; 20880000 C 0369 + IF CURSY=INTCONST THEN 20881000 C 0369 + BEGIN CTYPE:=INTTYPE; 20882000 C 0369 + CVAL:=IF NEGATIVE THEN -CURVAL ELSE CURVAL; 20883000 C 0369 + END ELSE 20884000 C 0369 + IF CURSY=CHARCONST THEN 20885000 C 0369 + BEGIN IF SIGNED THEN ERROR(29); 20886000 C 0369 + CTYPE:=CHARTYPE; CVAL:=CURVAL; 20887000 C 0369 + END ELSE 20888000 C 0369 + IF CURSY=REALCONST THEN 20889000 C 0369 + BEGIN CTYPE:=REALTYPE; 20890000 C 0369 + CVAL:=IF NEGATIVE THEN -CURVAL ELSE CURVAL; 20891000 C 0369 + END ELSE 20892000 C 0369 + IF CURSY=ALFACONST THEN 20893000 C 0369 + BEGIN IF SIGNED THEN ERROR(29); 20894000 C 0369 + IF CURLENGTH>7 THEN ERROR(41); 20895000 C 0369 + CTYPE:=ALFATYPE; CVAL:=CURVAL; 20896000 C 0369 + END ELSE 20897000 C 0369 + IF CURSY=IDENTIFIER THEN 20898000 C 0369 + BEGIN 20899000 C 0369 + SEARCH; 20900000 C 0369 + IF FOUND THEN 20901000 C 0369 + BEGIN 20902000 C 0369 + IF THISID.IDCLASS=CONST AND NOT BOOLEAN(THISID.FORMAL) THEN 20903000 C 0369 + BEGIN 20904000 C 0369 + IF TYPETAB1[THISID.TYPE].FORM≤ALFA THEN 20905000 C 0369 + BEGIN 20906000 C 0369 + CVAL:=THISID.INFO; 20907000 C 0369 + IF CVAL>1023 THEN CVAL:=CONSTTAB[CVAL-1023]; 20908000 C 0369 + CTYPE:=THISID.TYPE; 20909000 C 0369 + IF SIGNED THEN 20910000 C 0369 + BEGIN 20911000 C 0369 + TFORM:=TYPETAB1[THISID.TYPE].FORM; 20912000 C 0369 + IF TFORM≠NUMERIC AND TFORM≠FLOATING THEN ERROR(29) ELSE 20913000 C 0369 + IF NEGATIVE THEN CVAL:=-CVAL; 20914000 C 0369 + END; 20915000 C 0369 + END ELSE BEGIN ERROR(48); CVAL:=CTYPE:=0 END; 20916000 C 0369 + END ELSE BEGIN ERROR(32); CVAL:=CTYPE:=0 END; 20917000 C 0369 + END ELSE BEGIN ERROR(1); CVAL:=CTYPE:=0 END; 20918000 C 0369 + END ELSE BEGIN ERROR(32); CVAL:=CTYPE:=0 END; 20919000 C 0369 + INSYMBOL; 20920000 C 0369 + END OF CONSTANT#; 20921000 C 0369 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 30001000 C 0369 + % % 30002000 C 0369 + % % 30003000 C 0369 + % % 30004000 C 0369 + % PART 3: THE SCANNER. % 30005000 C 0369 + % ------------ % 30006000 C 0369 + % % 30007000 C 0369 + % % 30008000 C 0369 + % % 30009000 C 0369 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 30010000 C 0369 + 30011000 C 0369 + % INTERNAL INTERNAL SYMBOL 30012000 C 0369 + % SYMBOL NUMBER NAME KIND 30013000 C 0369 + % 30014000 C 0369 + % IDENTIFIER 1 IDENTIFIER MIDDLE 30015000 C 0369 + % 122 2 INTCONST MIDDLE 30016000 C 0369 + % 2.5 3 REALCONST MIDDLE 30017000 C 0369 + % "ABCD" 4 ALFACONST MIDDLE 30018000 C 0369 + % "C" 5 CHARCONST MIDDLE 30019000 C 0369 + % NOT 6 NOTSY MIDDLE 30020000 C 0369 + % * 7 ASTERISK MIDDLE 30021000 C 0369 + % / 8 SLASH MIDDLE 30022000 C 0369 + % & AND 9 ANDSY MIDDLE 30023000 C 0369 + % DIV 10 DIVSY MIDDLE 30024000 C 0369 + % MOD 11 MODSY MIDDLE 30025000 C 0369 + % + 12 PLUS MIDDLE 30026000 C 0369 + % - 13 MINUS MIDDLE 30027000 C 0369 + % OR 14 ORSY MIDDLE 30028000 C 0369 + % < LSS 15 LSSSY MIDDLE 30029000 C 0369 + % <= LEQ ≤ 16 LEQSY MIDDLE 30030000 C 0369 + % >= GEQ ≥ 17 GEQSY MIDDLE 30031000 C 0369 + % > GTR 18 GTRSY MIDDLE 30032000 C 0369 + % <> NEQ ≠ 19 NEQSY MIDDLE 30033000 C 0369 + % = EQL 30 EQLSY MIDDLE 30034000 C 0369 + % IN 21 INSY MIDDLE 30035000 C 0369 + % ( 22 LPAR MIDDLE 30036000 C 0369 + % ) 23 RPAR MIDDLE 30037000 C 0369 + % [ 24 LBRACKET MIDDLE 30038000 C 0369 + % ] 25 RBRACKET MIDDLE 30039000 C 0369 + % .. 26 DOUBLEDOT MIDDLE 30040000 C 0369 + % , 27 COMMA MIDDLE 30041000 C 0369 + % ; 28 SEMICOLON TERMINAL 30042000 C 0369 + % . 29 DOT MIDDLE 30043000 C 0369 + % ← @ 30 ARROW MIDDLE 30044000 C 0369 + % : 31 COLON MIDDLE 30045000 C 0369 + % := 32 ASSIGNSY MIDDLE 30046000 C 0369 + % BEGIN 33 BEGINSY INITIAL 30047000 C 0369 + % END 34 ENDSY TERMINAL 30048000 C 0369 + % IF 35 IFSY INITIAL 30049000 C 0369 + % THEN 36 THENSY MIDDLE 30050000 C 0369 + % ELSE 37 ELSESY TERMINAL 30051000 C 0369 + % CASE 38 CASESY INITIAL 30052000 C 0369 + % OF 39 OFSY MIDDLE 30053000 C 0369 + % REPEAT 40 REPEATSY INITIAL 30054000 C 0369 + % UNTIL 41 UNTILSY TERMINAL 30055000 C 0369 + % WHILE 42 WHILESY INITIAL 30056000 C 0369 + % DO 43 DOSY MIDDLE 30057000 C 0369 + % FOR 44 FORSY INITIAL 30058000 C 0369 + % TO 45 TOSY MIDDLE 30059000 C 0369 + % DOWNTO 46 DOWNTOSY MIDDLE 30060000 C 0369 + % GOTO 47 GOTOSY INITIAL 30061000 C 0369 + % NIL 48 NILSY MIDDLE 30062000 C 0369 + % TYPE 49 TYPESY INITIAL 30063000 C 0369 + % ARRAY 50 ARRAYSY MIDDLE 30064000 C 0369 + % RECORD 51 RECORDSY MIDDLE 30065000 C 0369 + % FILE 52 FILESY MIDDLE 30066000 C 0369 + % SET 53 SETSY MIDDLE 30067000 C 0369 + % CONST 54 CONSTSY INITIAL 30068000 C 0369 + % VAR 55 VARSY INITIAL 30069000 C 0369 + % LABEL 56 LABELSY INITIAL 30070000 C 0369 + % FUNCTION 57 FUNCSY INITIAL 30071000 C 0369 + % PROCEDURE 58 PROCSY INITIAL 30072000 C 0369 + % WITH 59 WITHSY INITIAL 30073000 C 0369 + % PROGRAM 60 PROGRAMSY INITIAL 30074000 C 0369 + % PACKED 61 PACKEDSY MIDDLE 30075000 C 0369 + 30076000 C 0369 + 30077000 C 0369 + DEFINE BLANK=48#, EQUAL=61#, QUOTES=63#, DOLLAR=42#, 30078000 C 0369 + LETTER(C)=(17≤C AND C≤25)OR(33≤C AND C≤41)OR(50≤C AND C≤57)#, 30079000 C 0369 + ALFANUM(C)=(LETTER(C) OR C≤9)#; 30080000 C 0369 + 30081000 C 0369 + REAL CURVAL; 30082000 C 0369 + ALPHA CURNAME1,CURNAME2,C,CX; 30083000 C 0369 + INTEGER CURLENGTH,LASTCHARPOS; 30084000 C 0369 + BOOLEAN FINIS; 30085000 C 0369 + 30086000 C 0369 + DEFINE NEXTCHAR= 30087000 C 0369 + BEGIN COMMENT *** READ NEXT CHARACTER. ***; 30088000 C 0369 + IF CHARCNT=0 THEN C:=BLANK ELSE 30089000 C 0369 + BEGIN 30090000 C 0369 + REPLACE CHARPNT BY CARDPNT:CARDPNT FOR 1; 30091000 C 0369 + C:=CH[0]; CHARCNT:=CHARCNT-1; 30092000 C 0369 + END END #; 30093000 C 0369 + 30094000 C 0369 + 30095000 C 0369 + 30096000 C 0369 + PROCEDURE INSYMBOL; 30097000 C 0369 + BEGIN COMMENT *** READS THE NEXT SYMBOL. ***; 30098000 C 0369 + INTEGER SCALE,EXP; 30099000 C 0369 + START OF SEGMENT ********** 8 + BOOLEAN NEGEXP; 30100000 C 0000 + LABEL START,OVERFLOW; 30101000 C 0000 + 30102000 C 0000 + START: 30103000 C 0000 + IF C=BLANK THEN 30104000 C 0000 + BEGIN SCAN CARDPNT:CARDPNT FOR CHARCNT:CHARCNT WHILE =" "; 30105000 C 0000 + IF CHARCNT=0 THEN BEGIN NEWCARD; GO TO START END; 30106000 C 0003 + NEXTCHAR; 30107000 C 0068 + END; 30108000 C 0076 + IF LETTER(C) THEN 30109000 C 0076 + BEGIN 30110000 C 0081 + CURLENGTH:=1; CURNAME1:=C; CURNAME2:=0; 30111000 C 0082 + NEXTCHAR; 30112000 C 0084 + WHILE ALFANUM(C) AND CURLENGTH<6 DO 30113000 C 0092 + BEGIN CURNAME1:=C&CURNAME1[35:29:30]; 30114000 C 0100 + CURLENGTH:=CURLENGTH+1; NEXTCHAR; 30115000 C 0102 + END; 30116000 C 0110 + IF CURLENGTH=6 THEN 30117000 C 0111 + BEGIN 30118000 C 0112 + WHILE ALFANUM(C) AND CURLENGTH<12 DO 30119000 C 0112 + BEGIN CURNAME2:=C&CURNAME2[35:29:30]; 30120000 C 0121 + CURLENGTH:=CURLENGTH+1; NEXTCHAR; 30121000 C 0123 + END; 30122000 C 0131 + WHILE ALFANUM(C) DO NEXTCHAR; 30123000 C 0132 + END; 30124000 C 0148 + CURNAME1.NAMELENGTH:=CURLENGTH; 30125000 C 0148 + CASE CURLENGTH OF 30126000 C 0150 + BEGIN ; 30127000 C 0150 + CURSY:=IDENTIFIER; 30128000 C 0150 + CURSY:=IF CURNAME1="20000IF" THEN IFSY ELSE 30129000 C 0152 + IF CURNAME1="20000DO" THEN DOSY ELSE 30130000 C 0154 + IF CURNAME1="20000TO" THEN TOSY ELSE 30131000 C 0156 + IF CURNAME1="20000OR" THEN ORSY ELSE 30132000 C 0158 + IF CURNAME1="20000OF" THEN OFSY ELSE 30133000 C 0160 + IF CURNAME1="20000IN" THEN INSY ELSE IDENTIFIER; 30134000 C 0162 + CURSY:=IF CURNAME1="3000END" THEN ENDSY ELSE 30135000 C 0165 + IF CURNAME1="3000FOR" THEN FORSY ELSE 30136000 C 0167 + IF CURNAME1="3000DIV" THEN DIVSY ELSE 30137000 C 0169 + IF CURNAME1="3000MOD" THEN MODSY ELSE 30138000 C 0171 + IF CURNAME1="3000NIL" THEN NILSY ELSE 30139000 C 0173 + IF CURNAME1="3000AND" THEN ANDSY ELSE 30140000 C 0175 + IF CURNAME1="3000NOT" THEN NOTSY ELSE 30141000 C 0177 + IF CURNAME1="3000VAR" THEN VARSY ELSE 30142000 C 0179 + IF CURNAME1="3000SET" THEN SETSY ELSE 30143000 C 0181 + IF CURNAME1="3000LSS" THEN LSSSY ELSE 30144000 C 0183 + IF CURNAME1="3000LEQ" THEN LEQSY ELSE 30145000 C 0185 + IF CURNAME1="3000GEQ" THEN GEQSY ELSE 30146000 C 0187 + IF CURNAME1="3000GTR" THEN GTRSY ELSE 30147000 C 0189 + IF CURNAME1="3000NEQ" THEN NEQSY ELSE 30148000 C 0191 + IF CURNAME1="3000EQL" THEN EQLSY ELSE IDENTIFIER; 30149000 C 0193 + CURSY:=IF CURNAME1="400THEN" THEN THENSY ELSE 30150000 C 0196 + IF CURNAME1="400ELSE" THEN ELSESY ELSE 30151000 C 0198 + IF CURNAME1="400WITH" THEN WITHSY ELSE 30152000 C 0200 + IF CURNAME1="400CASE" THEN CASESY ELSE 30153000 C 0202 + IF CURNAME1="400GOTO" THEN GOTOSY ELSE 30154000 C 0204 + IF CURNAME1="400TYPE" THEN TYPESY ELSE 30155000 C 0206 + IF CURNAME1="400FILE" THEN FILESY ELSE IDENTIFIER; 30156000 C 0208 + CURSY:=IF CURNAME1="50BEGIN" THEN BEGINSY ELSE 30157000 C 0211 + IF CURNAME1="50WHILE" THEN WHILESY ELSE 30158000 C 0213 + IF CURNAME1="50UNTIL" THEN UNTILSY ELSE 30159000 C 0215 + IF CURNAME1="50ARRAY" THEN ARRAYSY ELSE 30160000 C 0217 + IF CURNAME1="50CONST" THEN CONSTSY ELSE 30161000 C 0219 + IF CURNAME1="50LABEL" THEN LABELSY ELSE IDENTIFIER; 30162000 C 0221 + CURSY:=IF CURNAME1="6REPEAT" THEN REPEATSY ELSE 30163000 C 0225 + IF CURNAME1="6DOWNTO" THEN DOWNTOSY ELSE 30164000 C 0227 + IF CURNAME1="6RECORD" THEN RECORDSY ELSE 30165000 C 0229 + IF CURNAME1="6PACKED" THEN PACKEDSY ELSE IDENTIFIER; 30166000 C 0231 + CURSY:=IF CURNAME1="7PROGRA" AND CURNAME2="M" THEN PROGRAMSY 30167000 C 0234 + ELSE IDENTIFIER; 30168000 C 0236 + CURSY:=IF CURNAME1="8FUNCTI" AND CURNAME2="ON" THEN FUNCSY 30169000 C 0238 + ELSE IDENTIFIER; 30170000 C 0241 + CURSY:=IF CURNAME1="9PROCED" AND CURNAME2="URE" THEN PROCSY 30171000 C 0242 + ELSE IDENTIFIER; 30172000 C 0245 + CURSY:=IDENTIFIER; % 10 CHARACTERS. 30173000 C 0247 + CURSY:=IDENTIFIER; % 11 CHARACTERS. 30174000 C 0248 + CURSY:=IDENTIFIER; % 12 CHARACTERS. 30175000 C 0249 + END OF CASE; 30176000 C 0250 + START OF SEGMENT ********** 9 + 9 IS 14 LONG, NEXT SEG 8 + IF RESWORDOPTION AND CURSY≠IDENTIFIER THEN 30177000 C 0251 + BEGIN T1:=CARDLENGTH-CHARCNT-CURLENGTH; 30178000 C 0252 + IF CHARCNT=0 THEN CARDPNT:=CARDPNT+1 ELSE T1:=T1-1; 30179000 C 0298 + REPLACE XLINEPNT+T1 BY CARDPNT-(CURLENGTH+1) 30180000 C 0304 + FOR CURLENGTH; 30181000 C 0308 + END; 30182000 C 0311 + END OF LETTER ELSE 30183000 C 0311 + IF C≤9 THEN 30184000 C 0311 + BEGIN 30185000 C 0313 + CURVAL:=C; CURSY:=INTCONST; 30186000 C 0313 + NEXTCHAR; 30187000 C 0315 + WHILE C≤9 DO BEGIN CURVAL:=10×CURVAL+C; NEXTCHAR END; 30188000 C 0322 + IF C="." THEN 30189000 C 0334 + BEGIN 30190000 C 0334 + NEXTCHAR; 30191000 C 0335 + IF C≤9 THEN 30192000 C 0342 + BEGIN CURSY:=REALCONST; 30193000 C 0343 + DO BEGIN CURVAL:=10×CURVAL+C; 30194000 C 0344 + SCALE:=SCALE-1; NEXTCHAR; 30195000 C 0346 + END UNTIL C>9; 30196000 C 0355 + END ELSE IF C="." THEN C:=64 % SPECIAL MARK FOR ".." 30197000 C 0356 + ELSE ERROR(4); 30198000 C 0358 + END; 30199000 C 0360 + IF C="E" THEN 30200000 C 0360 + BEGIN 30201000 C 0361 + CURSY:=REALCONST; NEXTCHAR; 30202000 C 0361 + IF C="+" OR C="-" THEN BEGIN NEGEXP:=C="-"; NEXTCHAR END; 30203000 C 0370 + IF C≤9 THEN 30204000 C 0381 + BEGIN EXP:=C; NEXTCHAR; 30205000 C 0381 + WHILE C≤9 DO BEGIN EXP:=10×EXP+C; NEXTCHAR END; 30206000 C 0390 + IF NEGEXP THEN EXP:=-EXP; 30207000 C 0402 + END ELSE ERROR(4); 30208000 C 0403 + SCALE:=SCALE+EXP; 30209000 C 0405 + END; 30210000 C 0406 + IF CURSY=REALCONST THEN 30211000 C 0406 + BEGIN 30212000 C 0407 + REALOVERFLOW:=OVERFLOW; 30213000 C 0407 + CURVAL:=CURVAL×10*SCALE; 30214000 C 0409 + REALOVERFLOW:=0; 30215000 C 0412 + END ELSE 30216000 C 0413 + IF CURVAL>MAXINT THEN 30217000 C 0413 + BEGIN 30218000 C 0414 + OVERFLOW: ERROR(14); CURVAL:=0; REALOVERFLOW:=0; 30219000 C 0415 + END; 30220000 C 0417 + END OF DIGIT ELSE 30221000 C 0417 + IF C=QUOTES THEN 30222000 C 0417 + BEGIN 30223000 C 0419 + CURSY:=ALFACONST; CURLENGTH:=0; NEXTCHAR; 30224000 C 0420 + FINIS:=FALSE; 30225000 C 0429 + DO BEGIN 30226000 C 0430 + IF C=QUOTES THEN BEGIN NEXTCHAR; FINIS:=C≠QUOTES END ELSE 30227000 C 0430 + IF CHARCNT=0 THEN BEGIN ERROR(6); FINIS:=TRUE END; 30228000 C 0440 + IF NOT FINIS THEN 30229000 C 0443 + BEGIN 30230000 C 0443 + REPLACE STRINGPNT+CURLENGTH BY CHARPNT FOR 1; 30231000 C 0444 + CURLENGTH:=CURLENGTH+1; 30232000 C 0449 + NEXTCHAR; 30233000 C 0450 + END END UNTIL FINIS; 30234000 C 0457 + IF CURLENGTH=0 THEN ERROR(4) ELSE 30235000 C 0458 + IF CURLENGTH=1 THEN 30236000 C 0460 + BEGIN CURSY:=CHARCONST; 30237000 C 0461 + REPLACE CHARPNT BY STRINGPNT FOR 1; CURVAL:=CH[0]; 30238000 C 0463 + END ELSE 30239000 C 0466 + IF CURLENGTH≤7 THEN 30240000 C 0466 + BEGIN TEXT[0]:=" "; 30241000 C 0468 + REPLACE TEXTPNT BY STRINGPNT FOR CURLENGTH; 30242000 C 0469 + CURVAL:=TEXT[0]; 30243000 C 0472 + END; 30244000 C 0473 + END OF STRINGS ELSE 30245000 C 0473 + BEGIN 30246000 C 0473 + CURSY:=SYMBOL[C]; NEXTCHAR; 30247000 C 0475 + IF CURSY=COLON AND C=EQUAL THEN 30248000 C 0483 + BEGIN CURSY:=ASSIGNSY; NEXTCHAR END ELSE 30249000 C 0485 + IF CURSY=DOT AND C="." THEN 30250000 C 0494 + BEGIN CURSY:=DOUBLEDOT; NEXTCHAR END ELSE 30251000 C 0496 + IF CURSY=LSSSY AND C=EQUAL THEN 30252000 C 0505 + BEGIN CURSY:=LEQSY; NEXTCHAR END ELSE 30253000 C 0507 + IF CURSY=LSSSY AND C=">" THEN 30254000 C 0516 + BEGIN CURSY:=NEQSY; NEXTCHAR END ELSE 30255000 C 0518 + IF CURSY=GTRSY AND C=EQUAL THEN 30256000 C 0527 + BEGIN CURSY:=GEQSY; NEXTCHAR END ELSE 30257000 C 0529 + IF CURSY=LPAR AND C="*" THEN 30258000 C 0538 + BEGIN % *** COMMENT *** 30259000 C 0540 + NEXTCHAR; 30260000 C 0540 + IF C=DOLLAR THEN % DOLLAR INDICATES COMPILER OPTIONS. 30261000 C 0548 + DO BEGIN 30262000 C 0549 + NEXTCHAR; CX:=C; NEXTCHAR; 30263000 C 0550 + IF CX="L" THEN IF C=1 THEN HEADING 30264000 C 0565 + ELSE LISTOPTION:=C="+" ELSE 30265000 C 0588 + IF CX="R" THEN RESWORDOPTION:=C="+" ELSE 30266000 C 0590 + IF CX="C" THEN CHECKOPTION:=C="+" ELSE 30267000 C 0593 + IF CX="D" THEN DUMPOPTION:=C="+" ELSE 30268000 C 0596 + IF CX="X" THEN XREFOPTION:=C="+" ELSE 30269000 C 0599 + IF CX="A" THEN 30270000 C 0602 + IF C="+" THEN WRITE(PASCALGOL,ALIST) 30271000 C 0603 + ELSE WRITE(PASCALGOL,NOALIST) ELSE 30272000 C 0608 + IF CX="T" THEN 30273000 C 0612 + BEGIN LASTCHARPOS := CHARCNT - CARDLENGTH; 30274000 C 0613 + CARDLENGTH:=10×C; 30275000 C 0615 + NEXTCHAR; CARDLENGTH:=CARDLENGTH+C; 30276000 C 0616 + IF CARDLENGTH≤9 OR CARDLENGTH>80 THEN 30277000 C 0625 + BEGIN ERROR(14); CARDLENGTH:=72 END; 30278000 C 0626 + CHARCNT:=MAX(0,LASTCHARPOS+CARDLENGTH-1); 30279000 C 0628 + END; 30280000 C 0632 + NEXTCHAR; 30281000 C 0632 + END UNTIL C≠","; 30282000 C 0640 + FINIS:=FALSE; 30283000 C 0641 + DO BEGIN 30284000 C 0642 + IF C≠"*" THEN 30285000 C 0643 + SCAN CARDPNT:CARDPNT FOR CHARCNT:CHARCNT UNTIL ="*"; 30286000 C 0643 + IF CHARCNT=0 THEN NEWCARD ELSE 30287000 C 0646 + BEGIN NEXTCHAR; 30288000 C 0711 + WHILE C="*" DO NEXTCHAR; 30289000 C 0719 + FINIS:=C=")"; 30290000 C 0728 + END END UNTIL FINIS; 30291000 C 0729 + NEXTCHAR; 30292000 C 0730 + GO TO START; 30293000 C 0737 + END OF COMMENT; 30294000 C 0738 + END; 30295000 C 0738 + END OF INSYMBOL; 30296000 C 0738 + 8 IS 750 LONG, NEXT SEG 2 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 40001000 C 0369 + % % 40002000 C 0369 + % % 40003000 C 0369 + % % 40004000 C 0369 + % PART 4: EXPRESSION PARSER. % 40005000 C 0369 + % ------------------ % 40006000 C 0369 + % % 40007000 C 0369 + % % 40008000 C 0369 + % % 40009000 C 0369 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 40010000 C 0369 + 40011000 C 0369 + 40012000 C 0369 + PROCEDURE EXPRESSION; FORWARD; 40013000 C 0369 + PROCEDURE CONCAT; FORWARD; 40014000 C 0369 + 40015000 C 0369 + ALPHA TEMPSYM; 40016000 C 0369 + REAL SX; 40017000 C 0369 + INTEGER EXPRLEVEL,TX; 40018000 C 0369 + 40019000 C 0369 + DEFINE PUTTEXT(T)= 40020000 C 0369 + BEGIN 40021000 C 0369 + IF NUMSYMS=MAXSYMS THEN 40022000 C 0369 + BEGIN ERROR(71); 40023000 C 0369 + NUMSYMS:=1; 40024000 C 0369 + END ELSE NUMSYMS:=NUMSYMS+1; 40025000 C 0369 + SYMTAB[NUMSYMS]:=T; 40026000 C 0369 + END OF PUTTEXT #; 40027000 C 0369 + 40028000 C 0369 + DEFINE PUTSYM(S)= 40029000 C 0369 + BEGIN 40030000 C 0369 + TEMPSYM:=(S)&1[41:5:6]; 40031000 C 0369 + PUTTEXT(TEMPSYM); 40032000 C 0369 + END OF PUTSYM #; 40033000 C 0369 + 40034000 C 0369 + DEFINE PUTCONST(VAL)= 40035000 C 0369 + BEGIN 40036000 C 0369 + PUTTEXT("2000000"); 40037000 C 0369 + PUTTEXT(VAL); 40038000 C 0369 + END OF PUTCONST #; 40039000 C 0369 + 40040000 C 0369 + DEFINE PUTDUMMY= 40041000 C 0369 + BEGIN 40042000 C 0369 + PUTTEXT("3000000"); 40043000 C 0369 + END OF PUTDUMMY #; 40044000 C 0369 + 40045000 C 0369 + DEFINE PUTID(L,NUM,NUMDIG)= 40046000 C 0369 + BEGIN 40047000 C 0369 + TEXT[0]:=" " & L [35:5:6]; 40048000 C 0369 + REPLACE TEXTPNT+2 BY NUM FOR NUMDIG DIGITS; 40049000 C 0369 + PUTTEXT(TEXT[0]); 40050000 C 0369 + END OF PUTID#; 40051000 C 0369 + 40052000 C 0369 + DEFINE WRITEEXPR= 40053000 C 0369 + BEGIN 40054000 C 0369 + FOR T1:=1 STEP 1 UNTIL NUMSYMS DO 40055000 C 0369 + BEGIN 40056000 C 0369 + SX:=SYMTAB[T1]; TX:=SX.[41:6]; 40057000 C 0369 + IF TX=0 THEN GEN(SX,7,2) ELSE 40058000 C 0369 + IF TX=3 THEN ELSE 40059000 C 0369 + IF TX=1 THEN GEN(SX,1,7) ELSE 40060000 C 0369 + BEGIN 40061000 C 0369 + T1:=T1+1; SX:=SYMTAB[T1]; 40062000 C 0369 + IF SX.[44:6]=0 THEN GENINT(SX) ELSE GENREAL(SX); 40063000 C 0369 + END END; 40064000 C 0369 + NUMSYMS:=0; 40065000 C 0369 + END OF WRITEEXPR#; 40066000 C 0369 + 40067000 C 0369 + 40068000 C 0369 + DEFINE CHECKEXPR(LLIM,ULIM)= 40069000 C 0369 + BEGIN 40070000 C 0369 + PUTTEXT("CHECK("); 40071000 C 0369 + EXPRESSION; 40072000 C 0369 + PUTSYM(","); PUTCONST(LLIM); 40073000 C 0369 + PUTSYM(","); PUTCONST(ULIM); 40074000 C 0369 + PUTSYM(","); PUTCONST(CARDCNT); 40075000 C 0369 + PUTSYM(")"); 40076000 C 0369 + END OF CHECKEXPR#; 40077000 C 0369 + 40078000 C 0369 + 40079000 C 0369 + BOOLEAN SIMPLEVARIABLE,INSIDEBRACKETS; 40080000 C 0369 + INTEGER NUMPOINTERS; 40081000 C 0369 + 40082000 C 0369 + PROCEDURE VARIABLE; 40083000 C 0369 + BEGIN 40084000 C 0369 + INTEGER STARTSYM,LLIM,ULIM; 40085000 C 0369 + START OF SEGMENT ********** 10 + REAL T; 40086000 C 0000 + BOOLEAN INBRACKET,INRECORD; 40087000 C 0000 + LABEL ADDADDR; 40088000 C 0000 + 40089000 C 0000 + STARTSYM:=NUMSYMS+1; 40090000 C 0000 + IF THISLEVEL>CURLEVEL THEN % VARIABLE IN FIELD LIST OF 40091000 C 0001 + BEGIN % RECORD USED IN WITH-STATEMENT. 40092000 C 0002 + T:=DISPLAY[THISLEVEL]; 40093000 C 0002 + T4:=T.FIRSTWITHSYM; T5:=T.LASTWITHSYM; 40094000 C 0003 + FOR T3:=T4 STEP 1 UNTIL T5 DO PUTTEXT(WITHTAB[T3]); 40095000 C 0006 + INRECORD:=TRUE; 40096000 C 0015 + INBRACKET:=BOOLEAN(T.BRACKETSINWITH); 40097000 C 0016 + NUMPOINTERS:=NUMPOINTERS+T.NUMPNTRSINWITH; 40098000 C 0017 + SIMPLEVARIABLE:=FALSE; 40099000 C 0019 + CURTYPE:=T.RECTYPE; T:=TYPETAB1[CURTYPE]; 40100000 C 0019 + GO TO ADDADDR; 40101000 C 0022 + END; 40102000 C 0022 + IF THISLEVEL>1 AND THISLEVEL0 THEN BEGIN PUTSYM("-"); PUTCONST( LLIM) END; 40127000 C 0235 + PUTSYM(")"); 40128000 C 0257 + IF TYPETAB1[CURTYPE].SIZE>1 THEN 40129000 C 0265 + BEGIN PUTSYM("×"); PUTCONST(TYPETAB1[CURTYPE].SIZE) END; 40130000 C 0266 + END ELSE IF TYPETAB1[CURTYPE].STRUCT>0 THEN PUTSYM(","); 40131000 C 0288 + END UNTIL CURSY≠COMMA; 40132000 C 0298 + IF CURSY≠RBRACKET THEN 40133000 C 0299 + BEGIN ERROR(59); SKIP(RBRACKET); 40134000 C 0300 + IF CURSY=RBRACKET THEN INSYMBOL; 40135000 C 0302 + END ELSE INSYMBOL; 40136000 C 0304 + END OF BRACKETS ELSE 40137000 C 0305 + IF CURSY=DOT THEN 40138000 C 0305 + BEGIN 40139000 C 0306 + IF NOT(INBRACKET OR INRECORD) THEN 40140000 C 0306 + BEGIN PUTSYM("["); INBRACKET:=TRUE END; 40141000 C 0307 + T:=TYPETAB1[CURTYPE]; 40142000 C 0316 + IF T.FORM≠RECORD THEN ERROR(12); 40143000 C 0317 + INSYMBOL; 40144000 C 0320 + IF CURSY=IDENTIFIER THEN 40145000 C 0320 + BEGIN 40146000 C 0321 + SEARCHTAB(T.RECTAB); 40147000 C 0321 + IF FOUND THEN 40148000 C 0342 + BEGIN 40149000 C 0342 + THISID:=NAMETAB3[T.RECTAB,THISINDEX]; 40150000 C 0342 + ADDADDR: PUTSYM("+"); 40151000 C 0345 + PUTCONST(THISID.INFO); CURTYPE:=THISID.TYPE; 40152000 C 0352 + END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40153000 C 0367 + END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40154000 C 0369 + INRECORD:=TRUE; 40155000 C 0371 + INSYMBOL; 40156000 C 0372 + END OF DOT ELSE 40157000 C 0372 + BEGIN % CURSY=ARROW 40158000 C 0372 + T:=TYPETAB1[CURTYPE]; 40159000 C 0373 + IF T.FORM=FILES THEN 40160000 C 0374 + BEGIN 40161000 C 0375 + CURTYPE:=T.FILETYPE; 40162000 C 0375 + IF TYPETAB1[CURTYPE].STRUCT=0 THEN PUTTEXT(" [0]"); 40163000 C 0377 + END ELSE 40164000 C 0384 + IF T.FORM=TEXTFILE THEN 40165000 C 0384 + BEGIN 40166000 C 0388 + SYMTAB[NUMSYMS]:=SYMTAB[NUMSYMS] & "I" [35:5:6]; 40167000 C 0388 + PUTSYM("."); PUTTEXT("LASTCH"); 40168000 C 0391 + CURTYPE:=CHARTYPE; 40169000 C 0404 + END ELSE 40170000 C 0405 + IF T.FORM=POINTERS THEN 40171000 C 0405 + BEGIN 40172000 C 0408 + IF INBRACKET THEN PUTSYM("]"); 40173000 C 0408 + INBRACKET:=FALSE; 40174000 C 0417 + IF NUMSYMS+2≤MAXSYMS THEN 40175000 C 0417 + BEGIN 40176000 C 0419 + FOR T1:=NUMSYMS STEP -1 UNTIL STARTSYM DO 40177000 C 0419 + SYMTAB[T1+2]:=SYMTAB[T1]; 40178000 C 0421 + SYMTAB[STARTSYM]:=" MEM["; 40179000 C 0425 + SYMTAB[STARTSYM+1]:=" (T:="; 40180000 C 0426 + NUMSYMS:=NUMSYMS+2; NUMPOINTERS:=NUMPOINTERS+1; 40181000 C 0428 + INRECORD:=TRUE; 40182000 C 0430 + END ELSE ERROR(63); 40183000 C 0431 + CURTYPE:=T.POINTTYPE; 40184000 C 0434 + END ELSE BEGIN ERROR(12); CURTYPE:=0 END; 40185000 C 0436 + INSYMBOL; 40186000 C 0438 + END OF ARROW; 40187000 C 0438 + END UNTIL CURSY≠LBRACKET AND CURSY≠DOT AND CURSY≠ARROW; 40188000 C 0438 + IF TYPETAB1[CURTYPE].STRUCT=0 THEN 40189000 C 0441 + BEGIN 40190000 C 0443 + IF INBRACKET THEN PUTSYM("]"); 40191000 C 0443 + WHILE NUMPOINTERS>0 DO 40192000 C 0452 + BEGIN PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); 40193000 C 0453 + PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); 40194000 C 0466 + NUMPOINTERS:=NUMPOINTERS-1; 40195000 C 0480 + END; 40196000 C 0481 + END; 40197000 C 0484 + END; 40198000 C 0484 + INSIDEBRACKETS:=INBRACKET; 40199000 C 0484 + CURMODE:=NUMBER; 40200000 C 0484 + END OF VARIABLE; 40201000 C 0485 + 10 IS 490 LONG, NEXT SEG 2 + 40202000 C 0369 + 40203000 C 0369 + PROCEDURE PASSPARAMS; 40204000 C 0369 + BEGIN 40205000 C 0369 + INTEGER NPARS,PARAM,PTYPE,P,FIRSTSYM; 40206000 C 0369 + START OF SEGMENT ********** 11 + BOOLEAN FORMALPROC,CHECK; 40207000 C 0000 + LABEL EXIT; 40208000 C 0000 + 40209000 C 0000 + PUTID("V",1000×THISLEVEL+THISINDEX,5); 40210000 C 0000 + P:=THISID.INFO; 40211000 C 0015 + FORMALPROC:=BOOLEAN(THISID.FORMAL); 40212000 C 0017 + NPARS:=PARAMTAB[P]; P:=P+1; 40213000 C 0018 + IF FORMALPROC THEN NPARS:=9999; 40214000 C 0020 + INSYMBOL; 40215000 C 0022 + IF CURSY=LPAR THEN 40216000 C 0022 + BEGIN 40217000 C 0023 + PUTSYM("("); 40218000 C 0023 + DO BEGIN 40219000 C 0032 + INSYMBOL; 40220000 C 0033 + IF NPARS=0 THEN BEGIN ERROR(3); SKIP(RPAR); GO TO EXIT END; 40221000 C 0033 + PARAM:=PARAMTAB[P]; P:=P+1; 40222000 C 0036 + PTYPE:=PARAM.PARAMTYPE; 40223000 C 0039 + IF PARAM.PARAMKIND=CONST THEN 40224000 C 0040 + BEGIN 40225000 C 0041 + CHECK:=CHECKOPTION AND TYPETAB1[PTYPE].FORM LEQ CHAR; 40226000 C 0042 + IF CHECK THEN PUTTEXT("CHECK("); 40227000 C 0044 + PUTDUMMY; FIRSTSYM:=NUMSYMS; 40228000 C 0051 + EXPRLEVEL:=EXPRLEVEL+1; 40229000 C 0059 + EXPRESSION; EXPRLEVEL:=EXPRLEVEL-1; 40230000 C 0060 + IF CURMODE=BITPATTERN THEN 40231000 C 0062 + BEGIN SYMTAB[FIRSTSYM]:=" REAL("; PUTSYM(")"); END; 40232000 C 0063 + IF CHECK THEN 40233000 C 0074 + BEGIN 40234000 C 0074 + PUTSYM(","); PUTCONST(TYPETAB2[PTYPE]); 40235000 C 0075 + PUTSYM(","); PUTCONST(TYPETAB3[PTYPE]); 40236000 C 0095 + PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); 40237000 C 0116 + END; 40238000 C 0145 + END ELSE 40239000 C 0145 + IF PARAM.PARAMKIND=VAR THEN 40240000 C 0145 + BEGIN 40241000 C 0146 + IF CURSY=IDENTIFIER THEN 40242000 C 0147 + BEGIN 40243000 C 0148 + SEARCH; 40244000 C 0148 + IF FOUND THEN 40245000 C 0177 + BEGIN 40246000 C 0177 + IF THISID.IDCLASS=VAR OR 40247000 C 0177 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 40248000 C 0179 + BEGIN 40249000 C 0181 + IF PARAM.PARAMFILE=1 THEN 40250000 C 0182 + BEGIN 40251000 C 0183 + CURTYPE:=THISID.TYPE; 40252000 C 0183 + PUTID("V",1000×THISLEVEL+THISINDEX,5); PUTSYM(","); 40253000 C 0185 + PUTID("F",1000×THISLEVEL+THISINDEX,5); PUTSYM(","); 40254000 C 0208 + PUTID("I",1000×THISLEVEL+THISINDEX,5); 40255000 C 0232 + INSYMBOL; 40256000 C 0248 + END ELSE 40257000 C 0249 + BEGIN 40258000 C 0249 + VARIABLE; 40259000 C 0249 + IF TYPETAB1[CURTYPE].STRUCT>0 THEN 40260000 C 0250 + IF NOT SIMPLEVARIABLE THEN ERROR(92); 40261000 C 0251 + END; 40262000 C 0254 + END ELSE BEGIN ERROR(8); CURTYPE:=0 END; 40263000 C 0254 + END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40264000 C 0256 + END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40265000 C 0258 + END ELSE 40266000 C 0260 + BEGIN 40267000 C 0260 + IF CURSY=IDENTIFIER THEN 40268000 C 0260 + BEGIN 40269000 C 0261 + SEARCH; 40270000 C 0261 + IF FOUND THEN 40271000 C 0290 + BEGIN 40272000 C 0290 + IF THISID.IDCLASS≠PARAM.PARAMKIND THEN ERROR(91); 40273000 C 0290 + PUTID("V",1000×THISLEVEL+THISINDEX,5); 40274000 C 0293 + CURTYPE:=IF THISID.IDCLASS=FUNC THEN THISID.TYPE ELSE 0; 40275000 C 0309 + INSYMBOL; 40276000 C 0313 + END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40277000 C 0314 + END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40278000 C 0316 + END; 40279000 C 0318 + CHECKTYPES(PTYPE,CURTYPE); 40280000 C 0318 + NPARS:=NPARS-1; 40281000 C 0377 + IF CURSY=COMMA THEN PUTSYM(","); 40282000 C 0378 + END UNTIL CURSY≠COMMA; 40283000 C 0387 + IF CURSY≠RPAR THEN BEGIN ERROR(89); SKIP(RPAR) END; 40284000 C 0388 + EXIT: PUTSYM(")"); 40285000 C 0391 + IF CURSY=RPAR THEN INSYMBOL; 40286000 C 0398 + END; 40287000 C 0400 + IF NPARS>0 AND NOT FORMALPROC THEN ERROR(3); 40288000 C 0400 + CURMODE:=NUMBER; 40289000 C 0403 + END OF PASSPARAMS; 40290000 C 0404 + 11 IS 411 LONG, NEXT SEG 2 + 40291000 C 0369 + 40292000 C 0369 + PROCEDURE FACTOR; %*** FACTOR *** 40293000 C 0369 + BEGIN %************** 40294000 C 0369 + INTEGER STARTSYM,STYPE,T; 40295000 C 0369 + START OF SEGMENT ********** 12 + BOOLEAN FIRST; 40296000 C 0000 + REAL VAL; 40297000 C 0000 + 40298000 C 0000 + DEFINE PARAMETER= %*** CHECK THAT THE FUNCTION HAS 1 PARAM. 40299000 C 0000 + BEGIN 40300000 C 0000 + INSYMBOL; 40301000 C 0000 + IF CURSY=LPAR THEN 40302000 C 0000 + BEGIN 40303000 C 0000 + PUTSYM("("); INSYMBOL; EXPRESSION; 40304000 C 0000 + IF TYPETAB1[CURTYPE].FORM=NUMERIC THEN CURTYPE:=INTTYPE; 40305000 C 0000 + IF CURSY≠RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; 40306000 C 0000 + PUTSYM(")"); IF CURSY=RPAR THEN INSYMBOL; 40307000 C 0000 + END ELSE ERROR(3); 40308000 C 0000 + END OF PARAMETER#; 40309000 C 0000 + 40310000 C 0000 + CURMODE:=NUMBER; 40311000 C 0000 + IF CURSY=IDENTIFIER THEN 40312000 C 0000 + BEGIN 40313000 C 0001 + SEARCH; 40314000 C 0002 + IF FOUND THEN 40315000 C 0031 + BEGIN 40316000 C 0031 + IF THISID.IDCLASS=VAR OR 40317000 C 0031 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) 40318000 C 0033 + THEN VARIABLE ELSE 40319000 C 0034 + IF THISID.IDCLASS=CONST THEN 40320000 C 0036 + BEGIN 40321000 C 0038 + IF THISID.INFO≤1023 THEN PUTCONST(THISID.INFO) 40322000 C 0038 + ELSE PUTCONST(CONSTTAB[THISID.INFO-1023]); 40323000 C 0040 + CURTYPE:=THISID.TYPE; CURMODE:=NUMBER; 40324000 C 0068 + INSYMBOL; 40325000 C 0070 + END ELSE 40326000 C 0071 + IF THISID.IDCLASS=FUNC THEN 40327000 C 0071 + BEGIN 40328000 C 0073 + IF THISTAB=0 THEN %*** INTRINSIC FUNCTION *** 40329000 C 0073 + BEGIN 40330000 C 0074 + INTEGER DUMMY; 40350000 C 0074 + START OF SEGMENT ********** 13 + IF CURNAME1="3000ABS" THEN % "ABS" 40351000 C 0000 + BEGIN 40352000 C 0000 + PUTTEXT(" ABS"); PARAMETER; 40353000 C 0001 + IF CURTYPE≠REALTYPE AND CURTYPE≠INTTYPE THEN ERROR(67); 40354000 C 0036 + END ELSE 40355000 C 0039 + IF CURNAME1="3000CHR" THEN % "CHR" 40356000 C 0039 + BEGIN 40357000 C 0040 + INSYMBOL; 40358000 C 0041 + IF CURSY=LPAR THEN 40359000 C 0041 + BEGIN INSYMBOL; CHECKEXPR(0,63); 40360000 C 0042 + IF TYPETAB1[CURTYPE].FORM≠NUMERIC THEN ERROR(67); 40361000 C 0120 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40362000 C 0122 + IF CURSY=RPAR THEN INSYMBOL; 40363000 C 0125 + END ELSE ERROR(58); 40364000 C 0127 + CURTYPE:=CHARTYPE; 40365000 C 0128 + END ELSE 40366000 C 0129 + IF CURNAME1="3000EOF" OR % "EOF"/"EOLN" 40367000 C 0129 + CURNAME1="400EOLN" THEN 40368000 C 0130 + BEGIN 40369000 C 0131 + FIRST:=CURNAME1="3000EOF"; 40370000 C 0132 + FILEPARAM(INPUTFILE); 40371000 C 0133 + PUTID("I",FILENAME,5); 40372000 C 0186 + PUTTEXT(IF FIRST THEN " .EOF" ELSE " .EOLN"); 40373000 C 0201 + IF LPARFOUND THEN 40374000 C 0209 + BEGIN 40375000 C 0209 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40376000 C 0209 + IF CURSY=RPAR THEN INSYMBOL; 40377000 C 0212 + END; 40378000 C 0214 + CURTYPE:=BOOLTYPE; 40379000 C 0214 + END ELSE 40380000 C 0215 + IF CURNAME1="3000ODD" THEN % "ODD" 40381000 C 0215 + BEGIN 40382000 C 0218 + PUTTEXT(" ODD"); PARAMETER; 40383000 C 0219 + IF CURTYPE≠INTTYPE THEN ERROR(67); 40384000 C 0254 + CURTYPE:=BOOLTYPE; CURMODE:=BITPATTERN; 40385000 C 0256 + END ELSE 40386000 C 0258 + IF CURNAME1="3000ORD" THEN % "ORD" 40387000 C 0258 + BEGIN 40388000 C 0259 + PUTSYM("("); INSYMBOL; 40389000 C 0259 + IF CURSY=LPAR THEN 40390000 C 0269 + BEGIN 40391000 C 0269 + INSYMBOL; EXPRESSION; 40392000 C 0270 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(67); 40393000 C 0271 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40394000 C 0274 + INSYMBOL; 40395000 C 0276 + END ELSE ERROR(58); 40396000 C 0277 + CURTYPE:=INTTYPE; PUTSYM(")"); 40397000 C 0278 + END ELSE 40398000 C 0286 + IF CURNAME1="400PRED" OR % "PRED"/"SUCC" 40399000 C 0286 + CURNAME1="400SUCC" THEN 40400000 C 0288 + BEGIN 40401000 C 0289 + FIRST:=CURNAME1="400PRED"; 40402000 C 0289 + PUTTEXT("CHECK("); INSYMBOL; 40403000 C 0290 + IF CURSY=LPAR THEN 40404000 C 0299 + BEGIN 40405000 C 0299 + INSYMBOL; EXPRESSION; 40406000 C 0300 + PUTSYM(IF FIRST THEN "-" ELSE "+"); PUTSYM("1"); 40407000 C 0301 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(67); 40408000 C 0319 + PUTSYM(","); PUTCONST(TYPETAB2[CURTYPE]); 40409000 C 0321 + PUTSYM(","); PUTCONST(TYPETAB3[CURTYPE]); 40410000 C 0342 + PUTSYM(","); PUTCONST(CARDCNT); 40411000 C 0363 + PUTSYM(")"); 40412000 C 0384 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40413000 C 0392 + IF CURSY=RPAR THEN INSYMBOL; 40414000 C 0394 + END ELSE BEGIN ERROR(58); CURTYPE:=0 END; 40415000 C 0396 + END ELSE 40416000 C 0398 + IF CURNAME1="50ROUND" THEN % "ROUND" 40417000 C 0398 + BEGIN 40418000 C 0399 + PUTTEXT(" ROUND"); PARAMETER; 40419000 C 0400 + IF CURTYPE≠REALTYPE THEN ERROR(67); 40420000 C 0435 + NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40421000 C 0437 + PUTCONST(CARDCNT); PUTSYM(")"); 40422000 C 0446 + CURTYPE:=INTTYPE; 40423000 C 0467 + END ELSE 40424000 C 0467 + IF CURNAME1="3000SQR" THEN % "SQR" 40425000 C 0467 + BEGIN 40426000 C 0469 + PUTTEXT(" SQR"); PARAMETER; 40427000 C 0469 + NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40428000 C 0504 + PUTCONST(CARDCNT); PUTSYM(")"); 40429000 C 0513 + IF CURTYPE≠REALTYPE AND CURTYPE≠INTTYPE THEN ERROR(67); 40430000 C 0534 + END ELSE 40431000 C 0537 + IF CURNAME1="50TRUNC" THEN % "TRUNC" 40432000 C 0537 + BEGIN 40433000 C 0538 + PUTTEXT(" TRUNC"); PARAMETER; 40434000 C 0538 + NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40435000 C 0573 + PUTCONST(CARDCNT); PUTSYM(")"); 40436000 C 0582 + IF CURTYPE≠REALTYPE THEN ERROR(67); 40437000 C 0603 + CURTYPE:=INTTYPE; 40438000 C 0605 + END ELSE 40439000 C 0605 + IF CURNAME1="6CONCAT" THEN % "CONCAT" 40440000 C 0605 + CONCAT ELSE 40441000 C 0607 + IF CURNAME1="400TIME" THEN % "TIME" 40442000 C 0608 + BEGIN 40443000 C 0610 + PUTTEXT("(TIME("); PUTTEXT("1)/60)"); 40444000 C 0611 + CURTYPE:=REALTYPE; INSYMBOL 40445000 C 0625 + END ELSE 40446000 C 0626 + IF CURNAME1="400DATE" THEN % "DATE" 40447000 C 0626 + BEGIN 40448000 C 0629 + PUTTEXT("CURDAT"); 40449000 C 0630 + CURTYPE:=ALFATYPE; INSYMBOL; 40450000 C 0637 + END ELSE 40451000 C 0638 + IF CURNAME1="7ELAPSE" AND CURNAME2="D" THEN % "ELAPSED" 40452000 C 0638 + BEGIN 40453000 C 0642 + PUTTEXT("(TIME("); PUTTEXT("2)/60)"); 40454000 C 0643 + CURTYPE:=REALTYPE; INSYMBOL; 40455000 C 0657 + END ELSE 40456000 C 0658 + IF CURNAME1="6IOTIME" THEN % "IOTIME" 40457000 C 0658 + BEGIN 40458000 C 0661 + PUTTEXT("(TIME("); PUTTEXT("3)/60)"); 40459000 C 0662 + CURTYPE:=REALTYPE; INSYMBOL; 40460000 C 0676 + END ELSE 40461000 C 0677 + IF CURNAME1="7WEEKDA" AND CURNAME2="Y" THEN % "WEEKDAY" 40462000 C 0677 + BEGIN 40463000 C 0681 + PUTTEXT("WEEKDA"); 40464000 C 0682 + CURTYPE:=ALFATYPE; INSYMBOL; 40465000 C 0689 + END ELSE IF CURNAME1="400USER" THEN % "USER" 40466000 C 0690 + BEGIN 40467000 C 0693 + PUTTEXT(" TIME"); PUTTEXT(" (-1)"); 40468000 C 0694 + CURTYPE:=ALFATYPE; INSYMBOL; 40469000 C 0708 + END ELSE % "SIN","COS" ETC. 40470000 C 0709 + BEGIN 40471000 C 0709 + PUTTEXT(IF CURNAME1="3000SIN" THEN " SIN" ELSE 40472000 C 0712 + IF CURNAME1="3000COS" THEN " COS" ELSE 40473000 C 0712 + IF CURNAME1="6ARCTAN" THEN "ARCTAN" ELSE 40474000 C 0712 + IF CURNAME1="400SQRT" THEN " SQRT" ELSE 40475000 C 0712 + IF CURNAME1="3000EXP" THEN " EXP" ELSE 40476000 C 0712 + " LN"); 40477000 C 0712 + PARAMETER; 40478000 C 0727 + IF CURTYPE≠REALTYPE AND CURTYPE≠INTTYPE THEN ERROR(67); 40479000 C 0765 + CURTYPE:=REALTYPE; 40480000 C 0768 + END; 40481000 C 0769 + END OF INTRINSIC FUNCTIONS ELSE 40482000 C 0769 + 13 IS 784 LONG, NEXT SEG 12 + BEGIN 40483000 C 0076 + T:=THISID.TYPE; 40484000 C 0076 + PASSPARAMS; 40485000 C 0077 + CURTYPE:=T; 40486000 C 0078 + END; 40487000 C 0079 + END OF FUNCTIONS ELSE 40488000 C 0079 + IF THISID.IDCLASS=PROC THEN 40489000 C 0079 + BEGIN 40490000 C 0080 + ERROR(68); PASSPARAMS; 40491000 C 0081 + CURTYPE:=0; 40492000 C 0082 + END ELSE BEGIN ERROR(69); CURTYPE:=0; INSYMBOL END; 40493000 C 0083 + END ELSE BEGIN ERROR(1); CURTYPE:=0; INSYMBOL END; 40494000 C 0085 + END OF IDENTIFIER ELSE 40495000 C 0088 + IF CURSY≤CHARCONST THEN 40496000 C 0088 + BEGIN 40497000 C 0089 + CONSTANT(VAL,CURTYPE); PUTCONST(VAL); 40498000 C 0090 + END ELSE 40499000 C 0190 + IF CURSY=NOTSY THEN 40500000 C 0190 + BEGIN 40501000 C 0191 + PUTTEXT(" NOT "); PUTDUMMY; STARTSYM:=NUMSYMS; 40502000 C 0192 + INSYMBOL; FACTOR; 40503000 C 0206 + IF CURTYPE>0 THEN 40504000 C 0207 + IF CURTYPE≠BOOLTYPE THEN BEGIN ERROR(17); CURTYPE:=0 END; 40505000 C 0208 + IF CURMODE=NUMBER THEN 40506000 C 0211 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")"); 40507000 C 0212 + CURMODE:=BITPATTERN; 40508000 C 0223 + END; 40509000 C 0224 + END ELSE 40510000 C 0224 + IF CURSY=NILSY THEN 40511000 C 0224 + BEGIN 40512000 C 0225 + PUTCONST(0); CURTYPE:=NILTYPE; 40513000 C 0226 + INSYMBOL; 40514000 C 0239 + END ELSE 40515000 C 0239 + IF CURSY=LPAR THEN 40516000 C 0239 + BEGIN 40517000 C 0241 + PUTSYM("("); 40518000 C 0241 + INSYMBOL; EXPRESSION; 40519000 C 0249 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40520000 C 0250 + PUTSYM(")"); 40521000 C 0252 + INSYMBOL; 40522000 C 0260 + END ELSE 40523000 C 0260 + IF CURSY=LBRACKET THEN %*** SET CONSTANT *** 40524000 C 0260 + BEGIN 40525000 C 0262 + INSYMBOL; 40526000 C 0262 + IF CURSY=RBRACKET THEN 40527000 C 0263 + BEGIN 40528000 C 0263 + PUTCONST(0); CURTYPE:=EMPTYSET; CURMODE:=NUMBER; 40529000 C 0264 + INSYMBOL; 40530000 C 0279 + END ELSE 40531000 C 0279 + BEGIN 40532000 C 0279 + FIRST:=TRUE; 40533000 C 0280 + DO BEGIN 40534000 C 0280 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 40535000 C 0281 + PUTTEXT(" BIT("); STARTSYM:=NUMSYMS; 40536000 C 0283 + EXPRESSION; 40537000 C 0290 + IF STYPE=0 THEN 40538000 C 0290 + BEGIN STYPE:=CURTYPE; 40539000 C 0291 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(72); 40540000 C 0292 + END ELSE CHECKTYPES(STYPE,CURTYPE); 40541000 C 0295 + IF CURSY=DOUBLEDOT THEN 40542000 C 0356 + BEGIN 40543000 C 0356 + PUTSYM(","); SYMTAB[STARTSYM]:=" BITS("; 40544000 C 0357 + INSYMBOL; EXPRESSION; 40545000 C 0366 + IF STYPE=0 THEN 40546000 C 0367 + BEGIN STYPE:=CURTYPE; 40547000 C 0367 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(72); 40548000 C 0369 + END ELSE CHECKTYPES(STYPE,CURTYPE); 40549000 C 0371 + END; 40550000 C 0433 + PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); 40551000 C 0433 + IF CURSY=COMMA THEN PUTTEXT(" OR"); 40552000 C 0461 + END UNTIL CURSY≠COMMA; 40553000 C 0468 + IF CURSY≠RBRACKET THEN 40554000 C 0469 + BEGIN ERROR(59); SKIP(RBRACKET); 40555000 C 0470 + IF CURSY=RBRACKET THEN INSYMBOL; 40556000 C 0472 + END ELSE INSYMBOL; 40557000 C 0473 + NEWTYPE; T1:=SET; T1.SIZE:=1; T1.STRUCT:=0; 40558000 C 0476 + T1.SETTYPE:=STYPE; TYPETAB1[TYPEINDEX]:=T1; 40559000 C 0485 + CURTYPE:=TYPEINDEX; 40560000 C 0488 + CURMODE:=BITPATTERN; 40561000 C 0489 + END; 40562000 C 0490 + END OF SET CONSTANT ELSE BEGIN ERROR(99); INSYMBOL END; 40563000 C 0490 + END OF FACTOR; 40564000 C 0492 + 12 IS 498 LONG, NEXT SEG 2 + 40565000 C 0369 + 40566000 C 0369 + PROCEDURE TERM; %*** TERM *** 40567000 C 0369 + BEGIN %************ 40568000 C 0369 + INTEGER STARTSYM,MODE,TYPE1,MULOPTR,F; 40569000 C 0369 + START OF SEGMENT ********** 14 + PUTDUMMY; STARTSYM:=NUMSYMS; 40570000 C 0000 + FACTOR; 40571000 C 0006 + MODE:=CURMODE; 40572000 C 0007 + WHILE CURSY≥ASTERISK AND CURSY≤MODSY DO % "*","/","DIV","MOD","AND" 40573000 C 0007 + BEGIN 40574000 C 0010 + TYPE1:=CURTYPE; MULOPTR:=CURSY; 40575000 C 0010 + F:=TYPETAB1[TYPE1].FORM; 40576000 C 0011 + IF F=NUMERIC OR F=FLOATING THEN 40577000 C 0013 + BEGIN 40578000 C 0015 + MODE:=NUMBER; 40579000 C 0015 + IF CURSY=ASTERISK THEN PUTSYM("×") ELSE 40580000 C 0016 + IF CURSY=SLASH THEN PUTSYM("/") ELSE 40581000 C 0026 + IF CURSY=ANDSY THEN ERROR(64) ELSE 40582000 C 0035 + BEGIN 40583000 C 0038 + IF F=FLOATING THEN ERROR(64); 40584000 C 0038 + IF CURSY=DIVSY THEN PUTTEXT(" DIV") ELSE PUTTEXT(" MOD"); 40585000 C 0040 + END END ELSE 40586000 C 0055 + IF CURTYPE=BOOLTYPE OR F=SET THEN 40587000 C 0055 + BEGIN 40588000 C 0059 + MODE:=BITPATTERN; 40589000 C 0060 + IF CURMODE≠MODE THEN 40590000 C 0061 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40591000 C 0061 + PUTTEXT(" AND "); 40592000 C 0072 + IF CURSY≠(IF F=SET THEN ASTERISK ELSE ANDSY) THEN ERROR(64); 40593000 C 0078 + END ELSE ERROR(64); 40594000 C 0082 + PUTDUMMY; STARTSYM:=NUMSYMS; 40595000 C 0084 + INSYMBOL; FACTOR; 40596000 C 0091 + IF CURTYPE>0 AND TYPE1>0 THEN 40597000 C 0092 + BEGIN 40598000 C 0094 + IF CURTYPE≠TYPE1 THEN 40599000 C 0094 + BEGIN 40600000 C 0095 + IF TYPETAB1[TYPE1].FORM≠NUMERIC OR CURTYPE≠REALTYPE THEN 40601000 C 0095 + CHECKTYPES(TYPE1,CURTYPE); 40602000 C 0098 + IF TYPE1=REALTYPE THEN CURTYPE:=REALTYPE; 40603000 C 0159 + END; 40604000 C 0161 + IF CURTYPE=REALTYPE AND MULOPTR≥DIVSY THEN ERROR(65); 40605000 C 0161 + END; 40606000 C 0164 + IF MULOPTR=SLASH THEN CURTYPE:=REALTYPE; 40607000 C 0164 + IF CURTYPE=0 THEN CURTYPE:=TYPE1; 40608000 C 0166 + END OF WHILE LOOP; 40609000 C 0168 + IF MODE=BITPATTERN AND CURMODE≠MODE THEN 40610000 C 0168 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40611000 C 0170 + CURMODE:=MODE; 40612000 C 0180 + END OF TERM; 40613000 C 0181 + 14 IS 185 LONG, NEXT SEG 2 + 40614000 C 0369 + 40615000 C 0369 + PROCEDURE SIMPLEEXPRESSION; %*** SIMPLE EXPRESSION *** 40616000 C 0369 + BEGIN %************************* 40617000 C 0369 + INTEGER STARTSYM,MODE,TYPE1,F; 40618000 C 0369 + START OF SEGMENT ********** 15 + BOOLEAN SIGNED; 40619000 C 0000 + 40620000 C 0000 + PUTDUMMY; STARTSYM:=NUMSYMS; 40621000 C 0000 + IF CURSY=PLUS OR CURSY=MINUS THEN 40622000 C 0006 + BEGIN SIGNED:=TRUE; 40623000 C 0008 + PUTSYM(IF CURSY=PLUS THEN"+" ELSE "-"); 40624000 C 0009 + INSYMBOL; 40625000 C 0020 + END; 40626000 C 0021 + TERM; 40627000 C 0021 + MODE:=CURMODE; 40628000 C 0021 + IF SIGNED THEN 40629000 C 0022 + BEGIN F:=TYPETAB1[CURTYPE].FORM; 40630000 C 0022 + IF F≠NUMERIC AND F≠FLOATING THEN ERROR(29); 40631000 C 0024 + END; 40632000 C 0027 + WHILE CURSY≥PLUS AND CURSY≤ORSY DO % "+","-","OR" 40633000 C 0027 + BEGIN 40634000 C 0030 + TYPE1:=CURTYPE; F:=TYPETAB1[TYPE1].FORM; 40635000 C 0030 + IF F=NUMERIC OR F=FLOATING THEN 40636000 C 0032 + BEGIN MODE:=NUMBER; 40637000 C 0034 + IF CURSY=PLUS THEN PUTSYM("+") ELSE 40638000 C 0035 + IF CURSY=MINUS THEN PUTSYM("-") ELSE ERROR(64); 40639000 C 0044 + END ELSE 40640000 C 0054 + IF CURTYPE=BOOLTYPE THEN 40641000 C 0054 + BEGIN 40642000 C 0056 + MODE:=BITPATTERN; 40643000 C 0056 + IF CURMODE≠MODE THEN 40644000 C 0057 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40645000 C 0058 + IF CURSY=ORSY THEN PUTTEXT(" OR") ELSE ERROR(64); 40646000 C 0068 + END ELSE 40647000 C 0077 + IF F=SET THEN 40648000 C 0077 + BEGIN 40649000 C 0079 + MODE:=BITPATTERN; 40650000 C 0079 + IF CURMODE≠MODE THEN 40651000 C 0080 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")"); END; 40652000 C 0081 + IF CURSY=PLUS THEN PUTTEXT(" OR") ELSE 40653000 C 0091 + IF CURSY=MINUS THEN BEGIN PUTTEXT(" AND");PUTTEXT(" NOT ")END 40654000 C 0098 + ELSE ERROR(64); 40655000 C 0114 + END ELSE ERROR(64); 40656000 C 0116 + INSYMBOL; 40657000 C 0118 + PUTDUMMY; STARTSYM:=NUMSYMS; 40658000 C 0118 + TERM; 40659000 C 0125 + IF CURTYPE>0 AND TYPE1>0 THEN 40660000 C 0125 + BEGIN 40661000 C 0127 + IF CURTYPE≠TYPE1 THEN 40662000 C 0127 + BEGIN 40663000 C 0128 + IF TYPETAB1[TYPE1].FORM≠NUMERIC OR CURTYPE≠REALTYPE THEN 40664000 C 0129 + CHECKTYPES(TYPE1,CURTYPE); 40665000 C 0131 + IF TYPE1=REALTYPE THEN CURTYPE:=REALTYPE; 40666000 C 0192 + END END; 40667000 C 0194 + IF CURTYPE=0 THEN CURTYPE:=TYPE1; 40668000 C 0194 + END OF WHILE LOOP; 40669000 C 0196 + IF MODE=BITPATTERN AND CURMODE≠BITPATTERN THEN 40670000 C 0196 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40671000 C 0198 + CURMODE:=MODE; 40672000 C 0208 + END OF SIMPLEEXPRESSION; 40673000 C 0209 + 15 IS 213 LONG, NEXT SEG 2 + 40674000 C 0369 + 40675000 C 0369 + PROCEDURE EXPRESSION; %*** EXPRESSION *** 40676000 C 0369 + BEGIN %****************** 40677000 C 0369 + INTEGER STARTSYM,FIRSTSYM,TYPE1,RELOPTR,F; 40678000 C 0369 + START OF SEGMENT ********** 16 + BOOLEAN CALLGEN; 40679000 C 0000 + 40680000 C 0000 + EXPRLEVEL:=EXPRLEVEL+1; 40681000 C 0000 + IF EXPRLEVEL = 1 THEN 40682000 C 0001 + BEGIN 40683000 C 0002 + PUTDUMMY; 40684000 C 0002 + FIRSTSYM := NUMSYMS; 40685000 C 0008 + END; 40686000 C 0009 + PUTDUMMY; STARTSYM:=NUMSYMS; 40687000 C 0009 + PUTDUMMY; 40688000 C 0017 + SIMPLEEXPRESSION; 40689000 C 0024 + IF CURSY≥LSSSY AND CURSY≤INSY THEN % "<","≤","≥",">","=","≠","IN" 40690000 C 0025 + BEGIN 40691000 C 0026 + TYPE1:=CURTYPE; F:=TYPETAB1[TYPE1].FORM; 40692000 C 0027 + RELOPTR:=CURSY; 40693000 C 0029 + IF F≤ALFA THEN 40694000 C 0030 + BEGIN 40695000 C 0031 + IF CURMODE=BITPATTERN THEN 40696000 C 0031 + BEGIN SYMTAB[STARTSYM]:=" REAL("; PUTSYM(")") END; 40697000 C 0032 + IF CURSY=LSSSY THEN PUTSYM("<") ELSE 40698000 C 0043 + IF CURSY=LEQSY THEN PUTSYM("≤") ELSE 40699000 C 0052 + IF CURSY=GEQSY THEN PUTSYM("≥") ELSE 40700000 C 0061 + IF CURSY=GTRSY THEN PUTSYM(">") ELSE 40701000 C 0070 + IF CURSY=EQLSY THEN PUTSYM("=") ELSE 40702000 C 0080 + IF CURSY=NEQSY THEN PUTSYM("≠") ELSE 40703000 C 0089 + BEGIN 40704000 C 0098 + IF F≥FLOATING THEN ERROR(64); 40705000 C 0099 + SYMTAB[STARTSYM]:="INTST("; PUTSYM(","); CALLGEN:=TRUE; 40706000 C 0101 + END; 40707000 C 0112 + END ELSE 40708000 C 0112 + IF F=SET THEN 40709000 C 0112 + BEGIN 40710000 C 0113 + IF CURMODE=BITPATTERN THEN 40711000 C 0114 + BEGIN SYMTAB[STARTSYM+1]:=" REAL("; PUTSYM(")") END; 40712000 C 0114 + IF CURSY=EQLSY OR CURSY=NEQSY THEN 40713000 C 0125 + BEGIN PUTSYM(IF CURSY=EQLSY THEN "=" ELSE "≠"); 40714000 C 0127 + END ELSE 40715000 C 0137 + BEGIN 40716000 C 0137 + IF CURSY=LEQSY THEN SYMTAB[STARTSYM]:="INCL1(" ELSE 40717000 C 0137 + IF CURSY=GEQSY THEN SYMTAB[STARTSYM]:="INCL2(" ELSE ERROR(64); 40718000 C 0140 + PUTSYM(","); CALLGEN:=TRUE; 40719000 C 0146 + END END ELSE 40720000 C 0155 + IF F=POINTERS THEN 40721000 C 0155 + BEGIN 40722000 C 0156 + IF CURSY=EQLSY THEN PUTSYM("=") ELSE 40723000 C 0156 + IF CURSY=NEQSY THEN PUTSYM("≠") ELSE ERROR(64); 40724000 C 0165 + END ELSE ERROR(64); 40725000 C 0176 + INSYMBOL; 40726000 C 0177 + PUTDUMMY; STARTSYM:=NUMSYMS; 40727000 C 0177 + SIMPLEEXPRESSION; 40728000 C 0184 + IF CURTYPE>0 AND TYPE1>0 THEN 40729000 C 0184 + IF CURTYPE≠TYPE1 THEN 40730000 C 0186 + IF RELOPTR≠INSY THEN 40731000 C 0187 + BEGIN 40732000 C 0189 + IF TYPETAB1[TYPE1].FORM≠NUMERIC OR CURTYPE≠REALTYPE THEN 40733000 C 0189 + CHECKTYPES(TYPE1,CURTYPE); 40734000 C 0192 + END ELSE 40735000 C 0253 + IF TYPETAB1[CURTYPE].FORM≠SET THEN ERROR(66) 40736000 C 0253 + ELSE CHECKTYPES(TYPE1,TYPETAB1[CURTYPE].SETTYPE); 40737000 C 0255 + IF CURMODE=BITPATTERN THEN 40738000 C 0318 + BEGIN SYMTAB[STARTSYM]:=" REAL("; PUTSYM(")") END; 40739000 C 0318 + IF CALLGEN THEN PUTSYM(")"); 40740000 C 0329 + CURTYPE:=BOOLTYPE; CURMODE:=BITPATTERN; 40741000 C 0337 + END; 40742000 C 0339 + EXPRLEVEL:=EXPRLEVEL-1; 40743000 C 0339 + IF EXPRLEVEL=0 THEN 40744000 C 0341 + BEGIN 40745000 C 0342 + IF CURMODE=BITPATTERN THEN 40746000 C 0342 + BEGIN 40747000 C 0343 + SYMTAB[FIRSTSYM] := " REAL("; 40748000 C 0343 + PUTSYM(")"); 40749000 C 0345 + END; 40750000 C 0353 + WRITEEXPR; 40751000 C 0353 + END; 40752000 C 0431 + END OF EXPRESSION; 40753000 C 0431 + 16 IS 438 LONG, NEXT SEG 2 + 40754000 C 0369 + 40755000 C 0369 + DEFINE BOOLEXPR= 40756000 C 0369 + BEGIN 40757000 C 0369 + PUTDUMMY; EXPRLEVEL:=1; EXPRESSION; 40758000 C 0369 + IF CURTYPE>0 THEN IF CURTYPE≠BOOLTYPE THEN ERROR(17); 40759000 C 0369 + IF CURMODE≠BITPATTERN THEN 40760000 C 0369 + BEGIN SYMTAB[1]:=" B("; PUTSYM(")") END; 40761000 C 0369 + EXPRLEVEL:=0; WRITEEXPR; 40762000 C 0369 + END OF BOOLEAN#; 40763000 C 0369 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50001000 C 0369 + % % 50002000 C 0369 + % % 50003000 C 0369 + % % 50004000 C 0369 + % PART 5: INTRINSIC ROUTINES. % 50005000 C 0369 + % ------------------- % 50006000 C 0369 + % % 50007000 C 0369 + % % 50008000 C 0369 + % % 50009000 C 0369 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50010000 C 0369 + 50011000 C 0369 + 50012000 C 0369 + PROCEDURE CONCAT; %*** "CONCAT" *** 50013000 C 0369 + BEGIN %**************** 50014000 C 0369 + DEFINE INTEXPR= 50015000 C 0369 + START OF SEGMENT ********** 17 + BEGIN INSYMBOL; EXPRESSION; 50016000 C 0000 + IF CURTYPE>0 THEN 50017000 C 0000 + IF TYPETAB1[CURTYPE].FORM≠NUMERIC THEN ERROR(17); 50018000 C 0000 + END #; 50019000 C 0000 + 50020000 C 0000 + PUTTEXT("CONCAT"); PUTSYM("("); 50021000 C 0000 + INSYMBOL; 50022000 C 0014 + IF CURSY=LPAR THEN 50023000 C 0015 + BEGIN 50024000 C 0015 + INSYMBOL; EXPRESSION; 50025000 C 0016 + IF CURTYPE>0 THEN 50026000 C 0017 + IF TYPETAB1[CURTYPE].FORM>ALFA THEN ERROR(17); 50027000 C 0018 + IF CURSY=COMMA THEN 50028000 C 0021 + BEGIN 50029000 C 0022 + PUTSYM(","); INSYMBOL; EXPRESSION; 50030000 C 0022 + IF CURTYPE>0 THEN 50031000 C 0031 + IF TYPETAB1[CURTYPE].FORM>ALFA THEN ERROR(17); 50032000 C 0031 + IF CURSY=COMMA THEN 50033000 C 0035 + BEGIN 50034000 C 0035 + PUTSYM(","); INTEXPR; 50035000 C 0036 + IF CURSY=COMMA THEN 50036000 C 0048 + BEGIN 50037000 C 0049 + PUTSYM(","); INTEXPR; 50038000 C 0050 + IF CURSY=COMMA THEN 50039000 C 0062 + BEGIN 50040000 C 0063 + PUTSYM(","); INTEXPR; 50041000 C 0063 + PUTSYM(","); PUTCONST(CARDCNT); 50042000 C 0076 + PUTSYM(")"); 50043000 C 0096 + IF CURSY≠RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; 50044000 C 0104 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50045000 C 0106 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50046000 C 0108 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50047000 C 0110 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50048000 C 0112 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50049000 C 0114 + CURTYPE:=REALTYPE; 50050000 C 0116 + IF CURSY=RPAR THEN INSYMBOL; 50051000 C 0117 + END OF CONCAT; 50052000 C 0119 + 17 IS 120 LONG, NEXT SEG 2 + 50053000 C 0369 + 50054000 C 0369 + PROCEDURE PREAD(CHANGELINE); 50055000 C 0369 + VALUE CHANGELINE; BOOLEAN CHANGELINE; 50056000 C 0369 + BEGIN 50057000 C 0369 + INTEGER FILEID,F; 50058000 C 0369 + START OF SEGMENT ********** 18 + BOOLEAN CHECK; 50059000 C 0000 + GEN(" BEGIN",7,2); 50060000 C 0000 + FILEPARAM(INPUTFILE); FILEID:=FILENAME; 50061000 C 0009 + IF TYPETAB1[CURTYPE].FORM=FILES THEN ERROR(85); 50062000 C 0062 + IF SYMKIND[CURSY]≠TERMINAL THEN 50063000 C 0065 + BEGIN 50064000 C 0066 + IF CURSY NEQ RPAR THEN 50065000 C 0066 + DO BEGIN 50066000 C 0067 + WHILE CURSY=COMMA DO INSYMBOL; 50067000 C 0068 + IF CURSY=IDENTIFIER THEN 50068000 C 0070 + BEGIN 50069000 C 0071 + SEARCH; 50070000 C 0071 + IF FOUND THEN 50071000 C 0100 + BEGIN 50072000 C 0100 + IF THISID.IDCLASS=VAR OR 50073000 C 0100 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 50074000 C 0102 + BEGIN 50075000 C 0104 + VARIABLE; F:=TYPETAB1[CURTYPE].FORM; 50076000 C 0105 + IF F=NUMERIC OR F=FLOATING OR F=CHAR THEN 50077000 C 0107 + BEGIN 50078000 C 0109 + CHECK:=CHECKOPTION AND F≠FLOATING; 50079000 C 0110 + WRITEEXPR; GEN(":=",2,6); 50080000 C 0112 + IF CHECK THEN GEN("CHECK(",6,2); 50081000 C 0198 + GEN("PREAD(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 50082000 C 0207 + GENID("V",FILEID,5); GEN(",",1,7); 50083000 C 0237 + GENID("I",FILEID,5); GEN(",",1,7); 50084000 C 0257 + IF F=NUMERIC THEN GENINT(2) ELSE 50085000 C 0278 + IF F=FLOATING THEN GENINT(3) ELSE GENINT(1); 50086000 C 0324 + GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50087000 C 0411 + IF CHECK THEN 50088000 C 0471 + BEGIN 50089000 C 0472 + GEN(",",1,7); GENINT(TYPETAB2[CURTYPE]); GEN(",",1,7); 50090000 C 0472 + GENINT(TYPETAB3[CURTYPE]); GEN(",",1,7); 50091000 C 0532 + GENINT(CARDCNT); GEN(")",1,7); 50092000 C 0584 + END; 50093000 C 0635 + END ELSE BEGIN ERROR(82); INSYMBOL END; 50094000 C 0635 + END ELSE BEGIN ERROR(8); INSYMBOL END; 50095000 C 0638 + END ELSE BEGIN ERROR(1); INSYMBOL END; 50096000 C 0641 + END ELSE ERROR(9); 50097000 C 0644 + GEN(";",1,7); 50098000 C 0646 + END UNTIL CURSY≠COMMA; 50099000 C 0655 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50100000 C 0657 + IF CURSY=RPAR THEN INSYMBOL; 50101000 C 0659 + END; 50102000 C 0661 + IF CHANGELINE THEN 50103000 C 0661 + BEGIN 50104000 C 0662 + GEN("RLINE(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 50105000 C 0662 + GENID("V",FILEID,5); GEN(",",1,7); 50106000 C 0692 + GENID("I",FILEID,5); GEN(")",1,7); 50107000 C 0712 + END; 50108000 C 0733 + GEN("END",4,5); 50109000 C 0733 + END OF PREAD; 50110000 C 0742 + 18 IS 758 LONG, NEXT SEG 2 + 50111000 C 0369 + 50112000 C 0369 + PROCEDURE PWRITE(LINEFEED); 50113000 C 0369 + VALUE LINEFEED; BOOLEAN LINEFEED; 50114000 C 0369 + BEGIN 50115000 C 0369 + INTEGER FILEID,F,I,LASTSY; 50116000 C 0369 + START OF SEGMENT ********** 19 + POINTER P; 50117000 C 0000 + GEN(" BEGIN",7,2); 50118000 C 0000 + FILEPARAM(OUTPUTFILE); FILEID:=FILENAME; 50119000 C 0009 + IF TYPETAB1[CURTYPE].FORM=FILES THEN ERROR(85); 50120000 C 0062 + IF SYMKIND[CURSY]≠TERMINAL THEN 50121000 C 0065 + BEGIN 50122000 C 0066 + IF CURSY NEQ RPAR THEN 50123000 C 0066 + DO BEGIN 50124000 C 0067 + WHILE CURSY=COMMA DO INSYMBOL; 50125000 C 0068 + IF CURSY=ALFACONST AND CURLENGTH>7 THEN 50126000 C 0070 + BEGIN 50127000 C 0072 + GEN("WALFA(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 50128000 C 0072 + GENID("V",FILEID,5); GEN(",",1,7); 50129000 C 0102 + GENID("I",FILEID,5); GEN(",",1,7); 50130000 C 0122 + P:=STRINGPNT; 50131000 C 0143 + FOR I:=1 STEP 7 UNTIL 80 DO 50132000 C 0143 + IF I≤CURLENGTH THEN 50133000 C 0146 + BEGIN 50134000 C 0146 + IF ALGOLCNT<10 THEN WRITEALGOL; 50135000 C 0147 + REPLACE ALGOLPNT:ALGOLPNT BY """, P:P FOR 7, """, ","; 50136000 C 0149 + ALGOLCNT:=ALGOLCNT-10; 50137000 C 0160 + END ELSE GEN("0,",2,6); 50138000 C 0162 + GENINT(CURLENGTH); GEN(",",1,7); 50139000 C 0173 + GENINT(CARDCNT); GEN(")",1,7); 50140000 C 0224 + INSYMBOL; 50141000 C 0275 + END OF ALFACONST ELSE 50142000 C 0276 + BEGIN 50143000 C 0276 + GEN("PWRITE(",7,1); GENID("F",FILEID,5); GEN(",",1,7); 50144000 C 0276 + GENID("V",FILEID,5); GEN(",",1,7); 50145000 C 0306 + GENID("I",FILEID,5); GEN(",",1,7); 50146000 C 0326 + LASTSY:=CURSY; 50147000 C 0347 + EXPRESSION; F:=TYPETAB1[CURTYPE].FORM; 50148000 C 0348 + GEN(",",1,7); 50149000 C 0350 + IF F=NUMERIC OR F=FLOATING OR F=CHAR OR F=ALFA OR 50150000 C 0359 + CURTYPE=BOOLTYPE THEN 50151000 C 0362 + BEGIN 50152000 C 0363 + IF F=NUMERIC THEN GENINT(1) ELSE 50153000 C 0364 + IF F=FLOATING THEN GENINT(2) ELSE 50154000 C 0408 + IF F=ALFA THEN GENINT(5) ELSE 50155000 C 0452 + IF F=CHAR THEN GENINT(4) ELSE GENINT(3); 50156000 C 0496 + GEN(",",1,7); 50157000 C 0583 + IF CURSY=COLON THEN 50158000 C 0592 + BEGIN 50159000 C 0593 + INSYMBOL; EXPRESSION; 50160000 C 0594 + IF TYPETAB1[CURTYPE].FORM NEQ NUMERIC THEN ERROR(17); 50161000 C 0595 + GEN(",",1,7); 50162000 C 0597 + IF CURSY=COLON THEN 50163000 C 0606 + BEGIN 50164000 C 0607 + IF F≠FLOATING THEN ERROR(4); 50165000 C 0608 + INSYMBOL; EXPRESSION; 50166000 C 0610 + IF TYPETAB1[CURTYPE].FORM NEQ NUMERIC THEN ERROR(17); 50167000 C 0611 + GEN(",",1,7); 50168000 C 0613 + END ELSE GEN("-1,",3,5); 50169000 C 0622 + END ELSE 50170000 C 0632 + BEGIN 50171000 C 0632 + IF F=FLOATING THEN GENINT(16) ELSE 50172000 C 0634 + IF F=ALFA AND LASTSY=ALFACONST THEN GENINT(CURLENGTH) ELSE 50173000 C 0677 + IF F=ALFA THEN GENINT(7) ELSE 50174000 C 0722 + IF F=CHAR THEN GENINT(1) ELSE GENINT(10); 50175000 C 0766 + GEN(",-1,",4,4); 50176000 C 0853 + END; 50177000 C 0862 + END ELSE ERROR(17); 50178000 C 0862 + GENINT(CARDCNT); GEN(")",1,7); 50179000 C 0865 + END OF EXPRESSION; 50180000 C 0916 + GEN(";",1,7); 50181000 C 0916 + END UNTIL CURSY≠COMMA; 50182000 C 0927 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50183000 C 0928 + IF CURSY=RPAR THEN INSYMBOL; 50184000 C 0931 + END; 50185000 C 0933 + FILENAME:=FILEID; 50186000 C 0933 + IF LINEFEED THEN 50187000 C 0934 + BEGIN 50188000 C 0935 + INTEGER DUMMY; 50189000 C 0935 + START OF SEGMENT ********** 20 + GEN("WLINE(",6,2); GENID("F",FILENAME,5); GEN(",",1,7); 50190000 C 0000 + GENID("V",FILENAME,5); GEN(",",1,7); 50191000 C 0029 + GENID("I",FILENAME,5); GEN(")",1,7); 50192000 C 0050 + END; 50193000 C 0070 + 20 IS 72 LONG, NEXT SEG 19 + GEN("END",4,5); 50194000 C 0936 + END OF PWRITE; 50195000 C 0945 + 19 IS 957 LONG, NEXT SEG 2 + 50196000 C 0369 + 50197000 C 0369 + PROCEDURE FILEHANDLING(PROCNUM); %*** FILE HANDLING PROCEDURES: 50198000 C 0369 + VALUE PROCNUM; INTEGER PROCNUM; %*** 50199000 C 0369 + BEGIN %*** 1) PUT 50200000 C 0369 + INTEGER F; %*** 2) GET 50201000 C 0369 + START OF SEGMENT ********** 21 + CASE PROCNUM OF %*** 3) RESET 50202000 C 0000 + BEGIN ; %*** 4) REWRITE 50203000 C 0000 + GEN("PUT",3,5); %*** 5) PAGE 50204000 C 0000 + GEN("GET",3,5); % 50205000 C 0010 + GEN("RESET",5,3); % 50206000 C 0019 + GEN("REWRITE",7,1); % 50207000 C 0029 + GEN("PAGE",4,4); % 50208000 C 0038 + END; % 50209000 C 0048 + START OF SEGMENT ********** 22 + 22 IS 7 LONG, NEXT SEG 21 + GEN("(",1,7); FILEPARAM(0); % 50210000 C 0048 + IF FILENAME=0 THEN ERROR(78); % 50211000 C 0114 + F:=TYPETAB1[CURTYPE].FORM; 50212000 C 0116 + IF F=FILES AND PROCNUM=5 THEN ERROR(80); 50213000 C 0118 + GENID("F",FILENAME,5); GEN(",",1,7); 50214000 C 0121 + GENID("V",FILENAME,5); GEN(",",1,7); 50215000 C 0141 + GENID("I",FILENAME,5); GEN(",",1,7); 50216000 C 0162 + GENINT(CARDCNT); GEN(")",1,7); 50217000 C 0182 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50218000 C 0233 + IF CURSY=RPAR THEN INSYMBOL; 50219000 C 0236 + END OF FILEHANDLING; 50220000 C 0238 + 21 IS 241 LONG, NEXT SEG 2 + 50221000 C 0369 + 50222000 C 0369 + PROCEDURE PACK; 50223000 C 0369 + BEGIN 50224000 C 0369 + INTEGER IT,T; 50225000 C 0369 + START OF SEGMENT ********** 23 + GEN("PACK(",5,3); 50226000 C 0000 + INSYMBOL; 50227000 C 0009 + IF CURSY=LPAR THEN 50228000 C 0009 + BEGIN 50229000 C 0010 + INSYMBOL; 50230000 C 0010 + IF CURSY=IDENTIFIER THEN 50231000 C 0011 + BEGIN 50232000 C 0012 + SEARCH; 50233000 C 0012 + IF FOUND THEN 50234000 C 0042 + BEGIN 50235000 C 0043 + IF THISID.IDCLASS=VAR THEN 50236000 C 0043 + BEGIN 50237000 C 0044 + T:=TYPETAB1[THISID.TYPE]; 50238000 C 0045 + IF T.FORM=ARRAYS THEN 50239000 C 0046 + BEGIN 50240000 C 0048 + IT:=T.INXTYPE; 50241000 C 0048 + IF TYPETAB1[T.ARRTYPE].FORM≠CHAR THEN ERROR(88); 50242000 C 0049 + GENID("V",1000×THISLEVEL+THISINDEX,5); 50243000 C 0053 + IF THISLEVEL>1 AND THISLEVEL≠CURLEVEL THEN ERROR(5); 50244000 C 0065 + GEN(",",1,7); GENINT(TYPETAB2[THISID.TYPE]); 50245000 C 0068 + GEN(",",1,7); GENINT(TYPETAB3[THISID.TYPE]); 50246000 C 0120 + END ELSE ERROR(88); 50247000 C 0173 + END ELSE ERROR(88); 50248000 C 0175 + END ELSE ERROR(1); 50249000 C 0176 + END ELSE ERROR(9); 50250000 C 0177 + INSYMBOL; 50251000 C 0178 + IF CURSY=COMMA THEN 50252000 C 0179 + BEGIN 50253000 C 0180 + GEN(",",1,7); 50254000 C 0180 + INSYMBOL; EXPRESSION; CHECKTYPES(IT,CURTYPE); 50255000 C 0189 + IF CURSY=COMMA THEN 50256000 C 0250 + BEGIN 50257000 C 0250 + GEN(",",1,7); 50258000 C 0251 + INSYMBOL; 50259000 C 0260 + IF CURSY=IDENTIFIER THEN 50260000 C 0260 + BEGIN 50261000 C 0261 + SEARCH; 50262000 C 0262 + IF FOUND THEN 50263000 C 0291 + BEGIN 50264000 C 0291 + IF THISID.IDCLASS=VAR OR 50265000 C 0291 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 50266000 C 0293 + BEGIN 50267000 C 0295 + VARIABLE; WRITEEXPR; 50268000 C 0296 + IF CURTYPE>0 THEN 50269000 C 0374 + IF TYPETAB1[CURTYPE].FORM≠ALFA THEN ERROR(12); 50270000 C 0374 + END ELSE ERROR(8); 50271000 C 0378 + END ELSE ERROR(1); 50272000 C 0379 + END ELSE ERROR(9); 50273000 C 0380 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50274000 C 0381 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50275000 C 0383 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50276000 C 0385 + IF CURSY=RPAR THEN INSYMBOL; 50277000 C 0388 + END ELSE BEGIN ERROR(3); INSYMBOL END; 50278000 C 0390 + GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50279000 C 0393 + END OF PACK; 50280000 C 0453 + 23 IS 459 LONG, NEXT SEG 2 + 50281000 C 0369 + 50282000 C 0369 + PROCEDURE UNPACK; 50283000 C 0369 + BEGIN 50284000 C 0369 + INTEGER IT,T; 50285000 C 0369 + START OF SEGMENT ********** 24 + GEN("UNPACK(",7,1); INSYMBOL; 50286000 C 0000 + IF CURSY=LPAR THEN 50287000 C 0009 + BEGIN 50288000 C 0010 + INSYMBOL; EXPRESSION; 50289000 C 0010 + IF CURTYPE>0 THEN IF TYPETAB1[CURTYPE].FORM≠ALFA THEN ERROR(17); 50290000 C 0011 + IF CURSY=COMMA THEN 50291000 C 0015 + BEGIN 50292000 C 0016 + GEN(",",1,7); INSYMBOL; 50293000 C 0017 + IF CURSY=IDENTIFIER THEN 50294000 C 0026 + BEGIN 50295000 C 0027 + SEARCH; 50296000 C 0027 + IF FOUND THEN 50297000 C 0057 + BEGIN 50298000 C 0058 + IF THISID.IDCLASS=VAR THEN 50299000 C 0058 + BEGIN 50300000 C 0059 + T:=TYPETAB1[THISID.TYPE]; 50301000 C 0060 + IF T.FORM=ARRAYS THEN 50302000 C 0061 + BEGIN 50303000 C 0063 + IT:=T.INXTYPE; 50304000 C 0063 + IF TYPETAB1[T.ARRTYPE].FORM≠CHAR THEN ERROR(88); 50305000 C 0064 + IF THISLEVEL>1 AND THISLEVEL≠CURLEVEL THEN ERROR(5); 50306000 C 0068 + GENID("V",1000×THISLEVEL+THISINDEX,5); 50307000 C 0071 + GEN(",",1,7); GENINT(TYPETAB2[THISID.TYPE]); 50308000 C 0083 + GEN(",",1,7); GENINT(TYPETAB3[THISID.TYPE]); 50309000 C 0135 + END ELSE ERROR(88); 50310000 C 0188 + END ELSE ERROR(88); 50311000 C 0190 + END ELSE ERROR(1); 50312000 C 0191 + END ELSE ERROR(9); 50313000 C 0192 + INSYMBOL; 50314000 C 0193 + IF CURSY=COMMA THEN 50315000 C 0194 + BEGIN 50316000 C 0195 + GEN(",",1,7); 50317000 C 0195 + INSYMBOL; EXPRESSION; CHECKTYPES(IT,CURTYPE); 50318000 C 0204 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50319000 C 0265 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50320000 C 0267 + IF CURSY≠RPAR THEN BEGIN ERROR(89); SKIP(RPAR) END; 50321000 C 0269 + IF CURSY=RPAR THEN INSYMBOL; 50322000 C 0271 + END ELSE BEGIN ERROR(3); INSYMBOL END; 50323000 C 0273 + GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50324000 C 0275 + END OF UNPACK; 50325000 C 0335 + 24 IS 339 LONG, NEXT SEG 2 + 50326000 C 0369 + 50327000 C 0369 + PROCEDURE NEWDISP; %*** "NEW","DISPOSE" 50328000 C 0369 + BEGIN 50329000 C 0369 + INTEGER T1; 50330000 C 0369 + START OF SEGMENT ********** 25 + IF CURNAME1="3000NEW" THEN GEN("NEW(",4,4) ELSE 50331000 C 0000 + BEGIN GEN("DISPOSE",7,1); GEN("(",1,7) END; 50332000 C 0010 + INSYMBOL; 50333000 C 0031 + IF CURSY=LPAR THEN 50334000 C 0031 + BEGIN 50335000 C 0032 + INSYMBOL; 50336000 C 0032 + IF CURSY=IDENTIFIER THEN 50337000 C 0033 + BEGIN 50338000 C 0034 + SEARCH; 50339000 C 0034 + IF FOUND THEN 50340000 C 0064 + BEGIN 50341000 C 0065 + VARIABLE; 50342000 C 0065 + IF CURTYPE>0 THEN IF TYPETAB1[CURTYPE].FORM=POINTERS THEN 50343000 C 0066 + BEGIN 50344000 C 0068 + WRITEEXPR; GEN(",",1,7); 50345000 C 0069 + T1:=TYPETAB1[CURTYPE].POINTTYPE; 50346000 C 0155 + T1:=TYPETAB1[T1].SIZE; 50347000 C 0156 + IF T1>1023 THEN ERROR(86); 50348000 C 0158 + GENINT(T1); GEN(")",1,7); 50349000 C 0160 + END ELSE ERROR(81); 50350000 C 0210 + END ELSE BEGIN ERROR(1); INSYMBOL END; 50351000 C 0212 + END ELSE ERROR(9); 50352000 C 0213 + WHILE CURSY=COMMA DO 50353000 C 0215 + BEGIN INSYMBOL; 50354000 C 0216 + IF CURSY NEQ IDENTIFIER THEN ERROR(9); 50355000 C 0216 + IF CURSY NEQ RPAR THEN INSYMBOL; 50356000 C 0218 + END; 50357000 C 0220 + END ELSE BEGIN ERROR(58); SKIP(RPAR) END; 50358000 C 0221 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50359000 C 0223 + IF CURSY=RPAR THEN INSYMBOL; 50360000 C 0225 + END OF NEWDISP; 50361000 C 0227 + 25 IS 230 LONG, NEXT SEG 2 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 60001000 C 0369 + % % 60002000 C 0369 + % % 60003000 C 0369 + % % 60004000 C 0369 + % PART 6: THE STATEMENT PARSER. % 60005000 C 0369 + % --------------------- % 60006000 C 0369 + % % 60007000 C 0369 + % % 60008000 C 0369 + % % 60009000 C 0369 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 60010000 C 0369 + 60011000 C 0369 + 60012000 C 0369 + 60013000 C 0369 + PROCEDURE STATEMENT; FORWARD; 60014000 C 0369 + 60015000 C 0369 + PROCEDURE ASSIGNMENT; 60016000 C 0369 + BEGIN 60017000 C 0369 + INTEGER LEFTTYPE; 60018000 C 0369 + START OF SEGMENT ********** 26 + LABEL ASSIGN,EXIT; 60019000 C 0000 + IF FOUND THEN 60050000 C 0000 + BEGIN 60051000 C 0000 + IF THISID.IDCLASS=VAR OR 60052000 C 0000 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 60053000 C 0002 + BEGIN 60054000 C 0004 + VARIABLE; LEFTTYPE:=CURTYPE; 60055000 C 0005 + ASSIGN: IF CURSY≠ASSIGNSY THEN 60056000 C 0006 + BEGIN ERROR(28); SKIP(ASSIGNSY); 60057000 C 0007 + IF SYMKIND[CURSY]=TERMINAL THEN GO TO EXIT; 60058000 C 0009 + END; 60059000 C 0011 + INSYMBOL; 60060000 C 0011 + IF TYPETAB1[LEFTTYPE].STRUCT>0 THEN 60061000 C 0011 + BEGIN 60062000 C 0013 + ERROR(95); 60063000 C 0013 + END ELSE 60080000 C 0014 + BEGIN 60081000 C 0014 + WRITEEXPR; GEN(":=",2,6); 60082000 C 0015 + IF CHECKOPTION AND TYPETAB1[LEFTTYPE].FORM≤CHAR THEN 60083000 C 0101 + CHECKEXPR(TYPETAB2[LEFTTYPE],TYPETAB3[LEFTTYPE]) ELSE 60084000 C 0103 + EXPRESSION; 60085000 C 0181 + WRITEEXPR; 60086000 C 0182 + CHECKTYPES(LEFTTYPE,CURTYPE); 60087000 C 0259 + END; 60088000 C 0318 + END ELSE 60089000 C 0318 + BEGIN % FUNCTION ASSIGNMENT. 60090000 C 0318 + IF THISLEVEL≠CURLEVEL-1 OR THISINDEX≠CURFUNC THEN ERROR(5); 60091000 C 0319 + GENID("V",1000×THISLEVEL+THISINDEX,5); LEFTTYPE:=THISID.TYPE; 60092000 C 0322 + INSYMBOL; GO TO ASSIGN; 60093000 C 0336 + END; 60094000 C 0337 + END ELSE 60095000 C 0337 + BEGIN 60096000 C 0337 + SKIP(ASSIGNSY); 60097000 C 0339 + IF CURSY=ASSIGNSY THEN GO TO ASSIGN; 60098000 C 0339 + END; 60099000 C 0341 + EXIT: 60100000 C 0341 + END OF ASSIGNMENT; 60101000 C 0341 + 26 IS 348 LONG, NEXT SEG 2 + 60102000 C 0369 + 60103000 C 0369 + PROCEDURE COMPSTAT; 60104000 C 0369 + BEGIN 60105000 C 0369 + INTEGER BEGINNUM; 60106000 C 0369 + START OF SEGMENT ********** 27 + LABEL STATM; 60107000 C 0000 + 60108000 C 0000 + BEGINNUM:=NUMBEGINS:=NUMBEGINS+1; MARGIN(" B",BEGINNUM); 60109000 C 0000 + GEN("BEGIN",6,3); 60110000 C 0019 + DO BEGIN 60111000 C 0028 + IF CURSY=SEMICOLON OR CURSY=BEGINSY THEN INSYMBOL; 60112000 C 0029 + STATM: STATEMENT; 60113000 C 0031 + GEN(";",1,7); 60114000 C 0032 + IF CURSY=ELSESY THEN BEGIN ERROR(20); INSYMBOL; GO STATM END; 60115000 C 0041 + IF SYMKIND[CURSY]=INITIAL THEN BEGIN ERROR(21); GO STATM END; 60116000 C 0047 + END UNTIL CURSY≠SEMICOLON; 60117000 C 0049 + IF CURSY≠ENDSY THEN 60118000 C 0051 + BEGIN ERROR(24); SKIP(ENDSY); 60119000 C 0051 + IF CURSY≠ENDSY THEN BEGIN INSYMBOL; GO TO STATM END; 60120000 C 0053 + END; 60121000 C 0056 + GEN(" END",5,4); MARGIN(" E",BEGINNUM); 60122000 C 0056 + INSYMBOL; 60123000 C 0082 + END OF COMPSTAT; 60124000 C 0083 + 27 IS 88 LONG, NEXT SEG 2 + 60125000 C 0369 + 60126000 C 0369 + PROCEDURE IFSTAT; 60127000 C 0369 + BEGIN 60128000 C 0369 + LABEL EXIT; 60129000 C 0369 + START OF SEGMENT ********** 28 + GEN("IF",3,6); 60130000 C 0000 + INSYMBOL; BOOLEXPR; 60131000 C 0009 + IF CURSY≠THENSY THEN 60132000 C 0111 + BEGIN IF CURTYPE>0 THEN ERROR(27); 60133000 C 0111 + SKIP(THENSY); 60134000 C 0114 + IF CURSY≠THENSY THEN 60135000 C 0115 + BEGIN IF CURTYPE=0 THEN ERROR(27); 60136000 C 0115 + IF SYMKIND[CURSY]=TERMINAL THEN GO TO EXIT; 60137000 C 0118 + END; END; 60138000 C 0119 + GEN(" THEN",6,3); 60139000 C 0119 + INSYMBOL; STATEMENT; 60140000 C 0128 + IF CURSY=ELSESY THEN 60141000 C 0129 + BEGIN GEN(" ELSE",6,3); INSYMBOL; STATEMENT END; 60142000 C 0130 + EXIT: 60143000 C 0141 + END OF IFSTAT; 60144000 C 0141 + 28 IS 144 LONG, NEXT SEG 2 + 60145000 C 0369 + 60146000 C 0369 + PROCEDURE CASESTAT; 60147000 C 0369 + BEGIN 60148000 C 0369 + DEFINE CASEHASH(N)=(N).[38:39] MOD MAXCASES#; 60149000 C 0369 + START OF SEGMENT ********** 29 + INTEGER ARRAY CASETAB[0:MAXCASES]; 60150000 C 0000 + INTEGER CASENUM,CASETYPE,NCASELABS,TEMPVARNUM,CONVAL,CONTYPE,C,T; 60151000 C 0001 + BOOLEAN ZEROLAB,FIRST; 60152000 C 0001 + 60153000 C 0001 + CASENUM:=NUMCASES:=NUMCASES+1; MARGIN("CB",CASENUM); 60154000 C 0001 + TEMPVARNUM:=NUMTEMPS:=NUMTEMPS+1; 60155000 C 0021 + IF TEMPVARNUM>MAXTEMPS THEN ERROR(16); 60156000 C 0023 + GEN("BEGIN",6,3); GENID("T",TEMPVARNUM,2); GEN(":=",2,6); 60157000 C 0025 + INSYMBOL; EXPRESSION; 60158000 C 0054 + GEN(";",1,7); CASETYPE:=CURTYPE; 60159000 C 0055 + IF TYPETAB1[CASETYPE].FORM≥FLOATING THEN 60160000 C 0065 + BEGIN ERROR(17); CASETYPE:=0 END; 60161000 C 0066 + IF CURSY≠OFSY THEN 60162000 C 0068 + BEGIN IF CASETYPE>0 THEN ERROR(18); 60163000 C 0069 + SKIP(OFSY); 60164000 C 0072 + IF CURSY=OFSY THEN INSYMBOL ELSE 60165000 C 0072 + IF CASETYPE=0 THEN ERROR(18); 60166000 C 0074 + END ELSE INSYMBOL; 60167000 C 0079 + DO BEGIN 60168000 C 0080 + WHILE CURSY=SEMICOLON DO INSYMBOL; 60169000 C 0080 + FIRST:=TRUE; 60170000 C 0082 + IF CURSY≠ENDSY THEN 60171000 C 0083 + BEGIN 60172000 C 0083 + GEN("IF",3,6); 60173000 C 0084 + DO BEGIN 60174000 C 0093 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 60175000 C 0094 + CONSTANT(CONVAL,CONTYPE); 60176000 C 0097 + IF CONTYPE>0 THEN 60177000 C 0185 + BEGIN 60178000 C 0185 + IF CASETYPE=0 THEN CASETYPE:=CONTYPE ELSE 60179000 C 0186 + CHECKTYPES(CASETYPE,CONTYPE); 60180000 C 0188 + GENID("T",TEMPVARNUM,2); GEN("=",1,7); GENINT(CONVAL); 60181000 C 0248 + NCASELABS:=NCASELABS+1; 60182000 C 0310 + IF NCASELABS0 THEN ERROR(19); 60219000 C 0111 + SKIP(DOSY); 60220000 C 0114 + IF CURSY≠DOSY THEN 60221000 C 0115 + BEGIN IF CURTYPE=0 THEN ERROR(19); 60222000 C 0115 + GO TO IF SYMKIND[CURSY]=INITIAL THEN STATM ELSE EXIT; 60223000 C 0118 + END; END; 60224000 C 0123 + GEN(" DO",4,5); 60225000 C 0123 + INSYMBOL; 60226000 C 0132 + STATM: STATEMENT; 60227000 C 0133 + EXIT: 60228000 C 0133 + END OF WHILESTAT; 60229000 C 0134 + 30 IS 140 LONG, NEXT SEG 2 + 60230000 C 0369 + 60231000 C 0369 + PROCEDURE REPEATSTAT; 60232000 C 0369 + BEGIN 60233000 C 0369 + INTEGER REPNUM; 60234000 C 0369 + START OF SEGMENT ********** 31 + LABEL NEWTRY; 60235000 C 0000 + 60236000 C 0000 + REPNUM:=NUMREPS:=NUMREPS+1; 60237000 C 0000 + MARGIN(" R",REPNUM); 60238000 C 0001 + GEN("DO",3,6); GEN("BEGIN",6,3); 60239000 C 0019 + DO BEGIN 60240000 C 0037 + INSYMBOL; 60241000 C 0038 + NEWTRY: STATEMENT; 60242000 C 0038 + GEN(";",1,7); 60243000 C 0039 + IF CURSY=ELSESY THEN BEGIN ERROR(20);INSYMBOL; GO NEWTRY END; 60244000 C 0048 + IF SYMKIND[CURSY]=INITIAL THEN BEGIN ERROR(21); GO NEWTRY END; 60245000 C 0055 + END UNTIL CURSY≠SEMICOLON; 60246000 C 0057 + IF CURSY≠UNTILSY THEN 60247000 C 0059 + BEGIN 60248000 C 0059 + ERROR(22); 60249000 C 0060 + WHILE CURSY≠UNTILSY AND SYMKIND[CURSY]≠INITIAL DO 60250000 C 0061 + BEGIN INSYMBOL; SKIP(UNTILSY) END; 60251000 C 0063 + IF CURSY≠UNTILSY THEN GO TO NEWTRY; 60252000 C 0065 + END; 60253000 C 0066 + GEN(" END",5,4); GEN("UNTIL",6,3); MARGIN(" U",REPNUM); 60254000 C 0066 + INSYMBOL; BOOLEXPR; 60255000 C 0102 + END OF REPEATSTAT; 60256000 C 0206 + 31 IS 209 LONG, NEXT SEG 2 + 60257000 C 0369 + 60258000 C 0369 + PROCEDURE FORSTAT; 60259000 C 0369 + BEGIN 60260000 C 0369 + INTEGER VARTYPE,VARNUM,LLIM,ULIM; 60261000 C 0369 + START OF SEGMENT ********** 32 + BOOLEAN DOWN; 60262000 C 0000 + LABEL STATM; 60263000 C 0000 + 60264000 C 0000 + GEN("BEGIN",6,3); 60265000 C 0000 + INSYMBOL; 60266000 C 0009 + IF CURSY=IDENTIFIER THEN 60267000 C 0009 + BEGIN 60268000 C 0010 + SEARCH; 60269000 C 0010 + IF FOUND THEN 60270000 C 0040 + BEGIN 60271000 C 0041 + VARNUM:=1000×THISLEVEL+THISINDEX; 60272000 C 0041 + IF THISID.IDCLASS=VAR OR 60273000 C 0043 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 60274000 C 0044 + BEGIN 60275000 C 0047 + IF THISLEVEL>1 AND THISLEVELCURLEVEL THEN ERROR(83); 60277000 C 0050 + VARTYPE:=THISID.TYPE; 60278000 C 0052 + IF TYPETAB1[VARTYPE].FORM≤CHAR THEN 60279000 C 0053 + BEGIN 60280000 C 0055 + LLIM:=TYPETAB2[VARTYPE]; ULIM:=TYPETAB3[VARTYPE]; 60281000 C 0055 + END ELSE BEGIN ERROR(12); VARTYPE:=0 END; 60282000 C 0057 + END ELSE ERROR(8); 60283000 C 0059 + END ELSE ERROR(1); 60284000 C 0061 + END ELSE ERROR(9); 60285000 C 0062 + INSYMBOL; 60286000 C 0063 + IF CURSY≠ASSIGNSY THEN 60287000 C 0064 + BEGIN ERROR(28); 60288000 C 0064 + SKIP(ASSIGNSY); 60289000 C 0066 + IF CURSY=ASSIGNSY THEN INSYMBOL ELSE 60290000 C 0066 + IF SYMKIND[CURSY]=INITIAL THEN GO TO STATM; 60291000 C 0068 + END ELSE INSYMBOL; 60292000 C 0070 + GENID("V",VARNUM,5); GEN("←",1,7); 60293000 C 0071 + IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 60294000 C 0092 + WRITEEXPR; 60295000 C 0169 + GEN(";",1,7); 60296000 C 0246 + IF VARTYPE=0 THEN VARTYPE:=CURTYPE ELSE CHECKTYPES(VARTYPE,CURTYPE); 60297000 C 0255 + NUMTEMPS:=NUMTEMPS+1; IF NUMTEMPS>MAXTEMPS THEN ERROR(16); 60298000 C 0317 + IF CURSY=TOSY THEN INSYMBOL ELSE 60299000 C 0320 + IF CURSY=DOWNTOSY THEN BEGIN DOWN:=TRUE; INSYMBOL END ELSE 60300000 C 0322 + BEGIN IF CURTYPE>0 THEN ERROR(23); 60301000 C 0325 + SKIP(TOSY); 60302000 C 0327 + IF CURSY=TOSY THEN INSYMBOL ELSE 60303000 C 0328 + BEGIN IF CURTYPE=0 THEN ERROR(23); 60304000 C 0330 + IF SYMKIND[CURSY]=INITIAL THEN GO TO STATM; 60305000 C 0332 + END; END; 60306000 C 0334 + GENID("T",NUMTEMPS,2); GEN("←",1,7); 60307000 C 0334 + IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 60308000 C 0354 + WRITEEXPR; 60309000 C 0432 + GEN(";",1,7); 60310000 C 0509 + IF VARTYPE=0 THEN VARTYPE:=CURTYPE ELSE CHECKTYPES(VARTYPE,CURTYPE); 60311000 C 0518 + IF CURSY≠DOSY THEN 60312000 C 0580 + BEGIN IF CURTYPE>0 THEN ERROR(19); 60313000 C 0580 + SKIP(DOSY); 60314000 C 0583 + IF CURSY=DOSY THEN INSYMBOL ELSE 60315000 C 0584 + IF CURTYPE=0 THEN ERROR(19); 60316000 C 0585 + END ELSE INSYMBOL; 60317000 C 0588 + GEN("FOR",4,5); GENID("V",VARNUM,5); GEN("←",1,7); 60318000 C 0589 + GENID("V",VARNUM,5); GEN(" ",1,7); 60319000 C 0618 + IF DOWN THEN GEN("DOWNTO",7,2) ELSE GEN("UPTO",5,4); 60320000 C 0639 + GENID("T",NUMTEMPS,2); GEN(" DO",4,5); 60321000 C 0661 + STATM: STATEMENT; 60322000 C 0681 + GEN(" END",5,4); 60323000 C 0682 + NUMTEMPS:=NUMTEMPS-1; 60324000 C 0691 + END OF FORSTAT; 60325000 C 0692 + 32 IS 699 LONG, NEXT SEG 2 + 60326000 C 0369 + 60327000 C 0369 + PROCEDURE GOTOSTAT; 60328000 C 0369 + BEGIN 60329000 C 0369 + INTEGER I; 60330000 C 0369 + START OF SEGMENT ********** 33 + INSYMBOL; 60331000 C 0000 + IF CURSY=INTCONST THEN 60332000 C 0000 + BEGIN I:=NUMLABS; 60333000 C 0001 + WHILE I≥1 AND LABTAB[I].LABVAL≠CURVAL DO I:=I-1; 60334000 C 0002 + IF I=0 THEN ERROR(15); 60335000 C 0007 + GEN("GO",3,6); GENID("L",CURVAL,4); 60336000 C 0009 + INSYMBOL; 60337000 C 0030 + END ELSE ERROR(10); 60338000 C 0030 + END OF GOTOSTAT; 60339000 C 0033 + 33 IS 36 LONG, NEXT SEG 2 + 60340000 C 0369 + 60341000 C 0369 + PROCEDURE WITHSTAT; 60342000 C 0369 + BEGIN 60343000 C 0369 + INTEGER STARTLEVEL,VERYFIRSTWITHSYM,I; 60344000 C 0369 + START OF SEGMENT ********** 34 + REAL D; 60345000 C 0000 + STARTLEVEL:=TOPLEVEL; VERYFIRSTWITHSYM:=NWITHSYMS; 60346000 C 0000 + DO BEGIN 60347000 C 0001 + INSYMBOL; 60348000 C 0002 + IF CURSY=IDENTIFIER THEN 60349000 C 0002 + BEGIN 60350000 C 0003 + SEARCH; 60351000 C 0003 + IF FOUND THEN 60352000 C 0032 + BEGIN 60353000 C 0032 + IF THISID.IDCLASS=VAR THEN 60354000 C 0032 + BEGIN 60355000 C 0034 + VARIABLE; 60356000 C 0034 + IF CURTYPE>0 THEN 60357000 C 0035 + IF TYPETAB1[CURTYPE].FORM≠RECORD THEN ERROR(98); 60358000 C 0035 + IF SIMPLEVARIABLE THEN 60359000 C 0039 + BEGIN PUTSYM("["); INSIDEBRACKETS:=TRUE END; 60360000 C 0039 + IF TOPLEVELMAXWITHSYMS THEN ERROR(63) ELSE 60369000 C 0060 + FOR I:=1 STEP 1 UNTIL NUMSYMS DO 60370000 C 0062 + BEGIN 60371000 C 0064 + WITHTAB[NWITHSYMS]:=SYMTAB[I]; 60372000 C 0064 + NWITHSYMS:=NWITHSYMS+1; 60373000 C 0065 + END; 60374000 C 0066 + D.LASTWITHSYM:=NWITHSYMS-1; 60375000 C 0069 + DISPLAY[TOPLEVEL]:=D; 60376000 C 0071 + END ELSE ERROR(84); 60377000 C 0072 + END ELSE BEGIN ERROR(8); INSYMBOL END; 60378000 C 0073 + END ELSE BEGIN ERROR(1); INSYMBOL END; 60379000 C 0075 + END ELSE BEGIN ERROR(9); INSYMBOL END; 60380000 C 0077 + NUMSYMS:=0; 60381000 C 0079 + NUMPOINTERS := 0; 60382000 C 0079 + END UNTIL CURSY≠COMMA; 60383000 C 0080 + IF CURSY≠DOSY THEN 60384000 C 0081 + BEGIN ERROR(19); SKIP(DOSY); 60385000 C 0082 + IF CURSY=DOSY THEN INSYMBOL; 60386000 C 0084 + END ELSE INSYMBOL; 60387000 C 0086 + STATEMENT; 60388000 C 0087 + TOPLEVEL:=STARTLEVEL; NWITHSYMS:=VERYFIRSTWITHSYM; 60389000 C 0087 + END OF WITHSTAT; 60390000 C 0089 + 34 IS 93 LONG, NEXT SEG 2 + 60391000 C 0369 + 60392000 C 0369 + PROCEDURE STATEMENT; 60393000 C 0369 + BEGIN 60394000 C 0369 + INTEGER I; 60395000 C 0369 + START OF SEGMENT ********** 35 + LABEL LABFOUND; 60396000 C 0000 + 60397000 C 0000 + IF CURSY=INTCONST THEN % *** LABELED STATEMENT *** 60398000 C 0000 + BEGIN 60399000 C 0000 + FOR I:=FIRSTLAB STEP 1 UNTIL NUMLABS DO 60400000 C 0001 + IF LABTAB[I].LABVAL=CURVAL THEN 60401000 C 0002 + BEGIN IF LABTAB[I].LABDEF=1 THEN ERROR(31); 60402000 C 0003 + LABTAB[I].LABDEF:=1; 60403000 C 0006 + GO TO LABFOUND; 60404000 C 0009 + END; 60405000 C 0009 + ERROR(15); 60406000 C 0012 + LABFOUND: GENID("L",CURVAL,4); GEN(":",1,7); 60407000 C 0012 + INSYMBOL; 60408000 C 0033 + IF CURSY≠COLON THEN 60409000 C 0034 + BEGIN ERROR(26); 60410000 C 0034 + SKIP(COLON); IF CURSY=COLON THEN INSYMBOL; 60411000 C 0036 + END ELSE INSYMBOL; 60412000 C 0038 + END; 60413000 C 0039 + 60414000 C 0039 + COMMENT *** START OF STATEMENT *** ; 60415000 C 0039 + 60416000 C 0039 + IF CURSY=IDENTIFIER THEN 60417000 C 0039 + BEGIN 60418000 C 0040 + SEARCH; 60419000 C 0040 + IF FOUND THEN 60420000 C 0069 + BEGIN 60421000 C 0069 + IF THISID.IDCLASS=VAR OR 60422000 C 0069 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) OR 60423000 C 0071 + THISID.IDCLASS=FUNC THEN ASSIGNMENT ELSE 60424000 C 0073 + IF THISID.IDCLASS=PROC THEN 60425000 C 0076 + BEGIN 60426000 C 0077 + IF THISLEVEL=0 THEN % *** INTRINSIC PROCEDURE *** 60427000 C 0078 + BEGIN 60428000 C 0079 + IF CURNAME1="50WRITE" THEN PWRITE(FALSE) ELSE 60429000 C 0079 + IF CURNAME1="7WRITEL" AND 60430000 C 0081 + CURNAME2="000000N" THEN PWRITE(TRUE) ELSE 60431000 C 0083 + IF CURNAME1="400READ" THEN PREAD(FALSE) ELSE 60432000 C 0086 + IF CURNAME1="6READLN" THEN PREAD(TRUE) ELSE 60433000 C 0090 + IF CURNAME1="400PAGE" THEN FILEHANDLING(5) ELSE 60434000 C 0094 + IF CURNAME1="3000GET" THEN FILEHANDLING(2) ELSE 60435000 C 0098 + IF CURNAME1="3000PUT" THEN FILEHANDLING(1) ELSE 60436000 C 0102 + IF CURNAME1="50RESET" THEN FILEHANDLING(3) ELSE 60437000 C 0106 + IF CURNAME1="7REWRIT" AND 60438000 C 0110 + CURNAME2="000000E" THEN FILEHANDLING(4) ELSE 60439000 C 0112 + IF CURNAME1="3000NEW" THEN NEWDISP ELSE 60440000 C 0115 + IF CURNAME1="7DISPOS" AND 60441000 C 0118 + CURNAME2="000000E" THEN NEWDISP ELSE 60442000 C 0121 + IF CURNAME1="400PACK" THEN PACK ELSE 60443000 C 0123 + IF CURNAME1="6UNPACK" THEN UNPACK ELSE ERROR(0); 60444000 C 0127 + END ELSE PASSPARAMS; 60445000 C 0134 + WRITEEXPR; 60446000 C 0135 + END ELSE BEGIN ERROR(13); SKIP(99) END; 60447000 C 0213 + END ELSE BEGIN ERROR(1); ASSIGNMENT END; 60448000 C 0215 + END OF IDENTIFIER ELSE 60449000 C 0216 + IF CURSY=BEGINSY THEN COMPSTAT ELSE 60450000 C 0216 + IF CURSY=IFSY THEN IFSTAT ELSE 60451000 C 0219 + IF CURSY=CASESY THEN CASESTAT ELSE 60452000 C 0221 + IF CURSY=WHILESY THEN WHILESTAT ELSE 60453000 C 0223 + IF CURSY=REPEATSY THEN REPEATSTAT ELSE 60454000 C 0225 + IF CURSY=FORSY THEN FORSTAT ELSE 60455000 C 0228 + IF CURSY=WITHSY THEN WITHSTAT ELSE 60456000 C 0230 + IF CURSY=GOTOSY THEN GOTOSTAT ELSE 60457000 C 0232 + IF SYMKIND[CURSY]≠TERMINAL THEN 60458000 C 0234 + BEGIN ERROR(13); INSYMBOL; SKIP(SEMICOLON) END; 60459000 C 0236 + END OF STATEMENT; 60460000 C 0238 + 35 IS 241 LONG, NEXT SEG 2 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 70001000 C 0369 + % % 70002000 C 0369 + % % 70003000 C 0369 + % % 70004000 C 0369 + % PART 7: TYPE DECLARATIONS. % 70005000 C 0369 + % ------------------ % 70006000 C 0369 + % % 70007000 C 0369 + % % 70008000 C 0369 + % % 70009000 C 0369 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 70010000 C 0369 + 70011000 C 0369 + 70012000 C 0369 + REAL VALX1,VALX2; 70013000 C 0369 + INTEGER TYPEX1,TYPEX2; 70014000 C 0369 + BOOLEAN PACKED; 70015000 C 0369 + 70016000 C 0369 + PROCEDURE FIELDLIST(RECTAB,FIRSTADDR,LASTADDR); 70017000 C 0369 + VALUE RECTAB,FIRSTADDR; 70018000 C 0369 + INTEGER RECTAB,FIRSTADDR,LASTADDR; 70019000 C 0369 + FORWARD; 70020000 C 0369 + 70021000 C 0369 + DEFINE SUBRANGE= %*** SUBRANGE DECLARATION*** 70022000 C 0369 + BEGIN %*************************** 70023000 C 0369 + CONSTANT(VALX1,TYPEX1); 70024000 C 0369 + IF TYPETAB1[TYPEX1].FORM>CHAR THEN ERROR(11); 70025000 C 0369 + IF CURSY≠DOUBLEDOT THEN ERROR(53); 70026000 C 0369 + INSYMBOL; 70027000 C 0369 + CONSTANT(VALX2,TYPEX2); 70028000 C 0369 + IF TYPEX1>0 AND TYPEX2>0 THEN 70029000 C 0369 + IF TYPEX1≠TYPEX2 THEN ERROR(11) ELSE 70030000 C 0369 + IF VALX1>VALX2 THEN ERROR(54); 70031000 C 0369 + T1:=TYPETAB1[TYPEX1].FORM; IF T1=SYMBOLIC THEN T1:=SUBTYPE; 70032000 C 0369 + NEWTYPE; TTYPE:=TYPEINDEX; 70033000 C 0369 + T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; T1.MAINTYPE:=TYPEX1; 70034000 C 0369 + TYPETAB1[TYPEINDEX]:=T1; 70035000 C 0369 + TYPETAB2[TYPEINDEX]:=VALX1; TYPETAB3[TYPEINDEX]:=VALX2; 70036000 C 0369 + END OF SUBRANGE#; 70037000 C 0369 + 70038000 C 0369 + 70039000 C 0369 + PROCEDURE TYPEDECL(TTYPE,TSIZE); 70040000 C 0369 + INTEGER TTYPE,TSIZE; 70041000 C 0369 + BEGIN 70042000 C 0369 + PROCEDURE TYPERR(ERRNUM,TTYPE,TSIZE); 70043000 C 0369 + START OF SEGMENT ********** 36 + VALUE ERRNUM; 70044000 C 0000 + INTEGER ERRNUM,TTYPE,TSIZE; 70045000 C 0000 + BEGIN ERROR(ERRNUM); 70046000 C 0000 + TTYPE:=TSIZE:=0; 70047000 C 0000 + END; 70048000 C 0002 + 70049000 C 0002 + INTEGER RECINX,ARRSTRUCT,TX,SX,T1,T2,T3,T,N; 70050000 C 0002 + BOOLEAN FIRST; 70051000 C 0002 + 70052000 C 0002 + PACKED:=FALSE; 70080000 C 0002 + IF CURSY=IDENTIFIER THEN %*** SIMPLE TYPE DECLARATION *** 70081000 C 0003 + BEGIN %******************************* 70082000 C 0004 + SEARCH; 70083000 C 0005 + IF FOUND THEN 70084000 C 0034 + BEGIN 70085000 C 0034 + IF THISID.IDCLASS=TYPES THEN 70086000 C 0034 + BEGIN 70087000 C 0036 + TTYPE:=THISID.TYPE; TSIZE:=TYPETAB1[TTYPE].SIZE; 70088000 C 0036 + INSYMBOL; 70089000 C 0039 + END ELSE IF THISID.IDCLASS=CONST THEN SUBRANGE 70090000 C 0040 + ELSE TYPERR(7,TTYPE,TSIZE); 70091000 C 0249 + END ELSE BEGIN TYPERR(1,TTYPE,TSIZE); INSYMBOL END; 70092000 C 0251 + END ELSE 70093000 C 0255 + IF CURSY≤CHARCONST OR CURSY=PLUS OR CURSY=MINUS THEN SUBRANGE ELSE 70094000 C 0255 + IF CURSY=LPAR THEN 70095000 C 0466 + BEGIN 70096000 C 0467 + N:=0; 70097000 C 0467 + NEWTYPE; T3.IDCLASS:=CONST; T3.TYPE:=TYPEINDEX; 70098000 C 0468 + DO BEGIN 70099000 C 0477 + INSYMBOL; 70100000 C 0477 + IF CURSY=IDENTIFIER THEN 70101000 C 0477 + BEGIN 70102000 C 0478 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); 70103000 C 0478 + T3.INFO:=N; NAMETAB3[CURLEVEL,THISINDEX]:=T3; 70104000 C 0501 + N:=N+1; INSYMBOL; 70105000 C 0505 + END ELSE ERROR(9); 70106000 C 0507 + END UNTIL CURSY≠COMMA; 70107000 C 0508 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 70108000 C 0509 + T1:=SYMBOLIC; T1.STRUCT:=0; 70109000 C 0512 + T1.SIZE:=TSIZE:=1; TTYPE:=TYPEINDEX; 70110000 C 0514 + TYPETAB1[TYPEINDEX]:=T1; 70111000 C 0518 + TYPETAB2[TYPEINDEX]:=0; TYPETAB3[TYPEINDEX]:=N-1; 70112000 C 0519 + IF CURSY=RPAR THEN INSYMBOL; 70113000 C 0522 + END ELSE 70114000 C 0524 + 70115000 C 0524 + IF CURSY=ARROW THEN %*** POINTER DECLARATION *** 70116000 C 0524 + BEGIN %*************************** 70117000 C 0525 + INSYMBOL; 70118000 C 0526 + IF CURSY=IDENTIFIER THEN 70119000 C 0526 + BEGIN 70120000 C 0527 + NEWTYPE; TTYPE:=TYPEINDEX; T1:=POINTERS; 70121000 C 0527 + T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; 70122000 C 0534 + TYPETAB1[TYPEINDEX]:=T1; 70123000 C 0538 + SEARCH; 70124000 C 0540 + IF FOUND THEN 70125000 C 0569 + BEGIN 70126000 C 0569 + IF THISID.IDCLASS=TYPES THEN 70127000 C 0569 + TYPETAB1[TYPEINDEX].POINTTYPE:=THISID.TYPE ELSE 70128000 C 0571 + TYPERR(7,TTYPE,TSIZE); 70129000 C 0574 + END ELSE 70130000 C 0577 + BEGIN 70131000 C 0577 + IF NUMPNTRS0 THEN 70150000 C 0601 + BEGIN 70151000 C 0602 + IF TYPETAB1[TX].FORM>CHAR THEN ERROR(48); 70152000 C 0602 + T1:=ARRAYS; T1.INXTYPE:=TX; T1.ARRTYPE:=T; 70153000 C 0605 + T2:=TYPETAB2[TX]; T3:=TYPETAB3[TX]; 70154000 C 0609 + IF T3-T2>1022 THEN ERROR(61); 70155000 C 0611 + T1.SIZE:=MIN(1023,T3-T2+1); 70156000 C 0614 + NEWTYPE; 70157000 C 0619 + TYPETAB1[TYPEINDEX]:=T1; 70158000 C 0624 + TYPETAB2[TYPEINDEX]:=T2; TYPETAB3[TYPEINDEX]:=T3; 70159000 C 0625 + T:=TYPEINDEX; 70160000 C 0628 + END; 70161000 C 0628 + END UNTIL CURSY≠COMMA; 70162000 C 0628 + IF CURSY≠RBRACKET THEN ERROR(59) ELSE INSYMBOL; 70163000 C 0630 + IF CURSY≠OFSY THEN BEGIN ERROR(18); SKIP(OFSY) END; 70164000 C 0633 + INSYMBOL; 70165000 C 0635 + TYPEDECL(TX,SX); 70166000 C 0636 + IF TYPETAB1[TX].FORM≥FILES THEN ERROR(60); 70167000 C 0637 + ARRSTRUCT:=TYPETAB1[TX].STRUCT; 70168000 C 0640 + WHILE T>0 DO 70169000 C 0641 + BEGIN 70170000 C 0643 + T1:=TYPETAB1[T]; T3:=T1.ARRTYPE; 70171000 C 0643 + T1.ARRTYPE:=TX; T1.STRUCT:=ARRSTRUCT:=ARRSTRUCT+1; 70172000 C 0645 + T1.SIZE:=SX:=MIN(1024,SX×T1.SIZE); 70173000 C 0650 + TYPETAB1[T]:=T1; TX:=T; T:=T3; 70174000 C 0655 + END; 70175000 C 0658 + TTYPE:=TX; TSIZE:=SX; 70176000 C 0660 + END OF ARRAY DECLARATION ELSE 70177000 C 0662 + 70178000 C 0662 + IF CURSY=FILESY THEN %*** FILE DECLARATION *** 70179000 C 0662 + BEGIN %************************ 70180000 C 0663 + INSYMBOL; 70181000 C 0663 + IF CURSY≠OFSY THEN 70182000 C 0664 + BEGIN ERROR(18); 70183000 C 0665 + IF CURSY≠IDENTIFIER THEN INSYMBOL; 70184000 C 0666 + END ELSE INSYMBOL; 70185000 C 0668 + TYPEDECL(TX,SX); 70186000 C 0669 + IF TX>0 THEN 70187000 C 0670 + BEGIN T:=TYPETAB1[TX]; 70188000 C 0670 + IF T.FORM≥FILES THEN ERROR(50) ELSE 70189000 C 0672 + IF T.STRUCT>1 THEN ERROR(49) 70190000 C 0674 + END; 70191000 C 0677 + NEWTYPE; TTYPE:=TYPEINDEX; 70192000 C 0677 + T1:=IF T.FORM=CHAR THEN TEXTFILE ELSE FILES; 70193000 C 0683 + T1.SIZE:=TSIZE:=SX; T1.FILETYPE:=TX; 70194000 C 0687 + T1.STRUCT:=1; 70195000 C 0691 + TYPETAB1[TYPEINDEX]:=T1; 70196000 C 0693 + END OF FILE DECLARATION ELSE 70197000 C 0694 + 70198000 C 0694 + IF CURSY=SETSY THEN %*** SET DECLARATION *** 70199000 C 0694 + BEGIN %*********************** 70200000 C 0695 + INSYMBOL; 70201000 C 0696 + IF CURSY≠OFSY THEN 70202000 C 0696 + BEGIN ERROR(18); 70203000 C 0697 + IF CURSY>CHARCONST THEN INSYMBOL; 70204000 C 0698 + END ELSE INSYMBOL; 70205000 C 0700 + TYPEDECL(TX,SX); 70206000 C 0701 + IF TX>0 THEN 70207000 C 0702 + BEGIN 70208000 C 0703 + IF TYPETAB1[TX].FORM>CHAR THEN ERROR(48) ELSE 70209000 C 0703 + IF TYPETAB2[TX]<0 OR TYPETAB3[TX]>38 THEN ERROR(51); 70210000 C 0706 + END; 70211000 C 0710 + NEWTYPE; TTYPE:=TYPEINDEX; 70212000 C 0710 + T1:=SET; T1.SETTYPE:=TX; T1.STRUCT:=0; 70213000 C 0716 + T1.SIZE:=TSIZE:=1; TYPETAB1[TYPEINDEX]:=T1; 70214000 C 0720 + TYPETAB2[TYPEINDEX]:=TYPETAB2[TX]; 70215000 C 0724 + TYPETAB3[TYPEINDEX]:=TYPETAB3[TX]; 70216000 C 0725 + END OF SET DECLARATION ELSE 70217000 C 0727 + 70218000 C 0727 + IF CURSY=RECORDSY THEN %*** RECORD DECLARATION *** 70219000 C 0727 + BEGIN %************************** 70220000 C 0728 + IF LASTREC-1>CURLEVEL THEN LASTREC:=LASTREC-1 ELSE ERROR(55); 70221000 C 0729 + RECINX:=LASTREC; 70222000 C 0733 + BLOCKTAB[RECINX]:=NUMBLOCKS:=NUMBLOCKS+1; 70223000 C 0734 + INSYMBOL; 70224000 C 0736 + FIELDLIST(RECINX,0,SX); 70225000 C 0736 + IF SX>1022 THEN BEGIN ERROR(56); SX:=1022 END; 70226000 C 0738 + NEWTYPE; TTYPE:=TYPEINDEX; 70227000 C 0740 + T1:=RECORD; T1.RECTAB:=RECINX; T1.STRUCT:=1; 70228000 C 0746 + T1.SIZE:=TSIZE:=SX; TYPETAB1[TYPEINDEX]:=T1; 70229000 C 0751 + TYPETAB2[TYPEINDEX]:=0; TYPETAB3[TYPEINDEX]:=SX-1; 70230000 C 0754 + IF CURSY≠ENDSY THEN BEGIN ERROR(24); SKIP(ENDSY) END; 70231000 C 0757 + IF CURSY=ENDSY THEN INSYMBOL; 70232000 C 0760 + END ELSE BEGIN ERROR(4); SKIP(99) END; 70233000 C 0762 + END; 70234000 C 0764 + END OF TYPEDECL; 70235000 C 0764 + 36 IS 777 LONG, NEXT SEG 2 + 70236000 C 0369 + 70237000 C 0369 + PROCEDURE FIELDLIST(RECTAB,FIRSTADDR,LASTADDR); 70238000 C 0369 + VALUE RECTAB,FIRSTADDR; 70239000 C 0369 + INTEGER RECTAB,FIRSTADDR,LASTADDR; 70240000 C 0369 + BEGIN 70241000 C 0369 + INTEGER ARRAY ILIST[0:LISTLENGTH]; 70242000 C 0369 + START OF SEGMENT ********** 37 + INTEGER LISTINX; 70243000 C 0001 + INTEGER CASETYPE,ADDR,MAXADDR,INDEX,CTYPE,TX,SX,T1,T3,LLIM,ULIM,I; 70244000 C 0001 + BOOLEAN FIRST; 70245000 C 0001 + REAL CVAL; 70246000 C 0001 + LABEL CASETYPEID,CASEPART,EXIT; 70247000 C 0001 + 70248000 C 0001 + ADDR:=FIRSTADDR; 70249000 C 0001 + DO BEGIN 70250000 C 0002 + WHILE CURSY=SEMICOLON DO INSYMBOL; 70251000 C 0003 + IF CURSY=CASESY THEN GO TO CASEPART; 70252000 C 0005 + IF CURSY=IDENTIFIER THEN 70253000 C 0006 + BEGIN 70254000 C 0007 + LISTINX:=0; FIRST:=TRUE; 70255000 C 0007 + DO BEGIN 70256000 C 0009 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 70257000 C 0010 + IF CURSY=IDENTIFIER THEN 70258000 C 0012 + BEGIN 70259000 C 0013 + IF LISTINX≥LISTLENGTH THEN BEGIN ERROR(37); LISTINX:=0 END; 70260000 C 0013 + LISTINX:=LISTINX+1; 70261000 C 0016 + NEWNAME(CURNAME1,CURNAME2,RECTAB); 70262000 C 0017 + ILIST[LISTINX]:=THISINDEX; 70263000 C 0040 + INSYMBOL; 70264000 C 0041 + END ELSE 70265000 C 0042 + BEGIN ERROR(9); 70266000 C 0042 + IF CURSY≠COMMA THEN INSYMBOL; 70267000 C 0043 + END; 70268000 C 0045 + END UNTIL CURSY≠COMMA; 70269000 C 0045 + IF CURSY≠COLON THEN BEGIN ERROR(26); SKIP(COLON) END; 70270000 C 0046 + INSYMBOL; 70271000 C 0049 + TYPEDECL(TX,SX); 70272000 C 0049 + IF TX>0 THEN IF TYPETAB1[TX].FORM≥FILES THEN ERROR(57); 70273000 C 0050 + T3.IDCLASS:=VAR; T3.TYPE:=TX; 70274000 C 0054 + FOR I:=1 STEP 1 UNTIL LISTINX DO 70275000 C 0058 + BEGIN 70276000 C 0059 + T3.INFO:=ADDR; ADDR:=MIN(ADDR+SX,1024); 70277000 C 0059 + NAMETAB3[RECTAB,ILIST[I]]:=T3; 70278000 C 0064 + END; 70279000 C 0066 + END; 70280000 C 0068 + END UNTIL CURSY≠SEMICOLON; 70281000 C 0068 + LASTADDR:=ADDR; 70282000 C 0070 + GO TO EXIT; 70283000 C 0071 + 70284000 C 0073 + CASEPART: 70285000 C 0073 + LISTINX:=0; LASTADDR:=ADDR; INDEX:=-1; 70286000 C 0073 + INSYMBOL; 70287000 C 0075 + IF CURSY=IDENTIFIER THEN 70288000 C 0076 + BEGIN 70289000 C 0077 + SEARCH; 70290000 C 0077 + IF FOUND AND THISID.IDCLASS=TYPES THEN GO TO CASETYPEID; 70291000 C 0106 + NEWNAME(CURNAME1,CURNAME2,RECTAB); INDEX:=THISINDEX; 70292000 C 0108 + INSYMBOL; 70293000 C 0131 + IF CURSY≠COLON THEN ERROR(26); 70294000 C 0131 + INSYMBOL; 70295000 C 0133 + IF CURSY=IDENTIFIER THEN 70296000 C 0134 + BEGIN 70297000 C 0135 + SEARCH; 70298000 C 0135 + IF FOUND THEN 70299000 C 0164 + BEGIN 70300000 C 0164 + IF THISID.IDCLASS=TYPES THEN 70301000 C 0164 + BEGIN 70302000 C 0166 + CASETYPEID: CASETYPE:=THISID.TYPE; T1:=TYPETAB1[CASETYPE]; 70303000 C 0166 + LLIM:=TYPETAB2[CASETYPE]; ULIM:=TYPETAB3[CASETYPE]; 70304000 C 0169 + IF T1.FORM>CHAR THEN ERROR(48); 70305000 C 0171 + IF INDEX≥0 THEN 70306000 C 0173 + BEGIN 70307000 C 0174 + T3.IDCLASS:=VAR; T3.TYPE:=CASETYPE; T3.INFO:=ADDR; 70308000 C 0175 + ADDR:=LASTADDR:=ADDR+1; NAMETAB3[RECTAB,INDEX]:=T3; 70309000 C 0180 + END; 70310000 C 0184 + INSYMBOL; 70311000 C 0184 + END ELSE BEGIN ERROR(7); SKIP(OFSY) END; 70312000 C 0184 + END ELSE BEGIN ERROR(1); SKIP(OFSY) END; 70313000 C 0186 + END ELSE BEGIN ERROR(9); SKIP(OFSY) END; 70314000 C 0188 + END ELSE BEGIN ERROR(9); SKIP(OFSY) END; 70315000 C 0190 + IF CURSY≠OFSY THEN BEGIN ERROR(18); SKIP(RPAR) END; 70316000 C 0192 + IF CURSY=OFSY THEN INSYMBOL; 70317000 C 0195 + IF CASETYPE=0 THEN BEGIN LLIM:=-MAXINT; ULIM:=MAXINT END; 70318000 C 0197 + DO BEGIN 70319000 C 0200 + WHILE CURSY=SEMICOLON DO INSYMBOL; 70320000 C 0201 + IF CURSY≤CHARCONST OR CURSY=PLUS OR CURSY=MINUS THEN 70321000 C 0205 + BEGIN 70322000 C 0207 + FIRST:=TRUE; 70323000 C 0208 + DO BEGIN 70324000 C 0209 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 70325000 C 0209 + CONSTANT(CVAL,CTYPE); 70326000 C 0211 + IF CTYPE>0 THEN 70327000 C 0299 + BEGIN 70328000 C 0299 + IF CASETYPE=0 THEN CASETYPE:=CTYPE ELSE 70329000 C 0300 + IF CVALULIM THEN ERROR(14) ELSE 70330000 C 0302 + CHECKTYPES(CASETYPE,CTYPE); 70331000 C 0305 + IF LISTINX≥LISTLENGTH THEN BEGIN ERROR(30); LISTINX:=0 END; 70332000 C 0365 + LISTINX:=LISTINX+1; 70333000 C 0367 + ILIST[LISTINX]:=CVAL; I:=1; 70334000 C 0369 + WHILE ILIST[I]≠CVAL DO I:=I+1; 70335000 C 0371 + IF ILASTADDR THEN LASTADDR:=MAXADDR; 70344000 C 0385 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 70345000 C 0387 + INSYMBOL; 70346000 C 0390 + END ELSE ERROR(58); 70347000 C 0390 + END; 70348000 C 0391 + END UNTIL CURSY NEQ SEMICOLON; % 70349000 C 0391 + EXIT: 70350000 C 0393 + END OF FIELDLIST; 70351000 C 0393 + 37 IS 401 LONG, NEXT SEG 2 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 80001000 C 0369 + % % 80002000 C 0369 + % % 80003000 C 0369 + % % 80004000 C 0369 + % PART 8: THE PROCEDURE BLOCK. % 80005000 C 0369 + % -------------------- % 80006000 C 0369 + % % 80007000 C 0369 + % % 80008000 C 0369 + % % 80009000 C 0369 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 80010000 C 0369 + 80011000 C 0369 + 80012000 C 0369 + 80013000 C 0369 + PROCEDURE DECLAREVARS(PARAM,TAB,FIRST,LAST,LEVEL); 80014000 C 0369 + VALUE PARAM,FIRST,LAST,LEVEL; 80015000 C 0369 + INTEGER ARRAY TAB[0]; 80016000 C 0369 + INTEGER FIRST,LAST,LEVEL; 80017000 C 0369 + BOOLEAN PARAM; 80018000 C 0369 + BEGIN 80019000 C 0369 + INTEGER LEVEL1000,TYP,NAM,NAMTAB,T1,I,J,RECSIZE; 80020000 C 0369 + START OF SEGMENT ********** 38 + BOOLEAN REALVAR,ARRAYVAR,FIRSTDIM,EXTFILE; 80021000 C 0000 + ALPHA FNAME; 80022000 C 0000 + INTEGER FNLENGTH,FNSTART; % 80023000 C 0000 + 80024000 C 0000 + LEVEL1000:=LEVEL×1000; 80025000 C 0000 + FOR I:=FIRST STEP 1 UNTIL LAST DO 80026000 C 0001 + BEGIN 80027000 C 0002 + NAM:=TAB[I].[9:10]; NAMTAB:=NAMETAB3[LEVEL,NAM]; 80028000 C 0002 + TYP:=NAMTAB.TYPE; T1:=TYPETAB1[TYP]; 80029000 C 0005 + IF NAMTAB.IDCLASS GEQ FUNC THEN 80030000 C 0007 + BEGIN 80031000 C 0008 + IF REALVAR OR ARRAYVAR THEN 80032000 C 0009 + BEGIN 80033000 C 0010 + GEN(";",1,7); 80034000 C 0010 + REALVAR:=ARRAYVAR:=FALSE; 80035000 C 0019 + END; 80036000 C 0020 + IF NAMTAB.IDCLASS=FUNC THEN GEN("REAL",5,4); 80037000 C 0020 + GEN("PROCEDU",8,1); 80038000 C 0031 + GENID("V",LEVEL1000+NAM,5); GEN(";",1,7); 80039000 C 0040 + END ELSE 80040000 C 0061 + IF T1.STRUCT=0 THEN %*** SIMPLE TYPE *** 80041000 C 0061 + BEGIN 80042000 C 0065 + IF ARRAYVAR THEN BEGIN GEN(";",1,7); ARRAYVAR:=FALSE END; 80043000 C 0065 + IF REALVAR THEN GEN(",",1,7) ELSE 80044000 C 0076 + BEGIN GEN("REAL",5,4); REALVAR:=TRUE END; 80045000 C 0086 + GENID("V",LEVEL1000+NAM,5); 80046000 C 0096 + END ELSE 80047000 C 0108 + BEGIN 80048000 C 0108 + IF REALVAR THEN BEGIN GEN(";",1,7); REALVAR:=FALSE END; 80049000 C 0110 + IF T1.FORM0 AND CURKIND=CONST THEN ERROR(94); 80201000 C 0116 + END ELSE IF T.STRUCT>0 THEN ERROR(38); 80202000 C 0120 + END ELSE BEGIN ERROR(7); T3:=0 END; 80203000 C 0123 + END ELSE BEGIN ERROR(1); T3:=0 END; 80204000 C 0125 + END ELSE BEGIN ERROR(9); T3:=0 END; 80205000 C 0127 + INSYMBOL; 80206000 C 0129 + END ELSE 80207000 C 0129 + BEGIN 80208000 C 0129 + IF CURKIND≠PROC THEN ERROR(7); 80209000 C 0130 + T3:=0; 80210000 C 0132 + END; 80211000 C 0133 + T3.IDCLASS:=CURKIND; T3.FORMAL:=1; 80212000 C 0133 + FOR I:=P1 STEP 1 UNTIL NUMPARAMS DO 80213000 C 0136 + NAMETAB3[CURLEVEL+1,PARAMTAB[I].PARAMNAME]:=T3; 80214000 C 0138 + END UNTIL CURSY≠SEMICOLON; 80215000 C 0143 + IF CURSY≠RPAR THEN 80216000 C 0144 + BEGIN ERROR(49); SKIP(RPAR); 80217000 C 0145 + IF CURSY=RPAR THEN INSYMBOL; 80218000 C 0147 + END ELSE INSYMBOL; 80219000 C 0149 + END; 80220000 C 0150 + PARAMTAB[FIRSTPARAM]:=NUMPARAMS-FIRSTPARAM; 80221000 C 0150 + END OF PARAMETERLIST; 80222000 C 0152 + 39 IS 157 LONG, NEXT SEG 2 + 80223000 C 0369 + 80400000 C 0369 + PROCEDURE BLOCK; 80401000 C 0369 + BEGIN 80402000 C 0369 + INTEGER INDEX,CTYPE,NUMFORWARDS,T,T3,TX,I; 80403000 C 0369 + START OF SEGMENT ********** 40 + REAL CVAL; 80404000 C 0000 + ALPHA C1,C2; 80405000 C 0000 + BOOLEAN VALUEPARAMS,FUN; 80406000 C 0000 + LABEL START; 80407000 C 0000 + 80408000 C 0000 + INTEGER LABTABTOP,CONSTTABTOP,TYPETABTOP,PARAMTABTOP,TOPREC, 80409000 C 0000 + FORMERFIRSTLAB,FIRSTFILE; 80410000 C 0000 + 80411000 C 0000 + FORMERFIRSTLAB:=FIRSTLAB; 80412000 C 0000 + LABTABTOP:=NUMLABS; FIRSTLAB:=LABTABTOP+1; 80413000 C 0000 + CONSTTABTOP:=NUMCONSTS; 80414000 C 0002 + TYPETABTOP:=NUMTYPES; 80415000 C 0003 + PARAMTABTOP:=NUMPARAMS; 80416000 C 0004 + TOPREC:=LASTREC; 80417000 C 0005 + FIRSTFILE:=NUMFILES+1; 80418000 C 0005 + 80419000 C 0007 + TOPLEVEL:=CURLEVEL; 80420000 C 0007 + IF CURLEVEL>1 THEN GEN("BEGIN",6,3); 80421000 C 0007 + START: 80422000 C 0018 + IF CURSY=LABELSY THEN %*** LABEL DECLARATION *** 80423000 C 0018 + BEGIN %************************* 80424000 C 0018 + GEN("LABEL",6,3); 80425000 C 0019 + DO BEGIN 80426000 C 0028 + INSYMBOL; 80427000 C 0029 + IF CURSY=INTCONST THEN 80428000 C 0029 + BEGIN 80429000 C 0030 + GENID("L",CURVAL,4); 80430000 C 0030 + IF CURVAL>9999 THEN ERROR(33); 80431000 C 0042 + FOR I:=FIRSTLAB STEP 1 UNTIL NUMLABS DO 80432000 C 0044 + IF LABTAB[I].LABVAL=CURVAL THEN ERROR(31); 80433000 C 0048 + IF NUMLABS≥MAXLABS THEN BEGIN ERROR(34); NUMLABS:=0 END; 80434000 C 0053 + NUMLABS:=NUMLABS+1; 80435000 C 0055 + LABTAB[NUMLABS]:=CURVAL; 80436000 C 0057 + INSYMBOL; 80437000 C 0058 + END ELSE BEGIN ERROR(10); SKIP(COMMA) END; 80438000 C 0058 + IF CURSY=COMMA THEN GEN(",",1,7); 80439000 C 0060 + END UNTIL CURSY≠COMMA; 80440000 C 0071 + IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80441000 C 0072 + GEN(";",1,7); 80442000 C 0075 + IF SYMKIND[CURSY]≠INITIAL THEN INSYMBOL; 80443000 C 0084 + END OF LABEL DECLARATION; 80444000 C 0086 + 80445000 C 0086 + IF CURSY=CONSTSY THEN %*** CONSTANT DECLARATION *** 80446000 C 0086 + BEGIN %**************************** 80447000 C 0086 + INSYMBOL; 80448000 C 0087 + DO BEGIN 80449000 C 0087 + IF CURSY=IDENTIFIER THEN 80450000 C 0088 + BEGIN 80451000 C 0088 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80452000 C 0089 + INSYMBOL; 80453000 C 0112 + IF CURSY=EQLSY THEN 80454000 C 0112 + BEGIN 80455000 C 0113 + INSYMBOL; CONSTANT(CVAL,CTYPE); 80456000 C 0114 + T3:=CTYPE; T3.IDCLASS:=CONST; 80457000 C 0202 + IF CVAL.[46:8]≠0 OR CVAL>1023 THEN 80458000 C 0204 + BEGIN 80459000 C 0206 + IF NUMCONSTS≥MAXCONSTS THEN 80460000 C 0207 + BEGIN ERROR(35); NUMCONSTS:=0 END; 80461000 C 0208 + NUMCONSTS:=NUMCONSTS+1; 80462000 C 0210 + CONSTTAB[NUMCONSTS]:=CVAL; 80463000 C 0211 + T3.INFO:=1023+NUMCONSTS; 80464000 C 0212 + END ELSE T3.INFO:=CVAL; 80465000 C 0214 + NAMETAB3[CURLEVEL,INDEX]:=T3; 80466000 C 0217 + END ELSE BEGIN ERROR(36); SKIP(SEMICOLON) END; 80467000 C 0219 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80468000 C 0221 + IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80469000 C 0223 + IF SYMKIND[CURSY]≠INITIAL THEN INSYMBOL; 80470000 C 0225 + END UNTIL CURSY≠IDENTIFIER; 80471000 C 0227 + END OF CONSTANT DECLARATION; 80472000 C 0229 + 80473000 C 0229 + IF CURSY=TYPESY THEN %*** TYPE DECLARATION **** 80474000 C 0229 + BEGIN %************************* 80475000 C 0229 + INSYMBOL; 80476000 C 0230 + DO BEGIN 80477000 C 0230 + IF CURSY=IDENTIFIER THEN 80478000 C 0231 + BEGIN 80479000 C 0231 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80480000 C 0232 + INSYMBOL; 80481000 C 0255 + IF CURSY=EQLSY THEN 80482000 C 0255 + BEGIN 80483000 C 0256 + INSYMBOL; 80484000 C 0257 + TYPEDECL(CTYPE,TX); 80485000 C 0257 + T3:=CTYPE; T3.IDCLASS:=TYPES; 80486000 C 0258 + NAMETAB3[CURLEVEL,INDEX]:=T3; 80487000 C 0261 + END ELSE BEGIN ERROR(36); SKIP(SEMICOLON) END; 80488000 C 0263 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80489000 C 0265 + IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80490000 C 0267 + IF SYMKIND[CURSY]≠INITIAL THEN INSYMBOL; 80491000 C 0269 + END UNTIL CURSY≠IDENTIFIER; 80492000 C 0271 + END OF TYPE DECLARATION; 80493000 C 0273 + 80494000 C 0273 + IF CURSY=VARSY THEN %*** VARIABLE DECLARATION *** 80495000 C 0273 + BEGIN %**************************** 80496000 C 0273 + VARINDEX:=0; 80497000 C 0274 + DO BEGIN 80498000 C 0275 + FIRSTVAR:=VARINDEX+1; 80499000 C 0275 + DO BEGIN 80500000 C 0276 + IF CURSY=VARSY OR CURSY=COMMA THEN INSYMBOL; 80501000 C 0277 + IF CURSY=IDENTIFIER THEN 80502000 C 0279 + BEGIN 80503000 C 0280 + IF VARINDEX≥LISTLENGTH THEN 80504000 C 0281 + BEGIN ERROR(37); VARINDEX:=0 END; 80505000 C 0281 + VARINDEX:=VARINDEX+1; 80506000 C 0283 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); 80507000 C 0285 + VARLIST[VARINDEX]:=THISINDEX; 80508000 C 0307 + INSYMBOL; 80509000 C 0308 + END ELSE BEGIN ERROR(9); SKIP(COLON) END; 80510000 C 0309 + END UNTIL CURSY≠COMMA; 80511000 C 0311 + IF CURSY≠COLON THEN BEGIN ERROR(26); SKIP(COLON) END; 80512000 C 0312 + IF CURSY=COLON THEN 80513000 C 0315 + BEGIN 80514000 C 0316 + INSYMBOL; 80515000 C 0316 + TYPEDECL(CTYPE,TX); 80516000 C 0317 + T3:=CTYPE; T3.IDCLASS:=VAR; 80517000 C 0318 + FOR I:=FIRSTVAR STEP 1 UNTIL VARINDEX DO 80518000 C 0320 + NAMETAB3[CURLEVEL,VARLIST[I]]:=T3; 80519000 C 0322 + END ELSE BEGIN ERROR(26); SKIP(SEMICOLON) END; 80520000 C 0326 + IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80521000 C 0328 + IF SYMKIND[CURSY]≠INITIAL THEN INSYMBOL; 80522000 C 0331 + END UNTIL CURSY≠IDENTIFIER; 80523000 C 0333 + DECLAREVARS(FALSE,VARLIST,1,VARINDEX,CURLEVEL); 80524000 C 0334 + END OF VARIABLE DECLARATIONS; 80525000 C 0336 + 80526000 C 0336 + IF NUMPNTRS>0 THEN 80527000 C 0336 + BEGIN 80528000 C 0337 + C1:=CURNAME1; C2:=CURNAME2; 80529000 C 0338 + FOR I:=1 STEP 1 UNTIL NUMPNTRS DO 80530000 C 0339 + BEGIN 80531000 C 0341 + CURNAME1:=PNTRTAB1[I]; CURNAME2:=PNTRTAB2[I]; 80532000 C 0341 + SEARCHTAB(CURLEVEL); 80533000 C 0343 + THISID:=NAMETAB3[CURLEVEL,THISINDEX]; 80534000 C 0361 + IF FOUND AND THISID.IDCLASS=TYPES THEN 80535000 C 0363 + TYPETAB1[PNTRTAB3[I]].POINTTYPE:=THISID.TYPE ELSE ERROR(62); 80536000 C 0365 + END; 80537000 C 0370 + CURNAME1:=C1; CURNAME2:=C2; NUMPNTRS:=0; 80538000 C 0372 + END; 80539000 C 0374 + 80540000 C 0374 + WHILE CURSY=FUNCSY OR CURSY=PROCSY DO %*** PROC/FUNC DECLARATION *** 80541000 C 0374 + BEGIN %***************************** 80542000 C 0377 + FUN:=CURSY=FUNCSY; INSYMBOL; 80543000 C 0377 + IF CURSY=IDENTIFIER THEN 80544000 C 0379 + BEGIN 80545000 C 0379 + SEARCHTAB(CURLEVEL); 80546000 C 0380 + THISID:=NAMETAB3[CURLEVEL,THISINDEX]; 80547000 C 0398 + IF FOUND AND THISID.IDCLASS≥PROC THEN 80548000 C 0400 + BEGIN 80549000 C 0402 + INDEX:=THISINDEX; 80550000 C 0402 + IF THISID.FORWARDDEF=1 THEN 80551000 C 0403 + BEGIN 80552000 C 0404 + NAMETAB3[THISLEVEL,THISINDEX].FORWARDDEF:=0; 80553000 C 0405 + NUMFORWARDS:=NUMFORWARDS-1; 80554000 C 0408 + IF(THISID.IDCLASS=PROC AND FUN)OR 80555000 C 0409 + (THISID.IDCLASS=FUNC AND NOT FUN) THEN ERROR(43); 80556000 C 0411 + INSYMBOL; 80567000 C 0414 + END ELSE BEGIN ERROR(2); SKIP(SEMICOLON) END; 80568000 C 0415 + END ELSE 80569000 C 0417 + BEGIN 80570000 C 0417 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80571000 C 0417 + T3:=0; T3.INFO:=NUMPARAMS+1; 80572000 C 0441 + T3.IDCLASS:=IF FUN THEN FUNC ELSE PROC; 80573000 C 0444 + NAMETAB3[CURLEVEL,INDEX]:=T3; 80574000 C 0447 + INSYMBOL; PARAMETERLIST; 80575000 C 0449 + IF CURSY=COLON THEN 80576000 C 0450 + BEGIN 80577000 C 0451 + IF NOT FUN THEN ERROR(48); 80578000 C 0451 + INSYMBOL; 80579000 C 0453 + IF CURSY=IDENTIFIER THEN 80580000 C 0454 + BEGIN 80581000 C 0454 + SEARCH; 80582000 C 0455 + IF FOUND THEN 80583000 C 0484 + BEGIN 80584000 C 0484 + IF THISID.IDCLASS=TYPES THEN 80585000 C 0484 + BEGIN 80586000 C 0486 + T:=TYPETAB1[THISID.TYPE]; 80587000 C 0486 + IF T.FORM≤ALFA OR T.FORM=POINTERS THEN 80588000 C 0488 + BEGIN 80589000 C 0490 + NAMETAB3[CURLEVEL,INDEX].TYPE:=THISID.TYPE; 80590000 C 0491 + END ELSE ERROR(38); 80591000 C 0495 + END ELSE ERROR(7); 80592000 C 0496 + END ELSE ERROR(1); 80593000 C 0497 + END ELSE ERROR(9); 80594000 C 0498 + INSYMBOL; 80595000 C 0500 + END ELSE IF FUN THEN 80596000 C 0500 + BEGIN ERROR(26); SKIP(SEMICOLON) END; 80597000 C 0501 + END; 80598000 C 0503 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80599000 C 0503 + IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80600000 C 0505 + IF FUN THEN GEN("FUNCTN",7,2) ELSE 80601000 C 0508 + GEN("PROCEDU",8,1); GENID("V",1000×CURLEVEL+INDEX,5); 80602000 C 0517 + T:=NAMETAB3[CURLEVEL,INDEX].INFO; TX:=T+PARAMTAB[T]; 80603000 C 0541 + IF TX>T THEN 80604000 C 0545 + BEGIN 80605000 C 0546 + GEN("(",1,7); 80606000 C 0546 + FOR I:=T+1 STEP 1 UNTIL TX DO 80607000 C 0555 + BEGIN GENID("V",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80608000 C 0559 + IF BOOLEAN(PARAMTAB[I].PARAMFILE) THEN 80609000 C 0573 + BEGIN 80610000 C 0574 + GEN(",",1,7); 80611000 C 0575 + GENID("F",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80612000 C 0584 + GEN(",",1,7); 80613000 C 0597 + GENID("I",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80614000 C 0606 + END; 80615000 C 0620 + IF I LSS TX THEN GEN(",",1,7); 80616000 C 0620 + END; 80617000 C 0632 + GEN(");",2,6); 80618000 C 0633 + VALUEPARAMS:=FALSE; 80619000 C 0642 + FOR I:=T+1 STEP 1 UNTIL TX DO 80620000 C 0643 + IF PARAMTAB[I].PARAMKIND=CONST THEN 80621000 C 0647 + BEGIN 80622000 C 0648 + IF NOT VALUEPARAMS THEN 80623000 C 0649 + BEGIN GEN("VALUE",6,3); 80624000 C 0649 + VALUEPARAMS:=TRUE; 80625000 C 0659 + END ELSE GEN(",",1,7); 80626000 C 0660 + GENID("V",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80627000 C 0672 + END; 80628000 C 0685 + IF VALUEPARAMS THEN GEN(";",1,7); 80629000 C 0686 + DECLAREVARS(TRUE,PARAMTAB,T+1,TX,CURLEVEL+1); 80630000 C 0696 + END ELSE GEN(";",1,7); 80631000 C 0699 + 80632000 C 0708 + INSYMBOL; 80633000 C 0708 + IF CURNAME1="7FORWAR" AND CURNAME2="D" THEN 80634000 C 0709 + BEGIN 80635000 C 0711 + NAMETAB3[CURLEVEL,INDEX].FORWARDDEF:=1; 80636000 C 0711 + NUMFORWARDS:=NUMFORWARDS+1; 80637000 C 0714 + GEN("FORWARD",8,1); 80638000 C 0716 + INSYMBOL; 80639000 C 0725 + END ELSE 80640000 C 0725 + BEGIN 80641000 C 0725 + CURLEVEL:=CURLEVEL+1; 80642000 C 0728 + IF CURLEVEL≥LASTREC THEN ERROR(55); 80643000 C 0729 + BLOCKTAB[CURLEVEL]:=NUMBLOCKS:=NUMBLOCKS+1; 80644000 C 0731 + T:=CURFUNC; CURFUNC:=IF FUN THEN INDEX ELSE -1; 80645000 C 0733 + BLOCK; %*** COMPILE PROCEDURE BODY *** 80646000 C 0736 + REPLACE POINTER(NAMETAB1[CURLEVEL,*]) BY 0 80647000 C 0737 + FOR MAXNAMES+1 WORDS; 80648000 C 0739 + CURLEVEL:=CURLEVEL-1; CURFUNC:=T; 80649000 C 0742 + TOPLEVEL:=CURLEVEL; 80650000 C 0744 + END; 80651000 C 0745 + IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80652000 C 0745 + GEN(";",1,7); 80653000 C 0748 + IF SYMKIND[CURSY]≠INITIAL THEN INSYMBOL; 80654000 C 0757 + END OF PROCEDURE DECLARATION; 80655000 C 0759 + 80656000 C 0759 + 80657000 C 0759 + IF NUMFORWARDS>0 THEN ERROR(44); 80658000 C 0759 + GEN("INTEGER",8,1); 80659000 C 0763 + FOR I:=1 STEP 1 UNTIL MAXTEMPS DO 80660000 C 0772 + BEGIN GENID("T",I,2); 80661000 C 0774 + IF I1 THEN GEN("END",4,5); 80703000 C 0963 + END OF BLOCK; 80704000 C 0973 + 40 IS 984 LONG, NEXT SEG 2 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90001000 C 0369 + % % 90002000 C 0369 + % % 90003000 C 0369 + % % 90004000 C 0369 + % PART 9: THE MAIN PROGRAM. % 90005000 C 0369 + % ----------------- % 90006000 C 0369 + % % 90007000 C 0369 + % % 90008000 C 0369 + % % 90009000 C 0369 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90010000 C 0369 + 90011000 C 0369 + 90012000 C 0369 + INTEGER PROGNAMELENGTH; 90013000 C 0369 + ALPHA PROGNAME,ALGOLNAME; 90014000 C 0369 + 90015000 C 0369 + ALGOLNAME:="PASC000"&ENTIER(TIME(4) MOD 10)[17:5:6]; 90016000 C 0369 + ALGOLNAME:=ALGOLNAME&ENTIER(TIME(4) DIV 7)[11:5:6]; 90017000 C 0372 + ALGOLNAME:=ALGOLNAME&ENTIER(TIME(4) MOD 9)[5:5:6]; 90018000 C 0376 + USER:=TIME(-1); 90019000 C 0380 + FILL PASCALGOL WITH ALGOLNAME,USER; 90020000 C 0381 + BEGIN 90021000 C 0385 + FILE PASCRUN DISK SERIAL "PASCRUN"/"DISK" (2,10,150); 90022000 C 0385 + START OF SEGMENT ********** 41 + ARRAY BUF[0:9]; 90023000 C 0004 + LABEL EOF; 90024000 C 0006 + 90025000 C 0006 + WHILE TRUE DO 90026000 C 0006 + BEGIN 90027000 C 0007 + READ(PASCRUN,9,BUF[*]) [EOF]; 90028000 C 0007 + WRITE(PASCALGOL,10,BUF[*]); 90029000 C 0013 + END; 90030000 C 0017 + EOF: 90031000 C 0017 + END OF TRANSFER OF RUN TIME SYSTEM; 90032000 C 0018 + 41 IS 21 LONG, NEXT SEG 2 + CARDLENGTH:=72; 90033000 C 0388 + INITIALIZE; NEWCARD; 90034000 C 0388 + LISTOPTION:=CHECKOPTION:=TRUE; 90035000 C 0452 + C:=" "; INSYMBOL; 90036000 C 0454 + IF CURSY=PROGRAMSY THEN 90037000 C 0455 + BEGIN 90038000 C 0456 + INSYMBOL; 90039000 C 0456 + IF CURSY=IDENTIFIER THEN 90040000 C 0457 + BEGIN 90041000 C 0457 + PROGNAME:=CURNAME1.[35:36]; PROGNAMELENGTH:=MIN(6,CURLENGTH); 90042000 C 0458 + INSYMBOL; 90043000 C 0462 + IF CURSY=LPAR THEN 90044000 C 0463 + BEGIN 90045000 C 0463 + DO BEGIN 90046000 C 0464 + INSYMBOL; 90047000 C 0465 + IF CURSY=IDENTIFIER THEN 90048000 C 0465 + BEGIN 90049000 C 0466 + IF CURNAME1="50INPUT" THEN INPUTDECL:=TRUE ELSE 90050000 C 0466 + IF CURNAME1="6OUTPUT" THEN OUTPUTDECL:=TRUE ELSE 90051000 C 0468 + BEGIN 90052000 C 0473 + IF CURLENGTH>6 THEN ERROR(77); 90053000 C 0475 + NUMEXTFILES:=NUMEXTFILES+1; 90054000 C 0477 + IF NUMEXTFILES≤MAXEXTFILES THEN 90055000 C 0478 + EXTFILETAB[NUMEXTFILES]:=CURNAME1 ELSE 90056000 C 0479 + IF NUMEXTFILES=MAXEXTFILES+1 THEN ERROR(73); 90057000 C 0480 + END; 90058000 C 0483 + END ELSE ERROR(9); 90059000 C 0483 + INSYMBOL; 90060000 C 0485 + END UNTIL CURSY≠COMMA; 90061000 C 0485 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(SEMICOLON) END; 90062000 C 0486 + IF CURSY=RPAR THEN INSYMBOL; 90063000 C 0489 + IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 90064000 C 0491 + END ELSE BEGIN ERROR(58); SKIP(SEMICOLON) END; 90065000 C 0494 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 90066000 C 0496 + END ELSE BEGIN ERROR(75); SKIP(SEMICOLON) END; 90067000 C 0498 + INSYMBOL; 90068000 C 0500 + CURLEVEL:=1; 90069000 C 0500 + LASTREC:=MAXTABLES+1; 90070000 C 0501 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90071000 C 0502 + % % 90072000 C 0502 + BLOCK; % COMPILE USER PROGRAM. % 90073000 C 0502 + % % 90074000 C 0503 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90075000 C 0503 + IF CURSY≠DOT THEN 90076000 C 0503 + BEGIN 90077000 C 0503 + ERROR(76); 90078000 C 0504 + DO BLOCK UNTIL CURSY=DOT; 90079000 C 0505 + END; 90080000 C 0506 + IF FALSE THEN 90081000 C 0506 + BEGIN 90082000 C 0507 + ENDOFINPUT: ERROR(87); CHARCNT:=-1; 90083000 C 0507 + WRITE(LINES,TERMMESS); 90084000 C 0509 + END; 90085000 C 0512 + IF LISTOPTION AND CHARCNT≥0 THEN PRINTLINE; 90086000 C 0512 + IF ERRINX>0 THEN PRINTERRORS; 90087000 C 0556 + WRITE(LINES[DBL]); 90088000 C 0558 + WRITE(LINES[DBL]); 90089000 C 0562 + IF NUMERRS=0 THEN 90090000 C 0566 + BEGIN 90091000 C 0567 + ARRAY ZIPARRAY[0:19], Z[0:0]; 90092000 C 0567 + START OF SEGMENT ********** 42 + POINTER ZIPPNT; 90093000 C 0005 + 90094000 C 0005 + DEFINE ZIPTEXT(TEXT,L)= 90095000 C 0005 + BEGIN 90096000 C 0005 + Z[0]:=TEXT; 90097000 C 0005 + REPLACE ZIPPNT:ZIPPNT BY POINTER(Z[*])+(8-L) FOR L; 90098000 C 0005 + END#; 90099000 C 0005 + 90100000 C 0005 + PROCEDURE ZIPNUM(N); % TRANSFERS A NUMBER TO THE ZIP BUFFER. 90101000 C 0005 + VALUE N; INTEGER N; 90102000 C 0005 + IF N≤9 THEN ZIPTEXT(N,1) ELSE 90103000 C 0005 + BEGIN ZIPNUM(N DIV 10); ZIPTEXT(ENTIER(N MOD 10),1) END; 90104000 C 0014 + 90105000 C 0027 + WRITEALGOL; 90106000 C 0027 + WRITE(PASCALGOL,LASTLINE); 90107000 C 0027 + LOCK(PASCALGOL,SAVE); 90108000 C 0030 + ZIPPNT:=POINTER(ZIPARRAY[*]); 90109000 C 0032 + REPLACE ZIPPNT BY " " FOR 20 WORDS; 90110000 C 0033 + WRITE(LINES,NOERRORS); 90111000 C 0037 + ZIPTEXT("CC ",3); ZIPTEXT("COMPILE",7); 90112000 C 0040 + ZIPTEXT(" ",1); ZIPTEXT(PROGNAME,PROGNAMELENGTH); 90113000 C 0054 + ZIPTEXT("/",1); ZIPTEXT(USER,7); 90114000 C 0069 + ZIPTEXT(" XALGOL",7); ZIPTEXT(" ",1); 90115000 C 0083 + IF SAVEFACTOR>0 THEN ZIPTEXT("LIBRARY",7); 90116000 C 0098 + IF SAVEFACTOR<0 THEN ZIPTEXT("SYNTAX",6); 90117000 C 0106 + ZIPTEXT(";",1); 90118000 C 0115 + ZIPTEXT("XALGOL",6); ZIPTEXT(" FILE",5); 90119000 C 0122 + ZIPTEXT(" CARD=",6); ZIPTEXT(ALGOLNAME,7); 90120000 C 0137 + ZIPTEXT("/",1); ZIPTEXT(USER,7); 90121000 C 0160 + ZIPTEXT(" SERIAL",7); ZIPTEXT(";",1); 90122000 C 0174 + IF SAVEFACTOR>0 THEN 90123000 C 0189 + BEGIN 90124000 C 0190 + ZIPTEXT("SAVE=",5); ZIPNUM(SAVEFACTOR); 90125000 C 0190 + ZIPTEXT(";",1); 90126000 C 0198 + END; 90127000 C 0205 + ZIPTEXT("END.",4); 90128000 C 0205 + ZIP WITH ZIPARRAY[*]; 90129000 C 0213 + END OF COMPILER ZIP ELSE 90130000 C 0214 + 42 IS 221 LONG, NEXT SEG 2 + BEGIN 91001000 C 0568 + INTEGER I; 91002000 C 0568 + START OF SEGMENT ********** 43 + SWITCH FORMAT ERRORMESS1 := 91003000 C 0000 + START OF SEGMENT ********** 44 + (" 0 *** COMPILER ERROR *** CONTACT THE COMPUTER CENTRE."), 91004000 C 0000 + (" 1 IDENTIFIER NOT DEFINED."), 91005000 C 0000 + (" 2 IDENTIFIER ALREADY DEFINED."), 91006000 C 0000 + (" 3 WRONG NUMBER OF PARAMETERS."), 91007000 C 0000 + (" 4 SYNTAX ERROR."), 91008000 C 0000 + (" 5 VARIABLE NOT ACCESSIBLE (HARDWARE RESTRICTION)."), 91009000 C 0000 + (" 6 STRINGS MAY NOT BE CONTINUED FROM ONE CARD TO ANOTHER."), 91010000 C 0000 + (" 7 A TYPE EXPECTED."), 91011000 C 0000 + (" 8 VARIABLE EXPECTED."), 91012000 C 0000 + (" 9 IDENTIFIER EXPECTED."), 91013000 C 0000 + (" 10 INTEGER CONSTANT EXPECTED."), 91014000 C 0000 + (" 11 CONSTANT OF OTHER TYPE THAN EXPECTED."), 91015000 C 0000 + (" 12 VARIABLE OF ILLEGAL TYPE."), 91016000 C 0000 + (" 13 UNRECOGNIZABLE STATEMENT."), 91017000 C 0000 + (" 14 CONSTANT TOO BIG OR TO SMALL."), 91018000 C 0000 + (" 15 UNDEFINED LABEL."), 91019000 C 0000 + (" 16 FOR- AND CASE-STATEMENTS NESTED TOO DEEP."), 91020000 C 0000 + (" 17 EXPRESSION IS OF WRONG TYPE."), 91021000 C 0000 + (" 18 """OF""" EXPECTED."), 91022000 C 0000 + (" 19 """DO""" EXPECTED."), 91023000 C 0000 + (" 20 """ELSE""" WITHOUT CORRESPONDING """THEN"""."), 91024000 C 0000 + (" 21 ILLEGAL TERMINATION OF STATEMENT."), 91025000 C 0000 + (" 22 """UNTIL""" EXPECTED."), 91026000 C 0000 + (" 23 """TO"""/"""DOWNTO""" EXPECTED."), 91027000 C 0000 + (" 24 """END""" EXPECTED."), 91028000 C 0000 + (" 25 """;""" EXPECTED."), 91029000 C 0000 + (" 26 """:""" EXPECTED."), 91030000 C 0000 + (" 27 """THEN""" EXPECTED."), 91031000 C 0000 + (" 28 """:=""" EXPECTED."), 91032000 C 0000 + (" 29 ONLY NUMBERS MAY BE SIGNED."), 91033000 C 0000 + (" 30 TOO MANY CASES."), 91034000 C 0000 + (" 31 LABEL USED MORE THAN ONCE."), 91035000 C 0000 + (" 32 CONSTANT EXPECTED."), 91036000 C 0000 + (" 33 LABEL NOT IN RANGE 0..9999."), 91037000 C 0000 + (" 34 TOO MANY LABELS DECLARED."), 91038000 C 0000 + (" 35 TOO MANY CONSTANTS DECLARED."), 91039000 C 0000 + (" 36 """=""" EXPECTED."), 91040000 C 0000 + (" 37 THE LIST IS TOO LONG."), 91041000 C 0000 + (" 38 INVALID TYPE FOR A FUNCTION."), 91042000 C 0000 + (" 39 """BEGIN""" EXPECTED."), 91043000 C 0000 + (" 40 TOO MANY IDENTIFIERS DECLARED."), 91044000 C 0000 + (" 41 ALFA CONSTANTS MAY NOT BE LONGER THAN 7 CHARACTERS."), 91045000 C 0000 + (" 42 EXPRESSION IS NOT OF TYPE BOOLEAN."), 91046000 C 0000 + (" 43 NOT PROPER FORWARD DECLARATION."), 91047000 C 0000 + (" 44 UNSATISFIED FORWARD DECLARATION."), 91048000 C 0000 + (" 45 TOO MANY DIFFERENT TYPES DECLARED."), 91049000 C 0000 + (" 46 """)""" EXPECTED."), 91050000 C 0000 + (" 47 """[""" EXPECTED."), 91051000 C 0000 + (" 48 A SIMPLE TYPE EXPECTED."), 91052000 C 0000 + (" 49 """ARRAY OF ARRAY""" AND """ARRAY OF RECORD""" ILLEGAL", 91053000 C 0000 + " AS FILE TYPE."), 91054000 C 0000 + (" 50 """FILE OF FILE""" IS ILLEGAL."), 91055000 C 0000 + (" 51 SET BOUNDRY IS TOO BIG OR TOO SMALL."), 91056000 C 0000 + (" 52 TOO MANY UNDECLARED POINTERS."), 91057000 C 0000 + (" 53 """..""" EXPECTED."), 91058000 C 0000 + (" 54 FIRST VALUE IS GREATER THAN SECOND VALUE."), 91059000 C 0000 + (" 55 TOO MANY RECORDS DECLARED AT ONE TIME."), 91060000 C 0000 + (" 56 THE RECORD CONTAINS MORE THEN 1023 WORDS."), 91061000 C 0000 + (" 57 FILES NOT ALLOWED IN RECORDS."), 91062000 C 0000 + (" 58 """(""" EXPECTED."), 91063000 C 0000 + (" 59 """]""" EXPECTED."); 91064000 C 0000 + 44 IS 590 LONG, NEXT SEG 43 + 91065000 C 0000 + SWITCH FORMAT ERRORMESS2 := 91066000 C 0000 + START OF SEGMENT ********** 45 + (" 60 """ARRAY OF FILE""" NOT ALLOWED."), 91067000 C 0000 + (" 61 RANGE OF INDEX IS GREATER THAN 1023."), 91068000 C 0000 + (" 62 UNSATISFIED POINTER DECLARATION."), 91069000 C 0000 + (" 63 EXPRESSION IS TOO LONG."), 91070000 C 0000 + (" 64 ILLEGAL OPERATOR FOR THIS TYPE OF EXPRESSION."), 91071000 C 0000 + (" 65 INTEGER EXPRESSION EXPECTED."), 91072000 C 0000 + (" 66 A SET EXPECTED."), 91073000 C 0000 + (" 67 PARAMETER OF ILLEGAL TYPE."), 91074000 C 0000 + (" 68 PROCEDURES NOT ALLOWED IN THIS CONTEXT."), 91075000 C 0000 + (" 69 ILLEGAL USE OF THIS TYPE OF IDENTIFIER."), 91076000 C 0000 + (" 70 TOO MANY PARAMETERS DECLARED IN THE PROGRAM."), 91077000 C 0000 + (" 71 """ARRAY OF CHAR""" EXPECTED."), 91078000 C 0000 + (" 72 WRONG TYPE OF SET EXPRESSION."), 91079000 C 0000 + (" 73 TOO MANY EXTERNAL FILES."), 91080000 C 0000 + (" 74 ILLEGAL IDENTIFIER FOR EXTERNAL FILE."), 91081000 C 0000 + (" 75 """PROGRAM""" EXPECTED."), 91082000 C 0000 + (" 76 """.""" EXPECTED AT END OF PROGRAM."), 91083000 C 0000 + (" 77 EXTERNAL FILE IDENTIFIER MAY NOT EXCEED 6 CHARACTERS."), 91084000 C 0000 + (" 78 ILLEGAL FILE PARAMETER."), 91085000 C 0000 + (" 79 ILLEGAL USE OF FILE HANDLING PROCEDURE."), 91086000 C 0000 + (" 80 TEXT-FILE EXPECTED."), 91087000 C 0000 + (" 81 POINTER VARIABLE EXPECTED."), 91088000 C 0000 + (" 82 ONLY VALUES OF TYPE REAL, INTEGER OR CHAR MAY BE READ."), 91089000 C 0000 + (" 83 VARIABLES IN RECORDS ILLEGAL IN THIS CONTEXT."), 91090000 C 0000 + (" 84 DISPLAY OVERFLOW."), 91091000 C 0000 + (" 85 READ AND WRITE MAY ONLY BE USED ON TEXT-FILES."), 91092000 C 0000 + (" 86 REFERENCED OBJECT IS TOO BIG."), 91093000 C 0000 + (" 87 END-OF-INPUT DISCOVERED."), 91094000 C 0000 + (" 88 CHARACTER ARRAY EXPECTED."), 91095000 C 0000 + (" 89 """,""" EXPECTED."), 91096000 C 0000 + (" 91 PROCEDURES MAY NOT HAVE ANY TYPE."), 91097000 C 0000 + (" 91 PARAMETER OF WRONG KIND."), 91098000 C 0000 + (" 92 ONLY COMPLETE ARRAYS AND RECORDS MAY BE TRANSMITTED."), 91099000 C 0000 + (" 93 DECLARED LABEL NOT USED."), 91100000 C 0000 + (" 94 PARAMETERS OF THIS TYPE SHOULD NOT BE VALUE PARAMETERS."), 91101000 C 0000 + (" 95 ASSIGNMENT OF STRUCTURED VARIABLES NOT IMPLIMENTED."), 91102000 C 0000 + (" 96 INPUT/OUPUT NOT DECLARED."), 91103000 C 0000 + (" 97 TOO MANY FILES IN USE."), 91104000 C 0000 + (" 98 RECORD IDENTIFIER EXPECTED."), 91105000 C 0000 + (" 99 UNRECOGNIZED ITEM."), 91106000 C 0000 + (); 91107000 C 0000 + 45 IS 428 LONG, NEXT SEG 43 + 91108000 C 0000 + 91109000 C 0000 + WRITE(LINES,ERRORS,NUMERRS); 91110000 C 0000 + FOR I:=0 STEP 1 UNTIL 59 DO IF ERR[I] THEN 91111000 C 0007 + WRITE(LINES,ERRORMESS1[I]); 91112000 C 0008 + FOR I:=60 STEP 1 UNTIL 119 DO IF ERR[I] THEN 91113000 C 0015 + WRITE(LINES,ERRORMESS2[I-60]); 91114000 C 0016 + END OF ERROR MESSAGES; 91115000 C 0023 + 43 IS 28 LONG, NEXT SEG 2 + IF XREFOPTION THEN 92001000 C 0569 + BEGIN 92002000 C 0569 + REPLACE POINTER(XREFLINE[*]) BY " " FOR 17 WORDS; 92003000 C 0569 + HEADING; 92004000 C 0574 + SORT(PRINTXREF,XREFFILE,0,XREFMAX,XREFCOMPARE,3,1000,6000); 92005000 C 0594 + END; 92006000 C 0614 + END OF B5700 PASCAL COMPILER COMPILER................................... 99001000 C 0614 + 2 IS 620 LONG, NEXT SEG 1 + START OF SEGMENT ********** 46 + 46 IS 4 LONG, NEXT SEG 1 + 1 IS 2 LONG, NEXT SEG 0 + 62 IS 69 LONG, NEXT SEG 0 +NUMBER OF ERRORS DETECTED = 0. COMPILATION TIME = 368 SECONDS. +PRT SIZE = 280; TOTAL SEGMENT SIZE = 15719 WORDS; DISK SIZE = 720 SEGS; NO. PGM. SEGS = 62 +ESTIMATED CORE STORAGE REQUIRED = 26034 WORDS. +ESTIMATED AUXILIARY MEMORY REQUIRED = 0 WORDS. +NUMBER OF CARD-IMAGES PROCESSED = 3687. + + + + + + + LABEL 000000000LINE 00186197?RUN OBJECT/LISTER;FILE DISK=PASCAL SERIAL;END← OBJECT /LISTER diff --git a/PASCAL-Heriot-Watt/PATCHES.PASCAL.MKXV-Compile.lst b/PASCAL-Heriot-Watt/PATCHES.PASCAL.MKXV-Compile.lst new file mode 100644 index 0000000..4048a86 --- /dev/null +++ b/PASCAL-Heriot-Watt/PATCHES.PASCAL.MKXV-Compile.lst @@ -0,0 +1,7255 @@ + LABEL 000000000LINE 00186197?EXECUTE PATCH/MERGE PATCH /MERGE + + + + + + BURROUGHS B-5700 PATCH/MERGE PROGRAM MARK XV.3.00 WEDNESDAY, 07/16/86, 11:45 AM. + + + + + + INPUT +********** ********************************************************************************** + + + +$. 39 PATCHES FOR PASCAL WITH CONFLICTS +$*COMPILE PASCAL/NEW XALGOL LIBRARY +$*XALGOL STACK=800 +$*XALGOL FILE TAPE=SYMBOL/PASCAL SERIAL +$*XALGOL FILE NEWTAPE=SYMNEW/PASCAL SERIAL +$*XALGOL FILE LINE=LINE PRINT +$*DATA CARD +$- DOLLAR CARDS FOR COMPILATION +$ TAPE LIST SINGLE SEQXEQ NEW TAPE + + + + +$# PATCH 1 FOR PASCAL.XVI.O CONTAINS 10 CARDS. CORRECT SPELLING & TABULATION C 001 + + +$: PATCH TO CORRECT SPELLING IN SOME ERROR MESSAGES, CURRECT TABULATION OF CODE C 001 +$: OR COMMENTS, AND TO CORRECT THE CALL ON THE PROCEDURE TO GIVE A NEW PAGE. C 001 +$: *** NOTE THAT ERROR(71) IS NOW NO LONGER USED - SEE PATCH 513. C 001 +$: IS WAS USED ONCE, BUT INCORRECTLY. ERROR(63) IS CALLED IN ITS PLACE. C 001 +$: *** NOTE THAT THE ALGOL CODE FILE "PASCRUN"/"DISK" HAS BEEN RENAMED C 001 +$: "PASCAL"/"PRELUDE". IT IS NO LONGER REFERENCED DIRECTLY IN THIS COMPILER C 001 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 001 +$: C 001 + BEGIN ; % NULL %*** 4) REWRITE 50203000 C 001 + GEN("PUT",3,5); %*** 5) PAGE 50204000 C 001 + GEN("PPAGE",5,3); % 50208000 C 001 + BLOCK; %*** COMPILE PROCEDURE BODY *** 80646000 C 001 + COMPSTAT; %*** COMPILE STATEMENT PART *** 80691000 C 001 + (" 41 ALFA CONSTANTS MAY NOT BE LONGER THAN 7 CHARACTERS."), 91045000 C 001 + (" 55 PROCEDURE NESTING DEPTH + NO OF RECORDS IS TOO GREAT."), 91060000 C 001 + (" 87 END-OF-INPUT ENCOUNTERED UNEXPECTEDLY."), 91094000 C 001 + (" 97 TOO MANY FILES IN USE."), 91104000 C 001 +END OF B5700 PASCAL COMPILER............................................99001000 C 001 + + + + +$# PATCH 2 FOR PASCAL CONTAINS 171 CARDS. C 002 + + +$: PATCH TO MERGE DAG LANGMYHRS PPP10 TO PPP11 COSY PATCHES C 002 +$: WITH NILS OTTES MODIFIED PPP10 SOURCE. C 002 +$: DAVID A COOPER , HERIOT-WATT UNIVERSITY, JANUARY 1978. C 002 +$: C 002 +FILE CARD "SOURCE" (1,10,30); % SOURCE CODE FILE 10035000 C 002 +FILE LINES 1 (1,17); % PRINT FILE 10036000 C 002 +FILE PASCALGOL DISK SERIAL [20:600] (1,10,30,SAVE 0); % CODE FILE 10037000 C 002 +ARRAY PARAMTAB, FORWPARAM1, FORWPARAM2[0:MAXPARAMS]; 10109000 C 002 +FILE XREFFILE DISK SERIAL [20:3000] (1,3,30); 10137000 C 002 +ALPHA ARRAY XBUFF[0:2]; 10138500 C 002 +BOOLEAN XINB; 10138550 C 002 +INTEGER ARRAY SYMKIND[0:62]; %USED IN ERROR RECOVERY. 10149000 C 002 + ERROR100MESS (//"100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION10188500 C 002 +. THE VALUE 07 IS SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT TH10188600 C 002 +E COMPILATION ERRORS COUNT."//),% 10188700 C 002 + PACKEDSY=61#, ASSERTSY=62#; 10211000 C 002 +% 20181500 C 002 +% 20181550 C 002 + IF ERRNUM=100 20181600 C 002 + THEN NUMERRS:=NUMERRS-1;% * ERROR NUMBER 100 ALONE SHOULD NOT 20181650 C 002 +% * PREVENT THE XALGOL COMPILATION BEING 20181700 C 002 +% * ZIPPED AS THE VALUE 7 IS SUBSTITUTED 20181750 C 002 +% * FOR A BAD SAVE CONSTANT IN AN "S" 20181800 C 002 +% * OPTION. 20181850 C 002 +% 20181900 C 002 +% 20181950 C 002 + 7(INITIAL),MIDDLE,INITIAL; 20308000 C 002 + "400READ", "6READLN", "50RESET", "6UNPACK", "50WRITE", 20373000 C 002 + "6QQJZXL" DO 20373500 C 002 + IF DECL THEN AX := -AX; 20520000 C 002 + ABS(A[2]) LEQ ABS(B[2]); 20539000 C 002 +% 20541100 C 002 +% 20541150 C 002 +% 20541200 C 002 +BOOLEAN PROCEDURE XREFINPUT(A); 20541250 C 002 +ARRAY A[0]; 20541300 C 002 +BEGIN 20541350 C 002 + LABEL EOF; 20541400 C 002 + INTEGER I; 20541450 C 002 +% 20541500 C 002 + READ(XREFFILE,3,XBUFF[*])[EOF]; 20541550 C 002 + FOR I:=0,1,2 DO 20541600 C 002 + A[I] := XBUFF[I]; 20541650 C 002 + IF FALSE THEN EOF: BEGIN 20541700 C 002 + CLOSE(XREFFILE,RELEASE); 20541750 C 002 + XINB := TRUE; 20541800 C 002 + END; 20541850 C 002 + XREFINPUT := XINB; 20541900 C 002 +% 20541950 C 002 +END OF XREFINPUT; 20541960 C 002 + A2 := -A2; 20570000 C 002 +BOOLEAN LPARFOUND,SAVEXREFOPT; 20842000 C 002 + SAVEXREFOPT := XREFOPTION; XREFOPTION := FALSE; 20847500 C 002 + IF SAVEXREFOPT THEN NEWXREF(CURNAME1,CURNAME2,THISLEVEL, 20861500 C 002 + FALSE); 20861550 C 002 + XREFOPTION := SAVEXREFOPT; 20868500 C 002 +% ASSERT 62 ASSERTSY INITIAL 30075500 C 002 + IF CURNAME1="6ASSERT" THEN ASSERTSY ELSE 30165500 C 002 + END% 30280000 C 002 +% 30280025 C 002 +% 30280050 C 002 +% THE FOLLOWING LINES DECODE ANY OCCURRENCE OF THE "S" OPTION AND 30280075 C 002 +% SETS THE GLOBAL INTEGER VARIABLE "SAVEFACTOR" WHICH CONTROLS THE 30280100 C 002 +% TYPE OF COMPILATION INITIATED BY THE ZIP. THERE ARE THREE LEGAL FORMS 30280125 C 002 +% OF THE "S" OPTION AS FOLLOWS.- 30280150 C 002 +% 30280175 C 002 +% "S-" WILL GIVE NO ZIP IE. PASCAL SYNTAX CHECK ONLY 30280200 C 002 +% "S+" WILL GIVE A ZIP FOR COMPILE AND GO 30280225 C 002 +% "S??" WILL GIVE A ZIP FOR COMPILE TO LIBRARY 30280250 C 002 +% WHERE ?? IS THE TWO DIGIT DECIMAL SAVE 30280275 C 002 +% CONSTANT GIVEN THE OBJECT CODE FILE 30280300 C 002 +% NB. IF THE SAVE CONSTANT IS TO BE 30280325 C 002 +% LESS THAN 10 THE FIRST DIGIT 30280350 C 002 +% MUST BE INCLUDED IE. A "0". 30280375 C 002 +% 30280400 C 002 +% 30280425 C 002 + ELSE 30280450 C 002 + IF CX="S" THEN 30280475 C 002 + BEGIN 30280500 C 002 + IF C="-" THEN SAVEFACTOR:=-1 ELSE 30280525 C 002 + IF C="+" THEN SAVEFACTOR:= 0 ELSE 30280550 C 002 + IF C LEQ 9 THEN 30280575 C 002 + BEGIN 30280600 C 002 + SAVEFACTOR := 10 × C; NEXTCHAR; 30280625 C 002 + SAVEFACTOR := SAVEFACTOR + C; 30280650 C 002 + IF C GTR 9 THEN ERROR(100); 30280675 C 002 + END 30280700 C 002 + ELSE 30280720 C 002 + BEGIN 30280735 C 002 + ERROR(100); 30280750 C 002 + SAVEFACTOR := 7; 30280765 C 002 + END; 30280780 C 002 + END; 30280800 C 002 +% 30280825 C 002 +% 30280850 C 002 +% 30280875 C 002 +INTEGER EXPRLEVEL,TX,EXPINVARCNT;% 40018000 C 002 + BOOLEAN INBRACKET,INRECORD,SIMPLEVAR; 40087000 C 002 + SIMPLEVAR := FALSE; 40099000 C 002 + CURTYPE := THISID.TYPE; SIMPLEVAR := TRUE; 40104000 C 002 + SIMPLEVAR := FALSE; 40109000 C 002 + EXPINVARCNT:=EXPINVARCNT+1;% 40120500 C 002 + EXPINVARCNT:=EXPINVARCNT-1;% 40121500 C 002 + SIMPLEVARIABLE := SIMPLEVAR; 40199500 C 002 + IF EXPINVARCNT=0 THEN WRITEEXPR; % 40751000 C 002 + LABEL EFH; 50201500 C 002 + %*** 6) OPEN & CLOSE (INPUT) FOR 50204500 C 002 + % CUMULATIVE FREQUENCY COUNT50204550 C 002 + BEGIN 50208100 C 002 + GEN("QQJZXL",6,2); 50208200 C 002 + INSYMBOL; 50208300 C 002 + GO TO EFH; % 50208400 C 002 + END; 50208500 C 002 +EFH: 50219500 C 002 + EXPRLEVEL := 1; 60346500 C 002 + IF THISID.IDCLASS=VAR OR 60354000 C 002 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN % 60354500 C 002 + EXPRLEVEL := 0; 60383500 C 002 +PROCEDURE ASSERTSTAT; 60391100 C 002 +BEGIN 60391200 C 002 + GEN("IF NOT(",7,1); 60391400 C 002 + INSYMBOL; BOOLEXPR; 60391500 C 002 + GEN(") THEN",7,2); GEN("RUNERR(",7,1); GEN("7,",2,6); 60391600 C 002 + GENINT(CARDCNT); GEN(")",1,7); 60391700 C 002 +END OF ASSERTSTAT; 60391800 C 002 + IF CURNAME1="6QQJZXL" THEN FILEHANDLING(6) ELSE 60443500 C 002 + IF CURSY=ASSERTSY THEN ASSERTSTAT ELSE 60457500 C 002 + IF PARAM THEN GEN("0",1,7) ELSE BEGIN 80129000 C 002 + GEN("0:",2,6); 80129100 C 002 + GENINT(RECSIZE-1); 80129200 C 002 + END 80129300 C 002 + FORWPARAM1[NUMPARAMS] := CURNAME1; 80177500 C 002 + FORWPARAM2[NUMPARAMS] := CURNAME2; 80177600 C 002 + INTEGER INDEX, CTYPE, NUMFORWARDS, T, TX, I; 80403000 C 002 + ALPHA T3; 80403500 C 002 + LABEL LL1; % 80447010 C 002 + LABEL LL2; % 80496010 C 002 + LABEL LL3; % 80542010 C 002 + IF CURLEVEL GEQ MAXTABLES THEN ERROR(101) ELSE 80543500 C 002 + BLOCKTAB[CURLEVEL+1] := NUMBLOCKS := NUMBLOCKS + 1; 80543600 C 002 + NAMETAB3[CURLEVEL,THISINDEX].FORWARDDEF := 0; 80553000 C 002 + T := NAMETAB3[CURLEVEL,THISINDEX].INFO; 80554500 C 002 + TX := T + PARAMTAB[T]; 80554600 C 002 + FOR I:=T+1 STEP 1 UNTIL TX DO 80554700 C 002 + NEWNAME(FORWPARAM1[I],FORWPARAM2[I],CURLEVEL+1); 80554800 C 002 + REPLACE POINTER(NAMETAB1[CURLEVEL+1,*]) BY 0 80637500 C 002 + FOR MAXNAMES+1 WORDS; 80637600 C 002 + IF CURLEVEL GEQ LASTREC THEN ERROR(101); % 80643000 C 002 +% 90014100 C 002 +% 90014200 C 002 +SAVEFACTOR:=0;% * DEFAULT ZIP IS COMPILE AND GO UNLESS 90014300 C 002 +% * CHANGED BY THE USE OF THE "S" OPTION 90014400 C 002 +% 90014500 C 002 +% 90014600 C 002 +% 90042100 C 002 +% THE FOLLOWING LINES ADD A "0" ONTO THE FRONT OF THE PROGRAM NAME OR90042200 C 002 +% THE FIRST SIX CHARACTERS THEREOF IF IT IS LONGER THAN SIX CHARACTERS 90042300 C 002 +% THUS GIVING THE NAME OF THE XALGOL OBJECT CODE FILE PRODUCED. 90042400 C 002 +% 90042500 C 002 + PROGNAME := CURNAME1.[35:36]; PROGNAMELENGTH := MIN(6,CURLENGTH)+1;90042600 C 002 +% 90042700 C 002 +% 90042800 C 002 +BEGIN% 90090400 C 002 + WRITE(LINE ,NOERRORS);% 90090500 C 002 + IF ERR[100]% 90090600 C 002 + THEN WRITE(LINE ,ERROR100MESS);% 90090700 C 002 + IF SAVEFACTOR≥0 THEN% *A ZIP IS REQUIRED 90090800 C 002 +$VOIDT 90111000 C 002 +END% 90129500 C 002 + ("100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION. THE VALUE 07 IS91106500 C 002 +SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT THE COMPILATION ERRO91106600 C 002 +RS COUNT."),% 91106700 C 002 + ("101 PROCEDURES/FUNCTIONS NESTED TOO DEEP."), 91106800 C 002 + REWIND(XREFFILE); 92003500 C 002 + SORT(PRINTXREF,XREFINPUT,0,XREFMAX,XREFCOMPARE,3,1000,6000); 92005000 C 002 + + + + +$# PATCH 500 FOR PASCAL.XVI.O CONTAINS 5 CARDS. PRT CELLS 25 TO 30 C 500 + + +$: THIS PATCH CORRECTS THE DOCUMENTATION FOR THE COMPILERS PRT CELLS 25 TO 27 C 500 +$: (NOT 21 TO 23). FURTHERMORE. IT USES PRT CELL 30 FOR THE CARD COUNT (IN PLACE C 500 +$: OF 27) TO BE CONSISTANT WITH THE OTHER SYSTEM COMPILERS. PRT CELL 27 IS USED C 500 +$: FOR THE PAGE COUNT FORMERLY AT SEQUENCE 10134000. C 500 +$: NILS OTTE, UNIVERISTY OF NATAL, DURBAN. AUG - NOV 1977. C 500 +$: C 500 +INTEGER NUMERRS, % @R+25: NUMBER OF ERRORS IN PROGRAM. 10029000 C 500 + SAVEFACTOR, % @R+26: SAVEFACTOR FOR CODE FILE. 10030000 C 500 + PAGECNT, % @R+27: NUMBER OF PAGES PRINTED. 10033800 C 500 + CARDCNT; % @R+30: NUMBER OF CARDS READ. 10034000 C 500 + INTEGER LINECNT, ERRINX; % PAGECNT @ PRT+27 10134000 C 500 + + + + +$# PATCH 501 FOR PASCAL.XVI.O CONTAINS 3 CARDS. "PRT25" FOR USER-S PASCAL PROG. C 501 + + +$: THIS PATCH INCORPORATES THE PRE-DEFINED IDENTIFIER "PRT25" LOCATED C 501 +$: AT PRT CELL 25 AS PER DOCUMENTATION. (THE DOCUMENTATION MUST BE C 501 +$: AMENDED TO DELETE PRT26 AND PRT27 FROM THE PRE-DEFINED IDENTIFIER LIST.) C 501 +$: ** NOTE THAT FILE PASCAL/PRELUDE MUST BE UPDATED FOR "PRT25". C 501 +$: THE VARIABLE "PRT25" MAY BE SET BY THE Q COMMON = N CONTROL CARD. C 501 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 501 +$: C 501 + NEWNAME("50PRT25",0,0); %*** "PRT25" *** 20369100 C 501 + T3:=INTTYPE; T3.IDCLASS:=VAR; % GLOBAL INTEGER VARIABLE 20369200 C 501 + NAMETAB3[0,THISINDEX] := T3; 20369300 C 501 + + + + +$# PATCH 502 FOR PASCAL.XVI.O CONTAINS 3 CARDS. LINE COUNT WHEN DEBUGGING C 502 + + +$: TO CORRECT THE LINE COUNT WHEN THE DEBUGGING OPTION TO LIST THE ALGOL C 502 +$: CODE GENERATED IS SET (*$D+ *), OTHERWISE LINES PER PAGE GOES WRONG. C 502 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 502 +$: C 502 +DEFINE LINESPERPAGE = 60 #, 10038000 C 502 + IF DUMPOPTION THEN BEGIN IF (LINECNT:=LINECNT+1)≥LINESPERPAGE 20149000 C 502 + THEN HEADING; WRITE(LINE,10,ALGOLCARD[*]) END; 20149100 C 502 + + + + +$# PATCH 503 FOR PASCAL.XVI.O CONTAINS 9 CARDS. INTEGER TO REAL FOR TYPETAB1 C 503 + + +$: WHEN MORE THAN 63 ENTRIES WERE ENTERED IN THE "TYPETAB*" ARRAYS, THE C 503 +$: PASCAL COMPILER WAS DISCONTINUED DUE TO INTEGER OVERFLOW, WHICH COULD OCCUR C 503 +$: IN A NUMBER OF PROCEDURES AS A RESULT OF ASSIGNING TO AN INTEGER AN ARRAY C 503 +$: ELEMENT WHOSE EXPONENT FIELD WAS NOT ZERO. THE FIELD "ARRTYPE" IS C 503 +$: [43:10] AND HAS THE 4 HIGH ORDER BITS IN THE EXPONENT FIELD. THIS PATCH C 503 +$: ALTERS THE DECLARATIONS OF ALL IDENTIFIER TO WHICH "TYPETAB1" MAY BE C 503 +$: ASSIGNED FROM INTEGER TO REAL TO CORRECT THIS ERROR. C 503 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 503 +$: C 503 + INTEGER IT; REAL T; 50225000 C 503 + INTEGER IT; REAL T; 50285000 C 503 + INTEGER CASETYPE,ADDR,MAXADDR,INDEX,CTYPE,TX,SX, T3,LLIM,ULIM,I; 70244000 C 503 + REAL T1, CVAL; 70246000 C 503 + INTEGER LEVEL1000, TYP, NAM, NAMTAB, I, J, RECSIZE; 80020000 C 503 + ALPHA T1, FNAME; 80022000 C 503 + INTEGER FIRSTPARAM, CURKIND, P1, PX, I, T3; REAL T; 80148000 C 503 + INTEGER INDEX, CTYPE, NUMFORWARDS, T3, TX, I; 80403000 C 503 + REAL T, CVAL; 80404000 C 503 + + + + +$# PATCH 504 FOR PASCAL.XVI.O CONTAINS 23 CARDS. IMPLEMENT FORWARD DECLARATIONS C 504 + + +$: FORWARD DECLARATIONS OF PROCEDURES ENDED IN CHAOS DUE TO THE PARAMETERS AND C 504 +$: THEIR TYPES NOT BEING KEPT, RESULTING IN GLOBALS BEING REFERENCED WHERE C 504 +$: POSSIBLE, AND FORWARD DECLARATIONS OF FUNCTIONS DID NOT WORK AT ALL. C 504 +$: THE PROBLEM WAS THAT THE INFORMATION ON THE PARAMETERS WAS BEING STORED C 504 +$: IN THE "NAMETAB*" ROWS FOR THE CURRENT LEVEL, WHICH WERE BEING SET TO ZERO C 504 +$: ON EXIT FROM PROCEDURE BLOCKS AT THAT LEVEL THEREAFTER. C 504 +$: THIS PATCH CORRECTS THE ERROR BY MARKING THE ENTRIES FOR PARAMETERS OF C 504 +$: FORWARD PROCEDURES AND FUNCTIONS, SETTING TO ZERO ONLY THOSE ELEMENTS WHICH C 504 +$: ARE NOT SO MARKED ON EXIT FROM A BLOCK, AND UNMARKING THE RELEVANT PARAMETERS C 504 +$: WHEN THE PROCEDURE OR FUNCTION IS DEFINED. THE MARKING OF THE PARAMETERS C 504 +$: IS DONE IN SUCH A WAY THAT THE SAME IDENTIFIER NAME MAY BE USED AT THE SAME C 504 +$: LEVEL WITHOUT SYNTAX ERROR 2 TO REPORT THAT THE IDENTIFIER IS ALREADY DEFINED C 504 +$: THE UNMARKING REPLACES THE IDENTIFIER NAME IN "NAMETAB*" TO ALLOW FOR THE C 504 +$: SAME NAME OR ONE THAT HASHES TO THE SAME PLACE TO HAVE BEEN USED PREVIOUSLY C 504 +$: AND NOW DELETED. C 504 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 504 + IF FOUND AND THISID.IDCLASS≥FUNC THEN 80548000 C 504 + NAMETAB3[CURLEVEL,THISINDEX].FORWARDDEF:=0; 80553000 C 504 + (THISID.IDCLASS=FUNC AND NOT FUN) THEN ERROR(43); 80555100 C 504 + TX:=(T:=THISID.INFO)+PARAMTAB[T]; % UNMARK FORWARD PARMS 80556000 C 504 + FOR I:=T+1 STEP 1 UNTIL TX DO % TO ALLOW REFERENCE 80557000 C 504 + BEGIN T3:=PARAMTAB[I].PARAMNAME; 80558000 C 504 + CURNAME1:=ABS(NAMETAB1[CURLEVEL+1,T3]); 80559000 C 504 + CURNAME2:= NAMETAB2[CURLEVEL+1,T3]; 80560000 C 504 + NAMETAB1[CURLEVEL+1,T3]:=0; 80561000 C 504 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL+1); 80562000 C 504 + IF T3≠THISINDEX THEN BEGIN 80563000 C 504 + PARAMTAB[I].PARAMNAME:=THISINDEX; 80564000 C 504 + NAMETAB3[CURLEVEL+1,THISINDEX] := 80565000 C 504 + NAMETAB3[CURLEVEL+1,T3]; 80565010 C 504 + END END; % OF UNMARKING FORWARD PARAMETERS. 80566000 C 504 + TX:=(T:=NAMETAB3[CURLEVEL,INDEX].INFO)+PARAMTAB[T]; 80636100 C 504 + FOR I:=T+1 STEP 1 UNTIL TX DO % MARK FORWARD PARAMETERS 80636200 C 504 + NAMETAB1[CURLEVEL+1,PARAMTAB[I].PARAMNAME].[46:1] := 1; 80636210 C 504 + TX:=CURFUNC; CURFUNC:=IF FUN THEN INDEX ELSE -1; 80645000 C 504 + FOR I:=0 STEP 1 UNTIL MAXNAMES DO % LEAVE FORWARD PARAMETERS 80647000 C 504 + IF NAMETAB1[CURLEVEL,I]>0 THEN NAMETAB1[CURLEVEL,I]:=0; 80648000 C 504 + CURLEVEL:=CURLEVEL-1; CURFUNC:=TX; 80649000 C 504 + FOR I:=LASTREC STEP 1 UNTIL TOPREC-1 DO % CLEAR RECORD DECS 80693000 C 504 + + + + +$# PATCH 505 FOR PASCAL.XVI.O CONTAINS 9 CARDS. CHECK FOR HASH TABLE FULL C 505 + + +$: WHEN THERE ARE "MAXNAMES" IDENTIFIERS AT ONE LEVEL, THE "NAMETAB*" ROWS C 505 +$: BECOME FULL AND THIS USED TO PUT THE COMPILER INTO AN INFINITE LOOP, C 505 +$: EITHER IN "NEWNAME" OR "SEARCHTAB". THIS PATCH INSERTS TEST FOR WRAP AROUND C 505 +$: LEADING BACK TO THE HASHED STARTING POINT, FOR WHICH IT GIVES SYNTAX ERROR C 505 +$: 40, TOO MANY IDENTIFIERS DECLARED. C 505 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 505 +$: C 505 +DEFINE HASH(HASH1) = ENTIER((HASH1) MOD MAXNAMES) #; 20202000 C 505 +BEGIN ALPHA TNAME; INTEGER WRAPAROUND; 20209000 C 505 + WRAPAROUND:=THISINDEX:=HASH(CURNAME1); 20210000 C 505 + IF THISINDEX=WRAPAROUND THEN TNAME:=0; % TABLE IS FULL 20216100 C 505 + ALPHA TNAME; INTEGER WRAPAROUND; 20237100 C 505 + WRAPAROUND:=THISINDEX:=HASH(NAME1); 20238000 C 505 + IF THISINDEX=WRAPAROUND THEN % TABLE AT THIS LEVEL IS FULL 20244100 C 505 + BEGIN ERROR(40); NAME1:=TNAME; NAME2:=NAMETAB2[TAB,THISINDEX]20244200 C 505 + END; 20244300 C 505 + + + + +$# PATCH 506 FOR PASCAL.XVI.O CONTAINS 2 CARDS. RESERVED WORD ENDING AT CC 80 C 506 + + +$: IF A RESERVED WORD ENDED AT CARD COLUMN 79 OR 80 AND IF THE "BOLDFACE" FOR C 506 +$: RESERVED WORDS OPTION IS SET (*$R+ *), AN INVALID INDEX OCCURRED IN THE C 506 +$: SCANNER "INSYMBOL". THE PROBLEM IS CURED BY CORRECTLY COMPUTING THE STARTING C 506 +$: AND ENDING POINT OF THE RESERVED WORDS. C 506 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 506 +$: C 506 + BEGIN T1 := CARDLENGTH-CHARCNT-CURLENGTH-1; 30178000 C 506 + FOR CURLENGTH+REAL(CHARCNT=0); 30181000 C 506 + + + + +$# PATCH 507 FOR PASCAL.XVI.O CONTAINS 5 CARDS. "VARIABLE", "SIMPLEVARIABLE" C 507 + + +$: IN PROCEDURE "VARIABLE", "SIMPLEVARIABLE" IS SET TRUE IF A SUBSCRIPT IS C 507 +$: SIMPLE, RESULTING IN ALGOL CODE BEING WRITTEN PREMATURELY DURING RECURSIVE C 507 +$: CALLS ON PROCEDURE "EXPRESSION", WHICH IN SOME CASES LEAD TO ALGOL SYNTAX C 507 +$: ERRORS. SINCE WRITING THE ALGOL CODE IS DEPENDANT ON "EXPRLEVEL" BEING ZERO, C 507 +$: THIS PATCH BUMPS ITS VALUE PRIOR TO ANALYSING THE SUBSCRIPT, AND SETS C 507 +$: "SIMPLEVARIABLE" FALSE AFTERWARDS. C 507 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 507 +$: C 507 + EXPRLEVEL := EXPRLEVEL+1; % DO NOT "WRITEEXPR" YET 40120900 C 507 + EXPRLEVEL := EXPRLEVEL-1; 40121100 C 507 + SIMPLEVARIABLE := FALSE; % RECURSION ON "VARIABLE" 40121200 C 507 + EXPRLEVEL := EXPRLEVEL+1; 60063900 C 507 + EXPRLEVEL := EXPRLEVEL-1; 60065100 C 507 + + + + +$# PATCH 509 FOR PASCAL.XVI.O CONTAINS 1 CARD. "CONCAT" A FUNCTION OF ANY TYPE C 509 + + +$: THE INTRINSIC FUNCTION "CONCAT" COULD ONLY BE ASSIGNED TO A VARIABLE DECLARED C 509 +$: "REAL" TO AVOID TYPE CONFLICT SYNTAX ERRORS. THIS PATCH MAKES "CONCAT" C 509 +$: TYPELESS. C 509 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 509 +$: C 509 + CURTYPE := 0; % ALFATYPE OR REALTYPE 50050000 C 509 + + + + +$# PATCH 511 FOR PASCAL.XVI.O CONTAINS 7 CARDS. ALLOW UP-LEVEL ADDRESSING C 511 + + +$: TO ALLOW UP-LEVEL IDENTIFIER REFERENCES. FORMERLY, REFERENCES TO GLOBAL C 511 +$: IDENTIFIERS WHICH WERE NOT IN THE OUTER BLOCK WERE FLAGGED BY SYNTAX ERROR C 511 +$: 5, UP-LEVEL ADDRESSING NOT IMPLEMENTED DUE TO HARDWARE RESTRICTION. C 511 +$: ALTHOUGH THE RESTRICTION EXISTS IN EXTENDED ALGOL, IT IS NOT TRUE THAT THE C 511 +$: RESTRICTION IS DUE TO HARDWARE, FOR UP-LEVEL ADDRESSING IS ALLOWED IN C 511 +$: COMPATIBLE ALGOL WITH THE CAUTION THAT IT IS INEFFICIENT (THE IMPLEMENTATION C 511 +$: IS SIMILAR TO AN ARRAY ELEMENT REFERENCE). C 511 +$: THIS PATCH PERMITS SUCH GOBAL REFERENCES, EXCEPT C 511 +$: (1) THAT IF THE CONTROL VARIABLE OF A FOR STATEMENT IS NOT LOCAL OR IN THE C 511 +$: OUTER BLOCK (PTR) A WARNING IS ISSUED (IN THE FORM OF A SYNTAX ERROR, C 511 +$: BUT THE ERROR COUNT IS NOT INCREMENTED), AND C 511 +$: (2) THE RESTRICTION IS STILL APPLIED TO FUNCTION NAMES. THE MESSAGE FOR C 511 +$: SYNTAX ERROR IS AMENDED ACCORDINGLY. C 511 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 511 +$: C 511 + IF ERRNUM<0 THEN ERRNUM:=ABS(ERRNUM) ELSE 20180900 C 511 +$ %IF THISLEVEL>1 AND THISLEVEL1 AND THISLEVEL≠CURLEVEL THEN ERROR5; 50244000 C 511 +$ %IF THISLEVEL>1 AND THISLEVEL≠CURLEVEL THEN ERROR5; 50306000 C 511 + IF THISLEVEL≠CURLEVEL-1 OR THISINDEX≠CURFUNC THEN ERROR(5); 60091000 C 511 + IF THISLEVEL>1 AND THISLEVEL0 DO 60025000 C 512 + BEGIN NUMPOINTERS := NUMPOINTERS-1; 60026000 C 512 + IF NUMSYMS+4 ≥ MAXSYMS THEN WRITEEXPR; 60027000 C 512 + REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY 60028000 C 512 + "00-1)DIV00 1022,00 T MOD00 1022]"; 60029000 C 512 + NUMSYMS := NUMSYMS+4; 60030000 C 512 + END; % OF WHILE 60031000 C 512 + WRITEEXPR; GEN( ",", 1,7 ); 60032000 C 512 + END WRITESEXPR; 60033000 C 512 + 60034000 C 512 + %ERROR(95); % STRUCTURED ASSIGNMENT NOT IMPLEMENTED. 60063000 C 512 + GEN("ASSIGN(",7,1); WRITESEXPR; 60064000 C 512 + EXPRESSION; WRITESEXPR; 60065000 C 512 + GENINT(TYPETAB1[LEFTTYPE].SIZE); GEN(")",1,7); 60066000 C 512 + IF TYPETAB1[LEFTTYPE].SIZE≠TYPETAB1[CURTYPE].SIZE 60067000 C 512 + THEN ERROR(95); 60068000 C 512 + END; 60087000 C 512 + CHECKTYPES( LEFTTYPE, CURTYPE ); 60088000 C 512 + (" 95 SIZE OF STRUCTURES IN ASSIGNMENT ARE NOT THE SAME."), 91102000 C 512 + + + + +$# PATCH 513 FOR PASCAL.XVI.O CONTAINS 16 CARDS. FIX POINTERS VIA POINTERS C 513 + + +$: TO CORRECT THE CODE GENERATED FOR CHAINED REFERENCES THROUGH THE HEAP, C 513 +$: IE FOR POINTERS TO POINTERS. THE OFFSET FOR COMPONENTS WITHIN RECORDS C 513 +$: WAS INCORRECTLY BEING ADDED TO THE RECORD IN THE LEFTMOST REFERENCE, IE THE C 513 +$: INNERMOST, INSTEAD OF AT THE EXPECTED LEVEL. C 513 +$: FOR EXAMPLE, THE FOLLOWING TWO REFERENCES WOULD BOTH BE TRANSLATED TO C 513 +$: THE SAME ALGOL CODE EQUIVALENT TO HEAP[HEAP[ID+IPART+ICOMP]]; C 513 +$: ID@.PART@.COMP, ID@.PART.COMP@, C 513 +$: WHEN THE FIRST SHOULD HAVE BEEN: HEAP[HEAP[ID+IPART]+ICOMP]. C 513 +$: IN ADDITION, THIS PATCH IMPROVES THE COMPILERS CODE FOR GENERATING THE C 513 +$: "MEM" ARRAY SUBSCRIPT. C 513 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. 1977-11-14 C 513 +$: C 513 + IF NUMSYMS+6 ≤ MAXSYMS THEN 40175000 C 513 + NUMSYMS := NUMSYMS+2; 40180400 C 513 + IF NUMPOINTERS > 0 % POINTER VIA POINTER 40180500 C 513 + THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY 40180600 C 513 + "00-1)DIV00 1022,00 T MOD00 1022]"; 40180700 C 513 + NUMSYMS := NUMSYMS+4; 40180800 C 513 + END 40180900 C 513 + ELSE NUMPOINTERS := 1; 40181000 C 513 + % INBRACKET := FALSE; 40191100 C 513 + BEGIN NUMPOINTERS := NUMPOINTERS-1; 40193000 C 513 + IF NUMSYMS+4 ≤ MAXSYMS 40194000 C 513 + THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY 40194100 C 513 + "00-1)DIV00 1022,00 T MOD00 1022]"; 40194200 C 513 + NUMSYMS := NUMSYMS+4; 40194300 C 513 + END 40194400 C 513 + ELSE ERROR(63); % EXPRESSION IS TOO LONG FOR SYMTAB[*] 40195000 C 513 + + + + +$# PATCH 514 FOR PASCAL.XVI.O CONTAINS 2 CARDS. PROCESS TIME FUNCTION FOR RUN C 514 + + +$: PATCH TO CHANGE THE NAME OF THE FUNCTION ON THE B5700 VERSION WHICH SUPPLIES C 514 +$: THE PROCESS TIME USED BY THE PASCAL PROGRAM ON THE CURRENT RUN FROM "ELAPSED" C 514 +$: WHICH MEANS PLATFORM TIME, TO "CPUTIME" WHICH IS THE WIDELY ACCEPTED TERM C 514 +$: FOR THIS QUANTITY. C 514 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 514 +$: C 514 + NEWNAME("7CPUTIM","E",0); NAMETAB3[0,THISINDEX]:=T3; 20390000 C 514 + IF CURNAME1="7CPUTIM" AND CURNAME2="E" THEN % "CPUTIME" 40452000 C 514 + + + + +$# PATCH 516 FOR PASCAL.XVI.O. CONTAINS 2 CARDS. CORRECT "NO LISTING" ERROR C 516 + + +$: THIS PATCH CORRECTS AN ERROR WHEREBY IF LISTING WAS TURNED OFF C 516 +$: AND PAGE THROW WAS INVOKED, A HEADING WAS PRINTED REGARDLESS. C 516 +$: DAVID A COOPER, HERIOT-WATT UNIVERSITY.....JUNE, 1978. C 516 +$: C 516 + IF CX="L" THEN IF C=1 THEN 30264000 C 516 + IF LISTOPTION THEN HEADING ELSE 30264500 C 516 + + + + +$# PATCH 517 FOR PASCAL.XVI.O. CONTAINS 2 CARD. C 517 + + +$: THIS PATCH CORRECTS AN ERROR THAT CAUSED A FILE DECLARATION C 517 +$: TO HAVE ITS NAME STRING SPLIT OVER TWO LINES IN THE GENERATED XALGOL. C 517 +$: ALSO CHANGES SYMTAB FORM TYPE REAL TO TYPE ALPHA. C 517 +$: DAVID A COOPER, HERIOT-WATT UNIVERSITY.....JUNE, 1978. C 517 +$: C 517 +ALPHA ARRAY SYMTAB[0:MAXSYMS]; % USED BY "EXPRESSION". 10144000 C 517 + IF ALGOLCNT LSS 14 THEN WRITEALGOL; 80103000 C 517 + + + + +$# PATCH 518 FOR PASCAL.XVI.O. CONTAINS 224 CARDS. C 518 + + +$: THIS PATCH CHANGES THE WAY THAT MULTI-DIMENSION ARRAYS C 518 +$: REPRESENTING RECORDS ARE DECLARED. PREVIOSLY THEY WRE DECLARED C 518 +$: THE WRONG WAY ROUND FOR XALGOL. THIS PATCH SORTS THE DIMENSIONS C 518 +$: INTO ASCENDING ORDER FORM LEFT TO RIGHT AND GENERATES APPROPRIATE C 518 +$: DEFINES AND CODE FOR HANDLING THE ARRAYS. C 518 +$: STUART ANDERSON, COMPUTER SCIENCE, HERIOT-WATT UNIVERSITY, JUNE.....1978. C 518 +$: C 518 + DEFINE 10156200 C 518 + PERMSUB = 0 #, MAXTOTALSUBSCRS = 100#, 10156300 C 518 + ARRNAM = 1 #; 10156400 C 518 + ARRAY ARRSUBPERMTAB[0:1,0:MAXTOTALSUBSCRS]; 10156500 C 518 + INTEGER PASSPERMTAB, MAXPERMTAB, REMEMBERPOSN; 10156600 C 518 +$ 40080000 C 518 + BOOLEAN SIMPLEVARIABLE,INSIDEBRACKETS,INSIDEPARENS; 40080100 C 518 +$ 40105000 C 518 + IF INSIDEPARENS AND TYPETAB1[CURTYPE].STRUCT > 0 AND 40105100 C 518 + TYPETAB1[CURTYPE].FORM < FILES THEN 40105200 C 518 + PUTID("H",1000×THISLEVEL+THISINDEX,5) 40105300 C 518 + ELSE 40105400 C 518 + PUTID("V",1000×THISLEVEL+THISINDEX,5); 40105500 C 518 + INSIDEPARENS := TRUE; 40258100 C 518 + INSIDEPARENS := FALSE; 40259100 C 518 +$ 50243000 C 518 + GENID("H",1000×THISLEVEL+THISINDEX,5); 50243100 C 518 +$ 50307000 C 518 + GENID("H",1000×THISLEVEL+THISINDEX,5); 50307100 C 518 +$SET VOIDT 80052000 C 518 +$POP VOIDT 80064000 C 518 + DEFINE 80064005 C 518 + LOWSUBS = 0 #, 80064010 C 518 + HISUBS = 1 #, 80064015 C 518 + NEXTSUBS= 2 #, 80064020 C 518 + MAXNOOFSUBSCRIPTS = 20 #, 80064025 C 518 + STOPPERSUBTAB = 21 #; 80064030 C 518 + ARRAY ARRSUBSCRIPTRANGE[0:2,0:MAXNOOFSUBSCRIPTS]; 80064035 C 518 + INTEGER FIRSTRANGE, NEXTFREEENTRY, PASSSUBRANGE, PREVPASS, 80064040 C 518 + MP, POSNO, SUBDIFF; 80064045 C 518 + IF ARRAYVAR THEN GEN(";",1,7) ELSE ARRAYVAR := TRUE; 80064050 C 518 + IF NOT PARAM THEN 80064055 C 518 + BEGIN 80064060 C 518 + GEN("DEFINE",7,2); 80064065 C 518 + GENID("V",LEVEL1000+NAM,5); 80064070 C 518 + GEN("[",1,7); 80064075 C 518 + END; 80064080 C 518 + FIRSTRANGE := STOPPERSUBTAB; NEXTFREEENTRY := 0; 80064085 C 518 + POSNO := 1; 80064090 C 518 + MP := 10; FIRSTDIM := TRUE; 80064095 C 518 + DO 80064100 C 518 + BEGIN 80064105 C 518 + IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE 80064110 C 518 + BEGIN 80064111 C 518 + IF NOT PARAM THEN GEN(",",1,7); 80064112 C 518 + END; 80064113 C 518 + IF NOT PARAM THEN GENID("V",(LEVEL1000+NAM)×MP+POSNO,IF MP=10 80064115 C 518 + THEN 6 ELSE 7); POSNO := POSNO + 1; 80064120 C 518 + IF POSNO = MP THEN MP := MP×10; 80064125 C 518 + IF NEXTFREEENTRY = STOPPERSUBTAB THEN 80064130 C 518 + BEGIN 80064135 C 518 + ERROR(0); 80064140 C 518 + END 80064145 C 518 + ELSE 80064150 C 518 + BEGIN 80064155 C 518 + ARRSUBSCRIPTRANGE[LOWSUBS,NEXTFREEENTRY]:=TYPETAB2[TYP]; 80064160 C 518 + ARRSUBSCRIPTRANGE[HISUBS,NEXTFREEENTRY] := TYPETAB3[TYP]; 80064165 C 518 + END; 80064170 C 518 + SUBDIFF := TYPETAB3[TYP] - TYPETAB2[TYP]; 80064175 C 518 + IF FIRSTRANGE = STOPPERSUBTAB THEN 80064180 C 518 + BEGIN 80064185 C 518 + FIRSTRANGE := NEXTFREEENTRY; 80064190 C 518 + NEXTFREEENTRY := NEXTFREEENTRY + 1; 80064195 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,FIRSTRANGE] := STOPPERSUBTAB; 80064200 C 518 + END 80064205 C 518 + ELSE 80064210 C 518 + BEGIN 80064215 C 518 + PASSSUBRANGE := FIRSTRANGE; 80064220 C 518 + PREVPASS := STOPPERSUBTAB; NEXTFREEENTRY:=NEXTFREEENTRY+1;80064225 C 518 + WHILE(SUBDIFF ≥ ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE] 80064230 C 518 + -ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE]) AND 80064235 C 518 + (ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] ≠ 80064240 C 518 + STOPPERSUBTAB) DO 80064245 C 518 + BEGIN 80064250 C 518 + PREVPASS := PASSSUBRANGE; 80064255 C 518 + PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS, 8006426 C 518 + PASSSUBRANGE]; 80064265 C 518 + END; 80064270 C 518 + IF PREVPASS = STOPPERSUBTAB THEN 80064275 C 518 + BEGIN 80064280 C 518 + IF SUBDIFF ≥ ARRSUBSCRIPTRANGE[HISUBS, 80064285 C 518 + PASSSUBRANGE] - 80064290 C 518 + ARRSUBSCRIPTRANGE[LOWSUBS, 80064295 C 518 + PASSSUBRANGE] THEN 80064300 C 518 + BEGIN 80064305 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] := 80064310 C 518 + NEXTFREEENTRY - 1; 80064315 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] := 80064320 C 518 + STOPPERSUBTAB; 80064325 C 518 + END 80064330 C 518 + ELSE 80064335 C 518 + BEGIN 80064340 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] := 80064345 C 518 + FIRSTRANGE; 80064350 C 518 + FIRSTRANGE := NEXTFREEENTRY-1; 80064355 C 518 + END 80064360 C 518 + END 80064365 C 518 + ELSE 80064370 C 518 + BEGIN 80064375 C 518 + IF SUBDIFF ≥ ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE] - 80064380 C 518 + ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE] 80064385 C 518 + THEN 80064390 C 518 + BEGIN 80064395 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] := 80064400 C 518 + NEXTFREEENTRY - 1; 80064405 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] := 80064410 C 518 + STOPPERSUBTAB; 80064415 C 518 + END 80064420 C 518 + ELSE 80064425 C 518 + BEGIN 80064430 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,PREVPASS] := 80064435 C 518 + NEXTFREEENTRY -1; 80064440 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] := 80064445 C 518 + PASSSUBRANGE; 80064450 C 518 + END 80064455 C 518 + END 80064460 C 518 + END;TYP:=IF T1.FORM = ARRAYS THEN T1.ARRTYPE ELSE REALTYPE; 80064465 C 518 + T1 := TYPETAB1[TYP]; 80064470 C 518 + END UNTIL T1.STRUCT = 0 ; 80064475 C 518 + IF NOT PARAM THEN 80064480 C 518 + BEGIN 80064485 C 518 + GEN("]=",2,6); 80064490 C 518 + GENID("H",LEVEL1000+NAM,5); 80064495 C 518 + GEN("[",1,7); 80064500 C 518 + PASSSUBRANGE:= FIRSTRANGE; FIRSTDIM := TRUE; 80064505 C 518 + WHILE PASSSUBRANGE ≠ STOPPERSUBTAB DO 80064510 C 518 + BEGIN 80064515 C 518 + IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE GEN(",",1,7); 80064520 C 518 + GENID("V",(LEVEL1000+NAM)×(IF PASSSUBRANGE>9 THEN 100 ELSE 8006453 C 518 + 10)+PASSSUBRANGE+1,IF PASSSUBRANGE>9 THEN 7 ELSE 6); 80064535 C 518 + PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE]; 80064540 C 518 + END; 80064545 C 518 + GEN("]#;",3,5); 80064550 C 518 + END; 80064555 C 518 + PASSSUBRANGE := FIRSTRANGE; 80064560 C 518 + FIRSTDIM := TRUE; GEN("ARRAY",6,3); GENID("H",LEVEL1000+NAM,5); 80064565 C 518 + GEN("[",1,7); 80064570 C 518 + WHILE PASSSUBRANGE ≠ STOPPERSUBTAB DO 80064575 C 518 + BEGIN 80064580 C 518 + IF MAXPERMTAB LEQ MAXTOTALSUBSCRS AND PARAM THEN 80064585 C 518 + BEGIN 80064590 C 518 + ARRSUBPERMTAB[ARRNAM,MAXPERMTAB] := 80064595 C 518 + IF FIRSTDIM THEN NAM ELSE -1; 80064600 C 518 + ARRSUBPERMTAB[PERMSUB,MAXPERMTAB] := PASSSUBRANGE; 80064605 C 518 + MAXPERMTAB := MAXPERMTAB + 1; 80064610 C 518 + END 80064615 C 518 + ELSE 80064620 C 518 + BEGIN 80064625 C 518 + IF MAXPERMTAB > MAXTOTALSUBSCRS THEN ERROR(0); 80064630 C 518 + END; 80064640 C 518 + IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE GEN(",",1,7); 80064645 C 518 + GENINT(ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE]); 80064650 C 518 + IF NOT PARAM THEN 80064655 C 518 + BEGIN 80064660 C 518 + GEN(":",1,7); 80064665 C 518 + GENINT(ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE]); 80064670 C 518 + END; 80064675 C 518 + PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE]; 80064680 C 518 + END; 80064685 C 518 + GEN("]",1,7); 80064950 C 518 +$ 80421000 C 518 + IF CURLEVEL > 1 THEN 80421010 C 518 + BEGIN 80421020 C 518 + INTEGER NAMOFTHING,DIFF; 80421030 C 518 + BOOLEAN FIRSTTIME; 80421040 C 518 + GEN("BEGIN",6,3); 80421050 C 518 + IF MAXPERMTAB > 0 THEN 80421060 C 518 + BEGIN 80421070 C 518 + PASSPERMTAB := 0; 80421080 C 518 + DO 80421090 C 518 + BEGIN 80421100 C 518 + REMEMBERPOSN := PASSPERMTAB; 80421110 C 518 + GEN("DEFINE",7,2); 80421120 C 518 + NAMOFTHING := ARRSUBPERMTAB[ARRNAM,PASSPERMTAB]; 80421130 C 518 + GENID("V",1000×CURLEVEL+NAMOFTHING,5); 80421140 C 518 + GEN("[",1,7); 80421150 C 518 + FIRSTTIME := TRUE; 80421160 C 518 + DO 80421170 C 518 + BEGIN 80421180 C 518 + IF FIRSTTIME THEN FIRSTTIME := FALSE ELSE GEN(",",180421190 C 518 + ,7);80421200 C 518 + DIFF := PASSPERMTAB-REMEMBERPOSN+1; 80421210 C 518 + GENID("V",(1000+CURLEVEL+NAMOFTHING)×(IF DIFF>9 THEN 100 ELSE 80421220 C 518 + 10)+DIFF,(IF DIFF > 9 THEN 7 ELSE 6)); 80421230 C 518 + PASSPERMTAB := PASSPERMTAB + 1; END 80421270 C 518 + UNTIL PASSPERMTAB = MAXPERMTAB OR 80421280 C 518 + ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ≠ -1; 80421290 C 518 + GEN("]",1,7); 80421300 C 518 + GEN("=",1,7); 80421310 C 518 + GENID("H",1000×CURLEVEL+NAMOFTHING,5); 80421320 C 518 + GEN("[",1,7); 80421340 C 518 + PASSPERMTAB := REMEMBERPOSN; FIRSTTIME := TRUE; 80421350 C 518 + DO 80421360 C 518 + BEGIN 80421370 C 518 + IF FIRSTTIME THEN FIRSTTIME := FALSE ELSE GEN(",", 80421380 C 518 + 1,7);80421390 C 518 + DIFF := ARRSUBPERMTAB[PERMSUB,PASSPERMTAB]+1; 80421400 C 518 + GENID("V",(1000×CURLEVEL+NAMOFTHING)×(IF DIFF>9 THEN80421410 C 518 + 100 ELSE 10)+DIFF,(IF DIFF>9 THEN 7 ELSE 6)); 80421420 C 518 + PASSPERMTAB := PASSPERMTAB +1; 80421430 C 518 + END 80421440 C 518 + UNTIL PASSPERMTAB = MAXPERMTAB OR 80421450 C 518 + ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ≠ -1; 80421460 C 518 + GEN("]#;",3,5); 80421470 C 518 + END 80421480 C 518 + UNTIL PASSPERMTAB = MAXPERMTAB; 80421490 C 518 + MAXPERMTAB := 0; 80421500 C 518 + END 80421510 C 518 + END; 80421520 C 518 +$ 80608000 C 518 + BEGIN 80608010 C 518 + BEGIN 80608020 C 518 + INTEGER NAM,T1,SCRATCH; 80608030 C 518 + NAM := PARAMTAB[I].[9:10]; 80608040 C 518 + SCRATCH := NAMETAB3[CURLEVEL+1,NAM]; 80608050 C 518 + SCRATCH := SCRATCH.TYPE; 80608060 C 518 + T1 := TYPETAB1[SCRATCH]; 80608070 C 518 + IF T1.STRUCT ≠ 0 AND T1.FORM < FILES THEN 80608080 C 518 + GENID("H",1000×(CURLEVEL+1)+NAM,5) 80608090 C 518 + ELSE 80608100 C 518 + GENID("V",1000×(CURLEVEL+1)+NAM,5); 80608110 C 518 + END; 80608120 C 518 + MAXPERMTAB := 0; 90070100 C 518 + INSIDEPARENS := FALSE; 90070200 C 518 + + + + +$# PATCH 519 FOR PASCAL.XVI.O. CONTAINS 1 CARDS. INCREASE RUNTIME STACK. C 519 + + +$: C 519 + " XALGOL STACK = 2048; STACK = 1024; END."; % 90120500 C 519 + + + + +$# PATCH 600 FOR PASCAL.XVI.O. CONTAINS 22 CARDS. DAGS DEC77 PATCHES. C 600 + + +$: PATCHES RECEIVED FROM D.LANGMYHR AND TRANSPOSED FROM COSY FORMAT BY C 600 +$: DAVID A COOPER. FEBRUARY 1978. C 600 +$: C 600 + IF(F1 NEQ SET OR RT NEQ EMPTYSET) % 20813000 C 600 + AND % 20813050 C 600 + (F2 NEQ SET OR LT NEQ EMPTYSET) THEN % 20813100 C 600 + IF(F1 NEQ POINTERS OR RT NEQ NILTYPE) % 20814000 C 600 + AND % 20814050 C 600 + (F2 NEQ POINTERS OR LT NEQ NILTYPE) THEN % 20814100 C 600 + BEGIN ERROR(63); % 40023000 C 600 +$ 50059000 C 600 + GEN("PREAD(",6,2); WRITEEXPR; GEN(",",1,7); % 50079000 C 600 +$ 50080000 C 600 +$ 50081000 C 600 + GENID("F",FILEID,5); GEN(",",1,7); % 50082000 C 600 + IF F=NUMERIC THEN % 50086010 C 600 + BEGIN % 50086050 C 600 + GEN(",",1,7); GENINT(TYPETAB2[CURTYPE]); % 50086100 C 600 + GEN(",",1,7); GENINT(TYPETAB3[CURTYPE]); % 50086150 C 600 + END ELSE GEN(",0,0,",4,4); % 50086200 C 600 +$ SET VOIDT 50088000 C 600 +$ POP VOIDT 50093000 C 600 + IF NAMTAB.IDCLASS=FUNC THEN GEN("FUNCTN",7,2) % 80037000 C 600 + ELSE GEN("PROCEDU",8,1); % 80038000 C 600 + IF FOUND AND (THISID.IDCLASS=PROC OR THISID.IDCLASS=FUNC) THEN 80548000 C 600 + + + + +$#PATCH 601 FOR PASCAL.XVI.O.CONTAINS 147 CARDS. EXTENDE SET MODS. C 601 + + +$: PATCHES RECEIVED FROM D.LANGMYHR AND TRANSPOSED FROM COSY FORMAT BY C 601 +$: DAVID A COOPER. FEBRUARY 1978. C 601 +$: THIS PATCH MODIFIES THE SET HANDLING ROUTINES TO ALLOW SETS OF 0..93 C 601 +$: ELEMENTS C 601 +$: NB. THE RUN TIME SYSTEM MUST BE CHANGED ACCORDINGLY..... C 601 +$: --- --- ---- ------ ---- -- ------- ---------------- C 601 +% 40052050 C 601 +% 40052055 C 601 +PROCEDURE SPLIT(SPLITINX,WIDTH); % 40052100 C 601 +VALUE SPLITINX, WIDTH; % 40052150 C 601 +INTEGER SPLITINX, WIDTH ; % 40052200 C 601 +BEGIN % 40052250 C 601 + INTEGER I; % 40052300 C 601 +% 40052350 C 601 + IF NUMSYMS+WIDTH LEQ MAXSYMS THEN % 40052400 C 601 + BEGIN % 40052450 C 601 + FOR I:=NUMSYMS STEP -1 UNTIL SPLITINX DO % 40052500 C 601 + SYMTAB[I+WIDTH] := SYMTAB[I]; % 40052550 C 601 + FOR I:=1 STEP 1 UNTIL WIDTH DO % 40052600 C 601 + SYMTAB[SPLITINX+I-1] := "3000000"; % 40052650 C 601 + NUMSYMS := NUMSYMS + WIDTH; % 40052700 C 601 + END % 40052750 C 601 + ELSE 40052800 C 601 + BEGIN % 40052830 C 601 + ERROR(63); % 40052860 C 601 + NUMSYMS := 1; % 40052890 C 601 + END; % 40052900 C 601 +END OF SPLIT; % 40052950 C 601 +% 40052960 C 601 +% 40052965 C 601 + END; % 40188005 C 601 +IF TYPETAB1[CURTYPE].FORM=SET THEN % *** SET VARIABLES 40188010 C 601 +BEGIN % --- --- --------- 40188025 C 601 + INTEGER THISSYML, I; % 40188050 C 601 +% 40188075 C 601 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SLOAD("; % 40188100 C 601 + IF SIMPLEVAR THEN % 40188125 C 601 + BEGIN % 40188150 C 601 + PUTSYM(","); % 40188175 C 601 + PUTID("W",1000×THISLEVEL+THISINDEX,5); % 40188200 C 601 + END % 40188225 C 601 + ELSE % 40188250 C 601 + IF INBRACKET AND NOT INRECORD THEN % 40188275 C 601 + BEGIN % 40188300 C 601 + PUTSYM(","); THISSYML := NUMSYMS; % 40188325 C 601 + PUTCONST(0); PUTSYM(" "); PUTSYM(","); % 40188350 C 601 + FOR I:=STARTSYM+1 STEP 1 UNTIL THISSYML DO % 40188375 C 601 + PUTTEXT(SYMTAB[I]); 40188400 C 601 + PUTTEXT(" 1] "); % 40188425 C 601 + END % 40188450 C 601 + ELSE % 40188475 C 601 + BEGIN % 40188500 C 601 + THISSYML := NUMSYMS; % 40188525 C 601 + IF INBRACKET THEN PUTSYM("]"); % 40188550 C 601 + FOR I:=1 STEP 1 UNTIL NUMPOINTERS DO % 40188575 C 601 + BEGIN % 40188600 C 601 + PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); % 40188625 C 601 + PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); % 40188650 C 601 + END; % 40188675 C 601 + PUTSYM(","); % 40188700 C 601 + FOR I:=STARTSYM+1 STEP 1 UNTIL THISSYML DO % 40188725 C 601 + PUTTEXT(SYMTAB[I]); % 40188775 C 601 + PUTTEXT(" +1 "); % 40188800 C 601 + IF INBRACKET THEN PUTSYM("]"); % 40188825 C 601 + FOR I:=1 STEP 1 UNTIL NUMPOINTERS DO % 40188850 C 601 + BEGIN % 40188875 C 601 + PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); % 40188900 C 601 + PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); % 40188915 C 601 + END; % 40188930 C 601 + NUMPOINTERS := 0; % 40188945 C 601 + END; 40188960 C 601 + PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); % 40188975 C 601 +END OF SET VARIABLES; % 40188990 C 601 +$ 40198000 C 601 + IF TYPETAB1[THISID.TYPE].FORM=SET THEN 40274200 C 601 + BEGIN % 40274220 C 601 + GEN(",",1,7); % 40274240 C 601 + GENID("W",1000×THISLEVEL+THISINDEX,5); % 40274260 C 601 + END; % 40274280 C 601 + BOOLEAN FIRST, SPLITTED; % 40296000 C 601 + PUTTEXT("SETBS("); PUTTEXT(" 3,2,"); PUTCONST(CARDCNT); % 40529000 C 601 + PUTSYM(")"); % 40529300 C 601 + CURTYPE := EMPTYSET; CURMODE := NUMBER; % 40529600 C 601 + STARTSYM := NUMSYMS + 1; % 40533500 C 601 + PUTTEXT(" SETB("); % 40536000 C 601 + PUTSYM(","); SYMTAB[STARTSYM] := "SETBS("; % 40544000 C 601 + IF SPLITTED THEN PUTSYM(")"); % 40551500 C 601 + IF CURSY=COMMA THEN % 40552000 C 601 + BEGIN % 40552200 C 601 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SUNIO("; % 40552400 C 601 + PUTSYM(","); % 40552600 C 601 + SPLITTED := TRUE; % 40552800 C 601 + END; % 40552850 C 601 + NEWTYPE; T1 := SET; T1.SIZE := 2; T1.STRUCT := 0; % 40558000 C 601 + CURMODE := NUMBER; % 40561000 C 601 + IF CURTYPE=BOOLTYPE THEN % 40587000 C 601 + IF CURSY NEQ ANDSY THEN ERROR(64); 40593000 C 601 + END ELSE % 40593100 C 601 + IF F=SET THEN % 40593200 C 601 + BEGIN % 40593300 C 601 + IF CURSY=ASTERISK THEN % 40593400 C 601 + BEGIN % 40593500 C 601 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SINTS("; % 40593600 C 601 + PUTSYM(","); % 40593700 C 601 + END ELSE ERROR(64); % 40593800 C 601 + MODE := NUMBER; % 40593900 C 601 + IF F=SET THEN PUTSYM(")"); % 40608500 C 601 + SPLIT(STARTSYM,1); % 40650000 C 601 + IF CURSY=PLUS THEN SYMTAB[STARTSYM] := "SUNIO(" ELSE % 40651000 C 601 + IF CURSY=MINUS THEN SYMTAB[STARTSYM] := "SDIFF(" ELSE % 40652000 C 601 + ERROR(64); % 40653000 C 601 + PUTSYM(","); MODE := NUMBER; % 40654000 C 601 +$ 40655000 C 601 + IF F=SET THEN PUTSYM(")"); % 40668500 C 601 +$ 40688000 C 601 + IF CURSY=EQLSY THEN SYMTAB[STARTSYM] := "SEQUA(" % 40713000 C 601 + ELSE 40713150 C 601 + IF CURSY=NEQSY THEN % 40713300 C 601 + BEGIN % 40714000 C 601 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM]:= " NOT "; % 40714150 C 601 + SYMTAB[STARTSYM+1] := "SEQUA("; % 40714300 C 601 + IF TYPETAB1[LEFTTYPE].FORM=SET THEN % 60080100 C 601 + BEGIN % 60080200 C 601 + SYMTAB[1] := "SSTOR("; NUMSYMS := NUMSYMS - 3; % 60080300 C 601 + EXPRESSION; % 60080400 C 601 + PUTSYM(")"); CHECKTYPES(LEFTTYPE,CURTYPE); % 60080500 C 601 + WRITEEXPR; % 60080600 C 601 + END ELSE % 60080700 C 601 + IF TYPETAB2[TX] LSS 0 OR TYPETAB3[TX] GTR 93 THEN ERROR(51); 70210000 C 601 + T1.SIZE := TSIZE := 2; TYPETAB1[TYPEINDEX] := T1; % 70214000 C 601 + IF T1.FORM=SET THEN % 80046200 C 601 + BEGIN % 80046400 C 601 + GEN(",",1,7); GENID("W",LEVEL1000+NAM,5); % 80046600 C 601 + END; % 80046800 C 601 + IF T1.FORM=SET THEN % 80064700 C 601 + BEGIN % 80064750 C 601 + GEN(",0",2,6); % 80064800 C 601 + IF NOT PARAM THEN GEN(":1",2,6); % 80064850 C 601 + END; % 80064900 C 601 + BEGIN % 80608105 C 601 + IF T1.FORM=SET THEN % 80608111 C 601 + BEGIN % 80608113 C 601 + GEN(",",1,7); % 80608115 C 601 + GENID("W",1000×(CURLEVEL+1)+NAM,5); % 80608117 C 601 + END; 80608118 C 601 + END; % 80608119 C 601 + IF TYPETAB1[NAMETAB3[CURLEVEL+1,PARAMTAB[I].PARAMNAME].TYPE80627200 C 601 + ].FORM=SET 80627205 C 601 + THEN BEGIN % 80627400 C 601 + GEN(",",1,7); % 80627600 C 601 + GENID("W",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME 80627800 C 601 + ,5); % 80627801 C 601 + END; 80627850 C 601 + + + + +$#PATCH 602 FOR PASCAL.XVI./ CONTAINS 5 CARDS. CORRECT REPRESENTATION OF "NIL". C 602 + + +$: RECEIVED FROM DAG LANGHYMR ON 6/07/78. C 602 +$: DAVID A COOPER , HERIOT-WATT UNIVERSITY... JULY 1978. C 602 +NILTYPE := 6; %*** TYPE OF "NIL" *** 20363000 C 602 +T1.FORM := POINTERS; TYPETAB1[6] := T1; 20364000 C 602 +EMPTYSET := 7; % 20364500 C 602 +T1.FORM := SET; TYPETAB1[7] := T1; 20365000 C 602 +NUMTYPES := 7; % 20365500 C 602 + + + + +$# PATCH 603 FOR PASCAL XVI.O CONTAINS 6 CARDS. CORRECT TO PATCH 601 C 603 + + +$: DAVID A COOPER & S O ANDERSON, HERIOT-WATT UNIVERSITY. UST AUGUST 1978 C 603 +$: C 603 + INTEGER STARTSYM,FIRSTSYM,MODE,TYPE1,F; 40618000 C 603 + PUTDUMMY; STARTSYM := FIRSTSYM := NUMSYMS; 40621000 C 603 + SPLIT(FIRSTSYM,1); 40650000 C 603 + IF CURSY = PLUS THEN SYMTAB[FIRSTSYM] := "SUNIO(" ELSE 40651000 C 603 + IF CURSY = MINUS THEN SYMTAB[FIRSTSYM] := "SDIFF(" ELSE 40652000 C 603 + ERROR(64); 40653000 C 603 + + + + +$# PATCH 615 FOR PASCAL.XVI.O. CONTAINS 7 CARDS. C 615 + + +$ 40105100 C 615 +$ 40105200 C 615 +$ 40105300 C 615 +$ 40105400 C 615 + IF INSIDEPARENS AND SIMPLEVAR AND TYPETAB1[CURTYPE].STRUCT > 0 AND 40198500 C 615 + TYPETAB1[CURTYPE].FORM < FILES THEN SYMTAB[STARTSYM].[35:6] := 40198600 C 615 + "H"; 40198700 C 615 + + + + +$# PATCH 700 FOR PASCAL.XVI.O HAS 179 CARDS. REDUCE THRASHING BY CODE CHANGE C 700 + + +$: TO IMPROVE RUN TIME EFFICIENCY BY REAARRANGING THE THE COMPILERS CODE. C 700 +$: THE COMPILER HAD A HIGH OVERLAY I/O TIME AND HIGH ELAPSED TIME IN RELATION C 700 +$: TO THE PROCESS TIME, AND OBSERVATION OF THE B5700 CONFIRMED THAT IT WAS C 700 +$: THRASHING IN 32K. THIS PATCH ATTEMPTS TO REDUCE THE CORE REQUIREMENT BY C 700 +$: REARRANGING THE SEGMENTATION OF THE CODE. LARGE SEGMENTS ARE ELIMINATED C 700 +$: SO AS TO AVOID PULLING CODE THAT WILL NOT BE EXECUTED INTO CORE AND TO C 700 +$: RELEASE CODE SEGMENTS AS SO AS EXECUTION HAS PASSED. FOR EXAMPLE, THE C 700 +$: CROSS REFERENCE ROUTINES WERE ALL CONTAINED IN THE LARGE OUTER BLOCK CODE C 700 +$: SEGMENT WHICH INCLUDED VARIOUS UTILITY ROUTINES. C 700 +$: A FEATURE WHICH CONTRIBUTED SIGNIFICANTLY TO LARGE SEGMENTS WAS THE HIGH C 700 +$: NUMBER OF "DEFINES" WHICH RESULTED IN SIZEABLE SECTIONS OF CODE BEING C 700 +$: GENERATED IN-LINE, SOMETIMES MANY TIMES IN ONE SEGMENT. THESE "DEFINES" C 700 +$: WERE READILY CHANGED INTO PROCEDURES. (A SIDE EFFECT OF VIRTUALLY ELIMINATING C 700 +$: DEFINES FOR CODE IS THAT THE "BEND" OPTION NO LONGER RESULTS IN NUMEROUS C 700 +$: BLANK LINES REPEATING THE SAME SEQUENCE NUMBER FOR EVERY "END" IN THE NESTED C 700 +$: DEFINES.) C 700 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN AUG - NOV 1977. C 700 +$: C 700 +$ 10167000 C 700 +$ 10168000 C 700 +$ 10169000 C 700 + VALUE NAME1,NAME2,TABLE,DECL; 20016000 C 700 + REAL NAME1,NAME2; 20017000 C 700 + INTEGER TABLE; BOOLEAN DECL; 20018000 C 700 + FORWARD; 20019000 C 700 +PROCEDURE PRINTERRORS; FORWARD; 20020000 C 700 +PROCEDURE HEADING; %*** PRINTS A HEADING AT START OF NEW PAGE.20026000 C 700 +BEGIN DEFINE NEWSEGMENT = HERE #; 20027000 C 700 +END OF HEADING; 20033000 C 700 +PROCEDURE PRINTLINE; %*** PRINTS A PASCAL SOURCE CODE LINE 20036000 C 700 +BEGIN DEFINE NEWSEGMENT = HERE #; 20037000 C 700 +END OF PRINTLINE; 20047000 C 700 +PROCEDURE NEWCARD; %*** READS A NEW PASCAL SOURCE CODE CARD 20050000 C 700 +BEGIN DEFINE RESULT = ICARD[*], ETC #; 20051000 C 700 + REPLACE XLINEPNT BY " " FOR 16 WORDS; 20056000 C 700 + REPLACE LINEPNT BY CARDPNT FOR 10 WORDS, XLINEPNT FOR 6 WORDS; 20057000 C 700 +END OF NEWCARD; 20061000 C 700 +DEFINE GEN(GEN1,GEN2,GEN3) = GENI(TRUE,GEN1,GEN3,GEN2) #, 20063100 C 700 +GENID(GENID1,GENID2,GENID3)= GENI(FALSE,GENID1,GENID2,GENID3) #; 20063200 C 700 + 20063300 C 700 +PROCEDURE GENI(GENT, TXT, NUM, N ); 20063400 C 700 +VALUE GENT, TXT, NUM, N; 20063500 C 700 +BOOLEAN GENT; ALPHA TXT; INTEGER NUM, N; 20063600 C 700 +BEGIN DEFINE START = NUM #, NDIG = N #; 20063700 C 700 + 20063800 C 700 + IF GENT THEN %*** GENERATE A TEXT "TXT", CONSISTING OF 20064000 C 700 + TEXT[0] := TXT; 20067000 C 700 +END 20070000 C 700 +ELSE %*** GENERATE AN ALGOL IDENTIFIER. 20073000 C 700 + CH[0] := TXT; 20076000 C 700 +END END GENI; 20079000 C 700 +PROCEDURE GENINT( N ); 20082000 C 700 +VALUE N; INTEGER N; 20083000 C 700 +BEGIN DEFINE RESULT = ALGOL CODE #; 20084000 C 700 + INTEGER NABS, NSIZE; 20085000 C 700 +END OF GENINT; 20097000 C 700 +PROCEDURE WRITEALGOL; %*** WRITES A COMPLETED ALGOL CARD TO 20145000 C 700 + DEFINE NEWSEGMENT = HERE #; 20146100 C 700 + DEFINE NEWSEGMENT = HERE #; 20168100 C 700 + DEFINE NEWSEGMENT = HERE #; 20180100 C 700 + DEFINE NEWSEGMENT = HERE #; 20193100 C 700 +ALPHA THISID, CURNAME1, CURNAME2; % USED IN SCANNER 20205000 C 700 +PROCEDURE SEARCHTAB( TAB ); %*** SEARCH NAME TABLE "TAB" FOR THE 20208000 C 700 +VALUE TAB; INTEGER TAB; %*** IDENTIFIER JUST READ. 20208100 C 700 +END OF SEARCHTAB; 20221000 C 700 +PROCEDURE SEARCH; %*** SEARCH ALL TABLES CURRENTLY IN USE. 20223000 C 700 +BEGIN DEFINE RESULT = THISID #; 20224000 C 700 +END OF SEARCH; 20233000 C 700 +PROCEDURE NEWNAME( NAME1,NAME2, TAB ); 20236000 C 700 +VALUE NAME1, NAME2, TAB; 20236100 C 700 +ALPHA NAME1, NAME2; INTEGER TAB; 20236200 C 700 +END OF NEWNAME; 20250000 C 700 + DEFINE NEWSEGMENT = HERE #; 20515100 C 700 + DEFINE NEWSEGMENT = HERE #; 20533100 C 700 + DEFINE NEWSEGMENT = HERE #; 20546100 C 700 +PROCEDURE CHECKTYPES( LEFTTYPE, RIGHTTYPE ); 20802000 C 700 +VALUE LEFTTYPE, RIGHTTYPE; INTEGER LEFTTYPE, RIGHTTYPE; 20803000 C 700 +BEGIN 20804000 C 700 + REAL TT1, TT2; INTEGER F1, F2, LT, RT; 20805000 C 700 +END OF CHECKTYPES; 20838000 C 700 +PROCEDURE FILEPARAM( DEFAULTFILE ); %*** CHECKS THE FIRST PARAMETER 20844000 C 700 +VALUE DEFAULTFILE; INTEGER DEFAULTFILE;%*** TO SEE IF IT IS A FILE. 20844100 C 700 +BEGIN DEFINE RESULTS = FILENAME & LPARFOUND #; 20845000 C 700 +END OF FILEPARAM; 20869000 C 700 +REAL CURVAL; INTEGER CURLENGTH; 20872000 C 700 + 20873000 C 700 +PROCEDURE CONSTANT( CVAL, CTYPE ); 20874000 C 700 +REAL CVAL; INTEGER CTYPE; 20875000 C 700 +BEGIN 20876000 C 700 + INTEGER TFORM; BOOLEAN SIGNED, NEGATIVE; 20876100 C 700 +END OF CONSTANT; 20921000 C 700 +$ 30082000 C 700 +ALPHA C, CX; %( CURNAME1 & CURNAME2 MOVED TO 20205000 ) 30083000 C 700 +INTEGER LASTCHARPOS; %( CURVAL, CURLENGTH MOVED TO 20872000 ) 30084000 C 700 +PROCEDURE INSYMBOL; %*** IDENTIFIES THE NEXT SYMBOL ****** 30087000 C 700 +BEGIN 30087100 C 700 + 30087200 C 700 + PROCEDURE NEXTCHAR; %*** GETS THE NEXT CHARACTER. 30088000 C 700 + END OF NEXTCHAR; 30093000 C 700 +$ SET VOIDT 30095000 C 700 +$ POP VOIDT 30098000 C 700 + DEFINE T1 = EXP #; % USED AT 30178000 30099100 C 700 + BEGIN DEFINE NEWSEGMENT = HERE #; 30261100 C 700 + END NEWSEGEMENT; 30282200 C 700 +$ 40016000 C 700 +$ 40017000 C 700 +INTEGER EXPRLEVEL; 40018000 C 700 +DEFINE PUTSYM(S) = PUTTEXT( (S)&1[41:5:6] ) #; 40029000 C 700 +$ SET VOIDT 40029900 C 700 +$ POP VOIDT 40033000 C 700 +DEFINE PUTDUMMY = PUTTEXT("3000000") #; 40041000 C 700 +$ SET VOIDT 40042000 C 700 +$ POP VOIDT 40044000 C 700 +PROCEDURE WRITEEXPR; %*** WRITE GENERATED ALGOL EXPRESSION 40053000 C 700 + REAL SX; INTEGER T1, TX; 40054100 C 700 +END OF WRITEEXPR; 40066000 C 700 +PROCEDURE CHECKEXPR( LLIM, ULIM ); %*** WRITE CODE TO CHECK VALUE 40069000 C 700 + VALUE LLIM, ULIM; INTEGER LLIM, ULIM; 40069100 C 700 +BEGIN DEFINE CHECK = VALUE #; 40070000 C 700 +END OF CHECKEXPR; 40077000 C 700 + INTEGER T1, T5; % USED ONCE EACH 40086100 C 700 + T1:=T.FIRSTWITHSYM; T5:=T.LASTWITHSYM; 40094000 C 700 + FOR T1:=T1 STEP 1 UNTIL T5 DO PUTTEXT(WITHTAB[T1]); 40095000 C 700 + DEFINE T1 = T #; % USED AT 40558000 40298000 C 700 +$ SET VOIDT 40299000 C 700 +$ POP VOIDT 40309000 C 700 + 40331000 C 700 + PROCEDURE PARAMETER; %*** CHECK THAT THE FUNCTION HAS 1 PARAM.40332000 C 700 + BEGIN 40333000 C 700 + INSYMBOL; 40334000 C 700 + IF CURSY=LPAR 40335000 C 700 + THEN BEGIN 40336000 C 700 + PUTSYM("("); INSYMBOL; EXPRESSION; 40337000 C 700 + IF TYPETAB1[CURTYPE].FORM=NUMERIC THEN CURTYPE:=INTTYPE; 40338000 C 700 + IF CURSY≠RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; 40339000 C 700 + PUTSYM(")"); IF CURSY=RPAR THEN INSYMBOL; 40340000 C 700 + END ELSE ERROR(3); % OR ERROR(58) 40341000 C 700 + END OF PARAMETER; 40342000 C 700 + 40350000 C 700 +$ 60396000 C 700 + BEGIN LABEL LABFOUND; 60399000 C 700 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) OR 60423000 C 700 + THISID.IDCLASS=FUNC 60423200 C 700 + THEN ASSIGNMENT ELSE 60424000 C 700 +$ SET VOIDT 70013000 C 700 +$ POP VOIDT 70016000 C 700 + VALUE RECTAB,FIRSTADDR; 70018000 C 700 + INTEGER RECTAB,FIRSTADDR,LASTADDR; 70019000 C 700 +$ SET VOIDT 70022000 C 700 +$ POP VOIDT 70034000 C 700 + 70035000 C 700 +PROCEDURE TYPEDECL( TTYPE, TSIZE ); %***** TYPE DECLARATION ***** 70036000 C 700 + INTEGER TTYPE, TSIZE; %**************************** 70037000 C 700 +BEGIN 70038000 C 700 + INTEGER RECINX, ARRSTRUCT, TX, SX, T, N; REAL T1, T2, T3; 70039000 C 700 + BOOLEAN FIRST, PACKED; 70040000 C 700 + 70041000 C 700 +$ 70042000 C 700 + END TYPERR; 70048000 C 700 + PROCEDURE SUBRANGE; %*** SUBRANGE DECLARATION *** 70050000 C 700 + BEGIN %**************************** 70051000 C 700 + REAL VALX1, VALX2, T1; 70052000 C 700 + INTEGER TYPEX1, TYPEX2; 70053000 C 700 + 70054000 C 700 + CONSTANT(VALX1,TYPEX1); 70055000 C 700 + IF TYPETAB1[TYPEX1].FORM>CHAR THEN ERROR(11); 70056000 C 700 + IF CURSY≠DOUBLEDOT THEN ERROR(53); 70057000 C 700 + INSYMBOL; 70058000 C 700 + CONSTANT(VALX2,TYPEX2); 70059000 C 700 + IF TYPEX1>0 AND TYPEX2>0 THEN 70060000 C 700 + IF TYPEX1≠TYPEX2 THEN ERROR(11) ELSE 70061000 C 700 + IF VALX1>VALX2 THEN ERROR(54); 70062000 C 700 + IF (T1:=TYPETAB1[TYPEX1].FORM) = SYMBOLIC THEN T1:=SUBTYPE; 70063000 C 700 + NEWTYPE; TTYPE:=TYPEINDEX; 70064000 C 700 + T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; T1.MAINTYPE:=TYPEX1; 70065000 C 700 + TYPETAB1[TYPEINDEX]:=T1; 70066000 C 700 + TYPETAB2[TYPEINDEX]:=VALX1; TYPETAB3[TYPEINDEX]:=VALX2; 70067000 C 700 + END OF SUBRANGE; 70068000 C 700 + 70069000 C 700 + DEFINE DEC = POINTER #; 70117100 C 700 + DEFINE DEC = ARRAY #; 70143100 C 700 + DEFINE DEC = FILE #; 70180100 C 700 + DEFINE DEC = SET #; 70200100 C 700 + DEFINE DEC = RECORD #; 70220100 C 700 + LABEL CASEPART, EXIT; 70247000 C 700 + BEGIN DEFINE DEC = VARIANT #; 70285100 C 700 + LABEL CASETYPEID; 70285200 C 700 + END; 70349100 C 700 + DEFINE DEC = FILE #; 80066100 C 700 + GEN(""/",2,6); 80107000 C 700 + DEFINE DEC = LABEL #; 80424100 C 700 + DEFINE DEC = CONST #; 80447100 C 700 + DEFINE DEC = TYPE #; 80475100 C 700 + DEFINE DEC = VAR #; 80496100 C 700 + IF CURSY=FUNCSY OR CURSY=PROCSY % 80540900 C 700 + THEN BEGIN DEFINE DEC = CODE #; 80540910 C 700 + END OF SEGMENT FOR PROCEDURE DECLARATIONS; 80658100 C 700 + + + + +$# PATCH 701 FOR PASCAL.XVI.O CONTAINS 14 CARDS. REDUCE THRASHING BY ARRAY CUTS C 701 + + +$: TO IMPROVE RUN TIME EFFICIENCY BY REDUCING ARRAY SIZES. THE MOST SIGNIFICANT C 701 +$: CONTRIBUTION TO THE COMPILERS THRASHING BEHAVIOUR WAS THE EXCESSIVELY LARGE C 701 +$: DATA ARRAYS. THIS PATCH SUCCEEDS IN DRASTICALLY REDUCING THE CORE REQUIREMENT C 701 +$: OF THE COMPILER BY MAKING MOST OF THE LARGE ARRAYS MUCH SMALLER WITHOUT C 701 +$: IMPOSING UNREASONABLE RESTRICTIONS. IN PARTICULAR, THE THREE ARRAYS, C 701 +$: NAMETAB1, NAMETAB2, NAMETAB3 WERE EACH [0:50, 0:1022], AND HAVE BEEN REDUCED C 701 +$: TO [0:30, 0:307]. THESE REDUCTIONS HAVE NOT PREVENTED THE COMPILATION OF C 701 +$: A LARGE PASCAL PROGRAM OF ABOUT 4000 LINES, NAMELY THE P4 PASCAL COMPILER C 701 +$: FROM ZURICH. IN FACT, PRIOR TO THE CHANGES INTRODUCED BY PATCHES 700 & 701, C 701 +$: THE P4 PASCAL COMPILER TOOK 60 MINUTES ELAPSED TIME TO COMPILE, WHICH WAS C 701 +$: REDUCED TO 9 MINUTES BY THESE PATCHES, WHILE THE PROCESS TIME HAS REMAINED C 701 +$: CONSTANT AT 9 MINUTES. C 701 +$:**** NOTE THAT IF "MAXNAMES" IS CHANGED THEN THERE ARE 7 DEFINES IN THE FILE C 701 +$: PASCAL/PRELUDE THAT MUST ALSO BE CHANGED. C 701 +$: "MAXNAMES" IS CHOSEN AS A PRIME NUMBER AS IT IS USED AS A MODULUS FOR A HASH C 701 +$: FUNCTION. THE PASCAL IDENTIFIERS ARE TRANSLATED TO ALGOL NAMES USING LEVEL C 701 +$: AND HASH INDEX. HENCE CHANGING "MAXNAMES" CHANGES THE ALGOL NAMES FOR C 701 +$: "INPUT", "OUTPUT", & "PRT25". C 701 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN AUG - NOV 1977. C 701 +$: C 701 +DEFINE MAXTABLES = 30 #, %MAX NUMBER OF LEVELS IN IDENTIFIER TABLE.10042000 C 701 + MAXNAMES =307 #, %MAX NAMES IN EACH ROW OF IDENTIFIER TABLE.10043000 C 701 + % ONLY USED IN WITH STATEMENT TO TEST 10044001 C 701 + MAXCASES =64 #, %MAX LABELS IN A CASE-STATEMENT. 10045000 C 701 + MAXLABS =50 #, %MAX NUMBER OF IN PROGRAM LABELS. 10046000 C 701 + MAXPARAMS =200 #, %MAX NUMBER OF PARAMETERS IN WHOLE PROGRAM.10047000 C 701 + MAXTYPES =250 #, %MAX NUMBER OF DIFFERENT TYPES. 10048000 C 701 + MAXCONSTS =100 #, %SIZE OF TABLE FOR CONSTANTS. 10049000 C 701 + MAXWITHSYMS= 70 #, %MAX NUMBER OF SYMBOLS USED BY WITH-STATMS.10051000 C 701 + MAXSYMS =200 #, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 C 701 + LISTLENGTH =100 #, %MAX LENGTH OF VAR AND PARAM LISTS. 10053000 C 701 + MAXEXTFILES=10 #, %MAX NUMBER OF EXTERNAL FILES. 10054000 C 701 + MAXFILES =10 #, %MAX NUMBER OF FILES DECLARED AT ONE TIME. 10055000 C 701 + MAXPNTRS =10 #; %MAX NUMBER OF UNDECLARED POINTERS (FORWD).10056000 C 701 + + + + +$# PATCH 702 FOR PASCAL.XVI.O CONTAINS 4 CARDS. BOOLEAN ARRAY "ERR" 120 TO 4 C 702 + + +$: TO EXTEND THE REDUCTIONS OF PATCH 701 TO THE BOOLEAN ARRAY "ERR" FOR NOTING C 702 +$: THE SYNTAX ERRORS THAT HAVE OCCURRED. THIS PATCH COMPRESSES THE ARRAY FROM C 702 +$: 120 WORDS TO 4 WORDS BY USING 32 BITS IN EACH WORD. C 702 +$: IN ADDITION, THIS PATCH INSERTS THE ERROR COUNT ON THE LEFT OF THE LINE C 702 +$: WHICH REPORTS THE SYNTAX ERRORS. C 702 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 702 +$: C 702 +ARRAY ERRP[0:3]; % HOLDS 128 BITS % RECORDS ERROR MESSAGES USED. 10156000 C 702 +DEFINE ERR[ERR1] = BOOLEAN(0&ERRP[ERR1.[6:2]][0:ERR1.[4:5]:1]) #; 10156100 C 702 + ERRP[ERRNUM.[6:2]]:=ERRP[ERRNUM.[6:2]] & 1[ERRNUM.[4:5]:0:1]; 20182000 C 702 + REPLACE POINTER(ERRLINE[0])+4 BY NUMERRS FOR 4 DIGITS; 20194900 C 702 + + + + +$# PATCH 703 FOR PASCAL.XVI.O CONTAINS 6 CARDS. REDUCE THRASHING BY SAVE CORE C 703 + + +$: TO IMPROVE RUN-TIME EFFICIENCY BY REDUCING NON-OVERLAYABLE AREAS. C 703 +$: THIS PATCH REDUCES THE SAVE CORE REQUIREMENTS BY DECREASING THE FILE BLOCK C 703 +$: SIZES AND ALSO THE NUMBER OF BUFFERS WITHOUT UNDULY RETARDING THE COMPILATION C 703 +$: SPEED. THE SIZE OF THE DISK AREAS IS KEPT A MULTIPLE OF THE ORIGINAL BLOCK C 703 +$: SIZE WHERE RELEVANT TO AVOID INCOMPATIBILITY PROBLEMS. COMPARABLE REDUCTIONS C 703 +$: IN BLOCK SIZES OF THE OBJECT PROGRAM ARE ALSO MADE. C 703 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 703 +$: C 703 +FILE CARD "SOURCE" (1,10,30); % PASCAL SOURCE CODE INPUT FILE 10035000 C 703 +FILE PASCALGOL DISK SERIAL [20:300] (1,10,30,SAVE 0); % ALGOL CODE FILE10037000 C 703 +FILE XREFFILE DISK SERIAL [20:3000] (1,3,30); % FOR CROSS REFERENCE 10137000 C 703 + IF RECSIZE=1 OR RECSIZE=10 THEN GENINT(30) 80119000 C 703 + GEN(",SAVE",6,3); 80122000 C 703 + GEN("30);", 4,4); 80123000 C 703 + + + + +$# PATCH 704 FOR PASCAL.XVI.O HAS 8 CARDS. REDUCE OVERHEADS IN COPYING FILE C 704 + + +$: TO REDUCE THE COMPILER-S OVERHEADS. FIRSTLY, THE ALGOL CODE FILE C 704 +$: PASCRUN/DISK IS RENAMED PASCAL/PRELUDE. ORIGINALLY, THE COMPILER COPIED C 704 +$: THE PASCAL/PRELUDE FILE INTO THE GENERATED CODE FILE BEFORE STARTING TO C 704 +$: TRANSLATE THE PASCAL PROGRAM. THIS PATCH SAVES THE 3 SECONDS OR SO REQUIRED C 704 +$: FOR THIS BY SETTING THE "TAPE" OPTION FOR THE ALGOL COMPILER AND LABEL C 704 +$: EQUATING THE TAPE FILE TO PASCAL/PRELUDE. THE OVERHEAD TO THE ALGOL COMPILER C 704 +$: IS NEGLIGIBLE. THE ADVANTAGE IS EVEN GREATER IF THE PROGRAM FAILS TO C 704 +$: COMPILE SYNTAX FREE. THE FILE PASCAL/PRELUDE IS NO LONGER REFERENCED C 704 +$: DIRECTLY IN THE PASCAL COMPILER. C 704 +$: SEE PATCH 711. THIS NEEDS PATCH 705. C 704 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 704 +$: C 704 + ERRORS (I5," ERRORS DETECTED ",20("#") /), 10188000 C 704 + ALIST ("$ SET LIST "), 10189000 C 704 + MERGE ("$ SET TAPE RESET $" / 10190100 C 704 + "$ RESET TAPE", T73,"99000000" ), 10190200 C 704 + TERMMESS ("**** COMPILATION TERMINATED."); 10192000 C 704 +WRITE(PASCALGOL,MERGE); % ALGOL MUST COMPILE PRELUDE FIRST 90022000 C 704 +$ SET VOIDT 90023000 C 704 +$ POP VOIDT 90032000 C 704 +$: "; ALGOL FILE TAPE= PASCAL/PRELUDE SERIAL; ALGOL FILE CARD=", 90119000 C 704 + + + + +$# PATCH 705 FOR PASCAL.XVI.O CONTAINS 21 CARDS. GENERATE A BETTER ZIP C 705 + + +$: THIS PATCH TIDIES UP THE CODE THAT GENERATES THE ZIP TO PASS CONTROL TO THE C 705 +$: COMPATABLE ALGOL COMPILER. C 705 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 705 +$: C 705 +$ 90013000 C 705 + PROGNAME := IF CURLENGTH < 7 90042000 C 705 + THEN " "&CURNAME1[41:6×CURLENGTH-1:6×CURLENGTH] 90042010 C 705 + ELSE CURNAME2.[5:6]&CURNAME1[41:35:36]; 90042020 C 705 +$: ARRAY ZIPARRAY[0:16]; 90092000 C 705 + DEFINE PPROGNAME = 13 #, PALGOLNAME = 14 #, 90095000 C 705 + PLIBRARY = 15 #, PUSER = 16 #, 90096000 C 705 + P(P1) = POINTER(ZIPARRAY[P1])+1 FOR 7 #; 90097000 C 705 +$ SET VOIDT 90098000 C 705 +$ POP VOIDT 90104000 C 705 +$ 90109000 C 705 + ZIPARRAY[PPROGNAME]:=PROGNAME; ZIPARRAY[PALGOLNAME]:=ALGOLNAME; 90112000 C 705 + ZIPARRAY[PLIBRARY]:= IF SAVEFACTOR>0 THEN "LIBRARY" ELSE 90113000 C 705 + IF SAVEFACTOR<0 THEN " SYNTAX" ELSE " & RUN "; 90114000 C 705 + ZIPARRAY[PUSER]:=USER; 90115000 C 705 + REPLACE POINTER(ZIPARRAY[*]) BY "CC COMPILE ", 90116000 C 705 + P(PPROGNAME), "/", P(PUSER), 90117000 C 705 + " XALGOL ", P(PLIBRARY), 90118000 C 705 + "; ALGOL FILE TAPE= PASCAL/PRELUDE SERIAL; ALGOL FILE CARD=", 90119000 C 705 + P(PALGOLNAME), "/", P(PUSER), " SERIAL; END."; 90120000 C 705 +$ SET VOIDT 90121000 C 705 +$ POP VOIDT 90128000 C 705 + + + + +$# PATCH 708 FOR PASCAL.XVI.O CONTAINS 25 CARDS. LINE PRINT FILE MAY BE DISK C 708 + + +$: TO ENABLE THE COMPILER-S PRINT FILE TO BE LABEL EQUATED TO DISK AS FOR OTHER C 708 +$: B5700 COMPILERS. IN PARTICULAR, THIS PATCH CHANGES THE NAME TO LINE TO BE C 708 +$: CONSISTENT WITH ALL THE SYSTEM COMPILERS. THE ABILITY TO LABEL EQUATE FILE C 708 +$: "LINE" TO DISK IS NECESSARY IF THE COMPILER IS TO BE USED FROM A TERMINAL. C 708 +$: NOTE THAT A BLOCKED FILE SHOULD NOT HAVE VARIABLE LENGTH RECORDS IF IT IS C 708 +$: TO BE LABEL EQUATED TO A PRINTER. IF LESS THAN A THE MAX NUMBER OF WORDS PER C 708 +$: RECORD IS WRITTEN, THE BALANCE OF THE RECORD REMAINS UNCHANGED FROM WHAT WAS C 708 +$: LAST IN THE FILE BUFFER, SO THAT ON BEING PRINTED "GARBAGE", APPEARS AT THE C 708 +$: END OF SUCH LINES. C 708 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 708 +$: C 708 +SAVE FILE OUT LINE DISK SERIAL [20:1200] (1,17,90,SAVE 1); % PRINT FILE 10036000 C 708 + % AVOID BLOCKING RECORDS OF VARIABLE LENGTH 10036001 C 708 +ARRAY ICARD, ALGOLCARD[0:9], LINES, XLINE[0:16]; 10130000 C 708 + % AVOID BLOCKING VARIABLE LENGTH RECORDS 10130001 C 708 +ARRAY HEADTEXT, ERRLINE[0:16]; 10133000 C 708 + WRITE( LINE[NO],17,XLINE[*]); 20042000 C 708 + WRITE( LINE[NO],17,XLINE[*]); 20043000 C 708 + WRITE(LINE, 17,LINES[*]); 20045000 C 708 + WRITE(LINE, 17,ERRLINE[*]); 20195000 C 708 + LINEPNT :=POINTER(LINES[1]); 20315000 C 708 + REPLACE LINEPNT-8 BY " " FOR 17 WORDS; 20317000 C 708 + REPLACE XLINEPNT-8 BY LINEPNT-8 FOR 17 WORDS; 20318000 C 708 + REPLACE POINTER(ERRLINE[*]) BY "**** ", LINEPNT FOR 16 WORDS; 20319000 C 708 + REPLACE ALGOLPNT BY LINEPNT FOR 9 WORDS; 20321000 C 708 + REPLACE POINTER(HEADTEXT[*]) BY LINEPNT FOR 10 WORDS, "PAGE 1 ", 20326000 C 708 + LINEPNT FOR 6 WORDS; 20326100 C 708 + WRITE(LINE, 17,XREFLINE[*]); 20549000 C 708 + LOCK( LINE, * ); % & CRUNCH 20550000 C 708 + WRITE(LINE, 17,XREFLINE[*]); LINECNT:=LINECNT+1; 20560000 C 708 + WRITE(LINE, 17,XREFLINE[*]); LINECNT:=LINECNT+1; 20571000 C 708 + WRITE(LINE, TERMMESS); 90084000 C 708 + WRITE(LINE, NOERRORS); 90111000 C 708 + WRITE(LINE, ERRORS,NUMERRS); 91110000 C 708 + WRITE(LINE, ERRORMESS1[I]); 91112000 C 708 + WRITE(LINE, ERRORMESS2[I-60]); 91114000 C 708 + + + + +$# PATCH 709 FOR PASCAL.XVI.O CONTAINS 17 CARDS. NO PRINT IF NO LIST & NO ERRORS C 709 + + +$: TO OPEN THE PRINT FILE ONLY IF THE LIST OPTION IS SET OR IF SYNTAX ERRORS C 709 +$: ARE DETECTED. IF THE FIRST CARD IN THE PASCAL SOURCE RESETS THE LIST OPTION C 709 +$: (*$L- *) AND NO SYNTAX ERRORS ARE DETECTED, THEN THE PRINT FILE WILL NOT BE C 709 +$: CREATED (EVEN FOR THE HEADING) AS FOR OTHER COMPILERS. IN PARTICULAR, THIS C 709 +$: IMPLEMENTATION DOES NOT REQUIRE A TEST PRIOR TO PRINTING EACH LINE TO C 709 +$: DETERMINE WHETHER A HEADING HAS BEEN PRINTED. IT ONLY DOES THIS TEST WHEN C 709 +$: THE LIST OPTION IS SET AFTER THE FIRST CARD OR EXPLICITLY THEREAFTER, OR C 709 +$: IN THE "PRINTERRORS" ROUTINE. C 709 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 709 +$: C 709 + IF PAGECNT=1 THEN WRITE(LINE[NO],17,HEADTEXT[*]) ELSE 20029900 C 709 + WRITE( LINE[PAGE]); 20030000 C 709 + WRITE( LINE[DBL],17,HEADTEXT[*]); 20031000 C 709 + IF NOT LISTOPTION THEN 20194000 C 709 + BEGIN IF PAGECNT=0 THEN HEADING; PRINTLINE END; 20194100 C 709 + REPLACE POINTER(HEADTEXT[*])+45 BY TEXTPNT+5 FOR 2,"/", 20329000 C 709 + TEXTPNT+1 FOR 2, "/", TEXTPNT+3 FOR 2; 20330000 C 709 + NEWCARD; LISTOPTION:=CHECKOPTION:=TRUE; % DEFAULT 20402100 C 709 + INSYMBOL; % ANALYSING FIRST CARD MAY CHANGE DEFAULT LIST OPTN 20402200 C 709 + IF LISTOPTION AND PAGECNT=0 THEN HEADING; % ON FIRST PAGE. 20402300 C 709 + IF LISTOPTION THEN IF PAGECNT=0 THEN HEADING; % ON FIRST PAGE30282100 C 709 +C := " "; % TO INITIALIZE "INSYMBOL" 90034000 C 709 +INITIALIZE; % COMPILER TABLES, NEWCARD, INSYMBOL 90035000 C 709 +$ 90036000 C 709 +IF PAGECNT > 0 % THERE HAS BEEN SOME LISTING 90088000 C 709 +THEN BEGIN WRITE( LINE[DBL] ); WRITE( LINE[DBL] ) END; 90089000 C 709 + IF PAGECNT>0 THEN % THERE HAS BEEN LISTING 90110000 C 709 + + + + +$# PATCH 710 FOR PASCAL.XVI.0 CONTAINS 4 CARDS. NO OVERPRINTING WITH BLANK LINE C 710 + + +$: TO PREVENT OVERPRINTING WITH BLANK LINES. IF THE OPTION FOR "BOLDFACE" C 710 +$: PRINTING OF RESERVED WORDS IS SET (*$R+ *) THEN EACH LINE IS CONSTRUCTED BY C 710 +$: 2 OVERPRINTS FOR THE RESERVED WORDS ONLY, THEN ONE PRINT OF THE FULL TEXT. C 710 +$: THE AIM OF THIS PATCH IS TO SKIP THE OVERPRINTING FOR ALL THOSE LINES IN C 710 +$: WHICH NO RESERVED WORDS OCCUR. C 710 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 710 +$: C 710 +DEFINE RESWORDPRESENT = RESWORDOPTION.[1:1] #; 10159100 C 710 + IF REAL(RESWORDOPTION) = 3 THEN % RESERVED WORD IS PRESENT 20040000 C 710 + RESWORDOPTION := RESWORDOPTION AND TRUE; % RESET RESWORDPRESENT 20057100 C 710 + RESWORDOPTION := BOOLEAN(3); % SET RESWORDPRESENT BIT 30179000 C 710 + + + + +$# PATCH 711 FOR PASCAL.XVI.O CONTAINS 10 CARDS. PASC001/USERCODE UNIQUE NAME C 711 + + +$: TO GENERATE A UNIQUE FILE NAME IN THE DISK DIRECTORY. THIS PATCH CHANGES THE C 711 +$: METHOD FOR GENERATING A UNIQUE FILE NAME FOR THE ALGOL SOURCE CODE OUTPUT OF C 711 +$: THE COMPILER. FORMERLY, THIS WAS DONE USING THE TIME FUNCTION TO OBTAIN C 711 +$: SOME RANDOM DIGITS. THE METHOD USED IN PATCH/MERGE IS ADOPTED HERE, NAMELY C 711 +$: STARTING WITH THE PREFIX (MFID) "PASC001", A SEARCH IS PERFORMED TO DETERMINE C 711 +$: WHETHER SUCH A FILE NAME IS ALREADY CATALOGUED. IF SO, 1 IS ADDED AND THE C 711 +$: SEARCH REPEATED. IN ADDITION, THE FILE IS CREATED WITH A SAVE FACTOR C 711 +$: (RETENTION PERIOD) OF ZERO DAYS SO THAT A HALT-LOAD WILL REMOVE THE FILE C 711 +$: AUTOMATICALLY. C 711 +$: SEE PATCH 704. C 711 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 711 +$: C 711 +PROCEDURE SEARCHDISKDIRECTORY( F, A ); FILE F; ARRAY A[0]; 20222100 C 711 + SEARCH( F, A[*] ); % END OF SEARCHDISKDIRECTORY; 20222200 C 711 + 20222300 C 711 + CHARPNT := POINTER(CH[0])+7; CH[0] := " "; 20322000 C 711 +CH[0] := "PASC000"; CHARPNT := POINTER(CH[0])+5; 90016000 C 711 +PASCALGOL.FID := USER := TIME(-1); 90017000 C 711 +DO BEGIN C:=C+1; REPLACE CHARPNT BY C FOR 3 DIGITS; 90018000 C 711 + PASCALGOL.MFID := ALGOLNAME := CH[0]; 90019000 C 711 + SEARCHDISKDIRECTORY( PASCALGOL, LINES[*] ); 90020000 C 711 +END UNTIL LINES[0]=-1; % FILE NOT ON DISK 90021000 C 711 + + + + +$# PATCH 712 FOR PASCAL.XVI.O CONTAINS 2 CARDS. MARK PROCEDURE LEVELS IN MARGIN C 712 + + +$: PATCH TO MARK THE START AND END OF PROCEDURES AND FUNCTIONS BY ANNOTATING THE C 712 +$: MARGIN WITH THE SYMBOLS "+P" & "-P" FOLLOWED BY THE LEVEL NUMBER. C 712 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 712 +$: C 712 + MARGIN("+P",CURLEVEL); % MARK PROCEDURE LEVEL 80420100 C 712 + MARGIN("-P",CURLEVEL); % MARK END OF PROCEDURE 80702100 C 712 + + + + +$# PATCH 713 FOR PASCAL.XVI.O. CONTAINS 14 CARDS.CORRECTS ERROR MESSAGE ETC. C 713 + + +$: CORRECTS THE DOUBLE "NO ERRORS" MESSAGE AND THE OUTPUT OF HEADINGS C 713 +$: WHEN L1 IS SET AFTER L-. C 713 +$: ALSO CORRECTS THE SCANNING PROBLEM WHEN COMPILER OPTIONS ARE INCORRECT. C 713 +$: DAVID A COOPER, HERIOT-WATT UNIVERISTY ...... AUGUST 1978 C 713 +$: C 713 + ERROR102MESS(//"102 *** WARNING ONLY, ILLEGAL COMPILER OPTION.")10188750 C 713 + , % 10188751 C 713 + IF ERRNUM=100 OR ERRNUM=102 20181600 C 713 + THEN NUMERRS := NUMERRS - 1; %*ERROR NUMBER 102 IS ONLY AN ILLEGAL 20181610 C 713 +% * DOLLAR OPTION WARNING & 20181620 C 713 +% *ERROR NUMBER 100 ALONE SHOULD NOT 20181650 C 713 + ELSE LISTOPTION := C="+" ELSE 30265000 C 713 + END 30280800 C 713 + ELSE ERROR(102); 30280810 C 713 + IF ERR(102) THEN 90090710 C 713 + WRITE(LINE,ERROR102MESS); 90090720 C 713 +$ 90110000 C 713 +$ 90111000 C 713 + ("102 ***WARNING ONLY, ILLEGAL DOLLAR OPTION."), 91106900 C 713 + + + + +$# PATCH 800 FOR PASCAL.XVI.O.CONTAINS 10 CARDS. C 800 + + +$: TO REMOVE CONFLICTS BETWEEN HERIOT-WATT & NATAL EXISTING PATCHES. C 800 +$: C 800 + MAXSYMS = 800#, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 C 800 + MAXPNTRS = 25#; %MAX NUMBER OF UNDECLARED POINTERS(FORWD). 10056000 C 800 +DEFINE ERR(ERR1) = BOOLEAN(0&ERRP[(ERR1).[6:2]][0:((ERR1).[4:5]):1])#; 10156100 C 800 +INTEGER EXPRLEVEL, EXPINVARCNT; % 40018000 C 800 + INTEGER INDEX, CTYPE, NUMFORWARDS,TX, I; % 80403000 C 800 +INTEGER PROGNAMELENGTH; % 90013900 C 800 + IF ERR(100) % 90090600 C 800 + "; ALGOL FILE TAPE=PASCRUN/DISK SERIAL; ALGOL FILE CARD=", 90119000 C 800 + P(PALGOLNAME),"/",P(PUSER)," SERIAL;", % 90120000 C 800 + " XALGOL STACK = 2048; END."; % 90120500 C 800 + + + + +$# PATCH 998 FOR PASCAL.XVI.O CONTAINS 10 CARDS. INSERT PAGE THROWS AT DESIRED C 998 + + +$: PATCH TO INSERT PAGE THROWS AT DESIRED POINTS IN THE SOURCE TO PRODUCE A C 998 +$: NICELY LAID OUT LISTING. C 998 +$: C 998 +$ PAGE 19000000 C 998 +$ PAGE 20290000 C 998 +$ PAGE 29000000 C 998 +$ PAGE 39000000 C 998 +$ PAGE 49000000 C 998 +$ PAGE 59000000 C 998 +$ PAGE 69000000 C 998 +$ PAGE 79000000 C 998 +$ PAGE 89000000 C 998 +$ PAGE 90070999 C 998 +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 998 +$: C 998 + + + + +$# PATCH 999 FOR PASCAL.XVI.O. CONTAINS 1 CARDS. VERISON NUMBER. C 999 + + +$: C 999 +DEFINE EDITION = "4.4"#;%AUGUST 1978...DAVID A COOPER... 10028000 C 999 + + CONFLICTS +********** ********************************************************************************** + + + + + +FILE CARD "SOURCE" (1,10,30); % PASCAL SOURCE CODE INPUT FILE 10035000 C 703 CONFLICTED WITH: +FILE CARD "SOURCE" (1,10,30); % SOURCE CODE FILE 10035000 C 002 DISCARDED + + +SAVE FILE OUT LINE DISK SERIAL [20:1200] (1,17,90,SAVE 1); % PRINT FILE 10036000 C 708 CONFLICTED WITH: +FILE LINES 1 (1,17); % PRINT FILE 10036000 C 002 DISCARDED + + +FILE PASCALGOL DISK SERIAL [20:300] (1,10,30,SAVE 0); % ALGOL CODE FILE10037000 C 703 CONFLICTED WITH: +FILE PASCALGOL DISK SERIAL [20:600] (1,10,30,SAVE 0); % CODE FILE 10037000 C 002 DISCARDED + + + MAXSYMS = 800#, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 C 800 CONFLICTED WITH: + MAXSYMS =200 #, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 C 701 DISCARDED + + + MAXPNTRS = 25#; %MAX NUMBER OF UNDECLARED POINTERS(FORWD). 10056000 C 800 CONFLICTED WITH: + MAXPNTRS =10 #; %MAX NUMBER OF UNDECLARED POINTERS (FORWD).10056000 C 701 DISCARDED + + +FILE XREFFILE DISK SERIAL [20:3000] (1,3,30); % FOR CROSS REFERENCE 10137000 C 703 CONFLICTED WITH: +FILE XREFFILE DISK SERIAL [20:3000] (1,3,30); 10137000 C 002 DISCARDED + + +DEFINE ERR(ERR1) = BOOLEAN(0&ERRP[(ERR1).[6:2]][0:((ERR1).[4:5]):1])#; 10156100 C 800 CONFLICTED WITH: +DEFINE ERR[ERR1] = BOOLEAN(0&ERRP[ERR1.[6:2]][0:ERR1.[4:5]:1]) #; 10156100 C 702 DISCARDED + + + IF ERRNUM=100 OR ERRNUM=102 20181600 C 713 CONFLICTED WITH: + IF ERRNUM=100 20181600 C 002 DISCARDED + + +% *ERROR NUMBER 100 ALONE SHOULD NOT 20181650 C 713 CONFLICTED WITH: + THEN NUMERRS:=NUMERRS-1;% * ERROR NUMBER 100 ALONE SHOULD NOT 20181650 C 002 DISCARDED + + + END 30280800 C 713 CONFLICTED WITH: + END; 30280800 C 002 DISCARDED + + +INTEGER EXPRLEVEL, EXPINVARCNT; % 40018000 C 800 CONFLICTED WITH: +INTEGER EXPRLEVEL; 40018000 C 700 DISCARDED +INTEGER EXPRLEVEL,TX,EXPINVARCNT;% 40018000 C 002 DISCARDED + + +$ 40105100 C 615 CONFLICTED WITH: + IF INSIDEPARENS AND TYPETAB1[CURTYPE].STRUCT > 0 AND 40105100 C 518 DISCARDED + + +$ 40105200 C 615 CONFLICTED WITH: + TYPETAB1[CURTYPE].FORM < FILES THEN 40105200 C 518 DISCARDED + + +$ 40105300 C 615 CONFLICTED WITH: + PUTID("H",1000×THISLEVEL+THISINDEX,5) 40105300 C 518 DISCARDED + + +$ 40105400 C 615 CONFLICTED WITH: + ELSE 40105400 C 518 DISCARDED + + + SPLIT(FIRSTSYM,1); 40650000 C 603 CONFLICTED WITH: + SPLIT(STARTSYM,1); % 40650000 C 601 DISCARDED + + + IF CURSY = PLUS THEN SYMTAB[FIRSTSYM] := "SUNIO(" ELSE 40651000 C 603 CONFLICTED WITH: + IF CURSY=PLUS THEN SYMTAB[STARTSYM] := "SUNIO(" ELSE % 40651000 C 601 DISCARDED + + + IF CURSY = MINUS THEN SYMTAB[FIRSTSYM] := "SDIFF(" ELSE 40652000 C 603 CONFLICTED WITH: + IF CURSY=MINUS THEN SYMTAB[STARTSYM] := "SDIFF(" ELSE % 40652000 C 601 DISCARDED + + + ERROR(64); 40653000 C 603 CONFLICTED WITH: + ERROR(64); % 40653000 C 601 DISCARDED + + + INTEGER INDEX, CTYPE, NUMFORWARDS,TX, I; % 80403000 C 800 CONFLICTED WITH: + INTEGER INDEX, CTYPE, NUMFORWARDS, T3, TX, I; 80403000 C 503 DISCARDED + + + INTEGER INDEX, CTYPE, NUMFORWARDS,TX, I; % 80403000 C 800 CONFLICTED WITH: + INTEGER INDEX, CTYPE, NUMFORWARDS, T, TX, I; 80403000 C 002 DISCARDED + + + IF FOUND AND (THISID.IDCLASS=PROC OR THISID.IDCLASS=FUNC) THEN 80548000 C 600 CONFLICTED WITH: + IF FOUND AND THISID.IDCLASS≥FUNC THEN 80548000 C 504 DISCARDED + + + NAMETAB3[CURLEVEL,THISINDEX].FORWARDDEF:=0; 80553000 C 504 CONFLICTED WITH: + NAMETAB3[CURLEVEL,THISINDEX].FORWARDDEF := 0; 80553000 C 002 DISCARDED + + + IF ERR(100) % 90090600 C 800 CONFLICTED WITH: + IF ERR[100]% 90090600 C 002 DISCARDED + + +$ 90110000 C 713 CONFLICTED WITH: + IF PAGECNT>0 THEN % THERE HAS BEEN LISTING 90110000 C 709 DISCARDED + + +$ 90111000 C 713 CONFLICTED WITH: + WRITE(LINE, NOERRORS); 90111000 C 708 DISCARDED +$VOIDT 90111000 C 002 DISCARDED + + + "; ALGOL FILE TAPE=PASCRUN/DISK SERIAL; ALGOL FILE CARD=", 90119000 C 800 CONFLICTED WITH: + "; ALGOL FILE TAPE= PASCAL/PRELUDE SERIAL; ALGOL FILE CARD=", 90119000 C 705 DISCARDED + + + P(PALGOLNAME),"/",P(PUSER)," SERIAL;", % 90120000 C 800 CONFLICTED WITH: + P(PALGOLNAME), "/", P(PUSER), " SERIAL; END."; 90120000 C 705 DISCARDED + + + " XALGOL STACK = 2048; END."; % 90120500 C 800 CONFLICTED WITH: + " XALGOL STACK = 2048; STACK = 1024; END."; % 90120500 C 519 DISCARDED + + + + GENERATED OUTPUT +********** ********************************************************************************** + + + +? COMPILE PASCAL/NEW XALGOL LIBRARY 00000001 +? XALGOL STACK=800 00000002 +? XALGOL FILE TAPE=SYMBOL/PASCAL SERIAL 00000003 +? XALGOL FILE NEWTAPE=SYMNEW/PASCAL SERIAL 00000004 +? XALGOL FILE LINE=LINE PRINT 00000005 +? DATA CARD 000000≥ +$ TAPE LIST SINGLE SEQXEQ NEW TAPE +DEFINE EDITION = "4.4"#;%AUGUST 1978...DAVID A COOPER... %999-10028000 C 999 +INTEGER NUMERRS, % @R+25: NUMBER OF ERRORS IN PROGRAM. %500-10029000 C 500 + SAVEFACTOR, % @R+26: SAVEFACTOR FOR CODE FILE. %500-10030000 C 500 + PAGECNT, % @R+27: NUMBER OF PAGES PRINTED. %500-10033800 C 500 + CARDCNT; % @R+30: NUMBER OF CARDS READ. %500-10034000 C 500 +FILE CARD "SOURCE" (1,10,30); % PASCAL SOURCE CODE INPUT FILE %703-10035000 C 703 +SAVE FILE OUT LINE DISK SERIAL [20:1200] (1,17,90,SAVE 1); % PRINT FILE 10036000 C 708 + % AVOID BLOCKING RECORDS OF VARIABLE LENGTH%708-10036001 C 708 +FILE PASCALGOL DISK SERIAL [20:300] (1,10,30,SAVE 0); % ALGOL CODE FILE10037000 C 703 +DEFINE LINESPERPAGE = 60 #, %502-10038000 C 502 +DEFINE MAXTABLES = 30 #, %MAX NUMBER OF LEVELS IN IDENTIFIER TABLE.10042000 C 701 + MAXNAMES =307 #, %MAX NAMES IN EACH ROW OF IDENTIFIER TABLE.10043000 C 701 + % ONLY USED IN WITH STATEMENT TO TEST %701-10044001 C 701 + MAXCASES =64 #, %MAX LABELS IN A CASE-STATEMENT. %701-10045000 C 701 + MAXLABS =50 #, %MAX NUMBER OF IN PROGRAM LABELS. %701-10046000 C 701 + MAXPARAMS =200 #, %MAX NUMBER OF PARAMETERS IN WHOLE PROGRAM.10047000 C 701 + MAXTYPES =250 #, %MAX NUMBER OF DIFFERENT TYPES. %701-10048000 C 701 + MAXCONSTS =100 #, %SIZE OF TABLE FOR CONSTANTS. %701-10049000 C 701 + MAXWITHSYMS= 70 #, %MAX NUMBER OF SYMBOLS USED BY WITH-STATMS.10051000 C 701 + MAXSYMS = 800#, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 C 800 + LISTLENGTH =100 #, %MAX LENGTH OF VAR AND PARAM LISTS. %701-10053000 C 701 + MAXEXTFILES=10 #, %MAX NUMBER OF EXTERNAL FILES. %701-10054000 C 701 + MAXFILES =10 #, %MAX NUMBER OF FILES DECLARED AT ONE TIME. 10055000 C 701 + MAXPNTRS = 25#; %MAX NUMBER OF UNDECLARED POINTERS(FORWD). 10056000 C 800 +ARRAY PARAMTAB, FORWPARAM1, FORWPARAM2[0:MAXPARAMS]; %002-10109000 C 002 +ARRAY ICARD, ALGOLCARD[0:9], LINES, XLINE[0:16]; %708-10130000 C 708 + % AVOID BLOCKING VARIABLE LENGTH RECORDS 10130001 C 708 +ARRAY HEADTEXT, ERRLINE[0:16]; %708-10133000 C 708 + INTEGER LINECNT, ERRINX; % PAGECNT @ PRT+27 %500-10134000 C 500 +FILE XREFFILE DISK SERIAL [20:3000] (1,3,30); % FOR CROSS REFERENCE 10137000 C 703 +ALPHA ARRAY XBUFF[0:2]; %002-10138500 C 002 +BOOLEAN XINB; %002-10138550 C 002 +ALPHA ARRAY SYMTAB[0:MAXSYMS]; % USED BY "EXPRESSION". %517-10144000 C 517 +INTEGER ARRAY SYMKIND[0:62]; %USED IN ERROR RECOVERY. %002-10149000 C 002 +ARRAY ERRP[0:3]; % HOLDS 128 BITS % RECORDS ERROR MESSAGES USED. 10156000 C 702 +DEFINE ERR(ERR1) = BOOLEAN(0&ERRP[(ERR1).[6:2]][0:((ERR1).[4:5]):1])#; 10156100 C 800 + DEFINE %518-10156200 C 518 + PERMSUB = 0 #, MAXTOTALSUBSCRS = 100#, %518-10156300 C 518 + ARRNAM = 1 #; %518-10156400 C 518 + ARRAY ARRSUBPERMTAB[0:1,0:MAXTOTALSUBSCRS]; %518-10156500 C 518 + INTEGER PASSPERMTAB, MAXPERMTAB, REMEMBERPOSN; %518-10156600 C 518 +DEFINE RESWORDPRESENT = RESWORDOPTION.[1:1] #; %710-10159100 C 710 +$ %700-10167000 C 700 +$ %700-10168000 C 700 +$ %700-10169000 C 700 + ERRORS (I5," ERRORS DETECTED ",20("#") /), %704-10188000 C 704 + ERROR100MESS (//"100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION10188500 C 002 +. THE VALUE 07 IS SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT TH10188600 C 002 +E COMPILATION ERRORS COUNT."//),% %002-10188700 C 002 + ERROR102MESS(//"102 *** WARNING ONLY, ILLEGAL COMPILER OPTION.")10188750 C 713 + , % %713-10188751 C 713 + ALIST ("$ SET LIST "), %704-10189000 C 704 + MERGE ("$ SET TAPE RESET $" / %704-10190100 C 704 + "$ RESET TAPE", T73,"99000000" ), %704-10190200 C 704 + TERMMESS ("**** COMPILATION TERMINATED."); %704-10192000 C 704 + PACKEDSY=61#, ASSERTSY=62#; %002-10211000 C 002 +$ PAGE %998-19000000 C 998 + VALUE NAME1,NAME2,TABLE,DECL; %700-20016000 C 700 + REAL NAME1,NAME2; %700-20017000 C 700 + INTEGER TABLE; BOOLEAN DECL; %700-20018000 C 700 + FORWARD; %700-20019000 C 700 +PROCEDURE PRINTERRORS; FORWARD; %700-20020000 C 700 +PROCEDURE HEADING; %*** PRINTS A HEADING AT START OF NEW PAGE.20026000 C 700 +BEGIN DEFINE NEWSEGMENT = HERE #; %700-20027000 C 700 + IF PAGECNT=1 THEN WRITE(LINE[NO],17,HEADTEXT[*]) ELSE %709-20029900 C 709 + WRITE( LINE[PAGE]); %709-20030000 C 709 + WRITE( LINE[DBL],17,HEADTEXT[*]); %709-20031000 C 709 +END OF HEADING; %700-20033000 C 700 +PROCEDURE PRINTLINE; %*** PRINTS A PASCAL SOURCE CODE LINE %700-20036000 C 700 +BEGIN DEFINE NEWSEGMENT = HERE #; %700-20037000 C 700 + IF REAL(RESWORDOPTION) = 3 THEN % RESERVED WORD IS PRESENT %710-20040000 C 710 + WRITE( LINE[NO],17,XLINE[*]); %708-20042000 C 708 + WRITE( LINE[NO],17,XLINE[*]); %708-20043000 C 708 + WRITE(LINE, 17,LINES[*]); %708-20045000 C 708 +END OF PRINTLINE; %700-20047000 C 700 +PROCEDURE NEWCARD; %*** READS A NEW PASCAL SOURCE CODE CARD 20050000 C 700 +BEGIN DEFINE RESULT = ICARD[*], ETC #; %700-20051000 C 700 + REPLACE XLINEPNT BY " " FOR 16 WORDS; %700-20056000 C 700 + REPLACE LINEPNT BY CARDPNT FOR 10 WORDS, XLINEPNT FOR 6 WORDS;%700-20057000 C 700 + RESWORDOPTION := RESWORDOPTION AND TRUE; % RESET RESWORDPRESENT 20057100 C 710 +END OF NEWCARD; %700-20061000 C 700 +DEFINE GEN(GEN1,GEN2,GEN3) = GENI(TRUE,GEN1,GEN3,GEN2) #, %700-20063100 C 700 +GENID(GENID1,GENID2,GENID3)= GENI(FALSE,GENID1,GENID2,GENID3) #; %700-20063200 C 700 + %700-20063300 C 700 +PROCEDURE GENI(GENT, TXT, NUM, N ); %700-20063400 C 700 +VALUE GENT, TXT, NUM, N; %700-20063500 C 700 +BOOLEAN GENT; ALPHA TXT; INTEGER NUM, N; %700-20063600 C 700 +BEGIN DEFINE START = NUM #, NDIG = N #; %700-20063700 C 700 + %700-20063800 C 700 + IF GENT THEN %*** GENERATE A TEXT "TXT", CONSISTING OF 20064000 C 700 + TEXT[0] := TXT; %700-20067000 C 700 +END %700-20070000 C 700 +ELSE %*** GENERATE AN ALGOL IDENTIFIER. %700-20073000 C 700 + CH[0] := TXT; %700-20076000 C 700 +END END GENI; %700-20079000 C 700 +PROCEDURE GENINT( N ); %700-20082000 C 700 +VALUE N; INTEGER N; %700-20083000 C 700 +BEGIN DEFINE RESULT = ALGOL CODE #; %700-20084000 C 700 + INTEGER NABS, NSIZE; %700-20085000 C 700 +END OF GENINT; %700-20097000 C 700 +PROCEDURE WRITEALGOL; %*** WRITES A COMPLETED ALGOL CARD TO%700-20145000 C 700 + DEFINE NEWSEGMENT = HERE #; %700-20146100 C 700 + IF DUMPOPTION THEN BEGIN IF (LINECNT:=LINECNT+1)≥LINESPERPAGE %502-20149000 C 502 + THEN HEADING; WRITE(LINE,10,ALGOLCARD[*]) END; %502-20149100 C 502 + DEFINE NEWSEGMENT = HERE #; %700-20168100 C 700 + DEFINE NEWSEGMENT = HERE #; %700-20180100 C 700 + IF ERRNUM<0 THEN ERRNUM:=ABS(ERRNUM) ELSE %511-20180900 C 511 +% %002-20181500 C 002 +% %002-20181550 C 002 + IF ERRNUM=100 OR ERRNUM=102 %713-20181600 C 713 + THEN NUMERRS := NUMERRS - 1; %*ERROR NUMBER 102 IS ONLY AN ILLEGAL 20181610 C 713 +% * DOLLAR OPTION WARNING & %713-20181620 C 713 +% *ERROR NUMBER 100 ALONE SHOULD NOT %713-20181650 C 713 +% * PREVENT THE XALGOL COMPILATION BEING 20181700 C 002 +% * ZIPPED AS THE VALUE 7 IS SUBSTITUTED 20181750 C 002 +% * FOR A BAD SAVE CONSTANT IN AN "S"%002-20181800 C 002 +% * OPTION. %002-20181850 C 002 +% %002-20181900 C 002 +% %002-20181950 C 002 + ERRP[ERRNUM.[6:2]]:=ERRP[ERRNUM.[6:2]] & 1[ERRNUM.[4:5]:0:1]; %702-20182000 C 702 + DEFINE NEWSEGMENT = HERE #; %700-20193100 C 700 + IF NOT LISTOPTION THEN %709-20194000 C 709 + BEGIN IF PAGECNT=0 THEN HEADING; PRINTLINE END; %709-20194100 C 709 + REPLACE POINTER(ERRLINE[0])+4 BY NUMERRS FOR 4 DIGITS; %702-20194900 C 702 + WRITE(LINE, 17,ERRLINE[*]); %708-20195000 C 708 +DEFINE HASH(HASH1) = ENTIER((HASH1) MOD MAXNAMES) #; %505-20202000 C 505 +ALPHA THISID, CURNAME1, CURNAME2; % USED IN SCANNER %700-20205000 C 700 +PROCEDURE SEARCHTAB( TAB ); %*** SEARCH NAME TABLE "TAB" FOR THE %700-20208000 C 700 +VALUE TAB; INTEGER TAB; %*** IDENTIFIER JUST READ. %700-20208100 C 700 +BEGIN ALPHA TNAME; INTEGER WRAPAROUND; %505-20209000 C 505 + WRAPAROUND:=THISINDEX:=HASH(CURNAME1); %505-20210000 C 505 + IF THISINDEX=WRAPAROUND THEN TNAME:=0; % TABLE IS FULL %505-20216100 C 505 +END OF SEARCHTAB; %700-20221000 C 700 +PROCEDURE SEARCHDISKDIRECTORY( F, A ); FILE F; ARRAY A[0]; %711-20222100 C 711 + SEARCH( F, A[*] ); % END OF SEARCHDISKDIRECTORY; %711-20222200 C 711 + %711-20222300 C 711 +PROCEDURE SEARCH; %*** SEARCH ALL TABLES CURRENTLY IN USE. 20223000 C 700 +BEGIN DEFINE RESULT = THISID #; %700-20224000 C 700 +END OF SEARCH; %700-20233000 C 700 +PROCEDURE NEWNAME( NAME1,NAME2, TAB ); %700-20236000 C 700 +VALUE NAME1, NAME2, TAB; %700-20236100 C 700 +ALPHA NAME1, NAME2; INTEGER TAB; %700-20236200 C 700 + ALPHA TNAME; INTEGER WRAPAROUND; %505-20237100 C 505 + WRAPAROUND:=THISINDEX:=HASH(NAME1); %505-20238000 C 505 + IF THISINDEX=WRAPAROUND THEN % TABLE AT THIS LEVEL IS FULL 20244100 C 505 + BEGIN ERROR(40); NAME1:=TNAME; NAME2:=NAMETAB2[TAB,THISINDEX]20244200 C 505 + END; %505-20244300 C 505 +END OF NEWNAME; %700-20250000 C 700 +$ PAGE %998-20290000 C 998 + 7(INITIAL),MIDDLE,INITIAL; %002-20308000 C 002 + LINEPNT :=POINTER(LINES[1]); %708-20315000 C 708 + REPLACE LINEPNT-8 BY " " FOR 17 WORDS; %708-20317000 C 708 + REPLACE XLINEPNT-8 BY LINEPNT-8 FOR 17 WORDS; %708-20318000 C 708 + REPLACE POINTER(ERRLINE[*]) BY "**** ", LINEPNT FOR 16 WORDS; 20319000 C 708 + REPLACE ALGOLPNT BY LINEPNT FOR 9 WORDS; %708-20321000 C 708 + CHARPNT := POINTER(CH[0])+7; CH[0] := " "; %711-20322000 C 711 + REPLACE POINTER(HEADTEXT[*]) BY LINEPNT FOR 10 WORDS, "PAGE 1 ", 20326000 C 708 + LINEPNT FOR 6 WORDS; %708-20326100 C 708 + REPLACE POINTER(HEADTEXT[*])+45 BY TEXTPNT+5 FOR 2,"/", %709-20329000 C 709 + TEXTPNT+1 FOR 2, "/", TEXTPNT+3 FOR 2; %709-20330000 C 709 +NILTYPE := 6; %*** TYPE OF "NIL" *** %602-20363000 C 602 +T1.FORM := POINTERS; TYPETAB1[6] := T1; %602-20364000 C 602 +EMPTYSET := 7; % %602-20364500 C 602 +T1.FORM := SET; TYPETAB1[7] := T1; %602-20365000 C 602 +NUMTYPES := 7; % %602-20365500 C 602 + NEWNAME("50PRT25",0,0); %*** "PRT25" *** %501-20369100 C 501 + T3:=INTTYPE; T3.IDCLASS:=VAR; % GLOBAL INTEGER VARIABLE %501-20369200 C 501 + NAMETAB3[0,THISINDEX] := T3; %501-20369300 C 501 + "400READ", "6READLN", "50RESET", "6UNPACK", "50WRITE", %002-20373000 C 002 + "6QQJZXL" DO %002-20373500 C 002 + NEWNAME("7CPUTIM","E",0); NAMETAB3[0,THISINDEX]:=T3; %514-20390000 C 514 + NEWCARD; LISTOPTION:=CHECKOPTION:=TRUE; % DEFAULT %709-20402100 C 709 + INSYMBOL; % ANALYSING FIRST CARD MAY CHANGE DEFAULT LIST OPTN 20402200 C 709 + IF LISTOPTION AND PAGECNT=0 THEN HEADING; % ON FIRST PAGE. %709-20402300 C 709 + DEFINE NEWSEGMENT = HERE #; %700-20515100 C 700 + IF DECL THEN AX := -AX; %002-20520000 C 002 + DEFINE NEWSEGMENT = HERE #; %700-20533100 C 700 + ABS(A[2]) LEQ ABS(B[2]); %002-20539000 C 002 +% %002-20541100 C 002 +% %002-20541150 C 002 +% %002-20541200 C 002 +BOOLEAN PROCEDURE XREFINPUT(A); %002-20541250 C 002 +ARRAY A[0]; %002-20541300 C 002 +BEGIN %002-20541350 C 002 + LABEL EOF; %002-20541400 C 002 + INTEGER I; %002-20541450 C 002 +% %002-20541500 C 002 + READ(XREFFILE,3,XBUFF[*])[EOF]; %002-20541550 C 002 + FOR I:=0,1,2 DO %002-20541600 C 002 + A[I] := XBUFF[I]; %002-20541650 C 002 + IF FALSE THEN EOF: BEGIN %002-20541700 C 002 + CLOSE(XREFFILE,RELEASE); %002-20541750 C 002 + XINB := TRUE; %002-20541800 C 002 + END; %002-20541850 C 002 + XREFINPUT := XINB; %002-20541900 C 002 +% %002-20541950 C 002 +END OF XREFINPUT; %002-20541960 C 002 + DEFINE NEWSEGMENT = HERE #; %700-20546100 C 700 + WRITE(LINE, 17,XREFLINE[*]); %708-20549000 C 708 + LOCK( LINE, * ); % & CRUNCH %708-20550000 C 708 + WRITE(LINE, 17,XREFLINE[*]); LINECNT:=LINECNT+1; %708-20560000 C 708 + A2 := -A2; %002-20570000 C 002 + WRITE(LINE, 17,XREFLINE[*]); LINECNT:=LINECNT+1; %708-20571000 C 708 +PROCEDURE CHECKTYPES( LEFTTYPE, RIGHTTYPE ); %700-20802000 C 700 +VALUE LEFTTYPE, RIGHTTYPE; INTEGER LEFTTYPE, RIGHTTYPE; %700-20803000 C 700 +BEGIN %700-20804000 C 700 + REAL TT1, TT2; INTEGER F1, F2, LT, RT; %700-20805000 C 700 + IF(F1 NEQ SET OR RT NEQ EMPTYSET) % %600-20813000 C 600 + AND % %600-20813050 C 600 + (F2 NEQ SET OR LT NEQ EMPTYSET) THEN % %600-20813100 C 600 + IF(F1 NEQ POINTERS OR RT NEQ NILTYPE) % %600-20814000 C 600 + AND % %600-20814050 C 600 + (F2 NEQ POINTERS OR LT NEQ NILTYPE) THEN % %600-20814100 C 600 +END OF CHECKTYPES; %700-20838000 C 700 +BOOLEAN LPARFOUND,SAVEXREFOPT; %002-20842000 C 002 +PROCEDURE FILEPARAM( DEFAULTFILE ); %*** CHECKS THE FIRST PARAMETER 20844000 C 700 +VALUE DEFAULTFILE; INTEGER DEFAULTFILE;%*** TO SEE IF IT IS A FILE.%700-20844100 C 700 +BEGIN DEFINE RESULTS = FILENAME & LPARFOUND #; %700-20845000 C 700 + SAVEXREFOPT := XREFOPTION; XREFOPTION := FALSE; %002-20847500 C 002 + IF SAVEXREFOPT THEN NEWXREF(CURNAME1,CURNAME2,THISLEVEL, 20861500 C 002 + FALSE); %002-20861550 C 002 + XREFOPTION := SAVEXREFOPT; %002-20868500 C 002 +END OF FILEPARAM; %700-20869000 C 700 +REAL CURVAL; INTEGER CURLENGTH; %700-20872000 C 700 + %700-20873000 C 700 +PROCEDURE CONSTANT( CVAL, CTYPE ); %700-20874000 C 700 +REAL CVAL; INTEGER CTYPE; %700-20875000 C 700 +BEGIN %700-20876000 C 700 + INTEGER TFORM; BOOLEAN SIGNED, NEGATIVE; %700-20876100 C 700 +END OF CONSTANT; %700-20921000 C 700 +$ PAGE %998-29000000 C 998 +% ASSERT 62 ASSERTSY INITIAL %002-30075500 C 002 +$ %700-30082000 C 700 +ALPHA C, CX; %( CURNAME1 & CURNAME2 MOVED TO 20205000 ) %700-30083000 C 700 +INTEGER LASTCHARPOS; %( CURVAL, CURLENGTH MOVED TO 20872000 ) %700-30084000 C 700 +PROCEDURE INSYMBOL; %*** IDENTIFIES THE NEXT SYMBOL ******%700-30087000 C 700 +BEGIN %700-30087100 C 700 + %700-30087200 C 700 + PROCEDURE NEXTCHAR; %*** GETS THE NEXT CHARACTER. %700-30088000 C 700 + END OF NEXTCHAR; %700-30093000 C 700 +$ SET VOIDT 30095000 C 700 +$ POP VOIDT 30098000 C 700 + DEFINE T1 = EXP #; % USED AT 30178000 %700-30099100 C 700 + IF CURNAME1="6ASSERT" THEN ASSERTSY ELSE %002-30165500 C 002 + BEGIN T1 := CARDLENGTH-CHARCNT-CURLENGTH-1; %506-30178000 C 506 + RESWORDOPTION := BOOLEAN(3); % SET RESWORDPRESENT BIT 30179000 C 710 + FOR CURLENGTH+REAL(CHARCNT=0); %506-30181000 C 506 + BEGIN DEFINE NEWSEGMENT = HERE #; %700-30261100 C 700 + IF CX="L" THEN IF C=1 THEN %516-30264000 C 516 + IF LISTOPTION THEN HEADING ELSE %516-30264500 C 516 + ELSE LISTOPTION := C="+" ELSE %713-30265000 C 713 + END% %002-30280000 C 002 +% %002-30280025 C 002 +% %002-30280050 C 002 +% THE FOLLOWING LINES DECODE ANY OCCURRENCE OF THE "S" OPTION AND 30280075 C 002 +% SETS THE GLOBAL INTEGER VARIABLE "SAVEFACTOR" WHICH CONTROLS THE %002-30280100 C 002 +% TYPE OF COMPILATION INITIATED BY THE ZIP. THERE ARE THREE LEGAL FORMS 30280125 C 002 +% OF THE "S" OPTION AS FOLLOWS.- %002-30280150 C 002 +% %002-30280175 C 002 +% "S-" WILL GIVE NO ZIP IE. PASCAL SYNTAX CHECK ONLY %002-30280200 C 002 +% "S+" WILL GIVE A ZIP FOR COMPILE AND GO %002-30280225 C 002 +% "S??" WILL GIVE A ZIP FOR COMPILE TO LIBRARY %002-30280250 C 002 +% WHERE ?? IS THE TWO DIGIT DECIMAL SAVE %002-30280275 C 002 +% CONSTANT GIVEN THE OBJECT CODE FILE %002-30280300 C 002 +% NB. IF THE SAVE CONSTANT IS TO BE %002-30280325 C 002 +% LESS THAN 10 THE FIRST DIGIT %002-30280350 C 002 +% MUST BE INCLUDED IE. A "0". %002-30280375 C 002 +% %002-30280400 C 002 +% %002-30280425 C 002 + ELSE %002-30280450 C 002 + IF CX="S" THEN %002-30280475 C 002 + BEGIN %002-30280500 C 002 + IF C="-" THEN SAVEFACTOR:=-1 ELSE %002-30280525 C 002 + IF C="+" THEN SAVEFACTOR:= 0 ELSE %002-30280550 C 002 + IF C LEQ 9 THEN %002-30280575 C 002 + BEGIN %002-30280600 C 002 + SAVEFACTOR := 10 × C; NEXTCHAR; %002-30280625 C 002 + SAVEFACTOR := SAVEFACTOR + C; %002-30280650 C 002 + IF C GTR 9 THEN ERROR(100); %002-30280675 C 002 + END %002-30280700 C 002 + ELSE %002-30280720 C 002 + BEGIN %002-30280735 C 002 + ERROR(100); %002-30280750 C 002 + SAVEFACTOR := 7; %002-30280765 C 002 + END; %002-30280780 C 002 + END %713-30280800 C 713 + ELSE ERROR(102); %713-30280810 C 713 +% %002-30280825 C 002 +% %002-30280850 C 002 +% %002-30280875 C 002 + IF LISTOPTION THEN IF PAGECNT=0 THEN HEADING; % ON FIRST PAGE30282100 C 709 + END NEWSEGEMENT; %700-30282200 C 700 +$ PAGE %998-39000000 C 998 +$ %700-40016000 C 700 +$ %700-40017000 C 700 +INTEGER EXPRLEVEL, EXPINVARCNT; % %800-40018000 C 800 + BEGIN ERROR(63); % %600-40023000 C 600 +DEFINE PUTSYM(S) = PUTTEXT( (S)&1[41:5:6] ) #; %700-40029000 C 700 +$ SET VOIDT 40029900 C 700 +$ POP VOIDT 40033000 C 700 +DEFINE PUTDUMMY = PUTTEXT("3000000") #; %700-40041000 C 700 +$ SET VOIDT 40042000 C 700 +$ POP VOIDT 40044000 C 700 +% %601-40052050 C 601 +% %601-40052055 C 601 +PROCEDURE SPLIT(SPLITINX,WIDTH); % %601-40052100 C 601 +VALUE SPLITINX, WIDTH; % %601-40052150 C 601 +INTEGER SPLITINX, WIDTH ; % %601-40052200 C 601 +BEGIN % %601-40052250 C 601 + INTEGER I; % %601-40052300 C 601 +% %601-40052350 C 601 + IF NUMSYMS+WIDTH LEQ MAXSYMS THEN % %601-40052400 C 601 + BEGIN % %601-40052450 C 601 + FOR I:=NUMSYMS STEP -1 UNTIL SPLITINX DO % %601-40052500 C 601 + SYMTAB[I+WIDTH] := SYMTAB[I]; % %601-40052550 C 601 + FOR I:=1 STEP 1 UNTIL WIDTH DO % %601-40052600 C 601 + SYMTAB[SPLITINX+I-1] := "3000000"; % %601-40052650 C 601 + NUMSYMS := NUMSYMS + WIDTH; % %601-40052700 C 601 + END % %601-40052750 C 601 + ELSE %601-40052800 C 601 + BEGIN % %601-40052830 C 601 + ERROR(63); % %601-40052860 C 601 + NUMSYMS := 1; % %601-40052890 C 601 + END; % %601-40052900 C 601 +END OF SPLIT; % %601-40052950 C 601 +% %601-40052960 C 601 +% %601-40052965 C 601 +PROCEDURE WRITEEXPR; %*** WRITE GENERATED ALGOL EXPRESSION %700-40053000 C 700 + REAL SX; INTEGER T1, TX; %700-40054100 C 700 +END OF WRITEEXPR; %700-40066000 C 700 +PROCEDURE CHECKEXPR( LLIM, ULIM ); %*** WRITE CODE TO CHECK VALUE 40069000 C 700 + VALUE LLIM, ULIM; INTEGER LLIM, ULIM; %700-40069100 C 700 +BEGIN DEFINE CHECK = VALUE #; %700-40070000 C 700 +END OF CHECKEXPR; %700-40077000 C 700 +$ %518-40080000 C 518 + BOOLEAN SIMPLEVARIABLE,INSIDEBRACKETS,INSIDEPARENS; %518-40080100 C 518 + INTEGER T1, T5; % USED ONCE EACH %700-40086100 C 700 + BOOLEAN INBRACKET,INRECORD,SIMPLEVAR; %002-40087000 C 002 + T1:=T.FIRSTWITHSYM; T5:=T.LASTWITHSYM; %700-40094000 C 700 + FOR T1:=T1 STEP 1 UNTIL T5 DO PUTTEXT(WITHTAB[T1]); %700-40095000 C 700 + SIMPLEVAR := FALSE; %002-40099000 C 002 +$ %IF THISLEVEL>1 AND THISLEVEL 0 % POINTER VIA POINTER %513-40180500 C 513 + THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY %513-40180600 C 513 + "00-1)DIV00 1022,00 T MOD00 1022]"; %513-40180700 C 513 + NUMSYMS := NUMSYMS+4; %513-40180800 C 513 + END %513-40180900 C 513 + ELSE NUMPOINTERS := 1; %513-40181000 C 513 + END; % %601-40188005 C 601 +IF TYPETAB1[CURTYPE].FORM=SET THEN % *** SET VARIABLES %601-40188010 C 601 +BEGIN % --- --- --------- %601-40188025 C 601 + INTEGER THISSYML, I; % %601-40188050 C 601 +% %601-40188075 C 601 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SLOAD("; % %601-40188100 C 601 + IF SIMPLEVAR THEN % %601-40188125 C 601 + BEGIN % %601-40188150 C 601 + PUTSYM(","); % %601-40188175 C 601 + PUTID("W",1000×THISLEVEL+THISINDEX,5); % %601-40188200 C 601 + END % %601-40188225 C 601 + ELSE % %601-40188250 C 601 + IF INBRACKET AND NOT INRECORD THEN % %601-40188275 C 601 + BEGIN % %601-40188300 C 601 + PUTSYM(","); THISSYML := NUMSYMS; % %601-40188325 C 601 + PUTCONST(0); PUTSYM(" "); PUTSYM(","); % %601-40188350 C 601 + FOR I:=STARTSYM+1 STEP 1 UNTIL THISSYML DO % %601-40188375 C 601 + PUTTEXT(SYMTAB[I]); %601-40188400 C 601 + PUTTEXT(" 1] "); % %601-40188425 C 601 + END % %601-40188450 C 601 + ELSE % %601-40188475 C 601 + BEGIN % %601-40188500 C 601 + THISSYML := NUMSYMS; % %601-40188525 C 601 + IF INBRACKET THEN PUTSYM("]"); % %601-40188550 C 601 + FOR I:=1 STEP 1 UNTIL NUMPOINTERS DO % %601-40188575 C 601 + BEGIN % %601-40188600 C 601 + PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); % %601-40188625 C 601 + PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); % %601-40188650 C 601 + END; % %601-40188675 C 601 + PUTSYM(","); % %601-40188700 C 601 + FOR I:=STARTSYM+1 STEP 1 UNTIL THISSYML DO % %601-40188725 C 601 + PUTTEXT(SYMTAB[I]); % %601-40188775 C 601 + PUTTEXT(" +1 "); % %601-40188800 C 601 + IF INBRACKET THEN PUTSYM("]"); % %601-40188825 C 601 + FOR I:=1 STEP 1 UNTIL NUMPOINTERS DO % %601-40188850 C 601 + BEGIN % %601-40188875 C 601 + PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); % %601-40188900 C 601 + PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); % %601-40188915 C 601 + END; % %601-40188930 C 601 + NUMPOINTERS := 0; % %601-40188945 C 601 + END; %601-40188960 C 601 + PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); % %601-40188975 C 601 +END OF SET VARIABLES; % %601-40188990 C 601 + % INBRACKET := FALSE; %513-40191100 C 513 + BEGIN NUMPOINTERS := NUMPOINTERS-1; %513-40193000 C 513 + IF NUMSYMS+4 ≤ MAXSYMS %513-40194000 C 513 + THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY %513-40194100 C 513 + "00-1)DIV00 1022,00 T MOD00 1022]"; %513-40194200 C 513 + NUMSYMS := NUMSYMS+4; %513-40194300 C 513 + END %513-40194400 C 513 + ELSE ERROR(63); % EXPRESSION IS TOO LONG FOR SYMTAB[*] 40195000 C 513 +$ %601-40198000 C 601 + IF INSIDEPARENS AND SIMPLEVAR AND TYPETAB1[CURTYPE].STRUCT > 0 AND 40198500 C 615 + TYPETAB1[CURTYPE].FORM < FILES THEN SYMTAB[STARTSYM].[35:6] := 40198600 C 615 + "H"; %615-40198700 C 615 + SIMPLEVARIABLE := SIMPLEVAR; %002-40199500 C 002 + INSIDEPARENS := TRUE; %518-40258100 C 518 + INSIDEPARENS := FALSE; %518-40259100 C 518 + IF TYPETAB1[THISID.TYPE].FORM=SET THEN %601-40274200 C 601 + BEGIN % %601-40274220 C 601 + GEN(",",1,7); % %601-40274240 C 601 + GENID("W",1000×THISLEVEL+THISINDEX,5); % %601-40274260 C 601 + END; % %601-40274280 C 601 + BOOLEAN FIRST, SPLITTED; % %601-40296000 C 601 + DEFINE T1 = T #; % USED AT 40558000 %700-40298000 C 700 +$ SET VOIDT 40299000 C 700 +$ POP VOIDT 40309000 C 700 + %700-40331000 C 700 + PROCEDURE PARAMETER; %*** CHECK THAT THE FUNCTION HAS 1 PARAM.40332000 C 700 + BEGIN %700-40333000 C 700 + INSYMBOL; %700-40334000 C 700 + IF CURSY=LPAR %700-40335000 C 700 + THEN BEGIN %700-40336000 C 700 + PUTSYM("("); INSYMBOL; EXPRESSION; %700-40337000 C 700 + IF TYPETAB1[CURTYPE].FORM=NUMERIC THEN CURTYPE:=INTTYPE; 40338000 C 700 + IF CURSY≠RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; %700-40339000 C 700 + PUTSYM(")"); IF CURSY=RPAR THEN INSYMBOL; %700-40340000 C 700 + END ELSE ERROR(3); % OR ERROR(58) %700-40341000 C 700 + END OF PARAMETER; %700-40342000 C 700 + %700-40350000 C 700 + IF CURNAME1="7CPUTIM" AND CURNAME2="E" THEN % "CPUTIME" 40452000 C 514 + PUTTEXT("SETBS("); PUTTEXT(" 3,2,"); PUTCONST(CARDCNT); % 40529000 C 601 + PUTSYM(")"); % %601-40529300 C 601 + CURTYPE := EMPTYSET; CURMODE := NUMBER; % %601-40529600 C 601 + STARTSYM := NUMSYMS + 1; % %601-40533500 C 601 + PUTTEXT(" SETB("); % %601-40536000 C 601 + PUTSYM(","); SYMTAB[STARTSYM] := "SETBS("; % %601-40544000 C 601 + IF SPLITTED THEN PUTSYM(")"); % %601-40551500 C 601 + IF CURSY=COMMA THEN % %601-40552000 C 601 + BEGIN % %601-40552200 C 601 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SUNIO("; % %601-40552400 C 601 + PUTSYM(","); % %601-40552600 C 601 + SPLITTED := TRUE; % %601-40552800 C 601 + END; % %601-40552850 C 601 + NEWTYPE; T1 := SET; T1.SIZE := 2; T1.STRUCT := 0; % %601-40558000 C 601 + CURMODE := NUMBER; % %601-40561000 C 601 + IF CURTYPE=BOOLTYPE THEN % %601-40587000 C 601 + IF CURSY NEQ ANDSY THEN ERROR(64); %601-40593000 C 601 + END ELSE % %601-40593100 C 601 + IF F=SET THEN % %601-40593200 C 601 + BEGIN % %601-40593300 C 601 + IF CURSY=ASTERISK THEN % %601-40593400 C 601 + BEGIN % %601-40593500 C 601 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SINTS("; % %601-40593600 C 601 + PUTSYM(","); % %601-40593700 C 601 + END ELSE ERROR(64); % %601-40593800 C 601 + MODE := NUMBER; % %601-40593900 C 601 + IF F=SET THEN PUTSYM(")"); % %601-40608500 C 601 + INTEGER STARTSYM,FIRSTSYM,MODE,TYPE1,F; %603-40618000 C 603 + PUTDUMMY; STARTSYM := FIRSTSYM := NUMSYMS; %603-40621000 C 603 + SPLIT(FIRSTSYM,1); %603-40650000 C 603 + IF CURSY = PLUS THEN SYMTAB[FIRSTSYM] := "SUNIO(" ELSE %603-40651000 C 603 + IF CURSY = MINUS THEN SYMTAB[FIRSTSYM] := "SDIFF(" ELSE %603-40652000 C 603 + ERROR(64); %603-40653000 C 603 + PUTSYM(","); MODE := NUMBER; % %601-40654000 C 601 +$ %601-40655000 C 601 + IF F=SET THEN PUTSYM(")"); % %601-40668500 C 601 +$ %601-40688000 C 601 + IF CURSY=EQLSY THEN SYMTAB[STARTSYM] := "SEQUA(" % %601-40713000 C 601 + ELSE %601-40713150 C 601 + IF CURSY=NEQSY THEN % %601-40713300 C 601 + BEGIN % %601-40714000 C 601 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM]:= " NOT "; % %601-40714150 C 601 + SYMTAB[STARTSYM+1] := "SEQUA("; % %601-40714300 C 601 + IF EXPINVARCNT=0 THEN WRITEEXPR; % %002-40751000 C 002 +$ PAGE %998-49000000 C 998 + CURTYPE := 0; % ALFATYPE OR REALTYPE %509-50050000 C 509 +$ %600-50059000 C 600 + GEN("PREAD(",6,2); WRITEEXPR; GEN(",",1,7); % %600-50079000 C 600 +$ %600-50080000 C 600 +$ %600-50081000 C 600 + GENID("F",FILEID,5); GEN(",",1,7); % %600-50082000 C 600 + IF F=NUMERIC THEN % %600-50086010 C 600 + BEGIN % %600-50086050 C 600 + GEN(",",1,7); GENINT(TYPETAB2[CURTYPE]); % %600-50086100 C 600 + GEN(",",1,7); GENINT(TYPETAB3[CURTYPE]); % %600-50086150 C 600 + END ELSE GEN(",0,0,",4,4); % %600-50086200 C 600 +$ SET VOIDT %600-50088000 C 600 +$ POP VOIDT %600-50093000 C 600 + LABEL EFH; %002-50201500 C 002 + BEGIN ; % NULL %*** 4) REWRITE %001-50203000 C 001 + GEN("PUT",3,5); %*** 5) PAGE %001-50204000 C 001 + %*** 6) OPEN & CLOSE (INPUT) FOR 50204500 C 002 + % CUMULATIVE FREQUENCY COUNT50204550 C 002 + GEN("PPAGE",5,3); % %001-50208000 C 001 + BEGIN %002-50208100 C 002 + GEN("QQJZXL",6,2); %002-50208200 C 002 + INSYMBOL; %002-50208300 C 002 + GO TO EFH; % %002-50208400 C 002 + END; %002-50208500 C 002 +EFH: %002-50219500 C 002 + INTEGER IT; REAL T; %503-50225000 C 503 +$ %518-50243000 C 518 + GENID("H",1000×THISLEVEL+THISINDEX,5); %518-50243100 C 518 +$ %IF THISLEVEL>1 AND THISLEVEL≠CURLEVEL THEN ERROR5; %511-50244000 C 511 + INTEGER IT; REAL T; %503-50285000 C 503 +$ %IF THISLEVEL>1 AND THISLEVEL≠CURLEVEL THEN ERROR5; %511-50306000 C 511 +$ %518-50307000 C 518 + GENID("H",1000×THISLEVEL+THISINDEX,5); %518-50307100 C 518 +$ PAGE %998-59000000 C 998 + %512-60020000 C 512 + PROCEDURE WRITESEXPR; %*** FIX STRUCTURE FOR ASSIGNMENT %512-60021000 C 512 + BEGIN % USED ONLY IN ASSIGNMENT OF STRUCTURES 60022000 C 512 + IF INSIDEBRACKETS THEN IF SYMTAB[NUMSYMS] = "100000," %512-60023000 C 512 + THEN SYMTAB[NUMSYMS] := ", 0 ] " ELSE PUTSYM("]"); %512-60024000 C 512 + WHILE NUMPOINTERS>0 DO %512-60025000 C 512 + BEGIN NUMPOINTERS := NUMPOINTERS-1; %512-60026000 C 512 + IF NUMSYMS+4 ≥ MAXSYMS THEN WRITEEXPR; %512-60027000 C 512 + REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY %512-60028000 C 512 + "00-1)DIV00 1022,00 T MOD00 1022]"; %512-60029000 C 512 + NUMSYMS := NUMSYMS+4; %512-60030000 C 512 + END; % OF WHILE %512-60031000 C 512 + WRITEEXPR; GEN( ",", 1,7 ); %512-60032000 C 512 + END WRITESEXPR; %512-60033000 C 512 + %512-60034000 C 512 + %ERROR(95); % STRUCTURED ASSIGNMENT NOT IMPLEMENTED. %512-60063000 C 512 + EXPRLEVEL := EXPRLEVEL+1; %507-60063900 C 507 + GEN("ASSIGN(",7,1); WRITESEXPR; %512-60064000 C 512 + EXPRESSION; WRITESEXPR; %512-60065000 C 512 + EXPRLEVEL := EXPRLEVEL-1; %507-60065100 C 507 + GENINT(TYPETAB1[LEFTTYPE].SIZE); GEN(")",1,7); %512-60066000 C 512 + IF TYPETAB1[LEFTTYPE].SIZE≠TYPETAB1[CURTYPE].SIZE %512-60067000 C 512 + THEN ERROR(95); %512-60068000 C 512 + IF TYPETAB1[LEFTTYPE].FORM=SET THEN % %601-60080100 C 601 + BEGIN % %601-60080200 C 601 + SYMTAB[1] := "SSTOR("; NUMSYMS := NUMSYMS - 3; % %601-60080300 C 601 + EXPRESSION; % %601-60080400 C 601 + PUTSYM(")"); CHECKTYPES(LEFTTYPE,CURTYPE); % %601-60080500 C 601 + WRITEEXPR; % %601-60080600 C 601 + END ELSE % %601-60080700 C 601 + END; %512-60087000 C 512 + CHECKTYPES( LEFTTYPE, CURTYPE ); %512-60088000 C 512 + IF THISLEVEL≠CURLEVEL-1 OR THISINDEX≠CURFUNC THEN ERROR(5);%511-60091000 C 511 + IF THISLEVEL>1 AND THISLEVELCHAR THEN ERROR(11); %700-70056000 C 700 + IF CURSY≠DOUBLEDOT THEN ERROR(53); %700-70057000 C 700 + INSYMBOL; %700-70058000 C 700 + CONSTANT(VALX2,TYPEX2); %700-70059000 C 700 + IF TYPEX1>0 AND TYPEX2>0 THEN %700-70060000 C 700 + IF TYPEX1≠TYPEX2 THEN ERROR(11) ELSE %700-70061000 C 700 + IF VALX1>VALX2 THEN ERROR(54); %700-70062000 C 700 + IF (T1:=TYPETAB1[TYPEX1].FORM) = SYMBOLIC THEN T1:=SUBTYPE; %700-70063000 C 700 + NEWTYPE; TTYPE:=TYPEINDEX; %700-70064000 C 700 + T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; T1.MAINTYPE:=TYPEX1; %700-70065000 C 700 + TYPETAB1[TYPEINDEX]:=T1; %700-70066000 C 700 + TYPETAB2[TYPEINDEX]:=VALX1; TYPETAB3[TYPEINDEX]:=VALX2; %700-70067000 C 700 + END OF SUBRANGE; %700-70068000 C 700 + %700-70069000 C 700 + DEFINE DEC = POINTER #; %700-70117100 C 700 + DEFINE DEC = ARRAY #; %700-70143100 C 700 + DEFINE DEC = FILE #; %700-70180100 C 700 + DEFINE DEC = SET #; %700-70200100 C 700 + IF TYPETAB2[TX] LSS 0 OR TYPETAB3[TX] GTR 93 THEN ERROR(51); 70210000 C 601 + T1.SIZE := TSIZE := 2; TYPETAB1[TYPEINDEX] := T1; % %601-70214000 C 601 + DEFINE DEC = RECORD #; %700-70220100 C 700 + INTEGER CASETYPE,ADDR,MAXADDR,INDEX,CTYPE,TX,SX, T3,LLIM,ULIM,I; 70244000 C 503 + REAL T1, CVAL; %503-70246000 C 503 + LABEL CASEPART, EXIT; %700-70247000 C 700 + BEGIN DEFINE DEC = VARIANT #; %700-70285100 C 700 + LABEL CASETYPEID; %700-70285200 C 700 + END; %700-70349100 C 700 +$ PAGE %998-79000000 C 998 + INTEGER LEVEL1000, TYP, NAM, NAMTAB, I, J, RECSIZE; %503-80020000 C 503 + ALPHA T1, FNAME; %503-80022000 C 503 + IF NAMTAB.IDCLASS=FUNC THEN GEN("FUNCTN",7,2) % %600-80037000 C 600 + ELSE GEN("PROCEDU",8,1); % %600-80038000 C 600 + IF T1.FORM=SET THEN % %601-80046200 C 601 + BEGIN % %601-80046400 C 601 + GEN(",",1,7); GENID("W",LEVEL1000+NAM,5); % %601-80046600 C 601 + END; % %601-80046800 C 601 +$SET VOIDT %518-80052000 C 518 +$POP VOIDT %518-80064000 C 518 + DEFINE %518-80064005 C 518 + LOWSUBS = 0 #, %518-80064010 C 518 + HISUBS = 1 #, %518-80064015 C 518 + NEXTSUBS= 2 #, %518-80064020 C 518 + MAXNOOFSUBSCRIPTS = 20 #, %518-80064025 C 518 + STOPPERSUBTAB = 21 #; %518-80064030 C 518 + ARRAY ARRSUBSCRIPTRANGE[0:2,0:MAXNOOFSUBSCRIPTS]; %518-80064035 C 518 + INTEGER FIRSTRANGE, NEXTFREEENTRY, PASSSUBRANGE, PREVPASS, %518-80064040 C 518 + MP, POSNO, SUBDIFF; %518-80064045 C 518 + IF ARRAYVAR THEN GEN(";",1,7) ELSE ARRAYVAR := TRUE; %518-80064050 C 518 + IF NOT PARAM THEN %518-80064055 C 518 + BEGIN %518-80064060 C 518 + GEN("DEFINE",7,2); %518-80064065 C 518 + GENID("V",LEVEL1000+NAM,5); %518-80064070 C 518 + GEN("[",1,7); %518-80064075 C 518 + END; %518-80064080 C 518 + FIRSTRANGE := STOPPERSUBTAB; NEXTFREEENTRY := 0; %518-80064085 C 518 + POSNO := 1; %518-80064090 C 518 + MP := 10; FIRSTDIM := TRUE; %518-80064095 C 518 + DO %518-80064100 C 518 + BEGIN %518-80064105 C 518 + IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE %518-80064110 C 518 + BEGIN %518-80064111 C 518 + IF NOT PARAM THEN GEN(",",1,7); %518-80064112 C 518 + END; %518-80064113 C 518 + IF NOT PARAM THEN GENID("V",(LEVEL1000+NAM)×MP+POSNO,IF MP=10 80064115 C 518 + THEN 6 ELSE 7); POSNO := POSNO + 1; %518-80064120 C 518 + IF POSNO = MP THEN MP := MP×10; %518-80064125 C 518 + IF NEXTFREEENTRY = STOPPERSUBTAB THEN %518-80064130 C 518 + BEGIN %518-80064135 C 518 + ERROR(0); %518-80064140 C 518 + END %518-80064145 C 518 + ELSE %518-80064150 C 518 + BEGIN %518-80064155 C 518 + ARRSUBSCRIPTRANGE[LOWSUBS,NEXTFREEENTRY]:=TYPETAB2[TYP]; 80064160 C 518 + ARRSUBSCRIPTRANGE[HISUBS,NEXTFREEENTRY] := TYPETAB3[TYP]; 80064165 C 518 + END; %518-80064170 C 518 + SUBDIFF := TYPETAB3[TYP] - TYPETAB2[TYP]; %518-80064175 C 518 + IF FIRSTRANGE = STOPPERSUBTAB THEN %518-80064180 C 518 + BEGIN %518-80064185 C 518 + FIRSTRANGE := NEXTFREEENTRY; %518-80064190 C 518 + NEXTFREEENTRY := NEXTFREEENTRY + 1; %518-80064195 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,FIRSTRANGE] := STOPPERSUBTAB; 80064200 C 518 + END %518-80064205 C 518 + ELSE %518-80064210 C 518 + BEGIN %518-80064215 C 518 + PASSSUBRANGE := FIRSTRANGE; %518-80064220 C 518 + PREVPASS := STOPPERSUBTAB; NEXTFREEENTRY:=NEXTFREEENTRY+1;80064225 C 518 + WHILE(SUBDIFF ≥ ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE] %518-80064230 C 518 + -ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE]) AND 80064235 C 518 + (ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] ≠ %518-80064240 C 518 + STOPPERSUBTAB) DO %518-80064245 C 518 + BEGIN %518-80064250 C 518 + PREVPASS := PASSSUBRANGE; %518-80064255 C 518 + PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS, %518-8006426 C 518 + PASSSUBRANGE]; 80064265 C 518 + END; %518-80064270 C 518 + IF PREVPASS = STOPPERSUBTAB THEN %518-80064275 C 518 + BEGIN %518-80064280 C 518 + IF SUBDIFF ≥ ARRSUBSCRIPTRANGE[HISUBS, %518-80064285 C 518 + PASSSUBRANGE] - %518-80064290 C 518 + ARRSUBSCRIPTRANGE[LOWSUBS, %518-80064295 C 518 + PASSSUBRANGE] THEN%518-80064300 C 518 + BEGIN %518-80064305 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] := %518-80064310 C 518 + NEXTFREEENTRY - 1; %518-80064315 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] :=%518-80064320 C 518 + STOPPERSUBTAB; %518-80064325 C 518 + END %518-80064330 C 518 + ELSE %518-80064335 C 518 + BEGIN %518-80064340 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] :=%518-80064345 C 518 + FIRSTRANGE; %518-80064350 C 518 + FIRSTRANGE := NEXTFREEENTRY-1; %518-80064355 C 518 + END %518-80064360 C 518 + END %518-80064365 C 518 + ELSE %518-80064370 C 518 + BEGIN %518-80064375 C 518 + IF SUBDIFF ≥ ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE] - 80064380 C 518 + ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE] 80064385 C 518 + THEN %518-80064390 C 518 + BEGIN %518-80064395 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] := %518-80064400 C 518 + NEXTFREEENTRY - 1; %518-80064405 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] := %518-80064410 C 518 + STOPPERSUBTAB; %518-80064415 C 518 + END %518-80064420 C 518 + ELSE %518-80064425 C 518 + BEGIN %518-80064430 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,PREVPASS] := %518-80064435 C 518 + NEXTFREEENTRY -1; %518-80064440 C 518 + ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] := %518-80064445 C 518 + PASSSUBRANGE; %518-80064450 C 518 + END %518-80064455 C 518 + END %518-80064460 C 518 + END;TYP:=IF T1.FORM = ARRAYS THEN T1.ARRTYPE ELSE REALTYPE; 80064465 C 518 + T1 := TYPETAB1[TYP]; %518-80064470 C 518 + END UNTIL T1.STRUCT = 0 ; %518-80064475 C 518 + IF NOT PARAM THEN %518-80064480 C 518 + BEGIN %518-80064485 C 518 + GEN("]=",2,6); %518-80064490 C 518 + GENID("H",LEVEL1000+NAM,5); %518-80064495 C 518 + GEN("[",1,7); %518-80064500 C 518 + PASSSUBRANGE:= FIRSTRANGE; FIRSTDIM := TRUE; %518-80064505 C 518 + WHILE PASSSUBRANGE ≠ STOPPERSUBTAB DO %518-80064510 C 518 + BEGIN %518-80064515 C 518 + IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE GEN(",",1,7); 80064520 C 518 + GENID("V",(LEVEL1000+NAM)×(IF PASSSUBRANGE>9 THEN 100 ELSE 8006453 C 518 + 10)+PASSSUBRANGE+1,IF PASSSUBRANGE>9 THEN 7 ELSE 6); 80064535 C 518 + PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE]; 80064540 C 518 + END; %518-80064545 C 518 + GEN("]#;",3,5); %518-80064550 C 518 + END; %518-80064555 C 518 + PASSSUBRANGE := FIRSTRANGE; %518-80064560 C 518 + FIRSTDIM := TRUE; GEN("ARRAY",6,3); GENID("H",LEVEL1000+NAM,5); 80064565 C 518 + GEN("[",1,7); %518-80064570 C 518 + WHILE PASSSUBRANGE ≠ STOPPERSUBTAB DO %518-80064575 C 518 + BEGIN %518-80064580 C 518 + IF MAXPERMTAB LEQ MAXTOTALSUBSCRS AND PARAM THEN %518-80064585 C 518 + BEGIN %518-80064590 C 518 + ARRSUBPERMTAB[ARRNAM,MAXPERMTAB] := %518-80064595 C 518 + IF FIRSTDIM THEN NAM ELSE -1; %518-80064600 C 518 + ARRSUBPERMTAB[PERMSUB,MAXPERMTAB] := PASSSUBRANGE; %518-80064605 C 518 + MAXPERMTAB := MAXPERMTAB + 1; %518-80064610 C 518 + END %518-80064615 C 518 + ELSE %518-80064620 C 518 + BEGIN %518-80064625 C 518 + IF MAXPERMTAB > MAXTOTALSUBSCRS THEN ERROR(0); %518-80064630 C 518 + END; %518-80064640 C 518 + IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE GEN(",",1,7); %518-80064645 C 518 + GENINT(ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE]); %518-80064650 C 518 + IF NOT PARAM THEN %518-80064655 C 518 + BEGIN %518-80064660 C 518 + GEN(":",1,7); %518-80064665 C 518 + GENINT(ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE]); %518-80064670 C 518 + END; %518-80064675 C 518 + PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE]; %518-80064680 C 518 + END; %518-80064685 C 518 + IF T1.FORM=SET THEN % %601-80064700 C 601 + BEGIN % %601-80064750 C 601 + GEN(",0",2,6); % %601-80064800 C 601 + IF NOT PARAM THEN GEN(":1",2,6); % %601-80064850 C 601 + END; % %601-80064900 C 601 + GEN("]",1,7); %518-80064950 C 518 + DEFINE DEC = FILE #; %700-80066100 C 700 + IF ALGOLCNT LSS 14 THEN WRITEALGOL; %517-80103000 C 517 + GEN(""/",2,6); %700-80107000 C 700 + IF RECSIZE=1 OR RECSIZE=10 THEN GENINT(30) %703-80119000 C 703 + GEN(",SAVE",6,3); %703-80122000 C 703 + GEN("30);", 4,4); %703-80123000 C 703 + IF PARAM THEN GEN("0",1,7) ELSE BEGIN %002-80129000 C 002 + GEN("0:",2,6); %002-80129100 C 002 + GENINT(RECSIZE-1); %002-80129200 C 002 + END %002-80129300 C 002 + INTEGER FIRSTPARAM, CURKIND, P1, PX, I, T3; REAL T; %503-80148000 C 503 + FORWPARAM1[NUMPARAMS] := CURNAME1; %002-80177500 C 002 + FORWPARAM2[NUMPARAMS] := CURNAME2; %002-80177600 C 002 + INTEGER INDEX, CTYPE, NUMFORWARDS,TX, I; % %800-80403000 C 800 + ALPHA T3; %002-80403500 C 002 + REAL T, CVAL; %503-80404000 C 503 + MARGIN("+P",CURLEVEL); % MARK PROCEDURE LEVEL %712-80420100 C 712 +$ %518-80421000 C 518 + IF CURLEVEL > 1 THEN %518-80421010 C 518 + BEGIN %518-80421020 C 518 + INTEGER NAMOFTHING,DIFF; %518-80421030 C 518 + BOOLEAN FIRSTTIME; %518-80421040 C 518 + GEN("BEGIN",6,3); %518-80421050 C 518 + IF MAXPERMTAB > 0 THEN %518-80421060 C 518 + BEGIN %518-80421070 C 518 + PASSPERMTAB := 0; %518-80421080 C 518 + DO %518-80421090 C 518 + BEGIN %518-80421100 C 518 + REMEMBERPOSN := PASSPERMTAB; %518-80421110 C 518 + GEN("DEFINE",7,2); %518-80421120 C 518 + NAMOFTHING := ARRSUBPERMTAB[ARRNAM,PASSPERMTAB]; %518-80421130 C 518 + GENID("V",1000×CURLEVEL+NAMOFTHING,5); %518-80421140 C 518 + GEN("[",1,7); %518-80421150 C 518 + FIRSTTIME := TRUE; %518-80421160 C 518 + DO %518-80421170 C 518 + BEGIN %518-80421180 C 518 + IF FIRSTTIME THEN FIRSTTIME := FALSE ELSE GEN(",",180421190 C 518 + ,7);80421200 C 518 + DIFF := PASSPERMTAB-REMEMBERPOSN+1; %518-80421210 C 518 + GENID("V",(1000+CURLEVEL+NAMOFTHING)×(IF DIFF>9 THEN 100 ELSE 80421220 C 518 + 10)+DIFF,(IF DIFF > 9 THEN 7 ELSE 6)); %518-80421230 C 518 + PASSPERMTAB := PASSPERMTAB + 1; END %518-80421270 C 518 + UNTIL PASSPERMTAB = MAXPERMTAB OR %518-80421280 C 518 + ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ≠ -1; %518-80421290 C 518 + GEN("]",1,7); %518-80421300 C 518 + GEN("=",1,7); %518-80421310 C 518 + GENID("H",1000×CURLEVEL+NAMOFTHING,5); %518-80421320 C 518 + GEN("[",1,7); %518-80421340 C 518 + PASSPERMTAB := REMEMBERPOSN; FIRSTTIME := TRUE; %518-80421350 C 518 + DO %518-80421360 C 518 + BEGIN %518-80421370 C 518 + IF FIRSTTIME THEN FIRSTTIME := FALSE ELSE GEN(",", 80421380 C 518 + 1,7);80421390 C 518 + DIFF := ARRSUBPERMTAB[PERMSUB,PASSPERMTAB]+1; %518-80421400 C 518 + GENID("V",(1000×CURLEVEL+NAMOFTHING)×(IF DIFF>9 THEN80421410 C 518 + 100 ELSE 10)+DIFF,(IF DIFF>9 THEN 7 ELSE 6)); 80421420 C 518 + PASSPERMTAB := PASSPERMTAB +1; %518-80421430 C 518 + END %518-80421440 C 518 + UNTIL PASSPERMTAB = MAXPERMTAB OR %518-80421450 C 518 + ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ≠ -1; %518-80421460 C 518 + GEN("]#;",3,5); %518-80421470 C 518 + END %518-80421480 C 518 + UNTIL PASSPERMTAB = MAXPERMTAB; %518-80421490 C 518 + MAXPERMTAB := 0; %518-80421500 C 518 + END %518-80421510 C 518 + END; %518-80421520 C 518 + DEFINE DEC = LABEL #; %700-80424100 C 700 + LABEL LL1; % %002-80447010 C 002 + DEFINE DEC = CONST #; %700-80447100 C 700 + DEFINE DEC = TYPE #; %700-80475100 C 700 + LABEL LL2; % %002-80496010 C 002 + DEFINE DEC = VAR #; %700-80496100 C 700 + IF CURSY=FUNCSY OR CURSY=PROCSY % %700-80540900 C 700 + THEN BEGIN DEFINE DEC = CODE #; %700-80540910 C 700 + LABEL LL3; % %002-80542010 C 002 + IF CURLEVEL GEQ MAXTABLES THEN ERROR(101) ELSE %002-80543500 C 002 + BLOCKTAB[CURLEVEL+1] := NUMBLOCKS := NUMBLOCKS + 1; %002-80543600 C 002 + IF FOUND AND (THISID.IDCLASS=PROC OR THISID.IDCLASS=FUNC) THEN %600-80548000 C 600 + NAMETAB3[CURLEVEL,THISINDEX].FORWARDDEF:=0; %504-80553000 C 504 + T := NAMETAB3[CURLEVEL,THISINDEX].INFO; %002-80554500 C 002 + TX := T + PARAMTAB[T]; %002-80554600 C 002 + FOR I:=T+1 STEP 1 UNTIL TX DO %002-80554700 C 002 + NEWNAME(FORWPARAM1[I],FORWPARAM2[I],CURLEVEL+1); %002-80554800 C 002 + (THISID.IDCLASS=FUNC AND NOT FUN) THEN ERROR(43); %504-80555100 C 504 + TX:=(T:=THISID.INFO)+PARAMTAB[T]; % UNMARK FORWARD PARMS 80556000 C 504 + FOR I:=T+1 STEP 1 UNTIL TX DO % TO ALLOW REFERENCE 80557000 C 504 + BEGIN T3:=PARAMTAB[I].PARAMNAME; %504-80558000 C 504 + CURNAME1:=ABS(NAMETAB1[CURLEVEL+1,T3]); %504-80559000 C 504 + CURNAME2:= NAMETAB2[CURLEVEL+1,T3]; %504-80560000 C 504 + NAMETAB1[CURLEVEL+1,T3]:=0; %504-80561000 C 504 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL+1); %504-80562000 C 504 + IF T3≠THISINDEX THEN BEGIN %504-80563000 C 504 + PARAMTAB[I].PARAMNAME:=THISINDEX; %504-80564000 C 504 + NAMETAB3[CURLEVEL+1,THISINDEX] := %504-80565000 C 504 + NAMETAB3[CURLEVEL+1,T3]; %504-80565010 C 504 + END END; % OF UNMARKING FORWARD PARAMETERS. %504-80566000 C 504 +$ %518-80608000 C 518 + BEGIN %518-80608010 C 518 + BEGIN %518-80608020 C 518 + INTEGER NAM,T1,SCRATCH; %518-80608030 C 518 + NAM := PARAMTAB[I].[9:10]; %518-80608040 C 518 + SCRATCH := NAMETAB3[CURLEVEL+1,NAM]; %518-80608050 C 518 + SCRATCH := SCRATCH.TYPE; %518-80608060 C 518 + T1 := TYPETAB1[SCRATCH]; %518-80608070 C 518 + IF T1.STRUCT ≠ 0 AND T1.FORM < FILES THEN %518-80608080 C 518 + GENID("H",1000×(CURLEVEL+1)+NAM,5) %518-80608090 C 518 + ELSE %518-80608100 C 518 + BEGIN % %601-80608105 C 601 + GENID("V",1000×(CURLEVEL+1)+NAM,5); %518-80608110 C 518 + IF T1.FORM=SET THEN % %601-80608111 C 601 + BEGIN % %601-80608113 C 601 + GEN(",",1,7); % %601-80608115 C 601 + GENID("W",1000×(CURLEVEL+1)+NAM,5); % %601-80608117 C 601 + END; %601-80608118 C 601 + END; % %601-80608119 C 601 + END; %518-80608120 C 518 + IF TYPETAB1[NAMETAB3[CURLEVEL+1,PARAMTAB[I].PARAMNAME].TYPE80627200 C 601 + ].FORM=SET %601-80627205 C 601 + THEN BEGIN % %601-80627400 C 601 + GEN(",",1,7); % %601-80627600 C 601 + GENID("W",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME 80627800 C 601 + ,5); % %601-80627801 C 601 + END; %601-80627850 C 601 + TX:=(T:=NAMETAB3[CURLEVEL,INDEX].INFO)+PARAMTAB[T]; %504-80636100 C 504 + FOR I:=T+1 STEP 1 UNTIL TX DO % MARK FORWARD PARAMETERS 80636200 C 504 + NAMETAB1[CURLEVEL+1,PARAMTAB[I].PARAMNAME].[46:1] := 1; 80636210 C 504 + REPLACE POINTER(NAMETAB1[CURLEVEL+1,*]) BY 0 %002-80637500 C 002 + FOR MAXNAMES+1 WORDS; %002-80637600 C 002 + IF CURLEVEL GEQ LASTREC THEN ERROR(101); % %002-80643000 C 002 + TX:=CURFUNC; CURFUNC:=IF FUN THEN INDEX ELSE -1; %504-80645000 C 504 + BLOCK; %*** COMPILE PROCEDURE BODY *** 80646000 C 001 + FOR I:=0 STEP 1 UNTIL MAXNAMES DO % LEAVE FORWARD PARAMETERS 80647000 C 504 + IF NAMETAB1[CURLEVEL,I]>0 THEN NAMETAB1[CURLEVEL,I]:=0; 80648000 C 504 + CURLEVEL:=CURLEVEL-1; CURFUNC:=TX; %504-80649000 C 504 + END OF SEGMENT FOR PROCEDURE DECLARATIONS; %700-80658100 C 700 + COMPSTAT; %*** COMPILE STATEMENT PART *** 80691000 C 001 + FOR I:=LASTREC STEP 1 UNTIL TOPREC-1 DO % CLEAR RECORD DECS %504-80693000 C 504 + MARGIN("-P",CURLEVEL); % MARK END OF PROCEDURE %712-80702100 C 712 +$ PAGE %998-89000000 C 998 +$ %705-90013000 C 705 +INTEGER PROGNAMELENGTH; % %800-90013900 C 800 +% %002-90014100 C 002 +% %002-90014200 C 002 +SAVEFACTOR:=0;% * DEFAULT ZIP IS COMPILE AND GO UNLESS %002-90014300 C 002 +% * CHANGED BY THE USE OF THE "S" OPTION %002-90014400 C 002 +% %002-90014500 C 002 +% %002-90014600 C 002 +CH[0] := "PASC000"; CHARPNT := POINTER(CH[0])+5; %711-90016000 C 711 +PASCALGOL.FID := USER := TIME(-1); %711-90017000 C 711 +DO BEGIN C:=C+1; REPLACE CHARPNT BY C FOR 3 DIGITS; %711-90018000 C 711 + PASCALGOL.MFID := ALGOLNAME := CH[0]; %711-90019000 C 711 + SEARCHDISKDIRECTORY( PASCALGOL, LINES[*] ); %711-90020000 C 711 +END UNTIL LINES[0]=-1; % FILE NOT ON DISK %711-90021000 C 711 +WRITE(PASCALGOL,MERGE); % ALGOL MUST COMPILE PRELUDE FIRST %704-90022000 C 704 +$ SET VOIDT 90023000 C 704 +$ POP VOIDT 90032000 C 704 +C := " "; % TO INITIALIZE "INSYMBOL" %709-90034000 C 709 +INITIALIZE; % COMPILER TABLES, NEWCARD, INSYMBOL %709-90035000 C 709 +$ %709-90036000 C 709 + PROGNAME := IF CURLENGTH < 7 %705-90042000 C 705 + THEN " "&CURNAME1[41:6×CURLENGTH-1:6×CURLENGTH] 90042010 C 705 + ELSE CURNAME2.[5:6]&CURNAME1[41:35:36]; %705-90042020 C 705 +% %002-90042100 C 002 +% THE FOLLOWING LINES ADD A "0" ONTO THE FRONT OF THE PROGRAM NAME OR90042200 C 002 +% THE FIRST SIX CHARACTERS THEREOF IF IT IS LONGER THAN SIX CHARACTERS 90042300 C 002 +% THUS GIVING THE NAME OF THE XALGOL OBJECT CODE FILE PRODUCED. %002-90042400 C 002 +% %002-90042500 C 002 + PROGNAME := CURNAME1.[35:36]; PROGNAMELENGTH := MIN(6,CURLENGTH)+1;90042600 C 002 +% %002-90042700 C 002 +% %002-90042800 C 002 + MAXPERMTAB := 0; %518-90070100 C 518 + INSIDEPARENS := FALSE; %518-90070200 C 518 +$ PAGE %998-90070999 C 998 + WRITE(LINE, TERMMESS); %708-90084000 C 708 +IF PAGECNT > 0 % THERE HAS BEEN SOME LISTING %709-90088000 C 709 +THEN BEGIN WRITE( LINE[DBL] ); WRITE( LINE[DBL] ) END; %709-90089000 C 709 +BEGIN% %002-90090400 C 002 + WRITE(LINE ,NOERRORS);% %002-90090500 C 002 + IF ERR(100) % %800-90090600 C 800 + THEN WRITE(LINE ,ERROR100MESS);% %002-90090700 C 002 + IF ERR(102) THEN %713-90090710 C 713 + WRITE(LINE,ERROR102MESS); %713-90090720 C 713 + IF SAVEFACTOR≥0 THEN% *A ZIP IS REQUIRED %002-90090800 C 002 + DEFINE PPROGNAME = 13 #, PALGOLNAME = 14 #, %705-90095000 C 705 + PLIBRARY = 15 #, PUSER = 16 #, %705-90096000 C 705 + P(P1) = POINTER(ZIPARRAY[P1])+1 FOR 7 #; %705-90097000 C 705 +$ SET VOIDT 90098000 C 705 +$ POP VOIDT 90104000 C 705 +$ %705-90109000 C 705 +$ %713-90110000 C 713 +$ %713-90111000 C 713 + ZIPARRAY[PPROGNAME]:=PROGNAME; ZIPARRAY[PALGOLNAME]:=ALGOLNAME; 90112000 C 705 + ZIPARRAY[PLIBRARY]:= IF SAVEFACTOR>0 THEN "LIBRARY" ELSE %705-90113000 C 705 + IF SAVEFACTOR<0 THEN " SYNTAX" ELSE " & RUN "; 90114000 C 705 + ZIPARRAY[PUSER]:=USER; %705-90115000 C 705 + REPLACE POINTER(ZIPARRAY[*]) BY "CC COMPILE ", %705-90116000 C 705 + P(PPROGNAME), "/", P(PUSER), %705-90117000 C 705 + " XALGOL ", P(PLIBRARY), %705-90118000 C 705 + "; ALGOL FILE TAPE=PASCRUN/DISK SERIAL; ALGOL FILE CARD=", %800-90119000 C 800 + P(PALGOLNAME),"/",P(PUSER)," SERIAL;", % %800-90120000 C 800 + " XALGOL STACK = 2048; END."; % %800-90120500 C 800 +$ SET VOIDT 90121000 C 705 +$ POP VOIDT 90128000 C 705 +END% %002-90129500 C 002 + (" 5 FUNCTION NAME NOT ACCESSIBLE AT THIS LEVEL."), %511-91009000 C 511 + (" 41 ALFA CONSTANTS MAY NOT BE LONGER THAN 7 CHARACTERS."),%001-91045000 C 001 + (" 55 PROCEDURE NESTING DEPTH + NO OF RECORDS IS TOO GREAT."), 91060000 C 001 + (" 87 END-OF-INPUT ENCOUNTERED UNEXPECTEDLY."), %001-91094000 C 001 + (" 95 SIZE OF STRUCTURES IN ASSIGNMENT ARE NOT THE SAME."), %512-91102000 C 512 + (" 97 TOO MANY FILES IN USE."), %001-91104000 C 001 + ("100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION. THE VALUE 07 IS91106500 C 002 +SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT THE COMPILATION ERRO91106600 C 002 +RS COUNT."),% %002-91106700 C 002 + ("101 PROCEDURES/FUNCTIONS NESTED TOO DEEP."), %002-91106800 C 002 + ("102 ***WARNING ONLY, ILLEGAL DOLLAR OPTION."), %713-91106900 C 713 + WRITE(LINE, ERRORS,NUMERRS); %708-91110000 C 708 + WRITE(LINE, ERRORMESS1[I]); %708-91112000 C 708 + WRITE(LINE, ERRORMESS2[I-60]); %708-91114000 C 708 + REWIND(XREFFILE); %002-92003500 C 002 + SORT(PRINTXREF,XREFINPUT,0,XREFMAX,XREFCOMPARE,3,1000,6000); %002-92005000 C 002 +END OF B5700 PASCAL COMPILER............................................99001000 C 001 + %001-99999999 C 001 +? END. 000000≥ + + + + + + +NUMBER OF ERRORS DETECTED = 0. +PROCESSOR TIME = 46 SECONDS. +I/O TIME = 115 SECONDS. + + + + LABEL 000000000LINE 00186197?EXECUTE PATCH/MERGE PATCH /MERGE + + + + + + + + + + + + LABEL 000000000LINE 00186197? COMPILE PASCAL/NEW XALGOL LIBRARY XALGOL /PASCAL + + + + + + BURROUGHS B-5700 XALGOL COMPILER MARK XV.3.00 WEDNESDAY, 07/16/86, 11:50 AM. + + + + PASCAL /NEW + =============== + + + 10001000 T 0000 + 10002000 T 0000 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10003000 T 0000 + % % 10004000 T 0000 + % % 10005000 T 0000 + % * * % 10006000 T 0000 + % * P A S C A L C O M P I L E R * % 10007000 T 0000 + % *********************************** % 10008000 T 0000 + % % 10009000 T 0000 + % % 10010000 T 0000 + % WRITTEN 1975 BY % 10011000 T 0000 + % DAG F. LANGMYHR, % 10012000 T 0000 + % HERIOT-WATT UNIVERSITY, % 10013000 T 0000 + % EDINBURGH. % 10014000 T 0000 + % % 10015000 T 0000 + % % 10016000 T 0000 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10017000 T 0000 + % % 10018000 T 0000 + % % 10019000 T 0000 + % PART 1: DECLARATIONS. % 10020000 T 0000 + % ------------- % 10021000 T 0000 + % % 10022000 T 0000 + % % 10023000 T 0000 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10024000 T 0000 + 10025000 T 0000 + 10026000 T 0000 + BEGIN 10027000 T 0000 + START OF SEGMENT ********** 2 + DEFINE EDITION = "4.4"#;%AUGUST 1978...DAVID A COOPER... %999- 10028000 P 0000 + INTEGER NUMERRS, % @R+25: NUMBER OF ERRORS IN PROGRAM. %500- 10029000 P 0000 + SAVEFACTOR, % @R+26: SAVEFACTOR FOR CODE FILE. %500- 10030000 P 0000 + % >0 COMPILE TO LIBRARY. 10031000 T 0000 + % =0 COMPILE AND RUN. 10032000 T 0000 + % <0 COMPILE FOR SYNTAX. 10033000 T 0000 + PAGECNT, % @R+27: NUMBER OF PAGES PRINTED. %500- 10033800 C 0000 + CARDCNT; % @R+30: NUMBER OF CARDS READ. %500- 10034000 P 0000 + FILE CARD "SOURCE" (1,10,30); % PASCAL SOURCE CODE INPUT FILE %703- 10035000 P 0000 + SAVE FILE OUT LINE DISK SERIAL [20:1200] (1,17,90,SAVE 1); % PRINT FILE 10036000 P 0003 + % AVOID BLOCKING RECORDS OF VARIABLE LENGTH%708- 10036001 C 0009 + FILE PASCALGOL DISK SERIAL [20:300] (1,10,30,SAVE 0); % ALGOL CODE FILE 10037000 P 0009 + DEFINE LINESPERPAGE = 60 #, %502- 10038000 P 0016 + MAXINT=549755813887#; 10039000 T 0016 + 10040000 T 0016 + %*** COMPILER CONSTANTS *** 10041000 T 0016 + DEFINE MAXTABLES = 30 #, %MAX NUMBER OF LEVELS IN IDENTIFIER TABLE. 10042000 P 0016 + MAXNAMES =307 #, %MAX NAMES IN EACH ROW OF IDENTIFIER TABLE. 10043000 P 0016 + MAXLEVEL =15#, %MAX DEPTH OF PROCEDURE DECLARATIONS. 10044000 T 0016 + % ONLY USED IN WITH STATEMENT TO TEST %701- 10044001 C 0016 + MAXCASES =64 #, %MAX LABELS IN A CASE-STATEMENT. %701- 10045000 P 0016 + MAXLABS =50 #, %MAX NUMBER OF IN PROGRAM LABELS. %701- 10046000 P 0016 + MAXPARAMS =200 #, %MAX NUMBER OF PARAMETERS IN WHOLE PROGRAM. 10047000 P 0016 + MAXTYPES =250 #, %MAX NUMBER OF DIFFERENT TYPES. %701- 10048000 P 0016 + MAXCONSTS =100 #, %SIZE OF TABLE FOR CONSTANTS. %701- 10049000 P 0016 + MAXTEMPS =5#, %NUMBER OF EXTRA VARS IN EACH PROCEDURE. 10050000 T 0016 + MAXWITHSYMS= 70 #, %MAX NUMBER OF SYMBOLS USED BY WITH-STATMS. 10051000 P 0016 + MAXSYMS = 800#, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 P 0016 + LISTLENGTH =100 #, %MAX LENGTH OF VAR AND PARAM LISTS. %701- 10053000 P 0016 + MAXEXTFILES=10 #, %MAX NUMBER OF EXTERNAL FILES. %701- 10054000 P 0016 + MAXFILES =10 #, %MAX NUMBER OF FILES DECLARED AT ONE TIME. 10055000 P 0016 + MAXPNTRS = 25#; %MAX NUMBER OF UNDECLARED POINTERS(FORWD). 10056000 P 0016 + 10057000 T 0016 + %*** NAME TABLES *** 10058000 T 0016 + ARRAY NAMETAB1,NAMETAB2,NAMETAB3[0:MAXTABLES,0:MAXNAMES]; 10059000 T 0016 + DEFINE NAMELENGTH =[41:6]#, 10060000 T 0018 + TYPE =[9:10]#, 10061000 T 0018 + IDCLASS =[12:3]#, 10062000 T 0018 + VAR =0#, 10063000 T 0018 + CONST=1#, 10064000 T 0018 + FUNC =2#, 10065000 T 0018 + PROC =3#, 10066000 T 0018 + TYPES=4#, 10067000 T 0018 + INFO =[23:11]#, 10068000 T 0018 + FORMAL =[24:1]#, 10069000 T 0018 + FORWARDDEF =[25:1]#, 10070000 T 0018 + EXTERNALFILE=[26:1]#; 10071000 T 0018 + 10072000 T 0018 + %*** DISPLAY VECTOR *** 10073000 T 0018 + ARRAY DISPLAY[0:MAXLEVEL]; 10074000 T 0018 + DEFINE RECTYPE =[9:10]#, 10075000 T 0020 + FIRSTWITHSYM =[19:10]#, 10076000 T 0020 + LASTWITHSYM =[29:10]#, 10077000 T 0020 + NUMPNTRSINWITH=[35:6]#, 10078000 T 0020 + BRACKETSINWITH=[36:1]#, 10079000 T 0020 + NAMETAB =[46:7]#; 10080000 T 0020 + 10081000 T 0020 + %*** TYPE TABLES *** 10082000 T 0020 + ARRAY TYPETAB1,TYPETAB2,TYPETAB3[0:MAXTYPES]; 10083000 T 0020 + DEFINE FORM =[3:4]#, 10084000 T 0022 + NUMERIC =0#, 10085000 T 0022 + SYMBOLIC=1#, 10086000 T 0022 + SUBTYPE =2#, 10087000 T 0022 + MAINTYPE=[33:10]#, 10088000 T 0022 + CHAR =3#, 10089000 T 0022 + FLOATING=4#, 10090000 T 0022 + ALFA =5#, 10091000 T 0022 + SET =6#, 10092000 T 0022 + SETTYPE =[33:10]#, 10093000 T 0022 + POINTERS=7#, 10094000 T 0022 + POINTTYPE=[33:10]#, 10095000 T 0022 + ARRAYS =8#, 10096000 T 0022 + INXTYPE =[33:10]#, 10097000 T 0022 + ARRTYPE =[43:10]#, 10098000 T 0022 + RECORD =9#, 10099000 T 0022 + RECTAB =[33:10]#, 10100000 T 0022 + FILES =10#, 10101000 T 0022 + FILETYPE=[33:10]#, 10102000 T 0022 + TEXTFILE=11#, 10103000 T 0022 + SIZE =[15:12]#, 10104000 T 0022 + STRUCT=[23:8]#; 10105000 T 0022 + INTEGER NUMTYPES; 10106000 T 0022 + 10107000 T 0022 + %*** PARAMETER TABLE *** 10108000 T 0022 + ARRAY PARAMTAB, FORWPARAM1, FORWPARAM2[0:MAXPARAMS]; %002- 10109000 P 0022 + DEFINE PARAMNAME =[9:10]#, 10110000 T 0024 + PARAMKIND =[13:4]#, 10111000 T 0024 + PARAMLEVEL=[23:10]#, 10112000 T 0024 + PARAMTYPE =[33:10]#, 10113000 T 0024 + PARAMFILE =[34:1]#; 10114000 T 0024 + INTEGER NUMPARAMS; 10115000 T 0024 + 10116000 T 0024 + %*** CONSTANT TABLE *** 10117000 T 0024 + ARRAY CONSTTAB[0:MAXCONSTS]; 10118000 T 0024 + INTEGER NUMCONSTS; 10119000 T 0026 + 10120000 T 0026 + %*** LABEL TABLE *** 10121000 T 0026 + ARRAY LABTAB[0:MAXLABS]; 10122000 T 0026 + DEFINE LABVAL=[14:15]#, 10123000 T 0028 + LABDEF=[15:1]#; 10124000 T 0028 + INTEGER NUMLABS,FIRSTLAB; 10125000 T 0028 + 10126000 T 0028 + %*** TABLES FOR I/O AND CHARACTER HANDLING *** 10127000 T 0028 + ARRAY CH[0:0], TEXT[0:1], STRING[0:11]; 10128000 T 0028 + POINTER CHARPNT,TEXTPNT,TEXTPNT0,STRINGPNT; 10129000 T 0033 + ARRAY ICARD, ALGOLCARD[0:9], LINES, XLINE[0:16]; %708- 10130000 P 0033 + % AVOID BLOCKING VARIABLE LENGTH RECORDS 10130001 C 0037 + POINTER CARDPNT,LINEPNT,XLINEPNT,ALGOLPNT; 10131000 T 0037 + INTEGER CHARCNT,ALGOLCNT,MARGINCNT; 10132000 T 0037 + ARRAY HEADTEXT, ERRLINE[0:16]; %708- 10133000 P 0037 + INTEGER LINECNT, ERRINX; % PAGECNT @ PRT+27 %500- 10134000 P 0039 + 10135000 T 0039 + %*** XREF FILE AND TABLE *** 10136000 T 0039 + FILE XREFFILE DISK SERIAL [20:3000] (1,3,30); % FOR CROSS REFERENCE 10137000 P 0039 + ARRAY BLOCKTAB[0:MAXTABLES], XREFLINE[0:16]; 10138000 T 0043 + ALPHA ARRAY XBUFF[0:2]; %002- 10138500 C 0046 + BOOLEAN XINB; %002- 10138550 C 0048 + INTEGER NUMXREF,NUMBLOCKS; POINTER XREFPNT; 10139000 T 0048 + % 10140000 T 0048 + %*** OTHER TABLES *** 10141000 T 0048 + INTEGER ARRAY VARLIST[0:LISTLENGTH]; % TEMPORARY LIST OF VARIABLES. 10142000 T 0048 + INTEGER VARINDEX,FIRSTVAR; 10143000 T 0050 + ALPHA ARRAY SYMTAB[0:MAXSYMS]; % USED BY "EXPRESSION". %517- 10144000 P 0050 + INTEGER NUMSYMS; 10145000 T 0051 + ARRAY WITHTAB[0:MAXWITHSYMS]; % USED BY "WITHSTAT". 10146000 T 0051 + INTEGER NWITHSYMS; 10147000 T 0053 + INTEGER ARRAY SYMBOL[0:64]; % USED BY "INSYMBOL". 10148000 T 0053 + INTEGER ARRAY SYMKIND[0:62]; %USED IN ERROR RECOVERY. %002- 10149000 P 0055 + ARRAY PNTRTAB1,PNTRTAB2,PNTRTAB3[0:MAXPNTRS];% USED FOR FORWARD POINTERS 10150000 T 0057 + INTEGER NUMPNTRS; 10151000 T 0059 + ARRAY EXTFILETAB[0:MAXEXTFILES]; % EXTERNAL FILES. 10152000 T 0059 + INTEGER NUMEXTFILES; 10153000 T 0061 + ARRAY FILETAB[0:MAXFILES]; % FILES IN USE. 10154000 T 0061 + INTEGER NUMFILES; 10155000 T 0062 + ARRAY ERRP[0:3]; % HOLDS 128 BITS % RECORDS ERROR MESSAGES USED. 10156000 P 0062 + DEFINE ERR(ERR1) = BOOLEAN(0&ERRP[(ERR1).[6:2]][0:((ERR1).[4:5]):1])#; 10156100 C 0064 + DEFINE %518- 10156200 C 0064 + PERMSUB = 0 #, MAXTOTALSUBSCRS = 100#, %518- 10156300 C 0064 + ARRNAM = 1 #; %518- 10156400 C 0064 + ARRAY ARRSUBPERMTAB[0:1,0:MAXTOTALSUBSCRS]; %518- 10156500 C 0064 + INTEGER PASSPERMTAB, MAXPERMTAB, REMEMBERPOSN; %518- 10156600 C 0066 + 10157000 T 0066 + %*** COMPILE TIME OPTIONS *** 10158000 T 0066 + BOOLEAN LISTOPTION,RESWORDOPTION,CHECKOPTION,DUMPOPTION,XREFOPTION; 10159000 T 0066 + DEFINE RESWORDPRESENT = RESWORDOPTION.[1:1] #; %710- 10159100 C 0066 + INTEGER CARDLENGTH; 10160000 T 0066 + 10161000 T 0066 + %*** INTRINSIC TYPES *** 10162000 T 0066 + INTEGER INTTYPE,REALTYPE,ALFATYPE,CHARTYPE,BOOLTYPE,NILTYPE,TEXTTYPE, 10163000 T 0066 + INPUTFILE,OUTPUTFILE,EMPTYSET; 10164000 T 0066 + BOOLEAN INPUTDECL,OUTPUTDECL; 10165000 T 0066 + 10166000 T 0066 + %*** OTHER VARIABLES *** 10170000 T 0066 + ALPHA USER; % THE USER NUMBER FOUND ON THE USER CARD. 10171000 T 0066 + 10172000 T 0066 + INTEGER CURLEVEL, % CURRENT PROCEDURE LEVEL. 10173000 T 0066 + TOPLEVEL, % TOP LEVEL IN DISPLAY VECTOR. 10174000 T 0066 + NUMBEGINS, % NUMBER OF "BEGIN"S IN THE PROGRAM. 10175000 T 0066 + NUMCASES, % NUMBER OF CASE-STATEMENTS IN PROGRAM. 10176000 T 0066 + NUMREPS, % NUMBER OF REPEAT-STATEMENTS IN PROGRAM. 10177000 T 0066 + NUMTEMPS, % NUMBER OF TEMPORARY VARIABLES IN USE. 10178000 T 0066 + CURFUNC, % INDEX OF FUNCTION CURRENTLY COMPILED. 10179000 T 0066 + CURSY, % LAST SYMBOL READ BY SCANNER. 10180000 T 0066 + CURTYPE, % TYPE OF ENTITY LAST COMPILED. 10181000 T 0066 + CURMODE, % CURRENT EXPRESSION MODE. 10182000 T 0066 + LASTREC; % LAST RECORD TABLE DEFINED. 10183000 T 0066 + 10184000 T 0066 + LABEL ENDOFINPUT; 10185000 T 0066 + 10186000 T 0066 + FORMAT NOERRORS ("NO ERRORS DETECTED."), 10187000 T 0066 + START OF SEGMENT ********** 3 + ERRORS (I5," ERRORS DETECTED ",20("#") /), %704- 10188000 P 0066 + ERROR100MESS (//"100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION 10188500 C 0066 + . THE VALUE 07 IS SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT TH 10188600 C 0066 + E COMPILATION ERRORS COUNT."//),% %002- 10188700 C 0066 + ERROR102MESS(//"102 *** WARNING ONLY, ILLEGAL COMPILER OPTION.") 10188750 C 0066 + , % %713- 10188751 C 0066 + ALIST ("$ SET LIST "), %704- 10189000 P 0066 + NOALIST ("$ RESET LIST"), 10190000 T 0066 + MERGE ("$ SET TAPE RESET $" / %704- 10190100 C 0066 + "$ RESET TAPE", T73,"99000000" ), %704- 10190200 C 0066 + LASTLINE ("; TERMINATE: END OF PASCAL PROGRAM."), 10191000 T 0066 + TERMMESS ("**** COMPILATION TERMINATED."); %704- 10192000 P 0066 + 3 IS 106 LONG, NEXT SEG 2 + MONITOR EXPOVR:=REALOVERFLOW; 10193000 T 0066 + 10194000 T 0069 + %*** SCANNER SYMBOLS *** 10195000 T 0069 + DEFINE IDENTIFIER=1#, INTCONST=2#, REALCONST=3#, ALFACONST=4#, 10196000 T 0069 + CHARCONST=5#, NOTSY=6#, ASTERISK=7#, SLASH=8#, 10197000 T 0069 + ANDSY=9#, DIVSY=10#, MODSY=11#, PLUS=12#, 10198000 T 0069 + MINUS=13#, ORSY=14#, LSSSY=15#, LEQSY=16#, 10199000 T 0069 + GEQSY=17#, GTRSY=18#, NEQSY=19#, EQLSY=20#, 10200000 T 0069 + INSY=21#, LPAR=22#, RPAR=23#, LBRACKET=24#, 10201000 T 0069 + RBRACKET=25#, DOUBLEDOT=26#, COMMA=27#, SEMICOLON=28#, 10202000 T 0069 + DOT=29#, ARROW=30#, COLON=31#, ASSIGNSY=32#, 10203000 T 0069 + BEGINSY=33#, ENDSY=34#, IFSY=35#, THENSY=36#, 10204000 T 0069 + ELSESY=37#, CASESY=38#, OFSY=39#, REPEATSY=40#, 10205000 T 0069 + UNTILSY=41#, WHILESY=42#, DOSY=43#, FORSY=44#, 10206000 T 0069 + TOSY=45#, DOWNTOSY=46#, GOTOSY=47#, NILSY=48#, 10207000 T 0069 + TYPESY=49#, ARRAYSY=50#, RECORDSY=51#, FILESY=52#, 10208000 T 0069 + SETSY=53#, CONSTSY=54#, VARSY=55#, LABELSY=56#, 10209000 T 0069 + FUNCSY=57#, PROCSY=58#, WITHSY=59#, PROGRAMSY=60#, 10210000 T 0069 + PACKEDSY=61#, ASSERTSY=62#; %002- 10211000 P 0069 + 10212000 T 0069 + DEFINE INITIAL=0#, MIDDLE=1#, TERMINAL=2#; 10213000 T 0069 + DEFINE NUMBER=0#, BITPATTERN=1#; 10214000 T 0069 + + + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20001000 T 0069 + % % 20002000 T 0069 + % % 20003000 T 0069 + % % 20004000 T 0069 + % PART 2: COMPILER UTILITY ROUTINES. % 20005000 T 0069 + % -------------------------- % 20006000 T 0069 + % % 20007000 T 0069 + % % 20008000 T 0069 + % % 20009000 T 0069 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20010000 T 0069 + 20011000 T 0069 + 20012000 T 0069 + PROCEDURE INSYMBOL; FORWARD; 20013000 T 0069 + PROCEDURE WRITEALGOL; FORWARD; 20014000 T 0073 + PROCEDURE NEWXREF(NAME1,NAME2,TABLE,DECL); 20015000 T 0073 + VALUE NAME1,NAME2,TABLE,DECL; %700- 20016000 P 0073 + REAL NAME1,NAME2; %700- 20017000 P 0073 + INTEGER TABLE; BOOLEAN DECL; %700- 20018000 P 0073 + FORWARD; %700- 20019000 P 0073 + PROCEDURE PRINTERRORS; FORWARD; %700- 20020000 P 0073 + 20021000 T 0073 + DEFINE NDIGITS(N)= 20022000 T 0073 + IF N≤ 9 THEN 1 ELSE 20023000 T 0073 + IF N≤99 THEN 2 ELSE 3 DIGITS#; 20024000 T 0073 + 20025000 T 0073 + PROCEDURE HEADING; %*** PRINTS A HEADING AT START OF NEW PAGE. 20026000 P 0073 + BEGIN DEFINE NEWSEGMENT = HERE #; %700- 20027000 P 0073 + START OF SEGMENT ********** 4 + PAGECNT:=PAGECNT+1; 20028000 T 0000 + REPLACE POINTER(HEADTEXT[*])+85 BY PAGECNT FOR NDIGITS(PAGECNT); 20029000 T 0001 + IF PAGECNT=1 THEN WRITE(LINE[NO],17,HEADTEXT[*]) ELSE %709- 20029900 C 0011 + WRITE( LINE[PAGE]); %709- 20030000 P 0017 + WRITE( LINE[DBL],17,HEADTEXT[*]); %709- 20031000 P 0021 + LINECNT:=2; 20032000 T 0025 + END OF HEADING; %700- 20033000 P 0026 + 4 IS 27 LONG, NEXT SEG 2 + 20034000 T 0073 + 20035000 T 0073 + PROCEDURE PRINTLINE; %*** PRINTS A PASCAL SOURCE CODE LINE %700- 20036000 P 0073 + BEGIN DEFINE NEWSEGMENT = HERE #; %700- 20037000 P 0073 + START OF SEGMENT ********** 5 + REPLACE LINEPNT-8 BY CARDCNT FOR 5 DIGITS; 20038000 T 0000 + IF LINECNT≥LINESPERPAGE THEN HEADING; 20039000 T 0005 + IF REAL(RESWORDOPTION) = 3 THEN % RESERVED WORD IS PRESENT %710- 20040000 P 0007 + BEGIN 20041000 T 0008 + WRITE( LINE[NO],17,XLINE[*]); %708- 20042000 P 0008 + WRITE( LINE[NO],17,XLINE[*]); %708- 20043000 P 0012 + END; 20044000 T 0017 + WRITE(LINE, 17,LINES[*]); %708- 20045000 P 0017 + LINECNT:=LINECNT+1; 20046000 T 0021 + END OF PRINTLINE; %700- 20047000 P 0022 + 5 IS 23 LONG, NEXT SEG 2 + 20048000 T 0073 + 20049000 T 0073 + PROCEDURE NEWCARD; %*** READS A NEW PASCAL SOURCE CODE CARD 20050000 P 0073 + BEGIN DEFINE RESULT = ICARD[*], ETC #; %700- 20051000 P 0073 + START OF SEGMENT ********** 6 + IF LISTOPTION THEN PRINTLINE; 20052000 T 0000 + IF ERRINX>0 THEN PRINTERRORS; 20053000 T 0001 + READ(CARD,10,ICARD[*]) [ENDOFINPUT]; 20054000 T 0003 + CARDPNT:=POINTER(ICARD[*]); 20055000 T 0008 + REPLACE XLINEPNT BY " " FOR 16 WORDS; %700- 20056000 P 0009 + REPLACE LINEPNT BY CARDPNT FOR 10 WORDS, XLINEPNT FOR 6 WORDS;%700- 20057000 P 0013 + RESWORDOPTION := RESWORDOPTION AND TRUE; % RESET RESWORDPRESENT 20057100 C 0018 + CHARCNT:=CARDLENGTH; 20058000 T 0019 + MARGINCNT:=85; 20059000 T 0020 + CARDCNT:=CARDCNT+1; 20060000 T 0021 + END OF NEWCARD; %700- 20061000 P 0022 + 6 IS 27 LONG, NEXT SEG 2 + 20062000 T 0073 + 20063000 T 0073 + DEFINE GEN(GEN1,GEN2,GEN3) = GENI(TRUE,GEN1,GEN3,GEN2) #, %700- 20063100 C 0073 + GENID(GENID1,GENID2,GENID3)= GENI(FALSE,GENID1,GENID2,GENID3) #; %700- 20063200 C 0073 + %700- 20063300 C 0073 + PROCEDURE GENI(GENT, TXT, NUM, N ); %700- 20063400 C 0073 + VALUE GENT, TXT, NUM, N; %700- 20063500 C 0073 + BOOLEAN GENT; ALPHA TXT; INTEGER NUM, N; %700- 20063600 C 0073 + BEGIN DEFINE START = NUM #, NDIG = N #; %700- 20063700 C 0073 + START OF SEGMENT ********** 7 + %700- 20063800 C 0000 + IF GENT THEN %*** GENERATE A TEXT "TXT", CONSISTING OF 20064000 P 0000 + BEGIN %*** "N" LETTERS, STARTING AT "START". 20065000 T 0000 + IF ALGOLCNT 0 THEN 20117000 T 0021 + BEGIN 20118000 T 0021 + WHILE ABSX≥1@7 DO BEGIN ABSX:=ABSX/10; POWER:=POWER+1; END; 20119000 T 0022 + WHILE ABSX<1@6 DO BEGIN ABSX:=ABSX×10; POWER:=POWER-1; END; 20120000 T 0030 + V1:=ENTIER(ABSX); 20121000 T 0036 + V2:=ENTIER((ABSX-V1)×1000000); 20122000 T 0037 + REPLACE ALGOLPNT:ALGOLPNT BY V1 FOR 7 DIGITS, ".", 20123000 T 0040 + V2 FOR 6 DIGITS, "@"; 20124000 T 0047 + ALGOLCNT:=ALGOLCNT-15; 20125000 T 0053 + IF POWER<0 THEN GEN("-",1,7); 20126000 T 0054 + POWER:=ABS(POWER); 20127000 T 0057 + REPLACE ALGOLPNT:ALGOLPNT BY POWER FOR 2 DIGITS; 20128000 T 0058 + ALGOLCNT:=ALGOLCNT-2; 20129000 T 0062 + END ELSE GEN("0",1,7); 20130000 T 0063 + IF X<0 THEN GEN(")",1,7); 20131000 T 0067 + END; 20132000 T 0070 + END OF GENREAL; 20133000 T 0070 + 9 IS 74 LONG, NEXT SEG 2 + 20134000 T 0073 + 20135000 T 0073 + INTEGER TYPEINDEX; 20136000 T 0073 + 20137000 T 0073 + DEFINE NEWTYPE= 20138000 T 0073 + BEGIN 20139000 T 0073 + IF NUMTYPES≥MAXTYPES THEN BEGIN ERROR(45);NUMTYPES:=MAXTYPES-20 END; 20140000 T 0073 + TYPEINDEX:=NUMTYPES:=NUMTYPES+1; 20141000 T 0073 + END #; 20142000 T 0073 + 20143000 T 0073 + 20144000 T 0073 + PROCEDURE WRITEALGOL; %*** WRITES A COMPLETED ALGOL CARD TO%700- 20145000 P 0073 + BEGIN %*** THE FILE. 20146000 T 0073 + DEFINE NEWSEGMENT = HERE #; %700- 20146100 C 0073 + START OF SEGMENT ********** 10 + REPLACE POINTER(ALGOLCARD[9]) BY CARDCNT FOR 8 DIGITS; 20147000 T 0000 + WRITE(PASCALGOL,10,ALGOLCARD[*]); 20148000 T 0005 + IF DUMPOPTION THEN BEGIN IF (LINECNT:=LINECNT+1)≥LINESPERPAGE %502- 20149000 P 0010 + THEN HEADING; WRITE(LINE,10,ALGOLCARD[*]) END; %502- 20149100 C 0012 + ALGOLPNT:=POINTER(ALGOLCARD[*]); ALGOLCNT:=71; 20150000 T 0017 + REPLACE ALGOLPNT BY " " FOR 9 WORDS; 20151000 T 0020 + END OF WRITEALGOL; 20152000 T 0023 + 10 IS 24 LONG, NEXT SEG 2 + 20153000 T 0073 + 20154000 T 0073 + DEFINE MARGIN(LETTER,NUM)= 20155000 T 0073 + BEGIN COMMENT *** PLACES INFORMATION IN THE MARGIN. ; 20156000 T 0073 + IF MARGINCNT≤118 THEN 20157000 T 0073 + BEGIN TEXT[0]:=LETTER; 20158000 T 0073 + REPLACE LINEPNT+MARGINCNT BY TEXTPNT+5 FOR 2, 20159000 T 0073 + NUM FOR NDIGITS(NUM); 20160000 T 0073 + MARGINCNT:=MARGINCNT+6; 20161000 T 0073 + END; 20162000 T 0073 + END OF MARGIN#; 20163000 T 0073 + 20164000 T 0073 + 20165000 T 0073 + PROCEDURE SKIP(SYMBOL); %*** SKIP SYMBOLS TO RECOVER FROM ERROR 20166000 T 0073 + VALUE SYMBOL; INTEGER SYMBOL; %*** CONDITION. 20167000 T 0073 + BEGIN 20168000 T 0073 + DEFINE NEWSEGMENT = HERE #; %700- 20168100 C 0073 + START OF SEGMENT ********** 11 + WHILE CURSY≠SYMBOL AND SYMKIND[CURSY]=MIDDLE DO 20169000 T 0000 + IF CURSY=RECORDSY THEN 20170000 T 0002 + BEGIN DO BEGIN INSYMBOL; 20171000 T 0003 + SKIP(99); 20172000 T 0004 + END UNTIL CURSY≠SEMICOLON AND CURSY≠CASESY; 20173000 T 0005 + END ELSE INSYMBOL; 20174000 T 0007 + END OF SKIP; 20175000 T 0009 + 11 IS 10 LONG, NEXT SEG 2 + 20176000 T 0073 + 20177000 T 0073 + PROCEDURE ERROR(ERRNUM); 20178000 T 0073 + VALUE ERRNUM; INTEGER ERRNUM; 20179000 T 0073 + BEGIN COMMENT *** ARRANGE ERROR INDICATOR. ; 20180000 T 0073 + DEFINE NEWSEGMENT = HERE #; %700- 20180100 C 0073 + START OF SEGMENT ********** 12 + IF ERRNUM<0 THEN ERRNUM:=ABS(ERRNUM) ELSE %511- 20180900 C 0000 + NUMERRS:=NUMERRS+1; 20181000 T 0002 + % %002- 20181500 C 0004 + % %002- 20181550 C 0004 + IF ERRNUM=100 OR ERRNUM=102 %713- 20181600 C 0004 + THEN NUMERRS := NUMERRS - 1; %*ERROR NUMBER 102 IS ONLY AN ILLEGAL 20181610 C 0005 + % * DOLLAR OPTION WARNING & %713- 20181620 C 0007 + % *ERROR NUMBER 100 ALONE SHOULD NOT %713- 20181650 C 0007 + % * PREVENT THE XALGOL COMPILATION BEING 20181700 C 0007 + % * ZIPPED AS THE VALUE 7 IS SUBSTITUTED 20181750 C 0007 + % * FOR A BAD SAVE CONSTANT IN AN "S"%002- 20181800 C 0007 + % * OPTION. %002- 20181850 C 0007 + % %002- 20181900 C 0007 + % %002- 20181950 C 0007 + ERRP[ERRNUM.[6:2]]:=ERRP[ERRNUM.[6:2]] & 1[ERRNUM.[4:5]:0:1]; %702- 20182000 P 0007 + ERRINX:=MAX(ERRINX,CARDLENGTH-2-CHARCNT); 20183000 T 0013 + IF ERRINX≤115 THEN 20184000 T 0017 + BEGIN REPLACE POINTER(ERRLINE[1])+ERRINX BY "×", 20185000 T 0017 + ERRNUM FOR NDIGITS(ERRNUM); 20186000 T 0026 + ERRINX:=ERRINX+(IF ERRNUM≤ 9 THEN 2 ELSE 20187000 T 0032 + IF ERRNUM≤99 THEN 3 ELSE 4); 20188000 T 0035 + END END OF ERROR; 20189000 T 0038 + 12 IS 39 LONG, NEXT SEG 2 + 20190000 T 0073 + 20191000 T 0073 + PROCEDURE PRINTERRORS; 20192000 T 0073 + BEGIN COMMENT *** PRINT ERROR INDICATORS. ; 20193000 T 0073 + DEFINE NEWSEGMENT = HERE #; %700- 20193100 C 0073 + START OF SEGMENT ********** 13 + IF NOT LISTOPTION THEN %709- 20194000 P 0000 + BEGIN IF PAGECNT=0 THEN HEADING; PRINTLINE END; %709- 20194100 C 0000 + REPLACE POINTER(ERRLINE[0])+4 BY NUMERRS FOR 4 DIGITS; %702- 20194900 C 0003 + WRITE(LINE, 17,ERRLINE[*]); %708- 20195000 P 0011 + LINECNT:=LINECNT+1; 20196000 T 0015 + REPLACE POINTER(ERRLINE[1]) BY " " FOR 16 WORDS; 20197000 T 0016 + ERRINX:=0; 20198000 T 0022 + END OF PRINT ERRORS; 20199000 T 0023 + 13 IS 24 LONG, NEXT SEG 2 + 20200000 T 0073 + 20201000 T 0073 + DEFINE HASH(HASH1) = ENTIER((HASH1) MOD MAXNAMES) #; %505- 20202000 P 0073 + 20203000 T 0073 + INTEGER THISLEVEL,THISTAB,THISINDEX; 20204000 T 0073 + ALPHA THISID, CURNAME1, CURNAME2; % USED IN SCANNER %700- 20205000 P 0073 + BOOLEAN FOUND; 20206000 T 0073 + 20207000 T 0073 + PROCEDURE SEARCHTAB( TAB ); %*** SEARCH NAME TABLE "TAB" FOR THE %700- 20208000 P 0073 + VALUE TAB; INTEGER TAB; %*** IDENTIFIER JUST READ. %700- 20208100 C 0073 + BEGIN ALPHA TNAME; INTEGER WRAPAROUND; %505- 20209000 P 0073 + START OF SEGMENT ********** 14 + WRAPAROUND:=THISINDEX:=HASH(CURNAME1); %505- 20210000 P 0000 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20211000 T 0002 + WHILE (IF TNAME=CURNAME1 THEN NAMETAB2[TAB,THISINDEX]≠CURNAME2 20212000 T 0004 + ELSE TNAME≠0) DO 20213000 T 0007 + BEGIN 20214000 T 0009 + THISINDEX:=IF THISINDEX=0 THEN MAXNAMES ELSE THISINDEX-1; 20215000 T 0009 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20216000 T 0013 + IF THISINDEX=WRAPAROUND THEN TNAME:=0; % TABLE IS FULL %505- 20216100 C 0014 + END; 20217000 T 0016 + FOUND:=TNAME≠0; 20218000 T 0019 + IF XREFOPTION THEN 20219000 T 0020 + IF FOUND THEN NEWXREF(CURNAME1,CURNAME2,TAB,FALSE); % 20220000 T 0020 + END OF SEARCHTAB; %700- 20221000 P 0023 + 14 IS 27 LONG, NEXT SEG 2 + 20222000 T 0073 + PROCEDURE SEARCHDISKDIRECTORY( F, A ); FILE F; ARRAY A[0]; %711- 20222100 C 0073 + SEARCH( F, A[*] ); % END OF SEARCHDISKDIRECTORY; %711- 20222200 C 0073 + %711- 20222300 C 0075 + PROCEDURE SEARCH; %*** SEARCH ALL TABLES CURRENTLY IN USE. 20223000 P 0075 + BEGIN DEFINE RESULT = THISID #; %700- 20224000 P 0075 + START OF SEGMENT ********** 15 + THISLEVEL:=TOPLEVEL+1; 20225000 T 0000 + DO BEGIN 20226000 T 0001 + THISLEVEL:=THISLEVEL-1; 20227000 T 0002 + THISTAB:=IF THISLEVEL≤CURLEVEL THEN THISLEVEL 20228000 T 0003 + ELSE DISPLAY[THISLEVEL].NAMETAB; 20229000 T 0004 + SEARCHTAB(THISTAB); 20230000 T 0006 + END UNTIL FOUND OR THISLEVEL=0; 20231000 T 0007 + THISID:=NAMETAB3[THISTAB,THISINDEX]; 20232000 T 0009 + END OF SEARCH; %700- 20233000 P 0011 + 15 IS 12 LONG, NEXT SEG 2 + 20234000 T 0075 + 20235000 T 0075 + PROCEDURE NEWNAME( NAME1,NAME2, TAB ); %700- 20236000 P 0075 + VALUE NAME1, NAME2, TAB; %700- 20236100 C 0075 + ALPHA NAME1, NAME2; INTEGER TAB; %700- 20236200 C 0075 + BEGIN %*** ENTER A NEW NAME INTO THE NAME TABLE "TAB". 20237000 T 0075 + ALPHA TNAME; INTEGER WRAPAROUND; %505- 20237100 C 0075 + START OF SEGMENT ********** 16 + WRAPAROUND:=THISINDEX:=HASH(NAME1); %505- 20238000 P 0000 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20239000 T 0002 + WHILE(IF TNAME=NAME1 THEN NAMETAB2[TAB,THISINDEX]≠NAME2 20240000 T 0004 + ELSE TNAME≠0) DO 20241000 T 0007 + BEGIN 20242000 T 0009 + THISINDEX:=IF THISINDEX=0 THEN MAXNAMES ELSE THISINDEX-1; 20243000 T 0009 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20244000 T 0013 + IF THISINDEX=WRAPAROUND THEN % TABLE AT THIS LEVEL IS FULL 20244100 C 0014 + BEGIN ERROR(40); NAME1:=TNAME; NAME2:=NAMETAB2[TAB,THISINDEX] 20244200 C 0015 + END; %505- 20244300 C 0018 + END; 20245000 T 0019 + IF TNAME≠0 THEN ERROR(2); 20246000 T 0021 + NAMETAB1[TAB,THISINDEX]:=NAME1; 20247000 T 0023 + NAMETAB2[TAB,THISINDEX]:=NAME2; 20248000 T 0025 + IF XREFOPTION THEN NEWXREF(NAME1,NAME2,TAB,TRUE); 20249000 T 0027 + END OF NEWNAME; %700- 20250000 P 0029 + 16 IS 33 LONG, NEXT SEG 2 + 20251000 T 0075 + + + + + + + 20300000 T 0075 + PROCEDURE INITIALIZE; %*** INITIALIZATION *** 20301000 T 0075 + BEGIN %********************** 20302000 T 0075 + INTEGER T1,T3; 20303000 T 0075 + START OF SEGMENT ********** 17 + ALPHA A; 20304000 T 0000 + FILL SYMKIND[*] WITH 28(MIDDLE),TERMINAL,4(MIDDLE),INITIAL,TERMINAL, 20305000 T 0000 + START OF SEGMENT ********** 18 + INITIAL,MIDDLE,TERMINAL,INITIAL,MIDDLE,INITIAL,TERMINAL,INITIAL, 20306000 T 0001 + MIDDLE,INITIAL,2(MIDDLE),INITIAL,MIDDLE,INITIAL,4(MIDDLE), 20307000 T 0001 + 7(INITIAL),MIDDLE,INITIAL; %002- 20308000 P 0001 + 18 IS 63 LONG, NEXT SEG 17 + 20309000 T 0001 + FILL SYMBOL[*] WITH 10(0),0,ARROW,0,COLON,GTRSY,GEQSY,PLUS,9(0), 20310000 T 0001 + START OF SEGMENT ********** 19 + DOT,LBRACKET,ANDSY,LPAR,LSSSY,ARROW,0,9(0),0,ASTERISK,MINUS, 20311000 T 0003 + RPAR,SEMICOLON,LEQSY,0,SLASH,8(0),COMMA,0,NEQSY,EQLSY,RBRACKET, 20312000 T 0003 + 0,DOUBLEDOT; 20313000 T 0003 + 19 IS 65 LONG, NEXT SEG 17 + 20314000 T 0003 + LINEPNT :=POINTER(LINES[1]); %708- 20315000 P 0003 + XLINEPNT:=POINTER(XLINE[1]); 20316000 T 0006 + REPLACE LINEPNT-8 BY " " FOR 17 WORDS; %708- 20317000 P 0009 + REPLACE XLINEPNT-8 BY LINEPNT-8 FOR 17 WORDS; %708- 20318000 P 0015 + REPLACE POINTER(ERRLINE[*]) BY "**** ", LINEPNT FOR 16 WORDS; 20319000 P 0021 + ALGOLPNT:=POINTER(ALGOLCARD[*]); ALGOLCNT:=71; 20320000 T 0028 + REPLACE ALGOLPNT BY LINEPNT FOR 9 WORDS; %708- 20321000 P 0030 + CHARPNT := POINTER(CH[0])+7; CH[0] := " "; %711- 20322000 P 0033 + TEXTPNT:=POINTER(TEXT[*])+1; TEXTPNT0:=TEXTPNT-1; 20323000 T 0039 + REPLACE TEXTPNT BY " " FOR 15; 20324000 T 0046 + STRINGPNT:=POINTER(STRING[*]); 20325000 T 0049 + REPLACE POINTER(HEADTEXT[*]) BY LINEPNT FOR 10 WORDS, "PAGE 1 ", 20326000 P 0051 + LINEPNT FOR 6 WORDS; %708- 20326100 C 0059 + REPLACE POINTER(HEADTEXT[*]) BY "PASCAL(", EDITION, ")/B-5700"; 20327000 T 0061 + TEXT[0]:=TIME(5); 20328000 T 0072 + REPLACE POINTER(HEADTEXT[*])+45 BY TEXTPNT+5 FOR 2,"/", %709- 20329000 P 0073 + TEXTPNT+1 FOR 2, "/", TEXTPNT+3 FOR 2; %709- 20330000 P 0084 + T1:=TIME(1)/3600; 20331000 T 0095 + REPLACE POINTER(HEADTEXT[*])+57 BY (T1 DIV 60) FOR 2 DIGITS, ":", 20332000 T 0097 + ENTIER(T1 MOD 60) FOR 2 DIGITS; 20333000 T 0107 + HEADING; 20334000 T 0111 + 20335000 T 0112 + %*** INITIALIZE INTRINSIC TYPES, CONSTANTS ETC. *** 20336000 T 0112 + 20337000 T 0112 + INTTYPE:=T3:=1; %*** "INTEGER" *** 20338000 T 0112 + T1:=NUMERIC; T1.SIZE:=1; T1.STRUCT:=0; 20339000 T 0113 + TYPETAB1[1]:=T1; TYPETAB2[1]:=-MAXINT; TYPETAB3[1]:=MAXINT; 20340000 T 0117 + NEWNAME("7INTEGE","R",0); T3.IDCLASS:=TYPES; 20341000 T 0121 + NAMETAB3[0,THISINDEX]:=T3; 20342000 T 0124 + REALTYPE:=T3:=2; %*** "REAL" *** 20343000 T 0126 + T1.FORM:=FLOATING; TYPETAB1[2]:=T1; 20344000 T 0128 + NEWNAME("400REAL",0,0); T3.IDCLASS:=TYPES; 20345000 T 0131 + NAMETAB3[0,THISINDEX]:=T3; 20346000 T 0134 + ALFATYPE:=T3:=3; %*** "ALFA" *** 20347000 T 0136 + T1.FORM:=ALFA; TYPETAB1[3]:=T1; 20348000 T 0137 + NEWNAME("400ALFA",0,0); T3.IDCLASS:=TYPES; 20349000 T 0140 + NAMETAB3[0,THISINDEX]:=T3; 20350000 T 0143 + BOOLTYPE:=T3:=4; %*** "BOOLEAN" *** 20351000 T 0145 + T1.FORM:=SYMBOLIC; TYPETAB1[4]:=T1; TYPETAB3[4]:=1; 20352000 T 0146 + NEWNAME("7BOOLEA","N",0); T3.IDCLASS:=TYPES; 20353000 T 0150 + NAMETAB3[0,THISINDEX]:=T3; 20354000 T 0153 + CHARTYPE:=T3:=5; %*** "CHAR" *** 20355000 T 0155 + T1.FORM:=CHAR; TYPETAB1[5]:=T1; TYPETAB3[5]:=63; 20356000 T 0157 + NEWNAME("400CHAR",0,0); T3.IDCLASS:=TYPES; 20357000 T 0161 + NAMETAB3[0,THISINDEX]:=T3; 20358000 T 0164 + T3:=BOOLTYPE; T3.IDCLASS:=CONST; %*** "FALSE" *** 20359000 T 0177 + NEWNAME("50FALSE",0,0); NAMETAB3[0,THISINDEX]:=T3; 20360000 T 0179 + T3.INFO:=1; %*** "TRUE" *** 20361000 T 0182 + NEWNAME("400TRUE",0,0); NAMETAB3[0,THISINDEX]:=T3; 20362000 T 0184 + NILTYPE := 6; %*** TYPE OF "NIL" *** %602- 20363000 P 0187 + T1.FORM := POINTERS; TYPETAB1[6] := T1; %602- 20364000 P 0188 + EMPTYSET := 7; % %602- 20364500 C 0191 + T1.FORM := SET; TYPETAB1[7] := T1; %602- 20365000 P 0192 + NUMTYPES := 7; % %602- 20365500 C 0195 + NEWNAME("6MAXINT",0,0); T3:=INTTYPE; %*** "MAXINT" *** 20366000 T 0196 + T3.IDCLASS:=CONST; T3.INFO:=1024; 20367000 T 0198 + NAMETAB3[0,THISINDEX]:=T3; 20368000 T 0201 + NUMCONSTS:=1; CONSTTAB[1]:=MAXINT; 20369000 T 0203 + NEWNAME("50PRT25",0,0); %*** "PRT25" *** %501- 20369100 C 0205 + T3:=INTTYPE; T3.IDCLASS:=VAR; % GLOBAL INTEGER VARIABLE %501- 20369200 C 0206 + NAMETAB3[0,THISINDEX] := T3; %501- 20369300 C 0209 + 20370000 T 0211 + T3:=0; T3.IDCLASS:=PROC; %*** PROCEDURES *** 20371000 T 0211 + FOR A:="3000GET", "3000NEW", "400PACK", "400PAGE", "3000PUT", 20372000 T 0213 + "400READ", "6READLN", "50RESET", "6UNPACK", "50WRITE", %002- 20373000 P 0223 + "6QQJZXL" DO %002- 20373500 C 0233 + BEGIN 20374000 T 0236 + NEWNAME(A,0,0); NAMETAB3[0,THISINDEX]:=T3; 20375000 T 0236 + END; 20376000 T 0239 + NEWNAME("7DISPOS","E",0); NAMETAB3[0,THISINDEX]:=T3; 20377000 T 0257 + NEWNAME("7REWRIT","E",0); NAMETAB3[0,THISINDEX]:=T3; 20378000 T 0260 + NEWNAME("7WRITEL","N",0); NAMETAB3[0,THISINDEX]:=T3; 20379000 T 0263 + 20380000 T 0266 + T3.IDCLASS:=FUNC; %*** FUNCTIONS *** 20381000 T 0266 + FOR A:="3000ABS", "6ARCTAN", "3000CHR", "3000COS", "3000EOF", 20382000 T 0268 + "400EOLN", "3000EXP", "20000LN", "3000ODD", "400PRED", 20383000 T 0278 + "400SUCC", "50ROUND", "3000SIN", "3000SQR", "400SQRT", 20384000 T 0288 + "50TRUNC", "6CONCAT", "400TIME", "400DATE", "6IOTIME", 20385000 T 0298 + "400USER", "3000ORD" 20386000 T 0308 + DO BEGIN 20387000 T 0311 + NEWNAME(A,0,0); NAMETAB3[0,THISINDEX]:=T3; 20388000 T 0313 + END; 20389000 T 0316 + NEWNAME("7CPUTIM","E",0); NAMETAB3[0,THISINDEX]:=T3; %514- 20390000 P 0342 + NEWNAME("7WEEKDA","Y",0); NAMETAB3[0,THISINDEX]:=T3; 20391000 T 0345 + 20392000 T 0348 + TEXTTYPE:=T3:=NUMTYPES:=NUMTYPES+1; %*** "TEXT" *** 20393000 T 0348 + T1 := TEXTFILE; T1.STRUCT := 1; TYPETAB1[TEXTTYPE] := T1; % 20394000 T 0350 + T3.IDCLASS := TYPES; % 20395000 T 0354 + NEWNAME("400TEXT",0,0); NAMETAB3[0,THISINDEX]:=T3; 20396000 T 0356 + T3:=TEXTTYPE; T3.IDCLASS:=VAR; %*** "INPUT" *** 20397000 T 0359 + T3.EXTERNALFILE:=1; 20398000 T 0362 + NEWNAME("50INPUT",0,0); INPUTFILE:=THISINDEX; 20399000 T 0363 + NAMETAB3[0,THISINDEX]:=T3; 20400000 T 0365 + NEWNAME("6OUTPUT",0,0); %*** "OUTPUT" *** 20401000 T 0367 + NAMETAB3[0,THISINDEX]:=T3; OUTPUTFILE:=THISINDEX; 20402000 T 0369 + NEWCARD; LISTOPTION:=CHECKOPTION:=TRUE; % DEFAULT %709- 20402100 C 0371 + INSYMBOL; % ANALYSING FIRST CARD MAY CHANGE DEFAULT LIST OPTN 20402200 C 0373 + IF LISTOPTION AND PAGECNT=0 THEN HEADING; % ON FIRST PAGE. %709- 20402300 C 0374 + END OF INTIALIZED; 20403000 T 0376 + 17 IS 385 LONG, NEXT SEG 2 + 20404000 T 0075 + 20500000 T 0075 + 20501000 T 0075 + %*** XREF ROUTINES *** 20502000 T 0075 + %********************** 20503000 T 0075 + 20504000 T 0075 + DEFINE XREFCARD=[16:17]#, 20505000 T 0075 + XREFBLOCK=[26:10]#; 20506000 T 0075 + REAL A0,B0,A1,B1,LASTA0,LASTA1; 20507000 T 0075 + INTEGER NL,LASTBLOCK,A2,AX; 20508000 T 0075 + 20509000 T 0075 + PROCEDURE NEWXREF(NAME1,NAME2,TABLE,DECL); 20510000 T 0075 + VALUE NAME1,NAME2,TABLE,DECL; 20511000 T 0075 + REAL NAME1,NAME2; 20512000 T 0075 + INTEGER TABLE; 20513000 T 0075 + BOOLEAN DECL; 20514000 T 0075 + BEGIN 20515000 T 0075 + DEFINE NEWSEGMENT = HERE #; %700- 20515100 C 0075 + START OF SEGMENT ********** 20 + NL:=NAME1.NAMELENGTH; 20516000 T 0000 + IF NL<7 THEN NAME1:=0&NAME1[41:41:6]&NAME1[35:6×NL-1:6×NL] 20517000 T 0001 + ELSE NAME2:=0&NAME2[35:6×(NL-6)-1:6×(NL-6)]; 20518000 T 0008 + AX:=CARDCNT; AX.XREFBLOCK:=BLOCKTAB[TABLE]; 20519000 T 0015 + IF DECL THEN AX := -AX; %002- 20520000 P 0017 + WRITE(XREFFILE,*,NAME1,NAME2,AX); 20521000 T 0019 + END OF NEWXREF; 20522000 T 0030 + 20 IS 31 LONG, NEXT SEG 2 + 20523000 T 0075 + PROCEDURE XREFMAX(A); 20524000 T 0075 + ARRAY A[0]; 20525000 T 0075 + BEGIN 20526000 T 0075 + A[0]:="AZZZZZZ"; A[1]:="ZZZZZZ"; A[2]:=9999999999; 20527000 T 0075 + END OF XREFMAX; 20528000 T 0078 + 20529000 T 0082 + 20530000 T 0082 + BOOLEAN PROCEDURE XREFCOMPARE(A,B); 20531000 T 0082 + ARRAY A,B[0]; 20532000 T 0082 + BEGIN 20533000 T 0082 + DEFINE NEWSEGMENT = HERE #; %700- 20533100 C 0082 + START OF SEGMENT ********** 21 + A0:=A[0]; B0:=B[0]; A1:=A[1]; B1:=B[1]; 20534000 T 0000 + XREFCOMPARE:= 20535000 T 0004 + IF A0.[35:36]≠B0.[35:36] THEN A0.[35:36]LINESPERPAGE THEN HEADING; 20561000 T 0022 + XREFPNT:=POINTER(XREFLINE[*]); NUMXREF:=0; 20562000 T 0024 + REPLACE XREFPNT BY " " FOR 17 WORDS; XREFPNT:=XREFPNT+24; 20563000 T 0026 + END; 20564000 T 0032 + REPLACE XREFPNT BY A2.XREFCARD FOR 5 DIGITS; 20565000 T 0032 + XREFPNT:=XREFPNT+7; NUMXREF:=NUMXREF+1; 20566000 T 0036 + END ELSE 20567000 T 0040 + IF A2<0 THEN 20568000 T 0040 + BEGIN 20569000 T 0042 + A2 := -A2; %002- 20570000 P 0042 + WRITE(LINE, 17,XREFLINE[*]); LINECNT:=LINECNT+1; %708- 20571000 P 0043 + IF LINECNT>LINESPERPAGE THEN HEADING; 20572000 T 0049 + XREFPNT:=POINTER(XREFLINE[*]); NUMXREF:=0; 20573000 T 0050 + REPLACE XREFPNT BY " " FOR 17 WORDS; 20574000 T 0053 + TEXT[0]:=A0.[35:36]; LASTA0:=A0; 20575000 T 0056 + REPLACE XREFPNT BY TEXTPNT+1 FOR A0.NAMELENGTH; 20576000 T 0059 + TEXT[0]:=LASTA1:=A1; 20577000 T 0064 + IF A0.NAMELENGTH>6 THEN 20578000 T 0066 + REPLACE XREFPNT+6 BY TEXTPNT+1 FOR A0.NAMELENGTH-6; 20579000 T 0067 + REPLACE XREFPNT+17 BY A2.XREFCARD FOR 5 DIGITS; 20580000 T 0075 + XREFPNT:=XREFPNT+24; LASTBLOCK:=A2.XREFBLOCK; 20581000 T 0081 + END; 20582000 T 0085 + END; 20583000 T 0085 + END OF PRINTXREF; 20584000 T 0085 + 23 IS 86 LONG, NEXT SEG 2 + 20585000 T 0082 + 20800000 T 0082 + 20801000 T 0082 + PROCEDURE CHECKTYPES( LEFTTYPE, RIGHTTYPE ); %700- 20802000 P 0082 + VALUE LEFTTYPE, RIGHTTYPE; INTEGER LEFTTYPE, RIGHTTYPE; %700- 20803000 P 0082 + BEGIN %700- 20804000 P 0082 + REAL TT1, TT2; INTEGER F1, F2, LT, RT; %700- 20805000 P 0082 + START OF SEGMENT ********** 24 + IF LEFTTYPE>0 AND RIGHTTYPE>0 THEN 20806000 T 0000 + IF LEFTTYPE≠RIGHTTYPE THEN 20807000 T 0001 + BEGIN 20808000 T 0003 + LT:=LEFTTYPE; RT:=RIGHTTYPE; 20809000 T 0003 + TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20810000 T 0005 + F1:=TT1.FORM; F2:=TT2.FORM; 20811000 T 0007 + IF LT≠REALTYPE OR F2≠NUMERIC THEN 20812000 T 0009 + IF(F1 NEQ SET OR RT NEQ EMPTYSET) % %600- 20813000 P 0011 + AND % %600- 20813050 C 0013 + (F2 NEQ SET OR LT NEQ EMPTYSET) THEN % %600- 20813100 C 0013 + IF(F1 NEQ POINTERS OR RT NEQ NILTYPE) % %600- 20814000 P 0015 + AND % %600- 20814050 C 0017 + (F2 NEQ POINTERS OR LT NEQ NILTYPE) THEN % %600- 20814100 C 0017 + BEGIN 20815000 T 0019 + IF F1=SET AND F2=SET THEN 20816000 T 0020 + BEGIN 20817000 T 0022 + LT:=TT1.SETTYPE; RT:=TT2.SETTYPE; 20818000 T 0022 + TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20819000 T 0025 + F1:=TT1.FORM; F2:=TT2.FORM; 20820000 T 0027 + END; 20821000 T 0029 + IF F1=POINTERS AND F2=POINTERS THEN 20822000 T 0029 + BEGIN 20823000 T 0031 + LT:=TT1.POINTTYPE; RT:=TT2.POINTTYPE; 20824000 T 0031 + TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20825000 T 0034 + F1:=TT1.FORM; F2:=TT2.FORM; 20826000 T 0036 + END; 20827000 T 0038 + WHILE F1=SUBTYPE DO 20828000 T 0038 + BEGIN LT:=TT1.MAINTYPE; TT1:=TYPETAB1[LT]; F1:=TT1.FORM END; 20829000 T 0040 + WHILE F2=SUBTYPE DO 20830000 T 0044 + BEGIN RT:=TT2.MAINTYPE; TT2:=TYPETAB1[RT]; F2:=TT2.FORM END; 20831000 T 0046 + IF LT>0 AND RT>0 THEN 20832000 T 0050 + IF LT≠RT THEN 20833000 T 0052 + IF F1≠NUMERIC OR F2≠NUMERIC THEN 20834000 T 0053 + IF F1≠CHAR OR F2≠CHAR THEN ERROR(17); 20835000 T 0055 + END; 20836000 T 0059 + END; 20837000 T 0059 + END OF CHECKTYPES; %700- 20838000 P 0059 + 24 IS 64 LONG, NEXT SEG 2 + 20839000 T 0082 + 20840000 T 0082 + INTEGER FILENAME; 20841000 T 0082 + BOOLEAN LPARFOUND,SAVEXREFOPT; %002- 20842000 P 0082 + 20843000 T 0082 + PROCEDURE FILEPARAM( DEFAULTFILE ); %*** CHECKS THE FIRST PARAMETER 20844000 P 0082 + VALUE DEFAULTFILE; INTEGER DEFAULTFILE;%*** TO SEE IF IT IS A FILE.%700- 20844100 C 0082 + BEGIN DEFINE RESULTS = FILENAME & LPARFOUND #; %700- 20845000 P 0082 + START OF SEGMENT ********** 25 + INSYMBOL; FILENAME:=CURTYPE:=0; 20846000 T 0000 + LPARFOUND:=CURSY=LPAR; 20847000 T 0001 + SAVEXREFOPT := XREFOPTION; XREFOPTION := FALSE; %002- 20847500 C 0003 + IF LPARFOUND THEN 20848000 T 0004 + BEGIN 20849000 T 0004 + INSYMBOL; 20850000 T 0005 + IF CURSY=IDENTIFIER THEN 20851000 T 0005 + BEGIN 20852000 T 0006 + SEARCH; 20853000 T 0007 + IF FOUND THEN 20854000 T 0007 + BEGIN 20855000 T 0007 + IF THISID.IDCLASS=VAR THEN 20856000 T 0008 + BEGIN 20857000 T 0009 + CURTYPE:=THISID.TYPE; 20858000 T 0010 + IF TYPETAB1[CURTYPE].FORM≥FILES THEN 20859000 T 0011 + BEGIN 20860000 T 0012 + FILENAME:=1000×THISLEVEL+THISINDEX; 20861000 T 0013 + IF SAVEXREFOPT THEN NEWXREF(CURNAME1,CURNAME2,THISLEVEL, 20861500 C 0015 + FALSE); %002- 20861550 C 0016 + INSYMBOL; 20862000 T 0017 + END END END END; 20863000 T 0017 + IF SYMKIND[CURSY]=TERMINAL THEN ERROR(46); 20864000 T 0017 + END; 20865000 T 0020 + IF FILENAME=0 THEN FILENAME:=DEFAULTFILE; 20866000 T 0020 + IF (FILENAME=INPUTFILE AND NOT INPUTDECL) OR 20867000 T 0022 + (FILENAME=OUTPUTFILE AND NOT OUTPUTDECL) THEN ERROR(96); 20868000 T 0023 + XREFOPTION := SAVEXREFOPT; %002- 20868500 C 0026 + END OF FILEPARAM; %700- 20869000 P 0027 + 25 IS 28 LONG, NEXT SEG 2 + 20870000 T 0082 + 20871000 T 0082 + REAL CURVAL; INTEGER CURLENGTH; %700- 20872000 P 0082 + %700- 20873000 P 0082 + PROCEDURE CONSTANT( CVAL, CTYPE ); %700- 20874000 P 0082 + REAL CVAL; INTEGER CTYPE; %700- 20875000 P 0082 + BEGIN %700- 20876000 P 0082 + INTEGER TFORM; BOOLEAN SIGNED, NEGATIVE; %700- 20876100 C 0082 + START OF SEGMENT ********** 26 + IF CURSY=MINUS OR CURSY=PLUS THEN 20877000 T 0000 + BEGIN SIGNED:=TRUE; NEGATIVE:=CURSY=MINUS; 20878000 T 0001 + INSYMBOL; 20879000 T 0004 + END ELSE SIGNED:=NEGATIVE:=FALSE; 20880000 T 0004 + IF CURSY=INTCONST THEN 20881000 T 0006 + BEGIN CTYPE:=INTTYPE; 20882000 T 0007 + CVAL:=IF NEGATIVE THEN -CURVAL ELSE CURVAL; 20883000 T 0008 + END ELSE 20884000 T 0011 + IF CURSY=CHARCONST THEN 20885000 T 0011 + BEGIN IF SIGNED THEN ERROR(29); 20886000 T 0012 + CTYPE:=CHARTYPE; CVAL:=CURVAL; 20887000 T 0014 + END ELSE 20888000 T 0016 + IF CURSY=REALCONST THEN 20889000 T 0016 + BEGIN CTYPE:=REALTYPE; 20890000 T 0018 + CVAL:=IF NEGATIVE THEN -CURVAL ELSE CURVAL; 20891000 T 0019 + END ELSE 20892000 T 0022 + IF CURSY=ALFACONST THEN 20893000 T 0022 + BEGIN IF SIGNED THEN ERROR(29); 20894000 T 0023 + IF CURLENGTH>7 THEN ERROR(41); 20895000 T 0025 + CTYPE:=ALFATYPE; CVAL:=CURVAL; 20896000 T 0027 + END ELSE 20897000 T 0029 + IF CURSY=IDENTIFIER THEN 20898000 T 0029 + BEGIN 20899000 T 0030 + SEARCH; 20900000 T 0031 + IF FOUND THEN 20901000 T 0031 + BEGIN 20902000 T 0032 + IF THISID.IDCLASS=CONST AND NOT BOOLEAN(THISID.FORMAL) THEN 20903000 T 0032 + BEGIN 20904000 T 0035 + IF TYPETAB1[THISID.TYPE].FORM≤ALFA THEN 20905000 T 0035 + BEGIN 20906000 T 0037 + CVAL:=THISID.INFO; 20907000 T 0038 + IF CVAL>1023 THEN CVAL:=CONSTTAB[CVAL-1023]; 20908000 T 0039 + CTYPE:=THISID.TYPE; 20909000 T 0042 + IF SIGNED THEN 20910000 T 0044 + BEGIN 20911000 T 0044 + TFORM:=TYPETAB1[THISID.TYPE].FORM; 20912000 T 0044 + IF TFORM≠NUMERIC AND TFORM≠FLOATING THEN ERROR(29) ELSE 20913000 T 0046 + IF NEGATIVE THEN CVAL:=-CVAL; 20914000 T 0049 + END; 20915000 T 0052 + END ELSE BEGIN ERROR(48); CVAL:=CTYPE:=0 END; 20916000 T 0052 + END ELSE BEGIN ERROR(32); CVAL:=CTYPE:=0 END; 20917000 T 0055 + END ELSE BEGIN ERROR(1); CVAL:=CTYPE:=0 END; 20918000 T 0058 + END ELSE BEGIN ERROR(32); CVAL:=CTYPE:=0 END; 20919000 T 0061 + INSYMBOL; 20920000 T 0064 + END OF CONSTANT; %700- 20921000 P 0064 + 26 IS 68 LONG, NEXT SEG 2 + + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 30001000 T 0082 + % % 30002000 T 0082 + % % 30003000 T 0082 + % % 30004000 T 0082 + % PART 3: THE SCANNER. % 30005000 T 0082 + % ------------ % 30006000 T 0082 + % % 30007000 T 0082 + % % 30008000 T 0082 + % % 30009000 T 0082 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 30010000 T 0082 + 30011000 T 0082 + % INTERNAL INTERNAL SYMBOL 30012000 T 0082 + % SYMBOL NUMBER NAME KIND 30013000 T 0082 + % 30014000 T 0082 + % IDENTIFIER 1 IDENTIFIER MIDDLE 30015000 T 0082 + % 122 2 INTCONST MIDDLE 30016000 T 0082 + % 2.5 3 REALCONST MIDDLE 30017000 T 0082 + % "ABCD" 4 ALFACONST MIDDLE 30018000 T 0082 + % "C" 5 CHARCONST MIDDLE 30019000 T 0082 + % NOT 6 NOTSY MIDDLE 30020000 T 0082 + % * 7 ASTERISK MIDDLE 30021000 T 0082 + % / 8 SLASH MIDDLE 30022000 T 0082 + % & AND 9 ANDSY MIDDLE 30023000 T 0082 + % DIV 10 DIVSY MIDDLE 30024000 T 0082 + % MOD 11 MODSY MIDDLE 30025000 T 0082 + % + 12 PLUS MIDDLE 30026000 T 0082 + % - 13 MINUS MIDDLE 30027000 T 0082 + % OR 14 ORSY MIDDLE 30028000 T 0082 + % < LSS 15 LSSSY MIDDLE 30029000 T 0082 + % <= LEQ ≤ 16 LEQSY MIDDLE 30030000 T 0082 + % >= GEQ ≥ 17 GEQSY MIDDLE 30031000 T 0082 + % > GTR 18 GTRSY MIDDLE 30032000 T 0082 + % <> NEQ ≠ 19 NEQSY MIDDLE 30033000 T 0082 + % = EQL 30 EQLSY MIDDLE 30034000 T 0082 + % IN 21 INSY MIDDLE 30035000 T 0082 + % ( 22 LPAR MIDDLE 30036000 T 0082 + % ) 23 RPAR MIDDLE 30037000 T 0082 + % [ 24 LBRACKET MIDDLE 30038000 T 0082 + % ] 25 RBRACKET MIDDLE 30039000 T 0082 + % .. 26 DOUBLEDOT MIDDLE 30040000 T 0082 + % , 27 COMMA MIDDLE 30041000 T 0082 + % ; 28 SEMICOLON TERMINAL 30042000 T 0082 + % . 29 DOT MIDDLE 30043000 T 0082 + % ← @ 30 ARROW MIDDLE 30044000 T 0082 + % : 31 COLON MIDDLE 30045000 T 0082 + % := 32 ASSIGNSY MIDDLE 30046000 T 0082 + % BEGIN 33 BEGINSY INITIAL 30047000 T 0082 + % END 34 ENDSY TERMINAL 30048000 T 0082 + % IF 35 IFSY INITIAL 30049000 T 0082 + % THEN 36 THENSY MIDDLE 30050000 T 0082 + % ELSE 37 ELSESY TERMINAL 30051000 T 0082 + % CASE 38 CASESY INITIAL 30052000 T 0082 + % OF 39 OFSY MIDDLE 30053000 T 0082 + % REPEAT 40 REPEATSY INITIAL 30054000 T 0082 + % UNTIL 41 UNTILSY TERMINAL 30055000 T 0082 + % WHILE 42 WHILESY INITIAL 30056000 T 0082 + % DO 43 DOSY MIDDLE 30057000 T 0082 + % FOR 44 FORSY INITIAL 30058000 T 0082 + % TO 45 TOSY MIDDLE 30059000 T 0082 + % DOWNTO 46 DOWNTOSY MIDDLE 30060000 T 0082 + % GOTO 47 GOTOSY INITIAL 30061000 T 0082 + % NIL 48 NILSY MIDDLE 30062000 T 0082 + % TYPE 49 TYPESY INITIAL 30063000 T 0082 + % ARRAY 50 ARRAYSY MIDDLE 30064000 T 0082 + % RECORD 51 RECORDSY MIDDLE 30065000 T 0082 + % FILE 52 FILESY MIDDLE 30066000 T 0082 + % SET 53 SETSY MIDDLE 30067000 T 0082 + % CONST 54 CONSTSY INITIAL 30068000 T 0082 + % VAR 55 VARSY INITIAL 30069000 T 0082 + % LABEL 56 LABELSY INITIAL 30070000 T 0082 + % FUNCTION 57 FUNCSY INITIAL 30071000 T 0082 + % PROCEDURE 58 PROCSY INITIAL 30072000 T 0082 + % WITH 59 WITHSY INITIAL 30073000 T 0082 + % PROGRAM 60 PROGRAMSY INITIAL 30074000 T 0082 + % PACKED 61 PACKEDSY MIDDLE 30075000 T 0082 + % ASSERT 62 ASSERTSY INITIAL %002- 30075500 C 0082 + 30076000 T 0082 + 30077000 T 0082 + DEFINE BLANK=48#, EQUAL=61#, QUOTES=63#, DOLLAR=42#, 30078000 T 0082 + LETTER(C)=(17≤C AND C≤25)OR(33≤C AND C≤41)OR(50≤C AND C≤57)#, 30079000 T 0082 + ALFANUM(C)=(LETTER(C) OR C≤9)#; 30080000 T 0082 + 30081000 T 0082 + ALPHA C, CX; %( CURNAME1 & CURNAME2 MOVED TO 20205000 ) %700- 30083000 P 0082 + INTEGER LASTCHARPOS; %( CURVAL, CURLENGTH MOVED TO 20872000 ) %700- 30084000 P 0082 + BOOLEAN FINIS; 30085000 T 0082 + 30086000 T 0082 + PROCEDURE INSYMBOL; %*** IDENTIFIES THE NEXT SYMBOL ******%700- 30087000 P 0082 + BEGIN %700- 30087100 C 0082 + %700- 30087200 C 0082 + PROCEDURE NEXTCHAR; %*** GETS THE NEXT CHARACTER. %700- 30088000 P 0082 + START OF SEGMENT ********** 27 + IF CHARCNT=0 THEN C:=BLANK ELSE 30089000 T 0000 + BEGIN 30090000 T 0002 + REPLACE CHARPNT BY CARDPNT:CARDPNT FOR 1; 30091000 T 0002 + C:=CH[0]; CHARCNT:=CHARCNT-1; 30092000 T 0005 + END OF NEXTCHAR; %700- 30093000 P 0007 + 30094000 T 0007 + INTEGER SCALE,EXP; 30099000 T 0007 + DEFINE T1 = EXP #; % USED AT 30178000 %700- 30099100 C 0007 + BOOLEAN NEGEXP; 30100000 T 0007 + LABEL START,OVERFLOW; 30101000 T 0007 + 30102000 T 0007 + START: 30103000 T 0007 + IF C=BLANK THEN 30104000 T 0008 + BEGIN SCAN CARDPNT:CARDPNT FOR CHARCNT:CHARCNT WHILE =" "; 30105000 T 0008 + IF CHARCNT=0 THEN BEGIN NEWCARD; GO TO START END; 30106000 T 0011 + NEXTCHAR; 30107000 T 0013 + END; 30108000 T 0014 + IF LETTER(C) THEN 30109000 T 0014 + BEGIN 30110000 T 0020 + CURLENGTH:=1; CURNAME1:=C; CURNAME2:=0; 30111000 T 0020 + NEXTCHAR; 30112000 T 0023 + WHILE ALFANUM(C) AND CURLENGTH<6 DO 30113000 T 0024 + BEGIN CURNAME1:=C&CURNAME1[35:29:30]; 30114000 T 0032 + CURLENGTH:=CURLENGTH+1; NEXTCHAR; 30115000 T 0034 + END; 30116000 T 0036 + IF CURLENGTH=6 THEN 30117000 T 0036 + BEGIN 30118000 T 0037 + WHILE ALFANUM(C) AND CURLENGTH<12 DO 30119000 T 0038 + BEGIN CURNAME2:=C&CURNAME2[35:29:30]; 30120000 T 0046 + CURLENGTH:=CURLENGTH+1; NEXTCHAR; 30121000 T 0048 + END; 30122000 T 0050 + WHILE ALFANUM(C) DO NEXTCHAR; 30123000 T 0050 + END; 30124000 T 0059 + CURNAME1.NAMELENGTH:=CURLENGTH; 30125000 T 0059 + CASE CURLENGTH OF 30126000 T 0061 + BEGIN ; 30127000 T 0061 + CURSY:=IDENTIFIER; 30128000 T 0062 + CURSY:=IF CURNAME1="20000IF" THEN IFSY ELSE 30129000 T 0063 + IF CURNAME1="20000DO" THEN DOSY ELSE 30130000 T 0065 + IF CURNAME1="20000TO" THEN TOSY ELSE 30131000 T 0067 + IF CURNAME1="20000OR" THEN ORSY ELSE 30132000 T 0069 + IF CURNAME1="20000OF" THEN OFSY ELSE 30133000 T 0071 + IF CURNAME1="20000IN" THEN INSY ELSE IDENTIFIER; 30134000 T 0073 + CURSY:=IF CURNAME1="3000END" THEN ENDSY ELSE 30135000 T 0076 + IF CURNAME1="3000FOR" THEN FORSY ELSE 30136000 T 0078 + IF CURNAME1="3000DIV" THEN DIVSY ELSE 30137000 T 0080 + IF CURNAME1="3000MOD" THEN MODSY ELSE 30138000 T 0082 + IF CURNAME1="3000NIL" THEN NILSY ELSE 30139000 T 0084 + IF CURNAME1="3000AND" THEN ANDSY ELSE 30140000 T 0086 + IF CURNAME1="3000NOT" THEN NOTSY ELSE 30141000 T 0088 + IF CURNAME1="3000VAR" THEN VARSY ELSE 30142000 T 0090 + IF CURNAME1="3000SET" THEN SETSY ELSE 30143000 T 0092 + IF CURNAME1="3000LSS" THEN LSSSY ELSE 30144000 T 0094 + IF CURNAME1="3000LEQ" THEN LEQSY ELSE 30145000 T 0096 + IF CURNAME1="3000GEQ" THEN GEQSY ELSE 30146000 T 0098 + IF CURNAME1="3000GTR" THEN GTRSY ELSE 30147000 T 0100 + IF CURNAME1="3000NEQ" THEN NEQSY ELSE 30148000 T 0102 + IF CURNAME1="3000EQL" THEN EQLSY ELSE IDENTIFIER; 30149000 T 0104 + CURSY:=IF CURNAME1="400THEN" THEN THENSY ELSE 30150000 T 0108 + IF CURNAME1="400ELSE" THEN ELSESY ELSE 30151000 T 0110 + IF CURNAME1="400WITH" THEN WITHSY ELSE 30152000 T 0112 + IF CURNAME1="400CASE" THEN CASESY ELSE 30153000 T 0114 + IF CURNAME1="400GOTO" THEN GOTOSY ELSE 30154000 T 0116 + IF CURNAME1="400TYPE" THEN TYPESY ELSE 30155000 T 0118 + IF CURNAME1="400FILE" THEN FILESY ELSE IDENTIFIER; 30156000 T 0120 + CURSY:=IF CURNAME1="50BEGIN" THEN BEGINSY ELSE 30157000 T 0123 + IF CURNAME1="50WHILE" THEN WHILESY ELSE 30158000 T 0125 + IF CURNAME1="50UNTIL" THEN UNTILSY ELSE 30159000 T 0127 + IF CURNAME1="50ARRAY" THEN ARRAYSY ELSE 30160000 T 0129 + IF CURNAME1="50CONST" THEN CONSTSY ELSE 30161000 T 0131 + IF CURNAME1="50LABEL" THEN LABELSY ELSE IDENTIFIER; 30162000 T 0133 + CURSY:=IF CURNAME1="6REPEAT" THEN REPEATSY ELSE 30163000 T 0136 + IF CURNAME1="6DOWNTO" THEN DOWNTOSY ELSE 30164000 T 0138 + IF CURNAME1="6RECORD" THEN RECORDSY ELSE 30165000 T 0140 + IF CURNAME1="6ASSERT" THEN ASSERTSY ELSE %002- 30165500 C 0142 + IF CURNAME1="6PACKED" THEN PACKEDSY ELSE IDENTIFIER; 30166000 T 0144 + CURSY:=IF CURNAME1="7PROGRA" AND CURNAME2="M" THEN PROGRAMSY 30167000 T 0147 + ELSE IDENTIFIER; 30168000 T 0150 + CURSY:=IF CURNAME1="8FUNCTI" AND CURNAME2="ON" THEN FUNCSY 30169000 T 0152 + ELSE IDENTIFIER; 30170000 T 0154 + CURSY:=IF CURNAME1="9PROCED" AND CURNAME2="URE" THEN PROCSY 30171000 T 0156 + ELSE IDENTIFIER; 30172000 T 0158 + CURSY:=IDENTIFIER; % 10 CHARACTERS. 30173000 T 0160 + CURSY:=IDENTIFIER; % 11 CHARACTERS. 30174000 T 0161 + CURSY:=IDENTIFIER; % 12 CHARACTERS. 30175000 T 0163 + END OF CASE; 30176000 T 0164 + START OF SEGMENT ********** 28 + 28 IS 14 LONG, NEXT SEG 27 + IF RESWORDOPTION AND CURSY≠IDENTIFIER THEN 30177000 T 0209 + BEGIN T1 := CARDLENGTH-CHARCNT-CURLENGTH-1; %506- 30178000 P 0210 + RESWORDOPTION := BOOLEAN(3); % SET RESWORDPRESENT BIT 30179000 P 0213 + REPLACE XLINEPNT+T1 BY CARDPNT-(CURLENGTH+1) 30180000 T 0214 + FOR CURLENGTH+REAL(CHARCNT=0); %506- 30181000 P 0218 + END; 30182000 T 0222 + END OF LETTER ELSE 30183000 T 0222 + IF C≤9 THEN 30184000 T 0222 + BEGIN 30185000 T 0223 + CURVAL:=C; CURSY:=INTCONST; 30186000 T 0224 + NEXTCHAR; 30187000 T 0225 + WHILE C≤9 DO BEGIN CURVAL:=10×CURVAL+C; NEXTCHAR END; 30188000 T 0226 + IF C="." THEN 30189000 T 0231 + BEGIN 30190000 T 0232 + NEXTCHAR; 30191000 T 0232 + IF C≤9 THEN 30192000 T 0233 + BEGIN CURSY:=REALCONST; 30193000 T 0234 + DO BEGIN CURVAL:=10×CURVAL+C; 30194000 T 0235 + SCALE:=SCALE-1; NEXTCHAR; 30195000 T 0237 + END UNTIL C>9; 30196000 T 0240 + END ELSE IF C="." THEN C:=64 % SPECIAL MARK FOR ".." 30197000 T 0241 + ELSE ERROR(4); 30198000 T 0243 + END; 30199000 T 0245 + IF C="E" THEN 30200000 T 0245 + BEGIN 30201000 T 0245 + CURSY:=REALCONST; NEXTCHAR; 30202000 T 0246 + IF C="+" OR C="-" THEN BEGIN NEGEXP:=C="-"; NEXTCHAR END; 30203000 T 0248 + IF C≤9 THEN 30204000 T 0252 + BEGIN EXP:=C; NEXTCHAR; 30205000 T 0253 + WHILE C≤9 DO BEGIN EXP:=10×EXP+C; NEXTCHAR END; 30206000 T 0255 + IF NEGEXP THEN EXP:=-EXP; 30207000 T 0260 + END ELSE ERROR(4); 30208000 T 0262 + SCALE:=SCALE+EXP; 30209000 T 0263 + END; 30210000 T 0264 + IF CURSY=REALCONST THEN 30211000 T 0264 + BEGIN 30212000 T 0265 + REALOVERFLOW:=OVERFLOW; 30213000 T 0266 + CURVAL:=CURVAL×10*SCALE; 30214000 T 0267 + REALOVERFLOW:=0; 30215000 T 0271 + END ELSE 30216000 T 0271 + IF CURVAL>MAXINT THEN 30217000 T 0271 + BEGIN 30218000 T 0273 + OVERFLOW: ERROR(14); CURVAL:=0; REALOVERFLOW:=0; 30219000 T 0273 + END; 30220000 T 0276 + END OF DIGIT ELSE 30221000 T 0276 + IF C=QUOTES THEN 30222000 T 0276 + BEGIN 30223000 T 0278 + CURSY:=ALFACONST; CURLENGTH:=0; NEXTCHAR; 30224000 T 0279 + FINIS:=FALSE; 30225000 T 0281 + DO BEGIN 30226000 T 0282 + IF C=QUOTES THEN BEGIN NEXTCHAR; FINIS:=C≠QUOTES END ELSE 30227000 T 0283 + IF CHARCNT=0 THEN BEGIN ERROR(6); FINIS:=TRUE END; 30228000 T 0286 + IF NOT FINIS THEN 30229000 T 0289 + BEGIN 30230000 T 0290 + REPLACE STRINGPNT+CURLENGTH BY CHARPNT FOR 1; 30231000 T 0290 + CURLENGTH:=CURLENGTH+1; 30232000 T 0295 + NEXTCHAR; 30233000 T 0296 + END END UNTIL FINIS; 30234000 T 0297 + IF CURLENGTH=0 THEN ERROR(4) ELSE 30235000 T 0298 + IF CURLENGTH=1 THEN 30236000 T 0300 + BEGIN CURSY:=CHARCONST; 30237000 T 0301 + REPLACE CHARPNT BY STRINGPNT FOR 1; CURVAL:=CH[0]; 30238000 T 0303 + END ELSE 30239000 T 0306 + IF CURLENGTH≤7 THEN 30240000 T 0306 + BEGIN TEXT[0]:=" "; 30241000 T 0308 + REPLACE TEXTPNT BY STRINGPNT FOR CURLENGTH; 30242000 T 0309 + CURVAL:=TEXT[0]; 30243000 T 0312 + END; 30244000 T 0313 + END OF STRINGS ELSE 30245000 T 0313 + BEGIN 30246000 T 0313 + CURSY:=SYMBOL[C]; NEXTCHAR; 30247000 T 0315 + IF CURSY=COLON AND C=EQUAL THEN 30248000 T 0317 + BEGIN CURSY:=ASSIGNSY; NEXTCHAR END ELSE 30249000 T 0318 + IF CURSY=DOT AND C="." THEN 30250000 T 0321 + BEGIN CURSY:=DOUBLEDOT; NEXTCHAR END ELSE 30251000 T 0323 + IF CURSY=LSSSY AND C=EQUAL THEN 30252000 T 0325 + BEGIN CURSY:=LEQSY; NEXTCHAR END ELSE 30253000 T 0327 + IF CURSY=LSSSY AND C=">" THEN 30254000 T 0330 + BEGIN CURSY:=NEQSY; NEXTCHAR END ELSE 30255000 T 0332 + IF CURSY=GTRSY AND C=EQUAL THEN 30256000 T 0334 + BEGIN CURSY:=GEQSY; NEXTCHAR END ELSE 30257000 T 0336 + IF CURSY=LPAR AND C="*" THEN 30258000 T 0339 + BEGIN % *** COMMENT *** 30259000 T 0341 + NEXTCHAR; 30260000 T 0341 + IF C=DOLLAR THEN % DOLLAR INDICATES COMPILER OPTIONS. 30261000 T 0342 + BEGIN DEFINE NEWSEGMENT = HERE #; %700- 30261100 C 0343 + START OF SEGMENT ********** 29 + DO BEGIN 30262000 T 0000 + NEXTCHAR; CX:=C; NEXTCHAR; 30263000 T 0000 + IF CX="L" THEN IF C=1 THEN %516- 30264000 P 0002 + IF LISTOPTION THEN HEADING ELSE %516- 30264500 C 0004 + ELSE LISTOPTION := C="+" ELSE %713- 30265000 P 0006 + IF CX="R" THEN RESWORDOPTION:=C="+" ELSE 30266000 T 0008 + IF CX="C" THEN CHECKOPTION:=C="+" ELSE 30267000 T 0011 + IF CX="D" THEN DUMPOPTION:=C="+" ELSE 30268000 T 0014 + IF CX="X" THEN XREFOPTION:=C="+" ELSE 30269000 T 0017 + IF CX="A" THEN 30270000 T 0020 + IF C="+" THEN WRITE(PASCALGOL,ALIST) 30271000 T 0022 + ELSE WRITE(PASCALGOL,NOALIST) ELSE 30272000 T 0026 + IF CX="T" THEN 30273000 T 0030 + BEGIN LASTCHARPOS := CHARCNT - CARDLENGTH; 30274000 T 0031 + CARDLENGTH:=10×C; 30275000 T 0033 + NEXTCHAR; CARDLENGTH:=CARDLENGTH+C; 30276000 T 0034 + IF CARDLENGTH≤9 OR CARDLENGTH>80 THEN 30277000 T 0036 + BEGIN ERROR(14); CARDLENGTH:=72 END; 30278000 T 0038 + CHARCNT:=MAX(0,LASTCHARPOS+CARDLENGTH-1); 30279000 T 0040 + END% %002- 30280000 P 0044 + % %002- 30280025 C 0044 + % %002- 30280050 C 0044 + % THE FOLLOWING LINES DECODE ANY OCCURRENCE OF THE "S" OPTION AND 30280075 C 0044 + % SETS THE GLOBAL INTEGER VARIABLE "SAVEFACTOR" WHICH CONTROLS THE %002- 30280100 C 0044 + % TYPE OF COMPILATION INITIATED BY THE ZIP. THERE ARE THREE LEGAL FORMS 30280125 C 0044 + % OF THE "S" OPTION AS FOLLOWS.- %002- 30280150 C 0044 + % %002- 30280175 C 0044 + % "S-" WILL GIVE NO ZIP IE. PASCAL SYNTAX CHECK ONLY %002- 30280200 C 0044 + % "S+" WILL GIVE A ZIP FOR COMPILE AND GO %002- 30280225 C 0044 + % "S??" WILL GIVE A ZIP FOR COMPILE TO LIBRARY %002- 30280250 C 0044 + % WHERE ?? IS THE TWO DIGIT DECIMAL SAVE %002- 30280275 C 0044 + % CONSTANT GIVEN THE OBJECT CODE FILE %002- 30280300 C 0044 + % NB. IF THE SAVE CONSTANT IS TO BE %002- 30280325 C 0044 + % LESS THAN 10 THE FIRST DIGIT %002- 30280350 C 0044 + % MUST BE INCLUDED IE. A "0". %002- 30280375 C 0044 + % %002- 30280400 C 0044 + % %002- 30280425 C 0044 + ELSE %002- 30280450 C 0044 + IF CX="S" THEN %002- 30280475 C 0044 + BEGIN %002- 30280500 C 0045 + IF C="-" THEN SAVEFACTOR:=-1 ELSE %002- 30280525 C 0046 + IF C="+" THEN SAVEFACTOR:= 0 ELSE %002- 30280550 C 0048 + IF C LEQ 9 THEN %002- 30280575 C 0051 + BEGIN %002- 30280600 C 0052 + SAVEFACTOR := 10 × C; NEXTCHAR; %002- 30280625 C 0052 + SAVEFACTOR := SAVEFACTOR + C; %002- 30280650 C 0055 + IF C GTR 9 THEN ERROR(100); %002- 30280675 C 0056 + END %002- 30280700 C 0058 + ELSE %002- 30280720 C 0058 + BEGIN %002- 30280735 C 0058 + ERROR(100); %002- 30280750 C 0058 + SAVEFACTOR := 7; %002- 30280765 C 0059 + END; %002- 30280780 C 0060 + END %713- 30280800 C 0060 + ELSE ERROR(102); %713- 30280810 C 0060 + % %002- 30280825 C 0061 + % %002- 30280850 C 0061 + % %002- 30280875 C 0061 + NEXTCHAR; 30281000 T 0061 + END UNTIL C≠","; 30282000 T 0062 + IF LISTOPTION THEN IF PAGECNT=0 THEN HEADING; % ON FIRST PAGE 30282100 C 0063 + END NEWSEGEMENT; %700- 30282200 C 0066 + 29 IS 70 LONG, NEXT SEG 27 + FINIS:=FALSE; 30283000 T 0345 + DO BEGIN 30284000 T 0345 + IF C≠"*" THEN 30285000 T 0346 + SCAN CARDPNT:CARDPNT FOR CHARCNT:CHARCNT UNTIL ="*"; 30286000 T 0346 + IF CHARCNT=0 THEN NEWCARD ELSE 30287000 T 0349 + BEGIN NEXTCHAR; 30288000 T 0351 + WHILE C="*" DO NEXTCHAR; 30289000 T 0352 + FINIS:=C=")"; 30290000 T 0355 + END END UNTIL FINIS; 30291000 T 0357 + NEXTCHAR; 30292000 T 0357 + GO TO START; 30293000 T 0358 + END OF COMMENT; 30294000 T 0359 + END; 30295000 T 0359 + END OF INSYMBOL; 30296000 T 0359 + 27 IS 367 LONG, NEXT SEG 2 + + + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 40001000 T 0082 + % % 40002000 T 0082 + % % 40003000 T 0082 + % % 40004000 T 0082 + % PART 4: EXPRESSION PARSER. % 40005000 T 0082 + % ------------------ % 40006000 T 0082 + % % 40007000 T 0082 + % % 40008000 T 0082 + % % 40009000 T 0082 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 40010000 T 0082 + 40011000 T 0082 + 40012000 T 0082 + PROCEDURE EXPRESSION; FORWARD; 40013000 T 0082 + PROCEDURE CONCAT; FORWARD; 40014000 T 0082 + 40015000 T 0082 + INTEGER EXPRLEVEL, EXPINVARCNT; % %800- 40018000 P 0082 + 40019000 T 0082 + DEFINE PUTTEXT(T)= 40020000 T 0082 + BEGIN 40021000 T 0082 + IF NUMSYMS=MAXSYMS THEN 40022000 T 0082 + BEGIN ERROR(63); % %600- 40023000 P 0082 + NUMSYMS:=1; 40024000 T 0082 + END ELSE NUMSYMS:=NUMSYMS+1; 40025000 T 0082 + SYMTAB[NUMSYMS]:=T; 40026000 T 0082 + END OF PUTTEXT #; 40027000 T 0082 + 40028000 T 0082 + DEFINE PUTSYM(S) = PUTTEXT( (S)&1[41:5:6] ) #; %700- 40029000 P 0082 + 40034000 T 0082 + DEFINE PUTCONST(VAL)= 40035000 T 0082 + BEGIN 40036000 T 0082 + PUTTEXT("2000000"); 40037000 T 0082 + PUTTEXT(VAL); 40038000 T 0082 + END OF PUTCONST #; 40039000 T 0082 + 40040000 T 0082 + DEFINE PUTDUMMY = PUTTEXT("3000000") #; %700- 40041000 P 0082 + 40045000 T 0082 + DEFINE PUTID(L,NUM,NUMDIG)= 40046000 T 0082 + BEGIN 40047000 T 0082 + TEXT[0]:=" " & L [35:5:6]; 40048000 T 0082 + REPLACE TEXTPNT+2 BY NUM FOR NUMDIG DIGITS; 40049000 T 0082 + PUTTEXT(TEXT[0]); 40050000 T 0082 + END OF PUTID#; 40051000 T 0082 + 40052000 T 0082 + % %601- 40052050 C 0082 + % %601- 40052055 C 0082 + PROCEDURE SPLIT(SPLITINX,WIDTH); % %601- 40052100 C 0082 + VALUE SPLITINX, WIDTH; % %601- 40052150 C 0082 + INTEGER SPLITINX, WIDTH ; % %601- 40052200 C 0082 + BEGIN % %601- 40052250 C 0082 + INTEGER I; % %601- 40052300 C 0082 + START OF SEGMENT ********** 30 + % %601- 40052350 C 0000 + IF NUMSYMS+WIDTH LEQ MAXSYMS THEN % %601- 40052400 C 0000 + BEGIN % %601- 40052450 C 0001 + FOR I:=NUMSYMS STEP -1 UNTIL SPLITINX DO % %601- 40052500 C 0001 + SYMTAB[I+WIDTH] := SYMTAB[I]; % %601- 40052550 C 0003 + FOR I:=1 STEP 1 UNTIL WIDTH DO % %601- 40052600 C 0007 + SYMTAB[SPLITINX+I-1] := "3000000"; % %601- 40052650 C 0008 + NUMSYMS := NUMSYMS + WIDTH; % %601- 40052700 C 0012 + END % %601- 40052750 C 0013 + ELSE %601- 40052800 C 0013 + BEGIN % %601- 40052830 C 0013 + ERROR(63); % %601- 40052860 C 0016 + NUMSYMS := 1; % %601- 40052890 C 0016 + END; % %601- 40052900 C 0017 + END OF SPLIT; % %601- 40052950 C 0017 + 30 IS 20 LONG, NEXT SEG 2 + % %601- 40052960 C 0082 + % %601- 40052965 C 0082 + PROCEDURE WRITEEXPR; %*** WRITE GENERATED ALGOL EXPRESSION %700- 40053000 P 0082 + BEGIN 40054000 T 0082 + REAL SX; INTEGER T1, TX; %700- 40054100 C 0082 + START OF SEGMENT ********** 31 + FOR T1:=1 STEP 1 UNTIL NUMSYMS DO 40055000 T 0000 + BEGIN 40056000 T 0001 + SX:=SYMTAB[T1]; TX:=SX.[41:6]; 40057000 T 0001 + IF TX=0 THEN GEN(SX,7,2) ELSE 40058000 T 0003 + IF TX=3 THEN ELSE 40059000 T 0006 + IF TX=1 THEN GEN(SX,1,7) ELSE 40060000 T 0007 + BEGIN 40061000 T 0011 + T1:=T1+1; SX:=SYMTAB[T1]; 40062000 T 0011 + IF SX.[44:6]=0 THEN GENINT(SX) ELSE GENREAL(SX); 40063000 T 0013 + END END; 40064000 T 0017 + NUMSYMS:=0; 40065000 T 0019 + END OF WRITEEXPR; %700- 40066000 P 0020 + 31 IS 24 LONG, NEXT SEG 2 + 40067000 T 0082 + 40068000 T 0082 + PROCEDURE CHECKEXPR( LLIM, ULIM ); %*** WRITE CODE TO CHECK VALUE 40069000 P 0082 + VALUE LLIM, ULIM; INTEGER LLIM, ULIM; %700- 40069100 C 0082 + BEGIN DEFINE CHECK = VALUE #; %700- 40070000 P 0082 + START OF SEGMENT ********** 32 + PUTTEXT("CHECK("); 40071000 T 0000 + EXPRESSION; 40072000 T 0005 + PUTSYM(","); PUTCONST(LLIM); 40073000 T 0006 + PUTSYM(","); PUTCONST(ULIM); 40074000 T 0027 + PUTSYM(","); PUTCONST(CARDCNT); 40075000 T 0047 + PUTSYM(")"); 40076000 T 0067 + END OF CHECKEXPR; %700- 40077000 P 0074 + 32 IS 75 LONG, NEXT SEG 2 + 40078000 T 0082 + 40079000 T 0082 + BOOLEAN SIMPLEVARIABLE,INSIDEBRACKETS,INSIDEPARENS; %518- 40080100 C 0082 + INTEGER NUMPOINTERS; 40081000 T 0082 + 40082000 T 0082 + PROCEDURE VARIABLE; 40083000 T 0082 + BEGIN 40084000 T 0082 + INTEGER STARTSYM,LLIM,ULIM; 40085000 T 0082 + START OF SEGMENT ********** 33 + REAL T; 40086000 T 0000 + INTEGER T1, T5; % USED ONCE EACH %700- 40086100 C 0000 + BOOLEAN INBRACKET,INRECORD,SIMPLEVAR; %002- 40087000 P 0000 + LABEL ADDADDR; 40088000 T 0000 + 40089000 T 0000 + STARTSYM:=NUMSYMS+1; 40090000 T 0000 + IF THISLEVEL>CURLEVEL THEN % VARIABLE IN FIELD LIST OF 40091000 T 0001 + BEGIN % RECORD USED IN WITH-STATEMENT. 40092000 T 0002 + T:=DISPLAY[THISLEVEL]; 40093000 T 0002 + T1:=T.FIRSTWITHSYM; T5:=T.LASTWITHSYM; %700- 40094000 P 0003 + FOR T1:=T1 STEP 1 UNTIL T5 DO PUTTEXT(WITHTAB[T1]); %700- 40095000 P 0006 + INRECORD:=TRUE; 40096000 T 0015 + INBRACKET:=BOOLEAN(T.BRACKETSINWITH); 40097000 T 0016 + NUMPOINTERS:=NUMPOINTERS+T.NUMPNTRSINWITH; 40098000 T 0017 + SIMPLEVAR := FALSE; %002- 40099000 P 0019 + CURTYPE:=T.RECTYPE; T:=TYPETAB1[CURTYPE]; 40100000 T 0019 + GO TO ADDADDR; 40101000 T 0022 + END; 40102000 T 0022 + CURTYPE := THISID.TYPE; SIMPLEVAR := TRUE; %002- 40104000 P 0022 + PUTID("V",1000×THISLEVEL+THISINDEX,5); %518- 40105500 C 0024 + INSYMBOL; 40106000 T 0040 + IF CURSY=LBRACKET OR CURSY=DOT OR CURSY=ARROW THEN 40107000 T 0041 + BEGIN 40108000 T 0044 + SIMPLEVAR := FALSE; %002- 40109000 P 0044 + DO BEGIN 40110000 T 0045 + IF CURSY=LBRACKET THEN 40111000 T 0046 + BEGIN 40112000 T 0046 + IF NOT(INBRACKET OR INRECORD) THEN 40113000 T 0047 + BEGIN PUTSYM("["); INBRACKET:=TRUE END; 40114000 T 0048 + DO BEGIN 40115000 T 0056 + T:=TYPETAB1[CURTYPE]; 40116000 T 0057 + LLIM:=TYPETAB2[CURTYPE]; ULIM:=TYPETAB3[CURTYPE]; 40117000 T 0058 + IF T.FORM≠ARRAYS THEN ERROR(12); 40118000 T 0060 + IF INRECORD THEN PUTTEXT(" +("); 40119000 T 0062 + INSYMBOL; 40120000 T 0069 + EXPINVARCNT:=EXPINVARCNT+1;% %002- 40120500 C 0069 + EXPRLEVEL := EXPRLEVEL+1; % DO NOT "WRITEEXPR" YET %507- 40120900 C 0070 + IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 40121000 T 0072 + EXPRLEVEL := EXPRLEVEL-1; %507- 40121100 C 0076 + SIMPLEVARIABLE := FALSE; % RECURSION ON "VARIABLE" %507- 40121200 C 0077 + EXPINVARCNT:=EXPINVARCNT-1;% %002- 40121500 C 0078 + CHECKTYPES(T.INXTYPE,CURTYPE); 40122000 T 0079 + CURTYPE:=T.ARRTYPE; 40123000 T 0081 + IF INRECORD THEN 40124000 T 0082 + BEGIN 40125000 T 0082 + IF LLIM<0 THEN BEGIN PUTSYM("+"); PUTCONST(-LLIM) END ELSE 40126000 T 0083 + IF LLIM>0 THEN BEGIN PUTSYM("-"); PUTCONST( LLIM) END; 40127000 T 0104 + PUTSYM(")"); 40128000 T 0126 + IF TYPETAB1[CURTYPE].SIZE>1 THEN 40129000 T 0133 + BEGIN PUTSYM("×"); PUTCONST(TYPETAB1[CURTYPE].SIZE) END; 40130000 T 0134 + END ELSE IF TYPETAB1[CURTYPE].STRUCT>0 THEN PUTSYM(","); 40131000 T 0155 + END UNTIL CURSY≠COMMA; 40132000 T 0164 + IF CURSY≠RBRACKET THEN 40133000 T 0165 + BEGIN ERROR(59); SKIP(RBRACKET); 40134000 T 0166 + IF CURSY=RBRACKET THEN INSYMBOL; 40135000 T 0168 + END ELSE INSYMBOL; 40136000 T 0170 + END OF BRACKETS ELSE 40137000 T 0171 + IF CURSY=DOT THEN 40138000 T 0171 + BEGIN 40139000 T 0172 + IF NOT(INBRACKET OR INRECORD) THEN 40140000 T 0173 + BEGIN PUTSYM("["); INBRACKET:=TRUE END; 40141000 T 0174 + T:=TYPETAB1[CURTYPE]; 40142000 T 0182 + IF T.FORM≠RECORD THEN ERROR(12); 40143000 T 0183 + INSYMBOL; 40144000 T 0185 + IF CURSY=IDENTIFIER THEN 40145000 T 0186 + BEGIN 40146000 T 0186 + SEARCHTAB(T.RECTAB); 40147000 T 0187 + IF FOUND THEN 40148000 T 0188 + BEGIN 40149000 T 0188 + THISID:=NAMETAB3[T.RECTAB,THISINDEX]; 40150000 T 0189 + ADDADDR: PUTSYM("+"); 40151000 T 0191 + PUTCONST(THISID.INFO); CURTYPE:=THISID.TYPE; 40152000 T 0198 + END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40153000 T 0213 + END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40154000 T 0215 + INRECORD:=TRUE; 40155000 T 0217 + INSYMBOL; 40156000 T 0218 + END OF DOT ELSE 40157000 T 0218 + BEGIN % CURSY=ARROW 40158000 T 0218 + T:=TYPETAB1[CURTYPE]; 40159000 T 0219 + IF T.FORM=FILES THEN 40160000 T 0220 + BEGIN 40161000 T 0221 + CURTYPE:=T.FILETYPE; 40162000 T 0221 + IF TYPETAB1[CURTYPE].STRUCT=0 THEN PUTTEXT(" [0]"); 40163000 T 0223 + END ELSE 40164000 T 0230 + IF T.FORM=TEXTFILE THEN 40165000 T 0230 + BEGIN 40166000 T 0234 + SYMTAB[NUMSYMS]:=SYMTAB[NUMSYMS] & "I" [35:5:6]; 40167000 T 0234 + PUTSYM("."); PUTTEXT("LASTCH"); 40168000 T 0237 + CURTYPE:=CHARTYPE; 40169000 T 0249 + END ELSE 40170000 T 0250 + IF T.FORM=POINTERS THEN 40171000 T 0250 + BEGIN 40172000 T 0253 + IF INBRACKET THEN PUTSYM("]"); 40173000 T 0253 + INBRACKET:=FALSE; 40174000 T 0261 + IF NUMSYMS+6 ≤ MAXSYMS THEN %513- 40175000 P 0262 + BEGIN 40176000 T 0263 + FOR T1:=NUMSYMS STEP -1 UNTIL STARTSYM DO 40177000 T 0263 + SYMTAB[T1+2]:=SYMTAB[T1]; 40178000 T 0265 + SYMTAB[STARTSYM]:=" MEM["; 40179000 T 0269 + SYMTAB[STARTSYM+1]:=" (T:="; 40180000 T 0270 + NUMSYMS := NUMSYMS+2; %513- 40180400 C 0272 + IF NUMPOINTERS > 0 % POINTER VIA POINTER %513- 40180500 C 0273 + THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY %513- 40180600 C 0273 + "00-1)DIV00 1022,00 T MOD00 1022]"; %513- 40180700 C 0278 + NUMSYMS := NUMSYMS+4; %513- 40180800 C 0282 + END %513- 40180900 C 0283 + ELSE NUMPOINTERS := 1; %513- 40181000 P 0283 + INRECORD:=TRUE; 40182000 T 0286 + END ELSE ERROR(63); 40183000 T 0287 + CURTYPE:=T.POINTTYPE; 40184000 T 0288 + END ELSE BEGIN ERROR(12); CURTYPE:=0 END; 40185000 T 0290 + INSYMBOL; 40186000 T 0292 + END OF ARROW; 40187000 T 0292 + END UNTIL CURSY≠LBRACKET AND CURSY≠DOT AND CURSY≠ARROW; 40188000 T 0292 + END; % %601- 40188005 C 0295 + IF TYPETAB1[CURTYPE].FORM=SET THEN % *** SET VARIABLES %601- 40188010 C 0295 + BEGIN % --- --- --------- %601- 40188025 C 0297 + INTEGER THISSYML, I; % %601- 40188050 C 0297 + START OF SEGMENT ********** 34 + % %601- 40188075 C 0000 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SLOAD("; % %601- 40188100 C 0000 + IF SIMPLEVAR THEN % %601- 40188125 C 0002 + BEGIN % %601- 40188150 C 0002 + PUTSYM(","); % %601- 40188175 C 0003 + PUTID("W",1000×THISLEVEL+THISINDEX,5); % %601- 40188200 C 0011 + END % %601- 40188225 C 0027 + ELSE % %601- 40188250 C 0027 + IF INBRACKET AND NOT INRECORD THEN % %601- 40188275 C 0027 + BEGIN % %601- 40188300 C 0029 + PUTSYM(","); THISSYML := NUMSYMS; % %601- 40188325 C 0029 + PUTCONST(0); PUTSYM(" "); PUTSYM(","); % %601- 40188350 C 0037 + FOR I:=STARTSYM+1 STEP 1 UNTIL THISSYML DO % %601- 40188375 C 0064 + PUTTEXT(SYMTAB[I]); %601- 40188400 C 0068 + PUTTEXT(" 1] "); % %601- 40188425 C 0074 + END % %601- 40188450 C 0080 + ELSE % %601- 40188475 C 0080 + BEGIN % %601- 40188500 C 0080 + THISSYML := NUMSYMS; % %601- 40188525 C 0082 + IF INBRACKET THEN PUTSYM("]"); % %601- 40188550 C 0082 + FOR I:=1 STEP 1 UNTIL NUMPOINTERS DO % %601- 40188575 C 0090 + BEGIN % %601- 40188600 C 0091 + PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); % %601- 40188625 C 0091 + PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); % %601- 40188650 C 0103 + END; % %601- 40188675 C 0117 + PUTSYM(","); % %601- 40188700 C 0119 + FOR I:=STARTSYM+1 STEP 1 UNTIL THISSYML DO % %601- 40188725 C 0127 + PUTTEXT(SYMTAB[I]); % %601- 40188775 C 0131 + PUTTEXT(" +1 "); % %601- 40188800 C 0138 + IF INBRACKET THEN PUTSYM("]"); % %601- 40188825 C 0144 + FOR I:=1 STEP 1 UNTIL NUMPOINTERS DO % %601- 40188850 C 0152 + BEGIN % %601- 40188875 C 0154 + PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); % %601- 40188900 C 0154 + PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); % %601- 40188915 C 0166 + END; % %601- 40188930 C 0180 + NUMPOINTERS := 0; % %601- 40188945 C 0182 + END; %601- 40188960 C 0183 + PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); % %601- 40188975 C 0183 + END OF SET VARIABLES; % %601- 40188990 C 0211 + 34 IS 212 LONG, NEXT SEG 33 + IF TYPETAB1[CURTYPE].STRUCT=0 THEN 40189000 T 0299 + BEGIN 40190000 T 0300 + IF INBRACKET THEN PUTSYM("]"); 40191000 T 0301 + % INBRACKET := FALSE; %513- 40191100 C 0308 + WHILE NUMPOINTERS>0 DO 40192000 T 0308 + BEGIN NUMPOINTERS := NUMPOINTERS-1; %513- 40193000 P 0310 + IF NUMSYMS+4 ≤ MAXSYMS %513- 40194000 P 0311 + THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY %513- 40194100 C 0312 + "00-1)DIV00 1022,00 T MOD00 1022]"; %513- 40194200 C 0317 + NUMSYMS := NUMSYMS+4; %513- 40194300 C 0320 + END %513- 40194400 C 0321 + ELSE ERROR(63); % EXPRESSION IS TOO LONG FOR SYMTAB[*] 40195000 P 0321 + END; 40196000 T 0323 + END; 40197000 T 0323 + IF INSIDEPARENS AND SIMPLEVAR AND TYPETAB1[CURTYPE].STRUCT > 0 AND 40198500 C 0323 + TYPETAB1[CURTYPE].FORM < FILES THEN SYMTAB[STARTSYM].[35:6] := 40198600 C 0326 + "H"; %615- 40198700 C 0329 + INSIDEBRACKETS:=INBRACKET; 40199000 T 0330 + SIMPLEVARIABLE := SIMPLEVAR; %002- 40199500 C 0331 + CURMODE:=NUMBER; 40200000 T 0332 + END OF VARIABLE; 40201000 T 0333 + 33 IS 339 LONG, NEXT SEG 2 + 40202000 T 0082 + 40203000 T 0082 + PROCEDURE PASSPARAMS; 40204000 T 0082 + BEGIN 40205000 T 0082 + INTEGER NPARS,PARAM,PTYPE,P,FIRSTSYM; 40206000 T 0082 + START OF SEGMENT ********** 35 + BOOLEAN FORMALPROC,CHECK; 40207000 T 0000 + LABEL EXIT; 40208000 T 0000 + 40209000 T 0000 + PUTID("V",1000×THISLEVEL+THISINDEX,5); 40210000 T 0000 + P:=THISID.INFO; 40211000 T 0015 + FORMALPROC:=BOOLEAN(THISID.FORMAL); 40212000 T 0017 + NPARS:=PARAMTAB[P]; P:=P+1; 40213000 T 0018 + IF FORMALPROC THEN NPARS:=9999; 40214000 T 0020 + INSYMBOL; 40215000 T 0022 + IF CURSY=LPAR THEN 40216000 T 0022 + BEGIN 40217000 T 0023 + PUTSYM("("); 40218000 T 0023 + DO BEGIN 40219000 T 0031 + INSYMBOL; 40220000 T 0032 + IF NPARS=0 THEN BEGIN ERROR(3); SKIP(RPAR); GO TO EXIT END; 40221000 T 0032 + PARAM:=PARAMTAB[P]; P:=P+1; 40222000 T 0035 + PTYPE:=PARAM.PARAMTYPE; 40223000 T 0038 + IF PARAM.PARAMKIND=CONST THEN 40224000 T 0039 + BEGIN 40225000 T 0040 + CHECK:=CHECKOPTION AND TYPETAB1[PTYPE].FORM LEQ CHAR; 40226000 T 0041 + IF CHECK THEN PUTTEXT("CHECK("); 40227000 T 0043 + PUTDUMMY; FIRSTSYM:=NUMSYMS; 40228000 T 0050 + EXPRLEVEL:=EXPRLEVEL+1; 40229000 T 0058 + EXPRESSION; EXPRLEVEL:=EXPRLEVEL-1; 40230000 T 0059 + IF CURMODE=BITPATTERN THEN 40231000 T 0061 + BEGIN SYMTAB[FIRSTSYM]:=" REAL("; PUTSYM(")"); END; 40232000 T 0062 + IF CHECK THEN 40233000 T 0072 + BEGIN 40234000 T 0072 + PUTSYM(","); PUTCONST(TYPETAB2[PTYPE]); 40235000 T 0073 + PUTSYM(","); PUTCONST(TYPETAB3[PTYPE]); 40236000 T 0092 + PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); 40237000 T 0112 + END; 40238000 T 0139 + END ELSE 40239000 T 0139 + IF PARAM.PARAMKIND=VAR THEN 40240000 T 0139 + BEGIN 40241000 T 0141 + IF CURSY=IDENTIFIER THEN 40242000 T 0141 + BEGIN 40243000 T 0142 + SEARCH; 40244000 T 0142 + IF FOUND THEN 40245000 T 0143 + BEGIN 40246000 T 0143 + IF THISID.IDCLASS=VAR OR 40247000 T 0144 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 40248000 T 0145 + BEGIN 40249000 T 0147 + IF PARAM.PARAMFILE=1 THEN 40250000 T 0148 + BEGIN 40251000 T 0149 + CURTYPE:=THISID.TYPE; 40252000 T 0150 + PUTID("V",1000×THISLEVEL+THISINDEX,5); PUTSYM(","); 40253000 T 0151 + PUTID("F",1000×THISLEVEL+THISINDEX,5); PUTSYM(","); 40254000 T 0174 + PUTID("I",1000×THISLEVEL+THISINDEX,5); 40255000 T 0197 + INSYMBOL; 40256000 T 0213 + END ELSE 40257000 T 0214 + BEGIN 40258000 T 0214 + INSIDEPARENS := TRUE; %518- 40258100 C 0214 + VARIABLE; 40259000 T 0215 + INSIDEPARENS := FALSE; %518- 40259100 C 0216 + IF TYPETAB1[CURTYPE].STRUCT>0 THEN 40260000 T 0216 + IF NOT SIMPLEVARIABLE THEN ERROR(92); 40261000 T 0218 + END; 40262000 T 0220 + END ELSE BEGIN ERROR(8); CURTYPE:=0 END; 40263000 T 0220 + END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40264000 T 0222 + END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40265000 T 0224 + END ELSE 40266000 T 0226 + BEGIN 40267000 T 0226 + IF CURSY=IDENTIFIER THEN 40268000 T 0227 + BEGIN 40269000 T 0227 + SEARCH; 40270000 T 0228 + IF FOUND THEN 40271000 T 0228 + BEGIN 40272000 T 0229 + IF THISID.IDCLASS≠PARAM.PARAMKIND THEN ERROR(91); 40273000 T 0229 + PUTID("V",1000×THISLEVEL+THISINDEX,5); 40274000 T 0232 + IF TYPETAB1[THISID.TYPE].FORM=SET THEN %601- 40274200 C 0248 + BEGIN % %601- 40274220 C 0250 + GEN(",",1,7); % %601- 40274240 C 0251 + GENID("W",1000×THISLEVEL+THISINDEX,5); % %601- 40274260 C 0252 + END; % %601- 40274280 C 0255 + CURTYPE:=IF THISID.IDCLASS=FUNC THEN THISID.TYPE ELSE 0; 40275000 T 0255 + INSYMBOL; 40276000 T 0259 + END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40277000 T 0259 + END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40278000 T 0261 + END; 40279000 T 0263 + CHECKTYPES(PTYPE,CURTYPE); 40280000 T 0263 + NPARS:=NPARS-1; 40281000 T 0264 + IF CURSY=COMMA THEN PUTSYM(","); 40282000 T 0265 + END UNTIL CURSY≠COMMA; 40283000 T 0273 + IF CURSY≠RPAR THEN BEGIN ERROR(89); SKIP(RPAR) END; 40284000 T 0275 + EXIT: PUTSYM(")"); 40285000 T 0277 + IF CURSY=RPAR THEN INSYMBOL; 40286000 T 0284 + END; 40287000 T 0286 + IF NPARS>0 AND NOT FORMALPROC THEN ERROR(3); 40288000 T 0286 + CURMODE:=NUMBER; 40289000 T 0289 + END OF PASSPARAMS; 40290000 T 0290 + 35 IS 297 LONG, NEXT SEG 2 + 40291000 T 0082 + 40292000 T 0082 + PROCEDURE FACTOR; %*** FACTOR *** 40293000 T 0082 + BEGIN %************** 40294000 T 0082 + INTEGER STARTSYM,STYPE,T; 40295000 T 0082 + START OF SEGMENT ********** 36 + BOOLEAN FIRST, SPLITTED; % %601- 40296000 P 0000 + REAL VAL; 40297000 T 0000 + DEFINE T1 = T #; % USED AT 40558000 %700- 40298000 P 0000 + 40310000 T 0000 + CURMODE:=NUMBER; 40311000 T 0000 + IF CURSY=IDENTIFIER THEN 40312000 T 0000 + BEGIN 40313000 T 0001 + SEARCH; 40314000 T 0002 + IF FOUND THEN 40315000 T 0002 + BEGIN 40316000 T 0002 + IF THISID.IDCLASS=VAR OR 40317000 T 0003 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) 40318000 T 0004 + THEN VARIABLE ELSE 40319000 T 0005 + IF THISID.IDCLASS=CONST THEN 40320000 T 0008 + BEGIN 40321000 T 0009 + IF THISID.INFO≤1023 THEN PUTCONST(THISID.INFO) 40322000 T 0010 + ELSE PUTCONST(CONSTTAB[THISID.INFO-1023]); 40323000 T 0011 + CURTYPE:=THISID.TYPE; CURMODE:=NUMBER; 40324000 T 0039 + INSYMBOL; 40325000 T 0041 + END ELSE 40326000 T 0042 + IF THISID.IDCLASS=FUNC THEN 40327000 T 0042 + BEGIN 40328000 T 0044 + IF THISTAB=0 THEN %*** INTRINSIC FUNCTION *** 40329000 T 0044 + BEGIN 40330000 T 0045 + %700- 40331000 C 0045 + PROCEDURE PARAMETER; %*** CHECK THAT THE FUNCTION HAS 1 PARAM. 40332000 C 0045 + START OF SEGMENT ********** 37 + BEGIN %700- 40333000 C 0000 + INSYMBOL; %700- 40334000 C 0000 + IF CURSY=LPAR %700- 40335000 C 0000 + THEN BEGIN %700- 40336000 C 0000 + PUTSYM("("); INSYMBOL; EXPRESSION; %700- 40337000 C 0001 + IF TYPETAB1[CURTYPE].FORM=NUMERIC THEN CURTYPE:=INTTYPE; 40338000 C 0009 + IF CURSY≠RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; %700- 40339000 C 0012 + PUTSYM(")"); IF CURSY=RPAR THEN INSYMBOL; %700- 40340000 C 0015 + END ELSE ERROR(3); % OR ERROR(58) %700- 40341000 C 0023 + END OF PARAMETER; %700- 40342000 C 0024 + %700- 40350000 P 0025 + IF CURNAME1="3000ABS" THEN % "ABS" 40351000 T 0025 + BEGIN 40352000 T 0025 + PUTTEXT(" ABS"); PARAMETER; 40353000 T 0026 + IF CURTYPE≠REALTYPE AND CURTYPE≠INTTYPE THEN ERROR(67); 40354000 T 0034 + END ELSE 40355000 T 0037 + IF CURNAME1="3000CHR" THEN % "CHR" 40356000 T 0037 + BEGIN 40357000 T 0039 + INSYMBOL; 40358000 T 0040 + IF CURSY=LPAR THEN 40359000 T 0040 + BEGIN INSYMBOL; CHECKEXPR(0,63); 40360000 T 0041 + IF TYPETAB1[CURTYPE].FORM≠NUMERIC THEN ERROR(67); 40361000 T 0043 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40362000 T 0046 + IF CURSY=RPAR THEN INSYMBOL; 40363000 T 0049 + END ELSE ERROR(58); 40364000 T 0050 + CURTYPE:=CHARTYPE; 40365000 T 0053 + END ELSE 40366000 T 0054 + IF CURNAME1="3000EOF" OR % "EOF"/"EOLN" 40367000 T 0054 + CURNAME1="400EOLN" THEN 40368000 T 0055 + BEGIN 40369000 T 0056 + FIRST:=CURNAME1="3000EOF"; 40370000 T 0057 + FILEPARAM(INPUTFILE); 40371000 T 0058 + PUTID("I",FILENAME,5); 40372000 T 0059 + PUTTEXT(IF FIRST THEN " .EOF" ELSE " .EOLN"); 40373000 T 0076 + IF LPARFOUND THEN 40374000 T 0084 + BEGIN 40375000 T 0084 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40376000 T 0084 + IF CURSY=RPAR THEN INSYMBOL; 40377000 T 0087 + END; 40378000 T 0089 + CURTYPE:=BOOLTYPE; 40379000 T 0089 + END ELSE 40380000 T 0090 + IF CURNAME1="3000ODD" THEN % "ODD" 40381000 T 0090 + BEGIN 40382000 T 0093 + PUTTEXT(" ODD"); PARAMETER; 40383000 T 0094 + IF CURTYPE≠INTTYPE THEN ERROR(67); 40384000 T 0102 + CURTYPE:=BOOLTYPE; CURMODE:=BITPATTERN; 40385000 T 0104 + END ELSE 40386000 T 0106 + IF CURNAME1="3000ORD" THEN % "ORD" 40387000 T 0106 + BEGIN 40388000 T 0108 + PUTSYM("("); INSYMBOL; 40389000 T 0109 + IF CURSY=LPAR THEN 40390000 T 0118 + BEGIN 40391000 T 0118 + INSYMBOL; EXPRESSION; 40392000 T 0119 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(67); 40393000 T 0120 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40394000 T 0123 + INSYMBOL; 40395000 T 0125 + END ELSE ERROR(58); 40396000 T 0126 + CURTYPE:=INTTYPE; PUTSYM(")"); 40397000 T 0127 + END ELSE 40398000 T 0135 + IF CURNAME1="400PRED" OR % "PRED"/"SUCC" 40399000 T 0135 + CURNAME1="400SUCC" THEN 40400000 T 0136 + BEGIN 40401000 T 0137 + FIRST:=CURNAME1="400PRED"; 40402000 T 0137 + PUTTEXT("CHECK("); INSYMBOL; 40403000 T 0139 + IF CURSY=LPAR THEN 40404000 T 0148 + BEGIN 40405000 T 0148 + INSYMBOL; EXPRESSION; 40406000 T 0149 + PUTSYM(IF FIRST THEN "-" ELSE "+"); PUTSYM("1"); 40407000 T 0150 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(67); 40408000 T 0166 + PUTSYM(","); PUTCONST(TYPETAB2[CURTYPE]); 40409000 T 0169 + PUTSYM(","); PUTCONST(TYPETAB3[CURTYPE]); 40410000 T 0189 + PUTSYM(","); PUTCONST(CARDCNT); 40411000 T 0209 + PUTSYM(")"); 40412000 T 0229 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40413000 T 0236 + IF CURSY=RPAR THEN INSYMBOL; 40414000 T 0239 + END ELSE BEGIN ERROR(58); CURTYPE:=0 END; 40415000 T 0240 + END ELSE 40416000 T 0242 + IF CURNAME1="50ROUND" THEN % "ROUND" 40417000 T 0242 + BEGIN 40418000 T 0244 + PUTTEXT(" ROUND"); PARAMETER; 40419000 T 0244 + IF CURTYPE≠REALTYPE THEN ERROR(67); 40420000 T 0252 + NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40421000 T 0254 + PUTCONST(CARDCNT); PUTSYM(")"); 40422000 T 0263 + CURTYPE:=INTTYPE; 40423000 T 0283 + END ELSE 40424000 T 0284 + IF CURNAME1="3000SQR" THEN % "SQR" 40425000 T 0284 + BEGIN 40426000 T 0285 + PUTTEXT(" SQR"); PARAMETER; 40427000 T 0285 + NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40428000 T 0293 + PUTCONST(CARDCNT); PUTSYM(")"); 40429000 T 0302 + IF CURTYPE≠REALTYPE AND CURTYPE≠INTTYPE THEN ERROR(67); 40430000 T 0322 + END ELSE 40431000 T 0325 + IF CURNAME1="50TRUNC" THEN % "TRUNC" 40432000 T 0325 + BEGIN 40433000 T 0326 + PUTTEXT(" TRUNC"); PARAMETER; 40434000 T 0327 + NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40435000 T 0335 + PUTCONST(CARDCNT); PUTSYM(")"); 40436000 T 0344 + IF CURTYPE≠REALTYPE THEN ERROR(67); 40437000 T 0364 + CURTYPE:=INTTYPE; 40438000 T 0366 + END ELSE 40439000 T 0367 + IF CURNAME1="6CONCAT" THEN % "CONCAT" 40440000 T 0367 + CONCAT ELSE 40441000 T 0368 + IF CURNAME1="400TIME" THEN % "TIME" 40442000 T 0369 + BEGIN 40443000 T 0371 + PUTTEXT("(TIME("); PUTTEXT("1)/60)"); 40444000 T 0372 + CURTYPE:=REALTYPE; INSYMBOL 40445000 T 0386 + END ELSE 40446000 T 0387 + IF CURNAME1="400DATE" THEN % "DATE" 40447000 T 0387 + BEGIN 40448000 T 0390 + PUTTEXT("CURDAT"); 40449000 T 0391 + CURTYPE:=ALFATYPE; INSYMBOL; 40450000 T 0398 + END ELSE 40451000 T 0399 + IF CURNAME1="7CPUTIM" AND CURNAME2="E" THEN % "CPUTIME" 40452000 P 0399 + BEGIN 40453000 T 0403 + PUTTEXT("(TIME("); PUTTEXT("2)/60)"); 40454000 T 0404 + CURTYPE:=REALTYPE; INSYMBOL; 40455000 T 0418 + END ELSE 40456000 T 0419 + IF CURNAME1="6IOTIME" THEN % "IOTIME" 40457000 T 0419 + BEGIN 40458000 T 0422 + PUTTEXT("(TIME("); PUTTEXT("3)/60)"); 40459000 T 0423 + CURTYPE:=REALTYPE; INSYMBOL; 40460000 T 0437 + END ELSE 40461000 T 0438 + IF CURNAME1="7WEEKDA" AND CURNAME2="Y" THEN % "WEEKDAY" 40462000 T 0438 + BEGIN 40463000 T 0442 + PUTTEXT("WEEKDA"); 40464000 T 0443 + CURTYPE:=ALFATYPE; INSYMBOL; 40465000 T 0450 + END ELSE IF CURNAME1="400USER" THEN % "USER" 40466000 T 0451 + BEGIN 40467000 T 0454 + PUTTEXT(" TIME"); PUTTEXT(" (-1)"); 40468000 T 0455 + CURTYPE:=ALFATYPE; INSYMBOL; 40469000 T 0469 + END ELSE % "SIN","COS" ETC. 40470000 T 0470 + BEGIN 40471000 T 0470 + PUTTEXT(IF CURNAME1="3000SIN" THEN " SIN" ELSE 40472000 T 0473 + IF CURNAME1="3000COS" THEN " COS" ELSE 40473000 T 0473 + IF CURNAME1="6ARCTAN" THEN "ARCTAN" ELSE 40474000 T 0473 + IF CURNAME1="400SQRT" THEN " SQRT" ELSE 40475000 T 0473 + IF CURNAME1="3000EXP" THEN " EXP" ELSE 40476000 T 0473 + " LN"); 40477000 T 0473 + PARAMETER; 40478000 T 0488 + IF CURTYPE≠REALTYPE AND CURTYPE≠INTTYPE THEN ERROR(67); 40479000 T 0489 + CURTYPE:=REALTYPE; 40480000 T 0492 + END; 40481000 T 0493 + END OF INTRINSIC FUNCTIONS ELSE 40482000 T 0493 + 37 IS 517 LONG, NEXT SEG 36 + BEGIN 40483000 T 0047 + T:=THISID.TYPE; 40484000 T 0047 + PASSPARAMS; 40485000 T 0048 + CURTYPE:=T; 40486000 T 0049 + END; 40487000 T 0050 + END OF FUNCTIONS ELSE 40488000 T 0050 + IF THISID.IDCLASS=PROC THEN 40489000 T 0050 + BEGIN 40490000 T 0051 + ERROR(68); PASSPARAMS; 40491000 T 0052 + CURTYPE:=0; 40492000 T 0053 + END ELSE BEGIN ERROR(69); CURTYPE:=0; INSYMBOL END; 40493000 T 0054 + END ELSE BEGIN ERROR(1); CURTYPE:=0; INSYMBOL END; 40494000 T 0056 + END OF IDENTIFIER ELSE 40495000 T 0059 + IF CURSY≤CHARCONST THEN 40496000 T 0059 + BEGIN 40497000 T 0060 + CONSTANT(VAL,CURTYPE); PUTCONST(VAL); 40498000 T 0061 + END ELSE 40499000 T 0074 + IF CURSY=NOTSY THEN 40500000 T 0074 + BEGIN 40501000 T 0075 + PUTTEXT(" NOT "); PUTDUMMY; STARTSYM:=NUMSYMS; 40502000 T 0076 + INSYMBOL; FACTOR; 40503000 T 0090 + IF CURTYPE>0 THEN 40504000 T 0091 + IF CURTYPE≠BOOLTYPE THEN BEGIN ERROR(17); CURTYPE:=0 END; 40505000 T 0092 + IF CURMODE=NUMBER THEN 40506000 T 0095 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")"); 40507000 T 0096 + CURMODE:=BITPATTERN; 40508000 T 0106 + END; 40509000 T 0107 + END ELSE 40510000 T 0107 + IF CURSY=NILSY THEN 40511000 T 0107 + BEGIN 40512000 T 0108 + PUTCONST(0); CURTYPE:=NILTYPE; 40513000 T 0109 + INSYMBOL; 40514000 T 0122 + END ELSE 40515000 T 0122 + IF CURSY=LPAR THEN 40516000 T 0122 + BEGIN 40517000 T 0124 + PUTSYM("("); 40518000 T 0124 + INSYMBOL; EXPRESSION; 40519000 T 0131 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40520000 T 0132 + PUTSYM(")"); 40521000 T 0135 + INSYMBOL; 40522000 T 0141 + END ELSE 40523000 T 0142 + IF CURSY=LBRACKET THEN %*** SET CONSTANT *** 40524000 T 0142 + BEGIN 40525000 T 0143 + INSYMBOL; 40526000 T 0144 + IF CURSY=RBRACKET THEN 40527000 T 0144 + BEGIN 40528000 T 0145 + PUTTEXT("SETBS("); PUTTEXT(" 3,2,"); PUTCONST(CARDCNT); % 40529000 P 0145 + PUTSYM(")"); % %601- 40529300 C 0172 + CURTYPE := EMPTYSET; CURMODE := NUMBER; % %601- 40529600 C 0179 + INSYMBOL; 40530000 T 0180 + END ELSE 40531000 T 0181 + BEGIN 40532000 T 0181 + FIRST:=TRUE; 40533000 T 0181 + STARTSYM := NUMSYMS + 1; % %601- 40533500 C 0182 + DO BEGIN 40534000 T 0183 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 40535000 T 0184 + PUTTEXT(" SETB("); % %601- 40536000 P 0186 + EXPRESSION; 40537000 T 0192 + IF STYPE=0 THEN 40538000 T 0192 + BEGIN STYPE:=CURTYPE; 40539000 T 0193 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(72); 40540000 T 0194 + END ELSE CHECKTYPES(STYPE,CURTYPE); 40541000 T 0197 + IF CURSY=DOUBLEDOT THEN 40542000 T 0200 + BEGIN 40543000 T 0200 + PUTSYM(","); SYMTAB[STARTSYM] := "SETBS("; % %601- 40544000 P 0201 + INSYMBOL; EXPRESSION; 40545000 T 0209 + IF STYPE=0 THEN 40546000 T 0210 + BEGIN STYPE:=CURTYPE; 40547000 T 0211 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(72); 40548000 T 0212 + END ELSE CHECKTYPES(STYPE,CURTYPE); 40549000 T 0215 + END; 40550000 T 0218 + PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); 40551000 T 0218 + IF SPLITTED THEN PUTSYM(")"); % %601- 40551500 C 0244 + IF CURSY=COMMA THEN % %601- 40552000 P 0251 + BEGIN % %601- 40552200 C 0252 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SUNIO("; % %601- 40552400 C 0253 + PUTSYM(","); % %601- 40552600 C 0255 + SPLITTED := TRUE; % %601- 40552800 C 0263 + END; % %601- 40552850 C 0264 + END UNTIL CURSY≠COMMA; 40553000 T 0264 + IF CURSY≠RBRACKET THEN 40554000 T 0265 + BEGIN ERROR(59); SKIP(RBRACKET); 40555000 T 0266 + IF CURSY=RBRACKET THEN INSYMBOL; 40556000 T 0268 + END ELSE INSYMBOL; 40557000 T 0270 + NEWTYPE; T1 := SET; T1.SIZE := 2; T1.STRUCT := 0; % %601- 40558000 P 0271 + T1.SETTYPE:=STYPE; TYPETAB1[TYPEINDEX]:=T1; 40559000 T 0280 + CURTYPE:=TYPEINDEX; 40560000 T 0283 + CURMODE := NUMBER; % %601- 40561000 P 0284 + END; 40562000 T 0284 + END OF SET CONSTANT ELSE BEGIN ERROR(99); INSYMBOL END; 40563000 T 0284 + END OF FACTOR; 40564000 T 0286 + 36 IS 292 LONG, NEXT SEG 2 + 40565000 T 0082 + 40566000 T 0082 + PROCEDURE TERM; %*** TERM *** 40567000 T 0082 + BEGIN %************ 40568000 T 0082 + INTEGER STARTSYM,MODE,TYPE1,MULOPTR,F; 40569000 T 0082 + START OF SEGMENT ********** 38 + PUTDUMMY; STARTSYM:=NUMSYMS; 40570000 T 0000 + FACTOR; 40571000 T 0006 + MODE:=CURMODE; 40572000 T 0007 + WHILE CURSY≥ASTERISK AND CURSY≤MODSY DO % "*","/","DIV","MOD","AND" 40573000 T 0007 + BEGIN 40574000 T 0010 + TYPE1:=CURTYPE; MULOPTR:=CURSY; 40575000 T 0010 + F:=TYPETAB1[TYPE1].FORM; 40576000 T 0011 + IF F=NUMERIC OR F=FLOATING THEN 40577000 T 0013 + BEGIN 40578000 T 0015 + MODE:=NUMBER; 40579000 T 0015 + IF CURSY=ASTERISK THEN PUTSYM("×") ELSE 40580000 T 0016 + IF CURSY=SLASH THEN PUTSYM("/") ELSE 40581000 T 0025 + IF CURSY=ANDSY THEN ERROR(64) ELSE 40582000 T 0034 + BEGIN 40583000 T 0036 + IF F=FLOATING THEN ERROR(64); 40584000 T 0037 + IF CURSY=DIVSY THEN PUTTEXT(" DIV") ELSE PUTTEXT(" MOD"); 40585000 T 0039 + END END ELSE 40586000 T 0053 + IF CURTYPE=BOOLTYPE THEN % %601- 40587000 P 0053 + BEGIN 40588000 T 0056 + MODE:=BITPATTERN; 40589000 T 0057 + IF CURMODE≠MODE THEN 40590000 T 0058 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40591000 T 0058 + PUTTEXT(" AND "); 40592000 T 0068 + IF CURSY NEQ ANDSY THEN ERROR(64); %601- 40593000 P 0074 + END ELSE % %601- 40593100 C 0076 + IF F=SET THEN % %601- 40593200 C 0076 + BEGIN % %601- 40593300 C 0078 + IF CURSY=ASTERISK THEN % %601- 40593400 C 0079 + BEGIN % %601- 40593500 C 0080 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SINTS("; % %601- 40593600 C 0080 + PUTSYM(","); % %601- 40593700 C 0082 + END ELSE ERROR(64); % %601- 40593800 C 0090 + MODE := NUMBER; % %601- 40593900 C 0091 + END ELSE ERROR(64); 40594000 T 0092 + PUTDUMMY; STARTSYM:=NUMSYMS; 40595000 T 0093 + INSYMBOL; FACTOR; 40596000 T 0100 + IF CURTYPE>0 AND TYPE1>0 THEN 40597000 T 0101 + BEGIN 40598000 T 0103 + IF CURTYPE≠TYPE1 THEN 40599000 T 0103 + BEGIN 40600000 T 0104 + IF TYPETAB1[TYPE1].FORM≠NUMERIC OR CURTYPE≠REALTYPE THEN 40601000 T 0104 + CHECKTYPES(TYPE1,CURTYPE); 40602000 T 0107 + IF TYPE1=REALTYPE THEN CURTYPE:=REALTYPE; 40603000 T 0108 + END; 40604000 T 0110 + IF CURTYPE=REALTYPE AND MULOPTR≥DIVSY THEN ERROR(65); 40605000 T 0110 + END; 40606000 T 0113 + IF MULOPTR=SLASH THEN CURTYPE:=REALTYPE; 40607000 T 0113 + IF CURTYPE=0 THEN CURTYPE:=TYPE1; 40608000 T 0115 + IF F=SET THEN PUTSYM(")"); % %601- 40608500 C 0117 + END OF WHILE LOOP; 40609000 T 0127 + IF MODE=BITPATTERN AND CURMODE≠MODE THEN 40610000 T 0128 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40611000 T 0129 + CURMODE:=MODE; 40612000 T 0139 + END OF TERM; 40613000 T 0140 + 38 IS 144 LONG, NEXT SEG 2 + 40614000 T 0082 + 40615000 T 0082 + PROCEDURE SIMPLEEXPRESSION; %*** SIMPLE EXPRESSION *** 40616000 T 0082 + BEGIN %************************* 40617000 T 0082 + INTEGER STARTSYM,FIRSTSYM,MODE,TYPE1,F; %603- 40618000 P 0082 + START OF SEGMENT ********** 39 + BOOLEAN SIGNED; 40619000 T 0000 + 40620000 T 0000 + PUTDUMMY; STARTSYM := FIRSTSYM := NUMSYMS; %603- 40621000 P 0000 + IF CURSY=PLUS OR CURSY=MINUS THEN 40622000 T 0007 + BEGIN SIGNED:=TRUE; 40623000 T 0008 + PUTSYM(IF CURSY=PLUS THEN"+" ELSE "-"); 40624000 T 0010 + INSYMBOL; 40625000 T 0020 + END; 40626000 T 0021 + TERM; 40627000 T 0021 + MODE:=CURMODE; 40628000 T 0021 + IF SIGNED THEN 40629000 T 0022 + BEGIN F:=TYPETAB1[CURTYPE].FORM; 40630000 T 0022 + IF F≠NUMERIC AND F≠FLOATING THEN ERROR(29); 40631000 T 0024 + END; 40632000 T 0027 + WHILE CURSY≥PLUS AND CURSY≤ORSY DO % "+","-","OR" 40633000 T 0027 + BEGIN 40634000 T 0030 + TYPE1:=CURTYPE; F:=TYPETAB1[TYPE1].FORM; 40635000 T 0030 + IF F=NUMERIC OR F=FLOATING THEN 40636000 T 0032 + BEGIN MODE:=NUMBER; 40637000 T 0034 + IF CURSY=PLUS THEN PUTSYM("+") ELSE 40638000 T 0035 + IF CURSY=MINUS THEN PUTSYM("-") ELSE ERROR(64); 40639000 T 0043 + END ELSE 40640000 T 0053 + IF CURTYPE=BOOLTYPE THEN 40641000 T 0053 + BEGIN 40642000 T 0054 + MODE:=BITPATTERN; 40643000 T 0055 + IF CURMODE≠MODE THEN 40644000 T 0055 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40645000 T 0056 + IF CURSY=ORSY THEN PUTTEXT(" OR") ELSE ERROR(64); 40646000 T 0066 + END ELSE 40647000 T 0075 + IF F=SET THEN 40648000 T 0075 + BEGIN 40649000 T 0077 + SPLIT(FIRSTSYM,1); %603- 40650000 P 0077 + IF CURSY = PLUS THEN SYMTAB[FIRSTSYM] := "SUNIO(" ELSE %603- 40651000 P 0078 + IF CURSY = MINUS THEN SYMTAB[FIRSTSYM] := "SDIFF(" ELSE %603- 40652000 P 0081 + ERROR(64); %603- 40653000 P 0085 + PUTSYM(","); MODE := NUMBER; % %601- 40654000 P 0087 + END ELSE ERROR(64); 40656000 T 0095 + INSYMBOL; 40657000 T 0096 + PUTDUMMY; STARTSYM:=NUMSYMS; 40658000 T 0097 + TERM; 40659000 T 0103 + IF CURTYPE>0 AND TYPE1>0 THEN 40660000 T 0104 + BEGIN 40661000 T 0105 + IF CURTYPE≠TYPE1 THEN 40662000 T 0106 + BEGIN 40663000 T 0107 + IF TYPETAB1[TYPE1].FORM≠NUMERIC OR CURTYPE≠REALTYPE THEN 40664000 T 0107 + CHECKTYPES(TYPE1,CURTYPE); 40665000 T 0110 + IF TYPE1=REALTYPE THEN CURTYPE:=REALTYPE; 40666000 T 0111 + END END; 40667000 T 0113 + IF CURTYPE=0 THEN CURTYPE:=TYPE1; 40668000 T 0113 + IF F=SET THEN PUTSYM(")"); % %601- 40668500 C 0115 + END OF WHILE LOOP; 40669000 T 0124 + IF MODE=BITPATTERN AND CURMODE≠BITPATTERN THEN 40670000 T 0125 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40671000 T 0126 + CURMODE:=MODE; 40672000 T 0136 + END OF SIMPLEEXPRESSION; 40673000 T 0137 + 39 IS 142 LONG, NEXT SEG 2 + 40674000 T 0082 + 40675000 T 0082 + PROCEDURE EXPRESSION; %*** EXPRESSION *** 40676000 T 0082 + BEGIN %****************** 40677000 T 0082 + INTEGER STARTSYM,FIRSTSYM,TYPE1,RELOPTR,F; 40678000 T 0082 + START OF SEGMENT ********** 40 + BOOLEAN CALLGEN; 40679000 T 0000 + 40680000 T 0000 + EXPRLEVEL:=EXPRLEVEL+1; 40681000 T 0000 + IF EXPRLEVEL = 1 THEN 40682000 T 0001 + BEGIN 40683000 T 0002 + PUTDUMMY; 40684000 T 0002 + FIRSTSYM := NUMSYMS; 40685000 T 0008 + END; 40686000 T 0009 + PUTDUMMY; STARTSYM:=NUMSYMS; 40687000 T 0009 + SIMPLEEXPRESSION; 40689000 T 0017 + IF CURSY≥LSSSY AND CURSY≤INSY THEN % "<","≤","≥",">","=","≠","IN" 40690000 T 0017 + BEGIN 40691000 T 0019 + TYPE1:=CURTYPE; F:=TYPETAB1[TYPE1].FORM; 40692000 T 0020 + RELOPTR:=CURSY; 40693000 T 0022 + IF F≤ALFA THEN 40694000 T 0023 + BEGIN 40695000 T 0023 + IF CURMODE=BITPATTERN THEN 40696000 T 0024 + BEGIN SYMTAB[STARTSYM]:=" REAL("; PUTSYM(")") END; 40697000 T 0025 + IF CURSY=LSSSY THEN PUTSYM("<") ELSE 40698000 T 0035 + IF CURSY=LEQSY THEN PUTSYM("≤") ELSE 40699000 T 0043 + IF CURSY=GEQSY THEN PUTSYM("≥") ELSE 40700000 T 0052 + IF CURSY=GTRSY THEN PUTSYM(">") ELSE 40701000 T 0060 + IF CURSY=EQLSY THEN PUTSYM("=") ELSE 40702000 T 0069 + IF CURSY=NEQSY THEN PUTSYM("≠") ELSE 40703000 T 0077 + BEGIN 40704000 T 0086 + IF F≥FLOATING THEN ERROR(64); 40705000 T 0086 + SYMTAB[STARTSYM]:="INTST("; PUTSYM(","); CALLGEN:=TRUE; 40706000 T 0088 + END; 40707000 T 0098 + END ELSE 40708000 T 0098 + IF F=SET THEN 40709000 T 0098 + BEGIN 40710000 T 0099 + IF CURMODE=BITPATTERN THEN 40711000 T 0100 + BEGIN SYMTAB[STARTSYM+1]:=" REAL("; PUTSYM(")") END; 40712000 T 0100 + IF CURSY=EQLSY THEN SYMTAB[STARTSYM] := "SEQUA(" % %601- 40713000 P 0111 + ELSE %601- 40713150 C 0113 + IF CURSY=NEQSY THEN % %601- 40713300 C 0114 + BEGIN % %601- 40714000 P 0116 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM]:= " NOT "; % %601- 40714150 C 0117 + SYMTAB[STARTSYM+1] := "SEQUA("; % %601- 40714300 C 0119 + END ELSE 40715000 T 0121 + BEGIN 40716000 T 0121 + IF CURSY=LEQSY THEN SYMTAB[STARTSYM]:="INCL1(" ELSE 40717000 T 0124 + IF CURSY=GEQSY THEN SYMTAB[STARTSYM]:="INCL2(" ELSE ERROR(64); 40718000 T 0126 + PUTSYM(","); CALLGEN:=TRUE; 40719000 T 0132 + END END ELSE 40720000 T 0140 + IF F=POINTERS THEN 40721000 T 0140 + BEGIN 40722000 T 0141 + IF CURSY=EQLSY THEN PUTSYM("=") ELSE 40723000 T 0142 + IF CURSY=NEQSY THEN PUTSYM("≠") ELSE ERROR(64); 40724000 T 0150 + END ELSE ERROR(64); 40725000 T 0159 + INSYMBOL; 40726000 T 0161 + PUTDUMMY; STARTSYM:=NUMSYMS; 40727000 T 0161 + SIMPLEEXPRESSION; 40728000 T 0168 + IF CURTYPE>0 AND TYPE1>0 THEN 40729000 T 0168 + IF CURTYPE≠TYPE1 THEN 40730000 T 0170 + IF RELOPTR≠INSY THEN 40731000 T 0171 + BEGIN 40732000 T 0172 + IF TYPETAB1[TYPE1].FORM≠NUMERIC OR CURTYPE≠REALTYPE THEN 40733000 T 0173 + CHECKTYPES(TYPE1,CURTYPE); 40734000 T 0175 + END ELSE 40735000 T 0177 + IF TYPETAB1[CURTYPE].FORM≠SET THEN ERROR(66) 40736000 T 0177 + ELSE CHECKTYPES(TYPE1,TYPETAB1[CURTYPE].SETTYPE); 40737000 T 0181 + IF CURMODE=BITPATTERN THEN 40738000 T 0184 + BEGIN SYMTAB[STARTSYM]:=" REAL("; PUTSYM(")") END; 40739000 T 0184 + IF CALLGEN THEN PUTSYM(")"); 40740000 T 0194 + CURTYPE:=BOOLTYPE; CURMODE:=BITPATTERN; 40741000 T 0202 + END; 40742000 T 0203 + EXPRLEVEL:=EXPRLEVEL-1; 40743000 T 0203 + IF EXPRLEVEL=0 THEN 40744000 T 0204 + BEGIN 40745000 T 0205 + IF CURMODE=BITPATTERN THEN 40746000 T 0206 + BEGIN 40747000 T 0206 + SYMTAB[FIRSTSYM] := " REAL("; 40748000 T 0207 + PUTSYM(")"); 40749000 T 0208 + END; 40750000 T 0216 + IF EXPINVARCNT=0 THEN WRITEEXPR; % %002- 40751000 P 0216 + END; 40752000 T 0218 + END OF EXPRESSION; 40753000 T 0218 + 40 IS 223 LONG, NEXT SEG 2 + 40754000 T 0082 + 40755000 T 0082 + DEFINE BOOLEXPR= 40756000 T 0082 + BEGIN 40757000 T 0082 + PUTDUMMY; EXPRLEVEL:=1; EXPRESSION; 40758000 T 0082 + IF CURTYPE>0 THEN IF CURTYPE≠BOOLTYPE THEN ERROR(17); 40759000 T 0082 + IF CURMODE≠BITPATTERN THEN 40760000 T 0082 + BEGIN SYMTAB[1]:=" B("; PUTSYM(")") END; 40761000 T 0082 + EXPRLEVEL:=0; WRITEEXPR; 40762000 T 0082 + END OF BOOLEAN#; 40763000 T 0082 + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50001000 T 0082 + % % 50002000 T 0082 + % % 50003000 T 0082 + % % 50004000 T 0082 + % PART 5: INTRINSIC ROUTINES. % 50005000 T 0082 + % ------------------- % 50006000 T 0082 + % % 50007000 T 0082 + % % 50008000 T 0082 + % % 50009000 T 0082 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50010000 T 0082 + 50011000 T 0082 + 50012000 T 0082 + PROCEDURE CONCAT; %*** "CONCAT" *** 50013000 T 0082 + BEGIN %**************** 50014000 T 0082 + DEFINE INTEXPR= 50015000 T 0082 + START OF SEGMENT ********** 41 + BEGIN INSYMBOL; EXPRESSION; 50016000 T 0000 + IF CURTYPE>0 THEN 50017000 T 0000 + IF TYPETAB1[CURTYPE].FORM≠NUMERIC THEN ERROR(17); 50018000 T 0000 + END #; 50019000 T 0000 + 50020000 T 0000 + PUTTEXT("CONCAT"); PUTSYM("("); 50021000 T 0000 + INSYMBOL; 50022000 T 0013 + IF CURSY=LPAR THEN 50023000 T 0014 + BEGIN 50024000 T 0014 + INSYMBOL; EXPRESSION; 50025000 T 0015 + IF CURTYPE>0 THEN 50026000 T 0016 + IF TYPETAB1[CURTYPE].FORM>ALFA THEN ERROR(17); 50027000 T 0017 + IF CURSY=COMMA THEN 50028000 T 0020 + BEGIN 50029000 T 0021 + PUTSYM(","); INSYMBOL; EXPRESSION; 50030000 T 0021 + IF CURTYPE>0 THEN 50031000 T 0029 + IF TYPETAB1[CURTYPE].FORM>ALFA THEN ERROR(17); 50032000 T 0030 + IF CURSY=COMMA THEN 50033000 T 0033 + BEGIN 50034000 T 0034 + PUTSYM(","); INTEXPR; 50035000 T 0034 + IF CURSY=COMMA THEN 50036000 T 0046 + BEGIN 50037000 T 0047 + PUTSYM(","); INTEXPR; 50038000 T 0047 + IF CURSY=COMMA THEN 50039000 T 0059 + BEGIN 50040000 T 0060 + PUTSYM(","); INTEXPR; 50041000 T 0060 + PUTSYM(","); PUTCONST(CARDCNT); 50042000 T 0072 + PUTSYM(")"); 50043000 T 0091 + IF CURSY≠RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; 50044000 T 0098 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50045000 T 0101 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50046000 T 0103 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50047000 T 0105 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50048000 T 0107 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50049000 T 0109 + CURTYPE := 0; % ALFATYPE OR REALTYPE %509- 50050000 P 0111 + IF CURSY=RPAR THEN INSYMBOL; 50051000 T 0111 + END OF CONCAT; 50052000 T 0113 + 41 IS 114 LONG, NEXT SEG 2 + 50053000 T 0082 + 50054000 T 0082 + PROCEDURE PREAD(CHANGELINE); 50055000 T 0082 + VALUE CHANGELINE; BOOLEAN CHANGELINE; 50056000 T 0082 + BEGIN 50057000 T 0082 + INTEGER FILEID,F; 50058000 T 0082 + START OF SEGMENT ********** 42 + GEN(" BEGIN",7,2); 50060000 T 0000 + FILEPARAM(INPUTFILE); FILEID:=FILENAME; 50061000 T 0001 + IF TYPETAB1[CURTYPE].FORM=FILES THEN ERROR(85); 50062000 T 0003 + IF SYMKIND[CURSY]≠TERMINAL THEN 50063000 T 0005 + BEGIN 50064000 T 0006 + IF CURSY NEQ RPAR THEN 50065000 T 0007 + DO BEGIN 50066000 T 0008 + WHILE CURSY=COMMA DO INSYMBOL; 50067000 T 0009 + IF CURSY=IDENTIFIER THEN 50068000 T 0013 + BEGIN 50069000 T 0013 + SEARCH; 50070000 T 0014 + IF FOUND THEN 50071000 T 0014 + BEGIN 50072000 T 0015 + IF THISID.IDCLASS=VAR OR 50073000 T 0015 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 50074000 T 0016 + BEGIN 50075000 T 0019 + VARIABLE; F:=TYPETAB1[CURTYPE].FORM; 50076000 T 0019 + IF F=NUMERIC OR F=FLOATING OR F=CHAR THEN 50077000 T 0021 + BEGIN 50078000 T 0024 + GEN("PREAD(",6,2); WRITEEXPR; GEN(",",1,7); % %600- 50079000 P 0025 + GENID("F",FILEID,5); GEN(",",1,7); % %600- 50082000 P 0028 + GENID("V",FILEID,5); GEN(",",1,7); 50083000 T 0031 + GENID("I",FILEID,5); GEN(",",1,7); 50084000 T 0034 + IF F=NUMERIC THEN GENINT(2) ELSE 50085000 T 0037 + IF F=FLOATING THEN GENINT(3) ELSE GENINT(1); 50086000 T 0039 + IF F=NUMERIC THEN % %600- 50086010 C 0044 + BEGIN % %600- 50086050 C 0045 + GEN(",",1,7); GENINT(TYPETAB2[CURTYPE]); % %600- 50086100 C 0045 + GEN(",",1,7); GENINT(TYPETAB3[CURTYPE]); % %600- 50086150 C 0048 + END ELSE GEN(",0,0,",4,4); % %600- 50086200 C 0050 + GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50087000 T 0052 + END ELSE BEGIN ERROR(82); INSYMBOL END; 50094000 T 0056 + END ELSE BEGIN ERROR(8); INSYMBOL END; 50095000 T 0059 + END ELSE BEGIN ERROR(1); INSYMBOL END; 50096000 T 0061 + END ELSE ERROR(9); 50097000 T 0062 + GEN(";",1,7); 50098000 T 0064 + END UNTIL CURSY≠COMMA; 50099000 T 0065 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50100000 T 0066 + IF CURSY=RPAR THEN INSYMBOL; 50101000 T 0069 + END; 50102000 T 0071 + IF CHANGELINE THEN 50103000 T 0071 + BEGIN 50104000 T 0071 + GEN("RLINE(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 50105000 T 0072 + GENID("V",FILEID,5); GEN(",",1,7); 50106000 T 0076 + GENID("I",FILEID,5); GEN(")",1,7); 50107000 T 0079 + END; 50108000 T 0082 + GEN("END",4,5); 50109000 T 0082 + END OF PREAD; 50110000 T 0084 + 42 IS 90 LONG, NEXT SEG 2 + 50111000 T 0082 + 50112000 T 0082 + PROCEDURE PWRITE(LINEFEED); 50113000 T 0082 + VALUE LINEFEED; BOOLEAN LINEFEED; 50114000 T 0082 + BEGIN 50115000 T 0082 + INTEGER FILEID,F,I,LASTSY; 50116000 T 0082 + START OF SEGMENT ********** 43 + POINTER P; 50117000 T 0000 + GEN(" BEGIN",7,2); 50118000 T 0000 + FILEPARAM(OUTPUTFILE); FILEID:=FILENAME; 50119000 T 0001 + IF TYPETAB1[CURTYPE].FORM=FILES THEN ERROR(85); 50120000 T 0003 + IF SYMKIND[CURSY]≠TERMINAL THEN 50121000 T 0005 + BEGIN 50122000 T 0006 + IF CURSY NEQ RPAR THEN 50123000 T 0007 + DO BEGIN 50124000 T 0008 + WHILE CURSY=COMMA DO INSYMBOL; 50125000 T 0009 + IF CURSY=ALFACONST AND CURLENGTH>7 THEN 50126000 T 0013 + BEGIN 50127000 T 0014 + GEN("WALFA(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 50128000 T 0015 + GENID("V",FILEID,5); GEN(",",1,7); 50129000 T 0019 + GENID("I",FILEID,5); GEN(",",1,7); 50130000 T 0022 + P:=STRINGPNT; 50131000 T 0025 + FOR I:=1 STEP 7 UNTIL 80 DO 50132000 T 0026 + IF I≤CURLENGTH THEN 50133000 T 0029 + BEGIN 50134000 T 0029 + IF ALGOLCNT<10 THEN WRITEALGOL; 50135000 T 0030 + REPLACE ALGOLPNT:ALGOLPNT BY """, P:P FOR 7, """, ","; 50136000 T 0032 + ALGOLCNT:=ALGOLCNT-10; 50137000 T 0043 + END ELSE GEN("0,",2,6); 50138000 T 0045 + GENINT(CURLENGTH); GEN(",",1,7); 50139000 T 0049 + GENINT(CARDCNT); GEN(")",1,7); 50140000 T 0051 + INSYMBOL; 50141000 T 0053 + END OF ALFACONST ELSE 50142000 T 0054 + BEGIN 50143000 T 0054 + GEN("PWRITE(",7,1); GENID("F",FILEID,5); GEN(",",1,7); 50144000 T 0054 + GENID("V",FILEID,5); GEN(",",1,7); 50145000 T 0059 + GENID("I",FILEID,5); GEN(",",1,7); 50146000 T 0062 + LASTSY:=CURSY; 50147000 T 0065 + EXPRESSION; F:=TYPETAB1[CURTYPE].FORM; 50148000 T 0066 + GEN(",",1,7); 50149000 T 0068 + IF F=NUMERIC OR F=FLOATING OR F=CHAR OR F=ALFA OR 50150000 T 0069 + CURTYPE=BOOLTYPE THEN 50151000 T 0073 + BEGIN 50152000 T 0074 + IF F=NUMERIC THEN GENINT(1) ELSE 50153000 T 0074 + IF F=FLOATING THEN GENINT(2) ELSE 50154000 T 0076 + IF F=ALFA THEN GENINT(5) ELSE 50155000 T 0081 + IF F=CHAR THEN GENINT(4) ELSE GENINT(3); 50156000 T 0083 + GEN(",",1,7); 50157000 T 0087 + IF CURSY=COLON THEN 50158000 T 0088 + BEGIN 50159000 T 0089 + INSYMBOL; EXPRESSION; 50160000 T 0090 + IF TYPETAB1[CURTYPE].FORM NEQ NUMERIC THEN ERROR(17); 50161000 T 0091 + GEN(",",1,7); 50162000 T 0093 + IF CURSY=COLON THEN 50163000 T 0095 + BEGIN 50164000 T 0096 + IF F≠FLOATING THEN ERROR(4); 50165000 T 0096 + INSYMBOL; EXPRESSION; 50166000 T 0098 + IF TYPETAB1[CURTYPE].FORM NEQ NUMERIC THEN ERROR(17); 50167000 T 0099 + GEN(",",1,7); 50168000 T 0102 + END ELSE GEN("-1,",3,5); 50169000 T 0103 + END ELSE 50170000 T 0105 + BEGIN 50171000 T 0105 + IF F=FLOATING THEN GENINT(16) ELSE 50172000 T 0108 + IF F=ALFA AND LASTSY=ALFACONST THEN GENINT(CURLENGTH) ELSE 50173000 T 0110 + IF F=ALFA THEN GENINT(7) ELSE 50174000 T 0113 + IF F=CHAR THEN GENINT(1) ELSE GENINT(10); 50175000 T 0116 + GEN(",-1,",4,4); 50176000 T 0119 + END; 50177000 T 0121 + END ELSE ERROR(17); 50178000 T 0121 + GENINT(CARDCNT); GEN(")",1,7); 50179000 T 0123 + END OF EXPRESSION; 50180000 T 0126 + GEN(";",1,7); 50181000 T 0126 + END UNTIL CURSY≠COMMA; 50182000 T 0127 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50183000 T 0128 + IF CURSY=RPAR THEN INSYMBOL; 50184000 T 0131 + END; 50185000 T 0133 + FILENAME:=FILEID; 50186000 T 0133 + IF LINEFEED THEN 50187000 T 0134 + BEGIN 50188000 T 0134 + INTEGER DUMMY; 50189000 T 0134 + START OF SEGMENT ********** 44 + GEN("WLINE(",6,2); GENID("F",FILENAME,5); GEN(",",1,7); 50190000 T 0000 + GENID("V",FILENAME,5); GEN(",",1,7); 50191000 T 0004 + GENID("I",FILENAME,5); GEN(")",1,7); 50192000 T 0007 + END; 50193000 T 0010 + 44 IS 12 LONG, NEXT SEG 43 + GEN("END",4,5); 50194000 T 0136 + END OF PWRITE; 50195000 T 0137 + 43 IS 143 LONG, NEXT SEG 2 + 50196000 T 0082 + 50197000 T 0082 + PROCEDURE FILEHANDLING(PROCNUM); %*** FILE HANDLING PROCEDURES: 50198000 T 0082 + VALUE PROCNUM; INTEGER PROCNUM; %*** 50199000 T 0082 + BEGIN %*** 1) PUT 50200000 T 0082 + INTEGER F; %*** 2) GET 50201000 T 0082 + START OF SEGMENT ********** 45 + LABEL EFH; %002- 50201500 C 0000 + CASE PROCNUM OF %*** 3) RESET 50202000 T 0000 + BEGIN ; % NULL %*** 4) REWRITE %001- 50203000 P 0000 + GEN("PUT",3,5); %*** 5) PAGE %001- 50204000 P 0000 + %*** 6) OPEN & CLOSE (INPUT) FOR 50204500 C 0002 + % CUMULATIVE FREQUENCY COUNT 50204550 C 0002 + GEN("GET",3,5); % 50205000 T 0002 + GEN("RESET",5,3); % 50206000 T 0004 + GEN("REWRITE",7,1); % 50207000 T 0006 + GEN("PPAGE",5,3); % %001- 50208000 P 0008 + BEGIN %002- 50208100 C 0010 + GEN("QQJZXL",6,2); %002- 50208200 C 0010 + INSYMBOL; %002- 50208300 C 0012 + GO TO EFH; % %002- 50208400 C 0012 + END; %002- 50208500 C 0020 + END; % 50209000 T 0020 + START OF SEGMENT ********** 46 + 46 IS 8 LONG, NEXT SEG 45 + GEN("(",1,7); FILEPARAM(0); % 50210000 T 0021 + IF FILENAME=0 THEN ERROR(78); % 50211000 T 0023 + F:=TYPETAB1[CURTYPE].FORM; 50212000 T 0025 + IF F=FILES AND PROCNUM=5 THEN ERROR(80); 50213000 T 0026 + GENID("F",FILENAME,5); GEN(",",1,7); 50214000 T 0029 + GENID("V",FILENAME,5); GEN(",",1,7); 50215000 T 0032 + GENID("I",FILENAME,5); GEN(",",1,7); 50216000 T 0035 + GENINT(CARDCNT); GEN(")",1,7); 50217000 T 0038 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50218000 T 0041 + IF CURSY=RPAR THEN INSYMBOL; 50219000 T 0043 + EFH: %002- 50219500 C 0045 + END OF FILEHANDLING; 50220000 T 0046 + 45 IS 49 LONG, NEXT SEG 2 + 50221000 T 0082 + 50222000 T 0082 + PROCEDURE PACK; 50223000 T 0082 + BEGIN 50224000 T 0082 + INTEGER IT; REAL T; %503- 50225000 P 0082 + START OF SEGMENT ********** 47 + GEN("PACK(",5,3); 50226000 T 0000 + INSYMBOL; 50227000 T 0001 + IF CURSY=LPAR THEN 50228000 T 0002 + BEGIN 50229000 T 0002 + INSYMBOL; 50230000 T 0003 + IF CURSY=IDENTIFIER THEN 50231000 T 0003 + BEGIN 50232000 T 0004 + SEARCH; 50233000 T 0005 + IF FOUND THEN 50234000 T 0005 + BEGIN 50235000 T 0005 + IF THISID.IDCLASS=VAR THEN 50236000 T 0006 + BEGIN 50237000 T 0007 + T:=TYPETAB1[THISID.TYPE]; 50238000 T 0008 + IF T.FORM=ARRAYS THEN 50239000 T 0009 + BEGIN 50240000 T 0010 + IT:=T.INXTYPE; 50241000 T 0011 + IF TYPETAB1[T.ARRTYPE].FORM≠CHAR THEN ERROR(88); 50242000 T 0012 + GENID("H",1000×THISLEVEL+THISINDEX,5); %518- 50243100 C 0015 + GEN(",",1,7); GENINT(TYPETAB2[THISID.TYPE]); 50245000 T 0018 + GEN(",",1,7); GENINT(TYPETAB3[THISID.TYPE]); 50246000 T 0021 + END ELSE ERROR(88); 50247000 T 0024 + END ELSE ERROR(88); 50248000 T 0026 + END ELSE ERROR(1); 50249000 T 0028 + END ELSE ERROR(9); 50250000 T 0029 + INSYMBOL; 50251000 T 0030 + IF CURSY=COMMA THEN 50252000 T 0031 + BEGIN 50253000 T 0031 + GEN(",",1,7); 50254000 T 0032 + INSYMBOL; EXPRESSION; CHECKTYPES(IT,CURTYPE); 50255000 T 0033 + IF CURSY=COMMA THEN 50256000 T 0035 + BEGIN 50257000 T 0036 + GEN(",",1,7); 50258000 T 0037 + INSYMBOL; 50259000 T 0038 + IF CURSY=IDENTIFIER THEN 50260000 T 0039 + BEGIN 50261000 T 0039 + SEARCH; 50262000 T 0040 + IF FOUND THEN 50263000 T 0040 + BEGIN 50264000 T 0041 + IF THISID.IDCLASS=VAR OR 50265000 T 0041 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 50266000 T 0042 + BEGIN 50267000 T 0045 + VARIABLE; WRITEEXPR; 50268000 T 0045 + IF CURTYPE>0 THEN 50269000 T 0046 + IF TYPETAB1[CURTYPE].FORM≠ALFA THEN ERROR(12); 50270000 T 0047 + END ELSE ERROR(8); 50271000 T 0050 + END ELSE ERROR(1); 50272000 T 0052 + END ELSE ERROR(9); 50273000 T 0053 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50274000 T 0054 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50275000 T 0056 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50276000 T 0058 + IF CURSY=RPAR THEN INSYMBOL; 50277000 T 0061 + END ELSE BEGIN ERROR(3); INSYMBOL END; 50278000 T 0063 + GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50279000 T 0064 + END OF PACK; 50280000 T 0068 + 47 IS 72 LONG, NEXT SEG 2 + 50281000 T 0082 + 50282000 T 0082 + PROCEDURE UNPACK; 50283000 T 0082 + BEGIN 50284000 T 0082 + INTEGER IT; REAL T; %503- 50285000 P 0082 + START OF SEGMENT ********** 48 + GEN("UNPACK(",7,1); INSYMBOL; 50286000 T 0000 + IF CURSY=LPAR THEN 50287000 T 0002 + BEGIN 50288000 T 0002 + INSYMBOL; EXPRESSION; 50289000 T 0003 + IF CURTYPE>0 THEN IF TYPETAB1[CURTYPE].FORM≠ALFA THEN ERROR(17); 50290000 T 0004 + IF CURSY=COMMA THEN 50291000 T 0008 + BEGIN 50292000 T 0009 + GEN(",",1,7); INSYMBOL; 50293000 T 0009 + IF CURSY=IDENTIFIER THEN 50294000 T 0011 + BEGIN 50295000 T 0012 + SEARCH; 50296000 T 0012 + IF FOUND THEN 50297000 T 0013 + BEGIN 50298000 T 0013 + IF THISID.IDCLASS=VAR THEN 50299000 T 0014 + BEGIN 50300000 T 0015 + T:=TYPETAB1[THISID.TYPE]; 50301000 T 0015 + IF T.FORM=ARRAYS THEN 50302000 T 0017 + BEGIN 50303000 T 0018 + IT:=T.INXTYPE; 50304000 T 0019 + IF TYPETAB1[T.ARRTYPE].FORM≠CHAR THEN ERROR(88); 50305000 T 0020 + GENID("H",1000×THISLEVEL+THISINDEX,5); %518- 50307100 C 0023 + GEN(",",1,7); GENINT(TYPETAB2[THISID.TYPE]); 50308000 T 0026 + GEN(",",1,7); GENINT(TYPETAB3[THISID.TYPE]); 50309000 T 0029 + END ELSE ERROR(88); 50310000 T 0032 + END ELSE ERROR(88); 50311000 T 0034 + END ELSE ERROR(1); 50312000 T 0036 + END ELSE ERROR(9); 50313000 T 0037 + INSYMBOL; 50314000 T 0038 + IF CURSY=COMMA THEN 50315000 T 0039 + BEGIN 50316000 T 0039 + GEN(",",1,7); 50317000 T 0040 + INSYMBOL; EXPRESSION; CHECKTYPES(IT,CURTYPE); 50318000 T 0041 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50319000 T 0043 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50320000 T 0045 + IF CURSY≠RPAR THEN BEGIN ERROR(89); SKIP(RPAR) END; 50321000 T 0047 + IF CURSY=RPAR THEN INSYMBOL; 50322000 T 0050 + END ELSE BEGIN ERROR(3); INSYMBOL END; 50323000 T 0052 + GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50324000 T 0054 + END OF UNPACK; 50325000 T 0057 + 48 IS 61 LONG, NEXT SEG 2 + 50326000 T 0082 + 50327000 T 0082 + PROCEDURE NEWDISP; %*** "NEW","DISPOSE" 50328000 T 0082 + BEGIN 50329000 T 0082 + INTEGER T1; 50330000 T 0082 + START OF SEGMENT ********** 49 + IF CURNAME1="3000NEW" THEN GEN("NEW(",4,4) ELSE 50331000 T 0000 + BEGIN GEN("DISPOSE",7,1); GEN("(",1,7) END; 50332000 T 0002 + INSYMBOL; 50333000 T 0009 + IF CURSY=LPAR THEN 50334000 T 0009 + BEGIN 50335000 T 0010 + INSYMBOL; 50336000 T 0010 + IF CURSY=IDENTIFIER THEN 50337000 T 0011 + BEGIN 50338000 T 0012 + SEARCH; 50339000 T 0012 + IF FOUND THEN 50340000 T 0013 + BEGIN 50341000 T 0013 + VARIABLE; 50342000 T 0013 + IF CURTYPE>0 THEN IF TYPETAB1[CURTYPE].FORM=POINTERS THEN 50343000 T 0014 + BEGIN 50344000 T 0017 + WRITEEXPR; GEN(",",1,7); 50345000 T 0017 + T1:=TYPETAB1[CURTYPE].POINTTYPE; 50346000 T 0019 + T1:=TYPETAB1[T1].SIZE; 50347000 T 0021 + IF T1>1023 THEN ERROR(86); 50348000 T 0022 + GENINT(T1); GEN(")",1,7); 50349000 T 0024 + END ELSE ERROR(81); 50350000 T 0026 + END ELSE BEGIN ERROR(1); INSYMBOL END; 50351000 T 0029 + END ELSE ERROR(9); 50352000 T 0031 + WHILE CURSY=COMMA DO 50353000 T 0032 + BEGIN INSYMBOL; 50354000 T 0034 + IF CURSY NEQ IDENTIFIER THEN ERROR(9); 50355000 T 0034 + IF CURSY NEQ RPAR THEN INSYMBOL; 50356000 T 0036 + END; 50357000 T 0038 + END ELSE BEGIN ERROR(58); SKIP(RPAR) END; 50358000 T 0039 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50359000 T 0041 + IF CURSY=RPAR THEN INSYMBOL; 50360000 T 0043 + END OF NEWDISP; 50361000 T 0045 + 49 IS 48 LONG, NEXT SEG 2 + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 60001000 T 0082 + % % 60002000 T 0082 + % % 60003000 T 0082 + % % 60004000 T 0082 + % PART 6: THE STATEMENT PARSER. % 60005000 T 0082 + % --------------------- % 60006000 T 0082 + % % 60007000 T 0082 + % % 60008000 T 0082 + % % 60009000 T 0082 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 60010000 T 0082 + 60011000 T 0082 + 60012000 T 0082 + 60013000 T 0082 + PROCEDURE STATEMENT; FORWARD; 60014000 T 0082 + 60015000 T 0082 + PROCEDURE ASSIGNMENT; 60016000 T 0082 + BEGIN 60017000 T 0082 + INTEGER LEFTTYPE; 60018000 T 0082 + START OF SEGMENT ********** 50 + LABEL ASSIGN,EXIT; 60019000 T 0000 + %512- 60020000 C 0000 + PROCEDURE WRITESEXPR; %*** FIX STRUCTURE FOR ASSIGNMENT %512- 60021000 C 0000 + BEGIN % USED ONLY IN ASSIGNMENT OF STRUCTURES 60022000 C 0000 + IF INSIDEBRACKETS THEN IF SYMTAB[NUMSYMS] = "100000," %512- 60023000 C 0000 + THEN SYMTAB[NUMSYMS] := ", 0 ] " ELSE PUTSYM("]"); %512- 60024000 C 0001 + WHILE NUMPOINTERS>0 DO %512- 60025000 C 0012 + BEGIN NUMPOINTERS := NUMPOINTERS-1; %512- 60026000 C 0014 + IF NUMSYMS+4 ≥ MAXSYMS THEN WRITEEXPR; %512- 60027000 C 0015 + REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY %512- 60028000 C 0017 + "00-1)DIV00 1022,00 T MOD00 1022]"; %512- 60029000 C 0021 + NUMSYMS := NUMSYMS+4; %512- 60030000 C 0025 + END; % OF WHILE %512- 60031000 C 0026 + WRITEEXPR; GEN( ",", 1,7 ); %512- 60032000 C 0026 + END WRITESEXPR; %512- 60033000 C 0028 + %512- 60034000 C 0029 + IF FOUND THEN 60050000 T 0029 + BEGIN 60051000 T 0029 + IF THISID.IDCLASS=VAR OR 60052000 T 0029 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 60053000 T 0031 + BEGIN 60054000 T 0033 + VARIABLE; LEFTTYPE:=CURTYPE; 60055000 T 0034 + ASSIGN: IF CURSY≠ASSIGNSY THEN 60056000 T 0035 + BEGIN ERROR(28); SKIP(ASSIGNSY); 60057000 T 0036 + IF SYMKIND[CURSY]=TERMINAL THEN GO TO EXIT; 60058000 T 0038 + END; 60059000 T 0040 + INSYMBOL; 60060000 T 0040 + IF TYPETAB1[LEFTTYPE].STRUCT>0 THEN 60061000 T 0040 + BEGIN 60062000 T 0042 + %ERROR(95); % STRUCTURED ASSIGNMENT NOT IMPLEMENTED. %512- 60063000 P 0042 + EXPRLEVEL := EXPRLEVEL+1; %507- 60063900 C 0042 + GEN("ASSIGN(",7,1); WRITESEXPR; %512- 60064000 C 0044 + EXPRESSION; WRITESEXPR; %512- 60065000 C 0046 + EXPRLEVEL := EXPRLEVEL-1; %507- 60065100 C 0048 + GENINT(TYPETAB1[LEFTTYPE].SIZE); GEN(")",1,7); %512- 60066000 C 0049 + IF TYPETAB1[LEFTTYPE].SIZE≠TYPETAB1[CURTYPE].SIZE %512- 60067000 C 0052 + THEN ERROR(95); %512- 60068000 C 0053 + END ELSE 60080000 T 0055 + IF TYPETAB1[LEFTTYPE].FORM=SET THEN % %601- 60080100 C 0055 + BEGIN % %601- 60080200 C 0059 + SYMTAB[1] := "SSTOR("; NUMSYMS := NUMSYMS - 3; % %601- 60080300 C 0060 + EXPRESSION; % %601- 60080400 C 0062 + PUTSYM(")"); CHECKTYPES(LEFTTYPE,CURTYPE); % %601- 60080500 C 0063 + WRITEEXPR; % %601- 60080600 C 0072 + END ELSE % %601- 60080700 C 0073 + BEGIN 60081000 T 0073 + WRITEEXPR; GEN(":=",2,6); 60082000 T 0073 + IF CHECKOPTION AND TYPETAB1[LEFTTYPE].FORM≤CHAR THEN 60083000 T 0075 + CHECKEXPR(TYPETAB2[LEFTTYPE],TYPETAB3[LEFTTYPE]) ELSE 60084000 T 0077 + EXPRESSION; 60085000 T 0079 + WRITEEXPR; 60086000 T 0080 + END; %512- 60087000 P 0081 + CHECKTYPES( LEFTTYPE, CURTYPE ); %512- 60088000 P 0081 + END ELSE 60089000 T 0082 + BEGIN % FUNCTION ASSIGNMENT. 60090000 T 0082 + IF THISLEVEL≠CURLEVEL-1 OR THISINDEX≠CURFUNC THEN ERROR(5);%511- 60091000 P 0082 + GENID("V",1000×THISLEVEL+THISINDEX,5); LEFTTYPE:=THISID.TYPE; 60092000 T 0086 + INSYMBOL; GO TO ASSIGN; 60093000 T 0089 + END; 60094000 T 0090 + END ELSE 60095000 T 0090 + BEGIN 60096000 T 0090 + SKIP(ASSIGNSY); 60097000 T 0091 + IF CURSY=ASSIGNSY THEN GO TO ASSIGN; 60098000 T 0092 + END; 60099000 T 0093 + EXIT: 60100000 T 0093 + END OF ASSIGNMENT; 60101000 T 0094 + 50 IS 100 LONG, NEXT SEG 2 + 60102000 T 0082 + 60103000 T 0082 + PROCEDURE COMPSTAT; 60104000 T 0082 + BEGIN 60105000 T 0082 + INTEGER BEGINNUM; 60106000 T 0082 + START OF SEGMENT ********** 51 + LABEL STATM; 60107000 T 0000 + 60108000 T 0000 + BEGINNUM:=NUMBEGINS:=NUMBEGINS+1; MARGIN(" B",BEGINNUM); 60109000 T 0000 + GEN("BEGIN",6,3); 60110000 T 0019 + DO BEGIN 60111000 T 0021 + IF CURSY=SEMICOLON OR CURSY=BEGINSY THEN INSYMBOL; 60112000 T 0021 + STATM: STATEMENT; 60113000 T 0023 + GEN(";",1,7); 60114000 T 0024 + IF CURSY=ELSESY THEN BEGIN ERROR(20); INSYMBOL; GO STATM END; 60115000 T 0026 + IF SYMKIND[CURSY]=INITIAL THEN BEGIN ERROR(21); GO STATM END; 60116000 T 0031 + END UNTIL CURSY≠SEMICOLON; 60117000 T 0033 + IF CURSY≠ENDSY THEN 60118000 T 0035 + BEGIN ERROR(24); SKIP(ENDSY); 60119000 T 0035 + IF CURSY≠ENDSY THEN BEGIN INSYMBOL; GO TO STATM END; 60120000 T 0037 + END; 60121000 T 0040 + GEN(" END",5,4); MARGIN(" E",BEGINNUM); 60122000 T 0040 + INSYMBOL; 60123000 T 0059 + END OF COMPSTAT; 60124000 T 0059 + 51 IS 64 LONG, NEXT SEG 2 + 60125000 T 0082 + 60126000 T 0082 + PROCEDURE IFSTAT; 60127000 T 0082 + BEGIN 60128000 T 0082 + LABEL EXIT; 60129000 T 0082 + START OF SEGMENT ********** 52 + GEN("IF",3,6); 60130000 T 0000 + INSYMBOL; BOOLEXPR; 60131000 T 0001 + IF CURSY≠THENSY THEN 60132000 T 0026 + BEGIN IF CURTYPE>0 THEN ERROR(27); 60133000 T 0027 + SKIP(THENSY); 60134000 T 0030 + IF CURSY≠THENSY THEN 60135000 T 0030 + BEGIN IF CURTYPE=0 THEN ERROR(27); 60136000 T 0031 + IF SYMKIND[CURSY]=TERMINAL THEN GO TO EXIT; 60137000 T 0034 + END; END; 60138000 T 0035 + GEN(" THEN",6,3); 60139000 T 0035 + INSYMBOL; STATEMENT; 60140000 T 0037 + IF CURSY=ELSESY THEN 60141000 T 0038 + BEGIN GEN(" ELSE",6,3); INSYMBOL; STATEMENT END; 60142000 T 0038 + EXIT: 60143000 T 0041 + END OF IFSTAT; 60144000 T 0042 + 52 IS 45 LONG, NEXT SEG 2 + 60145000 T 0082 + 60146000 T 0082 + PROCEDURE CASESTAT; 60147000 T 0082 + BEGIN 60148000 T 0082 + DEFINE CASEHASH(N)=(N).[38:39] MOD MAXCASES#; 60149000 T 0082 + START OF SEGMENT ********** 53 + INTEGER ARRAY CASETAB[0:MAXCASES]; 60150000 T 0000 + INTEGER CASENUM,CASETYPE,NCASELABS,TEMPVARNUM,CONVAL,CONTYPE,C,T; 60151000 T 0001 + BOOLEAN ZEROLAB,FIRST; 60152000 T 0001 + 60153000 T 0001 + CASENUM:=NUMCASES:=NUMCASES+1; MARGIN("CB",CASENUM); 60154000 T 0001 + TEMPVARNUM:=NUMTEMPS:=NUMTEMPS+1; 60155000 T 0021 + IF TEMPVARNUM>MAXTEMPS THEN ERROR(16); 60156000 T 0023 + GEN("BEGIN",6,3); GENID("T",TEMPVARNUM,2); GEN(":=",2,6); 60157000 T 0025 + INSYMBOL; EXPRESSION; 60158000 T 0029 + GEN(";",1,7); CASETYPE:=CURTYPE; 60159000 T 0030 + IF TYPETAB1[CASETYPE].FORM≥FLOATING THEN 60160000 T 0032 + BEGIN ERROR(17); CASETYPE:=0 END; 60161000 T 0034 + IF CURSY≠OFSY THEN 60162000 T 0036 + BEGIN IF CASETYPE>0 THEN ERROR(18); 60163000 T 0037 + SKIP(OFSY); 60164000 T 0039 + IF CURSY=OFSY THEN INSYMBOL ELSE 60165000 T 0040 + IF CASETYPE=0 THEN ERROR(18); 60166000 T 0042 + END ELSE INSYMBOL; 60167000 T 0047 + DO BEGIN 60168000 T 0048 + WHILE CURSY=SEMICOLON DO INSYMBOL; 60169000 T 0048 + FIRST:=TRUE; 60170000 T 0050 + IF CURSY≠ENDSY THEN 60171000 T 0051 + BEGIN 60172000 T 0051 + GEN("IF",3,6); 60173000 T 0052 + DO BEGIN 60174000 T 0053 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 60175000 T 0054 + CONSTANT(CONVAL,CONTYPE); 60176000 T 0057 + IF CONTYPE>0 THEN 60177000 T 0058 + BEGIN 60178000 T 0059 + IF CASETYPE=0 THEN CASETYPE:=CONTYPE ELSE 60179000 T 0059 + CHECKTYPES(CASETYPE,CONTYPE); 60180000 T 0061 + GENID("T",TEMPVARNUM,2); GEN("=",1,7); GENINT(CONVAL); 60181000 T 0063 + NCASELABS:=NCASELABS+1; 60182000 T 0067 + IF NCASELABS0 THEN ERROR(19); 60219000 T 0027 + SKIP(DOSY); 60220000 T 0030 + IF CURSY≠DOSY THEN 60221000 T 0030 + BEGIN IF CURTYPE=0 THEN ERROR(19); 60222000 T 0031 + GO TO IF SYMKIND[CURSY]=INITIAL THEN STATM ELSE EXIT; 60223000 T 0034 + END; END; 60224000 T 0039 + GEN(" DO",4,5); 60225000 T 0039 + INSYMBOL; 60226000 T 0040 + STATM: STATEMENT; 60227000 T 0041 + EXIT: 60228000 T 0042 + END OF WHILESTAT; 60229000 T 0043 + 54 IS 49 LONG, NEXT SEG 2 + 60230000 T 0082 + 60231000 T 0082 + PROCEDURE REPEATSTAT; 60232000 T 0082 + BEGIN 60233000 T 0082 + INTEGER REPNUM; 60234000 T 0082 + START OF SEGMENT ********** 55 + LABEL NEWTRY; 60235000 T 0000 + 60236000 T 0000 + REPNUM:=NUMREPS:=NUMREPS+1; 60237000 T 0000 + MARGIN(" R",REPNUM); 60238000 T 0001 + GEN("DO",3,6); GEN("BEGIN",6,3); 60239000 T 0019 + DO BEGIN 60240000 T 0022 + INSYMBOL; 60241000 T 0023 + NEWTRY: STATEMENT; 60242000 T 0023 + GEN(";",1,7); 60243000 T 0024 + IF CURSY=ELSESY THEN BEGIN ERROR(20);INSYMBOL; GO NEWTRY END; 60244000 T 0026 + IF SYMKIND[CURSY]=INITIAL THEN BEGIN ERROR(21); GO NEWTRY END; 60245000 T 0032 + END UNTIL CURSY≠SEMICOLON; 60246000 T 0034 + IF CURSY≠UNTILSY THEN 60247000 T 0036 + BEGIN 60248000 T 0036 + ERROR(22); 60249000 T 0037 + WHILE CURSY≠UNTILSY AND SYMKIND[CURSY]≠INITIAL DO 60250000 T 0038 + BEGIN INSYMBOL; SKIP(UNTILSY) END; 60251000 T 0040 + IF CURSY≠UNTILSY THEN GO TO NEWTRY; 60252000 T 0042 + END; 60253000 T 0043 + GEN(" END",5,4); GEN("UNTIL",6,3); MARGIN(" U",REPNUM); 60254000 T 0043 + INSYMBOL; BOOLEXPR; 60255000 T 0064 + END OF REPEATSTAT; 60256000 T 0090 + 55 IS 93 LONG, NEXT SEG 2 + 60257000 T 0082 + 60258000 T 0082 + PROCEDURE FORSTAT; 60259000 T 0082 + BEGIN 60260000 T 0082 + INTEGER VARTYPE,VARNUM,LLIM,ULIM; 60261000 T 0082 + START OF SEGMENT ********** 56 + BOOLEAN DOWN; 60262000 T 0000 + LABEL STATM; 60263000 T 0000 + 60264000 T 0000 + GEN("BEGIN",6,3); 60265000 T 0000 + INSYMBOL; 60266000 T 0001 + IF CURSY=IDENTIFIER THEN 60267000 T 0002 + BEGIN 60268000 T 0002 + SEARCH; 60269000 T 0003 + IF FOUND THEN 60270000 T 0003 + BEGIN 60271000 T 0004 + VARNUM:=1000×THISLEVEL+THISINDEX; 60272000 T 0004 + IF THISID.IDCLASS=VAR OR 60273000 T 0006 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 60274000 T 0007 + BEGIN 60275000 T 0010 + IF THISLEVEL>1 AND THISLEVELCURLEVEL THEN ERROR(83); 60277000 T 0013 + VARTYPE:=THISID.TYPE; 60278000 T 0015 + IF TYPETAB1[VARTYPE].FORM≤CHAR THEN 60279000 T 0017 + BEGIN 60280000 T 0018 + LLIM:=TYPETAB2[VARTYPE]; ULIM:=TYPETAB3[VARTYPE]; 60281000 T 0019 + END ELSE BEGIN ERROR(12); VARTYPE:=0 END; 60282000 T 0021 + END ELSE ERROR(8); 60283000 T 0024 + END ELSE ERROR(1); 60284000 T 0025 + END ELSE ERROR(9); 60285000 T 0027 + INSYMBOL; 60286000 T 0028 + IF CURSY≠ASSIGNSY THEN 60287000 T 0028 + BEGIN ERROR(28); 60288000 T 0029 + SKIP(ASSIGNSY); 60289000 T 0030 + IF CURSY=ASSIGNSY THEN INSYMBOL ELSE 60290000 T 0031 + IF SYMKIND[CURSY]=INITIAL THEN GO TO STATM; 60291000 T 0033 + END ELSE INSYMBOL; 60292000 T 0035 + GENID("V",VARNUM,5); GEN("←",1,7); 60293000 T 0036 + IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 60294000 T 0039 + WRITEEXPR; 60295000 T 0042 + GEN(";",1,7); 60296000 T 0042 + IF VARTYPE=0 THEN VARTYPE:=CURTYPE ELSE CHECKTYPES(VARTYPE,CURTYPE); 60297000 T 0044 + NUMTEMPS:=NUMTEMPS+1; IF NUMTEMPS>MAXTEMPS THEN ERROR(16); 60298000 T 0047 + IF CURSY=TOSY THEN INSYMBOL ELSE 60299000 T 0050 + IF CURSY=DOWNTOSY THEN BEGIN DOWN:=TRUE; INSYMBOL END ELSE 60300000 T 0052 + BEGIN IF CURTYPE>0 THEN ERROR(23); 60301000 T 0055 + SKIP(TOSY); 60302000 T 0058 + IF CURSY=TOSY THEN INSYMBOL ELSE 60303000 T 0058 + BEGIN IF CURTYPE=0 THEN ERROR(23); 60304000 T 0060 + IF SYMKIND[CURSY]=INITIAL THEN GO TO STATM; 60305000 T 0063 + END; END; 60306000 T 0064 + GENID("T",NUMTEMPS,2); GEN("←",1,7); 60307000 T 0064 + IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 60308000 T 0067 + WRITEEXPR; 60309000 T 0070 + GEN(";",1,7); 60310000 T 0070 + IF VARTYPE=0 THEN VARTYPE:=CURTYPE ELSE CHECKTYPES(VARTYPE,CURTYPE); 60311000 T 0072 + IF CURSY≠DOSY THEN 60312000 T 0075 + BEGIN IF CURTYPE>0 THEN ERROR(19); 60313000 T 0076 + SKIP(DOSY); 60314000 T 0079 + IF CURSY=DOSY THEN INSYMBOL ELSE 60315000 T 0079 + IF CURTYPE=0 THEN ERROR(19); 60316000 T 0081 + END ELSE INSYMBOL; 60317000 T 0084 + GEN("FOR",4,5); GENID("V",VARNUM,5); GEN("←",1,7); 60318000 T 0085 + GENID("V",VARNUM,5); GEN(" ",1,7); 60319000 T 0089 + IF DOWN THEN GEN("DOWNTO",7,2) ELSE GEN("UPTO",5,4); 60320000 T 0092 + GENID("T",NUMTEMPS,2); GEN(" DO",4,5); 60321000 T 0099 + STATM: STATEMENT; 60322000 T 0102 + GEN(" END",5,4); 60323000 T 0103 + NUMTEMPS:=NUMTEMPS-1; 60324000 T 0105 + END OF FORSTAT; 60325000 T 0106 + 56 IS 113 LONG, NEXT SEG 2 + 60326000 T 0082 + 60327000 T 0082 + PROCEDURE GOTOSTAT; 60328000 T 0082 + BEGIN 60329000 T 0082 + INTEGER I; 60330000 T 0082 + START OF SEGMENT ********** 57 + INSYMBOL; 60331000 T 0000 + IF CURSY=INTCONST THEN 60332000 T 0000 + BEGIN I:=NUMLABS; 60333000 T 0001 + WHILE I≥1 AND LABTAB[I].LABVAL≠CURVAL DO I:=I-1; 60334000 T 0002 + IF I=0 THEN ERROR(15); 60335000 T 0007 + GEN("GO",3,6); GENID("L",CURVAL,4); 60336000 T 0009 + INSYMBOL; 60337000 T 0012 + END ELSE ERROR(10); 60338000 T 0013 + END OF GOTOSTAT; 60339000 T 0015 + 57 IS 18 LONG, NEXT SEG 2 + 60340000 T 0082 + 60341000 T 0082 + PROCEDURE WITHSTAT; 60342000 T 0082 + BEGIN 60343000 T 0082 + INTEGER STARTLEVEL,VERYFIRSTWITHSYM,I; 60344000 T 0082 + START OF SEGMENT ********** 58 + REAL D; 60345000 T 0000 + STARTLEVEL:=TOPLEVEL; VERYFIRSTWITHSYM:=NWITHSYMS; 60346000 T 0000 + EXPRLEVEL := 1; %002- 60346500 C 0001 + DO BEGIN 60347000 T 0002 + INSYMBOL; 60348000 T 0003 + IF CURSY=IDENTIFIER THEN 60349000 T 0003 + BEGIN 60350000 T 0004 + SEARCH; 60351000 T 0004 + IF FOUND THEN 60352000 T 0005 + BEGIN 60353000 T 0005 + IF THISID.IDCLASS=VAR OR %002- 60354000 P 0006 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN %%002- 60354500 C 0007 + BEGIN 60355000 T 0009 + VARIABLE; 60356000 T 0010 + IF CURTYPE>0 THEN 60357000 T 0010 + IF TYPETAB1[CURTYPE].FORM≠RECORD THEN ERROR(98); 60358000 T 0011 + IF SIMPLEVARIABLE THEN 60359000 T 0014 + BEGIN PUTSYM("["); INSIDEBRACKETS:=TRUE END; 60360000 T 0015 + IF TOPLEVELMAXWITHSYMS THEN ERROR(63) ELSE 60369000 T 0035 + FOR I:=1 STEP 1 UNTIL NUMSYMS DO 60370000 T 0037 + BEGIN 60371000 T 0039 + WITHTAB[NWITHSYMS]:=SYMTAB[I]; 60372000 T 0039 + NWITHSYMS:=NWITHSYMS+1; 60373000 T 0040 + END; 60374000 T 0041 + D.LASTWITHSYM:=NWITHSYMS-1; 60375000 T 0044 + DISPLAY[TOPLEVEL]:=D; 60376000 T 0046 + END ELSE ERROR(84); 60377000 T 0047 + END ELSE BEGIN ERROR(8); INSYMBOL END; 60378000 T 0048 + END ELSE BEGIN ERROR(1); INSYMBOL END; 60379000 T 0050 + END ELSE BEGIN ERROR(9); INSYMBOL END; 60380000 T 0052 + NUMSYMS:=0; 60381000 T 0054 + NUMPOINTERS := 0; 60382000 T 0054 + END UNTIL CURSY≠COMMA; 60383000 T 0055 + EXPRLEVEL := 0; %002- 60383500 C 0056 + IF CURSY≠DOSY THEN 60384000 T 0057 + BEGIN ERROR(19); SKIP(DOSY); 60385000 T 0058 + IF CURSY=DOSY THEN INSYMBOL; 60386000 T 0060 + END ELSE INSYMBOL; 60387000 T 0062 + STATEMENT; 60388000 T 0063 + TOPLEVEL:=STARTLEVEL; NWITHSYMS:=VERYFIRSTWITHSYM; 60389000 T 0063 + END OF WITHSTAT; 60390000 T 0065 + 58 IS 69 LONG, NEXT SEG 2 + 60391000 T 0082 + PROCEDURE ASSERTSTAT; %002- 60391100 C 0082 + BEGIN %002- 60391200 C 0082 + GEN("IF NOT(",7,1); %002- 60391400 C 0082 + INSYMBOL; BOOLEXPR; %002- 60391500 C 0083 + GEN(") THEN",7,2); GEN("RUNERR(",7,1); GEN("7,",2,6); %002- 60391600 C 0108 + GENINT(CARDCNT); GEN(")",1,7); %002- 60391700 C 0113 + END OF ASSERTSTAT; %002- 60391800 C 0115 + 60392000 T 0118 + PROCEDURE STATEMENT; 60393000 T 0118 + BEGIN 60394000 T 0118 + INTEGER I; 60395000 T 0118 + START OF SEGMENT ********** 59 + 60397000 T 0000 + IF CURSY=INTCONST THEN % *** LABELED STATEMENT *** 60398000 T 0000 + BEGIN LABEL LABFOUND; %700- 60399000 P 0000 + START OF SEGMENT ********** 60 + FOR I:=FIRSTLAB STEP 1 UNTIL NUMLABS DO 60400000 T 0000 + IF LABTAB[I].LABVAL=CURVAL THEN 60401000 T 0001 + BEGIN IF LABTAB[I].LABDEF=1 THEN ERROR(31); 60402000 T 0002 + LABTAB[I].LABDEF:=1; 60403000 T 0005 + GO TO LABFOUND; 60404000 T 0008 + END; 60405000 T 0008 + ERROR(15); 60406000 T 0011 + LABFOUND: GENID("L",CURVAL,4); GEN(":",1,7); 60407000 T 0011 + INSYMBOL; 60408000 T 0015 + IF CURSY≠COLON THEN 60409000 T 0015 + BEGIN ERROR(26); 60410000 T 0016 + SKIP(COLON); IF CURSY=COLON THEN INSYMBOL; 60411000 T 0017 + END ELSE INSYMBOL; 60412000 T 0020 + END; 60413000 T 0021 + 60 IS 22 LONG, NEXT SEG 59 + 60414000 T 0002 + COMMENT *** START OF STATEMENT *** ; 60415000 T 0002 + 60416000 T 0002 + IF CURSY=IDENTIFIER THEN 60417000 T 0002 + BEGIN 60418000 T 0002 + SEARCH; 60419000 T 0003 + IF FOUND THEN 60420000 T 0003 + BEGIN 60421000 T 0004 + IF THISID.IDCLASS=VAR OR 60422000 T 0004 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) OR %700- 60423000 P 0005 + THISID.IDCLASS=FUNC %700- 60423200 C 0008 + THEN ASSIGNMENT ELSE %700- 60424000 P 0009 + IF THISID.IDCLASS=PROC THEN 60425000 T 0010 + BEGIN 60426000 T 0012 + IF THISLEVEL=0 THEN % *** INTRINSIC PROCEDURE *** 60427000 T 0013 + BEGIN 60428000 T 0013 + IF CURNAME1="50WRITE" THEN PWRITE(FALSE) ELSE 60429000 T 0014 + IF CURNAME1="7WRITEL" AND 60430000 T 0016 + CURNAME2="000000N" THEN PWRITE(TRUE) ELSE 60431000 T 0018 + IF CURNAME1="400READ" THEN PREAD(FALSE) ELSE 60432000 T 0021 + IF CURNAME1="6READLN" THEN PREAD(TRUE) ELSE 60433000 T 0025 + IF CURNAME1="400PAGE" THEN FILEHANDLING(5) ELSE 60434000 T 0029 + IF CURNAME1="3000GET" THEN FILEHANDLING(2) ELSE 60435000 T 0033 + IF CURNAME1="3000PUT" THEN FILEHANDLING(1) ELSE 60436000 T 0037 + IF CURNAME1="50RESET" THEN FILEHANDLING(3) ELSE 60437000 T 0041 + IF CURNAME1="7REWRIT" AND 60438000 T 0045 + CURNAME2="000000E" THEN FILEHANDLING(4) ELSE 60439000 T 0047 + IF CURNAME1="3000NEW" THEN NEWDISP ELSE 60440000 T 0050 + IF CURNAME1="7DISPOS" AND 60441000 T 0053 + CURNAME2="000000E" THEN NEWDISP ELSE 60442000 T 0056 + IF CURNAME1="400PACK" THEN PACK ELSE 60443000 T 0058 + IF CURNAME1="6QQJZXL" THEN FILEHANDLING(6) ELSE %002- 60443500 C 0062 + IF CURNAME1="6UNPACK" THEN UNPACK ELSE ERROR(0); 60444000 T 0067 + END ELSE PASSPARAMS; 60445000 T 0073 + WRITEEXPR; 60446000 T 0074 + END ELSE BEGIN ERROR(13); SKIP(99) END; 60447000 T 0075 + END ELSE BEGIN ERROR(1); ASSIGNMENT END; 60448000 T 0077 + END OF IDENTIFIER ELSE 60449000 T 0079 + IF CURSY=BEGINSY THEN COMPSTAT ELSE 60450000 T 0079 + IF CURSY=IFSY THEN IFSTAT ELSE 60451000 T 0081 + IF CURSY=CASESY THEN CASESTAT ELSE 60452000 T 0083 + IF CURSY=WHILESY THEN WHILESTAT ELSE 60453000 T 0085 + IF CURSY=REPEATSY THEN REPEATSTAT ELSE 60454000 T 0088 + IF CURSY=FORSY THEN FORSTAT ELSE 60455000 T 0090 + IF CURSY=WITHSY THEN WITHSTAT ELSE 60456000 T 0092 + IF CURSY=GOTOSY THEN GOTOSTAT ELSE 60457000 T 0094 + IF CURSY=ASSERTSY THEN ASSERTSTAT ELSE %002- 60457500 C 0097 + IF SYMKIND[CURSY]≠TERMINAL THEN 60458000 T 0099 + BEGIN ERROR(13); INSYMBOL; SKIP(SEMICOLON) END; 60459000 T 0100 + END OF STATEMENT; 60460000 T 0103 + 59 IS 106 LONG, NEXT SEG 2 + + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 70001000 T 0118 + % % 70002000 T 0118 + % % 70003000 T 0118 + % % 70004000 T 0118 + % PART 7: TYPE DECLARATIONS. % 70005000 T 0118 + % ------------------ % 70006000 T 0118 + % % 70007000 T 0118 + % % 70008000 T 0118 + % % 70009000 T 0118 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 70010000 T 0118 + 70011000 T 0118 + 70012000 T 0118 + PROCEDURE FIELDLIST(RECTAB,FIRSTADDR,LASTADDR); 70017000 T 0118 + VALUE RECTAB,FIRSTADDR; %700- 70018000 P 0118 + INTEGER RECTAB,FIRSTADDR,LASTADDR; %700- 70019000 P 0118 + FORWARD; 70020000 T 0118 + 70021000 T 0118 + %700- 70035000 P 0118 + PROCEDURE TYPEDECL( TTYPE, TSIZE ); %***** TYPE DECLARATION ***** 70036000 P 0118 + INTEGER TTYPE, TSIZE; %**************************** 70037000 P 0118 + BEGIN %700- 70038000 P 0118 + INTEGER RECINX, ARRSTRUCT, TX, SX, T, N; REAL T1, T2, T3; %700- 70039000 P 0118 + START OF SEGMENT ********** 61 + BOOLEAN FIRST, PACKED; %700- 70040000 P 0000 + %700- 70041000 P 0000 + PROCEDURE TYPERR(ERRNUM,TTYPE,TSIZE); 70043000 T 0000 + VALUE ERRNUM; 70044000 T 0000 + INTEGER ERRNUM,TTYPE,TSIZE; 70045000 T 0000 + BEGIN ERROR(ERRNUM); 70046000 T 0000 + TTYPE:=TSIZE:=0; 70047000 T 0000 + END TYPERR; %700- 70048000 P 0002 + 70049000 T 0002 + PROCEDURE SUBRANGE; %*** SUBRANGE DECLARATION *** 70050000 P 0002 + BEGIN %**************************** 70051000 P 0002 + REAL VALX1, VALX2, T1; %700- 70052000 P 0002 + START OF SEGMENT ********** 62 + INTEGER TYPEX1, TYPEX2; %700- 70053000 C 0000 + %700- 70054000 C 0000 + CONSTANT(VALX1,TYPEX1); %700- 70055000 C 0000 + IF TYPETAB1[TYPEX1].FORM>CHAR THEN ERROR(11); %700- 70056000 C 0001 + IF CURSY≠DOUBLEDOT THEN ERROR(53); %700- 70057000 C 0003 + INSYMBOL; %700- 70058000 C 0005 + CONSTANT(VALX2,TYPEX2); %700- 70059000 C 0006 + IF TYPEX1>0 AND TYPEX2>0 THEN %700- 70060000 C 0007 + IF TYPEX1≠TYPEX2 THEN ERROR(11) ELSE %700- 70061000 C 0009 + IF VALX1>VALX2 THEN ERROR(54); %700- 70062000 C 0011 + IF (T1:=TYPETAB1[TYPEX1].FORM) = SYMBOLIC THEN T1:=SUBTYPE; %700- 70063000 C 0014 + NEWTYPE; TTYPE:=TYPEINDEX; %700- 70064000 C 0017 + T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; T1.MAINTYPE:=TYPEX1; %700- 70065000 C 0024 + TYPETAB1[TYPEINDEX]:=T1; %700- 70066000 C 0031 + TYPETAB2[TYPEINDEX]:=VALX1; TYPETAB3[TYPEINDEX]:=VALX2; %700- 70067000 C 0032 + END OF SUBRANGE; %700- 70068000 C 0035 + 62 IS 39 LONG, NEXT SEG 61 + %700- 70069000 C 0002 + PACKED:=FALSE; 70080000 T 0002 + IF CURSY=IDENTIFIER THEN %*** SIMPLE TYPE DECLARATION *** 70081000 T 0003 + BEGIN %******************************* 70082000 T 0004 + SEARCH; 70083000 T 0005 + IF FOUND THEN 70084000 T 0005 + BEGIN 70085000 T 0005 + IF THISID.IDCLASS=TYPES THEN 70086000 T 0006 + BEGIN 70087000 T 0007 + TTYPE:=THISID.TYPE; TSIZE:=TYPETAB1[TTYPE].SIZE; 70088000 T 0008 + INSYMBOL; 70089000 T 0011 + END ELSE IF THISID.IDCLASS=CONST THEN SUBRANGE 70090000 T 0011 + ELSE TYPERR(7,TTYPE,TSIZE); 70091000 T 0014 + END ELSE BEGIN TYPERR(1,TTYPE,TSIZE); INSYMBOL END; 70092000 T 0017 + END ELSE 70093000 T 0021 + IF CURSY≤CHARCONST OR CURSY=PLUS OR CURSY=MINUS THEN SUBRANGE ELSE 70094000 T 0021 + IF CURSY=LPAR THEN 70095000 T 0025 + BEGIN 70096000 T 0027 + N:=0; 70097000 T 0027 + NEWTYPE; T3.IDCLASS:=CONST; T3.TYPE:=TYPEINDEX; 70098000 T 0028 + DO BEGIN 70099000 T 0036 + INSYMBOL; 70100000 T 0037 + IF CURSY=IDENTIFIER THEN 70101000 T 0037 + BEGIN 70102000 T 0038 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); 70103000 T 0038 + T3.INFO:=N; NAMETAB3[CURLEVEL,THISINDEX]:=T3; 70104000 T 0040 + N:=N+1; INSYMBOL; 70105000 T 0043 + END ELSE ERROR(9); 70106000 T 0045 + END UNTIL CURSY≠COMMA; 70107000 T 0046 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 70108000 T 0048 + T1:=SYMBOLIC; T1.STRUCT:=0; 70109000 T 0050 + T1.SIZE:=TSIZE:=1; TTYPE:=TYPEINDEX; 70110000 T 0053 + TYPETAB1[TYPEINDEX]:=T1; 70111000 T 0056 + TYPETAB2[TYPEINDEX]:=0; TYPETAB3[TYPEINDEX]:=N-1; 70112000 T 0058 + IF CURSY=RPAR THEN INSYMBOL; 70113000 T 0061 + END ELSE 70114000 T 0062 + 70115000 T 0062 + IF CURSY=ARROW THEN %*** POINTER DECLARATION *** 70116000 T 0062 + BEGIN %*************************** 70117000 T 0064 + DEFINE DEC = POINTER #; %700- 70117100 C 0064 + START OF SEGMENT ********** 63 + INSYMBOL; 70118000 T 0000 + IF CURSY=IDENTIFIER THEN 70119000 T 0000 + BEGIN 70120000 T 0001 + NEWTYPE; TTYPE:=TYPEINDEX; T1:=POINTERS; 70121000 T 0001 + T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; 70122000 T 0008 + TYPETAB1[TYPEINDEX]:=T1; 70123000 T 0012 + SEARCH; 70124000 T 0014 + IF FOUND THEN 70125000 T 0014 + BEGIN 70126000 T 0014 + IF THISID.IDCLASS=TYPES THEN 70127000 T 0015 + TYPETAB1[TYPEINDEX].POINTTYPE:=THISID.TYPE ELSE 70128000 T 0016 + TYPERR(7,TTYPE,TSIZE); 70129000 T 0020 + END ELSE 70130000 T 0022 + BEGIN 70131000 T 0022 + IF NUMPNTRS0 THEN 70150000 T 0008 + BEGIN 70151000 T 0009 + IF TYPETAB1[TX].FORM>CHAR THEN ERROR(48); 70152000 T 0009 + T1:=ARRAYS; T1.INXTYPE:=TX; T1.ARRTYPE:=T; 70153000 T 0012 + T2:=TYPETAB2[TX]; T3:=TYPETAB3[TX]; 70154000 T 0016 + IF T3-T2>1022 THEN ERROR(61); 70155000 T 0018 + T1.SIZE:=MIN(1023,T3-T2+1); 70156000 T 0021 + NEWTYPE; 70157000 T 0026 + TYPETAB1[TYPEINDEX]:=T1; 70158000 T 0031 + TYPETAB2[TYPEINDEX]:=T2; TYPETAB3[TYPEINDEX]:=T3; 70159000 T 0032 + T:=TYPEINDEX; 70160000 T 0035 + END; 70161000 T 0035 + END UNTIL CURSY≠COMMA; 70162000 T 0035 + IF CURSY≠RBRACKET THEN ERROR(59) ELSE INSYMBOL; 70163000 T 0037 + IF CURSY≠OFSY THEN BEGIN ERROR(18); SKIP(OFSY) END; 70164000 T 0040 + INSYMBOL; 70165000 T 0042 + TYPEDECL(TX,SX); 70166000 T 0043 + IF TYPETAB1[TX].FORM≥FILES THEN ERROR(60); 70167000 T 0044 + ARRSTRUCT:=TYPETAB1[TX].STRUCT; 70168000 T 0047 + WHILE T>0 DO 70169000 T 0048 + BEGIN 70170000 T 0050 + T1:=TYPETAB1[T]; T3:=T1.ARRTYPE; 70171000 T 0050 + T1.ARRTYPE:=TX; T1.STRUCT:=ARRSTRUCT:=ARRSTRUCT+1; 70172000 T 0052 + T1.SIZE:=SX:=MIN(1024,SX×T1.SIZE); 70173000 T 0057 + TYPETAB1[T]:=T1; TX:=T; T:=T3; 70174000 T 0062 + END; 70175000 T 0065 + TTYPE:=TX; TSIZE:=SX; 70176000 T 0067 + END OF ARRAY DECLARATION ELSE 70177000 T 0069 + 64 IS 70 LONG, NEXT SEG 61 + 70178000 T 0070 + IF CURSY=FILESY THEN %*** FILE DECLARATION *** 70179000 T 0070 + BEGIN %************************ 70180000 T 0071 + DEFINE DEC = FILE #; %700- 70180100 C 0071 + START OF SEGMENT ********** 65 + INSYMBOL; 70181000 T 0000 + IF CURSY≠OFSY THEN 70182000 T 0000 + BEGIN ERROR(18); 70183000 T 0001 + IF CURSY≠IDENTIFIER THEN INSYMBOL; 70184000 T 0002 + END ELSE INSYMBOL; 70185000 T 0004 + TYPEDECL(TX,SX); 70186000 T 0005 + IF TX>0 THEN 70187000 T 0006 + BEGIN T:=TYPETAB1[TX]; 70188000 T 0007 + IF T.FORM≥FILES THEN ERROR(50) ELSE 70189000 T 0008 + IF T.STRUCT>1 THEN ERROR(49) 70190000 T 0011 + END; 70191000 T 0013 + NEWTYPE; TTYPE:=TYPEINDEX; 70192000 T 0014 + T1:=IF T.FORM=CHAR THEN TEXTFILE ELSE FILES; 70193000 T 0020 + T1.SIZE:=TSIZE:=SX; T1.FILETYPE:=TX; 70194000 T 0023 + T1.STRUCT:=1; 70195000 T 0027 + TYPETAB1[TYPEINDEX]:=T1; 70196000 T 0029 + END OF FILE DECLARATION ELSE 70197000 T 0030 + 65 IS 31 LONG, NEXT SEG 61 + 70198000 T 0073 + IF CURSY=SETSY THEN %*** SET DECLARATION *** 70199000 T 0073 + BEGIN %*********************** 70200000 T 0074 + DEFINE DEC = SET #; %700- 70200100 C 0074 + START OF SEGMENT ********** 66 + INSYMBOL; 70201000 T 0000 + IF CURSY≠OFSY THEN 70202000 T 0000 + BEGIN ERROR(18); 70203000 T 0001 + IF CURSY>CHARCONST THEN INSYMBOL; 70204000 T 0002 + END ELSE INSYMBOL; 70205000 T 0004 + TYPEDECL(TX,SX); 70206000 T 0005 + IF TX>0 THEN 70207000 T 0006 + BEGIN 70208000 T 0007 + IF TYPETAB1[TX].FORM>CHAR THEN ERROR(48) ELSE 70209000 T 0007 + IF TYPETAB2[TX] LSS 0 OR TYPETAB3[TX] GTR 93 THEN ERROR(51); 70210000 P 0010 + END; 70211000 T 0014 + NEWTYPE; TTYPE:=TYPEINDEX; 70212000 T 0014 + T1:=SET; T1.SETTYPE:=TX; T1.STRUCT:=0; 70213000 T 0020 + T1.SIZE := TSIZE := 2; TYPETAB1[TYPEINDEX] := T1; % %601- 70214000 P 0024 + TYPETAB2[TYPEINDEX]:=TYPETAB2[TX]; 70215000 T 0028 + TYPETAB3[TYPEINDEX]:=TYPETAB3[TX]; 70216000 T 0029 + END OF SET DECLARATION ELSE 70217000 T 0031 + 66 IS 32 LONG, NEXT SEG 61 + 70218000 T 0076 + IF CURSY=RECORDSY THEN %*** RECORD DECLARATION *** 70219000 T 0076 + BEGIN %************************** 70220000 T 0077 + DEFINE DEC = RECORD #; %700- 70220100 C 0077 + START OF SEGMENT ********** 67 + IF LASTREC-1>CURLEVEL THEN LASTREC:=LASTREC-1 ELSE ERROR(55); 70221000 T 0000 + RECINX:=LASTREC; 70222000 T 0004 + BLOCKTAB[RECINX]:=NUMBLOCKS:=NUMBLOCKS+1; 70223000 T 0005 + INSYMBOL; 70224000 T 0007 + FIELDLIST(RECINX,0,SX); 70225000 T 0007 + IF SX>1022 THEN BEGIN ERROR(56); SX:=1022 END; 70226000 T 0009 + NEWTYPE; TTYPE:=TYPEINDEX; 70227000 T 0011 + T1:=RECORD; T1.RECTAB:=RECINX; T1.STRUCT:=1; 70228000 T 0017 + T1.SIZE:=TSIZE:=SX; TYPETAB1[TYPEINDEX]:=T1; 70229000 T 0022 + TYPETAB2[TYPEINDEX]:=0; TYPETAB3[TYPEINDEX]:=SX-1; 70230000 T 0025 + IF CURSY≠ENDSY THEN BEGIN ERROR(24); SKIP(ENDSY) END; 70231000 T 0028 + IF CURSY=ENDSY THEN INSYMBOL; 70232000 T 0031 + END ELSE BEGIN ERROR(4); SKIP(99) END; 70233000 T 0033 + 67 IS 34 LONG, NEXT SEG 61 + END; 70234000 T 0081 + END OF TYPEDECL; 70235000 T 0081 + 61 IS 90 LONG, NEXT SEG 2 + 70236000 T 0118 + 70237000 T 0118 + PROCEDURE FIELDLIST(RECTAB,FIRSTADDR,LASTADDR); 70238000 T 0118 + VALUE RECTAB,FIRSTADDR; 70239000 T 0118 + INTEGER RECTAB,FIRSTADDR,LASTADDR; 70240000 T 0118 + BEGIN 70241000 T 0118 + INTEGER ARRAY ILIST[0:LISTLENGTH]; 70242000 T 0118 + START OF SEGMENT ********** 68 + INTEGER LISTINX; 70243000 T 0001 + INTEGER CASETYPE,ADDR,MAXADDR,INDEX,CTYPE,TX,SX, T3,LLIM,ULIM,I; 70244000 P 0001 + BOOLEAN FIRST; 70245000 T 0001 + REAL T1, CVAL; %503- 70246000 P 0001 + LABEL CASEPART, EXIT; %700- 70247000 P 0001 + 70248000 T 0001 + ADDR:=FIRSTADDR; 70249000 T 0001 + DO BEGIN 70250000 T 0002 + WHILE CURSY=SEMICOLON DO INSYMBOL; 70251000 T 0003 + IF CURSY=CASESY THEN GO TO CASEPART; 70252000 T 0005 + IF CURSY=IDENTIFIER THEN 70253000 T 0006 + BEGIN 70254000 T 0007 + LISTINX:=0; FIRST:=TRUE; 70255000 T 0007 + DO BEGIN 70256000 T 0009 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 70257000 T 0010 + IF CURSY=IDENTIFIER THEN 70258000 T 0012 + BEGIN 70259000 T 0013 + IF LISTINX≥LISTLENGTH THEN BEGIN ERROR(37); LISTINX:=0 END; 70260000 T 0013 + LISTINX:=LISTINX+1; 70261000 T 0016 + NEWNAME(CURNAME1,CURNAME2,RECTAB); 70262000 T 0017 + ILIST[LISTINX]:=THISINDEX; 70263000 T 0019 + INSYMBOL; 70264000 T 0020 + END ELSE 70265000 T 0020 + BEGIN ERROR(9); 70266000 T 0020 + IF CURSY≠COMMA THEN INSYMBOL; 70267000 T 0022 + END; 70268000 T 0023 + END UNTIL CURSY≠COMMA; 70269000 T 0023 + IF CURSY≠COLON THEN BEGIN ERROR(26); SKIP(COLON) END; 70270000 T 0025 + INSYMBOL; 70271000 T 0027 + TYPEDECL(TX,SX); 70272000 T 0028 + IF TX>0 THEN IF TYPETAB1[TX].FORM≥FILES THEN ERROR(57); 70273000 T 0029 + T3.IDCLASS:=VAR; T3.TYPE:=TX; 70274000 T 0033 + FOR I:=1 STEP 1 UNTIL LISTINX DO 70275000 T 0036 + BEGIN 70276000 T 0038 + T3.INFO:=ADDR; ADDR:=MIN(ADDR+SX,1024); 70277000 T 0038 + NAMETAB3[RECTAB,ILIST[I]]:=T3; 70278000 T 0043 + END; 70279000 T 0045 + END; 70280000 T 0047 + END UNTIL CURSY≠SEMICOLON; 70281000 T 0047 + LASTADDR:=ADDR; 70282000 T 0049 + GO TO EXIT; 70283000 T 0050 + 70284000 T 0052 + CASEPART: 70285000 T 0052 + BEGIN DEFINE DEC = VARIANT #; %700- 70285100 C 0052 + START OF SEGMENT ********** 69 + LABEL CASETYPEID; %700- 70285200 C 0000 + LISTINX:=0; LASTADDR:=ADDR; INDEX:=-1; 70286000 T 0000 + INSYMBOL; 70287000 T 0002 + IF CURSY=IDENTIFIER THEN 70288000 T 0003 + BEGIN 70289000 T 0004 + SEARCH; 70290000 T 0004 + IF FOUND AND THISID.IDCLASS=TYPES THEN GO TO CASETYPEID; 70291000 T 0005 + NEWNAME(CURNAME1,CURNAME2,RECTAB); INDEX:=THISINDEX; 70292000 T 0007 + INSYMBOL; 70293000 T 0009 + IF CURSY≠COLON THEN ERROR(26); 70294000 T 0010 + INSYMBOL; 70295000 T 0012 + IF CURSY=IDENTIFIER THEN 70296000 T 0012 + BEGIN 70297000 T 0013 + SEARCH; 70298000 T 0013 + IF FOUND THEN 70299000 T 0014 + BEGIN 70300000 T 0014 + IF THISID.IDCLASS=TYPES THEN 70301000 T 0015 + BEGIN 70302000 T 0016 + CASETYPEID: CASETYPE:=THISID.TYPE; T1:=TYPETAB1[CASETYPE]; 70303000 T 0016 + LLIM:=TYPETAB2[CASETYPE]; ULIM:=TYPETAB3[CASETYPE]; 70304000 T 0019 + IF T1.FORM>CHAR THEN ERROR(48); 70305000 T 0021 + IF INDEX≥0 THEN 70306000 T 0023 + BEGIN 70307000 T 0024 + T3.IDCLASS:=VAR; T3.TYPE:=CASETYPE; T3.INFO:=ADDR; 70308000 T 0025 + ADDR:=LASTADDR:=ADDR+1; NAMETAB3[RECTAB,INDEX]:=T3; 70309000 T 0030 + END; 70310000 T 0034 + INSYMBOL; 70311000 T 0034 + END ELSE BEGIN ERROR(7); SKIP(OFSY) END; 70312000 T 0034 + END ELSE BEGIN ERROR(1); SKIP(OFSY) END; 70313000 T 0036 + END ELSE BEGIN ERROR(9); SKIP(OFSY) END; 70314000 T 0038 + END ELSE BEGIN ERROR(9); SKIP(OFSY) END; 70315000 T 0040 + IF CURSY≠OFSY THEN BEGIN ERROR(18); SKIP(RPAR) END; 70316000 T 0042 + IF CURSY=OFSY THEN INSYMBOL; 70317000 T 0045 + IF CASETYPE=0 THEN BEGIN LLIM:=-MAXINT; ULIM:=MAXINT END; 70318000 T 0047 + DO BEGIN 70319000 T 0050 + WHILE CURSY=SEMICOLON DO INSYMBOL; 70320000 T 0051 + IF CURSY≤CHARCONST OR CURSY=PLUS OR CURSY=MINUS THEN 70321000 T 0055 + BEGIN 70322000 T 0057 + FIRST:=TRUE; 70323000 T 0058 + DO BEGIN 70324000 T 0059 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 70325000 T 0059 + CONSTANT(CVAL,CTYPE); 70326000 T 0061 + IF CTYPE>0 THEN 70327000 T 0062 + BEGIN 70328000 T 0063 + IF CASETYPE=0 THEN CASETYPE:=CTYPE ELSE 70329000 T 0063 + IF CVALULIM THEN ERROR(14) ELSE 70330000 T 0065 + CHECKTYPES(CASETYPE,CTYPE); 70331000 T 0069 + IF LISTINX≥LISTLENGTH THEN BEGIN ERROR(30); LISTINX:=0 END; 70332000 T 0070 + LISTINX:=LISTINX+1; 70333000 T 0073 + ILIST[LISTINX]:=CVAL; I:=1; 70334000 T 0074 + WHILE ILIST[I]≠CVAL DO I:=I+1; 70335000 T 0076 + IF ILASTADDR THEN LASTADDR:=MAXADDR; 70344000 T 0091 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 70345000 T 0093 + INSYMBOL; 70346000 T 0096 + END ELSE ERROR(58); 70347000 T 0096 + END; 70348000 T 0097 + END UNTIL CURSY NEQ SEMICOLON; % 70349000 T 0097 + END; %700- 70349100 C 0099 + 69 IS 100 LONG, NEXT SEG 68 + EXIT: 70350000 T 0053 + END OF FIELDLIST; 70351000 T 0053 + 68 IS 61 LONG, NEXT SEG 2 + + + + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 80001000 T 0118 + % % 80002000 T 0118 + % % 80003000 T 0118 + % % 80004000 T 0118 + % PART 8: THE PROCEDURE BLOCK. % 80005000 T 0118 + % -------------------- % 80006000 T 0118 + % % 80007000 T 0118 + % % 80008000 T 0118 + % % 80009000 T 0118 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 80010000 T 0118 + 80011000 T 0118 + 80012000 T 0118 + 80013000 T 0118 + PROCEDURE DECLAREVARS(PARAM,TAB,FIRST,LAST,LEVEL); 80014000 T 0118 + VALUE PARAM,FIRST,LAST,LEVEL; 80015000 T 0118 + INTEGER ARRAY TAB[0]; 80016000 T 0118 + INTEGER FIRST,LAST,LEVEL; 80017000 T 0118 + BOOLEAN PARAM; 80018000 T 0118 + BEGIN 80019000 T 0118 + INTEGER LEVEL1000, TYP, NAM, NAMTAB, I, J, RECSIZE; %503- 80020000 P 0118 + START OF SEGMENT ********** 70 + BOOLEAN REALVAR,ARRAYVAR,FIRSTDIM,EXTFILE; 80021000 T 0000 + ALPHA T1, FNAME; %503- 80022000 P 0000 + INTEGER FNLENGTH,FNSTART; % 80023000 T 0000 + 80024000 T 0000 + LEVEL1000:=LEVEL×1000; 80025000 T 0000 + FOR I:=FIRST STEP 1 UNTIL LAST DO 80026000 T 0001 + BEGIN 80027000 T 0002 + NAM:=TAB[I].[9:10]; NAMTAB:=NAMETAB3[LEVEL,NAM]; 80028000 T 0002 + TYP:=NAMTAB.TYPE; T1:=TYPETAB1[TYP]; 80029000 T 0005 + IF NAMTAB.IDCLASS GEQ FUNC THEN 80030000 T 0007 + BEGIN 80031000 T 0008 + IF REALVAR OR ARRAYVAR THEN 80032000 T 0009 + BEGIN 80033000 T 0010 + GEN(";",1,7); 80034000 T 0010 + REALVAR:=ARRAYVAR:=FALSE; 80035000 T 0012 + END; 80036000 T 0013 + IF NAMTAB.IDCLASS=FUNC THEN GEN("FUNCTN",7,2) % %600- 80037000 P 0013 + ELSE GEN("PROCEDU",8,1); % %600- 80038000 P 0016 + GENID("V",LEVEL1000+NAM,5); GEN(";",1,7); 80039000 T 0019 + END ELSE 80040000 T 0023 + IF T1.STRUCT=0 THEN %*** SIMPLE TYPE *** 80041000 T 0023 + BEGIN 80042000 T 0026 + IF ARRAYVAR THEN BEGIN GEN(";",1,7); ARRAYVAR:=FALSE END; 80043000 T 0026 + IF REALVAR THEN GEN(",",1,7) ELSE 80044000 T 0029 + BEGIN GEN("REAL",5,4); REALVAR:=TRUE END; 80045000 T 0032 + GENID("V",LEVEL1000+NAM,5); 80046000 T 0034 + IF T1.FORM=SET THEN % %601- 80046200 C 0036 + BEGIN % %601- 80046400 C 0038 + GEN(",",1,7); GENID("W",LEVEL1000+NAM,5); % %601- 80046600 C 0038 + END; % %601- 80046800 C 0042 + END ELSE 80047000 T 0042 + BEGIN 80048000 T 0042 + IF REALVAR THEN BEGIN GEN(";",1,7); REALVAR:=FALSE END; 80049000 T 0044 + IF T1.FORM9 THEN 100 ELSE 8006453 C 0107 + 10)+PASSSUBRANGE+1,IF PASSSUBRANGE>9 THEN 7 ELSE 6); 80064535 C 0107 + PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE]; 80064540 C 0115 + END; %518- 80064545 C 0116 + GEN("]#;",3,5); %518- 80064550 C 0117 + END; %518- 80064555 C 0118 + PASSSUBRANGE := FIRSTRANGE; %518- 80064560 C 0118 + FIRSTDIM := TRUE; GEN("ARRAY",6,3); GENID("H",LEVEL1000+NAM,5); 80064565 C 0119 + GEN("[",1,7); %518- 80064570 C 0123 + WHILE PASSSUBRANGE ≠ STOPPERSUBTAB DO %518- 80064575 C 0125 + BEGIN %518- 80064580 C 0127 + IF MAXPERMTAB LEQ MAXTOTALSUBSCRS AND PARAM THEN %518- 80064585 C 0127 + BEGIN %518- 80064590 C 0128 + ARRSUBPERMTAB[ARRNAM,MAXPERMTAB] := %518- 80064595 C 0129 + IF FIRSTDIM THEN NAM ELSE -1; %518- 80064600 C 0130 + ARRSUBPERMTAB[PERMSUB,MAXPERMTAB] := PASSSUBRANGE; %518- 80064605 C 0132 + MAXPERMTAB := MAXPERMTAB + 1; %518- 80064610 C 0134 + END %518- 80064615 C 0136 + ELSE %518- 80064620 C 0136 + BEGIN %518- 80064625 C 0136 + IF MAXPERMTAB > MAXTOTALSUBSCRS THEN ERROR(0); %518- 80064630 C 0139 + END; %518- 80064640 C 0141 + IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE GEN(",",1,7); %518- 80064645 C 0141 + GENINT(ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE]); %518- 80064650 C 0144 + IF NOT PARAM THEN %518- 80064655 C 0146 + BEGIN %518- 80064660 C 0146 + GEN(":",1,7); %518- 80064665 C 0147 + GENINT(ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE]); %518- 80064670 C 0148 + END; %518- 80064675 C 0150 + PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE]; %518- 80064680 C 0150 + END; %518- 80064685 C 0152 + IF T1.FORM=SET THEN % %601- 80064700 C 0152 + BEGIN % %601- 80064750 C 0154 + GEN(",0",2,6); % %601- 80064800 C 0154 + IF NOT PARAM THEN GEN(":1",2,6); % %601- 80064850 C 0156 + END; % %601- 80064900 C 0158 + GEN("]",1,7); %518- 80064950 C 0158 + END ELSE 80065000 T 0160 + 71 IS 164 LONG, NEXT SEG 70 + BEGIN %*** FILE *** 80066000 T 0050 + DEFINE DEC = FILE #; %700- 80066100 C 0050 + START OF SEGMENT ********** 72 + IF REALVAR OR ARRAYVAR THEN 80067000 T 0000 + BEGIN GEN(";",1,7); REALVAR:=ARRAYVAR:=FALSE END; 80068000 T 0000 + IF T1.FORM=TEXTFILE AND NOT PARAM THEN 80069000 T 0004 + BEGIN 80070000 T 0006 + IF NUMFILES≥MAXFILES THEN ERROR(97) 80071000 T 0006 + ELSE NUMFILES:=NUMFILES+1; 80072000 T 0008 + FILETAB[NUMFILES]:=NAM; 80073000 T 0010 + END; 80074000 T 0011 + EXTFILE:=FALSE; 80075000 T 0011 + FNAME:=NAMETAB1[LEVEL,NAM]; 80076000 T 0012 + FNLENGTH := FNAME.NAMELENGTH; FNSTART := 8-FNLENGTH; % 80077000 T 0014 + IF FNLENGTH LEQ 6 THEN % 80078000 T 0016 + BEGIN 80079000 T 0017 + FOR J:=1 STEP 1 UNTIL NUMEXTFILES DO 80080000 T 0017 + IF FNAME=EXTFILETAB[J] THEN EXTFILE:=TRUE; 80081000 T 0019 + END; 80082000 T 0023 + IF EXTFILE AND NOT PARAM THEN 80083000 T 0023 + BEGIN 80084000 T 0024 + IF NUMFILES GEQ MAXFILES THEN ERROR(97) 80085000 T 0025 + ELSE 80086000 T 0026 + NUMFILES := NUMFILES + 1; 80087000 T 0027 + FILETAB[NUMFILES] := -NAM - 1; 80088000 T 0028 + GEN("DEFINE",7,2); GENID("F",LEVEL1000+NAM,5); 80089000 T 0030 + GEN("=",1,7); 80090000 T 0034 + GEN(FNAME,FNLENGTH,FNSTART); % 80091000 T 0035 + GEN("#;",2,6); GEN("SAVE",5,4); GEN("FILE",5,4); 80092000 T 0037 + GEN(FNAME,FNLENGTH,FNSTART); % 80093000 T 0041 + END ELSE 80094000 T 0043 + BEGIN 80095000 T 0043 + GEN("FILE",5,4); GENID("F",LEVEL1000+NAM,5); 80096000 T 0047 + END; 80097000 T 0050 + IF NOT PARAM THEN 80098000 T 0050 + BEGIN 80099000 T 0051 + GEN(" DISK",6,3); GEN("SERIAL",7,2); 80100000 T 0051 + IF EXTFILE THEN 80101000 T 0054 + BEGIN 80102000 T 0054 + IF ALGOLCNT LSS 14 THEN WRITEALGOL; %517- 80103000 P 0055 + GEN("[0:0]",5,3); 80104000 T 0057 + GEN(""",1,7); 80105000 T 0058 + GEN(FNAME,FNLENGTH,FNSTART); % 80106000 T 0060 + GEN(""/",2,6); %700- 80107000 P 0061 + IF ALGOLCNT<9 THEN WRITEALGOL; 80108000 T 0063 + GEN(""",1,7); GEN(USER,7,1); GEN(""",1,7); 80109000 T 0064 + END ELSE 80110000 T 0069 + BEGIN 80111000 T 0069 + GEN("[20:",4,4); GEN("300]",4,4); 80112000 T 0075 + END; 80113000 T 0078 + GEN("(1,",3,5); 80114000 T 0078 + RECSIZE:=IF T1.FORM=TEXTFILE THEN 10 ELSE 80115000 T 0079 + IF TYPETAB1[T1.FILETYPE].STRUCT=0 THEN 1 ELSE 80116000 T 0082 + TYPETAB3[T1.FILETYPE]-TYPETAB2[T1.FILETYPE]+1; 80117000 T 0085 + GENINT(RECSIZE); GEN(",",1,7); 80118000 T 0088 + IF RECSIZE=1 OR RECSIZE=10 THEN GENINT(30) %703- 80119000 P 0090 + ELSE GENINT(RECSIZE); 80120000 T 0093 + IF ALGOLCNT LSS 10 THEN WRITEALGOL; 80121000 T 0098 + GEN(",SAVE",6,3); %703- 80122000 P 0100 + GEN("30);", 4,4); %703- 80123000 P 0102 + END ELSE GEN(";",1,7); 80124000 T 0103 + GEN("ARRAY",6,3); GENID("V",LEVEL1000+NAM,5); 80125000 T 0107 + GEN("[",1,7); 80126000 T 0111 + IF TYPETAB1[T1.FILETYPE].STRUCT=0 THEN 80127000 T 0112 + BEGIN 80128000 T 0114 + IF PARAM THEN GEN("0",1,7) ELSE BEGIN %002- 80129000 P 0115 + GEN("0:",2,6); %002- 80129100 C 0119 + GENINT(RECSIZE-1); %002- 80129200 C 0120 + END %002- 80129300 C 0121 + END ELSE 80130000 T 0121 + BEGIN 80131000 T 0121 + GENINT(TYPETAB2[T1.FILETYPE]); 80132000 T 0122 + IF NOT PARAM THEN 80133000 T 0123 + BEGIN GEN(":",1,7); GENINT(TYPETAB3[T1.FILETYPE]) END; 80134000 T 0124 + END; 80135000 T 0127 + GEN("];",2,6); 80136000 T 0127 + GEN("INTEGER",8,1); GENID("I",LEVEL1000+NAM,5); 80137000 T 0129 + GEN(";",1,7); 80138000 T 0132 + END; 80139000 T 0134 + 72 IS 137 LONG, NEXT SEG 70 + END; 80140000 T 0051 + END OF LOOP; 80141000 T 0051 + IF REALVAR OR ARRAYVAR THEN GEN(";",1,7); 80142000 T 0053 + END OF DECLAREVARS; 80143000 T 0056 + 70 IS 65 LONG, NEXT SEG 2 + 80144000 T 0118 + 80145000 T 0118 + PROCEDURE PARAMETERLIST; 80146000 T 0118 + BEGIN 80147000 T 0118 + INTEGER FIRSTPARAM, CURKIND, P1, PX, I, T3; REAL T; %503- 80148000 P 0118 + START OF SEGMENT ********** 73 + BOOLEAN FIRST; 80149000 T 0000 + 80150000 T 0000 + DEFINE NEWPARAM= 80151000 T 0000 + BEGIN 80152000 T 0000 + IF NUMPARAMS≥MAXPARAMS THEN 80153000 T 0000 + BEGIN ERROR(70); NUMPARAMS:=MAXPARAMS-10 END; 80154000 T 0000 + NUMPARAMS:=NUMPARAMS+1; 80155000 T 0000 + END OF NEWPARAM#; 80156000 T 0000 + 80157000 T 0000 + NEWPARAM; FIRSTPARAM:=NUMPARAMS; 80158000 T 0000 + IF CURSY=LPAR THEN 80159000 T 0005 + BEGIN 80160000 T 0006 + DO BEGIN 80161000 T 0006 + INSYMBOL; 80162000 T 0007 + IF CURSY=VARSY OR CURSY=FUNCSY OR CURSY=PROCSY THEN 80163000 T 0007 + BEGIN 80164000 T 0010 + CURKIND:=IF CURSY=VARSY THEN VAR ELSE 80165000 T 0010 + IF CURSY=FUNCSY THEN FUNC ELSE PROC; 80166000 T 0012 + INSYMBOL; 80167000 T 0015 + END ELSE CURKIND:=CONST; 80168000 T 0016 + FIRST:=TRUE; P1:=NUMPARAMS+1; 80169000 T 0017 + DO BEGIN 80170000 T 0019 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 80171000 T 0020 + IF CURSY=IDENTIFIER THEN 80172000 T 0022 + BEGIN 80173000 T 0023 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL+1); 80174000 T 0023 + PX:=THISINDEX; PX.PARAMKIND:=CURKIND; 80175000 T 0025 + PX.PARAMLEVEL:=CURLEVEL+1; 80176000 T 0028 + NEWPARAM; PARAMTAB[NUMPARAMS]:=PX; 80177000 T 0030 + FORWPARAM1[NUMPARAMS] := CURNAME1; %002- 80177500 C 0036 + FORWPARAM2[NUMPARAMS] := CURNAME2; %002- 80177600 C 0037 + END ELSE ERROR(9); 80178000 T 0038 + INSYMBOL; 80179000 T 0039 + END UNTIL CURSY≠COMMA; 80180000 T 0040 + IF CURSY=COLON THEN 80181000 T 0041 + BEGIN 80182000 T 0042 + IF CURKIND=PROC THEN ERROR(90); 80183000 T 0042 + INSYMBOL; 80184000 T 0044 + IF CURSY=IDENTIFIER THEN 80185000 T 0045 + BEGIN 80186000 T 0046 + SEARCH; 80187000 T 0046 + IF FOUND THEN 80188000 T 0047 + BEGIN 80189000 T 0047 + IF THISID.IDCLASS=TYPES THEN 80190000 T 0047 + BEGIN 80191000 T 0049 + T3:=THISID.TYPE; 80192000 T 0049 + FOR I:=P1 STEP 1 UNTIL NUMPARAMS DO 80193000 T 0050 + PARAMTAB[I].PARAMTYPE:=T3; 80194000 T 0052 + IF CURKIND=CONST OR CURKIND=VAR THEN 80195000 T 0056 + BEGIN 80196000 T 0058 + T:=TYPETAB1[T3]; 80197000 T 0059 + IF T.FORM≥FILES THEN 80198000 T 0060 + FOR I:=P1 STEP 1 UNTIL NUMPARAMS DO 80199000 T 0061 + PARAMTAB[I].PARAMFILE:=1; 80200000 T 0063 + IF T.STRUCT>0 AND CURKIND=CONST THEN ERROR(94); 80201000 T 0067 + END ELSE IF T.STRUCT>0 THEN ERROR(38); 80202000 T 0071 + END ELSE BEGIN ERROR(7); T3:=0 END; 80203000 T 0074 + END ELSE BEGIN ERROR(1); T3:=0 END; 80204000 T 0076 + END ELSE BEGIN ERROR(9); T3:=0 END; 80205000 T 0078 + INSYMBOL; 80206000 T 0080 + END ELSE 80207000 T 0080 + BEGIN 80208000 T 0080 + IF CURKIND≠PROC THEN ERROR(7); 80209000 T 0081 + T3:=0; 80210000 T 0083 + END; 80211000 T 0084 + T3.IDCLASS:=CURKIND; T3.FORMAL:=1; 80212000 T 0084 + FOR I:=P1 STEP 1 UNTIL NUMPARAMS DO 80213000 T 0087 + NAMETAB3[CURLEVEL+1,PARAMTAB[I].PARAMNAME]:=T3; 80214000 T 0089 + END UNTIL CURSY≠SEMICOLON; 80215000 T 0094 + IF CURSY≠RPAR THEN 80216000 T 0095 + BEGIN ERROR(49); SKIP(RPAR); 80217000 T 0096 + IF CURSY=RPAR THEN INSYMBOL; 80218000 T 0098 + END ELSE INSYMBOL; 80219000 T 0100 + END; 80220000 T 0101 + PARAMTAB[FIRSTPARAM]:=NUMPARAMS-FIRSTPARAM; 80221000 T 0101 + END OF PARAMETERLIST; 80222000 T 0103 + 73 IS 108 LONG, NEXT SEG 2 + 80223000 T 0118 + 80400000 T 0118 + PROCEDURE BLOCK; 80401000 T 0118 + BEGIN 80402000 T 0118 + INTEGER INDEX, CTYPE, NUMFORWARDS,TX, I; % %800- 80403000 P 0118 + START OF SEGMENT ********** 74 + ALPHA T3; %002- 80403500 C 0000 + REAL T, CVAL; %503- 80404000 P 0000 + ALPHA C1,C2; 80405000 T 0000 + BOOLEAN VALUEPARAMS,FUN; 80406000 T 0000 + LABEL START; 80407000 T 0000 + 80408000 T 0000 + INTEGER LABTABTOP,CONSTTABTOP,TYPETABTOP,PARAMTABTOP,TOPREC, 80409000 T 0000 + FORMERFIRSTLAB,FIRSTFILE; 80410000 T 0000 + 80411000 T 0000 + FORMERFIRSTLAB:=FIRSTLAB; 80412000 T 0000 + LABTABTOP:=NUMLABS; FIRSTLAB:=LABTABTOP+1; 80413000 T 0000 + CONSTTABTOP:=NUMCONSTS; 80414000 T 0002 + TYPETABTOP:=NUMTYPES; 80415000 T 0003 + PARAMTABTOP:=NUMPARAMS; 80416000 T 0004 + TOPREC:=LASTREC; 80417000 T 0005 + FIRSTFILE:=NUMFILES+1; 80418000 T 0005 + 80419000 T 0007 + TOPLEVEL:=CURLEVEL; 80420000 T 0007 + MARGIN("+P",CURLEVEL); % MARK PROCEDURE LEVEL %712- 80420100 C 0007 + IF CURLEVEL > 1 THEN %518- 80421010 C 0025 + BEGIN %518- 80421020 C 0026 + INTEGER NAMOFTHING,DIFF; %518- 80421030 C 0026 + START OF SEGMENT ********** 75 + BOOLEAN FIRSTTIME; %518- 80421040 C 0000 + GEN("BEGIN",6,3); %518- 80421050 C 0000 + IF MAXPERMTAB > 0 THEN %518- 80421060 C 0001 + BEGIN %518- 80421070 C 0002 + PASSPERMTAB := 0; %518- 80421080 C 0002 + DO %518- 80421090 C 0003 + BEGIN %518- 80421100 C 0004 + REMEMBERPOSN := PASSPERMTAB; %518- 80421110 C 0004 + GEN("DEFINE",7,2); %518- 80421120 C 0004 + NAMOFTHING := ARRSUBPERMTAB[ARRNAM,PASSPERMTAB]; %518- 80421130 C 0006 + GENID("V",1000×CURLEVEL+NAMOFTHING,5); %518- 80421140 C 0008 + GEN("[",1,7); %518- 80421150 C 0010 + FIRSTTIME := TRUE; %518- 80421160 C 0012 + DO %518- 80421170 C 0012 + BEGIN %518- 80421180 C 0013 + IF FIRSTTIME THEN FIRSTTIME := FALSE ELSE GEN(",",1 80421190 C 0013 + ,7); 80421200 C 0014 + DIFF := PASSPERMTAB-REMEMBERPOSN+1; %518- 80421210 C 0018 + GENID("V",(1000+CURLEVEL+NAMOFTHING)×(IF DIFF>9 THEN 100 ELSE 80421220 C 0020 + 10)+DIFF,(IF DIFF > 9 THEN 7 ELSE 6)); %518- 80421230 C 0020 + PASSPERMTAB := PASSPERMTAB + 1; END %518- 80421270 C 0027 + UNTIL PASSPERMTAB = MAXPERMTAB OR %518- 80421280 C 0029 + ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ≠ -1; %518- 80421290 C 0029 + GEN("]",1,7); %518- 80421300 C 0032 + GEN("=",1,7); %518- 80421310 C 0034 + GENID("H",1000×CURLEVEL+NAMOFTHING,5); %518- 80421320 C 0035 + GEN("[",1,7); %518- 80421340 C 0038 + PASSPERMTAB := REMEMBERPOSN; FIRSTTIME := TRUE; %518- 80421350 C 0039 + DO %518- 80421360 C 0041 + BEGIN %518- 80421370 C 0041 + IF FIRSTTIME THEN FIRSTTIME := FALSE ELSE GEN(",", 80421380 C 0041 + 1,7); 80421390 C 0042 + DIFF := ARRSUBPERMTAB[PERMSUB,PASSPERMTAB]+1; %518- 80421400 C 0044 + GENID("V",(1000×CURLEVEL+NAMOFTHING)×(IF DIFF>9 THEN 80421410 C 0046 + 100 ELSE 10)+DIFF,(IF DIFF>9 THEN 7 ELSE 6)); 80421420 C 0046 + PASSPERMTAB := PASSPERMTAB +1; %518- 80421430 C 0054 + END %518- 80421440 C 0055 + UNTIL PASSPERMTAB = MAXPERMTAB OR %518- 80421450 C 0055 + ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ≠ -1; %518- 80421460 C 0056 + GEN("]#;",3,5); %518- 80421470 C 0059 + END %518- 80421480 C 0060 + UNTIL PASSPERMTAB = MAXPERMTAB; %518- 80421490 C 0060 + MAXPERMTAB := 0; %518- 80421500 C 0061 + END %518- 80421510 C 0062 + END; %518- 80421520 C 0062 + 75 IS 64 LONG, NEXT SEG 74 + START: 80422000 T 0029 + IF CURSY=LABELSY THEN %*** LABEL DECLARATION *** 80423000 T 0029 + BEGIN %************************* 80424000 T 0029 + DEFINE DEC = LABEL #; %700- 80424100 C 0030 + START OF SEGMENT ********** 76 + GEN("LABEL",6,3); 80425000 T 0000 + DO BEGIN 80426000 T 0001 + INSYMBOL; 80427000 T 0002 + IF CURSY=INTCONST THEN 80428000 T 0002 + BEGIN 80429000 T 0003 + GENID("L",CURVAL,4); 80430000 T 0003 + IF CURVAL>9999 THEN ERROR(33); 80431000 T 0005 + FOR I:=FIRSTLAB STEP 1 UNTIL NUMLABS DO 80432000 T 0007 + IF LABTAB[I].LABVAL=CURVAL THEN ERROR(31); 80433000 T 0010 + IF NUMLABS≥MAXLABS THEN BEGIN ERROR(34); NUMLABS:=0 END; 80434000 T 0015 + NUMLABS:=NUMLABS+1; 80435000 T 0017 + LABTAB[NUMLABS]:=CURVAL; 80436000 T 0019 + INSYMBOL; 80437000 T 0020 + END ELSE BEGIN ERROR(10); SKIP(COMMA) END; 80438000 T 0020 + IF CURSY=COMMA THEN GEN(",",1,7); 80439000 T 0022 + END UNTIL CURSY≠COMMA; 80440000 T 0025 + IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80441000 T 0026 + GEN(";",1,7); 80442000 T 0029 + IF SYMKIND[CURSY]≠INITIAL THEN INSYMBOL; 80443000 T 0031 + END OF LABEL DECLARATION; 80444000 T 0033 + 76 IS 34 LONG, NEXT SEG 74 + 80445000 T 0031 + IF CURSY=CONSTSY THEN %*** CONSTANT DECLARATION *** 80446000 T 0031 + BEGIN %**************************** 80447000 T 0031 + LABEL LL1; % %002- 80447010 C 0032 + START OF SEGMENT ********** 77 + DEFINE DEC = CONST #; %700- 80447100 C 0000 + INSYMBOL; 80448000 T 0000 + DO BEGIN 80449000 T 0000 + IF CURSY=IDENTIFIER THEN 80450000 T 0001 + BEGIN 80451000 T 0001 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80452000 T 0002 + INSYMBOL; 80453000 T 0004 + IF CURSY=EQLSY THEN 80454000 T 0004 + BEGIN 80455000 T 0005 + INSYMBOL; CONSTANT(CVAL,CTYPE); 80456000 T 0006 + T3:=CTYPE; T3.IDCLASS:=CONST; 80457000 T 0007 + IF CVAL.[46:8]≠0 OR CVAL>1023 THEN 80458000 T 0010 + BEGIN 80459000 T 0012 + IF NUMCONSTS≥MAXCONSTS THEN 80460000 T 0012 + BEGIN ERROR(35); NUMCONSTS:=0 END; 80461000 T 0013 + NUMCONSTS:=NUMCONSTS+1; 80462000 T 0015 + CONSTTAB[NUMCONSTS]:=CVAL; 80463000 T 0016 + T3.INFO:=1023+NUMCONSTS; 80464000 T 0018 + END ELSE T3.INFO:=CVAL; 80465000 T 0020 + NAMETAB3[CURLEVEL,INDEX]:=T3; 80466000 T 0022 + END ELSE BEGIN ERROR(36); SKIP(SEMICOLON) END; 80467000 T 0024 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80468000 T 0026 + IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80469000 T 0028 + IF SYMKIND[CURSY]≠INITIAL THEN INSYMBOL; 80470000 T 0031 + END UNTIL CURSY≠IDENTIFIER; 80471000 T 0033 + END OF CONSTANT DECLARATION; 80472000 T 0034 + 77 IS 35 LONG, NEXT SEG 74 + 80473000 T 0033 + IF CURSY=TYPESY THEN %*** TYPE DECLARATION **** 80474000 T 0033 + BEGIN %************************* 80475000 T 0033 + DEFINE DEC = TYPE #; %700- 80475100 C 0034 + START OF SEGMENT ********** 78 + INSYMBOL; 80476000 T 0000 + DO BEGIN 80477000 T 0000 + IF CURSY=IDENTIFIER THEN 80478000 T 0001 + BEGIN 80479000 T 0001 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80480000 T 0002 + INSYMBOL; 80481000 T 0004 + IF CURSY=EQLSY THEN 80482000 T 0004 + BEGIN 80483000 T 0005 + INSYMBOL; 80484000 T 0006 + TYPEDECL(CTYPE,TX); 80485000 T 0006 + T3:=CTYPE; T3.IDCLASS:=TYPES; 80486000 T 0007 + NAMETAB3[CURLEVEL,INDEX]:=T3; 80487000 T 0010 + END ELSE BEGIN ERROR(36); SKIP(SEMICOLON) END; 80488000 T 0012 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80489000 T 0014 + IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80490000 T 0016 + IF SYMKIND[CURSY]≠INITIAL THEN INSYMBOL; 80491000 T 0018 + END UNTIL CURSY≠IDENTIFIER; 80492000 T 0020 + END OF TYPE DECLARATION; 80493000 T 0022 + 78 IS 23 LONG, NEXT SEG 74 + 80494000 T 0035 + IF CURSY=VARSY THEN %*** VARIABLE DECLARATION *** 80495000 T 0035 + BEGIN %**************************** 80496000 T 0035 + LABEL LL2; % %002- 80496010 C 0036 + START OF SEGMENT ********** 79 + DEFINE DEC = VAR #; %700- 80496100 C 0000 + VARINDEX:=0; 80497000 T 0000 + DO BEGIN 80498000 T 0000 + FIRSTVAR:=VARINDEX+1; 80499000 T 0001 + DO BEGIN 80500000 T 0002 + IF CURSY=VARSY OR CURSY=COMMA THEN INSYMBOL; 80501000 T 0003 + IF CURSY=IDENTIFIER THEN 80502000 T 0005 + BEGIN 80503000 T 0006 + IF VARINDEX≥LISTLENGTH THEN 80504000 T 0007 + BEGIN ERROR(37); VARINDEX:=0 END; 80505000 T 0007 + VARINDEX:=VARINDEX+1; 80506000 T 0009 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); 80507000 T 0011 + VARLIST[VARINDEX]:=THISINDEX; 80508000 T 0012 + INSYMBOL; 80509000 T 0013 + END ELSE BEGIN ERROR(9); SKIP(COLON) END; 80510000 T 0014 + END UNTIL CURSY≠COMMA; 80511000 T 0016 + IF CURSY≠COLON THEN BEGIN ERROR(26); SKIP(COLON) END; 80512000 T 0017 + IF CURSY=COLON THEN 80513000 T 0020 + BEGIN 80514000 T 0020 + INSYMBOL; 80515000 T 0021 + TYPEDECL(CTYPE,TX); 80516000 T 0021 + T3:=CTYPE; T3.IDCLASS:=VAR; 80517000 T 0022 + FOR I:=FIRSTVAR STEP 1 UNTIL VARINDEX DO 80518000 T 0025 + NAMETAB3[CURLEVEL,VARLIST[I]]:=T3; 80519000 T 0026 + END ELSE BEGIN ERROR(26); SKIP(SEMICOLON) END; 80520000 T 0030 + IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80521000 T 0032 + IF SYMKIND[CURSY]≠INITIAL THEN INSYMBOL; 80522000 T 0035 + END UNTIL CURSY≠IDENTIFIER; 80523000 T 0037 + DECLAREVARS(FALSE,VARLIST,1,VARINDEX,CURLEVEL); 80524000 T 0038 + END OF VARIABLE DECLARATIONS; 80525000 T 0040 + 79 IS 42 LONG, NEXT SEG 74 + 80526000 T 0037 + IF NUMPNTRS>0 THEN 80527000 T 0037 + BEGIN 80528000 T 0037 + C1:=CURNAME1; C2:=CURNAME2; 80529000 T 0038 + FOR I:=1 STEP 1 UNTIL NUMPNTRS DO 80530000 T 0039 + BEGIN 80531000 T 0041 + CURNAME1:=PNTRTAB1[I]; CURNAME2:=PNTRTAB2[I]; 80532000 T 0041 + SEARCHTAB(CURLEVEL); 80533000 T 0043 + THISID:=NAMETAB3[CURLEVEL,THISINDEX]; 80534000 T 0043 + IF FOUND AND THISID.IDCLASS=TYPES THEN 80535000 T 0045 + TYPETAB1[PNTRTAB3[I]].POINTTYPE:=THISID.TYPE ELSE ERROR(62); 80536000 T 0047 + END; 80537000 T 0052 + CURNAME1:=C1; CURNAME2:=C2; NUMPNTRS:=0; 80538000 T 0054 + END; 80539000 T 0056 + 80540000 T 0056 + IF CURSY=FUNCSY OR CURSY=PROCSY % %700- 80540900 C 0056 + THEN BEGIN DEFINE DEC = CODE #; %700- 80540910 C 0057 + START OF SEGMENT ********** 80 + WHILE CURSY=FUNCSY OR CURSY=PROCSY DO %*** PROC/FUNC DECLARATION *** 80541000 T 0000 + BEGIN %***************************** 80542000 T 0002 + LABEL LL3; % %002- 80542010 C 0002 + START OF SEGMENT ********** 81 + FUN:=CURSY=FUNCSY; INSYMBOL; 80543000 T 0000 + IF CURLEVEL GEQ MAXTABLES THEN ERROR(101) ELSE %002- 80543500 C 0001 + BLOCKTAB[CURLEVEL+1] := NUMBLOCKS := NUMBLOCKS + 1; %002- 80543600 C 0003 + IF CURSY=IDENTIFIER THEN 80544000 T 0007 + BEGIN 80545000 T 0007 + SEARCHTAB(CURLEVEL); 80546000 T 0008 + THISID:=NAMETAB3[CURLEVEL,THISINDEX]; 80547000 T 0009 + IF FOUND AND (THISID.IDCLASS=PROC OR THISID.IDCLASS=FUNC) THEN %600- 80548000 P 0010 + BEGIN 80549000 T 0014 + INDEX:=THISINDEX; 80550000 T 0014 + IF THISID.FORWARDDEF=1 THEN 80551000 T 0015 + BEGIN 80552000 T 0016 + NAMETAB3[CURLEVEL,THISINDEX].FORWARDDEF:=0; %504- 80553000 P 0017 + NUMFORWARDS:=NUMFORWARDS-1; 80554000 T 0020 + T := NAMETAB3[CURLEVEL,THISINDEX].INFO; %002- 80554500 C 0021 + TX := T + PARAMTAB[T]; %002- 80554600 C 0023 + FOR I:=T+1 STEP 1 UNTIL TX DO %002- 80554700 C 0025 + NEWNAME(FORWPARAM1[I],FORWPARAM2[I],CURLEVEL+1); %002- 80554800 C 0029 + IF(THISID.IDCLASS=PROC AND FUN)OR 80555000 T 0032 + (THISID.IDCLASS=FUNC AND NOT FUN) THEN ERROR(43); %504- 80555100 C 0034 + TX:=(T:=THISID.INFO)+PARAMTAB[T]; % UNMARK FORWARD PARMS 80556000 P 0037 + FOR I:=T+1 STEP 1 UNTIL TX DO % TO ALLOW REFERENCE 80557000 C 0040 + BEGIN T3:=PARAMTAB[I].PARAMNAME; %504- 80558000 C 0044 + CURNAME1:=ABS(NAMETAB1[CURLEVEL+1,T3]); %504- 80559000 C 0045 + CURNAME2:= NAMETAB2[CURLEVEL+1,T3]; %504- 80560000 C 0048 + NAMETAB1[CURLEVEL+1,T3]:=0; %504- 80561000 C 0050 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL+1); %504- 80562000 C 0053 + IF T3≠THISINDEX THEN BEGIN %504- 80563000 C 0054 + PARAMTAB[I].PARAMNAME:=THISINDEX; %504- 80564000 C 0056 + NAMETAB3[CURLEVEL+1,THISINDEX] := %504- 80565000 C 0058 + NAMETAB3[CURLEVEL+1,T3]; %504- 80565010 C 0060 + END END; % OF UNMARKING FORWARD PARAMETERS. %504- 80566000 C 0062 + INSYMBOL; 80567000 T 0063 + END ELSE BEGIN ERROR(2); SKIP(SEMICOLON) END; 80568000 T 0063 + END ELSE 80569000 T 0065 + BEGIN 80570000 T 0065 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80571000 T 0066 + T3:=0; T3.INFO:=NUMPARAMS+1; 80572000 T 0068 + T3.IDCLASS:=IF FUN THEN FUNC ELSE PROC; 80573000 T 0071 + NAMETAB3[CURLEVEL,INDEX]:=T3; 80574000 T 0074 + INSYMBOL; PARAMETERLIST; 80575000 T 0076 + IF CURSY=COLON THEN 80576000 T 0077 + BEGIN 80577000 T 0078 + IF NOT FUN THEN ERROR(48); 80578000 T 0078 + INSYMBOL; 80579000 T 0080 + IF CURSY=IDENTIFIER THEN 80580000 T 0080 + BEGIN 80581000 T 0081 + SEARCH; 80582000 T 0082 + IF FOUND THEN 80583000 T 0082 + BEGIN 80584000 T 0082 + IF THISID.IDCLASS=TYPES THEN 80585000 T 0083 + BEGIN 80586000 T 0084 + T:=TYPETAB1[THISID.TYPE]; 80587000 T 0085 + IF T.FORM≤ALFA OR T.FORM=POINTERS THEN 80588000 T 0086 + BEGIN 80589000 T 0089 + NAMETAB3[CURLEVEL,INDEX].TYPE:=THISID.TYPE; 80590000 T 0089 + END ELSE ERROR(38); 80591000 T 0093 + END ELSE ERROR(7); 80592000 T 0094 + END ELSE ERROR(1); 80593000 T 0096 + END ELSE ERROR(9); 80594000 T 0097 + INSYMBOL; 80595000 T 0098 + END ELSE IF FUN THEN 80596000 T 0099 + BEGIN ERROR(26); SKIP(SEMICOLON) END; 80597000 T 0099 + END; 80598000 T 0101 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80599000 T 0101 + IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80600000 T 0103 + IF FUN THEN GEN("FUNCTN",7,2) ELSE 80601000 T 0106 + GEN("PROCEDU",8,1); GENID("V",1000×CURLEVEL+INDEX,5); 80602000 T 0108 + T:=NAMETAB3[CURLEVEL,INDEX].INFO; TX:=T+PARAMTAB[T]; 80603000 T 0115 + IF TX>T THEN 80604000 T 0118 + BEGIN 80605000 T 0119 + GEN("(",1,7); 80606000 T 0120 + FOR I:=T+1 STEP 1 UNTIL TX DO 80607000 T 0121 + BEGIN %518- 80608010 C 0125 + BEGIN %518- 80608020 C 0125 + INTEGER NAM,T1,SCRATCH; %518- 80608030 C 0125 + START OF SEGMENT ********** 82 + NAM := PARAMTAB[I].[9:10]; %518- 80608040 C 0000 + SCRATCH := NAMETAB3[CURLEVEL+1,NAM]; %518- 80608050 C 0001 + SCRATCH := SCRATCH.TYPE; %518- 80608060 C 0003 + T1 := TYPETAB1[SCRATCH]; %518- 80608070 C 0005 + IF T1.STRUCT ≠ 0 AND T1.FORM < FILES THEN %518- 80608080 C 0006 + GENID("H",1000×(CURLEVEL+1)+NAM,5) %518- 80608090 C 0008 + ELSE %518- 80608100 C 0012 + BEGIN % %601- 80608105 C 0012 + GENID("V",1000×(CURLEVEL+1)+NAM,5); %518- 80608110 C 0012 + IF T1.FORM=SET THEN % %601- 80608111 C 0015 + BEGIN % %601- 80608113 C 0017 + GEN(",",1,7); % %601- 80608115 C 0017 + GENID("W",1000×(CURLEVEL+1)+NAM,5); % %601- 80608117 C 0019 + END; %601- 80608118 C 0022 + END; % %601- 80608119 C 0022 + END; %518- 80608120 C 0022 + 82 IS 23 LONG, NEXT SEG 81 + IF BOOLEAN(PARAMTAB[I].PARAMFILE) THEN 80609000 T 0128 + BEGIN 80610000 T 0129 + GEN(",",1,7); 80611000 T 0129 + GENID("F",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80612000 T 0131 + GEN(",",1,7); 80613000 T 0134 + GENID("I",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80614000 T 0136 + END; 80615000 T 0140 + IF I LSS TX THEN GEN(",",1,7); 80616000 T 0140 + END; 80617000 T 0142 + GEN(");",2,6); 80618000 T 0143 + VALUEPARAMS:=FALSE; 80619000 T 0144 + FOR I:=T+1 STEP 1 UNTIL TX DO 80620000 T 0145 + IF PARAMTAB[I].PARAMKIND=CONST THEN 80621000 T 0149 + BEGIN 80622000 T 0151 + IF NOT VALUEPARAMS THEN 80623000 T 0151 + BEGIN GEN("VALUE",6,3); 80624000 T 0152 + VALUEPARAMS:=TRUE; 80625000 T 0154 + END ELSE GEN(",",1,7); 80626000 T 0155 + GENID("V",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80627000 T 0159 + IF TYPETAB1[NAMETAB3[CURLEVEL+1,PARAMTAB[I].PARAMNAME].TYPE 80627200 C 0163 + ].FORM=SET %601- 80627205 C 0165 + THEN BEGIN % %601- 80627400 C 0167 + GEN(",",1,7); % %601- 80627600 C 0168 + GENID("W",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME 80627800 C 0169 + ,5); % %601- 80627801 C 0169 + END; %601- 80627850 C 0173 + END; 80628000 T 0173 + IF VALUEPARAMS THEN GEN(";",1,7); 80629000 T 0173 + DECLAREVARS(TRUE,PARAMTAB,T+1,TX,CURLEVEL+1); 80630000 T 0176 + END ELSE GEN(";",1,7); 80631000 T 0179 + 80632000 T 0181 + INSYMBOL; 80633000 T 0181 + IF CURNAME1="7FORWAR" AND CURNAME2="D" THEN 80634000 T 0181 + BEGIN 80635000 T 0183 + NAMETAB3[CURLEVEL,INDEX].FORWARDDEF:=1; 80636000 T 0184 + TX:=(T:=NAMETAB3[CURLEVEL,INDEX].INFO)+PARAMTAB[T]; %504- 80636100 C 0187 + FOR I:=T+1 STEP 1 UNTIL TX DO % MARK FORWARD PARAMETERS 80636200 C 0190 + NAMETAB1[CURLEVEL+1,PARAMTAB[I].PARAMNAME].[46:1] := 1; 80636210 C 0195 + NUMFORWARDS:=NUMFORWARDS+1; 80637000 T 0201 + REPLACE POINTER(NAMETAB1[CURLEVEL+1,*]) BY 0 %002- 80637500 C 0202 + FOR MAXNAMES+1 WORDS; %002- 80637600 C 0205 + GEN("FORWARD",8,1); 80638000 T 0208 + INSYMBOL; 80639000 T 0209 + END ELSE 80640000 T 0210 + BEGIN 80641000 T 0210 + CURLEVEL:=CURLEVEL+1; 80642000 T 0212 + IF CURLEVEL GEQ LASTREC THEN ERROR(101); % %002- 80643000 P 0213 + BLOCKTAB[CURLEVEL]:=NUMBLOCKS:=NUMBLOCKS+1; 80644000 T 0215 + TX:=CURFUNC; CURFUNC:=IF FUN THEN INDEX ELSE -1; %504- 80645000 P 0217 + BLOCK; %*** COMPILE PROCEDURE BODY *** 80646000 P 0220 + FOR I:=0 STEP 1 UNTIL MAXNAMES DO % LEAVE FORWARD PARAMETERS 80647000 P 0221 + IF NAMETAB1[CURLEVEL,I]>0 THEN NAMETAB1[CURLEVEL,I]:=0; 80648000 P 0222 + CURLEVEL:=CURLEVEL-1; CURFUNC:=TX; %504- 80649000 P 0228 + TOPLEVEL:=CURLEVEL; 80650000 T 0230 + END; 80651000 T 0231 + IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80652000 T 0231 + GEN(";",1,7); 80653000 T 0234 + IF SYMKIND[CURSY]≠INITIAL THEN INSYMBOL; 80654000 T 0235 + END OF PROCEDURE DECLARATION; 80655000 T 0237 + 81 IS 238 LONG, NEXT SEG 80 + 80656000 T 0003 + 80657000 T 0003 + IF NUMFORWARDS>0 THEN ERROR(44); 80658000 T 0003 + END OF SEGMENT FOR PROCEDURE DECLARATIONS; %700- 80658100 C 0005 + 80 IS 6 LONG, NEXT SEG 74 + GEN("INTEGER",8,1); 80659000 T 0060 + FOR I:=1 STEP 1 UNTIL MAXTEMPS DO 80660000 T 0061 + BEGIN GENID("T",I,2); 80661000 T 0064 + IF I1 THEN GEN("END",4,5); 80703000 T 0159 + END OF BLOCK; 80704000 T 0162 + 74 IS 173 LONG, NEXT SEG 2 + + + + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90001000 T 0118 + % % 90002000 T 0118 + % % 90003000 T 0118 + % % 90004000 T 0118 + % PART 9: THE MAIN PROGRAM. % 90005000 T 0118 + % ----------------- % 90006000 T 0118 + % % 90007000 T 0118 + % % 90008000 T 0118 + % % 90009000 T 0118 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90010000 T 0118 + 90011000 T 0118 + 90012000 T 0118 + INTEGER PROGNAMELENGTH; % %800- 90013900 C 0118 + ALPHA PROGNAME,ALGOLNAME; 90014000 T 0118 + % %002- 90014100 C 0118 + % %002- 90014200 C 0118 + SAVEFACTOR:=0;% * DEFAULT ZIP IS COMPILE AND GO UNLESS %002- 90014300 C 0118 + % * CHANGED BY THE USE OF THE "S" OPTION %002- 90014400 C 0118 + % %002- 90014500 C 0118 + % %002- 90014600 C 0118 + 90015000 T 0118 + CH[0] := "PASC000"; CHARPNT := POINTER(CH[0])+5; %711- 90016000 P 0118 + PASCALGOL.FID := USER := TIME(-1); %711- 90017000 P 0125 + DO BEGIN C:=C+1; REPLACE CHARPNT BY C FOR 3 DIGITS; %711- 90018000 P 0129 + PASCALGOL.MFID := ALGOLNAME := CH[0]; %711- 90019000 P 0133 + SEARCHDISKDIRECTORY( PASCALGOL, LINES[*] ); %711- 90020000 P 0137 + END UNTIL LINES[0]=-1; % FILE NOT ON DISK %711- 90021000 P 0139 + WRITE(PASCALGOL,MERGE); % ALGOL MUST COMPILE PRELUDE FIRST %704- 90022000 P 0140 + CARDLENGTH:=72; 90033000 T 0143 + C := " "; % TO INITIALIZE "INSYMBOL" %709- 90034000 P 0144 + INITIALIZE; % COMPILER TABLES, NEWCARD, INSYMBOL %709- 90035000 P 0145 + IF CURSY=PROGRAMSY THEN 90037000 T 0145 + BEGIN 90038000 T 0146 + INSYMBOL; 90039000 T 0147 + IF CURSY=IDENTIFIER THEN 90040000 T 0147 + BEGIN 90041000 T 0148 + PROGNAME := IF CURLENGTH < 7 %705- 90042000 P 0148 + THEN " "&CURNAME1[41:6×CURLENGTH-1:6×CURLENGTH] 90042010 C 0149 + ELSE CURNAME2.[5:6]&CURNAME1[41:35:36]; %705- 90042020 C 0154 + % %002- 90042100 C 0157 + % THE FOLLOWING LINES ADD A "0" ONTO THE FRONT OF THE PROGRAM NAME OR 90042200 C 0157 + % THE FIRST SIX CHARACTERS THEREOF IF IT IS LONGER THAN SIX CHARACTERS 90042300 C 0157 + % THUS GIVING THE NAME OF THE XALGOL OBJECT CODE FILE PRODUCED. %002- 90042400 C 0157 + % %002- 90042500 C 0157 + PROGNAME := CURNAME1.[35:36]; PROGNAMELENGTH := MIN(6,CURLENGTH)+1; 90042600 C 0157 + % %002- 90042700 C 0161 + % %002- 90042800 C 0162 + INSYMBOL; 90043000 T 0162 + IF CURSY=LPAR THEN 90044000 T 0162 + BEGIN 90045000 T 0163 + DO BEGIN 90046000 T 0163 + INSYMBOL; 90047000 T 0164 + IF CURSY=IDENTIFIER THEN 90048000 T 0164 + BEGIN 90049000 T 0165 + IF CURNAME1="50INPUT" THEN INPUTDECL:=TRUE ELSE 90050000 T 0165 + IF CURNAME1="6OUTPUT" THEN OUTPUTDECL:=TRUE ELSE 90051000 T 0167 + BEGIN 90052000 T 0176 + IF CURLENGTH>6 THEN ERROR(77); 90053000 T 0178 + NUMEXTFILES:=NUMEXTFILES+1; 90054000 T 0180 + IF NUMEXTFILES≤MAXEXTFILES THEN 90055000 T 0181 + EXTFILETAB[NUMEXTFILES]:=CURNAME1 ELSE 90056000 T 0182 + IF NUMEXTFILES=MAXEXTFILES+1 THEN ERROR(73); 90057000 T 0183 + END; 90058000 T 0186 + END ELSE ERROR(9); 90059000 T 0186 + INSYMBOL; 90060000 T 0188 + END UNTIL CURSY≠COMMA; 90061000 T 0188 + IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(SEMICOLON) END; 90062000 T 0189 + IF CURSY=RPAR THEN INSYMBOL; 90063000 T 0192 + IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 90064000 T 0194 + END ELSE BEGIN ERROR(58); SKIP(SEMICOLON) END; 90065000 T 0197 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 90066000 T 0199 + END ELSE BEGIN ERROR(75); SKIP(SEMICOLON) END; 90067000 T 0201 + INSYMBOL; 90068000 T 0203 + CURLEVEL:=1; 90069000 T 0203 + LASTREC:=MAXTABLES+1; 90070000 T 0204 + MAXPERMTAB := 0; %518- 90070100 C 0205 + INSIDEPARENS := FALSE; %518- 90070200 C 0206 + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90071000 T 0207 + % % 90072000 T 0207 + BLOCK; % COMPILE USER PROGRAM. % 90073000 T 0207 + % % 90074000 T 0207 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90075000 T 0207 + IF CURSY≠DOT THEN 90076000 T 0207 + BEGIN 90077000 T 0208 + ERROR(76); 90078000 T 0208 + DO BLOCK UNTIL CURSY=DOT; 90079000 T 0209 + END; 90080000 T 0211 + IF FALSE THEN 90081000 T 0211 + BEGIN 90082000 T 0212 + ENDOFINPUT: ERROR(87); CHARCNT:=-1; 90083000 T 0212 + WRITE(LINE, TERMMESS); %708- 90084000 P 0214 + END; 90085000 T 0217 + IF LISTOPTION AND CHARCNT≥0 THEN PRINTLINE; 90086000 T 0217 + IF ERRINX>0 THEN PRINTERRORS; 90087000 T 0220 + IF PAGECNT > 0 % THERE HAS BEEN SOME LISTING %709- 90088000 P 0221 + THEN BEGIN WRITE( LINE[DBL] ); WRITE( LINE[DBL] ) END; %709- 90089000 P 0222 + IF NUMERRS=0 THEN 90090000 T 0231 + BEGIN% %002- 90090400 C 0231 + WRITE(LINE ,NOERRORS);% %002- 90090500 C 0232 + IF ERR(100) % %800- 90090600 C 0235 + THEN WRITE(LINE ,ERROR100MESS);% %002- 90090700 C 0239 + IF ERR(102) THEN %713- 90090710 C 0243 + WRITE(LINE,ERROR102MESS); %713- 90090720 C 0247 + IF SAVEFACTOR≥0 THEN% *A ZIP IS REQUIRED %002- 90090800 C 0250 + BEGIN 90091000 T 0251 + ARRAY ZIPARRAY[0:19], Z[0:0]; 90092000 T 0252 + START OF SEGMENT ********** 83 + POINTER ZIPPNT; 90093000 T 0005 + 90094000 T 0005 + DEFINE PPROGNAME = 13 #, PALGOLNAME = 14 #, %705- 90095000 P 0005 + PLIBRARY = 15 #, PUSER = 16 #, %705- 90096000 P 0005 + P(P1) = POINTER(ZIPARRAY[P1])+1 FOR 7 #; %705- 90097000 P 0005 + 90105000 T 0005 + WRITEALGOL; 90106000 T 0005 + WRITE(PASCALGOL,LASTLINE); 90107000 T 0005 + LOCK(PASCALGOL,SAVE); 90108000 T 0008 + ZIPARRAY[PPROGNAME]:=PROGNAME; ZIPARRAY[PALGOLNAME]:=ALGOLNAME; 90112000 P 0010 + ZIPARRAY[PLIBRARY]:= IF SAVEFACTOR>0 THEN "LIBRARY" ELSE %705- 90113000 P 0012 + IF SAVEFACTOR<0 THEN " SYNTAX" ELSE " & RUN "; 90114000 P 0015 + ZIPARRAY[PUSER]:=USER; %705- 90115000 P 0018 + REPLACE POINTER(ZIPARRAY[*]) BY "CC COMPILE ", %705- 90116000 P 0019 + P(PPROGNAME), "/", P(PUSER), %705- 90117000 P 0025 + " XALGOL ", P(PLIBRARY), %705- 90118000 P 0041 + "; ALGOL FILE TAPE=PASCRUN/DISK SERIAL; ALGOL FILE CARD=", %800- 90119000 P 0052 + P(PALGOLNAME),"/",P(PUSER)," SERIAL;", % %800- 90120000 P 0056 + " XALGOL STACK = 2048; END."; % %800- 90120500 C 0077 + ZIP WITH ZIPARRAY[*]; 90129000 T 0080 + END% %002- 90129500 C 0082 + END OF COMPILER ZIP ELSE 90130000 T 0082 + 83 IS 88 LONG, NEXT SEG 2 + BEGIN 91001000 T 0253 + INTEGER I; 91002000 T 0253 + START OF SEGMENT ********** 84 + SWITCH FORMAT ERRORMESS1 := 91003000 T 0000 + START OF SEGMENT ********** 85 + (" 0 *** COMPILER ERROR *** CONTACT THE COMPUTER CENTRE."), 91004000 T 0000 + (" 1 IDENTIFIER NOT DEFINED."), 91005000 T 0000 + (" 2 IDENTIFIER ALREADY DEFINED."), 91006000 T 0000 + (" 3 WRONG NUMBER OF PARAMETERS."), 91007000 T 0000 + (" 4 SYNTAX ERROR."), 91008000 T 0000 + (" 5 FUNCTION NAME NOT ACCESSIBLE AT THIS LEVEL."), %511- 91009000 P 0000 + (" 6 STRINGS MAY NOT BE CONTINUED FROM ONE CARD TO ANOTHER."), 91010000 T 0000 + (" 7 A TYPE EXPECTED."), 91011000 T 0000 + (" 8 VARIABLE EXPECTED."), 91012000 T 0000 + (" 9 IDENTIFIER EXPECTED."), 91013000 T 0000 + (" 10 INTEGER CONSTANT EXPECTED."), 91014000 T 0000 + (" 11 CONSTANT OF OTHER TYPE THAN EXPECTED."), 91015000 T 0000 + (" 12 VARIABLE OF ILLEGAL TYPE."), 91016000 T 0000 + (" 13 UNRECOGNIZABLE STATEMENT."), 91017000 T 0000 + (" 14 CONSTANT TOO BIG OR TO SMALL."), 91018000 T 0000 + (" 15 UNDEFINED LABEL."), 91019000 T 0000 + (" 16 FOR- AND CASE-STATEMENTS NESTED TOO DEEP."), 91020000 T 0000 + (" 17 EXPRESSION IS OF WRONG TYPE."), 91021000 T 0000 + (" 18 """OF""" EXPECTED."), 91022000 T 0000 + (" 19 """DO""" EXPECTED."), 91023000 T 0000 + (" 20 """ELSE""" WITHOUT CORRESPONDING """THEN"""."), 91024000 T 0000 + (" 21 ILLEGAL TERMINATION OF STATEMENT."), 91025000 T 0000 + (" 22 """UNTIL""" EXPECTED."), 91026000 T 0000 + (" 23 """TO"""/"""DOWNTO""" EXPECTED."), 91027000 T 0000 + (" 24 """END""" EXPECTED."), 91028000 T 0000 + (" 25 """;""" EXPECTED."), 91029000 T 0000 + (" 26 """:""" EXPECTED."), 91030000 T 0000 + (" 27 """THEN""" EXPECTED."), 91031000 T 0000 + (" 28 """:=""" EXPECTED."), 91032000 T 0000 + (" 29 ONLY NUMBERS MAY BE SIGNED."), 91033000 T 0000 + (" 30 TOO MANY CASES."), 91034000 T 0000 + (" 31 LABEL USED MORE THAN ONCE."), 91035000 T 0000 + (" 32 CONSTANT EXPECTED."), 91036000 T 0000 + (" 33 LABEL NOT IN RANGE 0..9999."), 91037000 T 0000 + (" 34 TOO MANY LABELS DECLARED."), 91038000 T 0000 + (" 35 TOO MANY CONSTANTS DECLARED."), 91039000 T 0000 + (" 36 """=""" EXPECTED."), 91040000 T 0000 + (" 37 THE LIST IS TOO LONG."), 91041000 T 0000 + (" 38 INVALID TYPE FOR A FUNCTION."), 91042000 T 0000 + (" 39 """BEGIN""" EXPECTED."), 91043000 T 0000 + (" 40 TOO MANY IDENTIFIERS DECLARED."), 91044000 T 0000 + (" 41 ALFA CONSTANTS MAY NOT BE LONGER THAN 7 CHARACTERS."),%001- 91045000 P 0000 + (" 42 EXPRESSION IS NOT OF TYPE BOOLEAN."), 91046000 T 0000 + (" 43 NOT PROPER FORWARD DECLARATION."), 91047000 T 0000 + (" 44 UNSATISFIED FORWARD DECLARATION."), 91048000 T 0000 + (" 45 TOO MANY DIFFERENT TYPES DECLARED."), 91049000 T 0000 + (" 46 """)""" EXPECTED."), 91050000 T 0000 + (" 47 """[""" EXPECTED."), 91051000 T 0000 + (" 48 A SIMPLE TYPE EXPECTED."), 91052000 T 0000 + (" 49 """ARRAY OF ARRAY""" AND """ARRAY OF RECORD""" ILLEGAL", 91053000 T 0000 + " AS FILE TYPE."), 91054000 T 0000 + (" 50 """FILE OF FILE""" IS ILLEGAL."), 91055000 T 0000 + (" 51 SET BOUNDRY IS TOO BIG OR TOO SMALL."), 91056000 T 0000 + (" 52 TOO MANY UNDECLARED POINTERS."), 91057000 T 0000 + (" 53 """..""" EXPECTED."), 91058000 T 0000 + (" 54 FIRST VALUE IS GREATER THAN SECOND VALUE."), 91059000 T 0000 + (" 55 PROCEDURE NESTING DEPTH + NO OF RECORDS IS TOO GREAT."), 91060000 P 0000 + (" 56 THE RECORD CONTAINS MORE THEN 1023 WORDS."), 91061000 T 0000 + (" 57 FILES NOT ALLOWED IN RECORDS."), 91062000 T 0000 + (" 58 """(""" EXPECTED."), 91063000 T 0000 + (" 59 """]""" EXPECTED."); 91064000 T 0000 + 85 IS 591 LONG, NEXT SEG 84 + 91065000 T 0000 + SWITCH FORMAT ERRORMESS2 := 91066000 T 0000 + START OF SEGMENT ********** 86 + (" 60 """ARRAY OF FILE""" NOT ALLOWED."), 91067000 T 0000 + (" 61 RANGE OF INDEX IS GREATER THAN 1023."), 91068000 T 0000 + (" 62 UNSATISFIED POINTER DECLARATION."), 91069000 T 0000 + (" 63 EXPRESSION IS TOO LONG."), 91070000 T 0000 + (" 64 ILLEGAL OPERATOR FOR THIS TYPE OF EXPRESSION."), 91071000 T 0000 + (" 65 INTEGER EXPRESSION EXPECTED."), 91072000 T 0000 + (" 66 A SET EXPECTED."), 91073000 T 0000 + (" 67 PARAMETER OF ILLEGAL TYPE."), 91074000 T 0000 + (" 68 PROCEDURES NOT ALLOWED IN THIS CONTEXT."), 91075000 T 0000 + (" 69 ILLEGAL USE OF THIS TYPE OF IDENTIFIER."), 91076000 T 0000 + (" 70 TOO MANY PARAMETERS DECLARED IN THE PROGRAM."), 91077000 T 0000 + (" 71 """ARRAY OF CHAR""" EXPECTED."), 91078000 T 0000 + (" 72 WRONG TYPE OF SET EXPRESSION."), 91079000 T 0000 + (" 73 TOO MANY EXTERNAL FILES."), 91080000 T 0000 + (" 74 ILLEGAL IDENTIFIER FOR EXTERNAL FILE."), 91081000 T 0000 + (" 75 """PROGRAM""" EXPECTED."), 91082000 T 0000 + (" 76 """.""" EXPECTED AT END OF PROGRAM."), 91083000 T 0000 + (" 77 EXTERNAL FILE IDENTIFIER MAY NOT EXCEED 6 CHARACTERS."), 91084000 T 0000 + (" 78 ILLEGAL FILE PARAMETER."), 91085000 T 0000 + (" 79 ILLEGAL USE OF FILE HANDLING PROCEDURE."), 91086000 T 0000 + (" 80 TEXT-FILE EXPECTED."), 91087000 T 0000 + (" 81 POINTER VARIABLE EXPECTED."), 91088000 T 0000 + (" 82 ONLY VALUES OF TYPE REAL, INTEGER OR CHAR MAY BE READ."), 91089000 T 0000 + (" 83 VARIABLES IN RECORDS ILLEGAL IN THIS CONTEXT."), 91090000 T 0000 + (" 84 DISPLAY OVERFLOW."), 91091000 T 0000 + (" 85 READ AND WRITE MAY ONLY BE USED ON TEXT-FILES."), 91092000 T 0000 + (" 86 REFERENCED OBJECT IS TOO BIG."), 91093000 T 0000 + (" 87 END-OF-INPUT ENCOUNTERED UNEXPECTEDLY."), %001- 91094000 P 0000 + (" 88 CHARACTER ARRAY EXPECTED."), 91095000 T 0000 + (" 89 """,""" EXPECTED."), 91096000 T 0000 + (" 91 PROCEDURES MAY NOT HAVE ANY TYPE."), 91097000 T 0000 + (" 91 PARAMETER OF WRONG KIND."), 91098000 T 0000 + (" 92 ONLY COMPLETE ARRAYS AND RECORDS MAY BE TRANSMITTED."), 91099000 T 0000 + (" 93 DECLARED LABEL NOT USED."), 91100000 T 0000 + (" 94 PARAMETERS OF THIS TYPE SHOULD NOT BE VALUE PARAMETERS."), 91101000 T 0000 + (" 95 SIZE OF STRUCTURES IN ASSIGNMENT ARE NOT THE SAME."), %512- 91102000 P 0000 + (" 96 INPUT/OUPUT NOT DECLARED."), 91103000 T 0000 + (" 97 TOO MANY FILES IN USE."), %001- 91104000 P 0000 + (" 98 RECORD IDENTIFIER EXPECTED."), 91105000 T 0000 + (" 99 UNRECOGNIZED ITEM."), 91106000 T 0000 + ("100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION. THE VALUE 07 IS 91106500 C 0000 + SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT THE COMPILATION ERRO 91106600 C 0000 + RS COUNT."),% %002- 91106700 C 0000 + ("101 PROCEDURES/FUNCTIONS NESTED TOO DEEP."), %002- 91106800 C 0000 + ("102 ***WARNING ONLY, ILLEGAL DOLLAR OPTION."), %713- 91106900 C 0000 + (); 91107000 T 0000 + 86 IS 485 LONG, NEXT SEG 84 + 91108000 T 0000 + 91109000 T 0000 + WRITE(LINE, ERRORS,NUMERRS); %708- 91110000 P 0000 + FOR I:=0 STEP 1 UNTIL 59 DO IF ERR[I] THEN 91111000 T 0007 + WRITE(LINE, ERRORMESS1[I]); %708- 91112000 P 0012 + FOR I:=60 STEP 1 UNTIL 119 DO IF ERR[I] THEN 91113000 T 0019 + WRITE(LINE, ERRORMESS2[I-60]); %708- 91114000 P 0024 + END OF ERROR MESSAGES; 91115000 T 0031 + 84 IS 36 LONG, NEXT SEG 2 + IF XREFOPTION THEN 92001000 T 0254 + BEGIN 92002000 T 0254 + REPLACE POINTER(XREFLINE[*]) BY " " FOR 17 WORDS; 92003000 T 0254 + REWIND(XREFFILE); %002- 92003500 C 0259 + HEADING; 92004000 T 0260 + SORT(PRINTXREF,XREFINPUT,0,XREFMAX,XREFCOMPARE,3,1000,6000); %002- 92005000 P 0261 + END; 92006000 T 0281 + END OF B5700 PASCAL COMPILER............................................ 99001000 P 0281 + 2 IS 287 LONG, NEXT SEG 1 + START OF SEGMENT ********** 87 + 87 IS 30 LONG, NEXT SEG 1 + 1 IS 2 LONG, NEXT SEG 0 + 103 IS 69 LONG, NEXT SEG 0 +NUMBER OF ERRORS DETECTED = 0. COMPILATION TIME = 228 SECONDS. + +PRT SIZE = 311; TOTAL SEGMENT SIZE = 8668 WORDS; DISK SIZE = 540 SEGS; NO. PGM. SEGS = 103 + +ESTIMATED CORE STORAGE REQUIRED = 22525 WORDS. + +ESTIMATED AUXILIARY MEMORY REQUIRED = 0 WORDS. + +NUMBER OF CARD-IMAGES PROCESSED = 4242. + + + + LABEL 000000000LINE 00186197? COMPILE PASCAL/NEW XALGOL LIBRARY XALGOL /PASCAL diff --git a/PASCAL-Heriot-Watt/PATCHES.PASCAL.card b/PASCAL-Heriot-Watt/PATCHES.PASCAL.card index 8d22fa9..8151747 100644 --- a/PASCAL-Heriot-Watt/PATCHES.PASCAL.card +++ b/PASCAL-Heriot-Watt/PATCHES.PASCAL.card @@ -1,7 +1,15 @@ -?EXECUTE OBJECT/READER -?COMMON=3 -?FILE NEWTAPE = PATCH/PASCAL SERIAL +?EXECUTE PATCH/MERGE +?FILE LINE=LINE PRINT ?DATA CARD +$. 39 PATCHES FOR PASCAL WITH CONFLICTS +$*COMPILE PASCAL/NEW XALGOL LIBRARY +$*XALGOL STACK=800 +$*XALGOL FILE TAPE=SYMBOL/PASCAL SERIAL +$*XALGOL FILE NEWTAPE=SYMNEW/PASCAL SERIAL +$*XALGOL FILE LINE=LINE PRINT +$*DATA CARD +$- DOLLAR CARDS FOR COMPILATION +$ TAPE LIST SINGLE SEQXEQ NEW TAPE $# PATCH 1 FOR PASCAL.XVI.O CONTAINS 10 CARDS. CORRECT SPELLING & TABULATION $: PATCH TO CORRECT SPELLING IN SOME ERROR MESSAGES, CURRECT TABULATION OF CODE $: OR COMMENTS, AND TO CORRECT THE CALL ON THE PROCEDURE TO GIVE A NEW PAGE. @@ -9,18 +17,18 @@ $: *** NOTE THAT ERROR(71) IS NOW NO LONGER USED - SEE PATCH 513. $: IS WAS USED ONCE, BUT INCORRECTLY. ERROR(63) IS CALLED IN ITS PLACE. $: *** NOTE THAT THE ALGOL CODE FILE "PASCRUN"/"DISK" HAS BEEN RENAMED $: "PASCAL"/"PRELUDE". IT IS NO LONGER REFERENCED DIRECTLY IN THIS COMPILER -$: NILS A OTTE, UNIVERISTY OF NATAL, DURBAN. AUG - NOV 1977. +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. $: BEGIN ; % NULL %*** 4) REWRITE 50203000 GEN("PUT",3,5); %*** 5) PAGE 50204000 - GEN("PPAGE",5,3); % 50208000 + GEN("PPAGE",5,3); % 50208000 BLOCK; %*** COMPILE PROCEDURE BODY *** 80646000 COMPSTAT; %*** COMPILE STATEMENT PART *** 80691000 (" 41 ALFA CONSTANTS MAY NOT BE LONGER THAN 7 CHARACTERS."), 91045000 (" 55 PROCEDURE NESTING DEPTH + NO OF RECORDS IS TOO GREAT."), 91060000 (" 87 END-OF-INPUT ENCOUNTERED UNEXPECTEDLY."), 91094000 (" 97 TOO MANY FILES IN USE."), 91104000 -END OF B5700 PASCAL COMPILER.. .........................................99001000 +END OF B5700 PASCAL COMPILER............................................99001000 $# PATCH 2 FOR PASCAL CONTAINS 171 CARDS. $: PATCH TO MERGE DAG LANGMYHRS PPP10 TO PPP11 COSY PATCHES $: WITH NILS OTTES MODIFIED PPP10 SOURCE. @@ -28,24 +36,24 @@ $: DAVID A COOPER , HERIOT-WATT UNIVERSITY, JANUARY 1978. $: FILE CARD "SOURCE" (1,10,30); % SOURCE CODE FILE 10035000 FILE LINES 1 (1,17); % PRINT FILE 10036000 -FILE PASCALGOL DISK SERIAL [20:600] (1,10,30,SAVE 0); % CODE 10037000 +FILE PASCALGOL DISK SERIAL [20:600] (1,10,30,SAVE 0); % CODE FILE 10037000 ARRAY PARAMTAB, FORWPARAM1, FORWPARAM2[0:MAXPARAMS]; 10109000 FILE XREFFILE DISK SERIAL [20:3000] (1,3,30); 10137000 ALPHA ARRAY XBUFF[0:2]; 10138500 BOOLEAN XINB; 10138550 INTEGER ARRAY SYMKIND[0:62]; %USED IN ERROR RECOVERY. 10149000 ERROR100MESS (//"100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION10188500 - THE VALUE 07 IS SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT TH10188600 +. THE VALUE 07 IS SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT TH10188600 E COMPILATION ERRORS COUNT."//),% 10188700 - PACKEDSY=61#, ASSERTSY=62#; 10211000 + PACKEDSY=61#, ASSERTSY=62#; 10211000 % 20181500 % 20181550 IF ERRNUM=100 20181600 - THEN NUMERRS:=NUMERRS-1;% * ERROR NUMBER 100 ALONE SHOULD NOT 20181650 -% * PREVENT THE XALGOL COMPILATION BEING 20181700 -% * ZIPPED AS THE VALUE 7 IS SUBSTITUTED 20181750 -% * FOR A BAD SAVE CONSTANT IN AN "S" 20181800 -% * OPTION. 20181850 + THEN NUMERRS:=NUMERRS-1;% * ERROR NUMBER 100 ALONE SHOULD NOT 20181650 +% * PREVENT THE XALGOL COMPILATION BEING 20181700 +% * ZIPPED AS THE VALUE 7 IS SUBSTITUTED 20181750 +% * FOR A BAD SAVE CONSTANT IN AN "S" 20181800 +% * OPTION. 20181850 % 20181900 % 20181950 7(INITIAL),MIDDLE,INITIAL; 20308000 @@ -76,9 +84,9 @@ END OF XREFINPUT; 20541960 BOOLEAN LPARFOUND,SAVEXREFOPT; 20842000 SAVEXREFOPT := XREFOPTION; XREFOPTION := FALSE; 20847500 IF SAVEXREFOPT THEN NEWXREF(CURNAME1,CURNAME2,THISLEVEL, 20861500 - FALSE); 20861550 + FALSE); 20861550 XREFOPTION := SAVEXREFOPT; 20868500 -% ASSERT 62 ASSERTSY INITIAL 30075500 +% ASSERT 62 ASSERTSY INITIAL 30075500 IF CURNAME1="6ASSERT" THEN ASSERTSY ELSE 30165500 END% 30280000 % 30280025 @@ -128,26 +136,26 @@ INTEGER EXPRLEVEL,TX,EXPINVARCNT;% 40018000 SIMPLEVARIABLE := SIMPLEVAR; 40199500 IF EXPINVARCNT=0 THEN WRITEEXPR; % 40751000 LABEL EFH; 50201500 - %*** 6) OPEN & CLOSE (INPUT) FOR 50204500 - % CUMULATIVE FREQUENCY COUNT 50204550 + %*** 6) OPEN & CLOSE (INPUT) FOR 50204500 + % CUMULATIVE FREQUENCY COUNT50204550 BEGIN 50208100 GEN("QQJZXL",6,2); 50208200 INSYMBOL; 50208300 GO TO EFH; % 50208400 END; 50208500 - EFH: 50219500 - EXPRLEVEL := 1; 60346500 - IF THISID.IDCLASS=VAR OR 60354000 - THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN % 60354500 - EXPRLEVEL := 0; 60383500 +EFH: 50219500 + EXPRLEVEL := 1; 60346500 + IF THISID.IDCLASS=VAR OR 60354000 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN % 60354500 + EXPRLEVEL := 0; 60383500 PROCEDURE ASSERTSTAT; 60391100 BEGIN 60391200 GEN("IF NOT(",7,1); 60391400 INSYMBOL; BOOLEXPR; 60391500 GEN(") THEN",7,2); GEN("RUNERR(",7,1); GEN("7,",2,6); 60391600 - GENINT(CARDCNT); GEN(";",1,7); 60391700 + GENINT(CARDCNT); GEN(")",1,7); 60391700 END OF ASSERTSTAT; 60391800 - IF CURNAME1="6QQJZXL" THEN FILEHANDLING(6) ELSE 60443500 + IF CURNAME1="6QQJZXL" THEN FILEHANDLING(6) ELSE 60443500 IF CURSY=ASSERTSY THEN ASSERTSTAT ELSE 60457500 IF PARAM THEN GEN("0",1,7) ELSE BEGIN 80129000 GEN("0:",2,6); 80129100 @@ -189,7 +197,7 @@ BEGIN% 90090400 IF ERR[100]% 90090600 THEN WRITE(LINE ,ERROR100MESS);% 90090700 IF SAVEFACTOR}0 THEN% *A ZIP IS REQUIRED 90090800 -%VOIDT 90111000 +$VOIDT 90111000 END% 90129500 ("100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION. THE VALUE 07 IS91106500 SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT THE COMPILATION ERRO91106600 @@ -200,9 +208,9 @@ RS COUNT."),% 91106700 $# PATCH 500 FOR PASCAL.XVI.O CONTAINS 5 CARDS. PRT CELLS 25 TO 30 $: THIS PATCH CORRECTS THE DOCUMENTATION FOR THE COMPILERS PRT CELLS 25 TO 27 $: (NOT 21 TO 23). FURTHERMORE. IT USES PRT CELL 30 FOR THE CARD COUNT (IN PLACE -$: OF 27) TO BE CONSISTANT WITH THE OTHER SYSTEM COMPILERS. PRT CELLS 27 IS USED +$: OF 27) TO BE CONSISTANT WITH THE OTHER SYSTEM COMPILERS. PRT CELL 27 IS USED $: FOR THE PAGE COUNT FORMERLY AT SEQUENCE 10134000. -$: NILS OTTE, UNIVERISTY OF NATAL, DURBAN. AUG - NOV 1977. +$: NILS OTTE, UNIVERISTY OF NATAL, DURBAN. AUG - NOV 1977. $: INTEGER NUMERRS, % @R+25: NUMBER OF ERRORS IN PROGRAM. 10029000 SAVEFACTOR, % @R+26: SAVEFACTOR FOR CODE FILE. 10030000 @@ -220,14 +228,14 @@ $: NEWNAME("50PRT25",0,0); %*** "PRT25" *** 20369100 T3:=INTTYPE; T3.IDCLASS:=VAR; % GLOBAL INTEGER VARIABLE 20369200 NAMETAB3[0,THISINDEX] := T3; 20369300 -$# PATCH 502 FOR PASCAL.XVI.O CONTAINS 3 CARDS. LINE COUNT WHEN DEBUGGING +$# PATCH 502 FOR PASCAL.XVI.O CONTAINS 3 CARDS. LINE COUNT WHEN DEBUGGING $: TO CORRECT THE LINE COUNT WHEN THE DEBUGGING OPTION TO LIST THE ALGOL $: CODE GENERATED IS SET (*$D+ *), OTHERWISE LINES PER PAGE GOES WRONG. $: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. $: DEFINE LINESPERPAGE = 60 #, 10038000 - IF DUMPOPTION THEN BEGIN IF (LINECNT:=LINECNT+1)}LINESPERPAGE 20149000 - THEN HEADING; WRITE(LINE,10,ALGOLCARD[*]) END; 20149100 + IF DUMPOPTION THEN BEGIN IF (LINECNT:=LINECNT+1)}LINESPERPAGE 20149000 + THEN HEADING; WRITE(LINE,10,ALGOLCARD[*]) END; 20149100 $# PATCH 503 FOR PASCAL.XVI.O CONTAINS 9 CARDS. INTEGER TO REAL FOR TYPETAB1 $: WHEN MORE THAN 63 ENTRIES WERE ENTERED IN THE "TYPETAB*" ARRAYS, THE $: PASCAL COMPILER WAS DISCONTINUED DUE TO INTEGER OVERFLOW, WHICH COULD OCCUR @@ -237,6 +245,7 @@ $: [43:10] AND HAS THE 4 HIGH ORDER BITS IN THE EXPONENT FIELD. THIS PATCH $: ALTERS THE DECLARATIONS OF ALL IDENTIFIER TO WHICH "TYPETAB1" MAY BE $: ASSIGNED FROM INTEGER TO REAL TO CORRECT THIS ERROR. $: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. +$: INTEGER IT; REAL T; 50225000 INTEGER IT; REAL T; 50285000 INTEGER CASETYPE,ADDR,MAXADDR,INDEX,CTYPE,TX,SX, T3,LLIM,ULIM,I; 70244000 @@ -258,7 +267,7 @@ $: FORWARD PROCEDURES AND FUNCTIONS, SETTING TO ZERO ONLY THOSE ELEMENTS WHICH $: ARE NOT SO MARKED ON EXIT FROM A BLOCK, AND UNMARKING THE RELEVANT PARAMETERS $: WHEN THE PROCEDURE OR FUNCTION IS DEFINED. THE MARKING OF THE PARAMETERS $: IS DONE IN SUCH A WAY THAT THE SAME IDENTIFIER NAME MAY BE USED AT THE SAME -$: LEVEL WITHOUT SYNTAX ERROR X TO REPORT THAT THE IDENTIFIER IS ALREADY DEFINED +$: LEVEL WITHOUT SYNTAX ERROR 2 TO REPORT THAT THE IDENTIFIER IS ALREADY DEFINED $: THE UNMARKING REPLACES THE IDENTIFIER NAME IN "NAMETAB*" TO ALLOW FOR THE $: SAME NAME OR ONE THAT HASHES TO THE SAME PLACE TO HAVE BEEN USED PREVIOUSLY $: AND NOW DELETED. @@ -270,29 +279,30 @@ $: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. FOR I:=T+1 STEP 1 UNTIL TX DO % TO ALLOW REFERENCE 80557000 BEGIN T3:=PARAMTAB[I].PARAMNAME; 80558000 CURNAME1:=ABS(NAMETAB1[CURLEVEL+1,T3]); 80559000 - CURNAME2:= NAMETAB1[CURLEVEL+1,T3]; 80560000 + CURNAME2:= NAMETAB2[CURLEVEL+1,T3]; 80560000 NAMETAB1[CURLEVEL+1,T3]:=0; 80561000 NEWNAME(CURNAME1,CURNAME2,CURLEVEL+1); 80562000 IF T3!THISINDEX THEN BEGIN 80563000 PARAMTAB[I].PARAMNAME:=THISINDEX; 80564000 NAMETAB3[CURLEVEL+1,THISINDEX] := 80565000 NAMETAB3[CURLEVEL+1,T3]; 80565010 - END END; % OF UNMARKING FORWARD PARAMETERS. 80566000 - TX:=(T:=NAMETAB3[CURLEVEL,INDEX].INFO)+PARAMTAB[T]; 80636100 - FOR I:=T+1 STEP 1 UNTIL TX DO % MARK FORWARD PARAMETERS 80636200 - NAMETAB1[CURLEVEL+1,PARAMTAB[I].PARAMNAME].[46:1] := 1; 80636210 - TX:=CURFUNC; CURFUNC:=IF FUN THEN INDEX ELSE -1; 80645000 - FOR I:=0 STEP 1 UNTIL MAXNAMES DO % LEAVE FORWARD PARAMETERS 80647000 - IF NAMETAB1[CURLEVEL,I]>0 THEN NAMETAB1[CURLEVEL,I]:=0; 80648000 - CURLEVEL:=CURLEVEL-1; CURFUNC:=TX; 80649000 - FOR I:=LASTREC STEP 1 UNTIL TOPREC-1 DO % CLEAR RECORD DECS 80693000 + END END; % OF UNMARKING FORWARD PARAMETERS. 80566000 + TX:=(T:=NAMETAB3[CURLEVEL,INDEX].INFO)+PARAMTAB[T]; 80636100 + FOR I:=T+1 STEP 1 UNTIL TX DO % MARK FORWARD PARAMETERS 80636200 + NAMETAB1[CURLEVEL+1,PARAMTAB[I].PARAMNAME].[46:1] := 1; 80636210 + TX:=CURFUNC; CURFUNC:=IF FUN THEN INDEX ELSE -1; 80645000 + FOR I:=0 STEP 1 UNTIL MAXNAMES DO % LEAVE FORWARD PARAMETERS 80647000 + IF NAMETAB1[CURLEVEL,I]>0 THEN NAMETAB1[CURLEVEL,I]:=0; 80648000 + CURLEVEL:=CURLEVEL-1; CURFUNC:=TX; 80649000 + FOR I:=LASTREC STEP 1 UNTIL TOPREC-1 DO % CLEAR RECORD DECS 80693000 $# PATCH 505 FOR PASCAL.XVI.O CONTAINS 9 CARDS. CHECK FOR HASH TABLE FULL -$: WHEN THER ARE "MAXNAMES" IDENTIFIERS AT ONE LEVEL, THE "NAMETAB*" ROWS +$: WHEN THERe ARE "MAXNAMES" IDENTIFIERS AT ONE LEVEL, THE "NAMETAB*" ROWS $: BECOME FULL AND THIS USED TO PUT THE COMPILER INTO AN INFINITE LOOP, $: EITHER IN "NEWNAME" OR "SEARCHTAB". THIS PATCH INSERTS TEST FOR WRAP AROUND $: LEADING BACK TO THE HASHED STARTING POINT, FOR WHICH IT GIVES SYNTAX ERROR $: 40, TOO MANY IDENTIFIERS DECLARED. $: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. +$: DEFINE HASH(HASH1) = ENTIER((HASH1) MOD MAXNAMES) #; 20202000 BEGIN ALPHA TNAME; INTEGER WRAPAROUND; 20209000 WRAPAROUND:=THISINDEX:=HASH(CURNAME1); 20210000 @@ -308,6 +318,7 @@ $: RESERVED WORDS OPTION IS SET (*$R+ *), AN INVALID INDEX OCCURRED IN THE $: SCANNER "INSYMBOL". THE PROBLEM IS CURED BY CORRECTLY COMPUTING THE STARTING $: AND ENDING POINT OF THE RESERVED WORDS. $: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. +$: BEGIN T1 := CARDLENGTH-CHARCNT-CURLENGTH-1; 30178000 FOR CURLENGTH+REAL(CHARCNT=0); 30181000 $# PATCH 507 FOR PASCAL.XVI.O CONTAINS 5 CARDS. "VARIABLE", "SIMPLEVARIABLE" @@ -349,14 +360,14 @@ $: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. $: IF ERRNUM<0 THEN ERRNUM:=ABS(ERRNUM) ELSE 20180900 $ %IF THISLEVEL>1 AND THISLEVEL1 ND THISLEVEL!CURLEVEL THEN ERROR5; 50244000 -$ %IF THISLEVEL.1 AND THISLEVEL!CURLEVEL THEN ERROR5; 50306000 +$ %IF THISLEVEL>1 AND THISLEVEL!CURLEVEL THEN ERROR5; 50244000 +$ %IF THISLEVEL>1 AND THISLEVEL!CURLEVEL THEN ERROR5; 50306000 IF THISLEVEL!CURLEVEL-1 OR THISINDEX!CURFUNC THEN ERROR(5); 60091000 IF THISLEVEL>1 AND THISLEVEL 0 % POINTER VIA POINTER 40180500 + IF NUMPOINTERS > 0 % POINTER VIA POINTER 40180500 THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY 40180600 "00-1)DIV00 1022,00 T MOD00 1022]"; 40180700 NUMSYMS := NUMSYMS+4; 40180800 @@ -417,7 +428,7 @@ $: IF NUMSYMS+4 { MAXSYMS 40194000 THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY 40194100 "00-1)DIV00 1022,00 T MOD00 1022]"; 40194200 - NUMSYMS := NUMSYMS+4; 40194308 + NUMSYMS := NUMSYMS+4; 40194300 END 40194400 ELSE ERROR(63); % EXPRESSION IS TOO LONG FOR SYMTAB[*] 40195000 $# PATCH 514 FOR PASCAL.XVI.O CONTAINS 2 CARDS. PROCESS TIME FUNCTION FOR RUN @@ -427,20 +438,20 @@ $: WHICH MEANS PLATFORM TIME, TO "CPUTIME" WHICH IS THE WIDELY ACCEPTED TERM $: FOR THIS QUANTITY. $: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. $: - NEWNAME("7CPUTIM","E",0); NAMETAB3[0,THISINDEX]:=T3; 20390000 - IF CURNAME1="7CPUTIM" AND CURNAME2="E" THEN % "CPUTIME" 40452000 -$# PATCH 516 FOR PASCAL.XVI.O CONTAINS 2 CARDS. CORRECT "NO LISTING" ERROR + NEWNAME("7CPUTIM","E",0); NAMETAB3[0,THISINDEX]:=T3; 20390000 + IF CURNAME1="7CPUTIM" AND CURNAME2="E" THEN % "CPUTIME" 40452000 +$# PATCH 516 FOR PASCAL.XVI.O. CONTAINS 2 CARDS. CORRECT "NO LISTING" ERROR $: THIS PATCH CORRECTS AN ERROR WHEREBY IF LISTING WAS TURNED OFF $: AND PAGE THROW WAS INVOKED, A HEADING WAS PRINTED REGARDLESS. -$: DAVID A COOPER, HERIOT-WATT UNIVERSITY.....JUNE, 1978 +$: DAVID A COOPER, HERIOT-WATT UNIVERSITY.....JUNE, 1978. $: IF CX="L" THEN IF C=1 THEN 30264000 IF LISTOPTION THEN HEADING ELSE 30264500 -$# PATCH 517 FOR PASCAL.XVI.O CONTAINS 2 CARDS. +$# PATCH 517 FOR PASCAL.XVI.O. CONTAINS 2 CARD. $: THIS PATCH CORRECTS AN ERROR THAT CAUSED A FILE DECLARATION $: TO HAVE ITS NAME STRING SPLIT OVER TWO LINES IN THE GENERATED XALGOL. -$: ALSO CHANGES SYMTAB FROM TYPE REAL TO TYPE ALPHA. -$: DAVID A COOPER, HERIOT-WATT UNIVERSITY.....JUNE, 1978 +$: ALSO CHANGES SYMTAB FORM TYPE REAL TO TYPE ALPHA. +$: DAVID A COOPER, HERIOT-WATT UNIVERSITY.....JUNE, 1978. $: ALPHA ARRAY SYMTAB[0:MAXSYMS]; % USED BY "EXPRESSION". 10144000 IF ALGOLCNT LSS 14 THEN WRITEALGOL; 80103000 @@ -551,8 +562,8 @@ $POP VOIDT 80064000 END 80064365 ELSE 80064370 BEGIN 80064375 - IF SUBDIFF } ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE] -80064380 - ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE] 80064385 + IF SUBDIFF } ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE] - 80064380 + ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE] 80064385 THEN 80064390 BEGIN 80064395 ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] := 80064400 @@ -594,7 +605,7 @@ $POP VOIDT 80064000 IF MAXPERMTAB LEQ MAXTOTALSUBSCRS AND PARAM THEN 80064585 BEGIN 80064590 ARRSUBPERMTAB[ARRNAM,MAXPERMTAB] := 80064595 - IF FIRSTDIM THEN NAM ELSE -1; 80064600 + IF FIRSTDIM THEN NAM ELSE -1; 80064600 ARRSUBPERMTAB[PERMSUB,MAXPERMTAB] := PASSSUBRANGE; 80064605 MAXPERMTAB := MAXPERMTAB + 1; 80064610 END 80064615 @@ -653,8 +664,8 @@ $ 80421000 100 ELSE 10)+DIFF,(IF DIFF>9 THEN 7 ELSE 6)); 80421420 PASSPERMTAB := PASSPERMTAB +1; 80421430 END 80421440 - UNTIL PASSPERMTAB = MAXPERMTAB OR 80421450 - ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ! -1; 80421460 + UNTIL PASSPERMTAB = MAXPERMTAB OR 80421450 + ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ! -1; 80421460 GEN("]#;",3,5); 80421470 END 80421480 UNTIL PASSPERMTAB = MAXPERMTAB; 80421490 @@ -691,14 +702,14 @@ $: (F2 NEQ POINTERS OR LT NEQ NILTYPE) THEN % 20814100 BEGIN ERROR(63); % 40023000 $ 50059000 - GEN("PREAD(",6,2); WRITEEXPR; GEN(",",1,7); % 50079000 + GEN("PREAD(",6,2); WRITEEXPR; GEN(",",1,7); % 50079000 $ 50080000 $ 50081000 GENID("F",FILEID,5); GEN(",",1,7); % 50082000 IF F=NUMERIC THEN % 50086010 BEGIN % 50086050 - GEN(",",1,7); GENINT(TYPETAB2[CURTYPE]); % 50086100 - GEN(",",1,7); GENINT(TYPETAB3[CURTYPE]); % 50086150 + GEN(",",1,7); GENINT(TYPETAB2[CURTYPE]); % 50086100 + GEN(",",1,7); GENINT(TYPETAB3[CURTYPE]); % 50086150 END ELSE GEN(",0,0,",4,4); % 50086200 $ SET VOIDT 50088000 $ POP VOIDT 50093000 @@ -716,7 +727,7 @@ $: --- --- ---- ------ ---- -- ------- ---------------- % 40052055 PROCEDURE SPLIT(SPLITINX,WIDTH); % 40052100 VALUE SPLITINX, WIDTH; % 40052150 -INTEGER SPLITINX, WIDTH; % 40052200 +INTEGER SPLITINX, WIDTH ; % 40052200 BEGIN % 40052250 INTEGER I; % 40052300 % 40052350 @@ -751,7 +762,7 @@ BEGIN % --- --- --------- 40188025 IF INBRACKET AND NOT INRECORD THEN % 40188275 BEGIN % 40188300 PUTSYM(","); THISSYML := NUMSYMS; % 40188325 - PUTCONST(0); PUTSYM(" "); PUTSYM(","); % 40188350 + PUTCONST(0); PUTSYM(" "); PUTSYM(","); % 40188350 FOR I:=STARTSYM+1 STEP 1 UNTIL THISSYML DO % 40188375 PUTTEXT(SYMTAB[I]); 40188400 PUTTEXT(" 1] "); % 40188425 @@ -777,80 +788,80 @@ BEGIN % --- --- --------- 40188025 END; % 40188930 NUMPOINTERS := 0; % 40188945 END; 40188960 - PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); % 40188975 + PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); % 40188975 END OF SET VARIABLES; % 40188990 $ 40198000 IF TYPETAB1[THISID.TYPE].FORM=SET THEN 40274200 BEGIN % 40274220 GEN(",",1,7); % 40274240 GENID("W",1000|THISLEVEL+THISINDEX,5); % 40274260 - END; % 40274280 + END; % 40274280 BOOLEAN FIRST, SPLITTED; % 40296000 - PUTTEXT("SETBS("); PUTTEXT(" 3,2,"); PUTCONST(CARDCNT); % 40529000 + PUTTEXT("SETBS("); PUTTEXT(" 3,2,"); PUTCONST(CARDCNT); % 40529000 PUTSYM(")"); % 40529300 CURTYPE := EMPTYSET; CURMODE := NUMBER; % 40529600 STARTSYM := NUMSYMS + 1; % 40533500 PUTTEXT(" SETB("); % 40536000 PUTSYM(","); SYMTAB[STARTSYM] := "SETBS("; % 40544000 - IF SPLITTED THEN PUTSYM(")"); % 40551500 - IF CURSY=COMMA THEN % 40552000 - BEGIN % 40552200 - SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SUNIO("; % 40552400 - PUTSYM(","); % 40552600 - SPLITTED := TRUE; % 40552800 - END; % 40552850 - NEWTYPE; T1 := SET; T1.SIZE := 2; T1.STRUCT := 0; % 40558000 - CURMODE := NUMBER; % 40561000 - IF CURTYPE=BOOLTYPE THEN % 40587000 - IF CURSY NEQ ANDSY THEN ERROR(64); 40593000 - END ELSE % 40593100 - IF F=SET THEN % 40593200 - BEGIN % 40593300 - IF CURSY=ASTERISK THEN % 40593400 - BEGIN % 40593500 - SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SINTS("; % 40593600 - PUTSYM(","); % 40593700 - END ELSE ERROR(64); % 40593800 - MODE := NUMBER; % 40593900 - IF F=SET THEN PUTSYM(")"); % 40608500 - SPLIT(STARTSYM,1); % 40650000 - IF CURSY=PLUS THEN SYMTAB[STARTSYM] := "SUNIO(" ELSE % 40651000 - IF CURSY=MINUS THEN SYMTAB[STARTSYM] := "SDIFF(" ELSE % 40652000 - ERROR(64); % 40653000 - PUTSYM(","); MODE := NUMBER; % 40654000 + IF SPLITTED THEN PUTSYM(")"); % 40551500 + IF CURSY=COMMA THEN % 40552000 + BEGIN % 40552200 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SUNIO("; % 40552400 + PUTSYM(","); % 40552600 + SPLITTED := TRUE; % 40552800 + END; % 40552850 + NEWTYPE; T1 := SET; T1.SIZE := 2; T1.STRUCT := 0; % 40558000 + CURMODE := NUMBER; % 40561000 + IF CURTYPE=BOOLTYPE THEN % 40587000 + IF CURSY NEQ ANDSY THEN ERROR(64); 40593000 + END ELSE % 40593100 + IF F=SET THEN % 40593200 + BEGIN % 40593300 + IF CURSY=ASTERISK THEN % 40593400 + BEGIN % 40593500 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SINTS("; % 40593600 + PUTSYM(","); % 40593700 + END ELSE ERROR(64); % 40593800 + MODE := NUMBER; % 40593900 + IF F=SET THEN PUTSYM(")"); % 40608500 + SPLIT(STARTSYM,1); % 40650000 + IF CURSY=PLUS THEN SYMTAB[STARTSYM] := "SUNIO(" ELSE % 40651000 + IF CURSY=MINUS THEN SYMTAB[STARTSYM] := "SDIFF(" ELSE % 40652000 + ERROR(64); % 40653000 + PUTSYM(","); MODE := NUMBER; % 40654000 $ 40655000 - IF F=SET THEN PUTSYM(")"); % 40668500 + IF F=SET THEN PUTSYM(")"); % 40668500 $ 40688000 - IF CURSY=EQLSY THEN SYMTAB[STARTSYM] := "SEQUA(" % 40713000 - ELSE 40713150 - IF CURSY=NEQSY THEN % 40713300 - BEGIN % 40714000 - SPLIT(STARTSYM,1); SYMTAB[STARTSYM]:= " NOT "; % 40714150 - SYMTAB[STARTSYM+1] := "SEQUA("; % 40714300 - IF TYPETAB1[LEFTTYPE].FORM=SET THEN % 60080100 - BEGIN % 60080200 - SYMTAB[1] := "SSTOR("; NUMSYMS := NUMSYMS - 3; % 60080300 - EXPRESSION; % 60080400 - PUTSYM(")"); CHECKTYPES(LEFTTYPE,CURTYPE); % 60080500 - WRITEEXPR; % 60080600 - END ELSE % 60080700 - IF TYPETAB2[TX] LSS 0 OR TYPETAB3[TX] GTR 93 THEN ERROR(51); 70210000 - T1.SIZE := TSIZE := 2; TYPETAB1[TYPEINDEX] := T1; % 70214000 - IF T1.FORM=SET THEN % 80046200 - BEGIN % 80046400 - GEN(",",1,7); GENID("W",LEVEL1000+NAM,5); % 80046600 - END; % 80046800 - IF T1.FORM=SET THEN % 80064700 - BEGIN % 80064750 - GEN(",0",2,6); % 80064800 - IF NOT PARAM THEN GEN(":1",2,6); % 80064850 - END; % 80064900 - BEGIN % 80608105 - IF T1.FORM=SET THEN % 80608111 - BEGIN % 80608113 - GEN(",",1,7); % 80608115 - GENID("W",1000|(CURLEVEL+1)+NAM,5); % 80608117 - END; 80608118 + IF CURSY=EQLSY THEN SYMTAB[STARTSYM] := "SEQUA(" % 40713000 + ELSE 40713150 + IF CURSY=NEQSY THEN % 40713300 + BEGIN % 40714000 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM]:= " NOT "; % 40714150 + SYMTAB[STARTSYM+1] := "SEQUA("; % 40714300 + IF TYPETAB1[LEFTTYPE].FORM=SET THEN % 60080100 + BEGIN % 60080200 + SYMTAB[1] := "SSTOR("; NUMSYMS := NUMSYMS - 3; % 60080300 + EXPRESSION; % 60080400 + PUTSYM(")"); CHECKTYPES(LEFTTYPE,CURTYPE); % 60080500 + WRITEEXPR; % 60080600 + END ELSE % 60080700 + IF TYPETAB2[TX] LSS 0 OR TYPETAB3[TX] GTR 93 THEN ERROR(51); 70210000 + T1.SIZE := TSIZE := 2; TYPETAB1[TYPEINDEX] := T1; % 70214000 + IF T1.FORM=SET THEN % 80046200 + BEGIN % 80046400 + GEN(",",1,7); GENID("W",LEVEL1000+NAM,5); % 80046600 + END; % 80046800 + IF T1.FORM=SET THEN % 80064700 + BEGIN % 80064750 + GEN(",0",2,6); % 80064800 + IF NOT PARAM THEN GEN(":1",2,6); % 80064850 + END; % 80064900 + BEGIN % 80608105 + IF T1.FORM=SET THEN % 80608111 + BEGIN % 80608113 + GEN(",",1,7); % 80608115 + GENID("W",1000|(CURLEVEL+1)+NAM,5); % 80608117 + END; 80608118 END; % 80608119 IF TYPETAB1[NAMETAB3[CURLEVEL+1,PARAMTAB[I].PARAMNAME].TYPE80627200 ].FORM=SET 80627205 @@ -858,14 +869,14 @@ $ 40688000 GEN(",",1,7); % 80627600 GENID("W",1000|(CURLEVEL+1)+PARAMTAB[I].PARAMNAME 80627800 ,5); % 80627801 - END; 80627850 + END; 80627850 $#PATCH 602 FOR PASCAL.XVI./ CONTAINS 5 CARDS. CORRECT REPRESENTATION OF "NIL". $: RECEIVED FROM DAG LANGHYMR ON 6/07/78. $: DAVID A COOPER , HERIOT-WATT UNIVERSITY... JULY 1978. NILTYPE := 6; %*** TYPE OF "NIL" *** 20363000 T1.FORM := POINTERS; TYPETAB1[6] := T1; 20364000 EMPTYSET := 7; % 20364500 -T1.FORM := SET; TYPETAB1[7] := T1; 20365000 +T1.FORM := SET; TYPETAB1[7] := T1; 20365000 NUMTYPES := 7; % 20365500 $# PATCH 603 FOR PASCAL XVI.O CONTAINS 6 CARDS. CORRECT TO PATCH 601 $: DAVID A COOPER & S O ANDERSON, HERIOT-WATT UNIVERSITY. UST AUGUST 1978 @@ -876,7 +887,7 @@ $: IF CURSY = PLUS THEN SYMTAB[FIRSTSYM] := "SUNIO(" ELSE 40651000 IF CURSY = MINUS THEN SYMTAB[FIRSTSYM] := "SDIFF(" ELSE 40652000 ERROR(64); 40653000 -$# PATCH 614 FOR PASCAL.XVI.O. CONTAINS 7 CARDS. +$# PATCH 615 FOR PASCAL.XVI.O. CONTAINS 7 CARDS. $ 40105100 $ 40105200 $ 40105300 @@ -888,7 +899,7 @@ $# PATCH 700 FOR PASCAL.XVI.O HAS 179 CARDS. REDUCE THRASHING BY CODE CHANGE $: TO IMPROVE RUN TIME EFFICIENCY BY REAARRANGING THE THE COMPILERS CODE. $: THE COMPILER HAD A HIGH OVERLAY I/O TIME AND HIGH ELAPSED TIME IN RELATION $: TO THE PROCESS TIME, AND OBSERVATION OF THE B5700 CONFIRMED THAT IT WAS -$: THRASHING IN 32K. THIS PATCH ATTEMPTS TO REDUCE THE CORE REQUIREMENTS BY +$: THRASHING IN 32K. THIS PATCH ATTEMPTS TO REDUCE THE CORE REQUIREMENT BY $: REARRANGING THE SEGMENTATION OF THE CODE. LARGE SEGMENTS ARE ELIMINATED $: SO AS TO AVOID PULLING CODE THAT WILL NOT BE EXECUTED INTO CORE AND TO $: RELEASE CODE SEGMENTS AS SO AS EXECUTION HAS PASSED. FOR EXAMPLE, THE @@ -906,9 +917,9 @@ $: $ 10167000 $ 10168000 $ 10169000 - VALUE NAME1,NAME2,TABLE,DECL; 20016000 - REAL NAME1,NAME2; 20017000 - INTEGER TABLE; BOOLEAN DECL; 20018000 + VALUE NAME1,NAME2,TABLE,DECL; 20016000 + REAL NAME1,NAME2; 20017000 + INTEGER TABLE; BOOLEAN DECL; 20018000 FORWARD; 20019000 PROCEDURE PRINTERRORS; FORWARD; 20020000 PROCEDURE HEADING; %*** PRINTS A HEADING AT START OF NEW PAGE.20026000 @@ -917,7 +928,7 @@ END OF HEADING; 20033000 PROCEDURE PRINTLINE; %*** PRINTS A PASCAL SOURCE CODE LINE 20036000 BEGIN DEFINE NEWSEGMENT = HERE #; 20037000 END OF PRINTLINE; 20047000 -PROCEDURE NEWCARD; %*** READS A NEW PASCSAL SOURCE CODE CARD 20050000 +PROCEDURE NEWCARD; %*** READS A NEW PASCAL SOURCE CODE CARD 20050000 BEGIN DEFINE RESULT = ICARD[*], ETC #; 20051000 REPLACE XLINEPNT BY " " FOR 16 WORDS; 20056000 REPLACE LINEPNT BY CARDPNT FOR 10 WORDS, XLINEPNT FOR 6 WORDS; 20057000 @@ -925,7 +936,7 @@ END OF NEWCARD; 20061000 DEFINE GEN(GEN1,GEN2,GEN3) = GENI(TRUE,GEN1,GEN3,GEN2) #, 20063100 GENID(GENID1,GENID2,GENID3)= GENI(FALSE,GENID1,GENID2,GENID3) #; 20063200 20063300 -PROCEDURE GENI(GENT, TXT, NUM, N); 20063400 +PROCEDURE GENI(GENT, TXT, NUM, N ); 20063400 VALUE GENT, TXT, NUM, N; 20063500 BOOLEAN GENT; ALPHA TXT; INTEGER NUM, N; 20063600 BEGIN DEFINE START = NUM #, NDIG = N #; 20063700 @@ -933,34 +944,34 @@ BEGIN DEFINE START = NUM #, NDIG = N #; 20063700 IF GENT THEN %*** GENERATE A TEXT "TXT", CONSISTING OF 20064000 TEXT[0] := TXT; 20067000 END 20070000 -ELSE %*** GENERATE AN ALGOL IDENTIFIER. 20073000 +ELSE %*** GENERATE AN ALGOL IDENTIFIER. 20073000 CH[0] := TXT; 20076000 END END GENI; 20079000 PROCEDURE GENINT( N ); 20082000 VALUE N; INTEGER N; 20083000 -BEGIN DEFINE RESULT = ALGOL CODE #; 20084000 +BEGIN DEFINE RESULT = ALGOL CODE #; 20084000 INTEGER NABS, NSIZE; 20085000 END OF GENINT; 20097000 -PROCEDURE WRITEALGOL; %*** WRITES A COMPLETED ALGOL CARD TO 20145000 +PROCEDURE WRITEALGOL; %*** WRITES A COMPLETED ALGOL CARD TO 20145000 DEFINE NEWSEGMENT = HERE #; 20146100 DEFINE NEWSEGMENT = HERE #; 20168100 DEFINE NEWSEGMENT = HERE #; 20180100 DEFINE NEWSEGMENT = HERE #; 20193100 -ALPHA THISID, CURNAME1, CURNAME2, TNAME; % USED IN SCANNER 20205000 +ALPHA THISID, CURNAME1, CURNAME2; % USED IN SCANNER 20205000 TNAME? PROCEDURE SEARCHTAB( TAB ); %*** SEARCH NAME TABLE "TAB" FOR THE 20208000 VALUE TAB; INTEGER TAB; %*** IDENTIFIER JUST READ. 20208100 END OF SEARCHTAB; 20221000 PROCEDURE SEARCH; %*** SEARCH ALL TABLES CURRENTLY IN USE. 20223000 BEGIN DEFINE RESULT = THISID #; 20224000 END OF SEARCH; 20233000 -PROCEDURE NEWNAME( NAME1, NAME2, TAB ); 20236000 +PROCEDURE NEWNAME( NAME1,NAME2, TAB ); 20236000 VALUE NAME1, NAME2, TAB; 20236100 ALPHA NAME1, NAME2; INTEGER TAB; 20236200 END OF NEWNAME; 20250000 DEFINE NEWSEGMENT = HERE #; 20515100 DEFINE NEWSEGMENT = HERE #; 20533100 DEFINE NEWSEGMENT = HERE #; 20546100 -PROCEDURE CHECKTYPES(LEFTTYPE, RIGHTTYPE ); 20802000 +PROCEDURE CHECKTYPES( LEFTTYPE, RIGHTTYPE ); 20802000 VALUE LEFTTYPE, RIGHTTYPE; INTEGER LEFTTYPE, RIGHTTYPE; 20803000 BEGIN 20804000 REAL TT1, TT2; INTEGER F1, F2, LT, RT; 20805000 @@ -971,7 +982,7 @@ BEGIN DEFINE RESULTS = FILENAME & LPARFOUND #; 20845000 END OF FILEPARAM; 20869000 REAL CURVAL; INTEGER CURLENGTH; 20872000 20873000 -PROCEDURE CONSTANT( CVAL, CTYPE ); 20874000 +PROCEDURE CONSTANT( CVAL, CTYPE ); 20874000 REAL CVAL; INTEGER CTYPE; 20875000 BEGIN 20876000 INTEGER TFORM; BOOLEAN SIGNED, NEGATIVE; 20876100 @@ -982,10 +993,10 @@ INTEGER LASTCHARPOS; %( CURVAL, CURLENGTH MOVED TO 20872000 ) 30084000 PROCEDURE INSYMBOL; %*** IDENTIFIES THE NEXT SYMBOL ****** 30087000 BEGIN 30087100 30087200 - PROCEDURE NEXTCHAR; %*** GETS THE NEXT CHARACTER. 30088000 + PROCEDURE NEXTCHAR; %*** GETS THE NEXT CHARACTER. 30088000 END OF NEXTCHAR; 30093000 -$ SET VOIDT 30095000 -$ POP VOIDT 30098000 +$ SET VOIDT 30095000 +$ POP VOIDT 30098000 DEFINE T1 = EXP #; % USED AT 30178000 30099100 BEGIN DEFINE NEWSEGMENT = HERE #; 30261100 END NEWSEGEMENT; 30282200 @@ -993,24 +1004,24 @@ $ 40016000 $ 40017000 INTEGER EXPRLEVEL; 40018000 DEFINE PUTSYM(S) = PUTTEXT( (S)&1[41:5:6] ) #; 40029000 -$ SET VOIDT 40029900 -$ POP VOIDT 40033000 +$ SET VOIDT 40029900 +$ POP VOIDT 40033000 DEFINE PUTDUMMY = PUTTEXT("3000000") #; 40041000 -$ SET VOIDT 40042000 -$ POP VOIDT 40044000 -PROCEDURE WRITEEXPR; %*** WRITE GENERATED ALGOL EXPRESSION 40053000 +$ SET VOIDT 40042000 +$ POP VOIDT 40044000 +PROCEDURE WRITEEXPR; %*** WRITE GENERATED ALGOL EXPRESSION 40053000 REAL SX; INTEGER T1, TX; 40054100 END OF WRITEEXPR; 40066000 -PROCEDURE CHECKEXPR( LLIM, ULIM ); %*** WRITE CODE TO CHECK VALUE 40069000 +PROCEDURE CHECKEXPR( LLIM, ULIM ); %*** WRITE CODE TO CHECK VALUE 40069000 VALUE LLIM, ULIM; INTEGER LLIM, ULIM; 40069100 -BEGIN DEFINE CHECK = VALUE #; 40070000 +BEGIN DEFINE CHECK = VALUE #; 40070000 END OF CHECKEXPR; 40077000 INTEGER T1, T5; % USED ONCE EACH 40086100 T1:=T.FIRSTWITHSYM; T5:=T.LASTWITHSYM; 40094000 FOR T1:=T1 STEP 1 UNTIL T5 DO PUTTEXT(WITHTAB[T1]); 40095000 - DEFINE T1 = T #; % USED AT 405558000 40298000 -$ SET VOIDT 40299000 -$ POP VOIDT 40309000 + DEFINE T1 = T #; % USED AT 40558000 40298000 +$ SET VOIDT 40299000 +$ POP VOIDT 40309000 40331000 PROCEDURE PARAMETER; %*** CHECK THAT THE FUNCTION HAS 1 PARAM.40332000 BEGIN 40333000 @@ -1029,15 +1040,15 @@ $ 60396000 THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) OR 60423000 THISID.IDCLASS=FUNC 60423200 THEN ASSIGNMENT ELSE 60424000 -$ SET VOIDT 70013000 -$ POP VOIDT 70016000 - VALUE RECTAB,FIRSTADDR; 70018000 - INTEGER RECTAB,FIRSTADDR,LASTADDR; 70019000 -$ SET VOIDT 70022000 -$ POP VOIDT 70034000 +$ SET VOIDT 70013000 +$ POP VOIDT 70016000 + VALUE RECTAB,FIRSTADDR; 70018000 + INTEGER RECTAB,FIRSTADDR,LASTADDR; 70019000 +$ SET VOIDT 70022000 +$ POP VOIDT 70034000 70035000 -PROCEDURE TYPEDECL( TTYPE, TSIZE ); %***** TYPE DECLARATION ***** 70036000 - INTEGER TTYPE, TSIZE; %**************************** 70037000 +PROCEDURE TYPEDECL( TTYPE, TSIZE ); %***** TYPE DECLARATION ***** 70036000 + INTEGER TTYPE, TSIZE; %**************************** 70037000 BEGIN 70038000 INTEGER RECINX, ARRSTRUCT, TX, SX, T, N; REAL T1, T2, T3; 70039000 BOOLEAN FIRST, PACKED; 70040000 @@ -1081,42 +1092,42 @@ $ 70042000 DEFINE DEC = VAR #; 80496100 IF CURSY=FUNCSY OR CURSY=PROCSY % 80540900 THEN BEGIN DEFINE DEC = CODE #; 80540910 - END OF SEGMENT FOR PROCEDURE DECLARATIONS; 80648100 + END OF SEGMENT FOR PROCEDURE DECLARATIONS; 80658100 $# PATCH 701 FOR PASCAL.XVI.O CONTAINS 14 CARDS. REDUCE THRASHING BY ARRAY CUTS $: TO IMPROVE RUN TIME EFFICIENCY BY REDUCING ARRAY SIZES. THE MOST SIGNIFICANT $: CONTRIBUTION TO THE COMPILERS THRASHING BEHAVIOUR WAS THE EXCESSIVELY LARGE $: DATA ARRAYS. THIS PATCH SUCCEEDS IN DRASTICALLY REDUCING THE CORE REQUIREMENT $: OF THE COMPILER BY MAKING MOST OF THE LARGE ARRAYS MUCH SMALLER WITHOUT $: IMPOSING UNREASONABLE RESTRICTIONS. IN PARTICULAR, THE THREE ARRAYS, -$: NAMETAB1, NAMETAB2, NAMETAB3 WRE EHACH [0:50, 0:1022], AND HAVE BEEN REDUCED +$: NAMETAB1, NAMETAB2, NAMETAB3 WeRE EACH [0:50, 0:1022], AND HAVE BEEN REDUCED $: TO [0:30, 0:307]. THESE REDUCTIONS HAVE NOT PREVENTED THE COMPILATION OF $: A LARGE PASCAL PROGRAM OF ABOUT 4000 LINES, NAMELY THE P4 PASCAL COMPILER -$: FROM ZURICH. IN FACT, PRIOT TO THE CHANGES INTRODUCED BY PATCHES 700 & 701, +$: FROM ZURICH. IN FACT, PRIOR TO THE CHANGES INTRODUCED BY PATCHES 700 & 701, $: THE P4 PASCAL COMPILER TOOK 60 MINUTES ELAPSED TIME TO COMPILE, WHICH WAS $: REDUCED TO 9 MINUTES BY THESE PATCHES, WHILE THE PROCESS TIME HAS REMAINED $: CONSTANT AT 9 MINUTES. $:**** NOTE THAT IF "MAXNAMES" IS CHANGED THEN THERE ARE 7 DEFINES IN THE FILE $: PASCAL/PRELUDE THAT MUST ALSO BE CHANGED. -$: "MAXNAMES" WAS CHOSEN AS A PRIME NUMBER AS IT IS USED AS A MODULUS FOR A HASH +$: "MAXNAMES" IS CHOSEN AS A PRIME NUMBER AS IT IS USED AS A MODULUS FOR A HASH $: FUNCTION. THE PASCAL IDENTIFIERS ARE TRANSLATED TO ALGOL NAMES USING LEVEL $: AND HASH INDEX. HENCE CHANGING "MAXNAMES" CHANGES THE ALGOL NAMES FOR $: "INPUT", "OUTPUT", & "PRT25". $: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN AUG - NOV 1977. $: DEFINE MAXTABLES = 30 #, %MAX NUMBER OF LEVELS IN IDENTIFIER TABLE.10042000 - MAXNAMES =307 #, %MAX NAMES IN EACH ROE OF IDENTIFIER TABLE.10043000 + MAXNAMES =307 #, %MAX NAMES IN EACH ROW OF IDENTIFIER TABLE.10043000 % ONLY USED IN WITH STATEMENT TO TEST 10044001 MAXCASES =64 #, %MAX LABELS IN A CASE-STATEMENT. 10045000 - MAXLABS =50 #, %MAX NUMBER OF LABELS. 10046000 + MAXLABS =50 #, %MAX NUMBER OF IN PROGRAM LABELS. 10046000 MAXPARAMS =200 #, %MAX NUMBER OF PARAMETERS IN WHOLE PROGRAM.10047000 MAXTYPES =250 #, %MAX NUMBER OF DIFFERENT TYPES. 10048000 - MAXCONSTS =100 #, %SIZE OF CONSTANT TABLE. 10049000 + MAXCONSTS =100 #, %SIZE OF TABLE FOR CONSTANTS. 10049000 MAXWITHSYMS= 70 #, %MAX NUMBER OF SYMBOLS USED BY WITH-STATMS.10051000 MAXSYMS =200 #, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 LISTLENGTH =100 #, %MAX LENGTH OF VAR AND PARAM LISTS. 10053000 MAXEXTFILES=10 #, %MAX NUMBER OF EXTERNAL FILES. 10054000 MAXFILES =10 #, %MAX NUMBER OF FILES DECLARED AT ONE TIME. 10055000 - MAXPNTRS =10 #; %MAX NUMBER OF UNDECLARED POINTERS. 10056000 + MAXPNTRS =10 #; %MAX NUMBER OF UNDECLARED POINTERS (FORWD).10056000 $# PATCH 702 FOR PASCAL.XVI.O CONTAINS 4 CARDS. BOOLEAN ARRAY "ERR" 120 TO 4 $: TO EXTEND THE REDUCTIONS OF PATCH 701 TO THE BOOLEAN ARRAY "ERR" FOR NOTING $: THE SYNTAX ERRORS THAT HAVE OCCURRED. THIS PATCH COMPRESSES THE ARRAY FROM @@ -1126,7 +1137,7 @@ $: WHICH REPORTS THE SYNTAX ERRORS. $: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. $: ARRAY ERRP[0:3]; % HOLDS 128 BITS % RECORDS ERROR MESSAGES USED. 10156000 -DEFINE ERR[ERR1] = BOOLEAN(0&ERRP[ERR1.[6:2]][0:ERR1.[4:5]:1]) #; 10156108 +DEFINE ERR[ERR1] = BOOLEAN(0&ERRP[ERR1.[6:2]][0:ERR1.[4:5]:1]) #; 10156100 ERRP[ERRNUM.[6:2]]:=ERRP[ERRNUM.[6:2]] & 1[ERRNUM.[4:5]:0:1]; 20182000 REPLACE POINTER(ERRLINE[0])+4 BY NUMERRS FOR 4 DIGITS; 20194900 $# PATCH 703 FOR PASCAL.XVI.O CONTAINS 6 CARDS. REDUCE THRASHING BY SAVE CORE @@ -1134,17 +1145,17 @@ $: TO IMPROVE RUN-TIME EFFICIENCY BY REDUCING NON-OVERLAYABLE AREAS. $: THIS PATCH REDUCES THE SAVE CORE REQUIREMENTS BY DECREASING THE FILE BLOCK $: SIZES AND ALSO THE NUMBER OF BUFFERS WITHOUT UNDULY RETARDING THE COMPILATION $: SPEED. THE SIZE OF THE DISK AREAS IS KEPT A MULTIPLE OF THE ORIGINAL BLOCK -$: SIZE WHERE RELEVANT TO AVOID INCOMPATIBILITY PROBLEMES. COMPARABLE REDUCTIONS +$: SIZE WHERE RELEVANT TO AVOID INCOMPATIBILITY PROBLEMS. COMPARABLE REDUCTIONS $: IN BLOCK SIZES OF THE OBJECT PROGRAM ARE ALSO MADE. $: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. $: -FILE CARD "SOURCE" (1,10,38); % PASCAL SOURCE CODE INPUT FILE 10035000 +FILE CARD "SOURCE" (1,10,30); % PASCAL SOURCE CODE INPUT FILE 10035000 FILE PASCALGOL DISK SERIAL [20:300] (1,10,30,SAVE 0); % ALGOL CODE FILE10037000 FILE XREFFILE DISK SERIAL [20:3000] (1,3,30); % FOR CROSS REFERENCE 10137000 IF RECSIZE=1 OR RECSIZE=10 THEN GENINT(30) 80119000 GEN(",SAVE",6,3); 80122000 GEN("30);", 4,4); 80123000 -$# PATCH 704 FOR PASCAL.XVI.O HAS 8 CARDS. REDUCE OVERHEADS IN COPYING FILE +$# PATCH 704 FOR PASCAL.XVI.O HAS 8 CARDS. REDUCE OVERHEADS IN COPYING FILE $: TO REDUCE THE COMPILER-S OVERHEADS. FIRSTLY, THE ALGOL CODE FILE $: PASCRUN/DISK IS RENAMED PASCAL/PRELUDE. ORIGINALLY, THE COMPILER COPIED $: THE PASCAL/PRELUDE FILE INTO THE GENERATED CODE FILE BEFORE STARTING TO @@ -1159,12 +1170,12 @@ $: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. $: ERRORS (I5," ERRORS DETECTED ",20("#") /), 10188000 ALIST ("$ SET LIST "), 10189000 - MERGE ("$ SET TAPE RESET $" / 10190100 + MERGE ("$ SET TAPE RESET $" / 10190100 "$ RESET TAPE", T73,"99000000" ), 10190200 TERMMESS ("**** COMPILATION TERMINATED."); 10192000 WRITE(PASCALGOL,MERGE); % ALGOL MUST COMPILE PRELUDE FIRST 90022000 -$ SET VOIDT 90023000 -$ POP VOIDT 90032000 +$ SET VOIDT 90023000 +$ POP VOIDT 90032000 $: "; ALGOL FILE TAPE= PASCAL/PRELUDE SERIAL; ALGOL FILE CARD=", 90119000 $# PATCH 705 FOR PASCAL.XVI.O CONTAINS 21 CARDS. GENERATE A BETTER ZIP $: THIS PATCH TIDIES UP THE CODE THAT GENERATES THE ZIP TO PASS CONTROL TO THE @@ -1179,10 +1190,10 @@ $: ARRAY ZIPARRAY[0:16]; 90092000 DEFINE PPROGNAME = 13 #, PALGOLNAME = 14 #, 90095000 PLIBRARY = 15 #, PUSER = 16 #, 90096000 P(P1) = POINTER(ZIPARRAY[P1])+1 FOR 7 #; 90097000 -$ SET VOIDT 90098000 -$ POP VOIDT 90104000 +$ SET VOIDT 90098000 +$ POP VOIDT 90104000 $ 90109000 - ZIPARRAY[PPROGNAME]:=PROGNAME; ZIPARRAY[PALGOLNAME]:=ALGOLNAME; 90112000 + ZIPARRAY[PPROGNAME]:=PROGNAME; ZIPARRAY[PALGOLNAME]:=ALGOLNAME; 90112000 ZIPARRAY[PLIBRARY]:= IF SAVEFACTOR>0 THEN "LIBRARY" ELSE 90113000 IF SAVEFACTOR<0 THEN " SYNTAX" ELSE " & RUN "; 90114000 ZIPARRAY[PUSER]:=USER; 90115000 @@ -1191,17 +1202,17 @@ $ 90109000 " XALGOL ", P(PLIBRARY), 90118000 "; ALGOL FILE TAPE= PASCAL/PRELUDE SERIAL; ALGOL FILE CARD=", 90119000 P(PALGOLNAME), "/", P(PUSER), " SERIAL; END."; 90120000 -$ SET VOIDT 90121000 -$ POP VOIDT 90128000 -$# PATCH 708 FOR PASCAL.XVI.O CONTAINS 25 CARDS. LINE PRINT FILE MAY BE DISK +$ SET VOIDT 90121000 +$ POP VOIDT 90128000 +$# PATCH 708 FOR PASCAL.XVI.O CONTAINS 25 CARDS. LINE PRINT FILE MAY BE DISK $: TO ENABLE THE COMPILER-S PRINT FILE TO BE LABEL EQUATED TO DISK AS FOR OTHER $: B5700 COMPILERS. IN PARTICULAR, THIS PATCH CHANGES THE NAME TO LINE TO BE -$: CONSISTENT WITH ALL THE SYSTEM COMPILERS. THE ABILITY TO LABEL EQUATED FILE +$: CONSISTENT WITH ALL THE SYSTEM COMPILERS. THE ABILITY TO LABEL EQUATE FILE $: "LINE" TO DISK IS NECESSARY IF THE COMPILER IS TO BE USED FROM A TERMINAL. $: NOTE THAT A BLOCKED FILE SHOULD NOT HAVE VARIABLE LENGTH RECORDS IF IT IS $: TO BE LABEL EQUATED TO A PRINTER. IF LESS THAN A THE MAX NUMBER OF WORDS PER $: RECORD IS WRITTEN, THE BALANCE OF THE RECORD REMAINS UNCHANGED FROM WHAT WAS -$: LAST IN THE FILE BUFFER, SO THAT ON BEING PRINTED "GARBAGE" APPEARS AT THE +$: LAST IN THE FILE BUFFER, SO THAT ON BEING PRINTED "GARBAGE", APPEARS AT THE $: END OF SUCH LINES. $: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. $: @@ -1210,14 +1221,14 @@ SAVE FILE OUT LINE DISK SERIAL [20:1200] (1,17,90,SAVE 1); % PRINT FILE 10036000 ARRAY ICARD, ALGOLCARD[0:9], LINES, XLINE[0:16]; 10130000 % AVOID BLOCKING VARIABLE LENGTH RECORDS 10130001 ARRAY HEADTEXT, ERRLINE[0:16]; 10133000 - WRITE( LINE[NO], 17,XLINE[*]); 20042000 - WRITE( LINE[NO], 17,ERRLINE[*]); 20043000 - WRITE( LINE[NO], 17,XLINE[*]); 20045000 - WRITE( LINE[NO], 17,ERRLINE[*]); 20195000 + WRITE( LINE[NO],17,XLINE[*]); 20042000 + WRITE( LINE[NO],17,XLINE[*]); 20043000 + WRITE(LINE, 17,LINES[*]); 20045000 + WRITE(LINE, 17,ERRLINE[*]); 20195000 LINEPNT :=POINTER(LINES[1]); 20315000 REPLACE LINEPNT-8 BY " " FOR 17 WORDS; 20317000 - REPLACE XLINEPNT-8 BY LINEPNT-8 FOR 17 WORDS; 20318000 - REPLACE POINTER(ERRLINE[*]) BY "**** ", LINEPNT FOR 16 WORDS; 20319000 + REPLACE XLINEPNT-8 BY LINEPNT-8 FOR 17 WORDS; 20318000 + REPLACE POINTER(ERRLINE[*]) BY "**** ", LINEPNT FOR 16 WORDS; 20319000 REPLACE ALGOLPNT BY LINEPNT FOR 9 WORDS; 20321000 REPLACE POINTER(HEADTEXT[*]) BY LINEPNT FOR 10 WORDS, "PAGE 1 ", 20326000 LINEPNT FOR 6 WORDS; 20326100 @@ -1226,7 +1237,7 @@ ARRAY HEADTEXT, ERRLINE[0:16]; 10133000 WRITE(LINE, 17,XREFLINE[*]); LINECNT:=LINECNT+1; 20560000 WRITE(LINE, 17,XREFLINE[*]); LINECNT:=LINECNT+1; 20571000 WRITE(LINE, TERMMESS); 90084000 - WRITE(LINE, NOERRORS); 90111000 + WRITE(LINE, NOERRORS); 90111000 WRITE(LINE, ERRORS,NUMERRS); 91110000 WRITE(LINE, ERRORMESS1[I]); 91112000 WRITE(LINE, ERRORMESS2[I-60]); 91114000 @@ -1241,15 +1252,15 @@ $: THE LIST OPTION IS SET AFTER THE FIRST CARD OR EXPLICITLY THEREAFTER, OR $: IN THE "PRINTERRORS" ROUTINE. $: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. $: - IF PAGECNT=1 THEN WRITE(LINE[NO],17,HEADTEXT[*]) ELSE 20029000 + IF PAGECNT=1 THEN WRITE(LINE[NO],17,HEADTEXT[*]) ELSE 20029900 WRITE( LINE[PAGE]); 20030000 WRITE( LINE[DBL],17,HEADTEXT[*]); 20031000 IF NOT LISTOPTION THEN 20194000 BEGIN IF PAGECNT=0 THEN HEADING; PRINTLINE END; 20194100 - REPLACE POINTER(HEADTEXT[*])+45 BY TEXTPNT+3 FOR 2,"/", 20329000 + REPLACE POINTER(HEADTEXT[*])+45 BY TEXTPNT+5 FOR 2,"/", 20329000 TEXTPNT+1 FOR 2, "/", TEXTPNT+3 FOR 2; 20330000 - NEWCARD; LISTOPTION:=CHECKOPTION:=TRUE; % DEFAULT 20402100 - INSYMBOL; % ANALYSING FIRST CARD MAY CHANGE DEFAULT LIST OPTN 20402200 + NEWCARD; LISTOPTION:=CHECKOPTION:=TRUE; % DEFAULT 20402100 + INSYMBOL; % ANALYSING FIRST CARD MAY CHANGE DEFAULT LIST OPTN 20402200 IF LISTOPTION AND PAGECNT=0 THEN HEADING; % ON FIRST PAGE. 20402300 IF LISTOPTION THEN IF PAGECNT=0 THEN HEADING; % ON FIRST PAGE30282100 C := " "; % TO INITIALIZE "INSYMBOL" 90034000 @@ -1258,14 +1269,26 @@ $ 90036000 IF PAGECNT > 0 % THERE HAS BEEN SOME LISTING 90088000 THEN BEGIN WRITE( LINE[DBL] ); WRITE( LINE[DBL] ) END; 90089000 IF PAGECNT>0 THEN % THERE HAS BEEN LISTING 90110000 -$# PATCH 711 FOR PASCAL.XVI.O CONTAINS 10 CARDS. PASC001/USERCODE UNIQUE NAME +$# PATCH 710 FOR PASCAL.XVI.0 CONTAINS 4 CARDS. NO OVERPRINTING WITH BLANK LINE +$: TO PREVENT OVERPRINTING WITH BLANK LINES. IF THE OPTION FOR "BOLDFACE" +$: PRINTING OF RESERVED WORDS IS SET (*$R+ *) THEN EACH LINE IS CONSTRUCTED BY +$: 2 OVERPRINTS FOR THE RESERVED WORDS ONLY, THEN ONE PRINT OF THE FULL TEXT. +$: THE AIM OF THIS PATCH IS TO SKIP THE OVERPRINTING FOR ALL THOSE LINES IN +$: WHICH NO RESERVED WORDS OCCUR. +$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. +$: +DEFINE RESWORDPRESENT = RESWORDOPTION.[1:1] #; 10159100 + IF REAL(RESWORDOPTION) = 3 THEN % RESERVED WORD IS PRESENT 20040000 + RESWORDOPTION := RESWORDOPTION AND TRUE; % RESET RESWORDPRESENT 20057100 + RESWORDOPTION := BOOLEAN(3); % SET RESWORDPRESENT BIT 30179000 +$# PATCH 711 FOR PASCAL.XVI.O CONTAINS 10 CARDS. PASC001/USERCODE UNIQUE NAME $: TO GENERATE A UNIQUE FILE NAME IN THE DISK DIRECTORY. THIS PATCH CHANGES THE $: METHOD FOR GENERATING A UNIQUE FILE NAME FOR THE ALGOL SOURCE CODE OUTPUT OF $: THE COMPILER. FORMERLY, THIS WAS DONE USING THE TIME FUNCTION TO OBTAIN $: SOME RANDOM DIGITS. THE METHOD USED IN PATCH/MERGE IS ADOPTED HERE, NAMELY -$: STARTING WITH THE PREFIX (MFID) "PASC001", A SEARCH IS PREFORMED TO DETERMINE +$: STARTING WITH THE PREFIX (MFID) "PASC001", A SEARCH IS PERFORMED TO DETERMINE $: WHETHER SUCH A FILE NAME IS ALREADY CATALOGUED. IF SO, 1 IS ADDED AND THE -$: SEARCH REPEATED. IN ADDITION, THE FILE IS CREATED WITH A SAVE FACTOR +$: SEARCH REPEATED. IN ADDITION, THE FILE IS CREATED WITH A SAVE FACTOR $: (RETENTION PERIOD) OF ZERO DAYS SO THAT A HALT-LOAD WILL REMOVE THE FILE $: AUTOMATICALLY. $: SEE PATCH 704. @@ -1286,10 +1309,10 @@ $: PATCH TO MARK THE START AND END OF PROCEDURES AND FUNCTIONS BY ANNOTATING THE $: MARGIN WITH THE SYMBOLS "+P" & "-P" FOLLOWED BY THE LEVEL NUMBER. $: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. $: - MARGIN("+P",CURLEVEL); % MARK PROCEDURE LEVEL 80420100 - MARGIN("-P",CURLEVEL); % MARK END OF PROCEDURE 80702100 -$# PATCH 713 FOR PASCAL.XVI.O CONTAINS 14 CARDS.CORRECTS ERROR MESSAGE ETC. -$: CORRECTS THE DOUBLE "NO ERROS" MESSAGE AND THE OUTPUT OF HEADINGS + MARGIN("+P",CURLEVEL); % MARK PROCEDURE LEVEL 80420100 + MARGIN("-P",CURLEVEL); % MARK END OF PROCEDURE 80702100 +$# PATCH 713 FOR PASCAL.XVI.O. CONTAINS 14 CARDS.CORRECTS ERROR MESSAGE ETC. +$: CORRECTS THE DOUBLE "NO ERRORS" MESSAGE AND THE OUTPUT OF HEADINGS $: WHEN L1 IS SET AFTER L-. $: ALSO CORRECTS THE SCANNING PROBLEM WHEN COMPILER OPTIONS ARE INCORRECT. $: DAVID A COOPER, HERIOT-WATT UNIVERISTY ...... AUGUST 1978 @@ -1307,38 +1330,37 @@ $: WRITE(LINE,ERROR102MESS); 90090720 $ 90110000 $ 90111000 - ("102 ***WARNING ONLY, ILLEGAL DOLLAR OPTION."), 91106900 + ("102 ***WARNING ONLY, ILLEGAL DOLLAR OPTION."), 91106900 $# PATCH 800 FOR PASCAL.XVI.O.CONTAINS 10 CARDS. $: TO REMOVE CONFLICTS BETWEEN HERIOT-WATT & NATAL EXISTING PATCHES. $: MAXSYMS = 800#, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 MAXPNTRS = 25#; %MAX NUMBER OF UNDECLARED POINTERS(FORWD). 10056000 -DEFINE ERR(ERR1) = BOOLEAN(0&ERRP[(ERR1).[6:2]][0:((ERR1).[4:5]):1])#; 10156108 +DEFINE ERR(ERR1) = BOOLEAN(0&ERRP[(ERR1).[6:2]][0:((ERR1).[4:5]):1])#; 10156100 INTEGER EXPRLEVEL, EXPINVARCNT; % 40018000 - INTEGER INDEX, CTYPE, NUMFORWARDS, TX, I; % 80403000 + INTEGER INDEX, CTYPE, NUMFORWARDS,TX, I; % 80403000 INTEGER PROGNAMELENGTH; % 90013900 IF ERR(100) % 90090600 "; ALGOL FILE TAPE=PASCRUN/DISK SERIAL; ALGOL FILE CARD=", 90119000 P(PALGOLNAME),"/",P(PUSER)," SERIAL;", % 90120000 " XALGOL STACK = 2048; END."; % 90120500 $# PATCH 998 FOR PASCAL.XVI.O CONTAINS 10 CARDS. INSERT PAGE THROWS AT DESIRED -$: PATCH TO INSERT PAGE THROWS AT DESIRED POINTES IN THE SOURCE TO PRODUCE A +$: PATCH TO INSERT PAGE THROWS AT DESIRED POINTS IN THE SOURCE TO PRODUCE A $: NICELY LAID OUT LISTING. $: -$ PAGE 19000000 -$ PAGE 20290000 -$ PAGE 29000000 -$ PAGE 39000000 -$ PAGE 49000000 -$ PAGE 59000000 -$ PAGE 69000000 -$ PAGE 79000000 -$ PAGE 89000000 -$ PAGE 90070999 +$ PAGE 19000000 +$ PAGE 20290000 +$ PAGE 29000000 +$ PAGE 39000000 +$ PAGE 49000000 +$ PAGE 59000000 +$ PAGE 69000000 +$ PAGE 79000000 +$ PAGE 89000000 +$ PAGE 90070999 $: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. $: -$# PATCH 999 FOR PASCAL.XVI.O CONTAINS 1 CARDS. VERISON NUMBER. +$# PATCH 999 FOR PASCAL.XVI.O. CONTAINS 1 CARDS. VERISON NUMBER. $: -DEFINE EDITION = "4.4"#;%AUGUST 1978...DAVID A COOPER... 10028000 - +DEFINE EDITION = "4.4"#;%AUGUST 1978...DAVID A COOPER... 10028000 ?END diff --git a/PASCAL-Heriot-Watt/README.txt b/PASCAL-Heriot-Watt/README.txt index bd1fb5f..f9749cb 100644 --- a/PASCAL-Heriot-Watt/README.txt +++ b/PASCAL-Heriot-Watt/README.txt @@ -5,10 +5,11 @@ written by Dag F. Langmyhr at Heriot-Watt University in Edinburgh, Scotland, ca. 1975. Rather than compiling Pascal source to B5500 object code, this compiler -translates the Pascal source to Burroughs Algol. The PASCRUN/DISK file -is Algol source that is inserted into the Algol generated from the -Pascal source to provide a run-time system -- actually it is more like a -shim between Pascal and standard Algol intrinsics and I/O. +translates the Pascal source to Burroughs Compatible Algol (XAlgol). The +PASCRUN/DISK file is an XAlgol source that is inserted into the XAlgol +generated from the Pascal source to provide a run-time system -- +actually it is more like a shim between Pascal and standard XAlgol +intrinsics and I/O. The compiler, run-time system, and patches were originally transcribed by Rich Cornwell of North Carolina, US. Proofing and correction were @@ -24,40 +25,71 @@ HMSS2.TEST.card HMSS2.TEST.lst Listing produced by running the HMSS2.TEST.card job, including the - Pascal compiler listing, a listing of the generated Algol code, and + Pascal compiler listing, a listing of the generated XAlgol code, and the output from running the generated program. -PASCAL.MARKXIII.card - Compile deck and patches to allow the PASCAL compiler to compile - using B5500 Mark XIII Algol. +PASCAL.MKXIII.card + Compile deck and patches to allow SYMBOL.PASCAL.alg_m to compile + using the B5500 Mark XIII XAlgol compiler. -PASCAL.MARKXIII-Compile.lst +PASCAL.MKXIII-Compile.lst Listing produced by running the PASCAL.MARKXIII.card job. +PASCAL.MKXV-Compile.lst + Listing produced by compiling unpatched SYMBOL.PASCAL.alg_m with the + Mark XV XAlgol compiler. + PASCRUN.DISK.alg_m - Algol source for the run-time system inserted into the translated - Algol by the compiler. Transcribed from + XAlgol source for the run-time system inserted into the translated + XAlgol by the compiler. Transcribed from http://bitsavers.org/pdf/burroughs/B5000_5500_5700/listing/ B5700_Pascal_Apr78.pdf. PATCHES.PASCAL.card Card deck containing patches to the Pascal compiler in PATCH/MERGE - format. Transcribed from + format. Transcribed from the listing in the front of http://bitsavers.org/pdf/burroughs/B5000_5500_5700/listing/ B5700_Pascal_Mar79.pdf. + **NOTE** This series of patches uses compiler features, primarily $- + cards, that were implemented after Mark XIII. It works under Mark + XV, but will not work under Mark XIII software without some + modifications. + +PATCHES.PASCAL.MKXV-Compile.lst + PATCH/MERGE output and XAlgol listing produced by running + PATCHES.PASCAL.card under Mark XV system software. This run + generated the updated symbol file SYMNEW.PASCAL.alg_m. SYMBOL.PASCAL.alg_m Source for the Pascal compiler/translator, written in Burroughs - Extended Algol for the B5500. Transcribed from + XAlgol for the B5500. Transcribed from http://bitsavers.org/pdf/burroughs/B5000_5500_5700/listing/ B5700_Pascal_Mar79.pdf. +SYMNEW.PASCAL.alg_m + Updated XAlgol source for the Pascal compiler/translator, produced + by applying the patches in PATCHES.PASCAL.card to + SYMBOL.PASCAL.alg_m. + **PLEASE NOTE** + 1. This source was generated using Mark XV system software. The + source uses XAlgol constructs that are not available in the + Mark XIII compiler. + 2. Use of this compiler requires changes to the PASCRUN/DISK + run-time system. AT PRESENT WE DO NOT HAVE THOSE CHANGES. + This file and PATCHES.PASCAL.MKXV-Compile.lst are provided + mainly for historical interest; at this point you probably + do not want to try to use them. +__________ 2016-06-12 Paul Kimpel Initial commits to source control. 2016-07-04 Paul Kimpel - Commit proofreading corrections to SYMBOL.PASCAL and PASCRUN.DISK. - Commit compile deck and listing with patches to allow the compiler - to work with B5500 Mark XIII Algol. Commit compile & go deck and - output listing for HMSS2.TEST sample program. + Commit proofreading corrections to SYMBOL.PASCAL.alg_m and + PASCRUN.DISK.alg_m. Commit compile deck and listing with patches to + allow the compiler to work with B5500 Mark XIII Algol. Commit + compile & go deck and output listing for HMSS2.TEST sample program. +2017-07-16 Paul Kimpel + Commit proofreading corrections to PASCAL.PATCHES.card. Commit + additional listings for Mark XV, the patch deck, and resulting + updated compiler source file. diff --git a/PASCAL-Heriot-Watt/SYMNEW.PASCAL.alg_m b/PASCAL-Heriot-Watt/SYMNEW.PASCAL.alg_m new file mode 100644 index 0000000..4e66b86 --- /dev/null +++ b/PASCAL-Heriot-Watt/SYMNEW.PASCAL.alg_m @@ -0,0 +1,4243 @@ + 10001000 + 10002000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10003000 +% % 10004000 +% % 10005000 +% * * % 10006000 +% * P A S C A L C O M P I L E R * % 10007000 +% *********************************** % 10008000 +% % 10009000 +% % 10010000 +% WRITTEN 1975 BY % 10011000 +% DAG F. LANGMYHR, % 10012000 +% HERIOT-WATT UNIVERSITY, % 10013000 +% EDINBURGH. % 10014000 +% % 10015000 +% % 10016000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10017000 +% % 10018000 +% % 10019000 +% PART 1: DECLARATIONS. % 10020000 +% ------------- % 10021000 +% % 10022000 +% % 10023000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10024000 + 10025000 + 10026000 +BEGIN 10027000 +DEFINE EDITION = "4.4"#;%AUGUST 1978...DAVID A COOPER... %999-10028000 +INTEGER NUMERRS, % @R+25: NUMBER OF ERRORS IN PROGRAM. %500-10029000 + SAVEFACTOR, % @R+26: SAVEFACTOR FOR CODE FILE. %500-10030000 + % >0 COMPILE TO LIBRARY. 10031000 + % =0 COMPILE AND RUN. 10032000 + % <0 COMPILE FOR SYNTAX. 10033000 + PAGECNT, % @R+27: NUMBER OF PAGES PRINTED. %500-10033800 + CARDCNT; % @R+30: NUMBER OF CARDS READ. %500-10034000 +FILE CARD "SOURCE" (1,10,30); % PASCAL SOURCE CODE INPUT FILE %703-10035000 +SAVE FILE OUT LINE DISK SERIAL [20:1200] (1,17,90,SAVE 1); % PRINT FILE 10036000 + % AVOID BLOCKING RECORDS OF VARIABLE LENGTH%708-10036001 +FILE PASCALGOL DISK SERIAL [20:300] (1,10,30,SAVE 0); % ALGOL CODE FILE10037000 +DEFINE LINESPERPAGE = 60 #, %502-10038000 + MAXINT=549755813887#; 10039000 + 10040000 +%*** COMPILER CONSTANTS *** 10041000 +DEFINE MAXTABLES = 30 #, %MAX NUMBER OF LEVELS IN IDENTIFIER TABLE.10042000 + MAXNAMES =307 #, %MAX NAMES IN EACH ROW OF IDENTIFIER TABLE.10043000 + MAXLEVEL =15#, %MAX DEPTH OF PROCEDURE DECLARATIONS. 10044000 + % ONLY USED IN WITH STATEMENT TO TEST %701-10044001 + MAXCASES =64 #, %MAX LABELS IN A CASE-STATEMENT. %701-10045000 + MAXLABS =50 #, %MAX NUMBER OF IN PROGRAM LABELS. %701-10046000 + MAXPARAMS =200 #, %MAX NUMBER OF PARAMETERS IN WHOLE PROGRAM.10047000 + MAXTYPES =250 #, %MAX NUMBER OF DIFFERENT TYPES. %701-10048000 + MAXCONSTS =100 #, %SIZE OF TABLE FOR CONSTANTS. %701-10049000 + MAXTEMPS =5#, %NUMBER OF EXTRA VARS IN EACH PROCEDURE. 10050000 + MAXWITHSYMS= 70 #, %MAX NUMBER OF SYMBOLS USED BY WITH-STATMS.10051000 + MAXSYMS = 800#, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 + LISTLENGTH =100 #, %MAX LENGTH OF VAR AND PARAM LISTS. %701-10053000 + MAXEXTFILES=10 #, %MAX NUMBER OF EXTERNAL FILES. %701-10054000 + MAXFILES =10 #, %MAX NUMBER OF FILES DECLARED AT ONE TIME. 10055000 + MAXPNTRS = 25#; %MAX NUMBER OF UNDECLARED POINTERS(FORWD). 10056000 + 10057000 +%*** NAME TABLES *** 10058000 +ARRAY NAMETAB1,NAMETAB2,NAMETAB3[0:MAXTABLES,0:MAXNAMES]; 10059000 +DEFINE NAMELENGTH =[41:6]#, 10060000 + TYPE =[9:10]#, 10061000 + IDCLASS =[12:3]#, 10062000 + VAR =0#, 10063000 + CONST=1#, 10064000 + FUNC =2#, 10065000 + PROC =3#, 10066000 + TYPES=4#, 10067000 + INFO =[23:11]#, 10068000 + FORMAL =[24:1]#, 10069000 + FORWARDDEF =[25:1]#, 10070000 + EXTERNALFILE=[26:1]#; 10071000 + 10072000 +%*** DISPLAY VECTOR *** 10073000 +ARRAY DISPLAY[0:MAXLEVEL]; 10074000 +DEFINE RECTYPE =[9:10]#, 10075000 + FIRSTWITHSYM =[19:10]#, 10076000 + LASTWITHSYM =[29:10]#, 10077000 + NUMPNTRSINWITH=[35:6]#, 10078000 + BRACKETSINWITH=[36:1]#, 10079000 + NAMETAB =[46:7]#; 10080000 + 10081000 +%*** TYPE TABLES *** 10082000 +ARRAY TYPETAB1,TYPETAB2,TYPETAB3[0:MAXTYPES]; 10083000 +DEFINE FORM =[3:4]#, 10084000 + NUMERIC =0#, 10085000 + SYMBOLIC=1#, 10086000 + SUBTYPE =2#, 10087000 + MAINTYPE=[33:10]#, 10088000 + CHAR =3#, 10089000 + FLOATING=4#, 10090000 + ALFA =5#, 10091000 + SET =6#, 10092000 + SETTYPE =[33:10]#, 10093000 + POINTERS=7#, 10094000 + POINTTYPE=[33:10]#, 10095000 + ARRAYS =8#, 10096000 + INXTYPE =[33:10]#, 10097000 + ARRTYPE =[43:10]#, 10098000 + RECORD =9#, 10099000 + RECTAB =[33:10]#, 10100000 + FILES =10#, 10101000 + FILETYPE=[33:10]#, 10102000 + TEXTFILE=11#, 10103000 + SIZE =[15:12]#, 10104000 + STRUCT=[23:8]#; 10105000 +INTEGER NUMTYPES; 10106000 + 10107000 +%*** PARAMETER TABLE *** 10108000 +ARRAY PARAMTAB, FORWPARAM1, FORWPARAM2[0:MAXPARAMS]; %002-10109000 +DEFINE PARAMNAME =[9:10]#, 10110000 + PARAMKIND =[13:4]#, 10111000 + PARAMLEVEL=[23:10]#, 10112000 + PARAMTYPE =[33:10]#, 10113000 + PARAMFILE =[34:1]#; 10114000 +INTEGER NUMPARAMS; 10115000 + 10116000 +%*** CONSTANT TABLE *** 10117000 +ARRAY CONSTTAB[0:MAXCONSTS]; 10118000 +INTEGER NUMCONSTS; 10119000 + 10120000 +%*** LABEL TABLE *** 10121000 +ARRAY LABTAB[0:MAXLABS]; 10122000 +DEFINE LABVAL=[14:15]#, 10123000 + LABDEF=[15:1]#; 10124000 +INTEGER NUMLABS,FIRSTLAB; 10125000 + 10126000 +%*** TABLES FOR I/O AND CHARACTER HANDLING *** 10127000 +ARRAY CH[0:0], TEXT[0:1], STRING[0:11]; 10128000 + POINTER CHARPNT,TEXTPNT,TEXTPNT0,STRINGPNT; 10129000 +ARRAY ICARD, ALGOLCARD[0:9], LINES, XLINE[0:16]; %708-10130000 + % AVOID BLOCKING VARIABLE LENGTH RECORDS 10130001 + POINTER CARDPNT,LINEPNT,XLINEPNT,ALGOLPNT; 10131000 + INTEGER CHARCNT,ALGOLCNT,MARGINCNT; 10132000 +ARRAY HEADTEXT, ERRLINE[0:16]; %708-10133000 + INTEGER LINECNT, ERRINX; % PAGECNT @ PRT+27 %500-10134000 + 10135000 +%*** XREF FILE AND TABLE *** 10136000 +FILE XREFFILE DISK SERIAL [20:3000] (1,3,30); % FOR CROSS REFERENCE 10137000 +ARRAY BLOCKTAB[0:MAXTABLES], XREFLINE[0:16]; 10138000 +ALPHA ARRAY XBUFF[0:2]; %002-10138500 +BOOLEAN XINB; %002-10138550 + INTEGER NUMXREF,NUMBLOCKS; POINTER XREFPNT; 10139000 +% 10140000 +%*** OTHER TABLES *** 10141000 +INTEGER ARRAY VARLIST[0:LISTLENGTH]; % TEMPORARY LIST OF VARIABLES. 10142000 + INTEGER VARINDEX,FIRSTVAR; 10143000 +ALPHA ARRAY SYMTAB[0:MAXSYMS]; % USED BY "EXPRESSION". %517-10144000 + INTEGER NUMSYMS; 10145000 +ARRAY WITHTAB[0:MAXWITHSYMS]; % USED BY "WITHSTAT". 10146000 + INTEGER NWITHSYMS; 10147000 +INTEGER ARRAY SYMBOL[0:64]; % USED BY "INSYMBOL". 10148000 +INTEGER ARRAY SYMKIND[0:62]; %USED IN ERROR RECOVERY. %002-10149000 +ARRAY PNTRTAB1,PNTRTAB2,PNTRTAB3[0:MAXPNTRS];% USED FOR FORWARD POINTERS10150000 + INTEGER NUMPNTRS; 10151000 +ARRAY EXTFILETAB[0:MAXEXTFILES]; % EXTERNAL FILES. 10152000 + INTEGER NUMEXTFILES; 10153000 +ARRAY FILETAB[0:MAXFILES]; % FILES IN USE. 10154000 + INTEGER NUMFILES; 10155000 +ARRAY ERRP[0:3]; % HOLDS 128 BITS % RECORDS ERROR MESSAGES USED. 10156000 +DEFINE ERR(ERR1) = BOOLEAN(0&ERRP[(ERR1).[6:2]][0:((ERR1).[4:5]):1])#; 10156100 + DEFINE %518-10156200 + PERMSUB = 0 #, MAXTOTALSUBSCRS = 100#, %518-10156300 + ARRNAM = 1 #; %518-10156400 + ARRAY ARRSUBPERMTAB[0:1,0:MAXTOTALSUBSCRS]; %518-10156500 + INTEGER PASSPERMTAB, MAXPERMTAB, REMEMBERPOSN; %518-10156600 + 10157000 +%*** COMPILE TIME OPTIONS *** 10158000 +BOOLEAN LISTOPTION,RESWORDOPTION,CHECKOPTION,DUMPOPTION,XREFOPTION; 10159000 +DEFINE RESWORDPRESENT = RESWORDOPTION.[1:1] #; %710-10159100 +INTEGER CARDLENGTH; 10160000 + 10161000 +%*** INTRINSIC TYPES *** 10162000 +INTEGER INTTYPE,REALTYPE,ALFATYPE,CHARTYPE,BOOLTYPE,NILTYPE,TEXTTYPE, 10163000 + INPUTFILE,OUTPUTFILE,EMPTYSET; 10164000 +BOOLEAN INPUTDECL,OUTPUTDECL; 10165000 + 10166000 +%*** OTHER VARIABLES *** 10170000 +ALPHA USER; % THE USER NUMBER FOUND ON THE USER CARD.10171000 + 10172000 +INTEGER CURLEVEL, % CURRENT PROCEDURE LEVEL. 10173000 + TOPLEVEL, % TOP LEVEL IN DISPLAY VECTOR. 10174000 + NUMBEGINS, % NUMBER OF "BEGIN"S IN THE PROGRAM. 10175000 + NUMCASES, % NUMBER OF CASE-STATEMENTS IN PROGRAM. 10176000 + NUMREPS, % NUMBER OF REPEAT-STATEMENTS IN PROGRAM. 10177000 + NUMTEMPS, % NUMBER OF TEMPORARY VARIABLES IN USE. 10178000 + CURFUNC, % INDEX OF FUNCTION CURRENTLY COMPILED. 10179000 + CURSY, % LAST SYMBOL READ BY SCANNER. 10180000 + CURTYPE, % TYPE OF ENTITY LAST COMPILED. 10181000 + CURMODE, % CURRENT EXPRESSION MODE. 10182000 + LASTREC; % LAST RECORD TABLE DEFINED. 10183000 + 10184000 +LABEL ENDOFINPUT; 10185000 + 10186000 +FORMAT NOERRORS ("NO ERRORS DETECTED."), 10187000 + ERRORS (I5," ERRORS DETECTED ",20("#") /), %704-10188000 + ERROR100MESS (//"100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION10188500 +. THE VALUE 07 IS SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT TH10188600 +E COMPILATION ERRORS COUNT."//),% %002-10188700 + ERROR102MESS(//"102 *** WARNING ONLY, ILLEGAL COMPILER OPTION.")10188750 + , % %713-10188751 + ALIST ("$ SET LIST "), %704-10189000 + NOALIST ("$ RESET LIST"), 10190000 + MERGE ("$ SET TAPE RESET $" / %704-10190100 + "$ RESET TAPE", T73,"99000000" ), %704-10190200 + LASTLINE ("; TERMINATE: END OF PASCAL PROGRAM."), 10191000 + TERMMESS ("**** COMPILATION TERMINATED."); %704-10192000 +MONITOR EXPOVR:=REALOVERFLOW; 10193000 + 10194000 +%*** SCANNER SYMBOLS *** 10195000 +DEFINE IDENTIFIER=1#, INTCONST=2#, REALCONST=3#, ALFACONST=4#, 10196000 + CHARCONST=5#, NOTSY=6#, ASTERISK=7#, SLASH=8#, 10197000 + ANDSY=9#, DIVSY=10#, MODSY=11#, PLUS=12#, 10198000 + MINUS=13#, ORSY=14#, LSSSY=15#, LEQSY=16#, 10199000 + GEQSY=17#, GTRSY=18#, NEQSY=19#, EQLSY=20#, 10200000 + INSY=21#, LPAR=22#, RPAR=23#, LBRACKET=24#, 10201000 + RBRACKET=25#, DOUBLEDOT=26#, COMMA=27#, SEMICOLON=28#, 10202000 + DOT=29#, ARROW=30#, COLON=31#, ASSIGNSY=32#, 10203000 + BEGINSY=33#, ENDSY=34#, IFSY=35#, THENSY=36#, 10204000 + ELSESY=37#, CASESY=38#, OFSY=39#, REPEATSY=40#, 10205000 + UNTILSY=41#, WHILESY=42#, DOSY=43#, FORSY=44#, 10206000 + TOSY=45#, DOWNTOSY=46#, GOTOSY=47#, NILSY=48#, 10207000 + TYPESY=49#, ARRAYSY=50#, RECORDSY=51#, FILESY=52#, 10208000 + SETSY=53#, CONSTSY=54#, VARSY=55#, LABELSY=56#, 10209000 + FUNCSY=57#, PROCSY=58#, WITHSY=59#, PROGRAMSY=60#, 10210000 + PACKEDSY=61#, ASSERTSY=62#; %002-10211000 + 10212000 +DEFINE INITIAL=0#, MIDDLE=1#, TERMINAL=2#; 10213000 +DEFINE NUMBER=0#, BITPATTERN=1#; 10214000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%20001000 +% %20002000 +% %20003000 +% %20004000 +% PART 2: COMPILER UTILITY ROUTINES. %20005000 +% -------------------------- %20006000 +% %20007000 +% %20008000 +% %20009000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%20010000 + 20011000 + 20012000 +PROCEDURE INSYMBOL; FORWARD; 20013000 +PROCEDURE WRITEALGOL; FORWARD; 20014000 +PROCEDURE NEWXREF(NAME1,NAME2,TABLE,DECL); 20015000 + VALUE NAME1,NAME2,TABLE,DECL; %700-20016000 + REAL NAME1,NAME2; %700-20017000 + INTEGER TABLE; BOOLEAN DECL; %700-20018000 + FORWARD; %700-20019000 +PROCEDURE PRINTERRORS; FORWARD; %700-20020000 + 20021000 +DEFINE NDIGITS(N)= 20022000 +IF N{ 9 THEN 1 ELSE 20023000 +IF N{99 THEN 2 ELSE 3 DIGITS#; 20024000 + 20025000 +PROCEDURE HEADING; %*** PRINTS A HEADING AT START OF NEW PAGE.20026000 +BEGIN DEFINE NEWSEGMENT = HERE #; %700-20027000 + PAGECNT:=PAGECNT+1; 20028000 + REPLACE POINTER(HEADTEXT[*])+85 BY PAGECNT FOR NDIGITS(PAGECNT); 20029000 + IF PAGECNT=1 THEN WRITE(LINE[NO],17,HEADTEXT[*]) ELSE %709-20029900 + WRITE( LINE[PAGE]); %709-20030000 + WRITE( LINE[DBL],17,HEADTEXT[*]); %709-20031000 + LINECNT:=2; 20032000 +END OF HEADING; %700-20033000 + 20034000 + 20035000 +PROCEDURE PRINTLINE; %*** PRINTS A PASCAL SOURCE CODE LINE %700-20036000 +BEGIN DEFINE NEWSEGMENT = HERE #; %700-20037000 + REPLACE LINEPNT-8 BY CARDCNT FOR 5 DIGITS; 20038000 + IF LINECNT}LINESPERPAGE THEN HEADING; 20039000 + IF REAL(RESWORDOPTION) = 3 THEN % RESERVED WORD IS PRESENT %710-20040000 + BEGIN 20041000 + WRITE( LINE[NO],17,XLINE[*]); %708-20042000 + WRITE( LINE[NO],17,XLINE[*]); %708-20043000 + END; 20044000 + WRITE(LINE, 17,LINES[*]); %708-20045000 + LINECNT:=LINECNT+1; 20046000 +END OF PRINTLINE; %700-20047000 + 20048000 + 20049000 +PROCEDURE NEWCARD; %*** READS A NEW PASCAL SOURCE CODE CARD 20050000 +BEGIN DEFINE RESULT = ICARD[*], ETC #; %700-20051000 + IF LISTOPTION THEN PRINTLINE; 20052000 + IF ERRINX>0 THEN PRINTERRORS; 20053000 + READ(CARD,10,ICARD[*]) [ENDOFINPUT]; 20054000 + CARDPNT:=POINTER(ICARD[*]); 20055000 + REPLACE XLINEPNT BY " " FOR 16 WORDS; %700-20056000 + REPLACE LINEPNT BY CARDPNT FOR 10 WORDS, XLINEPNT FOR 6 WORDS;%700-20057000 + RESWORDOPTION := RESWORDOPTION AND TRUE; % RESET RESWORDPRESENT 20057100 + CHARCNT:=CARDLENGTH; 20058000 + MARGINCNT:=85; 20059000 + CARDCNT:=CARDCNT+1; 20060000 +END OF NEWCARD; %700-20061000 + 20062000 + 20063000 +DEFINE GEN(GEN1,GEN2,GEN3) = GENI(TRUE,GEN1,GEN3,GEN2) #, %700-20063100 +GENID(GENID1,GENID2,GENID3)= GENI(FALSE,GENID1,GENID2,GENID3) #; %700-20063200 + %700-20063300 +PROCEDURE GENI(GENT, TXT, NUM, N ); %700-20063400 +VALUE GENT, TXT, NUM, N; %700-20063500 +BOOLEAN GENT; ALPHA TXT; INTEGER NUM, N; %700-20063600 +BEGIN DEFINE START = NUM #, NDIG = N #; %700-20063700 + %700-20063800 + IF GENT THEN %*** GENERATE A TEXT "TXT", CONSISTING OF 20064000 +BEGIN %*** "N" LETTERS, STARTING AT "START". 20065000 + IF ALGOLCNT 0 THEN 20117000 + BEGIN 20118000 + WHILE ABSX}1@7 DO BEGIN ABSX:=ABSX/10; POWER:=POWER+1; END; 20119000 + WHILE ABSX<1@6 DO BEGIN ABSX:=ABSX|10; POWER:=POWER-1; END; 20120000 + V1:=ENTIER(ABSX); 20121000 + V2:=ENTIER((ABSX-V1)|1000000); 20122000 + REPLACE ALGOLPNT:ALGOLPNT BY V1 FOR 7 DIGITS, ".", 20123000 + V2 FOR 6 DIGITS, "@"; 20124000 + ALGOLCNT:=ALGOLCNT-15; 20125000 + IF POWER<0 THEN GEN("-",1,7); 20126000 + POWER:=ABS(POWER); 20127000 + REPLACE ALGOLPNT:ALGOLPNT BY POWER FOR 2 DIGITS; 20128000 + ALGOLCNT:=ALGOLCNT-2; 20129000 + END ELSE GEN("0",1,7); 20130000 + IF X<0 THEN GEN(")",1,7); 20131000 + END; 20132000 +END OF GENREAL; 20133000 + 20134000 + 20135000 +INTEGER TYPEINDEX; 20136000 + 20137000 +DEFINE NEWTYPE= 20138000 +BEGIN 20139000 + IF NUMTYPES}MAXTYPES THEN BEGIN ERROR(45);NUMTYPES:=MAXTYPES-20 END;20140000 + TYPEINDEX:=NUMTYPES:=NUMTYPES+1; 20141000 +END #; 20142000 + 20143000 + 20144000 +PROCEDURE WRITEALGOL; %*** WRITES A COMPLETED ALGOL CARD TO%700-20145000 +BEGIN %*** THE FILE. 20146000 + DEFINE NEWSEGMENT = HERE #; %700-20146100 + REPLACE POINTER(ALGOLCARD[9]) BY CARDCNT FOR 8 DIGITS; 20147000 + WRITE(PASCALGOL,10,ALGOLCARD[*]); 20148000 + IF DUMPOPTION THEN BEGIN IF (LINECNT:=LINECNT+1)}LINESPERPAGE %502-20149000 + THEN HEADING; WRITE(LINE,10,ALGOLCARD[*]) END; %502-20149100 + ALGOLPNT:=POINTER(ALGOLCARD[*]); ALGOLCNT:=71; 20150000 + REPLACE ALGOLPNT BY " " FOR 9 WORDS; 20151000 +END OF WRITEALGOL; 20152000 + 20153000 + 20154000 +DEFINE MARGIN(LETTER,NUM)= 20155000 +BEGIN COMMENT *** PLACES INFORMATION IN THE MARGIN. ; 20156000 + IF MARGINCNT{118 THEN 20157000 + BEGIN TEXT[0]:=LETTER; 20158000 + REPLACE LINEPNT+MARGINCNT BY TEXTPNT+5 FOR 2, 20159000 + NUM FOR NDIGITS(NUM); 20160000 + MARGINCNT:=MARGINCNT+6; 20161000 + END; 20162000 +END OF MARGIN#; 20163000 + 20164000 + 20165000 +PROCEDURE SKIP(SYMBOL); %*** SKIP SYMBOLS TO RECOVER FROM ERROR 20166000 +VALUE SYMBOL; INTEGER SYMBOL; %*** CONDITION. 20167000 +BEGIN 20168000 + DEFINE NEWSEGMENT = HERE #; %700-20168100 + WHILE CURSY!SYMBOL AND SYMKIND[CURSY]=MIDDLE DO 20169000 + IF CURSY=RECORDSY THEN 20170000 + BEGIN DO BEGIN INSYMBOL; 20171000 + SKIP(99); 20172000 + END UNTIL CURSY!SEMICOLON AND CURSY!CASESY; 20173000 + END ELSE INSYMBOL; 20174000 +END OF SKIP; 20175000 + 20176000 + 20177000 +PROCEDURE ERROR(ERRNUM); 20178000 +VALUE ERRNUM; INTEGER ERRNUM; 20179000 +BEGIN COMMENT *** ARRANGE ERROR INDICATOR. ; 20180000 + DEFINE NEWSEGMENT = HERE #; %700-20180100 + IF ERRNUM<0 THEN ERRNUM:=ABS(ERRNUM) ELSE %511-20180900 + NUMERRS:=NUMERRS+1; 20181000 +% %002-20181500 +% %002-20181550 + IF ERRNUM=100 OR ERRNUM=102 %713-20181600 + THEN NUMERRS := NUMERRS - 1; %*ERROR NUMBER 102 IS ONLY AN ILLEGAL 20181610 +% * DOLLAR OPTION WARNING & %713-20181620 +% *ERROR NUMBER 100 ALONE SHOULD NOT %713-20181650 +% * PREVENT THE XALGOL COMPILATION BEING 20181700 +% * ZIPPED AS THE VALUE 7 IS SUBSTITUTED 20181750 +% * FOR A BAD SAVE CONSTANT IN AN "S"%002-20181800 +% * OPTION. %002-20181850 +% %002-20181900 +% %002-20181950 + ERRP[ERRNUM.[6:2]]:=ERRP[ERRNUM.[6:2]] & 1[ERRNUM.[4:5]:0:1]; %702-20182000 + ERRINX:=MAX(ERRINX,CARDLENGTH-2-CHARCNT); 20183000 + IF ERRINX{115 THEN 20184000 + BEGIN REPLACE POINTER(ERRLINE[1])+ERRINX BY "|", 20185000 + ERRNUM FOR NDIGITS(ERRNUM); 20186000 + ERRINX:=ERRINX+(IF ERRNUM{ 9 THEN 2 ELSE 20187000 + IF ERRNUM{99 THEN 3 ELSE 4); 20188000 +END END OF ERROR; 20189000 + 20190000 + 20191000 +PROCEDURE PRINTERRORS; 20192000 +BEGIN COMMENT *** PRINT ERROR INDICATORS. ; 20193000 + DEFINE NEWSEGMENT = HERE #; %700-20193100 + IF NOT LISTOPTION THEN %709-20194000 + BEGIN IF PAGECNT=0 THEN HEADING; PRINTLINE END; %709-20194100 + REPLACE POINTER(ERRLINE[0])+4 BY NUMERRS FOR 4 DIGITS; %702-20194900 + WRITE(LINE, 17,ERRLINE[*]); %708-20195000 + LINECNT:=LINECNT+1; 20196000 + REPLACE POINTER(ERRLINE[1]) BY " " FOR 16 WORDS; 20197000 + ERRINX:=0; 20198000 +END OF PRINT ERRORS; 20199000 + 20200000 + 20201000 +DEFINE HASH(HASH1) = ENTIER((HASH1) MOD MAXNAMES) #; %505-20202000 + 20203000 +INTEGER THISLEVEL,THISTAB,THISINDEX; 20204000 +ALPHA THISID, CURNAME1, CURNAME2; % USED IN SCANNER %700-20205000 +BOOLEAN FOUND; 20206000 + 20207000 +PROCEDURE SEARCHTAB( TAB ); %*** SEARCH NAME TABLE "TAB" FOR THE %700-20208000 +VALUE TAB; INTEGER TAB; %*** IDENTIFIER JUST READ. %700-20208100 +BEGIN ALPHA TNAME; INTEGER WRAPAROUND; %505-20209000 + WRAPAROUND:=THISINDEX:=HASH(CURNAME1); %505-20210000 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20211000 + WHILE (IF TNAME=CURNAME1 THEN NAMETAB2[TAB,THISINDEX]!CURNAME2 20212000 + ELSE TNAME!0) DO 20213000 + BEGIN 20214000 + THISINDEX:=IF THISINDEX=0 THEN MAXNAMES ELSE THISINDEX-1; 20215000 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20216000 + IF THISINDEX=WRAPAROUND THEN TNAME:=0; % TABLE IS FULL %505-20216100 + END; 20217000 + FOUND:=TNAME!0; 20218000 + IF XREFOPTION THEN 20219000 + IF FOUND THEN NEWXREF(CURNAME1,CURNAME2,TAB,FALSE); % 20220000 +END OF SEARCHTAB; %700-20221000 + 20222000 +PROCEDURE SEARCHDISKDIRECTORY( F, A ); FILE F; ARRAY A[0]; %711-20222100 + SEARCH( F, A[*] ); % END OF SEARCHDISKDIRECTORY; %711-20222200 + %711-20222300 +PROCEDURE SEARCH; %*** SEARCH ALL TABLES CURRENTLY IN USE. 20223000 +BEGIN DEFINE RESULT = THISID #; %700-20224000 + THISLEVEL:=TOPLEVEL+1; 20225000 + DO BEGIN 20226000 + THISLEVEL:=THISLEVEL-1; 20227000 + THISTAB:=IF THISLEVEL{CURLEVEL THEN THISLEVEL 20228000 + ELSE DISPLAY[THISLEVEL].NAMETAB; 20229000 + SEARCHTAB(THISTAB); 20230000 + END UNTIL FOUND OR THISLEVEL=0; 20231000 + THISID:=NAMETAB3[THISTAB,THISINDEX]; 20232000 +END OF SEARCH; %700-20233000 + 20234000 + 20235000 +PROCEDURE NEWNAME( NAME1,NAME2, TAB ); %700-20236000 +VALUE NAME1, NAME2, TAB; %700-20236100 +ALPHA NAME1, NAME2; INTEGER TAB; %700-20236200 +BEGIN %*** ENTER A NEW NAME INTO THE NAME TABLE "TAB". 20237000 + ALPHA TNAME; INTEGER WRAPAROUND; %505-20237100 + WRAPAROUND:=THISINDEX:=HASH(NAME1); %505-20238000 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20239000 + WHILE(IF TNAME=NAME1 THEN NAMETAB2[TAB,THISINDEX]!NAME2 20240000 + ELSE TNAME!0) DO 20241000 + BEGIN 20242000 + THISINDEX:=IF THISINDEX=0 THEN MAXNAMES ELSE THISINDEX-1; 20243000 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20244000 + IF THISINDEX=WRAPAROUND THEN % TABLE AT THIS LEVEL IS FULL 20244100 + BEGIN ERROR(40); NAME1:=TNAME; NAME2:=NAMETAB2[TAB,THISINDEX]20244200 + END; %505-20244300 + END; 20245000 + IF TNAME!0 THEN ERROR(2); 20246000 + NAMETAB1[TAB,THISINDEX]:=NAME1; 20247000 + NAMETAB2[TAB,THISINDEX]:=NAME2; 20248000 + IF XREFOPTION THEN NEWXREF(NAME1,NAME2,TAB,TRUE); 20249000 +END OF NEWNAME; %700-20250000 + 20251000 + 20300000 +PROCEDURE INITIALIZE; %*** INITIALIZATION *** 20301000 +BEGIN %********************** 20302000 + INTEGER T1,T3; 20303000 + ALPHA A; 20304000 + FILL SYMKIND[*] WITH 28(MIDDLE),TERMINAL,4(MIDDLE),INITIAL,TERMINAL,20305000 + INITIAL,MIDDLE,TERMINAL,INITIAL,MIDDLE,INITIAL,TERMINAL,INITIAL, 20306000 + MIDDLE,INITIAL,2(MIDDLE),INITIAL,MIDDLE,INITIAL,4(MIDDLE), 20307000 + 7(INITIAL),MIDDLE,INITIAL; %002-20308000 + 20309000 + FILL SYMBOL[*] WITH 10(0),0,ARROW,0,COLON,GTRSY,GEQSY,PLUS,9(0), 20310000 + DOT,LBRACKET,ANDSY,LPAR,LSSSY,ARROW,0,9(0),0,ASTERISK,MINUS, 20311000 + RPAR,SEMICOLON,LEQSY,0,SLASH,8(0),COMMA,0,NEQSY,EQLSY,RBRACKET, 20312000 + 0,DOUBLEDOT; 20313000 + 20314000 + LINEPNT :=POINTER(LINES[1]); %708-20315000 + XLINEPNT:=POINTER(XLINE[1]); 20316000 + REPLACE LINEPNT-8 BY " " FOR 17 WORDS; %708-20317000 + REPLACE XLINEPNT-8 BY LINEPNT-8 FOR 17 WORDS; %708-20318000 + REPLACE POINTER(ERRLINE[*]) BY "**** ", LINEPNT FOR 16 WORDS; 20319000 + ALGOLPNT:=POINTER(ALGOLCARD[*]); ALGOLCNT:=71; 20320000 + REPLACE ALGOLPNT BY LINEPNT FOR 9 WORDS; %708-20321000 + CHARPNT := POINTER(CH[0])+7; CH[0] := " "; %711-20322000 + TEXTPNT:=POINTER(TEXT[*])+1; TEXTPNT0:=TEXTPNT-1; 20323000 + REPLACE TEXTPNT BY " " FOR 15; 20324000 + STRINGPNT:=POINTER(STRING[*]); 20325000 + REPLACE POINTER(HEADTEXT[*]) BY LINEPNT FOR 10 WORDS, "PAGE 1 ", 20326000 + LINEPNT FOR 6 WORDS; %708-20326100 + REPLACE POINTER(HEADTEXT[*]) BY "PASCAL(", EDITION, ")/B-5700"; 20327000 + TEXT[0]:=TIME(5); 20328000 + REPLACE POINTER(HEADTEXT[*])+45 BY TEXTPNT+5 FOR 2,"/", %709-20329000 + TEXTPNT+1 FOR 2, "/", TEXTPNT+3 FOR 2; %709-20330000 + T1:=TIME(1)/3600; 20331000 + REPLACE POINTER(HEADTEXT[*])+57 BY (T1 DIV 60) FOR 2 DIGITS, ":", 20332000 + ENTIER(T1 MOD 60) FOR 2 DIGITS; 20333000 + HEADING; 20334000 + 20335000 + %*** INITIALIZE INTRINSIC TYPES, CONSTANTS ETC. *** 20336000 + 20337000 + INTTYPE:=T3:=1; %*** "INTEGER" *** 20338000 + T1:=NUMERIC; T1.SIZE:=1; T1.STRUCT:=0; 20339000 + TYPETAB1[1]:=T1; TYPETAB2[1]:=-MAXINT; TYPETAB3[1]:=MAXINT; 20340000 + NEWNAME("7INTEGE","R",0); T3.IDCLASS:=TYPES; 20341000 + NAMETAB3[0,THISINDEX]:=T3; 20342000 + REALTYPE:=T3:=2; %*** "REAL" *** 20343000 + T1.FORM:=FLOATING; TYPETAB1[2]:=T1; 20344000 + NEWNAME("400REAL",0,0); T3.IDCLASS:=TYPES; 20345000 + NAMETAB3[0,THISINDEX]:=T3; 20346000 + ALFATYPE:=T3:=3; %*** "ALFA" *** 20347000 + T1.FORM:=ALFA; TYPETAB1[3]:=T1; 20348000 + NEWNAME("400ALFA",0,0); T3.IDCLASS:=TYPES; 20349000 + NAMETAB3[0,THISINDEX]:=T3; 20350000 + BOOLTYPE:=T3:=4; %*** "BOOLEAN" *** 20351000 + T1.FORM:=SYMBOLIC; TYPETAB1[4]:=T1; TYPETAB3[4]:=1; 20352000 + NEWNAME("7BOOLEA","N",0); T3.IDCLASS:=TYPES; 20353000 + NAMETAB3[0,THISINDEX]:=T3; 20354000 + CHARTYPE:=T3:=5; %*** "CHAR" *** 20355000 + T1.FORM:=CHAR; TYPETAB1[5]:=T1; TYPETAB3[5]:=63; 20356000 + NEWNAME("400CHAR",0,0); T3.IDCLASS:=TYPES; 20357000 + NAMETAB3[0,THISINDEX]:=T3; 20358000 + T3:=BOOLTYPE; T3.IDCLASS:=CONST; %*** "FALSE" *** 20359000 + NEWNAME("50FALSE",0,0); NAMETAB3[0,THISINDEX]:=T3; 20360000 + T3.INFO:=1; %*** "TRUE" *** 20361000 + NEWNAME("400TRUE",0,0); NAMETAB3[0,THISINDEX]:=T3; 20362000 +NILTYPE := 6; %*** TYPE OF "NIL" *** %602-20363000 +T1.FORM := POINTERS; TYPETAB1[6] := T1; %602-20364000 +EMPTYSET := 7; % %602-20364500 +T1.FORM := SET; TYPETAB1[7] := T1; %602-20365000 +NUMTYPES := 7; % %602-20365500 + NEWNAME("6MAXINT",0,0); T3:=INTTYPE; %*** "MAXINT" *** 20366000 + T3.IDCLASS:=CONST; T3.INFO:=1024; 20367000 + NAMETAB3[0,THISINDEX]:=T3; 20368000 + NUMCONSTS:=1; CONSTTAB[1]:=MAXINT; 20369000 + NEWNAME("50PRT25",0,0); %*** "PRT25" *** %501-20369100 + T3:=INTTYPE; T3.IDCLASS:=VAR; % GLOBAL INTEGER VARIABLE %501-20369200 + NAMETAB3[0,THISINDEX] := T3; %501-20369300 + 20370000 + T3:=0; T3.IDCLASS:=PROC; %*** PROCEDURES *** 20371000 + FOR A:="3000GET", "3000NEW", "400PACK", "400PAGE", "3000PUT", 20372000 + "400READ", "6READLN", "50RESET", "6UNPACK", "50WRITE", %002-20373000 + "6QQJZXL" DO %002-20373500 + BEGIN 20374000 + NEWNAME(A,0,0); NAMETAB3[0,THISINDEX]:=T3; 20375000 + END; 20376000 + NEWNAME("7DISPOS","E",0); NAMETAB3[0,THISINDEX]:=T3; 20377000 + NEWNAME("7REWRIT","E",0); NAMETAB3[0,THISINDEX]:=T3; 20378000 + NEWNAME("7WRITEL","N",0); NAMETAB3[0,THISINDEX]:=T3; 20379000 + 20380000 + T3.IDCLASS:=FUNC; %*** FUNCTIONS *** 20381000 + FOR A:="3000ABS", "6ARCTAN", "3000CHR", "3000COS", "3000EOF", 20382000 + "400EOLN", "3000EXP", "20000LN", "3000ODD", "400PRED", 20383000 + "400SUCC", "50ROUND", "3000SIN", "3000SQR", "400SQRT", 20384000 + "50TRUNC", "6CONCAT", "400TIME", "400DATE", "6IOTIME", 20385000 + "400USER", "3000ORD" 20386000 + DO BEGIN 20387000 + NEWNAME(A,0,0); NAMETAB3[0,THISINDEX]:=T3; 20388000 + END; 20389000 + NEWNAME("7CPUTIM","E",0); NAMETAB3[0,THISINDEX]:=T3; %514-20390000 + NEWNAME("7WEEKDA","Y",0); NAMETAB3[0,THISINDEX]:=T3; 20391000 + 20392000 + TEXTTYPE:=T3:=NUMTYPES:=NUMTYPES+1; %*** "TEXT" *** 20393000 + T1 := TEXTFILE; T1.STRUCT := 1; TYPETAB1[TEXTTYPE] := T1; % 20394000 + T3.IDCLASS := TYPES; % 20395000 + NEWNAME("400TEXT",0,0); NAMETAB3[0,THISINDEX]:=T3; 20396000 + T3:=TEXTTYPE; T3.IDCLASS:=VAR; %*** "INPUT" *** 20397000 + T3.EXTERNALFILE:=1; 20398000 + NEWNAME("50INPUT",0,0); INPUTFILE:=THISINDEX; 20399000 + NAMETAB3[0,THISINDEX]:=T3; 20400000 + NEWNAME("6OUTPUT",0,0); %*** "OUTPUT" *** 20401000 + NAMETAB3[0,THISINDEX]:=T3; OUTPUTFILE:=THISINDEX; 20402000 + NEWCARD; LISTOPTION:=CHECKOPTION:=TRUE; % DEFAULT %709-20402100 + INSYMBOL; % ANALYSING FIRST CARD MAY CHANGE DEFAULT LIST OPTN 20402200 + IF LISTOPTION AND PAGECNT=0 THEN HEADING; % ON FIRST PAGE. %709-20402300 +END OF INTIALIZED; 20403000 + 20404000 + 20500000 + 20501000 +%*** XREF ROUTINES *** 20502000 +%********************** 20503000 + 20504000 +DEFINE XREFCARD=[16:17]#, 20505000 + XREFBLOCK=[26:10]#; 20506000 +REAL A0,B0,A1,B1,LASTA0,LASTA1; 20507000 +INTEGER NL,LASTBLOCK,A2,AX; 20508000 + 20509000 +PROCEDURE NEWXREF(NAME1,NAME2,TABLE,DECL); 20510000 +VALUE NAME1,NAME2,TABLE,DECL; 20511000 +REAL NAME1,NAME2; 20512000 +INTEGER TABLE; 20513000 +BOOLEAN DECL; 20514000 +BEGIN 20515000 + DEFINE NEWSEGMENT = HERE #; %700-20515100 + NL:=NAME1.NAMELENGTH; 20516000 + IF NL<7 THEN NAME1:=0&NAME1[41:41:6]&NAME1[35:6|NL-1:6|NL] 20517000 + ELSE NAME2:=0&NAME2[35:6|(NL-6)-1:6|(NL-6)]; 20518000 + AX:=CARDCNT; AX.XREFBLOCK:=BLOCKTAB[TABLE]; 20519000 + IF DECL THEN AX := -AX; %002-20520000 + WRITE(XREFFILE,*,NAME1,NAME2,AX); 20521000 +END OF NEWXREF; 20522000 + 20523000 +PROCEDURE XREFMAX(A); 20524000 +ARRAY A[0]; 20525000 +BEGIN 20526000 + A[0]:="AZZZZZZ"; A[1]:="ZZZZZZ"; A[2]:=9999999999; 20527000 +END OF XREFMAX; 20528000 + 20529000 + 20530000 +BOOLEAN PROCEDURE XREFCOMPARE(A,B); 20531000 +ARRAY A,B[0]; 20532000 +BEGIN 20533000 + DEFINE NEWSEGMENT = HERE #; %700-20533100 + A0:=A[0]; B0:=B[0]; A1:=A[1]; B1:=B[1]; 20534000 + XREFCOMPARE:= 20535000 + IF A0.[35:36]!B0.[35:36] THEN A0.[35:36]LINESPERPAGE THEN HEADING; 20561000 + XREFPNT:=POINTER(XREFLINE[*]); NUMXREF:=0; 20562000 + REPLACE XREFPNT BY " " FOR 17 WORDS; XREFPNT:=XREFPNT+24; 20563000 + END; 20564000 + REPLACE XREFPNT BY A2.XREFCARD FOR 5 DIGITS; 20565000 + XREFPNT:=XREFPNT+7; NUMXREF:=NUMXREF+1; 20566000 + END ELSE 20567000 + IF A2<0 THEN 20568000 + BEGIN 20569000 + A2 := -A2; %002-20570000 + WRITE(LINE, 17,XREFLINE[*]); LINECNT:=LINECNT+1; %708-20571000 + IF LINECNT>LINESPERPAGE THEN HEADING; 20572000 + XREFPNT:=POINTER(XREFLINE[*]); NUMXREF:=0; 20573000 + REPLACE XREFPNT BY " " FOR 17 WORDS; 20574000 + TEXT[0]:=A0.[35:36]; LASTA0:=A0; 20575000 + REPLACE XREFPNT BY TEXTPNT+1 FOR A0.NAMELENGTH; 20576000 + TEXT[0]:=LASTA1:=A1; 20577000 + IF A0.NAMELENGTH>6 THEN 20578000 + REPLACE XREFPNT+6 BY TEXTPNT+1 FOR A0.NAMELENGTH-6; 20579000 + REPLACE XREFPNT+17 BY A2.XREFCARD FOR 5 DIGITS; 20580000 + XREFPNT:=XREFPNT+24; LASTBLOCK:=A2.XREFBLOCK; 20581000 + END; 20582000 + END; 20583000 +END OF PRINTXREF; 20584000 + 20585000 + 20800000 + 20801000 +PROCEDURE CHECKTYPES( LEFTTYPE, RIGHTTYPE ); %700-20802000 +VALUE LEFTTYPE, RIGHTTYPE; INTEGER LEFTTYPE, RIGHTTYPE; %700-20803000 +BEGIN %700-20804000 + REAL TT1, TT2; INTEGER F1, F2, LT, RT; %700-20805000 + IF LEFTTYPE>0 AND RIGHTTYPE>0 THEN 20806000 + IF LEFTTYPE!RIGHTTYPE THEN 20807000 + BEGIN 20808000 + LT:=LEFTTYPE; RT:=RIGHTTYPE; 20809000 + TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20810000 + F1:=TT1.FORM; F2:=TT2.FORM; 20811000 + IF LT!REALTYPE OR F2!NUMERIC THEN 20812000 + IF(F1 NEQ SET OR RT NEQ EMPTYSET) % %600-20813000 + AND % %600-20813050 + (F2 NEQ SET OR LT NEQ EMPTYSET) THEN % %600-20813100 + IF(F1 NEQ POINTERS OR RT NEQ NILTYPE) % %600-20814000 + AND % %600-20814050 + (F2 NEQ POINTERS OR LT NEQ NILTYPE) THEN % %600-20814100 + BEGIN 20815000 + IF F1=SET AND F2=SET THEN 20816000 + BEGIN 20817000 + LT:=TT1.SETTYPE; RT:=TT2.SETTYPE; 20818000 + TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20819000 + F1:=TT1.FORM; F2:=TT2.FORM; 20820000 + END; 20821000 + IF F1=POINTERS AND F2=POINTERS THEN 20822000 + BEGIN 20823000 + LT:=TT1.POINTTYPE; RT:=TT2.POINTTYPE; 20824000 + TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20825000 + F1:=TT1.FORM; F2:=TT2.FORM; 20826000 + END; 20827000 + WHILE F1=SUBTYPE DO 20828000 + BEGIN LT:=TT1.MAINTYPE; TT1:=TYPETAB1[LT]; F1:=TT1.FORM END; 20829000 + WHILE F2=SUBTYPE DO 20830000 + BEGIN RT:=TT2.MAINTYPE; TT2:=TYPETAB1[RT]; F2:=TT2.FORM END; 20831000 + IF LT>0 AND RT>0 THEN 20832000 + IF LT!RT THEN 20833000 + IF F1!NUMERIC OR F2!NUMERIC THEN 20834000 + IF F1!CHAR OR F2!CHAR THEN ERROR(17); 20835000 + END; 20836000 + END; 20837000 +END OF CHECKTYPES; %700-20838000 + 20839000 + 20840000 +INTEGER FILENAME; 20841000 +BOOLEAN LPARFOUND,SAVEXREFOPT; %002-20842000 + 20843000 +PROCEDURE FILEPARAM( DEFAULTFILE ); %*** CHECKS THE FIRST PARAMETER 20844000 +VALUE DEFAULTFILE; INTEGER DEFAULTFILE;%*** TO SEE IF IT IS A FILE.%700-20844100 +BEGIN DEFINE RESULTS = FILENAME & LPARFOUND #; %700-20845000 + INSYMBOL; FILENAME:=CURTYPE:=0; 20846000 + LPARFOUND:=CURSY=LPAR; 20847000 + SAVEXREFOPT := XREFOPTION; XREFOPTION := FALSE; %002-20847500 + IF LPARFOUND THEN 20848000 + BEGIN 20849000 + INSYMBOL; 20850000 + IF CURSY=IDENTIFIER THEN 20851000 + BEGIN 20852000 + SEARCH; 20853000 + IF FOUND THEN 20854000 + BEGIN 20855000 + IF THISID.IDCLASS=VAR THEN 20856000 + BEGIN 20857000 + CURTYPE:=THISID.TYPE; 20858000 + IF TYPETAB1[CURTYPE].FORM}FILES THEN 20859000 + BEGIN 20860000 + FILENAME:=1000|THISLEVEL+THISINDEX; 20861000 + IF SAVEXREFOPT THEN NEWXREF(CURNAME1,CURNAME2,THISLEVEL, 20861500 + FALSE); %002-20861550 + INSYMBOL; 20862000 + END END END END; 20863000 + IF SYMKIND[CURSY]=TERMINAL THEN ERROR(46); 20864000 + END; 20865000 + IF FILENAME=0 THEN FILENAME:=DEFAULTFILE; 20866000 + IF (FILENAME=INPUTFILE AND NOT INPUTDECL) OR 20867000 + (FILENAME=OUTPUTFILE AND NOT OUTPUTDECL) THEN ERROR(96); 20868000 + XREFOPTION := SAVEXREFOPT; %002-20868500 +END OF FILEPARAM; %700-20869000 + 20870000 + 20871000 +REAL CURVAL; INTEGER CURLENGTH; %700-20872000 + %700-20873000 +PROCEDURE CONSTANT( CVAL, CTYPE ); %700-20874000 +REAL CVAL; INTEGER CTYPE; %700-20875000 +BEGIN %700-20876000 + INTEGER TFORM; BOOLEAN SIGNED, NEGATIVE; %700-20876100 + IF CURSY=MINUS OR CURSY=PLUS THEN 20877000 + BEGIN SIGNED:=TRUE; NEGATIVE:=CURSY=MINUS; 20878000 + INSYMBOL; 20879000 + END ELSE SIGNED:=NEGATIVE:=FALSE; 20880000 + IF CURSY=INTCONST THEN 20881000 + BEGIN CTYPE:=INTTYPE; 20882000 + CVAL:=IF NEGATIVE THEN -CURVAL ELSE CURVAL; 20883000 + END ELSE 20884000 + IF CURSY=CHARCONST THEN 20885000 + BEGIN IF SIGNED THEN ERROR(29); 20886000 + CTYPE:=CHARTYPE; CVAL:=CURVAL; 20887000 + END ELSE 20888000 + IF CURSY=REALCONST THEN 20889000 + BEGIN CTYPE:=REALTYPE; 20890000 + CVAL:=IF NEGATIVE THEN -CURVAL ELSE CURVAL; 20891000 + END ELSE 20892000 + IF CURSY=ALFACONST THEN 20893000 + BEGIN IF SIGNED THEN ERROR(29); 20894000 + IF CURLENGTH>7 THEN ERROR(41); 20895000 + CTYPE:=ALFATYPE; CVAL:=CURVAL; 20896000 + END ELSE 20897000 + IF CURSY=IDENTIFIER THEN 20898000 + BEGIN 20899000 + SEARCH; 20900000 + IF FOUND THEN 20901000 + BEGIN 20902000 + IF THISID.IDCLASS=CONST AND NOT BOOLEAN(THISID.FORMAL) THEN 20903000 + BEGIN 20904000 + IF TYPETAB1[THISID.TYPE].FORM{ALFA THEN 20905000 + BEGIN 20906000 + CVAL:=THISID.INFO; 20907000 + IF CVAL>1023 THEN CVAL:=CONSTTAB[CVAL-1023]; 20908000 + CTYPE:=THISID.TYPE; 20909000 + IF SIGNED THEN 20910000 + BEGIN 20911000 + TFORM:=TYPETAB1[THISID.TYPE].FORM; 20912000 + IF TFORM!NUMERIC AND TFORM!FLOATING THEN ERROR(29) ELSE 20913000 + IF NEGATIVE THEN CVAL:=-CVAL; 20914000 + END; 20915000 + END ELSE BEGIN ERROR(48); CVAL:=CTYPE:=0 END; 20916000 + END ELSE BEGIN ERROR(32); CVAL:=CTYPE:=0 END; 20917000 + END ELSE BEGIN ERROR(1); CVAL:=CTYPE:=0 END; 20918000 + END ELSE BEGIN ERROR(32); CVAL:=CTYPE:=0 END; 20919000 + INSYMBOL; 20920000 +END OF CONSTANT; %700-20921000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%30001000 +% %30002000 +% %30003000 +% %30004000 +% PART 3: THE SCANNER. %30005000 +% ------------ %30006000 +% %30007000 +% %30008000 +% %30009000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%30010000 + 30011000 +% INTERNAL INTERNAL SYMBOL 30012000 +% SYMBOL NUMBER NAME KIND 30013000 +% 30014000 +% IDENTIFIER 1 IDENTIFIER MIDDLE 30015000 +% 122 2 INTCONST MIDDLE 30016000 +% 2.5 3 REALCONST MIDDLE 30017000 +% "ABCD" 4 ALFACONST MIDDLE 30018000 +% "C" 5 CHARCONST MIDDLE 30019000 +% NOT 6 NOTSY MIDDLE 30020000 +% * 7 ASTERISK MIDDLE 30021000 +% / 8 SLASH MIDDLE 30022000 +% & AND 9 ANDSY MIDDLE 30023000 +% DIV 10 DIVSY MIDDLE 30024000 +% MOD 11 MODSY MIDDLE 30025000 +% + 12 PLUS MIDDLE 30026000 +% - 13 MINUS MIDDLE 30027000 +% OR 14 ORSY MIDDLE 30028000 +% < LSS 15 LSSSY MIDDLE 30029000 +% <= LEQ { 16 LEQSY MIDDLE 30030000 +% >= GEQ } 17 GEQSY MIDDLE 30031000 +% > GTR 18 GTRSY MIDDLE 30032000 +% <> NEQ ! 19 NEQSY MIDDLE 30033000 +% = EQL 30 EQLSY MIDDLE 30034000 +% IN 21 INSY MIDDLE 30035000 +% ( 22 LPAR MIDDLE 30036000 +% ) 23 RPAR MIDDLE 30037000 +% [ 24 LBRACKET MIDDLE 30038000 +% ] 25 RBRACKET MIDDLE 30039000 +% .. 26 DOUBLEDOT MIDDLE 30040000 +% , 27 COMMA MIDDLE 30041000 +% ; 28 SEMICOLON TERMINAL 30042000 +% . 29 DOT MIDDLE 30043000 +% ~ @ 30 ARROW MIDDLE 30044000 +% : 31 COLON MIDDLE 30045000 +% := 32 ASSIGNSY MIDDLE 30046000 +% BEGIN 33 BEGINSY INITIAL 30047000 +% END 34 ENDSY TERMINAL 30048000 +% IF 35 IFSY INITIAL 30049000 +% THEN 36 THENSY MIDDLE 30050000 +% ELSE 37 ELSESY TERMINAL 30051000 +% CASE 38 CASESY INITIAL 30052000 +% OF 39 OFSY MIDDLE 30053000 +% REPEAT 40 REPEATSY INITIAL 30054000 +% UNTIL 41 UNTILSY TERMINAL 30055000 +% WHILE 42 WHILESY INITIAL 30056000 +% DO 43 DOSY MIDDLE 30057000 +% FOR 44 FORSY INITIAL 30058000 +% TO 45 TOSY MIDDLE 30059000 +% DOWNTO 46 DOWNTOSY MIDDLE 30060000 +% GOTO 47 GOTOSY INITIAL 30061000 +% NIL 48 NILSY MIDDLE 30062000 +% TYPE 49 TYPESY INITIAL 30063000 +% ARRAY 50 ARRAYSY MIDDLE 30064000 +% RECORD 51 RECORDSY MIDDLE 30065000 +% FILE 52 FILESY MIDDLE 30066000 +% SET 53 SETSY MIDDLE 30067000 +% CONST 54 CONSTSY INITIAL 30068000 +% VAR 55 VARSY INITIAL 30069000 +% LABEL 56 LABELSY INITIAL 30070000 +% FUNCTION 57 FUNCSY INITIAL 30071000 +% PROCEDURE 58 PROCSY INITIAL 30072000 +% WITH 59 WITHSY INITIAL 30073000 +% PROGRAM 60 PROGRAMSY INITIAL 30074000 +% PACKED 61 PACKEDSY MIDDLE 30075000 +% ASSERT 62 ASSERTSY INITIAL %002-30075500 + 30076000 + 30077000 +DEFINE BLANK=48#, EQUAL=61#, QUOTES=63#, DOLLAR=42#, 30078000 + LETTER(C)=(17{C AND C{25)OR(33{C AND C{41)OR(50{C AND C{57)#, 30079000 + ALFANUM(C)=(LETTER(C) OR C{9)#; 30080000 + 30081000 +ALPHA C, CX; %( CURNAME1 & CURNAME2 MOVED TO 20205000 ) %700-30083000 +INTEGER LASTCHARPOS; %( CURVAL, CURLENGTH MOVED TO 20872000 ) %700-30084000 +BOOLEAN FINIS; 30085000 + 30086000 +PROCEDURE INSYMBOL; %*** IDENTIFIES THE NEXT SYMBOL ******%700-30087000 +BEGIN %700-30087100 + %700-30087200 + PROCEDURE NEXTCHAR; %*** GETS THE NEXT CHARACTER. %700-30088000 + IF CHARCNT=0 THEN C:=BLANK ELSE 30089000 + BEGIN 30090000 + REPLACE CHARPNT BY CARDPNT:CARDPNT FOR 1; 30091000 + C:=CH[0]; CHARCNT:=CHARCNT-1; 30092000 + END OF NEXTCHAR; %700-30093000 + 30094000 + INTEGER SCALE,EXP; 30099000 + DEFINE T1 = EXP #; % USED AT 30178000 %700-30099100 + BOOLEAN NEGEXP; 30100000 + LABEL START,OVERFLOW; 30101000 + 30102000 +START: 30103000 + IF C=BLANK THEN 30104000 + BEGIN SCAN CARDPNT:CARDPNT FOR CHARCNT:CHARCNT WHILE =" "; 30105000 + IF CHARCNT=0 THEN BEGIN NEWCARD; GO TO START END; 30106000 + NEXTCHAR; 30107000 + END; 30108000 + IF LETTER(C) THEN 30109000 + BEGIN 30110000 + CURLENGTH:=1; CURNAME1:=C; CURNAME2:=0; 30111000 + NEXTCHAR; 30112000 + WHILE ALFANUM(C) AND CURLENGTH<6 DO 30113000 + BEGIN CURNAME1:=C&CURNAME1[35:29:30]; 30114000 + CURLENGTH:=CURLENGTH+1; NEXTCHAR; 30115000 + END; 30116000 + IF CURLENGTH=6 THEN 30117000 + BEGIN 30118000 + WHILE ALFANUM(C) AND CURLENGTH<12 DO 30119000 + BEGIN CURNAME2:=C&CURNAME2[35:29:30]; 30120000 + CURLENGTH:=CURLENGTH+1; NEXTCHAR; 30121000 + END; 30122000 + WHILE ALFANUM(C) DO NEXTCHAR; 30123000 + END; 30124000 + CURNAME1.NAMELENGTH:=CURLENGTH; 30125000 + CASE CURLENGTH OF 30126000 + BEGIN ; 30127000 + CURSY:=IDENTIFIER; 30128000 + CURSY:=IF CURNAME1="20000IF" THEN IFSY ELSE 30129000 + IF CURNAME1="20000DO" THEN DOSY ELSE 30130000 + IF CURNAME1="20000TO" THEN TOSY ELSE 30131000 + IF CURNAME1="20000OR" THEN ORSY ELSE 30132000 + IF CURNAME1="20000OF" THEN OFSY ELSE 30133000 + IF CURNAME1="20000IN" THEN INSY ELSE IDENTIFIER; 30134000 + CURSY:=IF CURNAME1="3000END" THEN ENDSY ELSE 30135000 + IF CURNAME1="3000FOR" THEN FORSY ELSE 30136000 + IF CURNAME1="3000DIV" THEN DIVSY ELSE 30137000 + IF CURNAME1="3000MOD" THEN MODSY ELSE 30138000 + IF CURNAME1="3000NIL" THEN NILSY ELSE 30139000 + IF CURNAME1="3000AND" THEN ANDSY ELSE 30140000 + IF CURNAME1="3000NOT" THEN NOTSY ELSE 30141000 + IF CURNAME1="3000VAR" THEN VARSY ELSE 30142000 + IF CURNAME1="3000SET" THEN SETSY ELSE 30143000 + IF CURNAME1="3000LSS" THEN LSSSY ELSE 30144000 + IF CURNAME1="3000LEQ" THEN LEQSY ELSE 30145000 + IF CURNAME1="3000GEQ" THEN GEQSY ELSE 30146000 + IF CURNAME1="3000GTR" THEN GTRSY ELSE 30147000 + IF CURNAME1="3000NEQ" THEN NEQSY ELSE 30148000 + IF CURNAME1="3000EQL" THEN EQLSY ELSE IDENTIFIER; 30149000 + CURSY:=IF CURNAME1="400THEN" THEN THENSY ELSE 30150000 + IF CURNAME1="400ELSE" THEN ELSESY ELSE 30151000 + IF CURNAME1="400WITH" THEN WITHSY ELSE 30152000 + IF CURNAME1="400CASE" THEN CASESY ELSE 30153000 + IF CURNAME1="400GOTO" THEN GOTOSY ELSE 30154000 + IF CURNAME1="400TYPE" THEN TYPESY ELSE 30155000 + IF CURNAME1="400FILE" THEN FILESY ELSE IDENTIFIER; 30156000 + CURSY:=IF CURNAME1="50BEGIN" THEN BEGINSY ELSE 30157000 + IF CURNAME1="50WHILE" THEN WHILESY ELSE 30158000 + IF CURNAME1="50UNTIL" THEN UNTILSY ELSE 30159000 + IF CURNAME1="50ARRAY" THEN ARRAYSY ELSE 30160000 + IF CURNAME1="50CONST" THEN CONSTSY ELSE 30161000 + IF CURNAME1="50LABEL" THEN LABELSY ELSE IDENTIFIER; 30162000 + CURSY:=IF CURNAME1="6REPEAT" THEN REPEATSY ELSE 30163000 + IF CURNAME1="6DOWNTO" THEN DOWNTOSY ELSE 30164000 + IF CURNAME1="6RECORD" THEN RECORDSY ELSE 30165000 + IF CURNAME1="6ASSERT" THEN ASSERTSY ELSE %002-30165500 + IF CURNAME1="6PACKED" THEN PACKEDSY ELSE IDENTIFIER; 30166000 + CURSY:=IF CURNAME1="7PROGRA" AND CURNAME2="M" THEN PROGRAMSY 30167000 + ELSE IDENTIFIER; 30168000 + CURSY:=IF CURNAME1="8FUNCTI" AND CURNAME2="ON" THEN FUNCSY 30169000 + ELSE IDENTIFIER; 30170000 + CURSY:=IF CURNAME1="9PROCED" AND CURNAME2="URE" THEN PROCSY 30171000 + ELSE IDENTIFIER; 30172000 + CURSY:=IDENTIFIER; % 10 CHARACTERS. 30173000 + CURSY:=IDENTIFIER; % 11 CHARACTERS. 30174000 + CURSY:=IDENTIFIER; % 12 CHARACTERS. 30175000 + END OF CASE; 30176000 + IF RESWORDOPTION AND CURSY!IDENTIFIER THEN 30177000 + BEGIN T1 := CARDLENGTH-CHARCNT-CURLENGTH-1; %506-30178000 + RESWORDOPTION := BOOLEAN(3); % SET RESWORDPRESENT BIT 30179000 + REPLACE XLINEPNT+T1 BY CARDPNT-(CURLENGTH+1) 30180000 + FOR CURLENGTH+REAL(CHARCNT=0); %506-30181000 + END; 30182000 + END OF LETTER ELSE 30183000 + IF C{9 THEN 30184000 + BEGIN 30185000 + CURVAL:=C; CURSY:=INTCONST; 30186000 + NEXTCHAR; 30187000 + WHILE C{9 DO BEGIN CURVAL:=10|CURVAL+C; NEXTCHAR END; 30188000 + IF C="." THEN 30189000 + BEGIN 30190000 + NEXTCHAR; 30191000 + IF C{9 THEN 30192000 + BEGIN CURSY:=REALCONST; 30193000 + DO BEGIN CURVAL:=10|CURVAL+C; 30194000 + SCALE:=SCALE-1; NEXTCHAR; 30195000 + END UNTIL C>9; 30196000 + END ELSE IF C="." THEN C:=64 % SPECIAL MARK FOR ".." 30197000 + ELSE ERROR(4); 30198000 + END; 30199000 + IF C="E" THEN 30200000 + BEGIN 30201000 + CURSY:=REALCONST; NEXTCHAR; 30202000 + IF C="+" OR C="-" THEN BEGIN NEGEXP:=C="-"; NEXTCHAR END; 30203000 + IF C{9 THEN 30204000 + BEGIN EXP:=C; NEXTCHAR; 30205000 + WHILE C{9 DO BEGIN EXP:=10|EXP+C; NEXTCHAR END; 30206000 + IF NEGEXP THEN EXP:=-EXP; 30207000 + END ELSE ERROR(4); 30208000 + SCALE:=SCALE+EXP; 30209000 + END; 30210000 + IF CURSY=REALCONST THEN 30211000 + BEGIN 30212000 + REALOVERFLOW:=OVERFLOW; 30213000 + CURVAL:=CURVAL|10*SCALE; 30214000 + REALOVERFLOW:=0; 30215000 + END ELSE 30216000 + IF CURVAL>MAXINT THEN 30217000 + BEGIN 30218000 +OVERFLOW: ERROR(14); CURVAL:=0; REALOVERFLOW:=0; 30219000 + END; 30220000 + END OF DIGIT ELSE 30221000 + IF C=QUOTES THEN 30222000 + BEGIN 30223000 + CURSY:=ALFACONST; CURLENGTH:=0; NEXTCHAR; 30224000 + FINIS:=FALSE; 30225000 + DO BEGIN 30226000 + IF C=QUOTES THEN BEGIN NEXTCHAR; FINIS:=C!QUOTES END ELSE 30227000 + IF CHARCNT=0 THEN BEGIN ERROR(6); FINIS:=TRUE END; 30228000 + IF NOT FINIS THEN 30229000 + BEGIN 30230000 + REPLACE STRINGPNT+CURLENGTH BY CHARPNT FOR 1; 30231000 + CURLENGTH:=CURLENGTH+1; 30232000 + NEXTCHAR; 30233000 + END END UNTIL FINIS; 30234000 + IF CURLENGTH=0 THEN ERROR(4) ELSE 30235000 + IF CURLENGTH=1 THEN 30236000 + BEGIN CURSY:=CHARCONST; 30237000 + REPLACE CHARPNT BY STRINGPNT FOR 1; CURVAL:=CH[0]; 30238000 + END ELSE 30239000 + IF CURLENGTH{7 THEN 30240000 + BEGIN TEXT[0]:=" "; 30241000 + REPLACE TEXTPNT BY STRINGPNT FOR CURLENGTH; 30242000 + CURVAL:=TEXT[0]; 30243000 + END; 30244000 + END OF STRINGS ELSE 30245000 + BEGIN 30246000 + CURSY:=SYMBOL[C]; NEXTCHAR; 30247000 + IF CURSY=COLON AND C=EQUAL THEN 30248000 + BEGIN CURSY:=ASSIGNSY; NEXTCHAR END ELSE 30249000 + IF CURSY=DOT AND C="." THEN 30250000 + BEGIN CURSY:=DOUBLEDOT; NEXTCHAR END ELSE 30251000 + IF CURSY=LSSSY AND C=EQUAL THEN 30252000 + BEGIN CURSY:=LEQSY; NEXTCHAR END ELSE 30253000 + IF CURSY=LSSSY AND C=">" THEN 30254000 + BEGIN CURSY:=NEQSY; NEXTCHAR END ELSE 30255000 + IF CURSY=GTRSY AND C=EQUAL THEN 30256000 + BEGIN CURSY:=GEQSY; NEXTCHAR END ELSE 30257000 + IF CURSY=LPAR AND C="*" THEN 30258000 + BEGIN % *** COMMENT *** 30259000 + NEXTCHAR; 30260000 + IF C=DOLLAR THEN % DOLLAR INDICATES COMPILER OPTIONS. 30261000 + BEGIN DEFINE NEWSEGMENT = HERE #; %700-30261100 + DO BEGIN 30262000 + NEXTCHAR; CX:=C; NEXTCHAR; 30263000 + IF CX="L" THEN IF C=1 THEN %516-30264000 + IF LISTOPTION THEN HEADING ELSE %516-30264500 + ELSE LISTOPTION := C="+" ELSE %713-30265000 + IF CX="R" THEN RESWORDOPTION:=C="+" ELSE 30266000 + IF CX="C" THEN CHECKOPTION:=C="+" ELSE 30267000 + IF CX="D" THEN DUMPOPTION:=C="+" ELSE 30268000 + IF CX="X" THEN XREFOPTION:=C="+" ELSE 30269000 + IF CX="A" THEN 30270000 + IF C="+" THEN WRITE(PASCALGOL,ALIST) 30271000 + ELSE WRITE(PASCALGOL,NOALIST) ELSE 30272000 + IF CX="T" THEN 30273000 + BEGIN LASTCHARPOS := CHARCNT - CARDLENGTH; 30274000 + CARDLENGTH:=10|C; 30275000 + NEXTCHAR; CARDLENGTH:=CARDLENGTH+C; 30276000 + IF CARDLENGTH{9 OR CARDLENGTH>80 THEN 30277000 + BEGIN ERROR(14); CARDLENGTH:=72 END; 30278000 + CHARCNT:=MAX(0,LASTCHARPOS+CARDLENGTH-1); 30279000 + END% %002-30280000 +% %002-30280025 +% %002-30280050 +% THE FOLLOWING LINES DECODE ANY OCCURRENCE OF THE "S" OPTION AND 30280075 +% SETS THE GLOBAL INTEGER VARIABLE "SAVEFACTOR" WHICH CONTROLS THE %002-30280100 +% TYPE OF COMPILATION INITIATED BY THE ZIP. THERE ARE THREE LEGAL FORMS 30280125 +% OF THE "S" OPTION AS FOLLOWS.- %002-30280150 +% %002-30280175 +% "S-" WILL GIVE NO ZIP IE. PASCAL SYNTAX CHECK ONLY %002-30280200 +% "S+" WILL GIVE A ZIP FOR COMPILE AND GO %002-30280225 +% "S??" WILL GIVE A ZIP FOR COMPILE TO LIBRARY %002-30280250 +% WHERE ?? IS THE TWO DIGIT DECIMAL SAVE %002-30280275 +% CONSTANT GIVEN THE OBJECT CODE FILE %002-30280300 +% NB. IF THE SAVE CONSTANT IS TO BE %002-30280325 +% LESS THAN 10 THE FIRST DIGIT %002-30280350 +% MUST BE INCLUDED IE. A "0". %002-30280375 +% %002-30280400 +% %002-30280425 + ELSE %002-30280450 + IF CX="S" THEN %002-30280475 + BEGIN %002-30280500 + IF C="-" THEN SAVEFACTOR:=-1 ELSE %002-30280525 + IF C="+" THEN SAVEFACTOR:= 0 ELSE %002-30280550 + IF C LEQ 9 THEN %002-30280575 + BEGIN %002-30280600 + SAVEFACTOR := 10 | C; NEXTCHAR; %002-30280625 + SAVEFACTOR := SAVEFACTOR + C; %002-30280650 + IF C GTR 9 THEN ERROR(100); %002-30280675 + END %002-30280700 + ELSE %002-30280720 + BEGIN %002-30280735 + ERROR(100); %002-30280750 + SAVEFACTOR := 7; %002-30280765 + END; %002-30280780 + END %713-30280800 + ELSE ERROR(102); %713-30280810 +% %002-30280825 +% %002-30280850 +% %002-30280875 + NEXTCHAR; 30281000 + END UNTIL C!","; 30282000 + IF LISTOPTION THEN IF PAGECNT=0 THEN HEADING; % ON FIRST PAGE30282100 + END NEWSEGEMENT; %700-30282200 + FINIS:=FALSE; 30283000 + DO BEGIN 30284000 + IF C!"*" THEN 30285000 + SCAN CARDPNT:CARDPNT FOR CHARCNT:CHARCNT UNTIL ="*"; 30286000 + IF CHARCNT=0 THEN NEWCARD ELSE 30287000 + BEGIN NEXTCHAR; 30288000 + WHILE C="*" DO NEXTCHAR; 30289000 + FINIS:=C=")"; 30290000 + END END UNTIL FINIS; 30291000 + NEXTCHAR; 30292000 + GO TO START; 30293000 + END OF COMMENT; 30294000 + END; 30295000 +END OF INSYMBOL; 30296000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%40001000 +% %40002000 +% %40003000 +% %40004000 +% PART 4: EXPRESSION PARSER. %40005000 +% ------------------ %40006000 +% %40007000 +% %40008000 +% %40009000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%40010000 + 40011000 + 40012000 +PROCEDURE EXPRESSION; FORWARD; 40013000 +PROCEDURE CONCAT; FORWARD; 40014000 + 40015000 +INTEGER EXPRLEVEL, EXPINVARCNT; % %800-40018000 + 40019000 +DEFINE PUTTEXT(T)= 40020000 +BEGIN 40021000 + IF NUMSYMS=MAXSYMS THEN 40022000 + BEGIN ERROR(63); % %600-40023000 + NUMSYMS:=1; 40024000 + END ELSE NUMSYMS:=NUMSYMS+1; 40025000 + SYMTAB[NUMSYMS]:=T; 40026000 +END OF PUTTEXT #; 40027000 + 40028000 +DEFINE PUTSYM(S) = PUTTEXT( (S)&1[41:5:6] ) #; %700-40029000 + 40034000 +DEFINE PUTCONST(VAL)= 40035000 +BEGIN 40036000 + PUTTEXT("2000000"); 40037000 + PUTTEXT(VAL); 40038000 +END OF PUTCONST #; 40039000 + 40040000 +DEFINE PUTDUMMY = PUTTEXT("3000000") #; %700-40041000 + 40045000 +DEFINE PUTID(L,NUM,NUMDIG)= 40046000 +BEGIN 40047000 + TEXT[0]:=" " & L [35:5:6]; 40048000 + REPLACE TEXTPNT+2 BY NUM FOR NUMDIG DIGITS; 40049000 + PUTTEXT(TEXT[0]); 40050000 +END OF PUTID#; 40051000 + 40052000 +% %601-40052050 +% %601-40052055 +PROCEDURE SPLIT(SPLITINX,WIDTH); % %601-40052100 +VALUE SPLITINX, WIDTH; % %601-40052150 +INTEGER SPLITINX, WIDTH ; % %601-40052200 +BEGIN % %601-40052250 + INTEGER I; % %601-40052300 +% %601-40052350 + IF NUMSYMS+WIDTH LEQ MAXSYMS THEN % %601-40052400 + BEGIN % %601-40052450 + FOR I:=NUMSYMS STEP -1 UNTIL SPLITINX DO % %601-40052500 + SYMTAB[I+WIDTH] := SYMTAB[I]; % %601-40052550 + FOR I:=1 STEP 1 UNTIL WIDTH DO % %601-40052600 + SYMTAB[SPLITINX+I-1] := "3000000"; % %601-40052650 + NUMSYMS := NUMSYMS + WIDTH; % %601-40052700 + END % %601-40052750 + ELSE %601-40052800 + BEGIN % %601-40052830 + ERROR(63); % %601-40052860 + NUMSYMS := 1; % %601-40052890 + END; % %601-40052900 +END OF SPLIT; % %601-40052950 +% %601-40052960 +% %601-40052965 +PROCEDURE WRITEEXPR; %*** WRITE GENERATED ALGOL EXPRESSION %700-40053000 +BEGIN 40054000 + REAL SX; INTEGER T1, TX; %700-40054100 + FOR T1:=1 STEP 1 UNTIL NUMSYMS DO 40055000 + BEGIN 40056000 + SX:=SYMTAB[T1]; TX:=SX.[41:6]; 40057000 + IF TX=0 THEN GEN(SX,7,2) ELSE 40058000 + IF TX=3 THEN ELSE 40059000 + IF TX=1 THEN GEN(SX,1,7) ELSE 40060000 + BEGIN 40061000 + T1:=T1+1; SX:=SYMTAB[T1]; 40062000 + IF SX.[44:6]=0 THEN GENINT(SX) ELSE GENREAL(SX); 40063000 + END END; 40064000 + NUMSYMS:=0; 40065000 +END OF WRITEEXPR; %700-40066000 + 40067000 + 40068000 +PROCEDURE CHECKEXPR( LLIM, ULIM ); %*** WRITE CODE TO CHECK VALUE 40069000 + VALUE LLIM, ULIM; INTEGER LLIM, ULIM; %700-40069100 +BEGIN DEFINE CHECK = VALUE #; %700-40070000 + PUTTEXT("CHECK("); 40071000 + EXPRESSION; 40072000 + PUTSYM(","); PUTCONST(LLIM); 40073000 + PUTSYM(","); PUTCONST(ULIM); 40074000 + PUTSYM(","); PUTCONST(CARDCNT); 40075000 + PUTSYM(")"); 40076000 +END OF CHECKEXPR; %700-40077000 + 40078000 + 40079000 + BOOLEAN SIMPLEVARIABLE,INSIDEBRACKETS,INSIDEPARENS; %518-40080100 +INTEGER NUMPOINTERS; 40081000 + 40082000 +PROCEDURE VARIABLE; 40083000 +BEGIN 40084000 + INTEGER STARTSYM,LLIM,ULIM; 40085000 + REAL T; 40086000 + INTEGER T1, T5; % USED ONCE EACH %700-40086100 + BOOLEAN INBRACKET,INRECORD,SIMPLEVAR; %002-40087000 + LABEL ADDADDR; 40088000 + 40089000 + STARTSYM:=NUMSYMS+1; 40090000 + IF THISLEVEL>CURLEVEL THEN % VARIABLE IN FIELD LIST OF 40091000 + BEGIN % RECORD USED IN WITH-STATEMENT. 40092000 + T:=DISPLAY[THISLEVEL]; 40093000 + T1:=T.FIRSTWITHSYM; T5:=T.LASTWITHSYM; %700-40094000 + FOR T1:=T1 STEP 1 UNTIL T5 DO PUTTEXT(WITHTAB[T1]); %700-40095000 + INRECORD:=TRUE; 40096000 + INBRACKET:=BOOLEAN(T.BRACKETSINWITH); 40097000 + NUMPOINTERS:=NUMPOINTERS+T.NUMPNTRSINWITH; 40098000 + SIMPLEVAR := FALSE; %002-40099000 + CURTYPE:=T.RECTYPE; T:=TYPETAB1[CURTYPE]; 40100000 + GO TO ADDADDR; 40101000 + END; 40102000 + CURTYPE := THISID.TYPE; SIMPLEVAR := TRUE; %002-40104000 + PUTID("V",1000|THISLEVEL+THISINDEX,5); %518-40105500 + INSYMBOL; 40106000 + IF CURSY=LBRACKET OR CURSY=DOT OR CURSY=ARROW THEN 40107000 + BEGIN 40108000 + SIMPLEVAR := FALSE; %002-40109000 + DO BEGIN 40110000 + IF CURSY=LBRACKET THEN 40111000 + BEGIN 40112000 + IF NOT(INBRACKET OR INRECORD) THEN 40113000 + BEGIN PUTSYM("["); INBRACKET:=TRUE END; 40114000 + DO BEGIN 40115000 + T:=TYPETAB1[CURTYPE]; 40116000 + LLIM:=TYPETAB2[CURTYPE]; ULIM:=TYPETAB3[CURTYPE]; 40117000 + IF T.FORM!ARRAYS THEN ERROR(12); 40118000 + IF INRECORD THEN PUTTEXT(" +("); 40119000 + INSYMBOL; 40120000 + EXPINVARCNT:=EXPINVARCNT+1;% %002-40120500 + EXPRLEVEL := EXPRLEVEL+1; % DO NOT "WRITEEXPR" YET %507-40120900 + IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 40121000 + EXPRLEVEL := EXPRLEVEL-1; %507-40121100 + SIMPLEVARIABLE := FALSE; % RECURSION ON "VARIABLE" %507-40121200 + EXPINVARCNT:=EXPINVARCNT-1;% %002-40121500 + CHECKTYPES(T.INXTYPE,CURTYPE); 40122000 + CURTYPE:=T.ARRTYPE; 40123000 + IF INRECORD THEN 40124000 + BEGIN 40125000 + IF LLIM<0 THEN BEGIN PUTSYM("+"); PUTCONST(-LLIM) END ELSE40126000 + IF LLIM>0 THEN BEGIN PUTSYM("-"); PUTCONST( LLIM) END; 40127000 + PUTSYM(")"); 40128000 + IF TYPETAB1[CURTYPE].SIZE>1 THEN 40129000 + BEGIN PUTSYM("|"); PUTCONST(TYPETAB1[CURTYPE].SIZE) END; 40130000 + END ELSE IF TYPETAB1[CURTYPE].STRUCT>0 THEN PUTSYM(","); 40131000 + END UNTIL CURSY!COMMA; 40132000 + IF CURSY!RBRACKET THEN 40133000 + BEGIN ERROR(59); SKIP(RBRACKET); 40134000 + IF CURSY=RBRACKET THEN INSYMBOL; 40135000 + END ELSE INSYMBOL; 40136000 + END OF BRACKETS ELSE 40137000 + IF CURSY=DOT THEN 40138000 + BEGIN 40139000 + IF NOT(INBRACKET OR INRECORD) THEN 40140000 + BEGIN PUTSYM("["); INBRACKET:=TRUE END; 40141000 + T:=TYPETAB1[CURTYPE]; 40142000 + IF T.FORM!RECORD THEN ERROR(12); 40143000 + INSYMBOL; 40144000 + IF CURSY=IDENTIFIER THEN 40145000 + BEGIN 40146000 + SEARCHTAB(T.RECTAB); 40147000 + IF FOUND THEN 40148000 + BEGIN 40149000 + THISID:=NAMETAB3[T.RECTAB,THISINDEX]; 40150000 +ADDADDR: PUTSYM("+"); 40151000 + PUTCONST(THISID.INFO); CURTYPE:=THISID.TYPE; 40152000 + END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40153000 + END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40154000 + INRECORD:=TRUE; 40155000 + INSYMBOL; 40156000 + END OF DOT ELSE 40157000 + BEGIN % CURSY=ARROW 40158000 + T:=TYPETAB1[CURTYPE]; 40159000 + IF T.FORM=FILES THEN 40160000 + BEGIN 40161000 + CURTYPE:=T.FILETYPE; 40162000 + IF TYPETAB1[CURTYPE].STRUCT=0 THEN PUTTEXT(" [0]"); 40163000 + END ELSE 40164000 + IF T.FORM=TEXTFILE THEN 40165000 + BEGIN 40166000 + SYMTAB[NUMSYMS]:=SYMTAB[NUMSYMS] & "I" [35:5:6]; 40167000 + PUTSYM("."); PUTTEXT("LASTCH"); 40168000 + CURTYPE:=CHARTYPE; 40169000 + END ELSE 40170000 + IF T.FORM=POINTERS THEN 40171000 + BEGIN 40172000 + IF INBRACKET THEN PUTSYM("]"); 40173000 + INBRACKET:=FALSE; 40174000 + IF NUMSYMS+6 { MAXSYMS THEN %513-40175000 + BEGIN 40176000 + FOR T1:=NUMSYMS STEP -1 UNTIL STARTSYM DO 40177000 + SYMTAB[T1+2]:=SYMTAB[T1]; 40178000 + SYMTAB[STARTSYM]:=" MEM["; 40179000 + SYMTAB[STARTSYM+1]:=" (T:="; 40180000 + NUMSYMS := NUMSYMS+2; %513-40180400 + IF NUMPOINTERS > 0 % POINTER VIA POINTER %513-40180500 + THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY %513-40180600 + "00-1)DIV00 1022,00 T MOD00 1022]"; %513-40180700 + NUMSYMS := NUMSYMS+4; %513-40180800 + END %513-40180900 + ELSE NUMPOINTERS := 1; %513-40181000 + INRECORD:=TRUE; 40182000 + END ELSE ERROR(63); 40183000 + CURTYPE:=T.POINTTYPE; 40184000 + END ELSE BEGIN ERROR(12); CURTYPE:=0 END; 40185000 + INSYMBOL; 40186000 + END OF ARROW; 40187000 + END UNTIL CURSY!LBRACKET AND CURSY!DOT AND CURSY!ARROW; 40188000 + END; % %601-40188005 +IF TYPETAB1[CURTYPE].FORM=SET THEN % *** SET VARIABLES %601-40188010 +BEGIN % --- --- --------- %601-40188025 + INTEGER THISSYML, I; % %601-40188050 +% %601-40188075 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SLOAD("; % %601-40188100 + IF SIMPLEVAR THEN % %601-40188125 + BEGIN % %601-40188150 + PUTSYM(","); % %601-40188175 + PUTID("W",1000|THISLEVEL+THISINDEX,5); % %601-40188200 + END % %601-40188225 + ELSE % %601-40188250 + IF INBRACKET AND NOT INRECORD THEN % %601-40188275 + BEGIN % %601-40188300 + PUTSYM(","); THISSYML := NUMSYMS; % %601-40188325 + PUTCONST(0); PUTSYM(" "); PUTSYM(","); % %601-40188350 + FOR I:=STARTSYM+1 STEP 1 UNTIL THISSYML DO % %601-40188375 + PUTTEXT(SYMTAB[I]); %601-40188400 + PUTTEXT(" 1] "); % %601-40188425 + END % %601-40188450 + ELSE % %601-40188475 + BEGIN % %601-40188500 + THISSYML := NUMSYMS; % %601-40188525 + IF INBRACKET THEN PUTSYM("]"); % %601-40188550 + FOR I:=1 STEP 1 UNTIL NUMPOINTERS DO % %601-40188575 + BEGIN % %601-40188600 + PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); % %601-40188625 + PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); % %601-40188650 + END; % %601-40188675 + PUTSYM(","); % %601-40188700 + FOR I:=STARTSYM+1 STEP 1 UNTIL THISSYML DO % %601-40188725 + PUTTEXT(SYMTAB[I]); % %601-40188775 + PUTTEXT(" +1 "); % %601-40188800 + IF INBRACKET THEN PUTSYM("]"); % %601-40188825 + FOR I:=1 STEP 1 UNTIL NUMPOINTERS DO % %601-40188850 + BEGIN % %601-40188875 + PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); % %601-40188900 + PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); % %601-40188915 + END; % %601-40188930 + NUMPOINTERS := 0; % %601-40188945 + END; %601-40188960 + PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); % %601-40188975 +END OF SET VARIABLES; % %601-40188990 + IF TYPETAB1[CURTYPE].STRUCT=0 THEN 40189000 + BEGIN 40190000 + IF INBRACKET THEN PUTSYM("]"); 40191000 + % INBRACKET := FALSE; %513-40191100 + WHILE NUMPOINTERS>0 DO 40192000 + BEGIN NUMPOINTERS := NUMPOINTERS-1; %513-40193000 + IF NUMSYMS+4 { MAXSYMS %513-40194000 + THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY %513-40194100 + "00-1)DIV00 1022,00 T MOD00 1022]"; %513-40194200 + NUMSYMS := NUMSYMS+4; %513-40194300 + END %513-40194400 + ELSE ERROR(63); % EXPRESSION IS TOO LONG FOR SYMTAB[*] 40195000 + END; 40196000 + END; 40197000 + IF INSIDEPARENS AND SIMPLEVAR AND TYPETAB1[CURTYPE].STRUCT > 0 AND 40198500 + TYPETAB1[CURTYPE].FORM < FILES THEN SYMTAB[STARTSYM].[35:6] := 40198600 + "H"; %615-40198700 + INSIDEBRACKETS:=INBRACKET; 40199000 + SIMPLEVARIABLE := SIMPLEVAR; %002-40199500 + CURMODE:=NUMBER; 40200000 +END OF VARIABLE; 40201000 + 40202000 + 40203000 +PROCEDURE PASSPARAMS; 40204000 +BEGIN 40205000 + INTEGER NPARS,PARAM,PTYPE,P,FIRSTSYM; 40206000 + BOOLEAN FORMALPROC,CHECK; 40207000 + LABEL EXIT; 40208000 + 40209000 + PUTID("V",1000|THISLEVEL+THISINDEX,5); 40210000 + P:=THISID.INFO; 40211000 + FORMALPROC:=BOOLEAN(THISID.FORMAL); 40212000 + NPARS:=PARAMTAB[P]; P:=P+1; 40213000 + IF FORMALPROC THEN NPARS:=9999; 40214000 + INSYMBOL; 40215000 + IF CURSY=LPAR THEN 40216000 + BEGIN 40217000 + PUTSYM("("); 40218000 + DO BEGIN 40219000 + INSYMBOL; 40220000 + IF NPARS=0 THEN BEGIN ERROR(3); SKIP(RPAR); GO TO EXIT END; 40221000 + PARAM:=PARAMTAB[P]; P:=P+1; 40222000 + PTYPE:=PARAM.PARAMTYPE; 40223000 + IF PARAM.PARAMKIND=CONST THEN 40224000 + BEGIN 40225000 + CHECK:=CHECKOPTION AND TYPETAB1[PTYPE].FORM LEQ CHAR; 40226000 + IF CHECK THEN PUTTEXT("CHECK("); 40227000 + PUTDUMMY; FIRSTSYM:=NUMSYMS; 40228000 + EXPRLEVEL:=EXPRLEVEL+1; 40229000 + EXPRESSION; EXPRLEVEL:=EXPRLEVEL-1; 40230000 + IF CURMODE=BITPATTERN THEN 40231000 + BEGIN SYMTAB[FIRSTSYM]:=" REAL("; PUTSYM(")"); END; 40232000 + IF CHECK THEN 40233000 + BEGIN 40234000 + PUTSYM(","); PUTCONST(TYPETAB2[PTYPE]); 40235000 + PUTSYM(","); PUTCONST(TYPETAB3[PTYPE]); 40236000 + PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); 40237000 + END; 40238000 + END ELSE 40239000 + IF PARAM.PARAMKIND=VAR THEN 40240000 + BEGIN 40241000 + IF CURSY=IDENTIFIER THEN 40242000 + BEGIN 40243000 + SEARCH; 40244000 + IF FOUND THEN 40245000 + BEGIN 40246000 + IF THISID.IDCLASS=VAR OR 40247000 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 40248000 + BEGIN 40249000 + IF PARAM.PARAMFILE=1 THEN 40250000 + BEGIN 40251000 + CURTYPE:=THISID.TYPE; 40252000 + PUTID("V",1000|THISLEVEL+THISINDEX,5); PUTSYM(","); 40253000 + PUTID("F",1000|THISLEVEL+THISINDEX,5); PUTSYM(","); 40254000 + PUTID("I",1000|THISLEVEL+THISINDEX,5); 40255000 + INSYMBOL; 40256000 + END ELSE 40257000 + BEGIN 40258000 + INSIDEPARENS := TRUE; %518-40258100 + VARIABLE; 40259000 + INSIDEPARENS := FALSE; %518-40259100 + IF TYPETAB1[CURTYPE].STRUCT>0 THEN 40260000 + IF NOT SIMPLEVARIABLE THEN ERROR(92); 40261000 + END; 40262000 + END ELSE BEGIN ERROR(8); CURTYPE:=0 END; 40263000 + END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40264000 + END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40265000 + END ELSE 40266000 + BEGIN 40267000 + IF CURSY=IDENTIFIER THEN 40268000 + BEGIN 40269000 + SEARCH; 40270000 + IF FOUND THEN 40271000 + BEGIN 40272000 + IF THISID.IDCLASS!PARAM.PARAMKIND THEN ERROR(91); 40273000 + PUTID("V",1000|THISLEVEL+THISINDEX,5); 40274000 + IF TYPETAB1[THISID.TYPE].FORM=SET THEN %601-40274200 + BEGIN % %601-40274220 + GEN(",",1,7); % %601-40274240 + GENID("W",1000|THISLEVEL+THISINDEX,5); % %601-40274260 + END; % %601-40274280 + CURTYPE:=IF THISID.IDCLASS=FUNC THEN THISID.TYPE ELSE 0; 40275000 + INSYMBOL; 40276000 + END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40277000 + END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40278000 + END; 40279000 + CHECKTYPES(PTYPE,CURTYPE); 40280000 + NPARS:=NPARS-1; 40281000 + IF CURSY=COMMA THEN PUTSYM(","); 40282000 + END UNTIL CURSY!COMMA; 40283000 + IF CURSY!RPAR THEN BEGIN ERROR(89); SKIP(RPAR) END; 40284000 +EXIT: PUTSYM(")"); 40285000 + IF CURSY=RPAR THEN INSYMBOL; 40286000 + END; 40287000 + IF NPARS>0 AND NOT FORMALPROC THEN ERROR(3); 40288000 + CURMODE:=NUMBER; 40289000 +END OF PASSPARAMS; 40290000 + 40291000 + 40292000 +PROCEDURE FACTOR; %*** FACTOR *** 40293000 +BEGIN %************** 40294000 + INTEGER STARTSYM,STYPE,T; 40295000 + BOOLEAN FIRST, SPLITTED; % %601-40296000 + REAL VAL; 40297000 + DEFINE T1 = T #; % USED AT 40558000 %700-40298000 + 40310000 + CURMODE:=NUMBER; 40311000 + IF CURSY=IDENTIFIER THEN 40312000 + BEGIN 40313000 + SEARCH; 40314000 + IF FOUND THEN 40315000 + BEGIN 40316000 + IF THISID.IDCLASS=VAR OR 40317000 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) 40318000 + THEN VARIABLE ELSE 40319000 + IF THISID.IDCLASS=CONST THEN 40320000 + BEGIN 40321000 + IF THISID.INFO{1023 THEN PUTCONST(THISID.INFO) 40322000 + ELSE PUTCONST(CONSTTAB[THISID.INFO-1023]);40323000 + CURTYPE:=THISID.TYPE; CURMODE:=NUMBER; 40324000 + INSYMBOL; 40325000 + END ELSE 40326000 + IF THISID.IDCLASS=FUNC THEN 40327000 + BEGIN 40328000 + IF THISTAB=0 THEN %*** INTRINSIC FUNCTION *** 40329000 + BEGIN 40330000 + %700-40331000 + PROCEDURE PARAMETER; %*** CHECK THAT THE FUNCTION HAS 1 PARAM.40332000 + BEGIN %700-40333000 + INSYMBOL; %700-40334000 + IF CURSY=LPAR %700-40335000 + THEN BEGIN %700-40336000 + PUTSYM("("); INSYMBOL; EXPRESSION; %700-40337000 + IF TYPETAB1[CURTYPE].FORM=NUMERIC THEN CURTYPE:=INTTYPE; 40338000 + IF CURSY!RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; %700-40339000 + PUTSYM(")"); IF CURSY=RPAR THEN INSYMBOL; %700-40340000 + END ELSE ERROR(3); % OR ERROR(58) %700-40341000 + END OF PARAMETER; %700-40342000 + %700-40350000 + IF CURNAME1="3000ABS" THEN % "ABS" 40351000 + BEGIN 40352000 + PUTTEXT(" ABS"); PARAMETER; 40353000 + IF CURTYPE!REALTYPE AND CURTYPE!INTTYPE THEN ERROR(67); 40354000 + END ELSE 40355000 + IF CURNAME1="3000CHR" THEN % "CHR" 40356000 + BEGIN 40357000 + INSYMBOL; 40358000 + IF CURSY=LPAR THEN 40359000 + BEGIN INSYMBOL; CHECKEXPR(0,63); 40360000 + IF TYPETAB1[CURTYPE].FORM!NUMERIC THEN ERROR(67); 40361000 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40362000 + IF CURSY=RPAR THEN INSYMBOL; 40363000 + END ELSE ERROR(58); 40364000 + CURTYPE:=CHARTYPE; 40365000 + END ELSE 40366000 + IF CURNAME1="3000EOF" OR % "EOF"/"EOLN" 40367000 + CURNAME1="400EOLN" THEN 40368000 + BEGIN 40369000 + FIRST:=CURNAME1="3000EOF"; 40370000 + FILEPARAM(INPUTFILE); 40371000 + PUTID("I",FILENAME,5); 40372000 + PUTTEXT(IF FIRST THEN " .EOF" ELSE " .EOLN"); 40373000 + IF LPARFOUND THEN 40374000 + BEGIN 40375000 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40376000 + IF CURSY=RPAR THEN INSYMBOL; 40377000 + END; 40378000 + CURTYPE:=BOOLTYPE; 40379000 + END ELSE 40380000 + IF CURNAME1="3000ODD" THEN % "ODD" 40381000 + BEGIN 40382000 + PUTTEXT(" ODD"); PARAMETER; 40383000 + IF CURTYPE!INTTYPE THEN ERROR(67); 40384000 + CURTYPE:=BOOLTYPE; CURMODE:=BITPATTERN; 40385000 + END ELSE 40386000 + IF CURNAME1="3000ORD" THEN % "ORD" 40387000 + BEGIN 40388000 + PUTSYM("("); INSYMBOL; 40389000 + IF CURSY=LPAR THEN 40390000 + BEGIN 40391000 + INSYMBOL; EXPRESSION; 40392000 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(67); 40393000 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40394000 + INSYMBOL; 40395000 + END ELSE ERROR(58); 40396000 + CURTYPE:=INTTYPE; PUTSYM(")"); 40397000 + END ELSE 40398000 + IF CURNAME1="400PRED" OR % "PRED"/"SUCC" 40399000 + CURNAME1="400SUCC" THEN 40400000 + BEGIN 40401000 + FIRST:=CURNAME1="400PRED"; 40402000 + PUTTEXT("CHECK("); INSYMBOL; 40403000 + IF CURSY=LPAR THEN 40404000 + BEGIN 40405000 + INSYMBOL; EXPRESSION; 40406000 + PUTSYM(IF FIRST THEN "-" ELSE "+"); PUTSYM("1"); 40407000 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(67); 40408000 + PUTSYM(","); PUTCONST(TYPETAB2[CURTYPE]); 40409000 + PUTSYM(","); PUTCONST(TYPETAB3[CURTYPE]); 40410000 + PUTSYM(","); PUTCONST(CARDCNT); 40411000 + PUTSYM(")"); 40412000 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40413000 + IF CURSY=RPAR THEN INSYMBOL; 40414000 + END ELSE BEGIN ERROR(58); CURTYPE:=0 END; 40415000 + END ELSE 40416000 + IF CURNAME1="50ROUND" THEN % "ROUND" 40417000 + BEGIN 40418000 + PUTTEXT(" ROUND"); PARAMETER; 40419000 + IF CURTYPE!REALTYPE THEN ERROR(67); 40420000 + NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40421000 + PUTCONST(CARDCNT); PUTSYM(")"); 40422000 + CURTYPE:=INTTYPE; 40423000 + END ELSE 40424000 + IF CURNAME1="3000SQR" THEN % "SQR" 40425000 + BEGIN 40426000 + PUTTEXT(" SQR"); PARAMETER; 40427000 + NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40428000 + PUTCONST(CARDCNT); PUTSYM(")"); 40429000 + IF CURTYPE!REALTYPE AND CURTYPE!INTTYPE THEN ERROR(67); 40430000 + END ELSE 40431000 + IF CURNAME1="50TRUNC" THEN % "TRUNC" 40432000 + BEGIN 40433000 + PUTTEXT(" TRUNC"); PARAMETER; 40434000 + NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40435000 + PUTCONST(CARDCNT); PUTSYM(")"); 40436000 + IF CURTYPE!REALTYPE THEN ERROR(67); 40437000 + CURTYPE:=INTTYPE; 40438000 + END ELSE 40439000 + IF CURNAME1="6CONCAT" THEN % "CONCAT" 40440000 + CONCAT ELSE 40441000 + IF CURNAME1="400TIME" THEN % "TIME" 40442000 + BEGIN 40443000 + PUTTEXT("(TIME("); PUTTEXT("1)/60)"); 40444000 + CURTYPE:=REALTYPE; INSYMBOL 40445000 + END ELSE 40446000 + IF CURNAME1="400DATE" THEN % "DATE" 40447000 + BEGIN 40448000 + PUTTEXT("CURDAT"); 40449000 + CURTYPE:=ALFATYPE; INSYMBOL; 40450000 + END ELSE 40451000 + IF CURNAME1="7CPUTIM" AND CURNAME2="E" THEN % "CPUTIME" 40452000 + BEGIN 40453000 + PUTTEXT("(TIME("); PUTTEXT("2)/60)"); 40454000 + CURTYPE:=REALTYPE; INSYMBOL; 40455000 + END ELSE 40456000 + IF CURNAME1="6IOTIME" THEN % "IOTIME" 40457000 + BEGIN 40458000 + PUTTEXT("(TIME("); PUTTEXT("3)/60)"); 40459000 + CURTYPE:=REALTYPE; INSYMBOL; 40460000 + END ELSE 40461000 + IF CURNAME1="7WEEKDA" AND CURNAME2="Y" THEN % "WEEKDAY" 40462000 + BEGIN 40463000 + PUTTEXT("WEEKDA"); 40464000 + CURTYPE:=ALFATYPE; INSYMBOL; 40465000 + END ELSE IF CURNAME1="400USER" THEN % "USER" 40466000 + BEGIN 40467000 + PUTTEXT(" TIME"); PUTTEXT(" (-1)"); 40468000 + CURTYPE:=ALFATYPE; INSYMBOL; 40469000 + END ELSE % "SIN","COS" ETC.40470000 + BEGIN 40471000 + PUTTEXT(IF CURNAME1="3000SIN" THEN " SIN" ELSE 40472000 + IF CURNAME1="3000COS" THEN " COS" ELSE 40473000 + IF CURNAME1="6ARCTAN" THEN "ARCTAN" ELSE 40474000 + IF CURNAME1="400SQRT" THEN " SQRT" ELSE 40475000 + IF CURNAME1="3000EXP" THEN " EXP" ELSE 40476000 + " LN"); 40477000 + PARAMETER; 40478000 + IF CURTYPE!REALTYPE AND CURTYPE!INTTYPE THEN ERROR(67); 40479000 + CURTYPE:=REALTYPE; 40480000 + END; 40481000 + END OF INTRINSIC FUNCTIONS ELSE 40482000 + BEGIN 40483000 + T:=THISID.TYPE; 40484000 + PASSPARAMS; 40485000 + CURTYPE:=T; 40486000 + END; 40487000 + END OF FUNCTIONS ELSE 40488000 + IF THISID.IDCLASS=PROC THEN 40489000 + BEGIN 40490000 + ERROR(68); PASSPARAMS; 40491000 + CURTYPE:=0; 40492000 + END ELSE BEGIN ERROR(69); CURTYPE:=0; INSYMBOL END; 40493000 + END ELSE BEGIN ERROR(1); CURTYPE:=0; INSYMBOL END; 40494000 + END OF IDENTIFIER ELSE 40495000 + IF CURSY{CHARCONST THEN 40496000 + BEGIN 40497000 + CONSTANT(VAL,CURTYPE); PUTCONST(VAL); 40498000 + END ELSE 40499000 + IF CURSY=NOTSY THEN 40500000 + BEGIN 40501000 + PUTTEXT(" NOT "); PUTDUMMY; STARTSYM:=NUMSYMS; 40502000 + INSYMBOL; FACTOR; 40503000 + IF CURTYPE>0 THEN 40504000 + IF CURTYPE!BOOLTYPE THEN BEGIN ERROR(17); CURTYPE:=0 END; 40505000 + IF CURMODE=NUMBER THEN 40506000 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")"); 40507000 + CURMODE:=BITPATTERN; 40508000 + END; 40509000 + END ELSE 40510000 + IF CURSY=NILSY THEN 40511000 + BEGIN 40512000 + PUTCONST(0); CURTYPE:=NILTYPE; 40513000 + INSYMBOL; 40514000 + END ELSE 40515000 + IF CURSY=LPAR THEN 40516000 + BEGIN 40517000 + PUTSYM("("); 40518000 + INSYMBOL; EXPRESSION; 40519000 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40520000 + PUTSYM(")"); 40521000 + INSYMBOL; 40522000 + END ELSE 40523000 + IF CURSY=LBRACKET THEN %*** SET CONSTANT *** 40524000 + BEGIN 40525000 + INSYMBOL; 40526000 + IF CURSY=RBRACKET THEN 40527000 + BEGIN 40528000 + PUTTEXT("SETBS("); PUTTEXT(" 3,2,"); PUTCONST(CARDCNT); % 40529000 + PUTSYM(")"); % %601-40529300 + CURTYPE := EMPTYSET; CURMODE := NUMBER; % %601-40529600 + INSYMBOL; 40530000 + END ELSE 40531000 + BEGIN 40532000 + FIRST:=TRUE; 40533000 + STARTSYM := NUMSYMS + 1; % %601-40533500 + DO BEGIN 40534000 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 40535000 + PUTTEXT(" SETB("); % %601-40536000 + EXPRESSION; 40537000 + IF STYPE=0 THEN 40538000 + BEGIN STYPE:=CURTYPE; 40539000 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(72); 40540000 + END ELSE CHECKTYPES(STYPE,CURTYPE); 40541000 + IF CURSY=DOUBLEDOT THEN 40542000 + BEGIN 40543000 + PUTSYM(","); SYMTAB[STARTSYM] := "SETBS("; % %601-40544000 + INSYMBOL; EXPRESSION; 40545000 + IF STYPE=0 THEN 40546000 + BEGIN STYPE:=CURTYPE; 40547000 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(72); 40548000 + END ELSE CHECKTYPES(STYPE,CURTYPE); 40549000 + END; 40550000 + PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); 40551000 + IF SPLITTED THEN PUTSYM(")"); % %601-40551500 + IF CURSY=COMMA THEN % %601-40552000 + BEGIN % %601-40552200 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SUNIO("; % %601-40552400 + PUTSYM(","); % %601-40552600 + SPLITTED := TRUE; % %601-40552800 + END; % %601-40552850 + END UNTIL CURSY!COMMA; 40553000 + IF CURSY!RBRACKET THEN 40554000 + BEGIN ERROR(59); SKIP(RBRACKET); 40555000 + IF CURSY=RBRACKET THEN INSYMBOL; 40556000 + END ELSE INSYMBOL; 40557000 + NEWTYPE; T1 := SET; T1.SIZE := 2; T1.STRUCT := 0; % %601-40558000 + T1.SETTYPE:=STYPE; TYPETAB1[TYPEINDEX]:=T1; 40559000 + CURTYPE:=TYPEINDEX; 40560000 + CURMODE := NUMBER; % %601-40561000 + END; 40562000 + END OF SET CONSTANT ELSE BEGIN ERROR(99); INSYMBOL END; 40563000 +END OF FACTOR; 40564000 + 40565000 + 40566000 +PROCEDURE TERM; %*** TERM *** 40567000 +BEGIN %************ 40568000 + INTEGER STARTSYM,MODE,TYPE1,MULOPTR,F; 40569000 + PUTDUMMY; STARTSYM:=NUMSYMS; 40570000 + FACTOR; 40571000 + MODE:=CURMODE; 40572000 + WHILE CURSY}ASTERISK AND CURSY{MODSY DO % "*","/","DIV","MOD","AND"40573000 + BEGIN 40574000 + TYPE1:=CURTYPE; MULOPTR:=CURSY; 40575000 + F:=TYPETAB1[TYPE1].FORM; 40576000 + IF F=NUMERIC OR F=FLOATING THEN 40577000 + BEGIN 40578000 + MODE:=NUMBER; 40579000 + IF CURSY=ASTERISK THEN PUTSYM("|") ELSE 40580000 + IF CURSY=SLASH THEN PUTSYM("/") ELSE 40581000 + IF CURSY=ANDSY THEN ERROR(64) ELSE 40582000 + BEGIN 40583000 + IF F=FLOATING THEN ERROR(64); 40584000 + IF CURSY=DIVSY THEN PUTTEXT(" DIV") ELSE PUTTEXT(" MOD"); 40585000 + END END ELSE 40586000 + IF CURTYPE=BOOLTYPE THEN % %601-40587000 + BEGIN 40588000 + MODE:=BITPATTERN; 40589000 + IF CURMODE!MODE THEN 40590000 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40591000 + PUTTEXT(" AND "); 40592000 + IF CURSY NEQ ANDSY THEN ERROR(64); %601-40593000 + END ELSE % %601-40593100 + IF F=SET THEN % %601-40593200 + BEGIN % %601-40593300 + IF CURSY=ASTERISK THEN % %601-40593400 + BEGIN % %601-40593500 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SINTS("; % %601-40593600 + PUTSYM(","); % %601-40593700 + END ELSE ERROR(64); % %601-40593800 + MODE := NUMBER; % %601-40593900 + END ELSE ERROR(64); 40594000 + PUTDUMMY; STARTSYM:=NUMSYMS; 40595000 + INSYMBOL; FACTOR; 40596000 + IF CURTYPE>0 AND TYPE1>0 THEN 40597000 + BEGIN 40598000 + IF CURTYPE!TYPE1 THEN 40599000 + BEGIN 40600000 + IF TYPETAB1[TYPE1].FORM!NUMERIC OR CURTYPE!REALTYPE THEN 40601000 + CHECKTYPES(TYPE1,CURTYPE); 40602000 + IF TYPE1=REALTYPE THEN CURTYPE:=REALTYPE; 40603000 + END; 40604000 + IF CURTYPE=REALTYPE AND MULOPTR}DIVSY THEN ERROR(65); 40605000 + END; 40606000 + IF MULOPTR=SLASH THEN CURTYPE:=REALTYPE; 40607000 + IF CURTYPE=0 THEN CURTYPE:=TYPE1; 40608000 + IF F=SET THEN PUTSYM(")"); % %601-40608500 + END OF WHILE LOOP; 40609000 + IF MODE=BITPATTERN AND CURMODE!MODE THEN 40610000 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40611000 + CURMODE:=MODE; 40612000 +END OF TERM; 40613000 + 40614000 + 40615000 +PROCEDURE SIMPLEEXPRESSION; %*** SIMPLE EXPRESSION *** 40616000 +BEGIN %************************* 40617000 + INTEGER STARTSYM,FIRSTSYM,MODE,TYPE1,F; %603-40618000 + BOOLEAN SIGNED; 40619000 + 40620000 + PUTDUMMY; STARTSYM := FIRSTSYM := NUMSYMS; %603-40621000 + IF CURSY=PLUS OR CURSY=MINUS THEN 40622000 + BEGIN SIGNED:=TRUE; 40623000 + PUTSYM(IF CURSY=PLUS THEN"+" ELSE "-"); 40624000 + INSYMBOL; 40625000 + END; 40626000 + TERM; 40627000 + MODE:=CURMODE; 40628000 + IF SIGNED THEN 40629000 + BEGIN F:=TYPETAB1[CURTYPE].FORM; 40630000 + IF F!NUMERIC AND F!FLOATING THEN ERROR(29); 40631000 + END; 40632000 + WHILE CURSY}PLUS AND CURSY{ORSY DO % "+","-","OR" 40633000 + BEGIN 40634000 + TYPE1:=CURTYPE; F:=TYPETAB1[TYPE1].FORM; 40635000 + IF F=NUMERIC OR F=FLOATING THEN 40636000 + BEGIN MODE:=NUMBER; 40637000 + IF CURSY=PLUS THEN PUTSYM("+") ELSE 40638000 + IF CURSY=MINUS THEN PUTSYM("-") ELSE ERROR(64); 40639000 + END ELSE 40640000 + IF CURTYPE=BOOLTYPE THEN 40641000 + BEGIN 40642000 + MODE:=BITPATTERN; 40643000 + IF CURMODE!MODE THEN 40644000 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40645000 + IF CURSY=ORSY THEN PUTTEXT(" OR") ELSE ERROR(64); 40646000 + END ELSE 40647000 + IF F=SET THEN 40648000 + BEGIN 40649000 + SPLIT(FIRSTSYM,1); %603-40650000 + IF CURSY = PLUS THEN SYMTAB[FIRSTSYM] := "SUNIO(" ELSE %603-40651000 + IF CURSY = MINUS THEN SYMTAB[FIRSTSYM] := "SDIFF(" ELSE %603-40652000 + ERROR(64); %603-40653000 + PUTSYM(","); MODE := NUMBER; % %601-40654000 + END ELSE ERROR(64); 40656000 + INSYMBOL; 40657000 + PUTDUMMY; STARTSYM:=NUMSYMS; 40658000 + TERM; 40659000 + IF CURTYPE>0 AND TYPE1>0 THEN 40660000 + BEGIN 40661000 + IF CURTYPE!TYPE1 THEN 40662000 + BEGIN 40663000 + IF TYPETAB1[TYPE1].FORM!NUMERIC OR CURTYPE!REALTYPE THEN 40664000 + CHECKTYPES(TYPE1,CURTYPE); 40665000 + IF TYPE1=REALTYPE THEN CURTYPE:=REALTYPE; 40666000 + END END; 40667000 + IF CURTYPE=0 THEN CURTYPE:=TYPE1; 40668000 + IF F=SET THEN PUTSYM(")"); % %601-40668500 + END OF WHILE LOOP; 40669000 + IF MODE=BITPATTERN AND CURMODE!BITPATTERN THEN 40670000 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40671000 + CURMODE:=MODE; 40672000 +END OF SIMPLEEXPRESSION; 40673000 + 40674000 + 40675000 +PROCEDURE EXPRESSION; %*** EXPRESSION *** 40676000 +BEGIN %****************** 40677000 + INTEGER STARTSYM,FIRSTSYM,TYPE1,RELOPTR,F; 40678000 + BOOLEAN CALLGEN; 40679000 + 40680000 + EXPRLEVEL:=EXPRLEVEL+1; 40681000 + IF EXPRLEVEL = 1 THEN 40682000 + BEGIN 40683000 + PUTDUMMY; 40684000 + FIRSTSYM := NUMSYMS; 40685000 + END; 40686000 + PUTDUMMY; STARTSYM:=NUMSYMS; 40687000 + SIMPLEEXPRESSION; 40689000 + IF CURSY}LSSSY AND CURSY{INSY THEN % "<","{","}",">","=","!","IN"40690000 + BEGIN 40691000 + TYPE1:=CURTYPE; F:=TYPETAB1[TYPE1].FORM; 40692000 + RELOPTR:=CURSY; 40693000 + IF F{ALFA THEN 40694000 + BEGIN 40695000 + IF CURMODE=BITPATTERN THEN 40696000 + BEGIN SYMTAB[STARTSYM]:=" REAL("; PUTSYM(")") END; 40697000 + IF CURSY=LSSSY THEN PUTSYM("<") ELSE 40698000 + IF CURSY=LEQSY THEN PUTSYM("{") ELSE 40699000 + IF CURSY=GEQSY THEN PUTSYM("}") ELSE 40700000 + IF CURSY=GTRSY THEN PUTSYM(">") ELSE 40701000 + IF CURSY=EQLSY THEN PUTSYM("=") ELSE 40702000 + IF CURSY=NEQSY THEN PUTSYM("!") ELSE 40703000 + BEGIN 40704000 + IF F}FLOATING THEN ERROR(64); 40705000 + SYMTAB[STARTSYM]:="INTST("; PUTSYM(","); CALLGEN:=TRUE; 40706000 + END; 40707000 + END ELSE 40708000 + IF F=SET THEN 40709000 + BEGIN 40710000 + IF CURMODE=BITPATTERN THEN 40711000 + BEGIN SYMTAB[STARTSYM+1]:=" REAL("; PUTSYM(")") END; 40712000 + IF CURSY=EQLSY THEN SYMTAB[STARTSYM] := "SEQUA(" % %601-40713000 + ELSE %601-40713150 + IF CURSY=NEQSY THEN % %601-40713300 + BEGIN % %601-40714000 + SPLIT(STARTSYM,1); SYMTAB[STARTSYM]:= " NOT "; % %601-40714150 + SYMTAB[STARTSYM+1] := "SEQUA("; % %601-40714300 + END ELSE 40715000 + BEGIN 40716000 + IF CURSY=LEQSY THEN SYMTAB[STARTSYM]:="INCL1(" ELSE 40717000 + IF CURSY=GEQSY THEN SYMTAB[STARTSYM]:="INCL2(" ELSE ERROR(64);40718000 + PUTSYM(","); CALLGEN:=TRUE; 40719000 + END END ELSE 40720000 + IF F=POINTERS THEN 40721000 + BEGIN 40722000 + IF CURSY=EQLSY THEN PUTSYM("=") ELSE 40723000 + IF CURSY=NEQSY THEN PUTSYM("!") ELSE ERROR(64); 40724000 + END ELSE ERROR(64); 40725000 + INSYMBOL; 40726000 + PUTDUMMY; STARTSYM:=NUMSYMS; 40727000 + SIMPLEEXPRESSION; 40728000 + IF CURTYPE>0 AND TYPE1>0 THEN 40729000 + IF CURTYPE!TYPE1 THEN 40730000 + IF RELOPTR!INSY THEN 40731000 + BEGIN 40732000 + IF TYPETAB1[TYPE1].FORM!NUMERIC OR CURTYPE!REALTYPE THEN 40733000 + CHECKTYPES(TYPE1,CURTYPE); 40734000 + END ELSE 40735000 + IF TYPETAB1[CURTYPE].FORM!SET THEN ERROR(66) 40736000 + ELSE CHECKTYPES(TYPE1,TYPETAB1[CURTYPE].SETTYPE); 40737000 + IF CURMODE=BITPATTERN THEN 40738000 + BEGIN SYMTAB[STARTSYM]:=" REAL("; PUTSYM(")") END; 40739000 + IF CALLGEN THEN PUTSYM(")"); 40740000 + CURTYPE:=BOOLTYPE; CURMODE:=BITPATTERN; 40741000 + END; 40742000 + EXPRLEVEL:=EXPRLEVEL-1; 40743000 + IF EXPRLEVEL=0 THEN 40744000 + BEGIN 40745000 + IF CURMODE=BITPATTERN THEN 40746000 + BEGIN 40747000 + SYMTAB[FIRSTSYM] := " REAL("; 40748000 + PUTSYM(")"); 40749000 + END; 40750000 + IF EXPINVARCNT=0 THEN WRITEEXPR; % %002-40751000 + END; 40752000 +END OF EXPRESSION; 40753000 + 40754000 + 40755000 +DEFINE BOOLEXPR= 40756000 +BEGIN 40757000 + PUTDUMMY; EXPRLEVEL:=1; EXPRESSION; 40758000 + IF CURTYPE>0 THEN IF CURTYPE!BOOLTYPE THEN ERROR(17); 40759000 + IF CURMODE!BITPATTERN THEN 40760000 + BEGIN SYMTAB[1]:=" B("; PUTSYM(")") END; 40761000 + EXPRLEVEL:=0; WRITEEXPR; 40762000 +END OF BOOLEAN#; 40763000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%50001000 +% %50002000 +% %50003000 +% %50004000 +% PART 5: INTRINSIC ROUTINES. %50005000 +% ------------------- %50006000 +% %50007000 +% %50008000 +% %50009000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%50010000 + 50011000 + 50012000 +PROCEDURE CONCAT; %*** "CONCAT" *** 50013000 +BEGIN %**************** 50014000 + DEFINE INTEXPR= 50015000 + BEGIN INSYMBOL; EXPRESSION; 50016000 + IF CURTYPE>0 THEN 50017000 + IF TYPETAB1[CURTYPE].FORM!NUMERIC THEN ERROR(17); 50018000 + END #; 50019000 + 50020000 + PUTTEXT("CONCAT"); PUTSYM("("); 50021000 + INSYMBOL; 50022000 + IF CURSY=LPAR THEN 50023000 + BEGIN 50024000 + INSYMBOL; EXPRESSION; 50025000 + IF CURTYPE>0 THEN 50026000 + IF TYPETAB1[CURTYPE].FORM>ALFA THEN ERROR(17); 50027000 + IF CURSY=COMMA THEN 50028000 + BEGIN 50029000 + PUTSYM(","); INSYMBOL; EXPRESSION; 50030000 + IF CURTYPE>0 THEN 50031000 + IF TYPETAB1[CURTYPE].FORM>ALFA THEN ERROR(17); 50032000 + IF CURSY=COMMA THEN 50033000 + BEGIN 50034000 + PUTSYM(","); INTEXPR; 50035000 + IF CURSY=COMMA THEN 50036000 + BEGIN 50037000 + PUTSYM(","); INTEXPR; 50038000 + IF CURSY=COMMA THEN 50039000 + BEGIN 50040000 + PUTSYM(","); INTEXPR; 50041000 + PUTSYM(","); PUTCONST(CARDCNT); 50042000 + PUTSYM(")"); 50043000 + IF CURSY!RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; 50044000 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50045000 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50046000 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50047000 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50048000 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50049000 + CURTYPE := 0; % ALFATYPE OR REALTYPE %509-50050000 + IF CURSY=RPAR THEN INSYMBOL; 50051000 +END OF CONCAT; 50052000 + 50053000 + 50054000 +PROCEDURE PREAD(CHANGELINE); 50055000 +VALUE CHANGELINE; BOOLEAN CHANGELINE; 50056000 +BEGIN 50057000 + INTEGER FILEID,F; 50058000 + GEN(" BEGIN",7,2); 50060000 + FILEPARAM(INPUTFILE); FILEID:=FILENAME; 50061000 + IF TYPETAB1[CURTYPE].FORM=FILES THEN ERROR(85); 50062000 + IF SYMKIND[CURSY]!TERMINAL THEN 50063000 + BEGIN 50064000 + IF CURSY NEQ RPAR THEN 50065000 + DO BEGIN 50066000 + WHILE CURSY=COMMA DO INSYMBOL; 50067000 + IF CURSY=IDENTIFIER THEN 50068000 + BEGIN 50069000 + SEARCH; 50070000 + IF FOUND THEN 50071000 + BEGIN 50072000 + IF THISID.IDCLASS=VAR OR 50073000 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 50074000 + BEGIN 50075000 + VARIABLE; F:=TYPETAB1[CURTYPE].FORM; 50076000 + IF F=NUMERIC OR F=FLOATING OR F=CHAR THEN 50077000 + BEGIN 50078000 + GEN("PREAD(",6,2); WRITEEXPR; GEN(",",1,7); % %600-50079000 + GENID("F",FILEID,5); GEN(",",1,7); % %600-50082000 + GENID("V",FILEID,5); GEN(",",1,7); 50083000 + GENID("I",FILEID,5); GEN(",",1,7); 50084000 + IF F=NUMERIC THEN GENINT(2) ELSE 50085000 + IF F=FLOATING THEN GENINT(3) ELSE GENINT(1); 50086000 + IF F=NUMERIC THEN % %600-50086010 + BEGIN % %600-50086050 + GEN(",",1,7); GENINT(TYPETAB2[CURTYPE]); % %600-50086100 + GEN(",",1,7); GENINT(TYPETAB3[CURTYPE]); % %600-50086150 + END ELSE GEN(",0,0,",4,4); % %600-50086200 + GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50087000 + END ELSE BEGIN ERROR(82); INSYMBOL END; 50094000 + END ELSE BEGIN ERROR(8); INSYMBOL END; 50095000 + END ELSE BEGIN ERROR(1); INSYMBOL END; 50096000 + END ELSE ERROR(9); 50097000 + GEN(";",1,7); 50098000 + END UNTIL CURSY!COMMA; 50099000 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50100000 + IF CURSY=RPAR THEN INSYMBOL; 50101000 + END; 50102000 + IF CHANGELINE THEN 50103000 + BEGIN 50104000 + GEN("RLINE(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 50105000 + GENID("V",FILEID,5); GEN(",",1,7); 50106000 + GENID("I",FILEID,5); GEN(")",1,7); 50107000 + END; 50108000 + GEN("END",4,5); 50109000 +END OF PREAD; 50110000 + 50111000 + 50112000 +PROCEDURE PWRITE(LINEFEED); 50113000 +VALUE LINEFEED; BOOLEAN LINEFEED; 50114000 +BEGIN 50115000 + INTEGER FILEID,F,I,LASTSY; 50116000 + POINTER P; 50117000 + GEN(" BEGIN",7,2); 50118000 + FILEPARAM(OUTPUTFILE); FILEID:=FILENAME; 50119000 + IF TYPETAB1[CURTYPE].FORM=FILES THEN ERROR(85); 50120000 + IF SYMKIND[CURSY]!TERMINAL THEN 50121000 + BEGIN 50122000 + IF CURSY NEQ RPAR THEN 50123000 + DO BEGIN 50124000 + WHILE CURSY=COMMA DO INSYMBOL; 50125000 + IF CURSY=ALFACONST AND CURLENGTH>7 THEN 50126000 + BEGIN 50127000 + GEN("WALFA(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 50128000 + GENID("V",FILEID,5); GEN(",",1,7); 50129000 + GENID("I",FILEID,5); GEN(",",1,7); 50130000 + P:=STRINGPNT; 50131000 + FOR I:=1 STEP 7 UNTIL 80 DO 50132000 + IF I{CURLENGTH THEN 50133000 + BEGIN 50134000 + IF ALGOLCNT<10 THEN WRITEALGOL; 50135000 + REPLACE ALGOLPNT:ALGOLPNT BY """, P:P FOR 7, """, ","; 50136000 + ALGOLCNT:=ALGOLCNT-10; 50137000 + END ELSE GEN("0,",2,6); 50138000 + GENINT(CURLENGTH); GEN(",",1,7); 50139000 + GENINT(CARDCNT); GEN(")",1,7); 50140000 + INSYMBOL; 50141000 + END OF ALFACONST ELSE 50142000 + BEGIN 50143000 + GEN("PWRITE(",7,1); GENID("F",FILEID,5); GEN(",",1,7); 50144000 + GENID("V",FILEID,5); GEN(",",1,7); 50145000 + GENID("I",FILEID,5); GEN(",",1,7); 50146000 + LASTSY:=CURSY; 50147000 + EXPRESSION; F:=TYPETAB1[CURTYPE].FORM; 50148000 + GEN(",",1,7); 50149000 + IF F=NUMERIC OR F=FLOATING OR F=CHAR OR F=ALFA OR 50150000 + CURTYPE=BOOLTYPE THEN 50151000 + BEGIN 50152000 + IF F=NUMERIC THEN GENINT(1) ELSE 50153000 + IF F=FLOATING THEN GENINT(2) ELSE 50154000 + IF F=ALFA THEN GENINT(5) ELSE 50155000 + IF F=CHAR THEN GENINT(4) ELSE GENINT(3); 50156000 + GEN(",",1,7); 50157000 + IF CURSY=COLON THEN 50158000 + BEGIN 50159000 + INSYMBOL; EXPRESSION; 50160000 + IF TYPETAB1[CURTYPE].FORM NEQ NUMERIC THEN ERROR(17); 50161000 + GEN(",",1,7); 50162000 + IF CURSY=COLON THEN 50163000 + BEGIN 50164000 + IF F!FLOATING THEN ERROR(4); 50165000 + INSYMBOL; EXPRESSION; 50166000 + IF TYPETAB1[CURTYPE].FORM NEQ NUMERIC THEN ERROR(17); 50167000 + GEN(",",1,7); 50168000 + END ELSE GEN("-1,",3,5); 50169000 + END ELSE 50170000 + BEGIN 50171000 + IF F=FLOATING THEN GENINT(16) ELSE 50172000 + IF F=ALFA AND LASTSY=ALFACONST THEN GENINT(CURLENGTH) ELSE50173000 + IF F=ALFA THEN GENINT(7) ELSE 50174000 + IF F=CHAR THEN GENINT(1) ELSE GENINT(10); 50175000 + GEN(",-1,",4,4); 50176000 + END; 50177000 + END ELSE ERROR(17); 50178000 + GENINT(CARDCNT); GEN(")",1,7); 50179000 + END OF EXPRESSION; 50180000 + GEN(";",1,7); 50181000 + END UNTIL CURSY!COMMA; 50182000 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50183000 + IF CURSY=RPAR THEN INSYMBOL; 50184000 + END; 50185000 + FILENAME:=FILEID; 50186000 + IF LINEFEED THEN 50187000 + BEGIN 50188000 + INTEGER DUMMY; 50189000 + GEN("WLINE(",6,2); GENID("F",FILENAME,5); GEN(",",1,7); 50190000 + GENID("V",FILENAME,5); GEN(",",1,7); 50191000 + GENID("I",FILENAME,5); GEN(")",1,7); 50192000 + END; 50193000 + GEN("END",4,5); 50194000 +END OF PWRITE; 50195000 + 50196000 + 50197000 +PROCEDURE FILEHANDLING(PROCNUM); %*** FILE HANDLING PROCEDURES: 50198000 +VALUE PROCNUM; INTEGER PROCNUM; %*** 50199000 +BEGIN %*** 1) PUT 50200000 + INTEGER F; %*** 2) GET 50201000 + LABEL EFH; %002-50201500 + CASE PROCNUM OF %*** 3) RESET 50202000 + BEGIN ; % NULL %*** 4) REWRITE %001-50203000 + GEN("PUT",3,5); %*** 5) PAGE %001-50204000 + %*** 6) OPEN & CLOSE (INPUT) FOR 50204500 + % CUMULATIVE FREQUENCY COUNT50204550 + GEN("GET",3,5); % 50205000 + GEN("RESET",5,3); % 50206000 + GEN("REWRITE",7,1); % 50207000 + GEN("PPAGE",5,3); % %001-50208000 + BEGIN %002-50208100 + GEN("QQJZXL",6,2); %002-50208200 + INSYMBOL; %002-50208300 + GO TO EFH; % %002-50208400 + END; %002-50208500 + END; % 50209000 + GEN("(",1,7); FILEPARAM(0); % 50210000 + IF FILENAME=0 THEN ERROR(78); % 50211000 + F:=TYPETAB1[CURTYPE].FORM; 50212000 + IF F=FILES AND PROCNUM=5 THEN ERROR(80); 50213000 + GENID("F",FILENAME,5); GEN(",",1,7); 50214000 + GENID("V",FILENAME,5); GEN(",",1,7); 50215000 + GENID("I",FILENAME,5); GEN(",",1,7); 50216000 + GENINT(CARDCNT); GEN(")",1,7); 50217000 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50218000 + IF CURSY=RPAR THEN INSYMBOL; 50219000 +EFH: %002-50219500 +END OF FILEHANDLING; 50220000 + 50221000 + 50222000 +PROCEDURE PACK; 50223000 +BEGIN 50224000 + INTEGER IT; REAL T; %503-50225000 + GEN("PACK(",5,3); 50226000 + INSYMBOL; 50227000 + IF CURSY=LPAR THEN 50228000 + BEGIN 50229000 + INSYMBOL; 50230000 + IF CURSY=IDENTIFIER THEN 50231000 + BEGIN 50232000 + SEARCH; 50233000 + IF FOUND THEN 50234000 + BEGIN 50235000 + IF THISID.IDCLASS=VAR THEN 50236000 + BEGIN 50237000 + T:=TYPETAB1[THISID.TYPE]; 50238000 + IF T.FORM=ARRAYS THEN 50239000 + BEGIN 50240000 + IT:=T.INXTYPE; 50241000 + IF TYPETAB1[T.ARRTYPE].FORM!CHAR THEN ERROR(88); 50242000 + GENID("H",1000|THISLEVEL+THISINDEX,5); %518-50243100 + GEN(",",1,7); GENINT(TYPETAB2[THISID.TYPE]); 50245000 + GEN(",",1,7); GENINT(TYPETAB3[THISID.TYPE]); 50246000 + END ELSE ERROR(88); 50247000 + END ELSE ERROR(88); 50248000 + END ELSE ERROR(1); 50249000 + END ELSE ERROR(9); 50250000 + INSYMBOL; 50251000 + IF CURSY=COMMA THEN 50252000 + BEGIN 50253000 + GEN(",",1,7); 50254000 + INSYMBOL; EXPRESSION; CHECKTYPES(IT,CURTYPE); 50255000 + IF CURSY=COMMA THEN 50256000 + BEGIN 50257000 + GEN(",",1,7); 50258000 + INSYMBOL; 50259000 + IF CURSY=IDENTIFIER THEN 50260000 + BEGIN 50261000 + SEARCH; 50262000 + IF FOUND THEN 50263000 + BEGIN 50264000 + IF THISID.IDCLASS=VAR OR 50265000 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 50266000 + BEGIN 50267000 + VARIABLE; WRITEEXPR; 50268000 + IF CURTYPE>0 THEN 50269000 + IF TYPETAB1[CURTYPE].FORM!ALFA THEN ERROR(12); 50270000 + END ELSE ERROR(8); 50271000 + END ELSE ERROR(1); 50272000 + END ELSE ERROR(9); 50273000 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50274000 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50275000 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50276000 + IF CURSY=RPAR THEN INSYMBOL; 50277000 + END ELSE BEGIN ERROR(3); INSYMBOL END; 50278000 + GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50279000 +END OF PACK; 50280000 + 50281000 + 50282000 +PROCEDURE UNPACK; 50283000 +BEGIN 50284000 + INTEGER IT; REAL T; %503-50285000 + GEN("UNPACK(",7,1); INSYMBOL; 50286000 + IF CURSY=LPAR THEN 50287000 + BEGIN 50288000 + INSYMBOL; EXPRESSION; 50289000 + IF CURTYPE>0 THEN IF TYPETAB1[CURTYPE].FORM!ALFA THEN ERROR(17); 50290000 + IF CURSY=COMMA THEN 50291000 + BEGIN 50292000 + GEN(",",1,7); INSYMBOL; 50293000 + IF CURSY=IDENTIFIER THEN 50294000 + BEGIN 50295000 + SEARCH; 50296000 + IF FOUND THEN 50297000 + BEGIN 50298000 + IF THISID.IDCLASS=VAR THEN 50299000 + BEGIN 50300000 + T:=TYPETAB1[THISID.TYPE]; 50301000 + IF T.FORM=ARRAYS THEN 50302000 + BEGIN 50303000 + IT:=T.INXTYPE; 50304000 + IF TYPETAB1[T.ARRTYPE].FORM!CHAR THEN ERROR(88); 50305000 + GENID("H",1000|THISLEVEL+THISINDEX,5); %518-50307100 + GEN(",",1,7); GENINT(TYPETAB2[THISID.TYPE]); 50308000 + GEN(",",1,7); GENINT(TYPETAB3[THISID.TYPE]); 50309000 + END ELSE ERROR(88); 50310000 + END ELSE ERROR(88); 50311000 + END ELSE ERROR(1); 50312000 + END ELSE ERROR(9); 50313000 + INSYMBOL; 50314000 + IF CURSY=COMMA THEN 50315000 + BEGIN 50316000 + GEN(",",1,7); 50317000 + INSYMBOL; EXPRESSION; CHECKTYPES(IT,CURTYPE); 50318000 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50319000 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50320000 + IF CURSY!RPAR THEN BEGIN ERROR(89); SKIP(RPAR) END; 50321000 + IF CURSY=RPAR THEN INSYMBOL; 50322000 + END ELSE BEGIN ERROR(3); INSYMBOL END; 50323000 + GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50324000 +END OF UNPACK; 50325000 + 50326000 + 50327000 +PROCEDURE NEWDISP; %*** "NEW","DISPOSE" 50328000 +BEGIN 50329000 + INTEGER T1; 50330000 + IF CURNAME1="3000NEW" THEN GEN("NEW(",4,4) ELSE 50331000 + BEGIN GEN("DISPOSE",7,1); GEN("(",1,7) END; 50332000 + INSYMBOL; 50333000 + IF CURSY=LPAR THEN 50334000 + BEGIN 50335000 + INSYMBOL; 50336000 + IF CURSY=IDENTIFIER THEN 50337000 + BEGIN 50338000 + SEARCH; 50339000 + IF FOUND THEN 50340000 + BEGIN 50341000 + VARIABLE; 50342000 + IF CURTYPE>0 THEN IF TYPETAB1[CURTYPE].FORM=POINTERS THEN 50343000 + BEGIN 50344000 + WRITEEXPR; GEN(",",1,7); 50345000 + T1:=TYPETAB1[CURTYPE].POINTTYPE; 50346000 + T1:=TYPETAB1[T1].SIZE; 50347000 + IF T1>1023 THEN ERROR(86); 50348000 + GENINT(T1); GEN(")",1,7); 50349000 + END ELSE ERROR(81); 50350000 + END ELSE BEGIN ERROR(1); INSYMBOL END; 50351000 + END ELSE ERROR(9); 50352000 + WHILE CURSY=COMMA DO 50353000 + BEGIN INSYMBOL; 50354000 + IF CURSY NEQ IDENTIFIER THEN ERROR(9); 50355000 + IF CURSY NEQ RPAR THEN INSYMBOL; 50356000 + END; 50357000 + END ELSE BEGIN ERROR(58); SKIP(RPAR) END; 50358000 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50359000 + IF CURSY=RPAR THEN INSYMBOL; 50360000 +END OF NEWDISP; 50361000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%60001000 +% %60002000 +% %60003000 +% %60004000 +% PART 6: THE STATEMENT PARSER. %60005000 +% --------------------- %60006000 +% %60007000 +% %60008000 +% %60009000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%60010000 + 60011000 + 60012000 + 60013000 +PROCEDURE STATEMENT; FORWARD; 60014000 + 60015000 +PROCEDURE ASSIGNMENT; 60016000 +BEGIN 60017000 + INTEGER LEFTTYPE; 60018000 + LABEL ASSIGN,EXIT; 60019000 + %512-60020000 + PROCEDURE WRITESEXPR; %*** FIX STRUCTURE FOR ASSIGNMENT %512-60021000 + BEGIN % USED ONLY IN ASSIGNMENT OF STRUCTURES 60022000 + IF INSIDEBRACKETS THEN IF SYMTAB[NUMSYMS] = "100000," %512-60023000 + THEN SYMTAB[NUMSYMS] := ", 0 ] " ELSE PUTSYM("]"); %512-60024000 + WHILE NUMPOINTERS>0 DO %512-60025000 + BEGIN NUMPOINTERS := NUMPOINTERS-1; %512-60026000 + IF NUMSYMS+4 } MAXSYMS THEN WRITEEXPR; %512-60027000 + REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY %512-60028000 + "00-1)DIV00 1022,00 T MOD00 1022]"; %512-60029000 + NUMSYMS := NUMSYMS+4; %512-60030000 + END; % OF WHILE %512-60031000 + WRITEEXPR; GEN( ",", 1,7 ); %512-60032000 + END WRITESEXPR; %512-60033000 + %512-60034000 + IF FOUND THEN 60050000 + BEGIN 60051000 + IF THISID.IDCLASS=VAR OR 60052000 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 60053000 + BEGIN 60054000 + VARIABLE; LEFTTYPE:=CURTYPE; 60055000 +ASSIGN: IF CURSY!ASSIGNSY THEN 60056000 + BEGIN ERROR(28); SKIP(ASSIGNSY); 60057000 + IF SYMKIND[CURSY]=TERMINAL THEN GO TO EXIT; 60058000 + END; 60059000 + INSYMBOL; 60060000 + IF TYPETAB1[LEFTTYPE].STRUCT>0 THEN 60061000 + BEGIN 60062000 + %ERROR(95); % STRUCTURED ASSIGNMENT NOT IMPLEMENTED. %512-60063000 + EXPRLEVEL := EXPRLEVEL+1; %507-60063900 + GEN("ASSIGN(",7,1); WRITESEXPR; %512-60064000 + EXPRESSION; WRITESEXPR; %512-60065000 + EXPRLEVEL := EXPRLEVEL-1; %507-60065100 + GENINT(TYPETAB1[LEFTTYPE].SIZE); GEN(")",1,7); %512-60066000 + IF TYPETAB1[LEFTTYPE].SIZE!TYPETAB1[CURTYPE].SIZE %512-60067000 + THEN ERROR(95); %512-60068000 + END ELSE 60080000 + IF TYPETAB1[LEFTTYPE].FORM=SET THEN % %601-60080100 + BEGIN % %601-60080200 + SYMTAB[1] := "SSTOR("; NUMSYMS := NUMSYMS - 3; % %601-60080300 + EXPRESSION; % %601-60080400 + PUTSYM(")"); CHECKTYPES(LEFTTYPE,CURTYPE); % %601-60080500 + WRITEEXPR; % %601-60080600 + END ELSE % %601-60080700 + BEGIN 60081000 + WRITEEXPR; GEN(":=",2,6); 60082000 + IF CHECKOPTION AND TYPETAB1[LEFTTYPE].FORM{CHAR THEN 60083000 + CHECKEXPR(TYPETAB2[LEFTTYPE],TYPETAB3[LEFTTYPE]) ELSE 60084000 + EXPRESSION; 60085000 + WRITEEXPR; 60086000 + END; %512-60087000 + CHECKTYPES( LEFTTYPE, CURTYPE ); %512-60088000 + END ELSE 60089000 + BEGIN % FUNCTION ASSIGNMENT. 60090000 + IF THISLEVEL!CURLEVEL-1 OR THISINDEX!CURFUNC THEN ERROR(5);%511-60091000 + GENID("V",1000|THISLEVEL+THISINDEX,5); LEFTTYPE:=THISID.TYPE; 60092000 + INSYMBOL; GO TO ASSIGN; 60093000 + END; 60094000 + END ELSE 60095000 + BEGIN 60096000 + SKIP(ASSIGNSY); 60097000 + IF CURSY=ASSIGNSY THEN GO TO ASSIGN; 60098000 + END; 60099000 +EXIT: 60100000 +END OF ASSIGNMENT; 60101000 + 60102000 + 60103000 +PROCEDURE COMPSTAT; 60104000 +BEGIN 60105000 + INTEGER BEGINNUM; 60106000 + LABEL STATM; 60107000 + 60108000 + BEGINNUM:=NUMBEGINS:=NUMBEGINS+1; MARGIN(" B",BEGINNUM); 60109000 + GEN("BEGIN",6,3); 60110000 + DO BEGIN 60111000 + IF CURSY=SEMICOLON OR CURSY=BEGINSY THEN INSYMBOL; 60112000 +STATM: STATEMENT; 60113000 + GEN(";",1,7); 60114000 + IF CURSY=ELSESY THEN BEGIN ERROR(20); INSYMBOL; GO STATM END; 60115000 + IF SYMKIND[CURSY]=INITIAL THEN BEGIN ERROR(21); GO STATM END; 60116000 + END UNTIL CURSY!SEMICOLON; 60117000 + IF CURSY!ENDSY THEN 60118000 + BEGIN ERROR(24); SKIP(ENDSY); 60119000 + IF CURSY!ENDSY THEN BEGIN INSYMBOL; GO TO STATM END; 60120000 + END; 60121000 + GEN(" END",5,4); MARGIN(" E",BEGINNUM); 60122000 + INSYMBOL; 60123000 +END OF COMPSTAT; 60124000 + 60125000 + 60126000 +PROCEDURE IFSTAT; 60127000 +BEGIN 60128000 + LABEL EXIT; 60129000 + GEN("IF",3,6); 60130000 + INSYMBOL; BOOLEXPR; 60131000 + IF CURSY!THENSY THEN 60132000 + BEGIN IF CURTYPE>0 THEN ERROR(27); 60133000 + SKIP(THENSY); 60134000 + IF CURSY!THENSY THEN 60135000 + BEGIN IF CURTYPE=0 THEN ERROR(27); 60136000 + IF SYMKIND[CURSY]=TERMINAL THEN GO TO EXIT; 60137000 + END; END; 60138000 + GEN(" THEN",6,3); 60139000 + INSYMBOL; STATEMENT; 60140000 + IF CURSY=ELSESY THEN 60141000 + BEGIN GEN(" ELSE",6,3); INSYMBOL; STATEMENT END; 60142000 +EXIT: 60143000 +END OF IFSTAT; 60144000 + 60145000 + 60146000 +PROCEDURE CASESTAT; 60147000 +BEGIN 60148000 + DEFINE CASEHASH(N)=(N).[38:39] MOD MAXCASES#; 60149000 + INTEGER ARRAY CASETAB[0:MAXCASES]; 60150000 + INTEGER CASENUM,CASETYPE,NCASELABS,TEMPVARNUM,CONVAL,CONTYPE,C,T; 60151000 + BOOLEAN ZEROLAB,FIRST; 60152000 + 60153000 + CASENUM:=NUMCASES:=NUMCASES+1; MARGIN("CB",CASENUM); 60154000 + TEMPVARNUM:=NUMTEMPS:=NUMTEMPS+1; 60155000 + IF TEMPVARNUM>MAXTEMPS THEN ERROR(16); 60156000 + GEN("BEGIN",6,3); GENID("T",TEMPVARNUM,2); GEN(":=",2,6); 60157000 + INSYMBOL; EXPRESSION; 60158000 + GEN(";",1,7); CASETYPE:=CURTYPE; 60159000 + IF TYPETAB1[CASETYPE].FORM}FLOATING THEN 60160000 + BEGIN ERROR(17); CASETYPE:=0 END; 60161000 + IF CURSY!OFSY THEN 60162000 + BEGIN IF CASETYPE>0 THEN ERROR(18); 60163000 + SKIP(OFSY); 60164000 + IF CURSY=OFSY THEN INSYMBOL ELSE 60165000 + IF CASETYPE=0 THEN ERROR(18); 60166000 + END ELSE INSYMBOL; 60167000 + DO BEGIN 60168000 + WHILE CURSY=SEMICOLON DO INSYMBOL; 60169000 + FIRST:=TRUE; 60170000 + IF CURSY!ENDSY THEN 60171000 + BEGIN 60172000 + GEN("IF",3,6); 60173000 + DO BEGIN 60174000 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 60175000 + CONSTANT(CONVAL,CONTYPE); 60176000 + IF CONTYPE>0 THEN 60177000 + BEGIN 60178000 + IF CASETYPE=0 THEN CASETYPE:=CONTYPE ELSE 60179000 + CHECKTYPES(CASETYPE,CONTYPE); 60180000 + GENID("T",TEMPVARNUM,2); GEN("=",1,7); GENINT(CONVAL); 60181000 + NCASELABS:=NCASELABS+1; 60182000 + IF NCASELABS0 THEN ERROR(19); 60219000 + SKIP(DOSY); 60220000 + IF CURSY!DOSY THEN 60221000 + BEGIN IF CURTYPE=0 THEN ERROR(19); 60222000 + GO TO IF SYMKIND[CURSY]=INITIAL THEN STATM ELSE EXIT; 60223000 + END; END; 60224000 + GEN(" DO",4,5); 60225000 + INSYMBOL; 60226000 +STATM: STATEMENT; 60227000 +EXIT: 60228000 +END OF WHILESTAT; 60229000 + 60230000 + 60231000 +PROCEDURE REPEATSTAT; 60232000 +BEGIN 60233000 + INTEGER REPNUM; 60234000 + LABEL NEWTRY; 60235000 + 60236000 + REPNUM:=NUMREPS:=NUMREPS+1; 60237000 + MARGIN(" R",REPNUM); 60238000 + GEN("DO",3,6); GEN("BEGIN",6,3); 60239000 + DO BEGIN 60240000 + INSYMBOL; 60241000 +NEWTRY: STATEMENT; 60242000 + GEN(";",1,7); 60243000 + IF CURSY=ELSESY THEN BEGIN ERROR(20);INSYMBOL; GO NEWTRY END; 60244000 + IF SYMKIND[CURSY]=INITIAL THEN BEGIN ERROR(21); GO NEWTRY END; 60245000 + END UNTIL CURSY!SEMICOLON; 60246000 + IF CURSY!UNTILSY THEN 60247000 + BEGIN 60248000 + ERROR(22); 60249000 + WHILE CURSY!UNTILSY AND SYMKIND[CURSY]!INITIAL DO 60250000 + BEGIN INSYMBOL; SKIP(UNTILSY) END; 60251000 + IF CURSY!UNTILSY THEN GO TO NEWTRY; 60252000 + END; 60253000 + GEN(" END",5,4); GEN("UNTIL",6,3); MARGIN(" U",REPNUM); 60254000 + INSYMBOL; BOOLEXPR; 60255000 +END OF REPEATSTAT; 60256000 + 60257000 + 60258000 +PROCEDURE FORSTAT; 60259000 +BEGIN 60260000 + INTEGER VARTYPE,VARNUM,LLIM,ULIM; 60261000 + BOOLEAN DOWN; 60262000 + LABEL STATM; 60263000 + 60264000 + GEN("BEGIN",6,3); 60265000 + INSYMBOL; 60266000 + IF CURSY=IDENTIFIER THEN 60267000 + BEGIN 60268000 + SEARCH; 60269000 + IF FOUND THEN 60270000 + BEGIN 60271000 + VARNUM:=1000|THISLEVEL+THISINDEX; 60272000 + IF THISID.IDCLASS=VAR OR 60273000 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 60274000 + BEGIN 60275000 + IF THISLEVEL>1 AND THISLEVELCURLEVEL THEN ERROR(83); 60277000 + VARTYPE:=THISID.TYPE; 60278000 + IF TYPETAB1[VARTYPE].FORM{CHAR THEN 60279000 + BEGIN 60280000 + LLIM:=TYPETAB2[VARTYPE]; ULIM:=TYPETAB3[VARTYPE]; 60281000 + END ELSE BEGIN ERROR(12); VARTYPE:=0 END; 60282000 + END ELSE ERROR(8); 60283000 + END ELSE ERROR(1); 60284000 + END ELSE ERROR(9); 60285000 + INSYMBOL; 60286000 + IF CURSY!ASSIGNSY THEN 60287000 + BEGIN ERROR(28); 60288000 + SKIP(ASSIGNSY); 60289000 + IF CURSY=ASSIGNSY THEN INSYMBOL ELSE 60290000 + IF SYMKIND[CURSY]=INITIAL THEN GO TO STATM; 60291000 + END ELSE INSYMBOL; 60292000 + GENID("V",VARNUM,5); GEN("~",1,7); 60293000 + IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 60294000 + WRITEEXPR; 60295000 + GEN(";",1,7); 60296000 + IF VARTYPE=0 THEN VARTYPE:=CURTYPE ELSE CHECKTYPES(VARTYPE,CURTYPE);60297000 + NUMTEMPS:=NUMTEMPS+1; IF NUMTEMPS>MAXTEMPS THEN ERROR(16); 60298000 + IF CURSY=TOSY THEN INSYMBOL ELSE 60299000 + IF CURSY=DOWNTOSY THEN BEGIN DOWN:=TRUE; INSYMBOL END ELSE 60300000 + BEGIN IF CURTYPE>0 THEN ERROR(23); 60301000 + SKIP(TOSY); 60302000 + IF CURSY=TOSY THEN INSYMBOL ELSE 60303000 + BEGIN IF CURTYPE=0 THEN ERROR(23); 60304000 + IF SYMKIND[CURSY]=INITIAL THEN GO TO STATM; 60305000 + END; END; 60306000 + GENID("T",NUMTEMPS,2); GEN("~",1,7); 60307000 + IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 60308000 + WRITEEXPR; 60309000 + GEN(";",1,7); 60310000 + IF VARTYPE=0 THEN VARTYPE:=CURTYPE ELSE CHECKTYPES(VARTYPE,CURTYPE);60311000 + IF CURSY!DOSY THEN 60312000 + BEGIN IF CURTYPE>0 THEN ERROR(19); 60313000 + SKIP(DOSY); 60314000 + IF CURSY=DOSY THEN INSYMBOL ELSE 60315000 + IF CURTYPE=0 THEN ERROR(19); 60316000 + END ELSE INSYMBOL; 60317000 + GEN("FOR",4,5); GENID("V",VARNUM,5); GEN("~",1,7); 60318000 + GENID("V",VARNUM,5); GEN(" ",1,7); 60319000 + IF DOWN THEN GEN("DOWNTO",7,2) ELSE GEN("UPTO",5,4); 60320000 + GENID("T",NUMTEMPS,2); GEN(" DO",4,5); 60321000 +STATM: STATEMENT; 60322000 + GEN(" END",5,4); 60323000 + NUMTEMPS:=NUMTEMPS-1; 60324000 +END OF FORSTAT; 60325000 + 60326000 + 60327000 +PROCEDURE GOTOSTAT; 60328000 +BEGIN 60329000 + INTEGER I; 60330000 + INSYMBOL; 60331000 + IF CURSY=INTCONST THEN 60332000 + BEGIN I:=NUMLABS; 60333000 + WHILE I}1 AND LABTAB[I].LABVAL!CURVAL DO I:=I-1; 60334000 + IF I=0 THEN ERROR(15); 60335000 + GEN("GO",3,6); GENID("L",CURVAL,4); 60336000 + INSYMBOL; 60337000 + END ELSE ERROR(10); 60338000 +END OF GOTOSTAT; 60339000 + 60340000 + 60341000 +PROCEDURE WITHSTAT; 60342000 +BEGIN 60343000 + INTEGER STARTLEVEL,VERYFIRSTWITHSYM,I; 60344000 + REAL D; 60345000 + STARTLEVEL:=TOPLEVEL; VERYFIRSTWITHSYM:=NWITHSYMS; 60346000 + EXPRLEVEL := 1; %002-60346500 + DO BEGIN 60347000 + INSYMBOL; 60348000 + IF CURSY=IDENTIFIER THEN 60349000 + BEGIN 60350000 + SEARCH; 60351000 + IF FOUND THEN 60352000 + BEGIN 60353000 + IF THISID.IDCLASS=VAR OR %002-60354000 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN %%002-60354500 + BEGIN 60355000 + VARIABLE; 60356000 + IF CURTYPE>0 THEN 60357000 + IF TYPETAB1[CURTYPE].FORM!RECORD THEN ERROR(98); 60358000 + IF SIMPLEVARIABLE THEN 60359000 + BEGIN PUTSYM("["); INSIDEBRACKETS:=TRUE END; 60360000 + IF TOPLEVELMAXWITHSYMS THEN ERROR(63) ELSE 60369000 + FOR I:=1 STEP 1 UNTIL NUMSYMS DO 60370000 + BEGIN 60371000 + WITHTAB[NWITHSYMS]:=SYMTAB[I]; 60372000 + NWITHSYMS:=NWITHSYMS+1; 60373000 + END; 60374000 + D.LASTWITHSYM:=NWITHSYMS-1; 60375000 + DISPLAY[TOPLEVEL]:=D; 60376000 + END ELSE ERROR(84); 60377000 + END ELSE BEGIN ERROR(8); INSYMBOL END; 60378000 + END ELSE BEGIN ERROR(1); INSYMBOL END; 60379000 + END ELSE BEGIN ERROR(9); INSYMBOL END; 60380000 + NUMSYMS:=0; 60381000 + NUMPOINTERS := 0; 60382000 + END UNTIL CURSY!COMMA; 60383000 + EXPRLEVEL := 0; %002-60383500 + IF CURSY!DOSY THEN 60384000 + BEGIN ERROR(19); SKIP(DOSY); 60385000 + IF CURSY=DOSY THEN INSYMBOL; 60386000 + END ELSE INSYMBOL; 60387000 + STATEMENT; 60388000 + TOPLEVEL:=STARTLEVEL; NWITHSYMS:=VERYFIRSTWITHSYM; 60389000 +END OF WITHSTAT; 60390000 + 60391000 +PROCEDURE ASSERTSTAT; %002-60391100 +BEGIN %002-60391200 + GEN("IF NOT(",7,1); %002-60391400 + INSYMBOL; BOOLEXPR; %002-60391500 + GEN(") THEN",7,2); GEN("RUNERR(",7,1); GEN("7,",2,6); %002-60391600 + GENINT(CARDCNT); GEN(")",1,7); %002-60391700 +END OF ASSERTSTAT; %002-60391800 + 60392000 +PROCEDURE STATEMENT; 60393000 +BEGIN 60394000 + INTEGER I; 60395000 + 60397000 + IF CURSY=INTCONST THEN % *** LABELED STATEMENT *** 60398000 + BEGIN LABEL LABFOUND; %700-60399000 + FOR I:=FIRSTLAB STEP 1 UNTIL NUMLABS DO 60400000 + IF LABTAB[I].LABVAL=CURVAL THEN 60401000 + BEGIN IF LABTAB[I].LABDEF=1 THEN ERROR(31); 60402000 + LABTAB[I].LABDEF:=1; 60403000 + GO TO LABFOUND; 60404000 + END; 60405000 + ERROR(15); 60406000 +LABFOUND: GENID("L",CURVAL,4); GEN(":",1,7); 60407000 + INSYMBOL; 60408000 + IF CURSY!COLON THEN 60409000 + BEGIN ERROR(26); 60410000 + SKIP(COLON); IF CURSY=COLON THEN INSYMBOL; 60411000 + END ELSE INSYMBOL; 60412000 + END; 60413000 + 60414000 + COMMENT *** START OF STATEMENT *** ; 60415000 + 60416000 + IF CURSY=IDENTIFIER THEN 60417000 + BEGIN 60418000 + SEARCH; 60419000 + IF FOUND THEN 60420000 + BEGIN 60421000 + IF THISID.IDCLASS=VAR OR 60422000 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) OR %700-60423000 + THISID.IDCLASS=FUNC %700-60423200 + THEN ASSIGNMENT ELSE %700-60424000 + IF THISID.IDCLASS=PROC THEN 60425000 + BEGIN 60426000 + IF THISLEVEL=0 THEN % *** INTRINSIC PROCEDURE *** 60427000 + BEGIN 60428000 + IF CURNAME1="50WRITE" THEN PWRITE(FALSE) ELSE 60429000 + IF CURNAME1="7WRITEL" AND 60430000 + CURNAME2="000000N" THEN PWRITE(TRUE) ELSE 60431000 + IF CURNAME1="400READ" THEN PREAD(FALSE) ELSE 60432000 + IF CURNAME1="6READLN" THEN PREAD(TRUE) ELSE 60433000 + IF CURNAME1="400PAGE" THEN FILEHANDLING(5) ELSE 60434000 + IF CURNAME1="3000GET" THEN FILEHANDLING(2) ELSE 60435000 + IF CURNAME1="3000PUT" THEN FILEHANDLING(1) ELSE 60436000 + IF CURNAME1="50RESET" THEN FILEHANDLING(3) ELSE 60437000 + IF CURNAME1="7REWRIT" AND 60438000 + CURNAME2="000000E" THEN FILEHANDLING(4) ELSE 60439000 + IF CURNAME1="3000NEW" THEN NEWDISP ELSE 60440000 + IF CURNAME1="7DISPOS" AND 60441000 + CURNAME2="000000E" THEN NEWDISP ELSE 60442000 + IF CURNAME1="400PACK" THEN PACK ELSE 60443000 + IF CURNAME1="6QQJZXL" THEN FILEHANDLING(6) ELSE %002-60443500 + IF CURNAME1="6UNPACK" THEN UNPACK ELSE ERROR(0); 60444000 + END ELSE PASSPARAMS; 60445000 + WRITEEXPR; 60446000 + END ELSE BEGIN ERROR(13); SKIP(99) END; 60447000 + END ELSE BEGIN ERROR(1); ASSIGNMENT END; 60448000 + END OF IDENTIFIER ELSE 60449000 + IF CURSY=BEGINSY THEN COMPSTAT ELSE 60450000 + IF CURSY=IFSY THEN IFSTAT ELSE 60451000 + IF CURSY=CASESY THEN CASESTAT ELSE 60452000 + IF CURSY=WHILESY THEN WHILESTAT ELSE 60453000 + IF CURSY=REPEATSY THEN REPEATSTAT ELSE 60454000 + IF CURSY=FORSY THEN FORSTAT ELSE 60455000 + IF CURSY=WITHSY THEN WITHSTAT ELSE 60456000 + IF CURSY=GOTOSY THEN GOTOSTAT ELSE 60457000 + IF CURSY=ASSERTSY THEN ASSERTSTAT ELSE %002-60457500 + IF SYMKIND[CURSY]!TERMINAL THEN 60458000 + BEGIN ERROR(13); INSYMBOL; SKIP(SEMICOLON) END; 60459000 +END OF STATEMENT; 60460000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70001000 +% %70002000 +% %70003000 +% %70004000 +% PART 7: TYPE DECLARATIONS. %70005000 +% ------------------ %70006000 +% %70007000 +% %70008000 +% %70009000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70010000 + 70011000 + 70012000 +PROCEDURE FIELDLIST(RECTAB,FIRSTADDR,LASTADDR); 70017000 + VALUE RECTAB,FIRSTADDR; %700-70018000 + INTEGER RECTAB,FIRSTADDR,LASTADDR; %700-70019000 +FORWARD; 70020000 + 70021000 + %700-70035000 +PROCEDURE TYPEDECL( TTYPE, TSIZE ); %***** TYPE DECLARATION ***** 70036000 + INTEGER TTYPE, TSIZE; %**************************** 70037000 +BEGIN %700-70038000 + INTEGER RECINX, ARRSTRUCT, TX, SX, T, N; REAL T1, T2, T3; %700-70039000 + BOOLEAN FIRST, PACKED; %700-70040000 + %700-70041000 + PROCEDURE TYPERR(ERRNUM,TTYPE,TSIZE); 70043000 + VALUE ERRNUM; 70044000 + INTEGER ERRNUM,TTYPE,TSIZE; 70045000 + BEGIN ERROR(ERRNUM); 70046000 + TTYPE:=TSIZE:=0; 70047000 + END TYPERR; %700-70048000 + 70049000 + PROCEDURE SUBRANGE; %*** SUBRANGE DECLARATION *** 70050000 + BEGIN %**************************** 70051000 + REAL VALX1, VALX2, T1; %700-70052000 + INTEGER TYPEX1, TYPEX2; %700-70053000 + %700-70054000 + CONSTANT(VALX1,TYPEX1); %700-70055000 + IF TYPETAB1[TYPEX1].FORM>CHAR THEN ERROR(11); %700-70056000 + IF CURSY!DOUBLEDOT THEN ERROR(53); %700-70057000 + INSYMBOL; %700-70058000 + CONSTANT(VALX2,TYPEX2); %700-70059000 + IF TYPEX1>0 AND TYPEX2>0 THEN %700-70060000 + IF TYPEX1!TYPEX2 THEN ERROR(11) ELSE %700-70061000 + IF VALX1>VALX2 THEN ERROR(54); %700-70062000 + IF (T1:=TYPETAB1[TYPEX1].FORM) = SYMBOLIC THEN T1:=SUBTYPE; %700-70063000 + NEWTYPE; TTYPE:=TYPEINDEX; %700-70064000 + T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; T1.MAINTYPE:=TYPEX1; %700-70065000 + TYPETAB1[TYPEINDEX]:=T1; %700-70066000 + TYPETAB2[TYPEINDEX]:=VALX1; TYPETAB3[TYPEINDEX]:=VALX2; %700-70067000 + END OF SUBRANGE; %700-70068000 + %700-70069000 + PACKED:=FALSE; 70080000 + IF CURSY=IDENTIFIER THEN %*** SIMPLE TYPE DECLARATION ***70081000 + BEGIN %*******************************70082000 + SEARCH; 70083000 + IF FOUND THEN 70084000 + BEGIN 70085000 + IF THISID.IDCLASS=TYPES THEN 70086000 + BEGIN 70087000 + TTYPE:=THISID.TYPE; TSIZE:=TYPETAB1[TTYPE].SIZE; 70088000 + INSYMBOL; 70089000 + END ELSE IF THISID.IDCLASS=CONST THEN SUBRANGE 70090000 + ELSE TYPERR(7,TTYPE,TSIZE); 70091000 + END ELSE BEGIN TYPERR(1,TTYPE,TSIZE); INSYMBOL END; 70092000 + END ELSE 70093000 + IF CURSY{CHARCONST OR CURSY=PLUS OR CURSY=MINUS THEN SUBRANGE ELSE 70094000 + IF CURSY=LPAR THEN 70095000 + BEGIN 70096000 + N:=0; 70097000 + NEWTYPE; T3.IDCLASS:=CONST; T3.TYPE:=TYPEINDEX; 70098000 + DO BEGIN 70099000 + INSYMBOL; 70100000 + IF CURSY=IDENTIFIER THEN 70101000 + BEGIN 70102000 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); 70103000 + T3.INFO:=N; NAMETAB3[CURLEVEL,THISINDEX]:=T3; 70104000 + N:=N+1; INSYMBOL; 70105000 + END ELSE ERROR(9); 70106000 + END UNTIL CURSY!COMMA; 70107000 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 70108000 + T1:=SYMBOLIC; T1.STRUCT:=0; 70109000 + T1.SIZE:=TSIZE:=1; TTYPE:=TYPEINDEX; 70110000 + TYPETAB1[TYPEINDEX]:=T1; 70111000 + TYPETAB2[TYPEINDEX]:=0; TYPETAB3[TYPEINDEX]:=N-1; 70112000 + IF CURSY=RPAR THEN INSYMBOL; 70113000 + END ELSE 70114000 + 70115000 + IF CURSY=ARROW THEN %*** POINTER DECLARATION *** 70116000 + BEGIN %*************************** 70117000 + DEFINE DEC = POINTER #; %700-70117100 + INSYMBOL; 70118000 + IF CURSY=IDENTIFIER THEN 70119000 + BEGIN 70120000 + NEWTYPE; TTYPE:=TYPEINDEX; T1:=POINTERS; 70121000 + T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; 70122000 + TYPETAB1[TYPEINDEX]:=T1; 70123000 + SEARCH; 70124000 + IF FOUND THEN 70125000 + BEGIN 70126000 + IF THISID.IDCLASS=TYPES THEN 70127000 + TYPETAB1[TYPEINDEX].POINTTYPE:=THISID.TYPE ELSE 70128000 + TYPERR(7,TTYPE,TSIZE); 70129000 + END ELSE 70130000 + BEGIN 70131000 + IF NUMPNTRS0 THEN 70150000 + BEGIN 70151000 + IF TYPETAB1[TX].FORM>CHAR THEN ERROR(48); 70152000 + T1:=ARRAYS; T1.INXTYPE:=TX; T1.ARRTYPE:=T; 70153000 + T2:=TYPETAB2[TX]; T3:=TYPETAB3[TX]; 70154000 + IF T3-T2>1022 THEN ERROR(61); 70155000 + T1.SIZE:=MIN(1023,T3-T2+1); 70156000 + NEWTYPE; 70157000 + TYPETAB1[TYPEINDEX]:=T1; 70158000 + TYPETAB2[TYPEINDEX]:=T2; TYPETAB3[TYPEINDEX]:=T3; 70159000 + T:=TYPEINDEX; 70160000 + END; 70161000 + END UNTIL CURSY!COMMA; 70162000 + IF CURSY!RBRACKET THEN ERROR(59) ELSE INSYMBOL; 70163000 + IF CURSY!OFSY THEN BEGIN ERROR(18); SKIP(OFSY) END; 70164000 + INSYMBOL; 70165000 + TYPEDECL(TX,SX); 70166000 + IF TYPETAB1[TX].FORM}FILES THEN ERROR(60); 70167000 + ARRSTRUCT:=TYPETAB1[TX].STRUCT; 70168000 + WHILE T>0 DO 70169000 + BEGIN 70170000 + T1:=TYPETAB1[T]; T3:=T1.ARRTYPE; 70171000 + T1.ARRTYPE:=TX; T1.STRUCT:=ARRSTRUCT:=ARRSTRUCT+1; 70172000 + T1.SIZE:=SX:=MIN(1024,SX|T1.SIZE); 70173000 + TYPETAB1[T]:=T1; TX:=T; T:=T3; 70174000 + END; 70175000 + TTYPE:=TX; TSIZE:=SX; 70176000 + END OF ARRAY DECLARATION ELSE 70177000 + 70178000 + IF CURSY=FILESY THEN %*** FILE DECLARATION *** 70179000 + BEGIN %************************ 70180000 + DEFINE DEC = FILE #; %700-70180100 + INSYMBOL; 70181000 + IF CURSY!OFSY THEN 70182000 + BEGIN ERROR(18); 70183000 + IF CURSY!IDENTIFIER THEN INSYMBOL; 70184000 + END ELSE INSYMBOL; 70185000 + TYPEDECL(TX,SX); 70186000 + IF TX>0 THEN 70187000 + BEGIN T:=TYPETAB1[TX]; 70188000 + IF T.FORM}FILES THEN ERROR(50) ELSE 70189000 + IF T.STRUCT>1 THEN ERROR(49) 70190000 + END; 70191000 + NEWTYPE; TTYPE:=TYPEINDEX; 70192000 + T1:=IF T.FORM=CHAR THEN TEXTFILE ELSE FILES; 70193000 + T1.SIZE:=TSIZE:=SX; T1.FILETYPE:=TX; 70194000 + T1.STRUCT:=1; 70195000 + TYPETAB1[TYPEINDEX]:=T1; 70196000 + END OF FILE DECLARATION ELSE 70197000 + 70198000 + IF CURSY=SETSY THEN %*** SET DECLARATION *** 70199000 + BEGIN %*********************** 70200000 + DEFINE DEC = SET #; %700-70200100 + INSYMBOL; 70201000 + IF CURSY!OFSY THEN 70202000 + BEGIN ERROR(18); 70203000 + IF CURSY>CHARCONST THEN INSYMBOL; 70204000 + END ELSE INSYMBOL; 70205000 + TYPEDECL(TX,SX); 70206000 + IF TX>0 THEN 70207000 + BEGIN 70208000 + IF TYPETAB1[TX].FORM>CHAR THEN ERROR(48) ELSE 70209000 + IF TYPETAB2[TX] LSS 0 OR TYPETAB3[TX] GTR 93 THEN ERROR(51); 70210000 + END; 70211000 + NEWTYPE; TTYPE:=TYPEINDEX; 70212000 + T1:=SET; T1.SETTYPE:=TX; T1.STRUCT:=0; 70213000 + T1.SIZE := TSIZE := 2; TYPETAB1[TYPEINDEX] := T1; % %601-70214000 + TYPETAB2[TYPEINDEX]:=TYPETAB2[TX]; 70215000 + TYPETAB3[TYPEINDEX]:=TYPETAB3[TX]; 70216000 + END OF SET DECLARATION ELSE 70217000 + 70218000 + IF CURSY=RECORDSY THEN %*** RECORD DECLARATION *** 70219000 + BEGIN %************************** 70220000 + DEFINE DEC = RECORD #; %700-70220100 + IF LASTREC-1>CURLEVEL THEN LASTREC:=LASTREC-1 ELSE ERROR(55); 70221000 + RECINX:=LASTREC; 70222000 + BLOCKTAB[RECINX]:=NUMBLOCKS:=NUMBLOCKS+1; 70223000 + INSYMBOL; 70224000 + FIELDLIST(RECINX,0,SX); 70225000 + IF SX>1022 THEN BEGIN ERROR(56); SX:=1022 END; 70226000 + NEWTYPE; TTYPE:=TYPEINDEX; 70227000 + T1:=RECORD; T1.RECTAB:=RECINX; T1.STRUCT:=1; 70228000 + T1.SIZE:=TSIZE:=SX; TYPETAB1[TYPEINDEX]:=T1; 70229000 + TYPETAB2[TYPEINDEX]:=0; TYPETAB3[TYPEINDEX]:=SX-1; 70230000 + IF CURSY!ENDSY THEN BEGIN ERROR(24); SKIP(ENDSY) END; 70231000 + IF CURSY=ENDSY THEN INSYMBOL; 70232000 + END ELSE BEGIN ERROR(4); SKIP(99) END; 70233000 + END; 70234000 +END OF TYPEDECL; 70235000 + 70236000 + 70237000 +PROCEDURE FIELDLIST(RECTAB,FIRSTADDR,LASTADDR); 70238000 +VALUE RECTAB,FIRSTADDR; 70239000 +INTEGER RECTAB,FIRSTADDR,LASTADDR; 70240000 +BEGIN 70241000 + INTEGER ARRAY ILIST[0:LISTLENGTH]; 70242000 + INTEGER LISTINX; 70243000 + INTEGER CASETYPE,ADDR,MAXADDR,INDEX,CTYPE,TX,SX, T3,LLIM,ULIM,I; 70244000 + BOOLEAN FIRST; 70245000 + REAL T1, CVAL; %503-70246000 + LABEL CASEPART, EXIT; %700-70247000 + 70248000 + ADDR:=FIRSTADDR; 70249000 + DO BEGIN 70250000 + WHILE CURSY=SEMICOLON DO INSYMBOL; 70251000 + IF CURSY=CASESY THEN GO TO CASEPART; 70252000 + IF CURSY=IDENTIFIER THEN 70253000 + BEGIN 70254000 + LISTINX:=0; FIRST:=TRUE; 70255000 + DO BEGIN 70256000 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 70257000 + IF CURSY=IDENTIFIER THEN 70258000 + BEGIN 70259000 + IF LISTINX}LISTLENGTH THEN BEGIN ERROR(37); LISTINX:=0 END; 70260000 + LISTINX:=LISTINX+1; 70261000 + NEWNAME(CURNAME1,CURNAME2,RECTAB); 70262000 + ILIST[LISTINX]:=THISINDEX; 70263000 + INSYMBOL; 70264000 + END ELSE 70265000 + BEGIN ERROR(9); 70266000 + IF CURSY!COMMA THEN INSYMBOL; 70267000 + END; 70268000 + END UNTIL CURSY!COMMA; 70269000 + IF CURSY!COLON THEN BEGIN ERROR(26); SKIP(COLON) END; 70270000 + INSYMBOL; 70271000 + TYPEDECL(TX,SX); 70272000 + IF TX>0 THEN IF TYPETAB1[TX].FORM}FILES THEN ERROR(57); 70273000 + T3.IDCLASS:=VAR; T3.TYPE:=TX; 70274000 + FOR I:=1 STEP 1 UNTIL LISTINX DO 70275000 + BEGIN 70276000 + T3.INFO:=ADDR; ADDR:=MIN(ADDR+SX,1024); 70277000 + NAMETAB3[RECTAB,ILIST[I]]:=T3; 70278000 + END; 70279000 + END; 70280000 + END UNTIL CURSY!SEMICOLON; 70281000 + LASTADDR:=ADDR; 70282000 + GO TO EXIT; 70283000 + 70284000 +CASEPART: 70285000 + BEGIN DEFINE DEC = VARIANT #; %700-70285100 + LABEL CASETYPEID; %700-70285200 + LISTINX:=0; LASTADDR:=ADDR; INDEX:=-1; 70286000 + INSYMBOL; 70287000 + IF CURSY=IDENTIFIER THEN 70288000 + BEGIN 70289000 + SEARCH; 70290000 + IF FOUND AND THISID.IDCLASS=TYPES THEN GO TO CASETYPEID; 70291000 + NEWNAME(CURNAME1,CURNAME2,RECTAB); INDEX:=THISINDEX; 70292000 + INSYMBOL; 70293000 + IF CURSY!COLON THEN ERROR(26); 70294000 + INSYMBOL; 70295000 + IF CURSY=IDENTIFIER THEN 70296000 + BEGIN 70297000 + SEARCH; 70298000 + IF FOUND THEN 70299000 + BEGIN 70300000 + IF THISID.IDCLASS=TYPES THEN 70301000 + BEGIN 70302000 +CASETYPEID: CASETYPE:=THISID.TYPE; T1:=TYPETAB1[CASETYPE]; 70303000 + LLIM:=TYPETAB2[CASETYPE]; ULIM:=TYPETAB3[CASETYPE]; 70304000 + IF T1.FORM>CHAR THEN ERROR(48); 70305000 + IF INDEX}0 THEN 70306000 + BEGIN 70307000 + T3.IDCLASS:=VAR; T3.TYPE:=CASETYPE; T3.INFO:=ADDR; 70308000 + ADDR:=LASTADDR:=ADDR+1; NAMETAB3[RECTAB,INDEX]:=T3; 70309000 + END; 70310000 + INSYMBOL; 70311000 + END ELSE BEGIN ERROR(7); SKIP(OFSY) END; 70312000 + END ELSE BEGIN ERROR(1); SKIP(OFSY) END; 70313000 + END ELSE BEGIN ERROR(9); SKIP(OFSY) END; 70314000 + END ELSE BEGIN ERROR(9); SKIP(OFSY) END; 70315000 + IF CURSY!OFSY THEN BEGIN ERROR(18); SKIP(RPAR) END; 70316000 + IF CURSY=OFSY THEN INSYMBOL; 70317000 + IF CASETYPE=0 THEN BEGIN LLIM:=-MAXINT; ULIM:=MAXINT END; 70318000 + DO BEGIN 70319000 + WHILE CURSY=SEMICOLON DO INSYMBOL; 70320000 + IF CURSY{CHARCONST OR CURSY=PLUS OR CURSY=MINUS THEN 70321000 + BEGIN 70322000 + FIRST:=TRUE; 70323000 + DO BEGIN 70324000 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 70325000 + CONSTANT(CVAL,CTYPE); 70326000 + IF CTYPE>0 THEN 70327000 + BEGIN 70328000 + IF CASETYPE=0 THEN CASETYPE:=CTYPE ELSE 70329000 + IF CVALULIM THEN ERROR(14) ELSE 70330000 + CHECKTYPES(CASETYPE,CTYPE); 70331000 + IF LISTINX}LISTLENGTH THEN BEGIN ERROR(30); LISTINX:=0 END; 70332000 + LISTINX:=LISTINX+1; 70333000 + ILIST[LISTINX]:=CVAL; I:=1; 70334000 + WHILE ILIST[I]!CVAL DO I:=I+1; 70335000 + IF ILASTADDR THEN LASTADDR:=MAXADDR; 70344000 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 70345000 + INSYMBOL; 70346000 + END ELSE ERROR(58); 70347000 + END; 70348000 + END UNTIL CURSY NEQ SEMICOLON; % 70349000 + END; %700-70349100 +EXIT: 70350000 +END OF FIELDLIST; 70351000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%80001000 +% %80002000 +% %80003000 +% %80004000 +% PART 8: THE PROCEDURE BLOCK. %80005000 +% -------------------- %80006000 +% %80007000 +% %80008000 +% %80009000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%80010000 + 80011000 + 80012000 + 80013000 +PROCEDURE DECLAREVARS(PARAM,TAB,FIRST,LAST,LEVEL); 80014000 +VALUE PARAM,FIRST,LAST,LEVEL; 80015000 +INTEGER ARRAY TAB[0]; 80016000 +INTEGER FIRST,LAST,LEVEL; 80017000 +BOOLEAN PARAM; 80018000 +BEGIN 80019000 + INTEGER LEVEL1000, TYP, NAM, NAMTAB, I, J, RECSIZE; %503-80020000 + BOOLEAN REALVAR,ARRAYVAR,FIRSTDIM,EXTFILE; 80021000 + ALPHA T1, FNAME; %503-80022000 + INTEGER FNLENGTH,FNSTART; % 80023000 + 80024000 + LEVEL1000:=LEVEL|1000; 80025000 + FOR I:=FIRST STEP 1 UNTIL LAST DO 80026000 + BEGIN 80027000 + NAM:=TAB[I].[9:10]; NAMTAB:=NAMETAB3[LEVEL,NAM]; 80028000 + TYP:=NAMTAB.TYPE; T1:=TYPETAB1[TYP]; 80029000 + IF NAMTAB.IDCLASS GEQ FUNC THEN 80030000 + BEGIN 80031000 + IF REALVAR OR ARRAYVAR THEN 80032000 + BEGIN 80033000 + GEN(";",1,7); 80034000 + REALVAR:=ARRAYVAR:=FALSE; 80035000 + END; 80036000 + IF NAMTAB.IDCLASS=FUNC THEN GEN("FUNCTN",7,2) % %600-80037000 + ELSE GEN("PROCEDU",8,1); % %600-80038000 + GENID("V",LEVEL1000+NAM,5); GEN(";",1,7); 80039000 + END ELSE 80040000 + IF T1.STRUCT=0 THEN %*** SIMPLE TYPE *** 80041000 + BEGIN 80042000 + IF ARRAYVAR THEN BEGIN GEN(";",1,7); ARRAYVAR:=FALSE END; 80043000 + IF REALVAR THEN GEN(",",1,7) ELSE 80044000 + BEGIN GEN("REAL",5,4); REALVAR:=TRUE END; 80045000 + GENID("V",LEVEL1000+NAM,5); 80046000 + IF T1.FORM=SET THEN % %601-80046200 + BEGIN % %601-80046400 + GEN(",",1,7); GENID("W",LEVEL1000+NAM,5); % %601-80046600 + END; % %601-80046800 + END ELSE 80047000 + BEGIN 80048000 + IF REALVAR THEN BEGIN GEN(";",1,7); REALVAR:=FALSE END; 80049000 + IF T1.FORM9 THEN 100 ELSE 80064530 + 10)+PASSSUBRANGE+1,IF PASSSUBRANGE>9 THEN 7 ELSE 6); 80064535 + PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE]; 80064540 + END; %518-80064545 + GEN("]#;",3,5); %518-80064550 + END; %518-80064555 + PASSSUBRANGE := FIRSTRANGE; %518-80064560 + FIRSTDIM := TRUE; GEN("ARRAY",6,3); GENID("H",LEVEL1000+NAM,5); 80064565 + GEN("[",1,7); %518-80064570 + WHILE PASSSUBRANGE ! STOPPERSUBTAB DO %518-80064575 + BEGIN %518-80064580 + IF MAXPERMTAB LEQ MAXTOTALSUBSCRS AND PARAM THEN %518-80064585 + BEGIN %518-80064590 + ARRSUBPERMTAB[ARRNAM,MAXPERMTAB] := %518-80064595 + IF FIRSTDIM THEN NAM ELSE -1; %518-80064600 + ARRSUBPERMTAB[PERMSUB,MAXPERMTAB] := PASSSUBRANGE; %518-80064605 + MAXPERMTAB := MAXPERMTAB + 1; %518-80064610 + END %518-80064615 + ELSE %518-80064620 + BEGIN %518-80064625 + IF MAXPERMTAB > MAXTOTALSUBSCRS THEN ERROR(0); %518-80064630 + END; %518-80064640 + IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE GEN(",",1,7); %518-80064645 + GENINT(ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE]); %518-80064650 + IF NOT PARAM THEN %518-80064655 + BEGIN %518-80064660 + GEN(":",1,7); %518-80064665 + GENINT(ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE]); %518-80064670 + END; %518-80064675 + PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE]; %518-80064680 + END; %518-80064685 + IF T1.FORM=SET THEN % %601-80064700 + BEGIN % %601-80064750 + GEN(",0",2,6); % %601-80064800 + IF NOT PARAM THEN GEN(":1",2,6); % %601-80064850 + END; % %601-80064900 + GEN("]",1,7); %518-80064950 + END ELSE 80065000 + BEGIN %*** FILE *** 80066000 + DEFINE DEC = FILE #; %700-80066100 + IF REALVAR OR ARRAYVAR THEN 80067000 + BEGIN GEN(";",1,7); REALVAR:=ARRAYVAR:=FALSE END; 80068000 + IF T1.FORM=TEXTFILE AND NOT PARAM THEN 80069000 + BEGIN 80070000 + IF NUMFILES}MAXFILES THEN ERROR(97) 80071000 + ELSE NUMFILES:=NUMFILES+1; 80072000 + FILETAB[NUMFILES]:=NAM; 80073000 + END; 80074000 + EXTFILE:=FALSE; 80075000 + FNAME:=NAMETAB1[LEVEL,NAM]; 80076000 + FNLENGTH := FNAME.NAMELENGTH; FNSTART := 8-FNLENGTH; % 80077000 + IF FNLENGTH LEQ 6 THEN % 80078000 + BEGIN 80079000 + FOR J:=1 STEP 1 UNTIL NUMEXTFILES DO 80080000 + IF FNAME=EXTFILETAB[J] THEN EXTFILE:=TRUE; 80081000 + END; 80082000 + IF EXTFILE AND NOT PARAM THEN 80083000 + BEGIN 80084000 + IF NUMFILES GEQ MAXFILES THEN ERROR(97) 80085000 + ELSE 80086000 + NUMFILES := NUMFILES + 1; 80087000 + FILETAB[NUMFILES] := -NAM - 1; 80088000 + GEN("DEFINE",7,2); GENID("F",LEVEL1000+NAM,5); 80089000 + GEN("=",1,7); 80090000 + GEN(FNAME,FNLENGTH,FNSTART); % 80091000 + GEN("#;",2,6); GEN("SAVE",5,4); GEN("FILE",5,4); 80092000 + GEN(FNAME,FNLENGTH,FNSTART); % 80093000 + END ELSE 80094000 + BEGIN 80095000 + GEN("FILE",5,4); GENID("F",LEVEL1000+NAM,5); 80096000 + END; 80097000 + IF NOT PARAM THEN 80098000 + BEGIN 80099000 + GEN(" DISK",6,3); GEN("SERIAL",7,2); 80100000 + IF EXTFILE THEN 80101000 + BEGIN 80102000 + IF ALGOLCNT LSS 14 THEN WRITEALGOL; %517-80103000 + GEN("[0:0]",5,3); 80104000 + GEN(""",1,7); 80105000 + GEN(FNAME,FNLENGTH,FNSTART); % 80106000 + GEN(""/",2,6); %700-80107000 + IF ALGOLCNT<9 THEN WRITEALGOL; 80108000 + GEN(""",1,7); GEN(USER,7,1); GEN(""",1,7); 80109000 + END ELSE 80110000 + BEGIN 80111000 + GEN("[20:",4,4); GEN("300]",4,4); 80112000 + END; 80113000 + GEN("(1,",3,5); 80114000 + RECSIZE:=IF T1.FORM=TEXTFILE THEN 10 ELSE 80115000 + IF TYPETAB1[T1.FILETYPE].STRUCT=0 THEN 1 ELSE 80116000 + TYPETAB3[T1.FILETYPE]-TYPETAB2[T1.FILETYPE]+1; 80117000 + GENINT(RECSIZE); GEN(",",1,7); 80118000 + IF RECSIZE=1 OR RECSIZE=10 THEN GENINT(30) %703-80119000 + ELSE GENINT(RECSIZE); 80120000 + IF ALGOLCNT LSS 10 THEN WRITEALGOL; 80121000 + GEN(",SAVE",6,3); %703-80122000 + GEN("30);", 4,4); %703-80123000 + END ELSE GEN(";",1,7); 80124000 + GEN("ARRAY",6,3); GENID("V",LEVEL1000+NAM,5); 80125000 + GEN("[",1,7); 80126000 + IF TYPETAB1[T1.FILETYPE].STRUCT=0 THEN 80127000 + BEGIN 80128000 + IF PARAM THEN GEN("0",1,7) ELSE BEGIN %002-80129000 + GEN("0:",2,6); %002-80129100 + GENINT(RECSIZE-1); %002-80129200 + END %002-80129300 + END ELSE 80130000 + BEGIN 80131000 + GENINT(TYPETAB2[T1.FILETYPE]); 80132000 + IF NOT PARAM THEN 80133000 + BEGIN GEN(":",1,7); GENINT(TYPETAB3[T1.FILETYPE]) END; 80134000 + END; 80135000 + GEN("];",2,6); 80136000 + GEN("INTEGER",8,1); GENID("I",LEVEL1000+NAM,5); 80137000 + GEN(";",1,7); 80138000 + END; 80139000 + END; 80140000 + END OF LOOP; 80141000 + IF REALVAR OR ARRAYVAR THEN GEN(";",1,7); 80142000 +END OF DECLAREVARS; 80143000 + 80144000 + 80145000 +PROCEDURE PARAMETERLIST; 80146000 +BEGIN 80147000 + INTEGER FIRSTPARAM, CURKIND, P1, PX, I, T3; REAL T; %503-80148000 + BOOLEAN FIRST; 80149000 + 80150000 + DEFINE NEWPARAM= 80151000 + BEGIN 80152000 + IF NUMPARAMS}MAXPARAMS THEN 80153000 + BEGIN ERROR(70); NUMPARAMS:=MAXPARAMS-10 END; 80154000 + NUMPARAMS:=NUMPARAMS+1; 80155000 + END OF NEWPARAM#; 80156000 + 80157000 + NEWPARAM; FIRSTPARAM:=NUMPARAMS; 80158000 + IF CURSY=LPAR THEN 80159000 + BEGIN 80160000 + DO BEGIN 80161000 + INSYMBOL; 80162000 + IF CURSY=VARSY OR CURSY=FUNCSY OR CURSY=PROCSY THEN 80163000 + BEGIN 80164000 + CURKIND:=IF CURSY=VARSY THEN VAR ELSE 80165000 + IF CURSY=FUNCSY THEN FUNC ELSE PROC; 80166000 + INSYMBOL; 80167000 + END ELSE CURKIND:=CONST; 80168000 + FIRST:=TRUE; P1:=NUMPARAMS+1; 80169000 + DO BEGIN 80170000 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 80171000 + IF CURSY=IDENTIFIER THEN 80172000 + BEGIN 80173000 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL+1); 80174000 + PX:=THISINDEX; PX.PARAMKIND:=CURKIND; 80175000 + PX.PARAMLEVEL:=CURLEVEL+1; 80176000 + NEWPARAM; PARAMTAB[NUMPARAMS]:=PX; 80177000 + FORWPARAM1[NUMPARAMS] := CURNAME1; %002-80177500 + FORWPARAM2[NUMPARAMS] := CURNAME2; %002-80177600 + END ELSE ERROR(9); 80178000 + INSYMBOL; 80179000 + END UNTIL CURSY!COMMA; 80180000 + IF CURSY=COLON THEN 80181000 + BEGIN 80182000 + IF CURKIND=PROC THEN ERROR(90); 80183000 + INSYMBOL; 80184000 + IF CURSY=IDENTIFIER THEN 80185000 + BEGIN 80186000 + SEARCH; 80187000 + IF FOUND THEN 80188000 + BEGIN 80189000 + IF THISID.IDCLASS=TYPES THEN 80190000 + BEGIN 80191000 + T3:=THISID.TYPE; 80192000 + FOR I:=P1 STEP 1 UNTIL NUMPARAMS DO 80193000 + PARAMTAB[I].PARAMTYPE:=T3; 80194000 + IF CURKIND=CONST OR CURKIND=VAR THEN 80195000 + BEGIN 80196000 + T:=TYPETAB1[T3]; 80197000 + IF T.FORM}FILES THEN 80198000 + FOR I:=P1 STEP 1 UNTIL NUMPARAMS DO 80199000 + PARAMTAB[I].PARAMFILE:=1; 80200000 + IF T.STRUCT>0 AND CURKIND=CONST THEN ERROR(94); 80201000 + END ELSE IF T.STRUCT>0 THEN ERROR(38); 80202000 + END ELSE BEGIN ERROR(7); T3:=0 END; 80203000 + END ELSE BEGIN ERROR(1); T3:=0 END; 80204000 + END ELSE BEGIN ERROR(9); T3:=0 END; 80205000 + INSYMBOL; 80206000 + END ELSE 80207000 + BEGIN 80208000 + IF CURKIND!PROC THEN ERROR(7); 80209000 + T3:=0; 80210000 + END; 80211000 + T3.IDCLASS:=CURKIND; T3.FORMAL:=1; 80212000 + FOR I:=P1 STEP 1 UNTIL NUMPARAMS DO 80213000 + NAMETAB3[CURLEVEL+1,PARAMTAB[I].PARAMNAME]:=T3; 80214000 + END UNTIL CURSY!SEMICOLON; 80215000 + IF CURSY!RPAR THEN 80216000 + BEGIN ERROR(49); SKIP(RPAR); 80217000 + IF CURSY=RPAR THEN INSYMBOL; 80218000 + END ELSE INSYMBOL; 80219000 + END; 80220000 + PARAMTAB[FIRSTPARAM]:=NUMPARAMS-FIRSTPARAM; 80221000 +END OF PARAMETERLIST; 80222000 + 80223000 + 80400000 +PROCEDURE BLOCK; 80401000 +BEGIN 80402000 + INTEGER INDEX, CTYPE, NUMFORWARDS,TX, I; % %800-80403000 + ALPHA T3; %002-80403500 + REAL T, CVAL; %503-80404000 + ALPHA C1,C2; 80405000 + BOOLEAN VALUEPARAMS,FUN; 80406000 + LABEL START; 80407000 + 80408000 + INTEGER LABTABTOP,CONSTTABTOP,TYPETABTOP,PARAMTABTOP,TOPREC, 80409000 + FORMERFIRSTLAB,FIRSTFILE; 80410000 + 80411000 + FORMERFIRSTLAB:=FIRSTLAB; 80412000 + LABTABTOP:=NUMLABS; FIRSTLAB:=LABTABTOP+1; 80413000 + CONSTTABTOP:=NUMCONSTS; 80414000 + TYPETABTOP:=NUMTYPES; 80415000 + PARAMTABTOP:=NUMPARAMS; 80416000 + TOPREC:=LASTREC; 80417000 + FIRSTFILE:=NUMFILES+1; 80418000 + 80419000 + TOPLEVEL:=CURLEVEL; 80420000 + MARGIN("+P",CURLEVEL); % MARK PROCEDURE LEVEL %712-80420100 + IF CURLEVEL > 1 THEN %518-80421010 + BEGIN %518-80421020 + INTEGER NAMOFTHING,DIFF; %518-80421030 + BOOLEAN FIRSTTIME; %518-80421040 + GEN("BEGIN",6,3); %518-80421050 + IF MAXPERMTAB > 0 THEN %518-80421060 + BEGIN %518-80421070 + PASSPERMTAB := 0; %518-80421080 + DO %518-80421090 + BEGIN %518-80421100 + REMEMBERPOSN := PASSPERMTAB; %518-80421110 + GEN("DEFINE",7,2); %518-80421120 + NAMOFTHING := ARRSUBPERMTAB[ARRNAM,PASSPERMTAB]; %518-80421130 + GENID("V",1000|CURLEVEL+NAMOFTHING,5); %518-80421140 + GEN("[",1,7); %518-80421150 + FIRSTTIME := TRUE; %518-80421160 + DO %518-80421170 + BEGIN %518-80421180 + IF FIRSTTIME THEN FIRSTTIME := FALSE ELSE GEN(",",180421190 + ,7);80421200 + DIFF := PASSPERMTAB-REMEMBERPOSN+1; %518-80421210 + GENID("V",(1000+CURLEVEL+NAMOFTHING)|(IF DIFF>9 THEN 100 ELSE 80421220 + 10)+DIFF,(IF DIFF > 9 THEN 7 ELSE 6)); %518-80421230 + PASSPERMTAB := PASSPERMTAB + 1; END %518-80421270 + UNTIL PASSPERMTAB = MAXPERMTAB OR %518-80421280 + ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ! -1; %518-80421290 + GEN("]",1,7); %518-80421300 + GEN("=",1,7); %518-80421310 + GENID("H",1000|CURLEVEL+NAMOFTHING,5); %518-80421320 + GEN("[",1,7); %518-80421340 + PASSPERMTAB := REMEMBERPOSN; FIRSTTIME := TRUE; %518-80421350 + DO %518-80421360 + BEGIN %518-80421370 + IF FIRSTTIME THEN FIRSTTIME := FALSE ELSE GEN(",", 80421380 + 1,7);80421390 + DIFF := ARRSUBPERMTAB[PERMSUB,PASSPERMTAB]+1; %518-80421400 + GENID("V",(1000|CURLEVEL+NAMOFTHING)|(IF DIFF>9 THEN80421410 + 100 ELSE 10)+DIFF,(IF DIFF>9 THEN 7 ELSE 6)); 80421420 + PASSPERMTAB := PASSPERMTAB +1; %518-80421430 + END %518-80421440 + UNTIL PASSPERMTAB = MAXPERMTAB OR %518-80421450 + ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ! -1; %518-80421460 + GEN("]#;",3,5); %518-80421470 + END %518-80421480 + UNTIL PASSPERMTAB = MAXPERMTAB; %518-80421490 + MAXPERMTAB := 0; %518-80421500 + END %518-80421510 + END; %518-80421520 +START: 80422000 + IF CURSY=LABELSY THEN %*** LABEL DECLARATION *** 80423000 + BEGIN %************************* 80424000 + DEFINE DEC = LABEL #; %700-80424100 + GEN("LABEL",6,3); 80425000 + DO BEGIN 80426000 + INSYMBOL; 80427000 + IF CURSY=INTCONST THEN 80428000 + BEGIN 80429000 + GENID("L",CURVAL,4); 80430000 + IF CURVAL>9999 THEN ERROR(33); 80431000 + FOR I:=FIRSTLAB STEP 1 UNTIL NUMLABS DO 80432000 + IF LABTAB[I].LABVAL=CURVAL THEN ERROR(31); 80433000 + IF NUMLABS}MAXLABS THEN BEGIN ERROR(34); NUMLABS:=0 END; 80434000 + NUMLABS:=NUMLABS+1; 80435000 + LABTAB[NUMLABS]:=CURVAL; 80436000 + INSYMBOL; 80437000 + END ELSE BEGIN ERROR(10); SKIP(COMMA) END; 80438000 + IF CURSY=COMMA THEN GEN(",",1,7); 80439000 + END UNTIL CURSY!COMMA; 80440000 + IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80441000 + GEN(";",1,7); 80442000 + IF SYMKIND[CURSY]!INITIAL THEN INSYMBOL; 80443000 + END OF LABEL DECLARATION; 80444000 + 80445000 + IF CURSY=CONSTSY THEN %*** CONSTANT DECLARATION *** 80446000 + BEGIN %**************************** 80447000 + LABEL LL1; % %002-80447010 + DEFINE DEC = CONST #; %700-80447100 + INSYMBOL; 80448000 + DO BEGIN 80449000 + IF CURSY=IDENTIFIER THEN 80450000 + BEGIN 80451000 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80452000 + INSYMBOL; 80453000 + IF CURSY=EQLSY THEN 80454000 + BEGIN 80455000 + INSYMBOL; CONSTANT(CVAL,CTYPE); 80456000 + T3:=CTYPE; T3.IDCLASS:=CONST; 80457000 + IF CVAL.[46:8]!0 OR CVAL>1023 THEN 80458000 + BEGIN 80459000 + IF NUMCONSTS}MAXCONSTS THEN 80460000 + BEGIN ERROR(35); NUMCONSTS:=0 END; 80461000 + NUMCONSTS:=NUMCONSTS+1; 80462000 + CONSTTAB[NUMCONSTS]:=CVAL; 80463000 + T3.INFO:=1023+NUMCONSTS; 80464000 + END ELSE T3.INFO:=CVAL; 80465000 + NAMETAB3[CURLEVEL,INDEX]:=T3; 80466000 + END ELSE BEGIN ERROR(36); SKIP(SEMICOLON) END; 80467000 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80468000 + IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80469000 + IF SYMKIND[CURSY]!INITIAL THEN INSYMBOL; 80470000 + END UNTIL CURSY!IDENTIFIER; 80471000 + END OF CONSTANT DECLARATION; 80472000 + 80473000 + IF CURSY=TYPESY THEN %*** TYPE DECLARATION **** 80474000 + BEGIN %************************* 80475000 + DEFINE DEC = TYPE #; %700-80475100 + INSYMBOL; 80476000 + DO BEGIN 80477000 + IF CURSY=IDENTIFIER THEN 80478000 + BEGIN 80479000 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80480000 + INSYMBOL; 80481000 + IF CURSY=EQLSY THEN 80482000 + BEGIN 80483000 + INSYMBOL; 80484000 + TYPEDECL(CTYPE,TX); 80485000 + T3:=CTYPE; T3.IDCLASS:=TYPES; 80486000 + NAMETAB3[CURLEVEL,INDEX]:=T3; 80487000 + END ELSE BEGIN ERROR(36); SKIP(SEMICOLON) END; 80488000 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80489000 + IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80490000 + IF SYMKIND[CURSY]!INITIAL THEN INSYMBOL; 80491000 + END UNTIL CURSY!IDENTIFIER; 80492000 + END OF TYPE DECLARATION; 80493000 + 80494000 + IF CURSY=VARSY THEN %*** VARIABLE DECLARATION *** 80495000 + BEGIN %**************************** 80496000 + LABEL LL2; % %002-80496010 + DEFINE DEC = VAR #; %700-80496100 + VARINDEX:=0; 80497000 + DO BEGIN 80498000 + FIRSTVAR:=VARINDEX+1; 80499000 + DO BEGIN 80500000 + IF CURSY=VARSY OR CURSY=COMMA THEN INSYMBOL; 80501000 + IF CURSY=IDENTIFIER THEN 80502000 + BEGIN 80503000 + IF VARINDEX}LISTLENGTH THEN 80504000 + BEGIN ERROR(37); VARINDEX:=0 END; 80505000 + VARINDEX:=VARINDEX+1; 80506000 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); 80507000 + VARLIST[VARINDEX]:=THISINDEX; 80508000 + INSYMBOL; 80509000 + END ELSE BEGIN ERROR(9); SKIP(COLON) END; 80510000 + END UNTIL CURSY!COMMA; 80511000 + IF CURSY!COLON THEN BEGIN ERROR(26); SKIP(COLON) END; 80512000 + IF CURSY=COLON THEN 80513000 + BEGIN 80514000 + INSYMBOL; 80515000 + TYPEDECL(CTYPE,TX); 80516000 + T3:=CTYPE; T3.IDCLASS:=VAR; 80517000 + FOR I:=FIRSTVAR STEP 1 UNTIL VARINDEX DO 80518000 + NAMETAB3[CURLEVEL,VARLIST[I]]:=T3; 80519000 + END ELSE BEGIN ERROR(26); SKIP(SEMICOLON) END; 80520000 + IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80521000 + IF SYMKIND[CURSY]!INITIAL THEN INSYMBOL; 80522000 + END UNTIL CURSY!IDENTIFIER; 80523000 + DECLAREVARS(FALSE,VARLIST,1,VARINDEX,CURLEVEL); 80524000 + END OF VARIABLE DECLARATIONS; 80525000 + 80526000 + IF NUMPNTRS>0 THEN 80527000 + BEGIN 80528000 + C1:=CURNAME1; C2:=CURNAME2; 80529000 + FOR I:=1 STEP 1 UNTIL NUMPNTRS DO 80530000 + BEGIN 80531000 + CURNAME1:=PNTRTAB1[I]; CURNAME2:=PNTRTAB2[I]; 80532000 + SEARCHTAB(CURLEVEL); 80533000 + THISID:=NAMETAB3[CURLEVEL,THISINDEX]; 80534000 + IF FOUND AND THISID.IDCLASS=TYPES THEN 80535000 + TYPETAB1[PNTRTAB3[I]].POINTTYPE:=THISID.TYPE ELSE ERROR(62); 80536000 + END; 80537000 + CURNAME1:=C1; CURNAME2:=C2; NUMPNTRS:=0; 80538000 + END; 80539000 + 80540000 + IF CURSY=FUNCSY OR CURSY=PROCSY % %700-80540900 + THEN BEGIN DEFINE DEC = CODE #; %700-80540910 + WHILE CURSY=FUNCSY OR CURSY=PROCSY DO %*** PROC/FUNC DECLARATION ***80541000 + BEGIN %*****************************80542000 + LABEL LL3; % %002-80542010 + FUN:=CURSY=FUNCSY; INSYMBOL; 80543000 + IF CURLEVEL GEQ MAXTABLES THEN ERROR(101) ELSE %002-80543500 + BLOCKTAB[CURLEVEL+1] := NUMBLOCKS := NUMBLOCKS + 1; %002-80543600 + IF CURSY=IDENTIFIER THEN 80544000 + BEGIN 80545000 + SEARCHTAB(CURLEVEL); 80546000 + THISID:=NAMETAB3[CURLEVEL,THISINDEX]; 80547000 + IF FOUND AND (THISID.IDCLASS=PROC OR THISID.IDCLASS=FUNC) THEN %600-80548000 + BEGIN 80549000 + INDEX:=THISINDEX; 80550000 + IF THISID.FORWARDDEF=1 THEN 80551000 + BEGIN 80552000 + NAMETAB3[CURLEVEL,THISINDEX].FORWARDDEF:=0; %504-80553000 + NUMFORWARDS:=NUMFORWARDS-1; 80554000 + T := NAMETAB3[CURLEVEL,THISINDEX].INFO; %002-80554500 + TX := T + PARAMTAB[T]; %002-80554600 + FOR I:=T+1 STEP 1 UNTIL TX DO %002-80554700 + NEWNAME(FORWPARAM1[I],FORWPARAM2[I],CURLEVEL+1); %002-80554800 + IF(THISID.IDCLASS=PROC AND FUN)OR 80555000 + (THISID.IDCLASS=FUNC AND NOT FUN) THEN ERROR(43); %504-80555100 + TX:=(T:=THISID.INFO)+PARAMTAB[T]; % UNMARK FORWARD PARMS 80556000 + FOR I:=T+1 STEP 1 UNTIL TX DO % TO ALLOW REFERENCE 80557000 + BEGIN T3:=PARAMTAB[I].PARAMNAME; %504-80558000 + CURNAME1:=ABS(NAMETAB1[CURLEVEL+1,T3]); %504-80559000 + CURNAME2:= NAMETAB2[CURLEVEL+1,T3]; %504-80560000 + NAMETAB1[CURLEVEL+1,T3]:=0; %504-80561000 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL+1); %504-80562000 + IF T3!THISINDEX THEN BEGIN %504-80563000 + PARAMTAB[I].PARAMNAME:=THISINDEX; %504-80564000 + NAMETAB3[CURLEVEL+1,THISINDEX] := %504-80565000 + NAMETAB3[CURLEVEL+1,T3]; %504-80565010 + END END; % OF UNMARKING FORWARD PARAMETERS. %504-80566000 + INSYMBOL; 80567000 + END ELSE BEGIN ERROR(2); SKIP(SEMICOLON) END; 80568000 + END ELSE 80569000 + BEGIN 80570000 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80571000 + T3:=0; T3.INFO:=NUMPARAMS+1; 80572000 + T3.IDCLASS:=IF FUN THEN FUNC ELSE PROC; 80573000 + NAMETAB3[CURLEVEL,INDEX]:=T3; 80574000 + INSYMBOL; PARAMETERLIST; 80575000 + IF CURSY=COLON THEN 80576000 + BEGIN 80577000 + IF NOT FUN THEN ERROR(48); 80578000 + INSYMBOL; 80579000 + IF CURSY=IDENTIFIER THEN 80580000 + BEGIN 80581000 + SEARCH; 80582000 + IF FOUND THEN 80583000 + BEGIN 80584000 + IF THISID.IDCLASS=TYPES THEN 80585000 + BEGIN 80586000 + T:=TYPETAB1[THISID.TYPE]; 80587000 + IF T.FORM{ALFA OR T.FORM=POINTERS THEN 80588000 + BEGIN 80589000 + NAMETAB3[CURLEVEL,INDEX].TYPE:=THISID.TYPE; 80590000 + END ELSE ERROR(38); 80591000 + END ELSE ERROR(7); 80592000 + END ELSE ERROR(1); 80593000 + END ELSE ERROR(9); 80594000 + INSYMBOL; 80595000 + END ELSE IF FUN THEN 80596000 + BEGIN ERROR(26); SKIP(SEMICOLON) END; 80597000 + END; 80598000 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80599000 + IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80600000 + IF FUN THEN GEN("FUNCTN",7,2) ELSE 80601000 + GEN("PROCEDU",8,1); GENID("V",1000|CURLEVEL+INDEX,5); 80602000 + T:=NAMETAB3[CURLEVEL,INDEX].INFO; TX:=T+PARAMTAB[T]; 80603000 + IF TX>T THEN 80604000 + BEGIN 80605000 + GEN("(",1,7); 80606000 + FOR I:=T+1 STEP 1 UNTIL TX DO 80607000 + BEGIN %518-80608010 + BEGIN %518-80608020 + INTEGER NAM,T1,SCRATCH; %518-80608030 + NAM := PARAMTAB[I].[9:10]; %518-80608040 + SCRATCH := NAMETAB3[CURLEVEL+1,NAM]; %518-80608050 + SCRATCH := SCRATCH.TYPE; %518-80608060 + T1 := TYPETAB1[SCRATCH]; %518-80608070 + IF T1.STRUCT ! 0 AND T1.FORM < FILES THEN %518-80608080 + GENID("H",1000|(CURLEVEL+1)+NAM,5) %518-80608090 + ELSE %518-80608100 + BEGIN % %601-80608105 + GENID("V",1000|(CURLEVEL+1)+NAM,5); %518-80608110 + IF T1.FORM=SET THEN % %601-80608111 + BEGIN % %601-80608113 + GEN(",",1,7); % %601-80608115 + GENID("W",1000|(CURLEVEL+1)+NAM,5); % %601-80608117 + END; %601-80608118 + END; % %601-80608119 + END; %518-80608120 + IF BOOLEAN(PARAMTAB[I].PARAMFILE) THEN 80609000 + BEGIN 80610000 + GEN(",",1,7); 80611000 + GENID("F",1000|(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80612000 + GEN(",",1,7); 80613000 + GENID("I",1000|(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80614000 + END; 80615000 + IF I LSS TX THEN GEN(",",1,7); 80616000 + END; 80617000 + GEN(");",2,6); 80618000 + VALUEPARAMS:=FALSE; 80619000 + FOR I:=T+1 STEP 1 UNTIL TX DO 80620000 + IF PARAMTAB[I].PARAMKIND=CONST THEN 80621000 + BEGIN 80622000 + IF NOT VALUEPARAMS THEN 80623000 + BEGIN GEN("VALUE",6,3); 80624000 + VALUEPARAMS:=TRUE; 80625000 + END ELSE GEN(",",1,7); 80626000 + GENID("V",1000|(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80627000 + IF TYPETAB1[NAMETAB3[CURLEVEL+1,PARAMTAB[I].PARAMNAME].TYPE80627200 + ].FORM=SET %601-80627205 + THEN BEGIN % %601-80627400 + GEN(",",1,7); % %601-80627600 + GENID("W",1000|(CURLEVEL+1)+PARAMTAB[I].PARAMNAME 80627800 + ,5); % %601-80627801 + END; %601-80627850 + END; 80628000 + IF VALUEPARAMS THEN GEN(";",1,7); 80629000 + DECLAREVARS(TRUE,PARAMTAB,T+1,TX,CURLEVEL+1); 80630000 + END ELSE GEN(";",1,7); 80631000 + 80632000 + INSYMBOL; 80633000 + IF CURNAME1="7FORWAR" AND CURNAME2="D" THEN 80634000 + BEGIN 80635000 + NAMETAB3[CURLEVEL,INDEX].FORWARDDEF:=1; 80636000 + TX:=(T:=NAMETAB3[CURLEVEL,INDEX].INFO)+PARAMTAB[T]; %504-80636100 + FOR I:=T+1 STEP 1 UNTIL TX DO % MARK FORWARD PARAMETERS 80636200 + NAMETAB1[CURLEVEL+1,PARAMTAB[I].PARAMNAME].[46:1] := 1; 80636210 + NUMFORWARDS:=NUMFORWARDS+1; 80637000 + REPLACE POINTER(NAMETAB1[CURLEVEL+1,*]) BY 0 %002-80637500 + FOR MAXNAMES+1 WORDS; %002-80637600 + GEN("FORWARD",8,1); 80638000 + INSYMBOL; 80639000 + END ELSE 80640000 + BEGIN 80641000 + CURLEVEL:=CURLEVEL+1; 80642000 + IF CURLEVEL GEQ LASTREC THEN ERROR(101); % %002-80643000 + BLOCKTAB[CURLEVEL]:=NUMBLOCKS:=NUMBLOCKS+1; 80644000 + TX:=CURFUNC; CURFUNC:=IF FUN THEN INDEX ELSE -1; %504-80645000 + BLOCK; %*** COMPILE PROCEDURE BODY *** 80646000 + FOR I:=0 STEP 1 UNTIL MAXNAMES DO % LEAVE FORWARD PARAMETERS 80647000 + IF NAMETAB1[CURLEVEL,I]>0 THEN NAMETAB1[CURLEVEL,I]:=0; 80648000 + CURLEVEL:=CURLEVEL-1; CURFUNC:=TX; %504-80649000 + TOPLEVEL:=CURLEVEL; 80650000 + END; 80651000 + IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80652000 + GEN(";",1,7); 80653000 + IF SYMKIND[CURSY]!INITIAL THEN INSYMBOL; 80654000 + END OF PROCEDURE DECLARATION; 80655000 + 80656000 + 80657000 + IF NUMFORWARDS>0 THEN ERROR(44); 80658000 + END OF SEGMENT FOR PROCEDURE DECLARATIONS; %700-80658100 + GEN("INTEGER",8,1); 80659000 + FOR I:=1 STEP 1 UNTIL MAXTEMPS DO 80660000 + BEGIN GENID("T",I,2); 80661000 + IF I1 THEN GEN("END",4,5); 80703000 +END OF BLOCK; 80704000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%90001000 +% %90002000 +% %90003000 +% %90004000 +% PART 9: THE MAIN PROGRAM. %90005000 +% ----------------- %90006000 +% %90007000 +% %90008000 +% %90009000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%90010000 + 90011000 + 90012000 +INTEGER PROGNAMELENGTH; % %800-90013900 +ALPHA PROGNAME,ALGOLNAME; 90014000 +% %002-90014100 +% %002-90014200 +SAVEFACTOR:=0;% * DEFAULT ZIP IS COMPILE AND GO UNLESS %002-90014300 +% * CHANGED BY THE USE OF THE "S" OPTION %002-90014400 +% %002-90014500 +% %002-90014600 + 90015000 +CH[0] := "PASC000"; CHARPNT := POINTER(CH[0])+5; %711-90016000 +PASCALGOL.FID := USER := TIME(-1); %711-90017000 +DO BEGIN C:=C+1; REPLACE CHARPNT BY C FOR 3 DIGITS; %711-90018000 + PASCALGOL.MFID := ALGOLNAME := CH[0]; %711-90019000 + SEARCHDISKDIRECTORY( PASCALGOL, LINES[*] ); %711-90020000 +END UNTIL LINES[0]=-1; % FILE NOT ON DISK %711-90021000 +WRITE(PASCALGOL,MERGE); % ALGOL MUST COMPILE PRELUDE FIRST %704-90022000 +CARDLENGTH:=72; 90033000 +C := " "; % TO INITIALIZE "INSYMBOL" %709-90034000 +INITIALIZE; % COMPILER TABLES, NEWCARD, INSYMBOL %709-90035000 +IF CURSY=PROGRAMSY THEN 90037000 +BEGIN 90038000 + INSYMBOL; 90039000 + IF CURSY=IDENTIFIER THEN 90040000 + BEGIN 90041000 + PROGNAME := IF CURLENGTH < 7 %705-90042000 + THEN " "&CURNAME1[41:6|CURLENGTH-1:6|CURLENGTH] 90042010 + ELSE CURNAME2.[5:6]&CURNAME1[41:35:36]; %705-90042020 +% %002-90042100 +% THE FOLLOWING LINES ADD A "0" ONTO THE FRONT OF THE PROGRAM NAME OR90042200 +% THE FIRST SIX CHARACTERS THEREOF IF IT IS LONGER THAN SIX CHARACTERS 90042300 +% THUS GIVING THE NAME OF THE XALGOL OBJECT CODE FILE PRODUCED. %002-90042400 +% %002-90042500 + PROGNAME := CURNAME1.[35:36]; PROGNAMELENGTH := MIN(6,CURLENGTH)+1;90042600 +% %002-90042700 +% %002-90042800 + INSYMBOL; 90043000 + IF CURSY=LPAR THEN 90044000 + BEGIN 90045000 + DO BEGIN 90046000 + INSYMBOL; 90047000 + IF CURSY=IDENTIFIER THEN 90048000 + BEGIN 90049000 + IF CURNAME1="50INPUT" THEN INPUTDECL:=TRUE ELSE 90050000 + IF CURNAME1="6OUTPUT" THEN OUTPUTDECL:=TRUE ELSE 90051000 + BEGIN 90052000 + IF CURLENGTH>6 THEN ERROR(77); 90053000 + NUMEXTFILES:=NUMEXTFILES+1; 90054000 + IF NUMEXTFILES{MAXEXTFILES THEN 90055000 + EXTFILETAB[NUMEXTFILES]:=CURNAME1 ELSE 90056000 + IF NUMEXTFILES=MAXEXTFILES+1 THEN ERROR(73); 90057000 + END; 90058000 + END ELSE ERROR(9); 90059000 + INSYMBOL; 90060000 + END UNTIL CURSY!COMMA; 90061000 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(SEMICOLON) END; 90062000 + IF CURSY=RPAR THEN INSYMBOL; 90063000 + IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 90064000 + END ELSE BEGIN ERROR(58); SKIP(SEMICOLON) END; 90065000 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 90066000 +END ELSE BEGIN ERROR(75); SKIP(SEMICOLON) END; 90067000 +INSYMBOL; 90068000 +CURLEVEL:=1; 90069000 +LASTREC:=MAXTABLES+1; 90070000 + MAXPERMTAB := 0; %518-90070100 + INSIDEPARENS := FALSE; %518-90070200 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%90071000 +% %90072000 + BLOCK; % COMPILE USER PROGRAM. %90073000 +% %90074000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%90075000 +IF CURSY!DOT THEN 90076000 +BEGIN 90077000 + ERROR(76); 90078000 + DO BLOCK UNTIL CURSY=DOT; 90079000 +END; 90080000 +IF FALSE THEN 90081000 +BEGIN 90082000 +ENDOFINPUT: ERROR(87); CHARCNT:=-1; 90083000 + WRITE(LINE, TERMMESS); %708-90084000 +END; 90085000 +IF LISTOPTION AND CHARCNT}0 THEN PRINTLINE; 90086000 +IF ERRINX>0 THEN PRINTERRORS; 90087000 +IF PAGECNT > 0 % THERE HAS BEEN SOME LISTING %709-90088000 +THEN BEGIN WRITE( LINE[DBL] ); WRITE( LINE[DBL] ) END; %709-90089000 +IF NUMERRS=0 THEN 90090000 +BEGIN% %002-90090400 + WRITE(LINE ,NOERRORS);% %002-90090500 + IF ERR(100) % %800-90090600 + THEN WRITE(LINE ,ERROR100MESS);% %002-90090700 + IF ERR(102) THEN %713-90090710 + WRITE(LINE,ERROR102MESS); %713-90090720 + IF SAVEFACTOR}0 THEN% *A ZIP IS REQUIRED %002-90090800 +BEGIN 90091000 + ARRAY ZIPARRAY[0:19], Z[0:0]; 90092000 + POINTER ZIPPNT; 90093000 + 90094000 + DEFINE PPROGNAME = 13 #, PALGOLNAME = 14 #, %705-90095000 + PLIBRARY = 15 #, PUSER = 16 #, %705-90096000 + P(P1) = POINTER(ZIPARRAY[P1])+1 FOR 7 #; %705-90097000 + 90105000 + WRITEALGOL; 90106000 + WRITE(PASCALGOL,LASTLINE); 90107000 + LOCK(PASCALGOL,SAVE); 90108000 + ZIPARRAY[PPROGNAME]:=PROGNAME; ZIPARRAY[PALGOLNAME]:=ALGOLNAME; 90112000 + ZIPARRAY[PLIBRARY]:= IF SAVEFACTOR>0 THEN "LIBRARY" ELSE %705-90113000 + IF SAVEFACTOR<0 THEN " SYNTAX" ELSE " & RUN "; 90114000 + ZIPARRAY[PUSER]:=USER; %705-90115000 + REPLACE POINTER(ZIPARRAY[*]) BY "CC COMPILE ", %705-90116000 + P(PPROGNAME), "/", P(PUSER), %705-90117000 + " XALGOL ", P(PLIBRARY), %705-90118000 + "; ALGOL FILE TAPE=PASCRUN/DISK SERIAL; ALGOL FILE CARD=", %800-90119000 + P(PALGOLNAME),"/",P(PUSER)," SERIAL;", % %800-90120000 + " XALGOL STACK = 2048; END."; % %800-90120500 + ZIP WITH ZIPARRAY[*]; 90129000 +END% %002-90129500 +END OF COMPILER ZIP ELSE 90130000 +BEGIN 91001000 + INTEGER I; 91002000 + SWITCH FORMAT ERRORMESS1 := 91003000 + (" 0 *** COMPILER ERROR *** CONTACT THE COMPUTER CENTRE."), 91004000 + (" 1 IDENTIFIER NOT DEFINED."), 91005000 + (" 2 IDENTIFIER ALREADY DEFINED."), 91006000 + (" 3 WRONG NUMBER OF PARAMETERS."), 91007000 + (" 4 SYNTAX ERROR."), 91008000 + (" 5 FUNCTION NAME NOT ACCESSIBLE AT THIS LEVEL."), %511-91009000 + (" 6 STRINGS MAY NOT BE CONTINUED FROM ONE CARD TO ANOTHER."), 91010000 + (" 7 A TYPE EXPECTED."), 91011000 + (" 8 VARIABLE EXPECTED."), 91012000 + (" 9 IDENTIFIER EXPECTED."), 91013000 + (" 10 INTEGER CONSTANT EXPECTED."), 91014000 + (" 11 CONSTANT OF OTHER TYPE THAN EXPECTED."), 91015000 + (" 12 VARIABLE OF ILLEGAL TYPE."), 91016000 + (" 13 UNRECOGNIZABLE STATEMENT."), 91017000 + (" 14 CONSTANT TOO BIG OR TO SMALL."), 91018000 + (" 15 UNDEFINED LABEL."), 91019000 + (" 16 FOR- AND CASE-STATEMENTS NESTED TOO DEEP."), 91020000 + (" 17 EXPRESSION IS OF WRONG TYPE."), 91021000 + (" 18 """OF""" EXPECTED."), 91022000 + (" 19 """DO""" EXPECTED."), 91023000 + (" 20 """ELSE""" WITHOUT CORRESPONDING """THEN"""."), 91024000 + (" 21 ILLEGAL TERMINATION OF STATEMENT."), 91025000 + (" 22 """UNTIL""" EXPECTED."), 91026000 + (" 23 """TO"""/"""DOWNTO""" EXPECTED."), 91027000 + (" 24 """END""" EXPECTED."), 91028000 + (" 25 """;""" EXPECTED."), 91029000 + (" 26 """:""" EXPECTED."), 91030000 + (" 27 """THEN""" EXPECTED."), 91031000 + (" 28 """:=""" EXPECTED."), 91032000 + (" 29 ONLY NUMBERS MAY BE SIGNED."), 91033000 + (" 30 TOO MANY CASES."), 91034000 + (" 31 LABEL USED MORE THAN ONCE."), 91035000 + (" 32 CONSTANT EXPECTED."), 91036000 + (" 33 LABEL NOT IN RANGE 0..9999."), 91037000 + (" 34 TOO MANY LABELS DECLARED."), 91038000 + (" 35 TOO MANY CONSTANTS DECLARED."), 91039000 + (" 36 """=""" EXPECTED."), 91040000 + (" 37 THE LIST IS TOO LONG."), 91041000 + (" 38 INVALID TYPE FOR A FUNCTION."), 91042000 + (" 39 """BEGIN""" EXPECTED."), 91043000 + (" 40 TOO MANY IDENTIFIERS DECLARED."), 91044000 + (" 41 ALFA CONSTANTS MAY NOT BE LONGER THAN 7 CHARACTERS."),%001-91045000 + (" 42 EXPRESSION IS NOT OF TYPE BOOLEAN."), 91046000 + (" 43 NOT PROPER FORWARD DECLARATION."), 91047000 + (" 44 UNSATISFIED FORWARD DECLARATION."), 91048000 + (" 45 TOO MANY DIFFERENT TYPES DECLARED."), 91049000 + (" 46 """)""" EXPECTED."), 91050000 + (" 47 """[""" EXPECTED."), 91051000 + (" 48 A SIMPLE TYPE EXPECTED."), 91052000 + (" 49 """ARRAY OF ARRAY""" AND """ARRAY OF RECORD""" ILLEGAL", 91053000 + " AS FILE TYPE."), 91054000 + (" 50 """FILE OF FILE""" IS ILLEGAL."), 91055000 + (" 51 SET BOUNDRY IS TOO BIG OR TOO SMALL."), 91056000 + (" 52 TOO MANY UNDECLARED POINTERS."), 91057000 + (" 53 """..""" EXPECTED."), 91058000 + (" 54 FIRST VALUE IS GREATER THAN SECOND VALUE."), 91059000 + (" 55 PROCEDURE NESTING DEPTH + NO OF RECORDS IS TOO GREAT."), 91060000 + (" 56 THE RECORD CONTAINS MORE THEN 1023 WORDS."), 91061000 + (" 57 FILES NOT ALLOWED IN RECORDS."), 91062000 + (" 58 """(""" EXPECTED."), 91063000 + (" 59 """]""" EXPECTED."); 91064000 + 91065000 + SWITCH FORMAT ERRORMESS2 := 91066000 + (" 60 """ARRAY OF FILE""" NOT ALLOWED."), 91067000 + (" 61 RANGE OF INDEX IS GREATER THAN 1023."), 91068000 + (" 62 UNSATISFIED POINTER DECLARATION."), 91069000 + (" 63 EXPRESSION IS TOO LONG."), 91070000 + (" 64 ILLEGAL OPERATOR FOR THIS TYPE OF EXPRESSION."), 91071000 + (" 65 INTEGER EXPRESSION EXPECTED."), 91072000 + (" 66 A SET EXPECTED."), 91073000 + (" 67 PARAMETER OF ILLEGAL TYPE."), 91074000 + (" 68 PROCEDURES NOT ALLOWED IN THIS CONTEXT."), 91075000 + (" 69 ILLEGAL USE OF THIS TYPE OF IDENTIFIER."), 91076000 + (" 70 TOO MANY PARAMETERS DECLARED IN THE PROGRAM."), 91077000 + (" 71 """ARRAY OF CHAR""" EXPECTED."), 91078000 + (" 72 WRONG TYPE OF SET EXPRESSION."), 91079000 + (" 73 TOO MANY EXTERNAL FILES."), 91080000 + (" 74 ILLEGAL IDENTIFIER FOR EXTERNAL FILE."), 91081000 + (" 75 """PROGRAM""" EXPECTED."), 91082000 + (" 76 """.""" EXPECTED AT END OF PROGRAM."), 91083000 + (" 77 EXTERNAL FILE IDENTIFIER MAY NOT EXCEED 6 CHARACTERS."), 91084000 + (" 78 ILLEGAL FILE PARAMETER."), 91085000 + (" 79 ILLEGAL USE OF FILE HANDLING PROCEDURE."), 91086000 + (" 80 TEXT-FILE EXPECTED."), 91087000 + (" 81 POINTER VARIABLE EXPECTED."), 91088000 + (" 82 ONLY VALUES OF TYPE REAL, INTEGER OR CHAR MAY BE READ."), 91089000 + (" 83 VARIABLES IN RECORDS ILLEGAL IN THIS CONTEXT."), 91090000 + (" 84 DISPLAY OVERFLOW."), 91091000 + (" 85 READ AND WRITE MAY ONLY BE USED ON TEXT-FILES."), 91092000 + (" 86 REFERENCED OBJECT IS TOO BIG."), 91093000 + (" 87 END-OF-INPUT ENCOUNTERED UNEXPECTEDLY."), %001-91094000 + (" 88 CHARACTER ARRAY EXPECTED."), 91095000 + (" 89 """,""" EXPECTED."), 91096000 + (" 91 PROCEDURES MAY NOT HAVE ANY TYPE."), 91097000 + (" 91 PARAMETER OF WRONG KIND."), 91098000 + (" 92 ONLY COMPLETE ARRAYS AND RECORDS MAY BE TRANSMITTED."), 91099000 + (" 93 DECLARED LABEL NOT USED."), 91100000 + (" 94 PARAMETERS OF THIS TYPE SHOULD NOT BE VALUE PARAMETERS."), 91101000 + (" 95 SIZE OF STRUCTURES IN ASSIGNMENT ARE NOT THE SAME."), %512-91102000 + (" 96 INPUT/OUPUT NOT DECLARED."), 91103000 + (" 97 TOO MANY FILES IN USE."), %001-91104000 + (" 98 RECORD IDENTIFIER EXPECTED."), 91105000 + (" 99 UNRECOGNIZED ITEM."), 91106000 + ("100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION. THE VALUE 07 IS91106500 +SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT THE COMPILATION ERRO91106600 +RS COUNT."),% %002-91106700 + ("101 PROCEDURES/FUNCTIONS NESTED TOO DEEP."), %002-91106800 + ("102 ***WARNING ONLY, ILLEGAL DOLLAR OPTION."), %713-91106900 + (); 91107000 + 91108000 + 91109000 + WRITE(LINE, ERRORS,NUMERRS); %708-91110000 + FOR I:=0 STEP 1 UNTIL 59 DO IF ERR[I] THEN 91111000 + WRITE(LINE, ERRORMESS1[I]); %708-91112000 + FOR I:=60 STEP 1 UNTIL 119 DO IF ERR[I] THEN 91113000 + WRITE(LINE, ERRORMESS2[I-60]); %708-91114000 +END OF ERROR MESSAGES; 91115000 +IF XREFOPTION THEN 92001000 +BEGIN 92002000 + REPLACE POINTER(XREFLINE[*]) BY " " FOR 17 WORDS; 92003000 + REWIND(XREFFILE); %002-92003500 + HEADING; 92004000 + SORT(PRINTXREF,XREFINPUT,0,XREFMAX,XREFCOMPARE,3,1000,6000); %002-92005000 +END; 92006000 +END OF B5700 PASCAL COMPILER............................................99001000 +END;END. LAST CARD ON 0CRDING TAPE 99999999