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