From c9fe38ede33d3da32f9b8bdd11adff225b48a048 Mon Sep 17 00:00:00 2001 From: Paul Kimpel Date: Mon, 4 Jul 2016 18:35:59 -0700 Subject: [PATCH] 1. Commit proofreading corrections to SYMBOL.PASCAL and PASCRUN.DISK. 2. Commit compile deck and listing with patches to allow the compiler to work with B5500 Mark XIII Algol. 3. Commit compile & go deck and output listing for HMSS2.TEST sample program. --- PASCAL-Heriot-Watt/HMSS2.TEST.card | 182 + PASCAL-Heriot-Watt/HMSS2.TEST.lst | 1674 ++++++++ PASCAL-Heriot-Watt/PASCAL.MKXIII-Compile.lst | 3816 ++++++++++++++++++ PASCAL-Heriot-Watt/PASCAL.MKXIII.card | 23 + PASCAL-Heriot-Watt/PASCRUN.DISK.alg_m | 956 +++-- PASCAL-Heriot-Watt/README.txt | 30 +- PASCAL-Heriot-Watt/SYMBOL.PASCAL.alg_m | 1104 ++--- 7 files changed, 6750 insertions(+), 1035 deletions(-) create mode 100644 PASCAL-Heriot-Watt/HMSS2.TEST.card create mode 100644 PASCAL-Heriot-Watt/HMSS2.TEST.lst create mode 100644 PASCAL-Heriot-Watt/PASCAL.MKXIII-Compile.lst create mode 100644 PASCAL-Heriot-Watt/PASCAL.MKXIII.card diff --git a/PASCAL-Heriot-Watt/HMSS2.TEST.card b/PASCAL-Heriot-Watt/HMSS2.TEST.card new file mode 100644 index 0000000..3635074 --- /dev/null +++ b/PASCAL-Heriot-Watt/HMSS2.TEST.card @@ -0,0 +1,182 @@ +?RUN PASCAL/DISK +?DATA SOURCE +(*$L+,C-,A+*) +PROGRAM HMSS2 (OUTPUT); +(*---------------------------------------------------------------------- + CHE 342 + CHIMNEY TEMPERATURE PROFILE PROBLEM + VERSION 1 1 MAY 1969 P. KIMPEL + ----------------------------------------------------------------------- + MODIFICATION LOG. + 92/04/01 P.KIMPEL + CONVERT FROM SDS-9300 FORTRAN TO MS-DOS PASCAL VER 3.32. + 92/11/15 P.KIMPEL + ADD TNEW ARRAY TO HOLD INTERMEDIATE RESULTS DURING CALCULATIONS. + 2016-07-02 P.KIMPEL + CONVERT TO HERIOT-WATT PASCAL FOR THE BURROUGHS B5500. + ---------------------------------------------------------------------*) + + CONST + TAIR= 20.0; + TWALL= 350.0; + H= 2.0; + DELTAX= 0.02; + K= 0.6; + EPSILON= 0.5; + XMAX= 50; + YMAX= 100; + FLUEXMIN= 25; + FLUEXMAX= 50; + FLUEYMIN= 25; + FLUEYMAX= 75; + + VAR + I: INTEGER; + J: INTEGER; + T: ARRAY [0..XMAX, 0..YMAX] OF REAL; + TNEW: ARRAY [0..XMAX, 0..YMAX] OF REAL; + CODE: PACKED ARRAY [0..27] OF CHAR; + PASS: INTEGER; + RMAX: REAL; + XNU: REAL; + XNUTAIR: REAL; + ET: REAL; + +(*--------------------------------------------------------------------*) +PROCEDURE RESIDUAL (I, J: INTEGER; TCELL: REAL); + VAR + R: REAL; + + BEGIN (*RESIDUAL*) + R:= ABS (TCELL - T[I,J]); + IF R > RMAX THEN + RMAX:= R; + + TNEW[I,J]:= TCELL; + END (*RESIDUAL*); + +(*--------------------------------------------------------------------*) +BEGIN (*HMSS*) +ET:= TIME; + +PASS:= 0; +FOR I:= 0 TO 27 DO + CODE[I]:= " "; +FOR I:= 1 TO 9 DO + CODE[I*2-1]:= CHR (ORD ("A") + I-1); +FOR I:= 10 TO 14 DO + CODE[I*2-1]:= CHR (ORD ("J") + I-10); + +(*INITIAL CONDITIONS -- LINEAR PROFILE*) +FOR I:= 0 TO FLUEXMIN DO + FOR J:= 0 TO YMAX DO + TNEW[I,J]:= (TWALL - TAIR) * I/XMAX + TAIR; + +FOR J:= FLUEYMIN TO FLUEYMAX DO + TNEW[FLUEXMIN,J]:= TWALL; + +FOR I:= FLUEXMIN TO FLUEXMAX DO + BEGIN + TNEW[I,FLUEYMIN]:= TWALL; + TNEW[I,FLUEYMAX]:= TWALL; + FOR J:= 0 TO FLUEYMIN DO + TNEW[I,J]:= (TWALL - TAIR) * I/XMAX + TAIR; + FOR J:= FLUEYMIN+1 TO FLUEYMAX-1 DO + TNEW[I,J]:= TWALL + 20.0; + FOR J:= FLUEYMAX TO YMAX DO + TNEW[I,J]:= (TWALL - TAIR) * I/XMAX + TAIR; + END (*FOR I*); + +XNU:= H * DELTAX / K; +XNUTAIR:= XNU * TAIR; + +REPEAT + PASS:= PASS+1; + WRITE (" PASS", PASS:5, ": "); + RMAX:= 0.0; + + (*MOVE TNEW[*,*] VALUES TO T[*,*]*) + FOR I:= 0 TO XMAX DO + FOR J:= 0 TO YMAX DO + T[I,J]:= TNEW[I,J]; + + FOR I:= 1 TO XMAX-1 DO + BEGIN + FOR J:= 1 TO YMAX-1 DO + BEGIN + IF (I < FLUEXMIN) OR (J < FLUEYMIN) OR (J > FLUEYMAX) THEN + RESIDUAL (I, J, + 0.25 * (T[I+1,J] + T[I-1,J] + T[I,J+1] + T[I,J-1])); + END (*FOR J*); + + (*FREE BOUNDARY AT Y=0: AIR*) + RESIDUAL (I, 0, + (XNUTAIR + 0.5 * (2.0 * T[I,1] + T[I+1,0] + T[I-1,0])) / + (XNU + 2.0)); + + (*INSULATED BOUNDARY AT Y=YMAX: HOUSE WALL*) + RESIDUAL (I, YMAX, + 0.25 * (T[I+1,YMAX] + T[I-1,YMAX] + 2.0 * T[I,YMAX-1])); + END (*FOR I*); + + FOR J:= 1 TO YMAX-1 DO + BEGIN + (*FREE BOUNDARY AT X=0*) + RESIDUAL (0, J, + (XNUTAIR + 0.5 * (2.0 * T[1,J] + T[0,J+1] + T[0,J-1])) / + (XNU + 2.0)); + + (*SYMMETRY BOUNDARY AT X=XMAX (DT/DX=0: ERGO, INSULATED)*) + IF (J < FLUEYMIN) OR (J > FLUEYMAX) THEN + RESIDUAL (XMAX, J, 0.25 * (T[XMAX,J+1] + T[XMAX,J-1] + + 2.0 * T[XMAX-1,J])); + END (*FOR J*); + + (*CORNER BOUNDARY AT X=XMAX, Y=YMAX*) + RESIDUAL (XMAX, YMAX, 0.50 * (T[XMAX-1,YMAX] + T[XMAX,YMAX-1])); + + (*CORNER BOUNDARY AT X=0, Y=YMAX*) + RESIDUAL (0, YMAX, (XNUTAIR - T[0,YMAX-1] + T[1,YMAX]) / XNU); + + (*CORNER BOUNARY AT X=XMAX, Y=0*) + RESIDUAL (XMAX, 0, (XNUTAIR - T[XMAX-1,0] + T[XMAX,1]) / XNU); + + (*CORNER BOUNDARY AT X=0, Y=0*) + RESIDUAL (0, 0, + (2.0 * XNUTAIR + T[1,0] + T[0,1]) / 2.0 / (XNU + 1.0)); + + WRITELN ("RMAX = ", RMAX:8:4); +UNTIL RMAX <= EPSILON; + +WRITELN; +WRITELN (" FINAL RMAX = ", RMAX); +WRITELN; +WRITELN (" TIMES: ET=", (TIME-ET):8:2, ", PT=", ELAPSED:8:2, + ", IO=", IOTIME:8:2); +WRITELN; +WRITELN (" TEMPERATURE PROFILE"); +WRITELN (" KEY A = 21- 40"); +WRITELN (" B = 61- 80"); +WRITELN (" C = 101-120"); +WRITELN (" D = 141-160"); +WRITELN (" E = 181-200"); +WRITELN (" F = 221-240"); +WRITELN (" G = 261-280"); +WRITELN (" H = 301-320"); +WRITELN (" I = 341-360"); +WRITELN; + +FOR J:= 0 TO YMAX DO + BEGIN + WRITE (J:4, " "); + FOR I:= 0 TO XMAX DO + WRITE (CODE[TRUNC(T[I,J]/20)]); + + WRITELN; + END (*FOR J*); + +WRITELN; +WRITELN (" TIMES: ET=", (TIME-ET):8:2, ", PT=", ELAPSED:8:2, + ", IO=", IOTIME:8:2); +END (*HMSS*). +?END \ No newline at end of file diff --git a/PASCAL-Heriot-Watt/HMSS2.TEST.lst b/PASCAL-Heriot-Watt/HMSS2.TEST.lst new file mode 100644 index 0000000..8ef73dc --- /dev/null +++ b/PASCAL-Heriot-Watt/HMSS2.TEST.lst @@ -0,0 +1,1674 @@ + LABEL 000000000LINES 00186183?RUN PASCAL/DISK PASCAL /DISK + + + + + + PASCAL(2.3)/B-5700 02/07/86 18:20 PAGE 1 + +00001=> (*$L+,C-,A+*) +00002=> PROGRAM HMSS2 (OUTPUT); +00003=> (*---------------------------------------------------------------------- +00004=> CHE 342 +00005=> CHIMNEY TEMPERATURE PROFILE PROBLEM +00006=> VERSION 1 1 MAY 1969 P. KIMPEL +00007=> ----------------------------------------------------------------------- +00008=> MODIFICATION LOG. +00009=> 92/04/01 P.KIMPEL +00010=> CONVERT FROM SDS-9300 FORTRAN TO MS-DOS PASCAL VER 3.32. +00011=> 92/11/15 P.KIMPEL +00012=> ADD TNEW ARRAY TO HOLD INTERMEDIATE RESULTS DURING CALCULATIONS. +00013=> 2016-07-02 P.KIMPEL +00014=> CONVERT TO HERIOT-WATT PASCAL FOR THE BURROUGHS B5500. +00015=> ---------------------------------------------------------------------*) +00016=> +00017=> CONST +00018=> TAIR= 20.0; +00019=> TWALL= 350.0; +00020=> H= 2.0; +00021=> DELTAX= 0.02; +00022=> K= 0.6; +00023=> EPSILON= 0.5; +00024=> XMAX= 50; +00025=> YMAX= 100; +00026=> FLUEXMIN= 25; +00027=> FLUEXMAX= 50; +00028=> FLUEYMIN= 25; +00029=> FLUEYMAX= 75; +00030=> +00031=> VAR +00032=> I: INTEGER; +00033=> J: INTEGER; +00034=> T: ARRAY [0..XMAX, 0..YMAX] OF REAL; +00035=> TNEW: ARRAY [0..XMAX, 0..YMAX] OF REAL; +00036=> CODE: PACKED ARRAY [0..27] OF CHAR; +00037=> PASS: INTEGER; +00038=> RMAX: REAL; +00039=> XNU: REAL; +00040=> XNUTAIR: REAL; +00041=> ET: REAL; +00042=> +00043=> (*--------------------------------------------------------------------*) +00044=> PROCEDURE RESIDUAL (I, J: INTEGER; TCELL: REAL); +00045=> VAR +00046=> R: REAL; +00047=> +00048=> BEGIN (*RESIDUAL*) B1 +00049=> R:= ABS (TCELL - T[I,J]); +00050=> IF R > RMAX THEN +00051=> RMAX:= R; +00052=> +00053=> TNEW[I,J]:= TCELL; +00054=> END (*RESIDUAL*); E1 +00055=> +00056=> (*--------------------------------------------------------------------*) + + + PASCAL(2.3)/B-5700 02/07/86 18:20 PAGE 2 + +00057=> BEGIN (*HMSS*) B2 +00058=> ET:= TIME; +00059=> +00060=> PASS:= 0; +00061=> FOR I:= 0 TO 27 DO +00062=> CODE[I]:= " "; +00063=> FOR I:= 1 TO 9 DO +00064=> CODE[I*2-1]:= CHR (ORD ("A") + I-1); +00065=> FOR I:= 10 TO 14 DO +00066=> CODE[I*2-1]:= CHR (ORD ("J") + I-10); +00067=> +00068=> (*INITIAL CONDITIONS -- LINEAR PROFILE*) +00069=> FOR I:= 0 TO FLUEXMIN DO +00070=> FOR J:= 0 TO YMAX DO +00071=> TNEW[I,J]:= (TWALL - TAIR) * I/XMAX + TAIR; +00072=> +00073=> FOR J:= FLUEYMIN TO FLUEYMAX DO +00074=> TNEW[FLUEXMIN,J]:= TWALL; +00075=> +00076=> FOR I:= FLUEXMIN TO FLUEXMAX DO +00077=> BEGIN B3 +00078=> TNEW[I,FLUEYMIN]:= TWALL; +00079=> TNEW[I,FLUEYMAX]:= TWALL; +00080=> FOR J:= 0 TO FLUEYMIN DO +00081=> TNEW[I,J]:= (TWALL - TAIR) * I/XMAX + TAIR; +00082=> FOR J:= FLUEYMIN+1 TO FLUEYMAX-1 DO +00083=> TNEW[I,J]:= TWALL + 20.0; +00084=> FOR J:= FLUEYMAX TO YMAX DO +00085=> TNEW[I,J]:= (TWALL - TAIR) * I/XMAX + TAIR; +00086=> END (*FOR I*); E3 +00087=> +00088=> XNU:= H * DELTAX / K; +00089=> XNUTAIR:= XNU * TAIR; +00090=> +00091=> REPEAT R1 +00092=> PASS:= PASS+1; +00093=> WRITE (" PASS", PASS:5, ": "); +00094=> RMAX:= 0.0; +00095=> +00096=> (*MOVE TNEW[*,*] VALUES TO T[*,*]*) +00097=> FOR I:= 0 TO XMAX DO +00098=> FOR J:= 0 TO YMAX DO +00099=> T[I,J]:= TNEW[I,J]; +00100=> +00101=> FOR I:= 1 TO XMAX-1 DO +00102=> BEGIN B4 +00103=> FOR J:= 1 TO YMAX-1 DO +00104=> BEGIN B5 +00105=> IF (I < FLUEXMIN) OR (J < FLUEYMIN) OR (J > FLUEYMAX) THEN +00106=> RESIDUAL (I, J, +00107=> 0.25 * (T[I+1,J] + T[I-1,J] + T[I,J+1] + T[I,J-1])); +00108=> END (*FOR J*); E5 +00109=> +00110=> (*FREE BOUNDARY AT Y=0: AIR*) +00111=> RESIDUAL (I, 0, +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 + +00113=> (XNU + 2.0)); +00114=> +00115=> (*INSULATED BOUNDARY AT Y=YMAX: HOUSE WALL*) +00116=> RESIDUAL (I, YMAX, +00117=> 0.25 * (T[I+1,YMAX] + T[I-1,YMAX] + 2.0 * T[I,YMAX-1])); +00118=> END (*FOR I*); E4 +00119=> +00120=> FOR J:= 1 TO YMAX-1 DO +00121=> BEGIN B6 +00122=> (*FREE BOUNDARY AT X=0*) +00123=> RESIDUAL (0, J, +00124=> (XNUTAIR + 0.5 * (2.0 * T[1,J] + T[0,J+1] + T[0,J-1])) / +00125=> (XNU + 2.0)); +00126=> +00127=> (*SYMMETRY BOUNDARY AT X=XMAX (DT/DX=0: ERGO, INSULATED)*) +00128=> IF (J < FLUEYMIN) OR (J > FLUEYMAX) THEN +00129=> RESIDUAL (XMAX, J, 0.25 * (T[XMAX,J+1] + T[XMAX,J-1] + +00130=> 2.0 * T[XMAX-1,J])); +00131=> END (*FOR J*); E6 +00132=> +00133=> (*CORNER BOUNDARY AT X=XMAX, Y=YMAX*) +00134=> RESIDUAL (XMAX, YMAX, 0.50 * (T[XMAX-1,YMAX] + T[XMAX,YMAX-1])); +00135=> +00136=> (*CORNER BOUNDARY AT X=0, Y=YMAX*) +00137=> RESIDUAL (0, YMAX, (XNUTAIR - T[0,YMAX-1] + T[1,YMAX]) / XNU); +00138=> +00139=> (*CORNER BOUNARY AT X=XMAX, Y=0*) +00140=> RESIDUAL (XMAX, 0, (XNUTAIR - T[XMAX-1,0] + T[XMAX,1]) / XNU); +00141=> +00142=> (*CORNER BOUNDARY AT X=0, Y=0*) +00143=> RESIDUAL (0, 0, +00144=> (2.0 * XNUTAIR + T[1,0] + T[0,1]) / 2.0 / (XNU + 1.0)); +00145=> +00146=> WRITELN ("RMAX = ", RMAX:8:4); +00147=> UNTIL RMAX <= EPSILON; U1 +00148=> +00149=> WRITELN; +00150=> WRITELN (" FINAL RMAX = ", RMAX); +00151=> WRITELN; +00152=> WRITELN (" TIMES: ET=", (TIME-ET):8:2, ", PT=", ELAPSED:8:2, +00153=> ", IO=", IOTIME:8:2); +00154=> WRITELN; +00155=> WRITELN (" TEMPERATURE PROFILE"); +00156=> WRITELN (" KEY A = 21- 40"); +00157=> WRITELN (" B = 61- 80"); +00158=> WRITELN (" C = 101-120"); +00159=> WRITELN (" D = 141-160"); +00160=> WRITELN (" E = 181-200"); +00161=> WRITELN (" F = 221-240"); +00162=> WRITELN (" G = 261-280"); +00163=> WRITELN (" H = 301-320"); +00164=> WRITELN (" I = 341-360"); +00165=> WRITELN; +00166=> +00167=> FOR J:= 0 TO YMAX DO +00168=> BEGIN B7 + + + PASCAL(2.3)/B-5700 02/07/86 18:20 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 +00175=> +00176=> WRITELN; +00177=> WRITELN (" TIMES: ET=", (TIME-ET):8:2, ", PT=", ELAPSED:8:2, +00178=> ", IO=", IOTIME:8:2); +00179=> END (*HMSS*). E2 + + + + +NO ERRORS DETECTED. + + + + + + + LABEL 000000000LINES 00186183?RUN PASCAL/DISK PASCAL /DISK + + + + + + + + + + + + LABEL 0XALGOL 0COMPILE00186183CC USER=0000000; COMPILE HMSS2/0000000 XALGOL ;XALGOL FILE CARD=PASC85 XALGOL /HMSS2 + + + + + + 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 + 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 + 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 + 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 + +ESTIMATED CORE STORAGE REQUIRED = 6769 WORDS. + +ESTIMATED AUXILIARY MEMORY REQUIRED = 0 WORDS. + + + + LABEL 0XALGOL 0COMPILE00186183CC USER=0000000; COMPILE HMSS2/0000000 XALGOL ;XALGOL FILE CARD=PASC85 XALGOL /HMSS2 + + + + + + + + + + + + LABEL 000000000OUTPUT 00186183CC USER=0000000; COMPILE HMSS2/0000000 XALGOL ;XALGOL FILE CARD=PASC85 HMSS2 /0000000 + + + + + + PASS 1: RMAX = 230.0000 + PASS 2: RMAX = 106.9839 + PASS 3: RMAX = 30.0786 + PASS 4: RMAX = 23.8685 + PASS 5: RMAX = 15.8328 + PASS 6: RMAX = 12.3433 + PASS 7: RMAX = 10.9879 + PASS 8: RMAX = 9.0:98 + PASS 9: RMAX = 8.5020 + PASS 10: RMAX = 7.3267 + PASS 10: RMAX = 6.9743 + PASS 12: RMAX = 6.0>73 + PASS 13: RMAX = 5.9338 + PASS 14: RMAX = 5.30:6 + PASS 15: RMAX = 5.1764 + PASS 16: RMAX = 4.6904 + PASS 17: RMAX = 4.5987 + PASS 18: RMAX = 4.2054 + PASS 19: RMAX = 4.0>24 + PASS 20: RMAX = 3.8467 + PASS 20: RMAX = 3.7723 + PASS 22: RMAX = 3.5496 + PASS 23: RMAX = 3.4656 + PASS 24: RMAX = 3.2966 + PASS 25: RMAX = 3.20:5 + PASS 26: RMAX = 3.0785 + PASS 27: RMAX = 3.0047 + PASS 28: RMAX = 2.8883 + PASS 29: RMAX = 2.8223 + PASS 30: RMAX = 2.720# + PASS 30: RMAX = 2.6616 + PASS 32: RMAX = 2.5726 + PASS 33: RMAX = 2.5187 + PASS 34: RMAX = 2.4400 + PASS 35: RMAX = 2.3909 + PASS 36: RMAX = 2.3207 + PASS 37: RMAX = 2.2759 + PASS 38: RMAX = 2.20?9 + PASS 39: RMAX = 2.1717 + PASS 40: RMAX = 2.0@49 + PASS 40: RMAX = 2.0769 + PASS 42: RMAX = 2.0254 + PASS 43: RMAX = 1.9902 + PASS 44: RMAX = 1.9434 + PASS 45: RMAX = 1.90#7 + PASS 46: RMAX = 1.8678 + PASS 47: RMAX = 1.8374 + PASS 48: RMAX = 1.7980 + PASS 49: RMAX = 1.7696 + PASS 50: RMAX = 1.7334 + PASS 50: RMAX = 1.7068 + PASS 52: RMAX = 1.6733 + PASS 53: RMAX = 1.6483 + PASS 54: RMAX = 1.6173 + PASS 55: RMAX = 1.5938 + PASS 56: RMAX = 1.5650 + PASS 57: RMAX = 1.5428 + PASS 58: RMAX = 1.5160 + PASS 59: RMAX = 0.>950 + PASS 60: RMAX = 0.>700 + PASS 60: RMAX = 0.>502 + PASS 62: RMAX = 0.>267 + PASS 63: RMAX = 0.>079 + PASS 64: RMAX = 0.:869 + PASS 65: RMAX = 0.:681 + PASS 66: RMAX = 0.:504 + PASS 67: RMAX = 0.:305 + PASS 68: RMAX = 0.:159 + PASS 69: RMAX = 0.?949 + PASS 70: RMAX = 0.?830 + PASS 70: RMAX = 0.?60? + PASS 72: RMAX = 0.?518 + PASS 73: RMAX = 0.?297 + PASS 74: RMAX = 0.?220 + PASS 75: RMAX = 0.?00# + PASS 76: RMAX = 0.@937 + PASS 77: RMAX = 0.@737 + PASS 78: RMAX = 0.@666 + PASS 79: RMAX = 0.@475 + PASS 80: RMAX = 0.@407 + PASS 80: RMAX = 0.@225 + PASS 82: RMAX = 0.@159 + PASS 83: RMAX = 0.#985 + PASS 84: RMAX = 0.#922 + PASS 85: RMAX = 0.#755 + PASS 86: RMAX = 0.#694 + PASS 87: RMAX = 0.#534 + PASS 88: RMAX = 0.#476 + PASS 89: RMAX = 0.#323 + PASS 90: RMAX = 0.#266 + PASS 90: RMAX = 0.#0@9 + PASS 92: RMAX = 0.#064 + PASS 93: RMAX = 0.9923 + PASS 94: RMAX = 0.9870 + PASS 95: RMAX = 0.9734 + PASS 96: RMAX = 0.9683 + PASS 97: RMAX = 0.9553 + PASS 98: RMAX = 0.9503 + PASS 99: RMAX = 0.9377 + PASS 100: RMAX = 0.9329 + PASS 100: RMAX = 0.9208 + PASS 102: RMAX = 0.9161 + PASS 103: RMAX = 0.9045 + PASS 104: RMAX = 0.8999 + PASS 105: RMAX = 0.8887 + PASS 106: RMAX = 0.8843 + PASS 107: RMAX = 0.8735 + PASS 108: RMAX = 0.8692 + PASS 109: RMAX = 0.8587 + PASS 100: RMAX = 0.8545 + PASS 100: RMAX = 0.8444 + PASS 102: RMAX = 0.8404 + PASS 103: RMAX = 0.830# + PASS 104: RMAX = 0.8267 + PASS 105: RMAX = 0.8183 + PASS 106: RMAX = 0.80:4 + PASS 107: RMAX = 0.8059 + PASS 108: RMAX = 0.8005 + PASS 109: RMAX = 0.7939 + PASS 120: RMAX = 0.7880 + PASS 120: RMAX = 0.7822 + PASS 122: RMAX = 0.7758 + PASS 123: RMAX = 0.7708 + PASS 124: RMAX = 0.7640 + PASS 125: RMAX = 0.7597 + PASS 126: RMAX = 0.7526 + PASS 127: RMAX = 0.7490 + PASS 128: RMAX = 0.7415 + PASS 129: RMAX = 0.7385 + PASS 130: RMAX = 0.7307 + PASS 130: RMAX = 0.7283 + PASS 132: RMAX = 0.7204 + PASS 133: RMAX = 0.7183 + PASS 134: RMAX = 0.70#7 + PASS 135: RMAX = 0.7086 + PASS 136: RMAX = 0.700? + PASS 137: RMAX = 0.6992 + PASS 138: RMAX = 0.6919 + PASS 139: RMAX = 0.6899 + PASS 140: RMAX = 0.6829 + PASS 140: RMAX = 0.6809 + PASS 142: RMAX = 0.6740 + PASS 143: RMAX = 0.6721 + PASS 144: RMAX = 0.6654 + PASS 145: RMAX = 0.6636 + PASS 146: RMAX = 0.6570 + PASS 147: RMAX = 0.6552 + PASS 148: RMAX = 0.6488 + PASS 149: RMAX = 0.6470 + PASS 150: RMAX = 0.6408 + PASS 150: RMAX = 0.6390 + PASS 152: RMAX = 0.6329 + PASS 153: RMAX = 0.630? + PASS 154: RMAX = 0.6252 + PASS 155: RMAX = 0.6235 + PASS 156: RMAX = 0.6177 + PASS 157: RMAX = 0.6160 + PASS 158: RMAX = 0.60#4 + PASS 159: RMAX = 0.6087 + PASS 160: RMAX = 0.6032 + PASS 160: RMAX = 0.6016 + PASS 162: RMAX = 0.5962 + PASS 163: RMAX = 0.5946 + PASS 164: RMAX = 0.5893 + PASS 165: RMAX = 0.5877 + PASS 166: RMAX = 0.5825 + PASS 167: RMAX = 0.580# + PASS 168: RMAX = 0.5759 + PASS 169: RMAX = 0.5744 + PASS 170: RMAX = 0.5696 + PASS 170: RMAX = 0.5680 + PASS 172: RMAX = 0.5635 + PASS 173: RMAX = 0.5617 + PASS 174: RMAX = 0.5576 + PASS 175: RMAX = 0.5555 + PASS 176: RMAX = 0.5517 + PASS 177: RMAX = 0.5494 + PASS 178: RMAX = 0.5460 + PASS 179: RMAX = 0.5434 + PASS 180: RMAX = 0.5403 + PASS 180: RMAX = 0.5376 + PASS 182: RMAX = 0.5348 + PASS 183: RMAX = 0.5319 + PASS 184: RMAX = 0.5293 + PASS 185: RMAX = 0.5263 + PASS 186: RMAX = 0.5240 + PASS 187: RMAX = 0.5207 + PASS 188: RMAX = 0.5187 + PASS 189: RMAX = 0.5153 + PASS 190: RMAX = 0.50:6 + PASS 190: RMAX = 0.50#0 + PASS 192: RMAX = 0.5085 + PASS 193: RMAX = 0.5048 + PASS 194: RMAX = 0.5035 + PASS 195: RMAX = 0.4997 + + FINAL RMAX = 4.99680577E-00 + + TIMES: ET= 507.55, PT= 504.57, IO= 8.75 + + TEMPERATURE PROFILE + KEY A = 21- 40 + B = 61- 80 + C = 101-120 + D = 141-160 + E = 181-200 + F = 221-240 + G = 261-280 + 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 + + + + + diff --git a/PASCAL-Heriot-Watt/PASCAL.MKXIII-Compile.lst b/PASCAL-Heriot-Watt/PASCAL.MKXIII-Compile.lst new file mode 100644 index 0000000..dd12c87 --- /dev/null +++ b/PASCAL-Heriot-Watt/PASCAL.MKXIII-Compile.lst @@ -0,0 +1,3816 @@ + LABEL 0XALGOL 0COMPILE00186180?COMPILE PASCAL/DISK XALGOL LIBRARY XALGOL /PASCAL + + + + + + BURROUGHS B-5700 XALGOL COMPILER MARK XIII.0 SUNDAY, 06/29/86, 10:38 AM. + + + + + + 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="2.3"#; 10028000 T 0000 + INTEGER NUMERRS, % @R+21: NUMBER OF ERRORS IN PROGRAM. 10029000 T 0000 + SAVEFACTOR, % @R+22: SAVEFACTOR FOR CODE FILE. 10030000 T 0000 + % >0 COMPILE TO LIBRARY. 10031000 T 0000 + % =0 COMPILE AND RUN. 10032000 T 0000 + % <0 COMPILE FOR SYNTAX. 10033000 T 0000 + CARDCNT; % @R+23: NUMBER OF CARDS READ. 10034000 T 0000 + FILE CARD "SOURCE" (2,10,150); % SOURCE CODE INPUT FILE 10035000 T 0000 + FILE LINES 1 (2,17); % PRINT FILE. 10036000 T 0003 + FILE PASCALGOL DISK SERIAL [20:600] (2,10,150,SAVE 0); % CODE FILE 10037000 T 0007 + DEFINE LINESPERPAGE=58#, 10038000 T 0013 + MAXINT=549755813887#; 10039000 T 0013 + 10040000 T 0013 + %*** COMPILER CONSTANTS *** 10041000 T 0013 + DEFINE MAXTABLES =50#, %MAX NUMBER OF NAME TABLES. 10042000 T 0013 + MAXNAMES =997#, %MAX NAMES IN EACH TABLE. 10043000 T 0013 + MAXLEVEL =15#, %MAX DEPTH OF PROCEDURE DECLARATIONS. 10044000 T 0013 + MAXCASES =211#, %MAX LABELS IN A CASE-STATEMENT. 10045000 T 0013 + MAXLABS =100#, %MAX NUMBER OF LABELS. 10046000 T 0013 + MAXPARAMS =200#, %MAX NUMBER OF PARAMETERS IN WHOLE PROGRAM. 10047000 T 0013 + MAXTYPES =1022#, %MAX NUMBER OF DIFFERENT TYPES. 10048000 T 0013 + MAXCONSTS =200#, %SIZE OF CONSTANT TABLE. 10049000 T 0013 + MAXTEMPS =5#, %NUMBER OF EXTRA VARS IN EACH PROCEDURE. 10050000 T 0013 + MAXWITHSYMS=250#, %MAX NUMBER OF SYMBOLS USED BY WITH-STATMS. 10051000 T 0013 + MAXSYMS =800#, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 T 0013 + LISTLENGTH =800#, %MAX LENGTH OF VAR AND PARAM LISTS. 10053000 T 0013 + MAXEXTFILES=20#, %MAX NUMBER OF EXTERNAL FILES. 10054000 T 0013 + MAXFILES =20#, %MAX NUMBER OF FILES DECLARED AT ONE TIME. 10055000 T 0013 + MAXPNTRS =50#; %MAX NUMBER OF UNDECLARED POINTERS. 10056000 T 0013 + 10057000 T 0013 + %*** NAME TABLES *** 10058000 T 0013 + ARRAY NAMETAB1,NAMETAB2,NAMETAB3[0:MAXTABLES,0:MAXNAMES]; 10059000 T 0013 + DEFINE NAMELENGTH =[41:6]#, 10060000 T 0015 + TYPE =[9:10]#, 10061000 T 0015 + IDCLASS =[12:3]#, 10062000 T 0015 + VAR =0#, 10063000 T 0015 + CONST=1#, 10064000 T 0015 + FUNC =2#, 10065000 T 0015 + PROC =3#, 10066000 T 0015 + TYPES=4#, 10067000 T 0015 + INFO =[23:11]#, 10068000 T 0015 + FORMAL =[24:1]#, 10069000 T 0015 + FORWARDDEF =[25:1]#, 10070000 T 0015 + EXTERNALFILE=[26:1]#; 10071000 T 0015 + 10072000 T 0015 + %*** DISPLAY VECTOR *** 10073000 T 0015 + ARRAY DISPLAY[0:MAXLEVEL]; 10074000 T 0015 + DEFINE RECTYPE =[9:10]#, 10075000 T 0017 + FIRSTWITHSYM =[19:10]#, 10076000 T 0017 + LASTWITHSYM =[29:10]#, 10077000 T 0017 + NUMPNTRSINWITH=[35:6]#, 10078000 T 0017 + BRACKETSINWITH=[36:1]#, 10079000 T 0017 + NAMETAB =[46:7]#; 10080000 T 0017 + 10081000 T 0017 + %*** TYPE TABLES *** 10082000 T 0017 + ARRAY TYPETAB1,TYPETAB2,TYPETAB3[0:MAXTYPES]; 10083000 T 0017 + DEFINE FORM =[3:4]#, 10084000 T 0019 + NUMERIC =0#, 10085000 T 0019 + SYMBOLIC=1#, 10086000 T 0019 + SUBTYPE =2#, 10087000 T 0019 + MAINTYPE=[33:10]#, 10088000 T 0019 + CHAR =3#, 10089000 T 0019 + FLOATING=4#, 10090000 T 0019 + ALFA =5#, 10091000 T 0019 + SET =6#, 10092000 T 0019 + SETTYPE =[33:10]#, 10093000 T 0019 + POINTERS=7#, 10094000 T 0019 + POINTTYPE=[33:10]#, 10095000 T 0019 + ARRAYS =8#, 10096000 T 0019 + INXTYPE =[33:10]#, 10097000 T 0019 + ARRTYPE =[43:10]#, 10098000 T 0019 + RECORD =9#, 10099000 T 0019 + RECTAB =[33:10]#, 10100000 T 0019 + FILES =10#, 10101000 T 0019 + FILETYPE=[33:10]#, 10102000 T 0019 + TEXTFILE=11#, 10103000 T 0019 + SIZE =[15:12]#, 10104000 T 0019 + STRUCT=[23:8]#; 10105000 T 0019 + INTEGER NUMTYPES; 10106000 T 0019 + 10107000 T 0019 + %*** PARAMETER TABLE *** 10108000 T 0019 + ARRAY PARAMTAB[0:MAXPARAMS]; 10109000 T 0019 + DEFINE PARAMNAME =[9:10]#, 10110000 T 0021 + PARAMKIND =[13:4]#, 10111000 T 0021 + PARAMLEVEL=[23:10]#, 10112000 T 0021 + PARAMTYPE =[33:10]#, 10113000 T 0021 + PARAMFILE =[34:1]#; 10114000 T 0021 + INTEGER NUMPARAMS; 10115000 T 0021 + 10116000 T 0021 + %*** CONSTANT TABLE *** 10117000 T 0021 + ARRAY CONSTTAB[0:MAXCONSTS]; 10118000 T 0021 + INTEGER NUMCONSTS; 10119000 T 0023 + 10120000 T 0023 + %*** LABEL TABLE *** 10121000 T 0023 + ARRAY LABTAB[0:MAXLABS]; 10122000 T 0023 + DEFINE LABVAL=[14:15]#, 10123000 T 0025 + LABDEF=[15:1]#; 10124000 T 0025 + INTEGER NUMLABS,FIRSTLAB; 10125000 T 0025 + 10126000 T 0025 + %*** TABLES FOR I/O AND CHARACTER HANDLING *** 10127000 T 0025 + ARRAY CH[0:0], TEXT[0:1], STRING[0:11]; 10128000 T 0025 + POINTER CHARPNT,TEXTPNT,TEXTPNT0,STRINGPNT; 10129000 T 0030 + ARRAY ICARD[0:9], LINE[0:16], XLINE[0:10], ALGOLCARD[0:9]; 10130000 T 0030 + POINTER CARDPNT,LINEPNT,XLINEPNT,ALGOLPNT; 10131000 T 0037 + INTEGER CHARCNT,ALGOLCNT,MARGINCNT; 10132000 T 0037 + ARRAY HEADTEXT[0:10], ERRLINE[0:16]; 10133000 T 0037 + INTEGER LINECNT,PAGECNT,ERRINX; 10134000 T 0040 + 10135000 T 0040 + %*** XREF FILE AND TABLE *** 10136000 T 0040 + FILE XREFFILE DISK SERIAL [20:3000] (2,3,150); 10137000 T 0040 + ARRAY BLOCKTAB[0:MAXTABLES], XREFLINE[0:16]; 10138000 T 0044 + INTEGER NUMXREF,NUMBLOCKS; POINTER XREFPNT; 10139000 T 0047 + % 10140000 T 0047 + %*** OTHER TABLES *** 10141000 T 0047 + INTEGER ARRAY VARLIST[0:LISTLENGTH]; % TEMPORARY LIST OF VARIABLES. 10142000 T 0047 + INTEGER VARINDEX,FIRSTVAR; 10143000 T 0049 + ARRAY SYMTAB[0:MAXSYMS]; % USED BY "EXPRESSION". 10144000 T 0049 + 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:61]; % USED IN ERROR RECOVERY. 10149000 T 0054 + ARRAY PNTRTAB1,PNTRTAB2,PNTRTAB3[0:MAXPNTRS];% USED FOR FORWARD POINTERS 10150000 T 0056 + INTEGER NUMPNTRS; 10151000 T 0058 + ARRAY EXTFILETAB[0:MAXEXTFILES]; % EXTERNAL FILES. 10152000 T 0058 + INTEGER NUMEXTFILES; 10153000 T 0060 + ARRAY FILETAB[0:MAXFILES]; % FILES IN USE. 10154000 T 0060 + INTEGER NUMFILES; 10155000 T 0062 + BOOLEAN ARRAY ERR[0:119]; % RECORDS ERROR MESSAGES. 10156000 T 0062 + 10157000 T 0064 + %*** COMPILE TIME OPTIONS *** 10158000 T 0064 + BOOLEAN LISTOPTION,RESWORDOPTION,CHECKOPTION,DUMPOPTION,XREFOPTION; 10159000 T 0064 + INTEGER CARDLENGTH; 10160000 T 0064 + 10161000 T 0064 + %*** INTRINSIC TYPES *** 10162000 T 0064 + INTEGER INTTYPE,REALTYPE,ALFATYPE,CHARTYPE,BOOLTYPE,NILTYPE,TEXTTYPE, 10163000 T 0064 + INPUTFILE,OUTPUTFILE,EMPTYSET; 10164000 T 0064 + BOOLEAN INPUTDECL,OUTPUTDECL; 10165000 T 0064 + 10166000 T 0064 + %*** TEMPORARY VARIABLES *** 10167000 T 0064 + INTEGER T1,T2,T3,T4,T5; 10168000 T 0064 + 10169000 T 0064 + %*** OTHER VARIABLES *** 10170000 T 0064 + ALPHA USER; % THE USER NUMBER FOUND ON THE USER CARD. 10171000 T 0064 + 10172000 T 0064 + INTEGER CURLEVEL, % CURRENT PROCEDURE LEVEL. 10173000 T 0064 + TOPLEVEL, % TOP LEVEL IN DISPLAY VECTOR. 10174000 T 0064 + NUMBEGINS, % NUMBER OF "BEGIN"S IN THE PROGRAM. 10175000 T 0064 + NUMCASES, % NUMBER OF CASE-STATEMENTS IN PROGRAM. 10176000 T 0064 + NUMREPS, % NUMBER OF REPEAT-STATEMENTS IN PROGRAM. 10177000 T 0064 + NUMTEMPS, % NUMBER OF TEMPORARY VARIABLES IN USE. 10178000 T 0064 + CURFUNC, % INDEX OF FUNCTION CURRENTLY COMPILED. 10179000 T 0064 + CURSY, % LAST SYMBOL READ BY SCANNER. 10180000 T 0064 + CURTYPE, % TYPE OF ENTITY LAST COMPILED. 10181000 T 0064 + CURMODE, % CURRENT EXPRESSION MODE. 10182000 T 0064 + LASTREC; % LAST RECORD TABLE DEFINED. 10183000 T 0064 + 10184000 T 0064 + LABEL ENDOFINPUT; 10185000 T 0064 + 10186000 T 0064 + FORMAT NOERRORS ("NO ERRORS DETECTED."), 10187000 T 0064 + START OF SEGMENT ********** 3 + ERRORS (I5," ERRORS DETECTED"/), 10188000 T 0064 + ALIST ("$ SET LIST SINGLE"), 10189000 T 0064 + NOALIST ("$ RESET LIST"), 10190000 T 0064 + LASTLINE ("; TERMINATE: END OF PASCAL PROGRAM."), 10191000 T 0064 + TERMMESS ("**** END-OF-INPUT. COMPILATION TERMINATED."); 10192000 T 0064 + 3 IS 46 LONG, NEXT SEG 2 + MONITOR EXPOVR:=REALOVERFLOW; 10193000 T 0064 + 10194000 T 0066 + %*** SCANNER SYMBOLS *** 10195000 T 0066 + DEFINE IDENTIFIER=1#, INTCONST=2#, REALCONST=3#, ALFACONST=4#, 10196000 T 0066 + CHARCONST=5#, NOTSY=6#, ASTERISK=7#, SLASH=8#, 10197000 T 0066 + ANDSY=9#, DIVSY=10#, MODSY=11#, PLUS=12#, 10198000 T 0066 + MINUS=13#, ORSY=14#, LSSSY=15#, LEQSY=16#, 10199000 T 0066 + GEQSY=17#, GTRSY=18#, NEQSY=19#, EQLSY=20#, 10200000 T 0066 + INSY=21#, LPAR=22#, RPAR=23#, LBRACKET=24#, 10201000 T 0066 + RBRACKET=25#, DOUBLEDOT=26#, COMMA=27#, SEMICOLON=28#, 10202000 T 0066 + DOT=29#, ARROW=30#, COLON=31#, ASSIGNSY=32#, 10203000 T 0066 + BEGINSY=33#, ENDSY=34#, IFSY=35#, THENSY=36#, 10204000 T 0066 + ELSESY=37#, CASESY=38#, OFSY=39#, REPEATSY=40#, 10205000 T 0066 + UNTILSY=41#, WHILESY=42#, DOSY=43#, FORSY=44#, 10206000 T 0066 + TOSY=45#, DOWNTOSY=46#, GOTOSY=47#, NILSY=48#, 10207000 T 0066 + TYPESY=49#, ARRAYSY=50#, RECORDSY=51#, FILESY=52#, 10208000 T 0066 + SETSY=53#, CONSTSY=54#, VARSY=55#, LABELSY=56#, 10209000 T 0066 + FUNCSY=57#, PROCSY=58#, WITHSY=59#, PROGRAMSY=60#, 10210000 T 0066 + PACKEDSY=61#; 10211000 T 0066 + 10212000 T 0066 + DEFINE INITIAL=0#, MIDDLE=1#, TERMINAL=2#; 10213000 T 0066 + DEFINE NUMBER=0#, BITPATTERN=1#; 10214000 T 0066 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20001000 T 0066 + % % 20002000 T 0066 + % % 20003000 T 0066 + % % 20004000 T 0066 + % PART 2: COMPILER UTILITY ROUTINES. % 20005000 T 0066 + % -------------------------- % 20006000 T 0066 + % % 20007000 T 0066 + % % 20008000 T 0066 + % % 20009000 T 0066 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20010000 T 0066 + 20011000 T 0066 + 20012000 T 0066 + PROCEDURE INSYMBOL; FORWARD; 20013000 T 0066 + PROCEDURE WRITEALGOL; FORWARD; 20014000 T 0069 + PROCEDURE NEWXREF(NAME1,NAME2,TABLE,DECL); 20015000 T 0069 + VALUE NAME1, NAME2, TABLE, DECL; 20016000 T 0069 + REAL NAME1, NAME2; 20017000 T 0069 + INTEGER TABLE; 20018000 T 0069 + BOOLEAN DECL; 20019000 T 0069 + FORWARD; 20020000 T 0069 + 20021000 T 0069 + DEFINE NDIGITS(N)= 20022000 T 0069 + IF N{ 9 THEN 1 ELSE 20023000 T 0069 + IF N{99 THEN 2 ELSE 3 DIGITS#; 20024000 T 0069 + 20025000 T 0069 + DEFINE HEADING= 20026000 T 0069 + BEGIN COMMENT *** PRINTS A HEADING ON TOP OF A NEW PAGE. ; 20027000 T 0069 + PAGECNT:=PAGECNT+1; 20028000 T 0069 + REPLACE POINTER(HEADTEXT[*])+85 BY PAGECNT FOR NDIGITS(PAGECNT); 20029000 T 0069 + WRITE(LINES[PAGE]); 20030000 T 0069 + WRITE(LINES[DBL],11,HEADTEXT[*]); 20031000 T 0069 + LINECNT:=2; 20032000 T 0069 + END OF HEADING#; 20033000 T 0069 + 20034000 T 0069 + 20035000 T 0069 + DEFINE PRINTLINE= %*** PRINTS A SOURCE CODE LINE. 20036000 T 0069 + BEGIN 20037000 T 0069 + REPLACE LINEPNT-8 BY CARDCNT FOR 5 DIGITS; 20038000 T 0069 + IF LINECNT}LINESPERPAGE THEN HEADING; 20039000 T 0069 + IF RESWORDOPTION THEN 20040000 T 0069 + BEGIN 20041000 T 0069 + WRITE(LINES[NO],11,XLINE[*]); 20042000 T 0069 + WRITE(LINES[NO],11,XLINE[*]); 20043000 T 0069 + END; 20044000 T 0069 + WRITE(LINES,17,LINE[*]); 20045000 T 0069 + LINECNT:=LINECNT+1; 20046000 T 0069 + END OF PRINTLINE#; 20047000 T 0069 + 20048000 T 0069 + 20049000 T 0069 + DEFINE NEWCARD= %*** READS A NEW SOURCE CODE CARD. 20050000 T 0069 + BEGIN 20051000 T 0069 + IF LISTOPTION THEN PRINTLINE; 20052000 T 0069 + IF ERRINX>0 THEN PRINTERRORS; 20053000 T 0069 + READ(CARD,10,ICARD[*]) [ENDOFINPUT]; 20054000 T 0069 + CARDPNT:=POINTER(ICARD[*]); 20055000 T 0069 + REPLACE LINEPNT BY CARDPNT FOR 10 WORDS, " " FOR 6 WORDS; 20056000 T 0069 + REPLACE XLINEPNT BY " " FOR 10 WORDS; 20057000 T 0069 + CHARCNT:=CARDLENGTH; 20058000 T 0069 + MARGINCNT:=85; 20059000 T 0069 + CARDCNT:=CARDCNT+1; 20060000 T 0069 + END#; 20061000 T 0069 + 20062000 T 0069 + 20063000 T 0069 + DEFINE GEN(T,N,START)= %*** GENERATE A TEXT "T", CONSISTING OF 20064000 T 0069 + BEGIN %*** "N" LETTERS, STARTING AT "START". 20065000 T 0069 + IF ALGOLCNT 0 THEN 20117000 T 0028 + BEGIN 20118000 T 0029 + WHILE ABSX}1@7 DO BEGIN ABSX:=ABSX/10; POWER:=POWER+1; END; 20119000 T 0029 + WHILE ABSX<1@6 DO BEGIN ABSX:=ABSX|10; POWER:=POWER-1; END; 20120000 T 0036 + V1:=ENTIER(ABSX); 20121000 T 0042 + V2:=ENTIER((ABSX-V1)|1000000); 20122000 T 0043 + REPLACE ALGOLPNT:ALGOLPNT BY V1 FOR 7 DIGITS, ".", 20123000 T 0046 + V2 FOR 6 DIGITS, "@"; 20124000 T 0053 + ALGOLCNT:=ALGOLCNT-15; 20125000 T 0059 + IF POWER<0 THEN GEN("-",1,7); 20126000 T 0060 + POWER:=ABS(POWER); 20127000 T 0071 + REPLACE ALGOLPNT:ALGOLPNT BY POWER FOR 2 DIGITS; 20128000 T 0072 + ALGOLCNT:=ALGOLCNT-2; 20129000 T 0075 + END ELSE GEN("0",1,7); 20130000 T 0076 + IF X<0 THEN GEN(")",1,7); 20131000 T 0089 + END; 20132000 T 0099 + END OF GENREAL; 20133000 T 0099 + 4 IS 103 LONG, NEXT SEG 2 + 20134000 T 0069 + 20135000 T 0069 + INTEGER TYPEINDEX; 20136000 T 0069 + 20137000 T 0069 + DEFINE NEWTYPE= 20138000 T 0069 + BEGIN 20139000 T 0069 + IF NUMTYPES}MAXTYPES THEN BEGIN ERROR(45);NUMTYPES:=MAXTYPES-20 END; 20140000 T 0069 + TYPEINDEX:=NUMTYPES:=NUMTYPES+1; 20141000 T 0069 + END #; 20142000 T 0069 + 20143000 T 0069 + 20144000 T 0069 + PROCEDURE WRITEALGOL; %*** WRITES A COMPLETED XALGOL CARD TO 20145000 T 0069 + BEGIN %*** THE FILE. 20146000 T 0069 + REPLACE POINTER(ALGOLCARD[9]) BY CARDCNT FOR 8 DIGITS; 20147000 T 0069 + WRITE(PASCALGOL,10,ALGOLCARD[*]); 20148000 T 0074 + IF DUMPOPTION THEN WRITE(LINES,10,ALGOLCARD[*]); 20149000 T 0079 + ALGOLPNT:=POINTER(ALGOLCARD[*]); ALGOLCNT:=71; 20150000 T 0084 + REPLACE ALGOLPNT BY " " FOR 9 WORDS; 20151000 T 0086 + END OF WRITEALGOL; 20152000 T 0089 + 20153000 T 0090 + 20154000 T 0090 + DEFINE MARGIN(LETTER,NUM)= 20155000 T 0090 + BEGIN COMMENT *** PLACES INFORMATION IN THE MARGIN. ; 20156000 T 0090 + IF MARGINCNT{118 THEN 20157000 T 0090 + BEGIN TEXT[0]:=LETTER; 20158000 T 0090 + REPLACE LINEPNT+MARGINCNT BY TEXTPNT+5 FOR 2, 20159000 T 0090 + NUM FOR NDIGITS(NUM); 20160000 T 0090 + MARGINCNT:=MARGINCNT+6; 20161000 T 0090 + END; 20162000 T 0090 + END OF MARGIN#; 20163000 T 0090 + 20164000 T 0090 + 20165000 T 0090 + PROCEDURE SKIP(SYMBOL); %*** SKIP SYMBOLS TO RECOVER FROM ERROR 20166000 T 0090 + VALUE SYMBOL; INTEGER SYMBOL; %*** CONDITION. 20167000 T 0090 + BEGIN 20168000 T 0090 + WHILE CURSY!SYMBOL AND SYMKIND[CURSY]=MIDDLE DO 20169000 T 0090 + IF CURSY=RECORDSY THEN 20170000 T 0092 + BEGIN DO BEGIN INSYMBOL; 20171000 T 0093 + SKIP(99); 20172000 T 0094 + END UNTIL CURSY!SEMICOLON AND CURSY!CASESY; 20173000 T 0095 + END ELSE INSYMBOL; 20174000 T 0097 + END OF SKIP; 20175000 T 0098 + 20176000 T 0099 + 20177000 T 0099 + PROCEDURE ERROR(ERRNUM); 20178000 T 0099 + VALUE ERRNUM; INTEGER ERRNUM; 20179000 T 0099 + BEGIN COMMENT *** ARRANGE ERROR INDICATOR. ; 20180000 T 0099 + NUMERRS:=NUMERRS+1; 20181000 T 0099 + ERR[ERRNUM]:=TRUE; 20182000 T 0100 + ERRINX:=MAX(ERRINX,CARDLENGTH-2-CHARCNT); 20183000 T 0101 + IF ERRINX{115 THEN 20184000 T 0105 + BEGIN REPLACE POINTER(ERRLINE[1])+ERRINX BY "|", 20185000 T 0106 + ERRNUM FOR NDIGITS(ERRNUM); 20186000 T 0114 + ERRINX:=ERRINX+(IF ERRNUM{ 9 THEN 2 ELSE 20187000 T 0121 + IF ERRNUM{99 THEN 3 ELSE 4); 20188000 T 0123 + END END OF ERROR; 20189000 T 0126 + 20190000 T 0126 + 20191000 T 0126 + PROCEDURE PRINTERRORS; 20192000 T 0126 + BEGIN COMMENT *** PRINT ERROR INDICATORS. ; 20193000 T 0126 + IF NOT LISTOPTION THEN PRINTLINE; 20194000 T 0126 + WRITE(LINES,17,ERRLINE[*]); 20195000 T 0170 + LINECNT:=LINECNT+1; 20196000 T 0174 + REPLACE POINTER(ERRLINE[1]) BY " " FOR 16 WORDS; 20197000 T 0175 + ERRINX:=0; 20198000 T 0181 + END OF PRINT ERRORS; 20199000 T 0182 + 20200000 T 0182 + 20201000 T 0182 + DEFINE HASH(N) = (N).[35:36] MOD MAXNAMES#; 20202000 T 0182 + 20203000 T 0182 + INTEGER THISLEVEL,THISTAB,THISINDEX; 20204000 T 0182 + ALPHA THISID,TNAME; 20205000 T 0182 + BOOLEAN FOUND; 20206000 T 0182 + 20207000 T 0182 + DEFINE SEARCHTAB(TAB)= %*** SEARCH NAME TABLE "TAB" FOR THE 20208000 T 0182 + BEGIN %*** IDENTIFIER JUST READ. 20209000 T 0182 + THISINDEX:=HASH(CURNAME1); 20210000 T 0182 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20211000 T 0182 + WHILE (IF TNAME=CURNAME1 THEN NAMETAB2[TAB,THISINDEX]!CURNAME2 20212000 T 0182 + ELSE TNAME!0) DO 20213000 T 0182 + BEGIN 20214000 T 0182 + THISINDEX:=IF THISINDEX=0 THEN MAXNAMES ELSE THISINDEX-1; 20215000 T 0182 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20216000 T 0182 + END; 20217000 T 0182 + FOUND:=TNAME!0; 20218000 T 0182 + IF XREFOPTION THEN 20219000 T 0182 + IF FOUND THEN NEWXREF(CURNAME1,CURNAME2,TAB,FALSE); % 20220000 T 0182 + END OF SEARCHTAB#; 20221000 T 0182 + 20222000 T 0182 + DEFINE SEARCH= %*** SEARCH ALL TABLES CURRENTLY IN USE. 20223000 T 0182 + BEGIN 20224000 T 0182 + THISLEVEL:=TOPLEVEL+1; 20225000 T 0182 + DO BEGIN 20226000 T 0182 + THISLEVEL:=THISLEVEL-1; 20227000 T 0182 + THISTAB:=IF THISLEVEL{CURLEVEL THEN THISLEVEL 20228000 T 0182 + ELSE DISPLAY[THISLEVEL].NAMETAB; 20229000 T 0182 + SEARCHTAB(THISTAB); 20230000 T 0182 + END UNTIL FOUND OR THISLEVEL=0; 20231000 T 0182 + THISID:=NAMETAB3[THISTAB,THISINDEX]; 20232000 T 0182 + END OF SEARCH #; 20233000 T 0182 + 20234000 T 0182 + 20235000 T 0182 + DEFINE NEWNAME(NAME1,NAME2,TAB) = 20236000 T 0182 + BEGIN %*** ENTER A NEW NAME INTO THE NAME TABLE "TAB". 20237000 T 0182 + THISINDEX:=HASH(NAME1); 20238000 T 0182 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20239000 T 0182 + WHILE(IF TNAME=NAME1 THEN NAMETAB2[TAB,THISINDEX]!NAME2 20240000 T 0182 + ELSE TNAME!0) DO 20241000 T 0182 + BEGIN 20242000 T 0182 + THISINDEX:=IF THISINDEX=0 THEN MAXNAMES ELSE THISINDEX-1; 20243000 T 0182 + TNAME:=NAMETAB1[TAB,THISINDEX]; 20244000 T 0182 + END; 20245000 T 0182 + IF TNAME!0 THEN ERROR(2); 20246000 T 0182 + NAMETAB1[TAB,THISINDEX]:=NAME1; 20247000 T 0182 + NAMETAB2[TAB,THISINDEX]:=NAME2; 20248000 T 0182 + IF XREFOPTION THEN NEWXREF(NAME1,NAME2,TAB,TRUE); 20249000 T 0182 + END OF NEWNAME #; 20250000 T 0182 + 20251000 T 0182 + 20300000 T 0182 + PROCEDURE INITIALIZE; %*** INITIALIZATION *** 20301000 T 0182 + BEGIN %********************** 20302000 T 0182 + INTEGER T1,T3; 20303000 T 0182 + START OF SEGMENT ********** 5 + ALPHA A; 20304000 T 0000 + FILL SYMKIND[*] WITH 20305000 R 0000 + MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE, 20305100 R 0000 + START OF SEGMENT ********** 6 + MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE, 20305200 R 0001 + MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE, 20305300 R 0001 + MIDDLE,MIDDLE,MIDDLE,MIDDLE, 20305400 R 0001 + TERMINAL,MIDDLE,MIDDLE,MIDDLE,MIDDLE,INITIAL,TERMINAL, 20305500 R 0001 + INITIAL,MIDDLE,TERMINAL,INITIAL,MIDDLE,INITIAL,TERMINAL,INITIAL, 20306000 T 0001 + MIDDLE,INITIAL,MIDDLE,MIDDLE,INITIAL,MIDDLE,INITIAL, 20307000 R 0001 + MIDDLE,MIDDLE,MIDDLE,MIDDLE, 20307100 R 0001 + INITIAL,INITIAL,INITIAL,INITIAL,INITIAL,INITIAL,INITIAL,MIDDLE; 20308000 R 0001 + 6 IS 62 LONG, NEXT SEG 5 + 20309000 T 0001 + FILL SYMBOL[*] WITH 0,0,0,0,0,0,0,0,0,0,0, 20310000 R 0001 + START OF SEGMENT ********** 7 + ARROW,0,COLON,GTRSY,GEQSY,PLUS,0,0,0,0,0,0,0,0,0, 20310100 R 0003 + DOT,LBRACKET,ANDSY,LPAR,LSSSY,ARROW, 20311000 R 0003 + 0,0,0,0,0,0,0,0,0,0,0,ASTERISK,MINUS, 20311100 R 0003 + RPAR,SEMICOLON,LEQSY,0,SLASH, 20312000 R 0003 + 0,0,0,0,0,0,0,0,COMMA,0,NEQSY,EQLSY,RBRACKET,0,DOUBLEDOT; 20313000 R 0003 + 7 IS 65 LONG, NEXT SEG 5 + 20314000 T 0003 + LINEPNT :=POINTER(LINE[1]); 20315000 T 0003 + XLINEPNT:=POINTER(XLINE[1]); 20316000 T 0006 + REPLACE LINEPNT-8 BY " => ", " " FOR 16 WORDS; 20317000 T 0009 + REPLACE XLINEPNT-8 BY " " FOR 11 WORDS; 20318000 T 0018 + REPLACE POINTER(ERRLINE[*]) BY "**** ", " " FOR 16 WORDS; 20319000 T 0023 + ALGOLPNT:=POINTER(ALGOLCARD[*]); ALGOLCNT:=71; 20320000 T 0032 + REPLACE ALGOLPNT BY " " FOR 9 WORDS; 20321000 T 0034 + CHARPNT:=POINTER(CH[*])+7; 20322000 T 0038 + TEXTPNT:=POINTER(TEXT[*])+1; TEXTPNT0:=TEXTPNT-1; 20323000 T 0041 + REPLACE TEXTPNT BY " " FOR 15; 20324000 T 0047 + STRINGPNT:=POINTER(STRING[*]); 20325000 T 0051 + REPLACE POINTER(HEADTEXT[*]) BY " " FOR 10 WORDS, "PAGE "; 20326000 T 0052 + REPLACE POINTER(HEADTEXT[*]) BY "PASCAL(", EDITION, ")/B-5700"; 20327000 T 0061 + TEXT[0]:=TIME(5); 20328000 T 0072 + REPLACE POINTER(HEADTEXT[*])+45 BY TEXTPNT+3 FOR 2, "/", 20329000 T 0073 + TEXTPNT+1 FOR 2, "/", TEXTPNT+5 FOR 2; 20330000 T 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 0132 + %*** INITIALIZE INTRINSIC TYPES, CONSTANTS ETC. *** 20336000 T 0132 + 20337000 T 0132 + INTTYPE:=T3:=1; %*** "INTEGER" *** 20338000 T 0132 + T1:=NUMERIC; T1.SIZE:=1; T1.STRUCT:=0; 20339000 T 0133 + TYPETAB1[1]:=T1; TYPETAB2[1]:=-MAXINT; TYPETAB3[1]:=MAXINT; 20340000 T 0137 + NEWNAME("7INTEGE","R",0); T3.IDCLASS:=TYPES; 20341000 T 0141 + NAMETAB3[0,THISINDEX]:=T3; 20342000 T 0172 + REALTYPE:=T3:=2; %*** "REAL" *** 20343000 T 0174 + T1.FORM:=FLOATING; TYPETAB1[2]:=T1; 20344000 T 0175 + NEWNAME("400REAL",0,0); T3.IDCLASS:=TYPES; 20345000 T 0178 + NAMETAB3[0,THISINDEX]:=T3; 20346000 T 0204 + ALFATYPE:=T3:=3; %*** "ALFA" *** 20347000 T 0206 + T1.FORM:=ALFA; TYPETAB1[3]:=T1; 20348000 T 0207 + NEWNAME("400ALFA",0,0); T3.IDCLASS:=TYPES; 20349000 T 0210 + NAMETAB3[0,THISINDEX]:=T3; 20350000 T 0236 + BOOLTYPE:=T3:=4; %*** "BOOLEAN" *** 20351000 T 0238 + T1.FORM:=SYMBOLIC; TYPETAB1[4]:=T1; TYPETAB3[4]:=1; 20352000 T 0239 + NEWNAME("7BOOLEA","N",0); T3.IDCLASS:=TYPES; 20353000 T 0243 + NAMETAB3[0,THISINDEX]:=T3; 20354000 T 0270 + CHARTYPE:=T3:=5; %*** "CHAR" *** 20355000 T 0272 + T1.FORM:=CHAR; TYPETAB1[5]:=T1; TYPETAB3[5]:=63; 20356000 T 0273 + NEWNAME("400CHAR",0,0); T3.IDCLASS:=TYPES; 20357000 T 0277 + NAMETAB3[0,THISINDEX]:=T3; 20358000 T 0304 + T3:=BOOLTYPE; T3.IDCLASS:=CONST; %*** "FALSE" *** 20359000 T 0306 + NEWNAME("50FALSE",0,0); NAMETAB3[0,THISINDEX]:=T3; 20360000 T 0308 + T3.INFO:=1; %*** "TRUE" *** 20361000 T 0335 + NEWNAME("400TRUE",0,0); NAMETAB3[0,THISINDEX]:=T3; 20362000 T 0337 + NUMTYPES:=5; 20363000 T 0363 + NILTYPE:=-1; %*** TYPE OF "NIL" *** 20364000 T 0364 + EMPTYSET:=-2; %*** TYPE OF [] *** 20365000 T 0365 + NEWNAME("6MAXINT",0,0); T3:=INTTYPE; %*** "MAXINT" *** 20366000 T 0366 + T3.IDCLASS:=CONST; T3.INFO:=1024; 20367000 T 0391 + NAMETAB3[0,THISINDEX]:=T3; 20368000 T 0394 + NUMCONSTS:=1; CONSTTAB[1]:=MAXINT; 20369000 T 0396 + 20370000 T 0398 + T3:=0; T3.IDCLASS:=PROC; %*** PROCEDURES *** 20371000 T 0398 + FOR A:="3000GET", "3000NEW", "400PACK", "400PAGE", "3000PUT", 20372000 T 0401 + "400READ", "6READLN", "50RESET", "6UNPACK", "50WRITE" DO 20373000 T 0411 + BEGIN 20374000 T 0421 + NEWNAME(A,0,0); NAMETAB3[0,THISINDEX]:=T3; 20375000 T 0421 + END; 20376000 T 0459 + NEWNAME("7DISPOS","E",0); NAMETAB3[0,THISINDEX]:=T3; 20377000 T 0459 + NEWNAME("7REWRIT","E",0); NAMETAB3[0,THISINDEX]:=T3; 20378000 T 0485 + NEWNAME("7WRITEL","N",0); NAMETAB3[0,THISINDEX]:=T3; 20379000 T 0511 + 20380000 T 0537 + T3.IDCLASS:=FUNC; %*** FUNCTIONS *** 20381000 T 0537 + FOR A:="3000ABS", "6ARCTAN", "3000CHR", "3000COS", "3000EOF", 20382000 T 0539 + "400EOLN", "3000EXP", "20000LN", "3000ODD", "400PRED", 20383000 T 0549 + "400SUCC", "50ROUND", "3000SIN", "3000SQR", "400SQRT", 20384000 T 0559 + "50TRUNC", "6CONCAT", "400TIME", "400DATE", "6IOTIME", 20385000 T 0569 + "400USER", "3000ORD" 20386000 T 0579 + DO BEGIN 20387000 T 0582 + NEWNAME(A,0,0); NAMETAB3[0,THISINDEX]:=T3; 20388000 T 0583 + END; 20389000 T 0631 + NEWNAME("7ELAPSE","D",0); NAMETAB3[0,THISINDEX]:=T3; 20390000 T 0631 + NEWNAME("7WEEKDA","Y",0); NAMETAB3[0,THISINDEX]:=T3; 20391000 T 0657 + 20392000 T 0683 + TEXTTYPE:=T3:=NUMTYPES:=NUMTYPES+1; %*** "TEXT" *** 20393000 T 0683 + T1 := TEXTFILE; T1.STRUCT := 1; TYPETAB1[TEXTTYPE] := T1; % 20394000 T 0685 + T3.IDCLASS := TYPES; % 20395000 T 0689 + NEWNAME("400TEXT",0,0); NAMETAB3[0,THISINDEX]:=T3; 20396000 T 0691 + T3:=TEXTTYPE; T3.IDCLASS:=VAR; %*** "INPUT" *** 20397000 T 0717 + T3.EXTERNALFILE:=1; 20398000 T 0719 + NEWNAME("50INPUT",0,0); INPUTFILE:=THISINDEX; 20399000 T 0721 + NAMETAB3[0,THISINDEX]:=T3; 20400000 T 0747 + NEWNAME("6OUTPUT",0,0); %*** "OUTPUT" *** 20401000 T 0749 + NAMETAB3[0,THISINDEX]:=T3; OUTPUTFILE:=THISINDEX; 20402000 T 0773 + END OF INTIALIZED; 20403000 T 0776 + 5 IS 781 LONG, NEXT SEG 2 + 20404000 T 0182 + 20500000 T 0182 + 20501000 T 0182 + %*** XREF ROUTINES *** 20502000 T 0182 + %********************** 20503000 T 0182 + 20504000 T 0182 + DEFINE XREFCARD=[16:17]#, 20505000 T 0182 + XREFBLOCK=[26:10]#; 20506000 T 0182 + REAL A0,B0,A1,B1,LASTA0,LASTA1; 20507000 T 0182 + INTEGER NL,LASTBLOCK,A2,AX; 20508000 T 0182 + 20509000 T 0182 + PROCEDURE NEWXREF(NAME1,NAME2,TABLE,DECL); 20510000 T 0182 + VALUE NAME1,NAME2,TABLE,DECL; 20511000 T 0182 + REAL NAME1,NAME2; 20512000 T 0182 + INTEGER TABLE; 20513000 T 0182 + BOOLEAN DECL; 20514000 T 0182 + BEGIN 20515000 T 0182 + NL:=NAME1.NAMELENGTH; 20516000 T 0182 + IF NL<7 THEN NAME1:=0&NAME1[41:41:6]&NAME1[35:6|NL-1:6|NL] 20517000 T 0184 + ELSE NAME2:=0&NAME2[35:6|(NL-6)-1:6|(NL-6)]; 20518000 T 0191 + AX:=CARDCNT; AX.XREFBLOCK:=BLOCKTAB[TABLE]; 20519000 T 0198 + IF DECL THEN AX:=AX-100000000000; 20520000 T 0200 + WRITE(XREFFILE,*,NAME1,NAME2,AX); 20521000 T 0202 + END OF NEWXREF; 20522000 T 0214 + 20523000 T 0214 + PROCEDURE XREFMAX(A); 20524000 T 0214 + ARRAY A[0]; 20525000 T 0214 + BEGIN 20526000 T 0214 + A[0]:="AZZZZZZ"; A[1]:="ZZZZZZ"; A[2]:=9999999999; 20527000 T 0214 + END OF XREFMAX; 20528000 T 0218 + 20529000 T 0222 + 20530000 T 0222 + BOOLEAN PROCEDURE XREFCOMPARE(A,B); 20531000 T 0222 + ARRAY A,B[0]; 20532000 T 0222 + BEGIN 20533000 T 0222 + A0:=A[0]; B0:=B[0]; A1:=A[1]; B1:=B[1]; 20534000 T 0222 + XREFCOMPARE:= 20535000 T 0226 + IF A0.[35:36]!B0.[35:36] THEN A0.[35:36]LINESPERPAGE THEN HEADING; 20561000 T 0263 + XREFPNT:=POINTER(XREFLINE[*]); NUMXREF:=0; 20562000 T 0285 + REPLACE XREFPNT BY " " FOR 17 WORDS; XREFPNT:=XREFPNT+24; 20563000 T 0287 + END; 20564000 T 0293 + REPLACE XREFPNT BY A2.XREFCARD FOR 5 DIGITS; 20565000 T 0293 + XREFPNT:=XREFPNT+7; NUMXREF:=NUMXREF+1; 20566000 T 0297 + END ELSE 20567000 T 0301 + IF A2<0 THEN 20568000 T 0301 + BEGIN 20569000 T 0303 + A2:=A2+100000000000; 20570000 T 0303 + WRITE(LINES,17,XREFLINE[*]); LINECNT:=LINECNT+1; 20571000 T 0304 + IF LINECNT>LINESPERPAGE THEN HEADING; 20572000 T 0310 + XREFPNT:=POINTER(XREFLINE[*]); NUMXREF:=0; 20573000 T 0332 + REPLACE XREFPNT BY " " FOR 17 WORDS; 20574000 T 0334 + TEXT[0]:=A0.[35:36]; LASTA0:=A0; 20575000 T 0337 + REPLACE XREFPNT BY TEXTPNT+1 FOR A0.NAMELENGTH; 20576000 T 0340 + TEXT[0]:=LASTA1:=A1; 20577000 T 0345 + IF A0.NAMELENGTH>6 THEN 20578000 T 0347 + REPLACE XREFPNT+6 BY TEXTPNT+1 FOR A0.NAMELENGTH-6; 20579000 T 0348 + REPLACE XREFPNT+17 BY A2.XREFCARD FOR 5 DIGITS; 20580000 T 0356 + XREFPNT:=XREFPNT+24; LASTBLOCK:=A2.XREFBLOCK; 20581000 T 0362 + END; 20582000 T 0366 + END; 20583000 T 0366 + END OF PRINTXREF; 20584000 T 0366 + 20585000 T 0368 + 20800000 T 0368 + 20801000 T 0368 + INTEGER TT1,TT2,F1,F2,LT,RT; 20802000 T 0368 + 20803000 T 0368 + DEFINE CHECKTYPES(LEFTTYPE,RIGHTTYPE)= 20804000 T 0368 + BEGIN 20805000 T 0368 + IF LEFTTYPE>0 AND RIGHTTYPE>0 THEN 20806000 T 0368 + IF LEFTTYPE!RIGHTTYPE THEN 20807000 T 0368 + BEGIN 20808000 T 0368 + LT:=LEFTTYPE; RT:=RIGHTTYPE; 20809000 T 0368 + TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20810000 T 0368 + F1:=TT1.FORM; F2:=TT2.FORM; 20811000 T 0368 + IF LT!REALTYPE OR F2!NUMERIC THEN 20812000 T 0368 + IF(F1!SET AND LT!EMPTYSET)OR(F2!SET AND RT!EMPTYSET)THEN 20813000 T 0368 + IF(F1!POINTERS AND LT!NILTYPE)OR(F2!POINTERS AND RT!NILTYPE)THEN 20814000 T 0368 + BEGIN 20815000 T 0368 + IF F1=SET AND F2=SET THEN 20816000 T 0368 + BEGIN 20817000 T 0368 + LT:=TT1.SETTYPE; RT:=TT2.SETTYPE; 20818000 T 0368 + TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20819000 T 0368 + F1:=TT1.FORM; F2:=TT2.FORM; 20820000 T 0368 + END; 20821000 T 0368 + IF F1=POINTERS AND F2=POINTERS THEN 20822000 T 0368 + BEGIN 20823000 T 0368 + LT:=TT1.POINTTYPE; RT:=TT2.POINTTYPE; 20824000 T 0368 + TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20825000 T 0368 + F1:=TT1.FORM; F2:=TT2.FORM; 20826000 T 0368 + END; 20827000 T 0368 + WHILE F1=SUBTYPE DO 20828000 T 0368 + BEGIN LT:=TT1.MAINTYPE; TT1:=TYPETAB1[LT]; F1:=TT1.FORM END; 20829000 T 0368 + WHILE F2=SUBTYPE DO 20830000 T 0368 + BEGIN RT:=TT2.MAINTYPE; TT2:=TYPETAB1[RT]; F2:=TT2.FORM END; 20831000 T 0368 + IF LT>0 AND RT>0 THEN 20832000 T 0368 + IF LT!RT THEN 20833000 T 0368 + IF F1!NUMERIC OR F2!NUMERIC THEN 20834000 T 0368 + IF F1!CHAR OR F2!CHAR THEN ERROR(17); 20835000 T 0368 + END; 20836000 T 0368 + END; 20837000 T 0368 + END OF CHECKTYPES#; 20838000 T 0368 + 20839000 T 0368 + 20840000 T 0368 + INTEGER FILENAME; 20841000 T 0368 + BOOLEAN LPARFOUND; 20842000 T 0368 + 20843000 T 0368 + DEFINE FILEPARAM(DEFAULTFILE)=%*** CHECKS THE FIRST PARAMETER TO SEE 20844000 T 0368 + BEGIN %*** IF IT IS A FILE. 20845000 T 0368 + INSYMBOL; FILENAME:=CURTYPE:=0; 20846000 T 0368 + LPARFOUND:=CURSY=LPAR; 20847000 T 0368 + IF LPARFOUND THEN 20848000 T 0368 + BEGIN 20849000 T 0368 + INSYMBOL; 20850000 T 0368 + IF CURSY=IDENTIFIER THEN 20851000 T 0368 + BEGIN 20852000 T 0368 + SEARCH; 20853000 T 0368 + IF FOUND THEN 20854000 T 0368 + BEGIN 20855000 T 0368 + IF THISID.IDCLASS=VAR THEN 20856000 T 0368 + BEGIN 20857000 T 0368 + CURTYPE:=THISID.TYPE; 20858000 T 0368 + IF TYPETAB1[CURTYPE].FORM}FILES THEN 20859000 T 0368 + BEGIN 20860000 T 0368 + FILENAME:=1000|THISLEVEL+THISINDEX; 20861000 T 0368 + INSYMBOL; 20862000 T 0368 + END END END END; 20863000 T 0368 + IF SYMKIND[CURSY]=TERMINAL THEN ERROR(46); 20864000 T 0368 + END; 20865000 T 0368 + IF FILENAME=0 THEN FILENAME:=DEFAULTFILE; 20866000 T 0368 + IF (FILENAME=INPUTFILE AND NOT INPUTDECL) OR 20867000 T 0368 + (FILENAME=OUTPUTFILE AND NOT OUTPUTDECL) THEN ERROR(96); 20868000 T 0368 + END OF FILEPARAM#; 20869000 T 0368 + 20870000 T 0368 + 20871000 T 0368 + INTEGER TFORM; 20872000 T 0368 + BOOLEAN SIGNED,NEGATIVE; 20873000 T 0368 + 20874000 T 0368 + DEFINE CONSTANT(CVAL,CTYPE)= %*** *** 20875000 T 0368 + BEGIN %****************** 20876000 T 0368 + IF CURSY=MINUS OR CURSY=PLUS THEN 20877000 T 0368 + BEGIN SIGNED:=TRUE; NEGATIVE:=CURSY=MINUS; 20878000 T 0368 + INSYMBOL; 20879000 T 0368 + END ELSE SIGNED:=NEGATIVE:=FALSE; 20880000 T 0368 + IF CURSY=INTCONST THEN 20881000 T 0368 + BEGIN CTYPE:=INTTYPE; 20882000 T 0368 + CVAL:=IF NEGATIVE THEN -CURVAL ELSE CURVAL; 20883000 T 0368 + END ELSE 20884000 T 0368 + IF CURSY=CHARCONST THEN 20885000 T 0368 + BEGIN IF SIGNED THEN ERROR(29); 20886000 T 0368 + CTYPE:=CHARTYPE; CVAL:=CURVAL; 20887000 T 0368 + END ELSE 20888000 T 0368 + IF CURSY=REALCONST THEN 20889000 T 0368 + BEGIN CTYPE:=REALTYPE; 20890000 T 0368 + CVAL:=IF NEGATIVE THEN -CURVAL ELSE CURVAL; 20891000 T 0368 + END ELSE 20892000 T 0368 + IF CURSY=ALFACONST THEN 20893000 T 0368 + BEGIN IF SIGNED THEN ERROR(29); 20894000 T 0368 + IF CURLENGTH>7 THEN ERROR(41); 20895000 T 0368 + CTYPE:=ALFATYPE; CVAL:=CURVAL; 20896000 T 0368 + END ELSE 20897000 T 0368 + IF CURSY=IDENTIFIER THEN 20898000 T 0368 + BEGIN 20899000 T 0368 + SEARCH; 20900000 T 0368 + IF FOUND THEN 20901000 T 0368 + BEGIN 20902000 T 0368 + IF THISID.IDCLASS=CONST AND NOT BOOLEAN(THISID.FORMAL) THEN 20903000 T 0368 + BEGIN 20904000 T 0368 + IF TYPETAB1[THISID.TYPE].FORM{ALFA THEN 20905000 T 0368 + BEGIN 20906000 T 0368 + CVAL:=THISID.INFO; 20907000 T 0368 + IF CVAL>1023 THEN CVAL:=CONSTTAB[CVAL-1023]; 20908000 T 0368 + CTYPE:=THISID.TYPE; 20909000 T 0368 + IF SIGNED THEN 20910000 T 0368 + BEGIN 20911000 T 0368 + TFORM:=TYPETAB1[THISID.TYPE].FORM; 20912000 T 0368 + IF TFORM!NUMERIC AND TFORM!FLOATING THEN ERROR(29) ELSE 20913000 T 0368 + IF NEGATIVE THEN CVAL:=-CVAL; 20914000 T 0368 + END; 20915000 T 0368 + END ELSE BEGIN ERROR(48); CVAL:=CTYPE:=0 END; 20916000 T 0368 + END ELSE BEGIN ERROR(32); CVAL:=CTYPE:=0 END; 20917000 T 0368 + END ELSE BEGIN ERROR(1); CVAL:=CTYPE:=0 END; 20918000 T 0368 + END ELSE BEGIN ERROR(32); CVAL:=CTYPE:=0 END; 20919000 T 0368 + INSYMBOL; 20920000 T 0368 + END OF CONSTANT#; 20921000 T 0368 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 30001000 T 0368 + % % 30002000 T 0368 + % % 30003000 T 0368 + % % 30004000 T 0368 + % PART 3: THE SCANNER. % 30005000 T 0368 + % ------------ % 30006000 T 0368 + % % 30007000 T 0368 + % % 30008000 T 0368 + % % 30009000 T 0368 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 30010000 T 0368 + 30011000 T 0368 + % INTERNAL INTERNAL SYMBOL 30012000 T 0368 + % SYMBOL NUMBER NAME KIND 30013000 T 0368 + % 30014000 T 0368 + % IDENTIFIER 1 IDENTIFIER MIDDLE 30015000 T 0368 + % 122 2 INTCONST MIDDLE 30016000 T 0368 + % 2.5 3 REALCONST MIDDLE 30017000 T 0368 + % "ABCD" 4 ALFACONST MIDDLE 30018000 T 0368 + % "C" 5 CHARCONST MIDDLE 30019000 T 0368 + % NOT 6 NOTSY MIDDLE 30020000 T 0368 + % * 7 ASTERISK MIDDLE 30021000 T 0368 + % / 8 SLASH MIDDLE 30022000 T 0368 + % & AND 9 ANDSY MIDDLE 30023000 T 0368 + % DIV 10 DIVSY MIDDLE 30024000 T 0368 + % MOD 11 MODSY MIDDLE 30025000 T 0368 + % + 12 PLUS MIDDLE 30026000 T 0368 + % - 13 MINUS MIDDLE 30027000 T 0368 + % OR 14 ORSY MIDDLE 30028000 T 0368 + % < LSS 15 LSSSY MIDDLE 30029000 T 0368 + % <= LEQ { 16 LEQSY MIDDLE 30030000 T 0368 + % >= GEQ } 17 GEQSY MIDDLE 30031000 T 0368 + % > GTR 18 GTRSY MIDDLE 30032000 T 0368 + % <> NEQ ! 19 NEQSY MIDDLE 30033000 T 0368 + % = EQL 30 EQLSY MIDDLE 30034000 T 0368 + % IN 21 INSY MIDDLE 30035000 T 0368 + % ( 22 LPAR MIDDLE 30036000 T 0368 + % ) 23 RPAR MIDDLE 30037000 T 0368 + % [ 24 LBRACKET MIDDLE 30038000 T 0368 + % ] 25 RBRACKET MIDDLE 30039000 T 0368 + % .. 26 DOUBLEDOT MIDDLE 30040000 T 0368 + % , 27 COMMA MIDDLE 30041000 T 0368 + % ; 28 SEMICOLON TERMINAL 30042000 T 0368 + % . 29 DOT MIDDLE 30043000 T 0368 + % ~ @ 30 ARROW MIDDLE 30044000 T 0368 + % : 31 COLON MIDDLE 30045000 T 0368 + % := 32 ASSIGNSY MIDDLE 30046000 T 0368 + % BEGIN 33 BEGINSY INITIAL 30047000 T 0368 + % END 34 ENDSY TERMINAL 30048000 T 0368 + % IF 35 IFSY INITIAL 30049000 T 0368 + % THEN 36 THENSY MIDDLE 30050000 T 0368 + % ELSE 37 ELSESY TERMINAL 30051000 T 0368 + % CASE 38 CASESY INITIAL 30052000 T 0368 + % OF 39 OFSY MIDDLE 30053000 T 0368 + % REPEAT 40 REPEATSY INITIAL 30054000 T 0368 + % UNTIL 41 UNTILSY TERMINAL 30055000 T 0368 + % WHILE 42 WHILESY INITIAL 30056000 T 0368 + % DO 43 DOSY MIDDLE 30057000 T 0368 + % FOR 44 FORSY INITIAL 30058000 T 0368 + % TO 45 TOSY MIDDLE 30059000 T 0368 + % DOWNTO 46 DOWNTOSY MIDDLE 30060000 T 0368 + % GOTO 47 GOTOSY INITIAL 30061000 T 0368 + % NIL 48 NILSY MIDDLE 30062000 T 0368 + % TYPE 49 TYPESY INITIAL 30063000 T 0368 + % ARRAY 50 ARRAYSY MIDDLE 30064000 T 0368 + % RECORD 51 RECORDSY MIDDLE 30065000 T 0368 + % FILE 52 FILESY MIDDLE 30066000 T 0368 + % SET 53 SETSY MIDDLE 30067000 T 0368 + % CONST 54 CONSTSY INITIAL 30068000 T 0368 + % VAR 55 VARSY INITIAL 30069000 T 0368 + % LABEL 56 LABELSY INITIAL 30070000 T 0368 + % FUNCTION 57 FUNCSY INITIAL 30071000 T 0368 + % PROCEDURE 58 PROCSY INITIAL 30072000 T 0368 + % WITH 59 WITHSY INITIAL 30073000 T 0368 + % PROGRAM 60 PROGRAMSY INITIAL 30074000 T 0368 + % PACKED 61 PACKEDSY MIDDLE 30075000 T 0368 + 30076000 T 0368 + 30077000 T 0368 + DEFINE BLANK=48#, EQUAL=61#, QUOTES=63#, DOLLAR=42#, 30078000 T 0368 + LETTER(C)=(17{C AND C{25)OR(33{C AND C{41)OR(50{C AND C{57)#, 30079000 T 0368 + ALFANUM(C)=(LETTER(C) OR C{9)#; 30080000 T 0368 + 30081000 T 0368 + REAL CURVAL; 30082000 T 0368 + ALPHA CURNAME1,CURNAME2,C,CX; 30083000 T 0368 + INTEGER CURLENGTH,LASTCHARPOS; 30084000 T 0368 + BOOLEAN FINIS; 30085000 T 0368 + 30086000 T 0368 + DEFINE NEXTCHAR= 30087000 T 0368 + BEGIN COMMENT *** READ NEXT CHARACTER. ***; 30088000 T 0368 + IF CHARCNT=0 THEN C:=BLANK ELSE 30089000 T 0368 + BEGIN 30090000 T 0368 + REPLACE CHARPNT BY CARDPNT:CARDPNT FOR 1; 30091000 T 0368 + C:=CH[0]; CHARCNT:=CHARCNT-1; 30092000 T 0368 + END END #; 30093000 T 0368 + 30094000 T 0368 + 30095000 T 0368 + 30096000 T 0368 + PROCEDURE INSYMBOL; 30097000 T 0368 + BEGIN COMMENT *** READS THE NEXT SYMBOL. ***; 30098000 T 0368 + INTEGER SCALE,EXP; 30099000 T 0368 + START OF SEGMENT ********** 8 + BOOLEAN NEGEXP; 30100000 T 0000 + LABEL START,OVERFLOW; 30101000 T 0000 + 30102000 T 0000 + START: 30103000 T 0000 + IF C=BLANK THEN 30104000 T 0000 + BEGIN SCAN CARDPNT:CARDPNT FOR CHARCNT:CHARCNT WHILE =" "; 30105000 T 0000 + IF CHARCNT=0 THEN BEGIN NEWCARD; GO TO START END; 30106000 T 0003 + NEXTCHAR; 30107000 T 0068 + END; 30108000 T 0076 + IF LETTER(C) THEN 30109000 T 0076 + BEGIN 30110000 T 0081 + CURLENGTH:=1; CURNAME1:=C; CURNAME2:=0; 30111000 T 0082 + NEXTCHAR; 30112000 T 0084 + WHILE ALFANUM(C) AND CURLENGTH<6 DO 30113000 T 0092 + BEGIN CURNAME1:=C&CURNAME1[35:29:30]; 30114000 T 0100 + CURLENGTH:=CURLENGTH+1; NEXTCHAR; 30115000 T 0102 + END; 30116000 T 0110 + IF CURLENGTH=6 THEN 30117000 T 0111 + BEGIN 30118000 T 0112 + WHILE ALFANUM(C) AND CURLENGTH<12 DO 30119000 T 0112 + BEGIN CURNAME2:=C&CURNAME2[35:29:30]; 30120000 T 0120 + CURLENGTH:=CURLENGTH+1; NEXTCHAR; 30121000 T 0122 + END; 30122000 T 0131 + WHILE ALFANUM(C) DO NEXTCHAR; 30123000 T 0131 + END; 30124000 T 0147 + CURNAME1.NAMELENGTH:=CURLENGTH; 30125000 T 0147 + CASE CURLENGTH OF 30126000 T 0148 + BEGIN ; 30127000 T 0149 + CURSY:=IDENTIFIER; 30128000 T 0149 + CURSY:=IF CURNAME1="20000IF" THEN IFSY ELSE 30129000 T 0150 + IF CURNAME1="20000DO" THEN DOSY ELSE 30130000 T 0152 + IF CURNAME1="20000TO" THEN TOSY ELSE 30131000 T 0154 + IF CURNAME1="20000OR" THEN ORSY ELSE 30132000 T 0156 + IF CURNAME1="20000OF" THEN OFSY ELSE 30133000 T 0158 + IF CURNAME1="20000IN" THEN INSY ELSE IDENTIFIER; 30134000 T 0160 + CURSY:=IF CURNAME1="3000END" THEN ENDSY ELSE 30135000 T 0164 + IF CURNAME1="3000FOR" THEN FORSY ELSE 30136000 T 0166 + IF CURNAME1="3000DIV" THEN DIVSY ELSE 30137000 T 0168 + IF CURNAME1="3000MOD" THEN MODSY ELSE 30138000 T 0170 + IF CURNAME1="3000NIL" THEN NILSY ELSE 30139000 T 0172 + IF CURNAME1="3000AND" THEN ANDSY ELSE 30140000 T 0174 + IF CURNAME1="3000NOT" THEN NOTSY ELSE 30141000 T 0176 + IF CURNAME1="3000VAR" THEN VARSY ELSE 30142000 T 0178 + IF CURNAME1="3000SET" THEN SETSY ELSE 30143000 T 0180 + IF CURNAME1="3000LSS" THEN LSSSY ELSE 30144000 T 0182 + IF CURNAME1="3000LEQ" THEN LEQSY ELSE 30145000 T 0184 + IF CURNAME1="3000GEQ" THEN GEQSY ELSE 30146000 T 0186 + IF CURNAME1="3000GTR" THEN GTRSY ELSE 30147000 T 0188 + IF CURNAME1="3000NEQ" THEN NEQSY ELSE 30148000 T 0190 + IF CURNAME1="3000EQL" THEN EQLSY ELSE IDENTIFIER; 30149000 T 0192 + CURSY:=IF CURNAME1="400THEN" THEN THENSY ELSE 30150000 T 0195 + IF CURNAME1="400ELSE" THEN ELSESY ELSE 30151000 T 0197 + IF CURNAME1="400WITH" THEN WITHSY ELSE 30152000 T 0199 + IF CURNAME1="400CASE" THEN CASESY ELSE 30153000 T 0201 + IF CURNAME1="400GOTO" THEN GOTOSY ELSE 30154000 T 0203 + IF CURNAME1="400TYPE" THEN TYPESY ELSE 30155000 T 0205 + IF CURNAME1="400FILE" THEN FILESY ELSE IDENTIFIER; 30156000 T 0207 + CURSY:=IF CURNAME1="50BEGIN" THEN BEGINSY ELSE 30157000 T 0210 + IF CURNAME1="50WHILE" THEN WHILESY ELSE 30158000 T 0212 + IF CURNAME1="50UNTIL" THEN UNTILSY ELSE 30159000 T 0214 + IF CURNAME1="50ARRAY" THEN ARRAYSY ELSE 30160000 T 0216 + IF CURNAME1="50CONST" THEN CONSTSY ELSE 30161000 T 0218 + IF CURNAME1="50LABEL" THEN LABELSY ELSE IDENTIFIER; 30162000 T 0220 + CURSY:=IF CURNAME1="6REPEAT" THEN REPEATSY ELSE 30163000 T 0223 + IF CURNAME1="6DOWNTO" THEN DOWNTOSY ELSE 30164000 T 0225 + IF CURNAME1="6RECORD" THEN RECORDSY ELSE 30165000 T 0227 + IF CURNAME1="6PACKED" THEN PACKEDSY ELSE IDENTIFIER; 30166000 T 0229 + CURSY:=IF CURNAME1="7PROGRA" AND CURNAME2="M" THEN PROGRAMSY 30167000 T 0233 + ELSE IDENTIFIER; 30168000 T 0235 + CURSY:=IF CURNAME1="8FUNCTI" AND CURNAME2="ON" THEN FUNCSY 30169000 T 0237 + ELSE IDENTIFIER; 30170000 T 0239 + CURSY:=IF CURNAME1="9PROCED" AND CURNAME2="URE" THEN PROCSY 30171000 T 0241 + ELSE IDENTIFIER; 30172000 T 0244 + CURSY:=IDENTIFIER; % 10 CHARACTERS. 30173000 T 0245 + CURSY:=IDENTIFIER; % 11 CHARACTERS. 30174000 T 0247 + CURSY:=IDENTIFIER; % 12 CHARACTERS. 30175000 T 0248 + END OF CASE; 30176000 T 0249 + START OF SEGMENT ********** 9 + 9 IS 13 LONG, NEXT SEG 8 + IF RESWORDOPTION AND CURSY!IDENTIFIER THEN 30177000 T 0249 + BEGIN T1:=CARDLENGTH-CHARCNT-CURLENGTH; 30178000 T 0250 + IF CHARCNT=0 THEN CARDPNT:=CARDPNT+1 ELSE T1:=T1-1; 30179000 T 0296 + REPLACE XLINEPNT+T1 BY CARDPNT-(CURLENGTH+1) 30180000 T 0302 + FOR CURLENGTH; 30181000 T 0306 + END; 30182000 T 0309 + END OF LETTER ELSE 30183000 T 0309 + IF C{9 THEN 30184000 T 0309 + BEGIN 30185000 T 0311 + CURVAL:=C; CURSY:=INTCONST; 30186000 T 0311 + NEXTCHAR; 30187000 T 0313 + WHILE C{9 DO BEGIN CURVAL:=10|CURVAL+C; NEXTCHAR END; 30188000 T 0320 + IF C="." THEN 30189000 T 0331 + BEGIN 30190000 T 0332 + NEXTCHAR; 30191000 T 0332 + IF C{9 THEN 30192000 T 0340 + BEGIN CURSY:=REALCONST; 30193000 T 0341 + DO BEGIN CURVAL:=10|CURVAL+C; 30194000 T 0342 + SCALE:=SCALE-1; NEXTCHAR; 30195000 T 0344 + END UNTIL C>9; 30196000 T 0352 + END ELSE IF C="." THEN C:=64 % SPECIAL MARK FOR ".." 30197000 T 0354 + ELSE ERROR(4); 30198000 T 0356 + END; 30199000 T 0357 + IF C="E" THEN 30200000 T 0357 + BEGIN 30201000 T 0358 + CURSY:=REALCONST; NEXTCHAR; 30202000 T 0359 + IF C="+" OR C="-" THEN BEGIN NEGEXP:=C="-"; NEXTCHAR END; 30203000 T 0367 + IF C{9 THEN 30204000 T 0378 + BEGIN EXP:=C; NEXTCHAR; 30205000 T 0379 + WHILE C{9 DO BEGIN EXP:=10|EXP+C; NEXTCHAR END; 30206000 T 0387 + IF NEGEXP THEN EXP:=-EXP; 30207000 T 0398 + END ELSE ERROR(4); 30208000 T 0400 + SCALE:=SCALE+EXP; 30209000 T 0401 + END; 30210000 T 0403 + IF CURSY=REALCONST THEN 30211000 T 0403 + BEGIN 30212000 T 0403 + REALOVERFLOW:=OVERFLOW; 30213000 T 0404 + CURVAL:=CURVAL|10*SCALE; 30214000 T 0406 + REALOVERFLOW:=0; 30215000 T 0409 + END ELSE 30216000 T 0410 + IF CURVAL>MAXINT THEN 30217000 T 0410 + BEGIN 30218000 T 0411 + OVERFLOW: ERROR(14); CURVAL:=0; REALOVERFLOW:=0; 30219000 T 0411 + END; 30220000 T 0414 + END OF DIGIT ELSE 30221000 T 0414 + IF C=QUOTES THEN 30222000 T 0414 + BEGIN 30223000 T 0416 + CURSY:=ALFACONST; CURLENGTH:=0; NEXTCHAR; 30224000 T 0417 + FINIS:=FALSE; 30225000 T 0426 + DO BEGIN 30226000 T 0427 + IF C=QUOTES THEN BEGIN NEXTCHAR; FINIS:=C!QUOTES END ELSE 30227000 T 0427 + IF CHARCNT=0 THEN BEGIN ERROR(6); FINIS:=TRUE END; 30228000 T 0437 + IF NOT FINIS THEN 30229000 T 0440 + BEGIN 30230000 T 0440 + REPLACE STRINGPNT+CURLENGTH BY CHARPNT FOR 1; 30231000 T 0441 + CURLENGTH:=CURLENGTH+1; 30232000 T 0446 + NEXTCHAR; 30233000 T 0447 + END END UNTIL FINIS; 30234000 T 0454 + IF CURLENGTH=0 THEN ERROR(4) ELSE 30235000 T 0455 + IF CURLENGTH=1 THEN 30236000 T 0457 + BEGIN CURSY:=CHARCONST; 30237000 T 0458 + REPLACE CHARPNT BY STRINGPNT FOR 1; CURVAL:=CH[0]; 30238000 T 0460 + END ELSE 30239000 T 0463 + IF CURLENGTH{7 THEN 30240000 T 0463 + BEGIN TEXT[0]:=" "; 30241000 T 0465 + REPLACE TEXTPNT BY STRINGPNT FOR CURLENGTH; 30242000 T 0466 + CURVAL:=TEXT[0]; 30243000 T 0469 + END; 30244000 T 0470 + END OF STRINGS ELSE 30245000 T 0470 + BEGIN 30246000 T 0470 + CURSY:=SYMBOL[C]; NEXTCHAR; 30247000 T 0472 + IF CURSY=COLON AND C=EQUAL THEN 30248000 T 0480 + BEGIN CURSY:=ASSIGNSY; NEXTCHAR END ELSE 30249000 T 0482 + IF CURSY=DOT AND C="." THEN 30250000 T 0491 + BEGIN CURSY:=DOUBLEDOT; NEXTCHAR END ELSE 30251000 T 0493 + IF CURSY=LSSSY AND C=EQUAL THEN 30252000 T 0502 + BEGIN CURSY:=LEQSY; NEXTCHAR END ELSE 30253000 T 0504 + IF CURSY=LSSSY AND C=">" THEN 30254000 T 0513 + BEGIN CURSY:=NEQSY; NEXTCHAR END ELSE 30255000 T 0515 + IF CURSY=GTRSY AND C=EQUAL THEN 30256000 T 0524 + BEGIN CURSY:=GEQSY; NEXTCHAR END ELSE 30257000 T 0526 + IF CURSY=LPAR AND C="*" THEN 30258000 T 0535 + BEGIN % *** COMMENT *** 30259000 T 0537 + NEXTCHAR; 30260000 T 0537 + IF C=DOLLAR THEN % DOLLAR INDICATES COMPILER OPTIONS. 30261000 T 0545 + DO BEGIN 30262000 T 0546 + NEXTCHAR; CX:=C; NEXTCHAR; 30263000 T 0546 + IF CX="L" THEN IF C=1 THEN HEADING 30264000 T 0562 + ELSE LISTOPTION:=C="+" ELSE 30265000 T 0585 + IF CX="R" THEN RESWORDOPTION:=C="+" ELSE 30266000 T 0587 + IF CX="C" THEN CHECKOPTION:=C="+" ELSE 30267000 T 0590 + IF CX="D" THEN DUMPOPTION:=C="+" ELSE 30268000 T 0593 + IF CX="X" THEN XREFOPTION:=C="+" ELSE 30269000 T 0596 + IF CX="A" THEN 30270000 T 0599 + IF C="+" THEN WRITE(PASCALGOL,ALIST) 30271000 T 0600 + ELSE WRITE(PASCALGOL,NOALIST) ELSE 30272000 T 0604 + IF CX="T" THEN 30273000 T 0608 + BEGIN LASTCHARPOS := CHARCNT - CARDLENGTH; 30274000 T 0609 + CARDLENGTH:=10|C; 30275000 T 0611 + NEXTCHAR; CARDLENGTH:=CARDLENGTH+C; 30276000 T 0612 + IF CARDLENGTH{9 OR CARDLENGTH>80 THEN 30277000 T 0621 + BEGIN ERROR(14); CARDLENGTH:=72 END; 30278000 T 0623 + CHARCNT:=MAX(0,LASTCHARPOS+CARDLENGTH-1); 30279000 T 0625 + END; 30280000 T 0629 + NEXTCHAR; 30281000 T 0629 + END UNTIL C!","; 30282000 T 0636 + FINIS:=FALSE; 30283000 T 0638 + DO BEGIN 30284000 T 0638 + IF C!"*" THEN 30285000 T 0638 + SCAN CARDPNT:CARDPNT FOR CHARCNT:CHARCNT UNTIL ="*"; 30286000 T 0639 + IF CHARCNT=0 THEN NEWCARD ELSE 30287000 T 0642 + BEGIN NEXTCHAR; 30288000 T 0706 + WHILE C="*" DO NEXTCHAR; 30289000 T 0714 + FINIS:=C=")"; 30290000 T 0724 + END END UNTIL FINIS; 30291000 T 0725 + NEXTCHAR; 30292000 T 0726 + GO TO START; 30293000 T 0733 + END OF COMMENT; 30294000 T 0734 + END; 30295000 T 0734 + END OF INSYMBOL; 30296000 T 0734 + 8 IS 739 LONG, NEXT SEG 2 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 40001000 T 0368 + % % 40002000 T 0368 + % % 40003000 T 0368 + % % 40004000 T 0368 + % PART 4: EXPRESSION PARSER. % 40005000 T 0368 + % ------------------ % 40006000 T 0368 + % % 40007000 T 0368 + % % 40008000 T 0368 + % % 40009000 T 0368 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 40010000 T 0368 + 40011000 T 0368 + 40012000 T 0368 + PROCEDURE EXPRESSION; FORWARD; 40013000 T 0368 + PROCEDURE CONCAT; FORWARD; 40014000 T 0368 + 40015000 T 0368 + ALPHA TEMPSYM; 40016000 T 0368 + REAL SX; 40017000 T 0368 + INTEGER EXPRLEVEL,TX; 40018000 T 0368 + 40019000 T 0368 + DEFINE PUTTEXT(T)= 40020000 T 0368 + BEGIN 40021000 T 0368 + IF NUMSYMS=MAXSYMS THEN 40022000 T 0368 + BEGIN ERROR(71); 40023000 T 0368 + NUMSYMS:=1; 40024000 T 0368 + END ELSE NUMSYMS:=NUMSYMS+1; 40025000 T 0368 + SYMTAB[NUMSYMS]:=T; 40026000 T 0368 + END OF PUTTEXT #; 40027000 T 0368 + 40028000 T 0368 + DEFINE PUTSYM(S)= 40029000 T 0368 + BEGIN 40030000 T 0368 + TEMPSYM:=(S)&1[41:5:6]; 40031000 T 0368 + PUTTEXT(TEMPSYM); 40032000 T 0368 + END OF PUTSYM #; 40033000 T 0368 + 40034000 T 0368 + DEFINE PUTCONST(VAL)= 40035000 T 0368 + BEGIN 40036000 T 0368 + PUTTEXT("2000000"); 40037000 T 0368 + PUTTEXT(VAL); 40038000 T 0368 + END OF PUTCONST #; 40039000 T 0368 + 40040000 T 0368 + DEFINE PUTDUMMY= 40041000 T 0368 + BEGIN 40042000 T 0368 + PUTTEXT("3000000"); 40043000 T 0368 + END OF PUTDUMMY #; 40044000 T 0368 + 40045000 T 0368 + DEFINE PUTID(L,NUM,NUMDIG)= 40046000 T 0368 + BEGIN 40047000 T 0368 + TEXT[0]:=" " & L [35:5:6]; 40048000 T 0368 + REPLACE TEXTPNT+2 BY NUM FOR NUMDIG DIGITS; 40049000 T 0368 + PUTTEXT(TEXT[0]); 40050000 T 0368 + END OF PUTID#; 40051000 T 0368 + 40052000 T 0368 + DEFINE WRITEEXPR= 40053000 T 0368 + BEGIN 40054000 T 0368 + FOR T1:=1 STEP 1 UNTIL NUMSYMS DO 40055000 T 0368 + BEGIN 40056000 T 0368 + SX:=SYMTAB[T1]; TX:=SX.[41:6]; 40057000 T 0368 + IF TX=0 THEN GEN(SX,7,2) ELSE 40058000 T 0368 + IF TX=3 THEN ELSE 40059000 T 0368 + IF TX=1 THEN GEN(SX,1,7) ELSE 40060000 T 0368 + BEGIN 40061000 T 0368 + T1:=T1+1; SX:=SYMTAB[T1]; 40062000 T 0368 + IF SX.[44:6]=0 THEN GENINT(SX) ELSE GENREAL(SX); 40063000 T 0368 + END END; 40064000 T 0368 + NUMSYMS:=0; 40065000 T 0368 + END OF WRITEEXPR#; 40066000 T 0368 + 40067000 T 0368 + 40068000 T 0368 + DEFINE CHECKEXPR(LLIM,ULIM)= 40069000 T 0368 + BEGIN 40070000 T 0368 + PUTTEXT("CHECK("); 40071000 T 0368 + EXPRESSION; 40072000 T 0368 + PUTSYM(","); PUTCONST(LLIM); 40073000 T 0368 + PUTSYM(","); PUTCONST(ULIM); 40074000 T 0368 + PUTSYM(","); PUTCONST(CARDCNT); 40075000 T 0368 + PUTSYM(")"); 40076000 T 0368 + END OF CHECKEXPR#; 40077000 T 0368 + 40078000 T 0368 + 40079000 T 0368 + BOOLEAN SIMPLEVARIABLE,INSIDEBRACKETS; 40080000 T 0368 + INTEGER NUMPOINTERS; 40081000 T 0368 + 40082000 T 0368 + PROCEDURE VARIABLE; 40083000 T 0368 + BEGIN 40084000 T 0368 + INTEGER STARTSYM,LLIM,ULIM; 40085000 T 0368 + START OF SEGMENT ********** 10 + REAL T; 40086000 T 0000 + BOOLEAN INBRACKET,INRECORD; 40087000 T 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 + T4:=T.FIRSTWITHSYM; T5:=T.LASTWITHSYM; 40094000 T 0003 + FOR T3:=T4 STEP 1 UNTIL T5 DO PUTTEXT(WITHTAB[T3]); 40095000 T 0006 + INRECORD:=TRUE; 40096000 T 0015 + INBRACKET:=BOOLEAN(T.BRACKETSINWITH); 40097000 T 0016 + NUMPOINTERS:=NUMPOINTERS+T.NUMPNTRSINWITH; 40098000 T 0017 + SIMPLEVARIABLE:=FALSE; 40099000 T 0019 + CURTYPE:=T.RECTYPE; T:=TYPETAB1[CURTYPE]; 40100000 T 0019 + GO TO ADDADDR; 40101000 T 0022 + END; 40102000 T 0022 + IF THISLEVEL>1 AND THISLEVEL0 THEN BEGIN PUTSYM("-"); PUTCONST( LLIM) END; 40127000 T 0233 + PUTSYM(")"); 40128000 T 0255 + IF TYPETAB1[CURTYPE].SIZE>1 THEN 40129000 T 0263 + BEGIN PUTSYM("|"); PUTCONST(TYPETAB1[CURTYPE].SIZE) END; 40130000 T 0264 + END ELSE IF TYPETAB1[CURTYPE].STRUCT>0 THEN PUTSYM(","); 40131000 T 0286 + END UNTIL CURSY!COMMA; 40132000 T 0296 + IF CURSY!RBRACKET THEN 40133000 T 0297 + BEGIN ERROR(59); SKIP(RBRACKET); 40134000 T 0298 + IF CURSY=RBRACKET THEN INSYMBOL; 40135000 T 0300 + END ELSE INSYMBOL; 40136000 T 0302 + END OF BRACKETS ELSE 40137000 T 0303 + IF CURSY=DOT THEN 40138000 T 0303 + BEGIN 40139000 T 0304 + IF NOT(INBRACKET OR INRECORD) THEN 40140000 T 0304 + BEGIN PUTSYM("["); INBRACKET:=TRUE END; 40141000 T 0305 + T:=TYPETAB1[CURTYPE]; 40142000 T 0314 + IF T.FORM!RECORD THEN ERROR(12); 40143000 T 0315 + INSYMBOL; 40144000 T 0318 + IF CURSY=IDENTIFIER THEN 40145000 T 0318 + BEGIN 40146000 T 0319 + SEARCHTAB(T.RECTAB); 40147000 T 0319 + IF FOUND THEN 40148000 T 0339 + BEGIN 40149000 T 0340 + THISID:=NAMETAB3[T.RECTAB,THISINDEX]; 40150000 T 0340 + ADDADDR: PUTSYM("+"); 40151000 T 0342 + PUTCONST(THISID.INFO); CURTYPE:=THISID.TYPE; 40152000 T 0350 + END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40153000 T 0365 + END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40154000 T 0367 + INRECORD:=TRUE; 40155000 T 0369 + INSYMBOL; 40156000 T 0370 + END OF DOT ELSE 40157000 T 0370 + BEGIN % CURSY=ARROW 40158000 T 0370 + T:=TYPETAB1[CURTYPE]; 40159000 T 0371 + IF T.FORM=FILES THEN 40160000 T 0372 + BEGIN 40161000 T 0373 + CURTYPE:=T.FILETYPE; 40162000 T 0373 + IF TYPETAB1[CURTYPE].STRUCT=0 THEN PUTTEXT(" [0]"); 40163000 T 0375 + END ELSE 40164000 T 0382 + IF T.FORM=TEXTFILE THEN 40165000 T 0382 + BEGIN 40166000 T 0386 + SYMTAB[NUMSYMS]:=SYMTAB[NUMSYMS] & "I" [35:5:6]; 40167000 T 0386 + PUTSYM("."); PUTTEXT("LASTCH"); 40168000 T 0389 + CURTYPE:=CHARTYPE; 40169000 T 0402 + END ELSE 40170000 T 0403 + IF T.FORM=POINTERS THEN 40171000 T 0403 + BEGIN 40172000 T 0406 + IF INBRACKET THEN PUTSYM("]"); 40173000 T 0406 + INBRACKET:=FALSE; 40174000 T 0415 + IF NUMSYMS+2{MAXSYMS THEN 40175000 T 0415 + BEGIN 40176000 T 0417 + FOR T1:=NUMSYMS STEP -1 UNTIL STARTSYM DO 40177000 T 0417 + SYMTAB[T1+2]:=SYMTAB[T1]; 40178000 T 0419 + SYMTAB[STARTSYM]:=" MEM["; 40179000 T 0423 + SYMTAB[STARTSYM+1]:=" (T:="; 40180000 T 0424 + NUMSYMS:=NUMSYMS+2; NUMPOINTERS:=NUMPOINTERS+1; 40181000 T 0426 + INRECORD:=TRUE; 40182000 T 0428 + END ELSE ERROR(63); 40183000 T 0429 + CURTYPE:=T.POINTTYPE; 40184000 T 0432 + END ELSE BEGIN ERROR(12); CURTYPE:=0 END; 40185000 T 0434 + INSYMBOL; 40186000 T 0436 + END OF ARROW; 40187000 T 0436 + END UNTIL CURSY!LBRACKET AND CURSY!DOT AND CURSY!ARROW; 40188000 T 0436 + IF TYPETAB1[CURTYPE].STRUCT=0 THEN 40189000 T 0439 + BEGIN 40190000 T 0441 + IF INBRACKET THEN PUTSYM("]"); 40191000 T 0441 + WHILE NUMPOINTERS>0 DO 40192000 T 0451 + BEGIN PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); 40193000 T 0452 + PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); 40194000 T 0465 + NUMPOINTERS:=NUMPOINTERS-1; 40195000 T 0479 + END; 40196000 T 0480 + END; 40197000 T 0483 + END; 40198000 T 0483 + INSIDEBRACKETS:=INBRACKET; 40199000 T 0483 + CURMODE:=NUMBER; 40200000 T 0483 + END OF VARIABLE; 40201000 T 0484 + 10 IS 489 LONG, NEXT SEG 2 + 40202000 T 0368 + 40203000 T 0368 + PROCEDURE PASSPARAMS; 40204000 T 0368 + BEGIN 40205000 T 0368 + INTEGER NPARS,PARAM,PTYPE,P,FIRSTSYM; 40206000 T 0368 + START OF SEGMENT ********** 11 + 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 0032 + INSYMBOL; 40220000 T 0032 + IF NPARS=0 THEN BEGIN ERROR(3); SKIP(RPAR); GO TO EXIT END; 40221000 T 0033 + PARAM:=PARAMTAB[P]; P:=P+1; 40222000 T 0036 + PTYPE:=PARAM.PARAMTYPE; 40223000 T 0038 + IF PARAM.PARAMKIND=CONST THEN 40224000 T 0039 + BEGIN 40225000 T 0041 + CHECK:=CHECKOPTION AND TYPETAB1[PTYPE].FORM LEQ CHAR; 40226000 T 0041 + IF CHECK THEN PUTTEXT("CHECK("); 40227000 T 0044 + 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 0073 + BEGIN 40234000 T 0073 + PUTSYM(","); PUTCONST(TYPETAB2[PTYPE]); 40235000 T 0074 + PUTSYM(","); PUTCONST(TYPETAB3[PTYPE]); 40236000 T 0094 + PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); 40237000 T 0115 + END; 40238000 T 0144 + END ELSE 40239000 T 0144 + IF PARAM.PARAMKIND=VAR THEN 40240000 T 0144 + BEGIN 40241000 T 0145 + IF CURSY=IDENTIFIER THEN 40242000 T 0146 + BEGIN 40243000 T 0147 + SEARCH; 40244000 T 0147 + IF FOUND THEN 40245000 T 0175 + BEGIN 40246000 T 0175 + IF THISID.IDCLASS=VAR OR 40247000 T 0175 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 40248000 T 0177 + BEGIN 40249000 T 0179 + IF PARAM.PARAMFILE=1 THEN 40250000 T 0180 + BEGIN 40251000 T 0181 + CURTYPE:=THISID.TYPE; 40252000 T 0181 + PUTID("V",1000|THISLEVEL+THISINDEX,5); PUTSYM(","); 40253000 T 0183 + PUTID("F",1000|THISLEVEL+THISINDEX,5); PUTSYM(","); 40254000 T 0206 + PUTID("I",1000|THISLEVEL+THISINDEX,5); 40255000 T 0230 + INSYMBOL; 40256000 T 0246 + END ELSE 40257000 T 0247 + BEGIN 40258000 T 0247 + VARIABLE; 40259000 T 0247 + IF TYPETAB1[CURTYPE].STRUCT>0 THEN 40260000 T 0248 + IF NOT SIMPLEVARIABLE THEN ERROR(92); 40261000 T 0249 + END; 40262000 T 0252 + END ELSE BEGIN ERROR(8); CURTYPE:=0 END; 40263000 T 0252 + END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40264000 T 0254 + END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40265000 T 0256 + END ELSE 40266000 T 0258 + BEGIN 40267000 T 0258 + IF CURSY=IDENTIFIER THEN 40268000 T 0258 + BEGIN 40269000 T 0259 + SEARCH; 40270000 T 0259 + IF FOUND THEN 40271000 T 0287 + BEGIN 40272000 T 0287 + IF THISID.IDCLASS!PARAM.PARAMKIND THEN ERROR(91); 40273000 T 0288 + PUTID("V",1000|THISLEVEL+THISINDEX,5); 40274000 T 0291 + CURTYPE:=IF THISID.IDCLASS=FUNC THEN THISID.TYPE ELSE 0; 40275000 T 0306 + INSYMBOL; 40276000 T 0310 + END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40277000 T 0311 + END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40278000 T 0313 + END; 40279000 T 0315 + CHECKTYPES(PTYPE,CURTYPE); 40280000 T 0315 + NPARS:=NPARS-1; 40281000 T 0373 + IF CURSY=COMMA THEN PUTSYM(","); 40282000 T 0374 + END UNTIL CURSY!COMMA; 40283000 T 0383 + IF CURSY!RPAR THEN BEGIN ERROR(89); SKIP(RPAR) END; 40284000 T 0384 + EXIT: PUTSYM(")"); 40285000 T 0387 + IF CURSY=RPAR THEN INSYMBOL; 40286000 T 0395 + END; 40287000 T 0397 + IF NPARS>0 AND NOT FORMALPROC THEN ERROR(3); 40288000 T 0397 + CURMODE:=NUMBER; 40289000 T 0400 + END OF PASSPARAMS; 40290000 T 0401 + 11 IS 408 LONG, NEXT SEG 2 + 40291000 T 0368 + 40292000 T 0368 + PROCEDURE FACTOR; %*** FACTOR *** 40293000 T 0368 + BEGIN %************** 40294000 T 0368 + INTEGER STARTSYM,STYPE,T; 40295000 T 0368 + START OF SEGMENT ********** 12 + BOOLEAN FIRST; 40296000 T 0000 + REAL VAL; 40297000 T 0000 + 40298000 T 0000 + DEFINE PARAMETER= %*** CHECK THAT THE FUNCTION HAS 1 PARAM. 40299000 T 0000 + BEGIN 40300000 T 0000 + INSYMBOL; 40301000 T 0000 + IF CURSY=LPAR THEN 40302000 T 0000 + BEGIN 40303000 T 0000 + PUTSYM("("); INSYMBOL; EXPRESSION; 40304000 T 0000 + IF TYPETAB1[CURTYPE].FORM=NUMERIC THEN CURTYPE:=INTTYPE; 40305000 T 0000 + IF CURSY!RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; 40306000 T 0000 + PUTSYM(")"); IF CURSY=RPAR THEN INSYMBOL; 40307000 T 0000 + END ELSE ERROR(3); 40308000 T 0000 + END OF PARAMETER#; 40309000 T 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 0029 + BEGIN 40316000 T 0029 + IF THISID.IDCLASS=VAR OR 40317000 T 0030 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) 40318000 T 0031 + THEN VARIABLE ELSE 40319000 T 0032 + IF THISID.IDCLASS=CONST THEN 40320000 T 0035 + BEGIN 40321000 T 0036 + IF THISID.INFO{1023 THEN PUTCONST(THISID.INFO) 40322000 T 0037 + ELSE PUTCONST(CONSTTAB[THISID.INFO-1023]); 40323000 T 0038 + CURTYPE:=THISID.TYPE; CURMODE:=NUMBER; 40324000 T 0066 + INSYMBOL; 40325000 T 0068 + END ELSE 40326000 T 0069 + IF THISID.IDCLASS=FUNC THEN 40327000 T 0069 + BEGIN 40328000 T 0071 + IF THISTAB=0 THEN %*** INTRINSIC FUNCTION *** 40329000 T 0071 + BEGIN 40330000 T 0072 + INTEGER DUMMY; 40350000 T 0072 + START OF SEGMENT ********** 13 + IF CURNAME1="3000ABS" THEN % "ABS" 40351000 T 0000 + BEGIN 40352000 T 0000 + PUTTEXT(" ABS"); PARAMETER; 40353000 T 0001 + IF CURTYPE!REALTYPE AND CURTYPE!INTTYPE THEN ERROR(67); 40354000 T 0036 + END ELSE 40355000 T 0039 + IF CURNAME1="3000CHR" THEN % "CHR" 40356000 T 0039 + BEGIN 40357000 T 0040 + INSYMBOL; 40358000 T 0041 + IF CURSY=LPAR THEN 40359000 T 0041 + BEGIN INSYMBOL; CHECKEXPR(0,63); 40360000 T 0042 + IF TYPETAB1[CURTYPE].FORM!NUMERIC THEN ERROR(67); 40361000 T 0120 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40362000 T 0122 + IF CURSY=RPAR THEN INSYMBOL; 40363000 T 0125 + END ELSE ERROR(58); 40364000 T 0127 + CURTYPE:=CHARTYPE; 40365000 T 0128 + END ELSE 40366000 T 0129 + IF CURNAME1="3000EOF" OR % "EOF"/"EOLN" 40367000 T 0129 + CURNAME1="400EOLN" THEN 40368000 T 0130 + BEGIN 40369000 T 0131 + FIRST:=CURNAME1="3000EOF"; 40370000 T 0132 + FILEPARAM(INPUTFILE); 40371000 T 0133 + PUTID("I",FILENAME,5); 40372000 T 0185 + PUTTEXT(IF FIRST THEN " .EOF" ELSE " .EOLN"); 40373000 T 0200 + IF LPARFOUND THEN 40374000 T 0208 + BEGIN 40375000 T 0208 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40376000 T 0208 + IF CURSY=RPAR THEN INSYMBOL; 40377000 T 0211 + END; 40378000 T 0213 + CURTYPE:=BOOLTYPE; 40379000 T 0213 + END ELSE 40380000 T 0214 + IF CURNAME1="3000ODD" THEN % "ODD" 40381000 T 0214 + BEGIN 40382000 T 0217 + PUTTEXT(" ODD"); PARAMETER; 40383000 T 0218 + IF CURTYPE!INTTYPE THEN ERROR(67); 40384000 T 0253 + CURTYPE:=BOOLTYPE; CURMODE:=BITPATTERN; 40385000 T 0255 + END ELSE 40386000 T 0257 + IF CURNAME1="3000ORD" THEN % "ORD" 40387000 T 0257 + BEGIN 40388000 T 0258 + PUTSYM("("); INSYMBOL; 40389000 T 0258 + IF CURSY=LPAR THEN 40390000 T 0268 + BEGIN 40391000 T 0268 + INSYMBOL; EXPRESSION; 40392000 T 0269 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(67); 40393000 T 0270 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40394000 T 0273 + INSYMBOL; 40395000 T 0275 + END ELSE ERROR(58); 40396000 T 0276 + CURTYPE:=INTTYPE; PUTSYM(")"); 40397000 T 0277 + END ELSE 40398000 T 0285 + IF CURNAME1="400PRED" OR % "PRED"/"SUCC" 40399000 T 0285 + CURNAME1="400SUCC" THEN 40400000 T 0287 + BEGIN 40401000 T 0288 + FIRST:=CURNAME1="400PRED"; 40402000 T 0288 + PUTTEXT("CHECK("); INSYMBOL; 40403000 T 0289 + IF CURSY=LPAR THEN 40404000 T 0298 + BEGIN 40405000 T 0298 + INSYMBOL; EXPRESSION; 40406000 T 0299 + PUTSYM(IF FIRST THEN "-" ELSE "+"); PUTSYM("1"); 40407000 T 0300 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(67); 40408000 T 0318 + PUTSYM(","); PUTCONST(TYPETAB2[CURTYPE]); 40409000 T 0320 + PUTSYM(","); PUTCONST(TYPETAB3[CURTYPE]); 40410000 T 0341 + PUTSYM(","); PUTCONST(CARDCNT); 40411000 T 0362 + PUTSYM(")"); 40412000 T 0383 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40413000 T 0391 + IF CURSY=RPAR THEN INSYMBOL; 40414000 T 0393 + END ELSE BEGIN ERROR(58); CURTYPE:=0 END; 40415000 T 0395 + END ELSE 40416000 T 0397 + IF CURNAME1="50ROUND" THEN % "ROUND" 40417000 T 0397 + BEGIN 40418000 T 0398 + PUTTEXT(" ROUND"); PARAMETER; 40419000 T 0399 + IF CURTYPE!REALTYPE THEN ERROR(67); 40420000 T 0434 + NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40421000 T 0436 + PUTCONST(CARDCNT); PUTSYM(")"); 40422000 T 0445 + CURTYPE:=INTTYPE; 40423000 T 0466 + END ELSE 40424000 T 0466 + IF CURNAME1="3000SQR" THEN % "SQR" 40425000 T 0466 + BEGIN 40426000 T 0468 + PUTTEXT(" SQR"); PARAMETER; 40427000 T 0468 + NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40428000 T 0503 + PUTCONST(CARDCNT); PUTSYM(")"); 40429000 T 0512 + IF CURTYPE!REALTYPE AND CURTYPE!INTTYPE THEN ERROR(67); 40430000 T 0533 + END ELSE 40431000 T 0536 + IF CURNAME1="50TRUNC" THEN % "TRUNC" 40432000 T 0536 + BEGIN 40433000 T 0537 + PUTTEXT(" TRUNC"); PARAMETER; 40434000 T 0537 + NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40435000 T 0572 + PUTCONST(CARDCNT); PUTSYM(")"); 40436000 T 0581 + IF CURTYPE!REALTYPE THEN ERROR(67); 40437000 T 0602 + CURTYPE:=INTTYPE; 40438000 T 0604 + END ELSE 40439000 T 0604 + IF CURNAME1="6CONCAT" THEN % "CONCAT" 40440000 T 0604 + CONCAT ELSE 40441000 T 0606 + IF CURNAME1="400TIME" THEN % "TIME" 40442000 T 0607 + BEGIN 40443000 T 0609 + PUTTEXT("(TIME("); PUTTEXT("1)/60"); 40444000 T 0610 + CURTYPE:=REALTYPE; INSYMBOL 40445000 T 0624 + END ELSE 40446000 T 0625 + IF CURNAME1="400DATE" THEN % "DATE" 40447000 T 0625 + BEGIN 40448000 T 0628 + PUTTEXT("CURDAT"); 40449000 T 0629 + CURTYPE:=ALFATYPE; INSYMBOL; 40450000 T 0636 + END ELSE 40451000 T 0637 + IF CURNAME1="7ELAPSE" AND CURNAME2="D" THEN % "ELAPSED" 40452000 T 0637 + BEGIN 40453000 T 0641 + PUTTEXT("(TIME("); PUTTEXT("2)/60)"); 40454000 T 0642 + CURTYPE:=REALTYPE; INSYMBOL; 40455000 T 0656 + END ELSE 40456000 T 0657 + IF CURNAME1="6IOTIME" THEN % "IOTIME" 40457000 T 0657 + BEGIN 40458000 T 0660 + PUTTEXT("(TIME("); PUTTEXT("3)/60)"); 40459000 T 0661 + CURTYPE:=REALTYPE; INSYMBOL; 40460000 T 0675 + END ELSE 40461000 T 0676 + IF CURNAME1="7WEEKDA" AND CURNAME2="Y" THEN % "WEEKDAY" 40462000 T 0676 + BEGIN 40463000 T 0680 + PUTTEXT("WEEKDA"); 40464000 T 0681 + CURTYPE:=ALFATYPE; INSYMBOL; 40465000 T 0688 + END ELSE IF CURNAME1="400USER" THEN % "USER" 40466000 T 0689 + BEGIN 40467000 T 0692 + PUTTEXT(" TIME"); PUTTEXT(" (-1)"); 40468000 T 0693 + CURTYPE:=ALFATYPE; INSYMBOL; 40469000 T 0707 + END ELSE % "SIN","COS" ETC. 40470000 T 0708 + BEGIN 40471000 T 0708 + PUTTEXT(IF CURNAME1="3000SIN" THEN " SIN" ELSE 40472000 T 0711 + IF CURNAME1="3000COS" THEN " COS" ELSE 40473000 T 0711 + IF CURNAME1="6ARCTAN" THEN "ARCTAN" ELSE 40474000 T 0711 + IF CURNAME1="400SQRT" THEN " SQRT" ELSE 40475000 T 0711 + IF CURNAME1="3000EXP" THEN " EXP" ELSE 40476000 T 0711 + " LN"); 40477000 T 0711 + PARAMETER; 40478000 T 0726 + IF CURTYPE!REALTYPE AND CURTYPE!INTTYPE THEN ERROR(67); 40479000 T 0764 + CURTYPE:=REALTYPE; 40480000 T 0767 + END; 40481000 T 0768 + END OF INTRINSIC FUNCTIONS ELSE 40482000 T 0768 + 13 IS 783 LONG, NEXT SEG 12 + BEGIN 40483000 T 0074 + T:=THISID.TYPE; 40484000 T 0074 + PASSPARAMS; 40485000 T 0075 + CURTYPE:=T; 40486000 T 0076 + END; 40487000 T 0077 + END OF FUNCTIONS ELSE 40488000 T 0077 + IF THISID.IDCLASS=PROC THEN 40489000 T 0077 + BEGIN 40490000 T 0078 + ERROR(68); PASSPARAMS; 40491000 T 0079 + CURTYPE:=0; 40492000 T 0080 + END ELSE BEGIN ERROR(69); CURTYPE:=0; INSYMBOL END; 40493000 T 0081 + END ELSE BEGIN ERROR(1); CURTYPE:=0; INSYMBOL END; 40494000 T 0083 + END OF IDENTIFIER ELSE 40495000 T 0086 + IF CURSY{CHARCONST THEN 40496000 T 0086 + BEGIN 40497000 T 0087 + CONSTANT(VAL,CURTYPE); PUTCONST(VAL); 40498000 T 0088 + END ELSE 40499000 T 0187 + IF CURSY=NOTSY THEN 40500000 T 0187 + BEGIN 40501000 T 0188 + PUTTEXT(" NOT "); PUTDUMMY; STARTSYM:=NUMSYMS; 40502000 T 0189 + INSYMBOL; FACTOR; 40503000 T 0203 + IF CURTYPE>0 THEN 40504000 T 0204 + IF CURTYPE!BOOLTYPE THEN BEGIN ERROR(17); CURTYPE:=0 END; 40505000 T 0205 + IF CURMODE=NUMBER THEN 40506000 T 0208 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")"); 40507000 T 0209 + CURMODE:=BITPATTERN; 40508000 T 0220 + END; 40509000 T 0221 + END ELSE 40510000 T 0221 + IF CURSY=NILSY THEN 40511000 T 0221 + BEGIN 40512000 T 0222 + PUTCONST(0); CURTYPE:=NILTYPE; 40513000 T 0223 + INSYMBOL; 40514000 T 0236 + END ELSE 40515000 T 0236 + IF CURSY=LPAR THEN 40516000 T 0236 + BEGIN 40517000 T 0238 + PUTSYM("("); 40518000 T 0238 + INSYMBOL; EXPRESSION; 40519000 T 0246 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40520000 T 0247 + PUTSYM(")"); 40521000 T 0249 + INSYMBOL; 40522000 T 0257 + END ELSE 40523000 T 0257 + IF CURSY=LBRACKET THEN %*** SET CONSTANT *** 40524000 T 0257 + BEGIN 40525000 T 0259 + INSYMBOL; 40526000 T 0259 + IF CURSY=RBRACKET THEN 40527000 T 0260 + BEGIN 40528000 T 0260 + PUTCONST(0); CURTYPE:=EMPTYSET; CURMODE:=NUMBER; 40529000 T 0261 + INSYMBOL; 40530000 T 0276 + END ELSE 40531000 T 0276 + BEGIN 40532000 T 0276 + FIRST:=TRUE; 40533000 T 0277 + DO BEGIN 40534000 T 0277 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 40535000 T 0277 + PUTTEXT(" BIT("); STARTSYM:=NUMSYMS; 40536000 T 0280 + EXPRESSION; 40537000 T 0286 + IF STYPE=0 THEN 40538000 T 0287 + BEGIN STYPE:=CURTYPE; 40539000 T 0288 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(72); 40540000 T 0289 + END ELSE CHECKTYPES(STYPE,CURTYPE); 40541000 T 0292 + IF CURSY=DOUBLEDOT THEN 40542000 T 0352 + BEGIN 40543000 T 0352 + PUTSYM(","); SYMTAB[STARTSYM]:=" BITS("; 40544000 T 0353 + INSYMBOL; EXPRESSION; 40545000 T 0362 + IF STYPE=0 THEN 40546000 T 0363 + BEGIN STYPE:=CURTYPE; 40547000 T 0363 + IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(72); 40548000 T 0365 + END ELSE CHECKTYPES(STYPE,CURTYPE); 40549000 T 0367 + END; 40550000 T 0428 + PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); 40551000 T 0428 + IF CURSY=COMMA THEN PUTTEXT(" OR"); 40552000 T 0456 + END UNTIL CURSY!COMMA; 40553000 T 0463 + IF CURSY!RBRACKET THEN 40554000 T 0464 + BEGIN ERROR(59); SKIP(RBRACKET); 40555000 T 0465 + IF CURSY=RBRACKET THEN INSYMBOL; 40556000 T 0467 + END ELSE INSYMBOL; 40557000 T 0468 + NEWTYPE; T1:=SET; T1.SIZE:=1; T1.STRUCT:=0; 40558000 T 0471 + T1.SETTYPE:=STYPE; TYPETAB1[TYPEINDEX]:=T1; 40559000 T 0480 + CURTYPE:=TYPEINDEX; 40560000 T 0483 + CURMODE:=BITPATTERN; 40561000 T 0484 + END; 40562000 T 0485 + END OF SET CONSTANT ELSE BEGIN ERROR(99); INSYMBOL END; 40563000 T 0485 + END OF FACTOR; 40564000 T 0487 + 12 IS 493 LONG, NEXT SEG 2 + 40565000 T 0368 + 40566000 T 0368 + PROCEDURE TERM; %*** TERM *** 40567000 T 0368 + BEGIN %************ 40568000 T 0368 + INTEGER STARTSYM,MODE,TYPE1,MULOPTR,F; 40569000 T 0368 + START OF SEGMENT ********** 14 + 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 0014 + MODE:=NUMBER; 40579000 T 0015 + IF CURSY=ASTERISK THEN PUTSYM("|") ELSE 40580000 T 0016 + IF CURSY=SLASH THEN PUTSYM("/") ELSE 40581000 T 0026 + IF CURSY=ANDSY THEN ERROR(64) ELSE 40582000 T 0035 + BEGIN 40583000 T 0038 + IF F=FLOATING THEN ERROR(64); 40584000 T 0038 + IF CURSY=DIVSY THEN PUTTEXT(" DIV") ELSE PUTTEXT(" MOD"); 40585000 T 0040 + END END ELSE 40586000 T 0055 + IF CURTYPE=BOOLTYPE OR F=SET THEN 40587000 T 0055 + BEGIN 40588000 T 0059 + MODE:=BITPATTERN; 40589000 T 0060 + IF CURMODE!MODE THEN 40590000 T 0061 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40591000 T 0061 + PUTTEXT(" AND "); 40592000 T 0072 + IF CURSY!(IF F=SET THEN ASTERISK ELSE ANDSY) THEN ERROR(64); 40593000 T 0078 + END ELSE ERROR(64); 40594000 T 0082 + PUTDUMMY; STARTSYM:=NUMSYMS; 40595000 T 0084 + INSYMBOL; FACTOR; 40596000 T 0091 + IF CURTYPE>0 AND TYPE1>0 THEN 40597000 T 0092 + BEGIN 40598000 T 0094 + IF CURTYPE!TYPE1 THEN 40599000 T 0094 + BEGIN 40600000 T 0095 + IF TYPETAB1[TYPE1].FORM!NUMERIC OR CURTYPE!REALTYPE THEN 40601000 T 0095 + CHECKTYPES(TYPE1,CURTYPE); 40602000 T 0098 + IF TYPE1=REALTYPE THEN CURTYPE:=REALTYPE; 40603000 T 0158 + END; 40604000 T 0160 + IF CURTYPE=REALTYPE AND MULOPTR}DIVSY THEN ERROR(65); 40605000 T 0160 + END; 40606000 T 0163 + IF MULOPTR=SLASH THEN CURTYPE:=REALTYPE; 40607000 T 0163 + IF CURTYPE=0 THEN CURTYPE:=TYPE1; 40608000 T 0165 + END OF WHILE LOOP; 40609000 T 0167 + IF MODE=BITPATTERN AND CURMODE!MODE THEN 40610000 T 0167 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40611000 T 0169 + CURMODE:=MODE; 40612000 T 0179 + END OF TERM; 40613000 T 0180 + 14 IS 184 LONG, NEXT SEG 2 + 40614000 T 0368 + 40615000 T 0368 + PROCEDURE SIMPLEEXPRESSION; %*** SIMPLE EXPRESSION *** 40616000 T 0368 + BEGIN %************************* 40617000 T 0368 + INTEGER STARTSYM,MODE,TYPE1,F; 40618000 T 0368 + START OF SEGMENT ********** 15 + BOOLEAN SIGNED; 40619000 T 0000 + 40620000 T 0000 + PUTDUMMY; STARTSYM:=NUMSYMS; 40621000 T 0000 + IF CURSY=PLUS OR CURSY=MINUS THEN 40622000 T 0006 + BEGIN SIGNED:=TRUE; 40623000 T 0008 + PUTSYM(IF CURSY=PLUS THEN"+" ELSE "-"); 40624000 T 0009 + 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 0029 + TYPE1:=CURTYPE; F:=TYPETAB1[TYPE1].FORM; 40635000 T 0029 + IF F=NUMERIC OR F=FLOATING THEN 40636000 T 0032 + BEGIN MODE:=NUMBER; 40637000 T 0033 + IF CURSY=PLUS THEN PUTSYM("+") ELSE 40638000 T 0035 + IF CURSY=MINUS THEN PUTSYM("-") ELSE ERROR(64); 40639000 T 0043 + END ELSE 40640000 T 0054 + IF CURTYPE=BOOLTYPE THEN 40641000 T 0054 + BEGIN 40642000 T 0055 + MODE:=BITPATTERN; 40643000 T 0056 + IF CURMODE!MODE THEN 40644000 T 0056 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40645000 T 0057 + IF CURSY=ORSY THEN PUTTEXT(" OR") ELSE ERROR(64); 40646000 T 0068 + END ELSE 40647000 T 0077 + IF F=SET THEN 40648000 T 0077 + BEGIN 40649000 T 0079 + MODE:=BITPATTERN; 40650000 T 0079 + IF CURMODE!MODE THEN 40651000 T 0080 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")"); END; 40652000 T 0081 + IF CURSY=PLUS THEN PUTTEXT(" OR") ELSE 40653000 T 0091 + IF CURSY=MINUS THEN BEGIN PUTTEXT(" AND");PUTTEXT(" NOT ")END 40654000 T 0098 + ELSE ERROR(64); 40655000 T 0114 + END ELSE ERROR(64); 40656000 T 0116 + INSYMBOL; 40657000 T 0118 + PUTDUMMY; STARTSYM:=NUMSYMS; 40658000 T 0118 + TERM; 40659000 T 0125 + IF CURTYPE>0 AND TYPE1>0 THEN 40660000 T 0125 + BEGIN 40661000 T 0127 + IF CURTYPE!TYPE1 THEN 40662000 T 0127 + BEGIN 40663000 T 0128 + IF TYPETAB1[TYPE1].FORM!NUMERIC OR CURTYPE!REALTYPE THEN 40664000 T 0129 + CHECKTYPES(TYPE1,CURTYPE); 40665000 T 0131 + IF TYPE1=REALTYPE THEN CURTYPE:=REALTYPE; 40666000 T 0191 + END END; 40667000 T 0193 + IF CURTYPE=0 THEN CURTYPE:=TYPE1; 40668000 T 0193 + END OF WHILE LOOP; 40669000 T 0195 + IF MODE=BITPATTERN AND CURMODE!BITPATTERN THEN 40670000 T 0195 + BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40671000 T 0197 + CURMODE:=MODE; 40672000 T 0207 + END OF SIMPLEEXPRESSION; 40673000 T 0208 + 15 IS 212 LONG, NEXT SEG 2 + 40674000 T 0368 + 40675000 T 0368 + PROCEDURE EXPRESSION; %*** EXPRESSION *** 40676000 T 0368 + BEGIN %****************** 40677000 T 0368 + INTEGER STARTSYM,FIRSTSYM,TYPE1,RELOPTR,F; 40678000 T 0368 + START OF SEGMENT ********** 16 + 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 + PUTDUMMY; 40688000 T 0017 + SIMPLEEXPRESSION; 40689000 T 0024 + IF CURSY}LSSSY AND CURSY{INSY THEN % "<","{","}",">","=","!","IN" 40690000 T 0025 + BEGIN 40691000 T 0026 + TYPE1:=CURTYPE; F:=TYPETAB1[TYPE1].FORM; 40692000 T 0027 + RELOPTR:=CURSY; 40693000 T 0029 + IF F{ALFA THEN 40694000 T 0030 + BEGIN 40695000 T 0031 + IF CURMODE=BITPATTERN THEN 40696000 T 0031 + BEGIN SYMTAB[STARTSYM]:=" REAL("; PUTSYM(")") END; 40697000 T 0032 + IF CURSY=LSSSY THEN PUTSYM("<") ELSE 40698000 T 0043 + IF CURSY=LEQSY THEN PUTSYM("{") ELSE 40699000 T 0052 + IF CURSY=GEQSY THEN PUTSYM("}") ELSE 40700000 T 0061 + IF CURSY=GTRSY THEN PUTSYM(">") ELSE 40701000 T 0070 + IF CURSY=EQLSY THEN PUTSYM("=") ELSE 40702000 T 0080 + IF CURSY=NEQSY THEN PUTSYM("!") ELSE 40703000 T 0089 + BEGIN 40704000 T 0098 + IF F}FLOATING THEN ERROR(64); 40705000 T 0099 + SYMTAB[STARTSYM]:="INTST("; PUTSYM(","); CALLGEN:=TRUE; 40706000 T 0101 + END; 40707000 T 0112 + END ELSE 40708000 T 0112 + IF F=SET THEN 40709000 T 0112 + BEGIN 40710000 T 0113 + IF CURMODE=BITPATTERN THEN 40711000 T 0114 + BEGIN SYMTAB[STARTSYM+1]:=" REAL("; PUTSYM(")") END; 40712000 T 0114 + IF CURSY=EQLSY OR CURSY=NEQSY THEN 40713000 T 0125 + BEGIN PUTSYM(IF CURSY=EQLSY THEN "=" ELSE "!"); 40714000 T 0127 + END ELSE 40715000 T 0137 + BEGIN 40716000 T 0137 + IF CURSY=LEQSY THEN SYMTAB[STARTSYM]:="INCL1(" ELSE 40717000 T 0137 + IF CURSY=GEQSY THEN SYMTAB[STARTSYM]:="INCL2(" ELSE ERROR(64); 40718000 T 0140 + PUTSYM(","); CALLGEN:=TRUE; 40719000 T 0146 + END END ELSE 40720000 T 0155 + IF F=POINTERS THEN 40721000 T 0155 + BEGIN 40722000 T 0156 + IF CURSY=EQLSY THEN PUTSYM("=") ELSE 40723000 T 0156 + IF CURSY=NEQSY THEN PUTSYM("!") ELSE ERROR(64); 40724000 T 0165 + END ELSE ERROR(64); 40725000 T 0176 + INSYMBOL; 40726000 T 0177 + PUTDUMMY; STARTSYM:=NUMSYMS; 40727000 T 0177 + SIMPLEEXPRESSION; 40728000 T 0184 + IF CURTYPE>0 AND TYPE1>0 THEN 40729000 T 0184 + IF CURTYPE!TYPE1 THEN 40730000 T 0186 + IF RELOPTR!INSY THEN 40731000 T 0187 + BEGIN 40732000 T 0189 + IF TYPETAB1[TYPE1].FORM!NUMERIC OR CURTYPE!REALTYPE THEN 40733000 T 0189 + CHECKTYPES(TYPE1,CURTYPE); 40734000 T 0192 + END ELSE 40735000 T 0252 + IF TYPETAB1[CURTYPE].FORM!SET THEN ERROR(66) 40736000 T 0252 + ELSE CHECKTYPES(TYPE1,TYPETAB1[CURTYPE].SETTYPE); 40737000 T 0254 + IF CURMODE=BITPATTERN THEN 40738000 T 0316 + BEGIN SYMTAB[STARTSYM]:=" REAL("; PUTSYM(")") END; 40739000 T 0316 + IF CALLGEN THEN PUTSYM(")"); 40740000 T 0327 + CURTYPE:=BOOLTYPE; CURMODE:=BITPATTERN; 40741000 T 0335 + END; 40742000 T 0337 + EXPRLEVEL:=EXPRLEVEL-1; 40743000 T 0337 + IF EXPRLEVEL=0 THEN 40744000 T 0339 + BEGIN 40745000 T 0340 + IF CURMODE=BITPATTERN THEN 40746000 T 0340 + BEGIN 40747000 T 0341 + SYMTAB[FIRSTSYM] := " REAL("; 40748000 T 0341 + PUTSYM(")"); 40749000 T 0343 + END; 40750000 T 0351 + WRITEEXPR; 40751000 T 0351 + END; 40752000 T 0429 + END OF EXPRESSION; 40753000 T 0429 + 16 IS 436 LONG, NEXT SEG 2 + 40754000 T 0368 + 40755000 T 0368 + DEFINE BOOLEXPR= 40756000 T 0368 + BEGIN 40757000 T 0368 + PUTDUMMY; EXPRLEVEL:=1; EXPRESSION; 40758000 T 0368 + IF CURTYPE>0 THEN IF CURTYPE!BOOLTYPE THEN ERROR(17); 40759000 T 0368 + IF CURMODE!BITPATTERN THEN 40760000 T 0368 + BEGIN SYMTAB[1]:=" B("; PUTSYM(")") END; 40761000 T 0368 + EXPRLEVEL:=0; WRITEEXPR; 40762000 T 0368 + END OF BOOLEAN#; 40763000 T 0368 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50001000 T 0368 + % % 50002000 T 0368 + % % 50003000 T 0368 + % % 50004000 T 0368 + % PART 5: INTRINSIC ROUTINES. % 50005000 T 0368 + % ------------------- % 50006000 T 0368 + % % 50007000 T 0368 + % % 50008000 T 0368 + % % 50009000 T 0368 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50010000 T 0368 + 50011000 T 0368 + 50012000 T 0368 + PROCEDURE CONCAT; %*** "CONCAT" *** 50013000 T 0368 + BEGIN %**************** 50014000 T 0368 + DEFINE INTEXPR= 50015000 T 0368 + START OF SEGMENT ********** 17 + 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 0014 + IF CURSY=LPAR THEN 50023000 T 0015 + BEGIN 50024000 T 0015 + INSYMBOL; EXPRESSION; 50025000 T 0016 + IF CURTYPE>0 THEN 50026000 T 0017 + IF TYPETAB1[CURTYPE].FORM>ALFA THEN ERROR(17); 50027000 T 0018 + IF CURSY=COMMA THEN 50028000 T 0021 + BEGIN 50029000 T 0022 + PUTSYM(","); INSYMBOL; EXPRESSION; 50030000 T 0022 + IF CURTYPE>0 THEN 50031000 T 0031 + IF TYPETAB1[CURTYPE].FORM>ALFA THEN ERROR(17); 50032000 T 0031 + IF CURSY=COMMA THEN 50033000 T 0035 + BEGIN 50034000 T 0035 + PUTSYM(","); INTEXPR; 50035000 T 0036 + IF CURSY=COMMA THEN 50036000 T 0048 + BEGIN 50037000 T 0049 + PUTSYM(","); INTEXPR; 50038000 T 0050 + IF CURSY=COMMA THEN 50039000 T 0062 + BEGIN 50040000 T 0063 + PUTSYM(","); INTEXPR; 50041000 T 0063 + PUTSYM(","); PUTCONST(CARDCNT); 50042000 T 0076 + PUTSYM(")"); 50043000 T 0096 + IF CURSY!RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; 50044000 T 0104 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50045000 T 0106 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50046000 T 0108 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50047000 T 0110 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50048000 T 0112 + END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50049000 T 0114 + CURTYPE:=REALTYPE; 50050000 T 0116 + IF CURSY=RPAR THEN INSYMBOL; 50051000 T 0117 + END OF CONCAT; 50052000 T 0119 + 17 IS 120 LONG, NEXT SEG 2 + 50053000 T 0368 + 50054000 T 0368 + PROCEDURE PREAD(CHANGELINE); 50055000 T 0368 + VALUE CHANGELINE; BOOLEAN CHANGELINE; 50056000 T 0368 + BEGIN 50057000 T 0368 + INTEGER FILEID,F; 50058000 T 0368 + START OF SEGMENT ********** 18 + BOOLEAN CHECK; 50059000 T 0000 + GEN(" BEGIN",7,2); 50060000 T 0000 + FILEPARAM(INPUTFILE); FILEID:=FILENAME; 50061000 T 0009 + IF TYPETAB1[CURTYPE].FORM=FILES THEN ERROR(85); 50062000 T 0061 + IF SYMKIND[CURSY]!TERMINAL THEN 50063000 T 0064 + BEGIN 50064000 T 0065 + IF CURSY NEQ RPAR THEN 50065000 T 0065 + DO BEGIN 50066000 T 0066 + WHILE CURSY=COMMA DO INSYMBOL; 50067000 T 0066 + IF CURSY=IDENTIFIER THEN 50068000 T 0069 + BEGIN 50069000 T 0069 + SEARCH; 50070000 T 0070 + IF FOUND THEN 50071000 T 0097 + BEGIN 50072000 T 0098 + IF THISID.IDCLASS=VAR OR 50073000 T 0098 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 50074000 T 0099 + BEGIN 50075000 T 0102 + VARIABLE; F:=TYPETAB1[CURTYPE].FORM; 50076000 T 0102 + IF F=NUMERIC OR F=FLOATING OR F=CHAR THEN 50077000 T 0104 + BEGIN 50078000 T 0107 + CHECK:=CHECKOPTION AND F!FLOATING; 50079000 T 0108 + WRITEEXPR; GEN(":=",2,6); 50080000 T 0109 + IF CHECK THEN GEN("CHECK(",6,2); 50081000 T 0196 + GEN("PREAD(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 50082000 T 0205 + GENID("V",FILEID,5); GEN(",",1,7); 50083000 T 0235 + GENID("I",FILEID,5); GEN(",",1,7); 50084000 T 0255 + IF F=NUMERIC THEN GENINT(2) ELSE 50085000 T 0276 + IF F=FLOATING THEN GENINT(3) ELSE GENINT(1); 50086000 T 0322 + GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50087000 T 0409 + IF CHECK THEN 50088000 T 0469 + BEGIN 50089000 T 0470 + GEN(",",1,7); GENINT(TYPETAB2[CURTYPE]); GEN(",",1,7); 50090000 T 0470 + GENINT(TYPETAB3[CURTYPE]); GEN(",",1,7); 50091000 T 0530 + GENINT(CARDCNT); GEN(")",1,7); 50092000 T 0582 + END; 50093000 T 0633 + END ELSE BEGIN ERROR(82); INSYMBOL END; 50094000 T 0633 + END ELSE BEGIN ERROR(8); INSYMBOL END; 50095000 T 0636 + END ELSE BEGIN ERROR(1); INSYMBOL END; 50096000 T 0639 + END ELSE ERROR(9); 50097000 T 0642 + GEN(";",1,7); 50098000 T 0644 + END UNTIL CURSY!COMMA; 50099000 T 0653 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50100000 T 0655 + IF CURSY=RPAR THEN INSYMBOL; 50101000 T 0657 + END; 50102000 T 0659 + IF CHANGELINE THEN 50103000 T 0659 + BEGIN 50104000 T 0659 + GEN("RLINE(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 50105000 T 0660 + GENID("V",FILEID,5); GEN(",",1,7); 50106000 T 0689 + GENID("I",FILEID,5); GEN(")",1,7); 50107000 T 0710 + END; 50108000 T 0730 + GEN("END",4,5); 50109000 T 0730 + END OF PREAD; 50110000 T 0739 + 18 IS 756 LONG, NEXT SEG 2 + 50111000 T 0368 + 50112000 T 0368 + PROCEDURE PWRITE(LINEFEED); 50113000 T 0368 + VALUE LINEFEED; BOOLEAN LINEFEED; 50114000 T 0368 + BEGIN 50115000 T 0368 + INTEGER FILEID,F,I,LASTSY; 50116000 T 0368 + START OF SEGMENT ********** 19 + POINTER P; 50117000 T 0000 + GEN(" BEGIN",7,2); 50118000 T 0000 + FILEPARAM(OUTPUTFILE); FILEID:=FILENAME; 50119000 T 0009 + IF TYPETAB1[CURTYPE].FORM=FILES THEN ERROR(85); 50120000 T 0061 + IF SYMKIND[CURSY]!TERMINAL THEN 50121000 T 0064 + BEGIN 50122000 T 0065 + IF CURSY NEQ RPAR THEN 50123000 T 0065 + DO BEGIN 50124000 T 0066 + WHILE CURSY=COMMA DO INSYMBOL; 50125000 T 0066 + IF CURSY=ALFACONST AND CURLENGTH>7 THEN 50126000 T 0069 + BEGIN 50127000 T 0070 + GEN("WALFA(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 50128000 T 0071 + GENID("V",FILEID,5); GEN(",",1,7); 50129000 T 0100 + GENID("I",FILEID,5); GEN(",",1,7); 50130000 T 0121 + P:=STRINGPNT; 50131000 T 0141 + FOR I:=1 STEP 7 UNTIL 80 DO 50132000 T 0142 + IF I{CURLENGTH THEN 50133000 T 0145 + BEGIN 50134000 T 0145 + IF ALGOLCNT<10 THEN WRITEALGOL; 50135000 T 0146 + REPLACE ALGOLPNT:ALGOLPNT BY """, P:P FOR 7, """, ","; 50136000 T 0148 + ALGOLCNT:=ALGOLCNT-10; 50137000 T 0159 + END ELSE GEN("0,",2,6); 50138000 T 0161 + GENINT(CURLENGTH); GEN(",",1,7); 50139000 T 0172 + GENINT(CARDCNT); GEN(")",1,7); 50140000 T 0223 + INSYMBOL; 50141000 T 0274 + END OF ALFACONST ELSE 50142000 T 0275 + BEGIN 50143000 T 0275 + GEN("PWRITE(",7,1); GENID("F",FILEID,5); GEN(",",1,7); 50144000 T 0275 + GENID("V",FILEID,5); GEN(",",1,7); 50145000 T 0305 + GENID("I",FILEID,5); GEN(",",1,7); 50146000 T 0325 + LASTSY:=CURSY; 50147000 T 0346 + EXPRESSION; F:=TYPETAB1[CURTYPE].FORM; 50148000 T 0347 + GEN(",",1,7); 50149000 T 0349 + IF F=NUMERIC OR F=FLOATING OR F=CHAR OR F=ALFA OR 50150000 T 0358 + CURTYPE=BOOLTYPE THEN 50151000 T 0361 + BEGIN 50152000 T 0362 + IF F=NUMERIC THEN GENINT(1) ELSE 50153000 T 0363 + IF F=FLOATING THEN GENINT(2) ELSE 50154000 T 0407 + IF F=ALFA THEN GENINT(5) ELSE 50155000 T 0451 + IF F=CHAR THEN GENINT(4) ELSE GENINT(3); 50156000 T 0495 + GEN(",",1,7); 50157000 T 0582 + IF CURSY=COLON THEN 50158000 T 0591 + BEGIN 50159000 T 0592 + INSYMBOL; EXPRESSION; 50160000 T 0593 + IF TYPETAB1[CURTYPE].FORM NEQ NUMERIC THEN ERROR(17); 50161000 T 0594 + GEN(",",1,7); 50162000 T 0596 + IF CURSY=COLON THEN 50163000 T 0605 + BEGIN 50164000 T 0606 + IF F!FLOATING THEN ERROR(4); 50165000 T 0607 + INSYMBOL; EXPRESSION; 50166000 T 0609 + IF TYPETAB1[CURTYPE].FORM NEQ NUMERIC THEN ERROR(17); 50167000 T 0610 + GEN(",",1,7); 50168000 T 0612 + END ELSE GEN("-1,",3,5); 50169000 T 0621 + END ELSE 50170000 T 0631 + BEGIN 50171000 T 0631 + IF F=FLOATING THEN GENINT(16) ELSE 50172000 T 0633 + IF F=ALFA AND LASTSY=ALFACONST THEN GENINT(CURLENGTH) ELSE 50173000 T 0676 + IF F=ALFA THEN GENINT(7) ELSE 50174000 T 0721 + IF F=CHAR THEN GENINT(1) ELSE GENINT(10); 50175000 T 0765 + GEN(",-1,",4,4); 50176000 T 0852 + END; 50177000 T 0861 + END ELSE ERROR(17); 50178000 T 0861 + GENINT(CARDCNT); GEN(")",1,7); 50179000 T 0864 + END OF EXPRESSION; 50180000 T 0915 + GEN(";",1,7); 50181000 T 0915 + END UNTIL CURSY!COMMA; 50182000 T 0926 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50183000 T 0927 + IF CURSY=RPAR THEN INSYMBOL; 50184000 T 0930 + END; 50185000 T 0931 + FILENAME:=FILEID; 50186000 T 0931 + IF LINEFEED THEN 50187000 T 0932 + BEGIN 50188000 T 0932 + INTEGER DUMMY; 50189000 T 0933 + START OF SEGMENT ********** 20 + GEN("WLINE(",6,2); GENID("F",FILENAME,5); GEN(",",1,7); 50190000 T 0000 + GENID("V",FILENAME,5); GEN(",",1,7); 50191000 T 0029 + GENID("I",FILENAME,5); GEN(")",1,7); 50192000 T 0050 + END; 50193000 T 0070 + 20 IS 72 LONG, NEXT SEG 19 + GEN("END",4,5); 50194000 T 0934 + END OF PWRITE; 50195000 T 0943 + 19 IS 955 LONG, NEXT SEG 2 + 50196000 T 0368 + 50197000 T 0368 + PROCEDURE FILEHANDLING(PROCNUM); %*** FILE HANDLING PROCEDURES: 50198000 T 0368 + VALUE PROCNUM; INTEGER PROCNUM; %*** 50199000 T 0368 + BEGIN %*** 1) PUT 50200000 T 0368 + INTEGER F; %*** 2) GET 50201000 T 0368 + START OF SEGMENT ********** 21 + CASE PROCNUM OF %*** 3) RESET 50202000 T 0000 + BEGIN ; %*** 4) REWRITE 50203000 T 0000 + GEN("PUT",3,5); %*** 5) PAGE 50204000 T 0000 + GEN("GET",3,5); % 50205000 T 0010 + GEN("RESET",5,3); % 50206000 T 0019 + GEN("REWRITE",7,1); % 50207000 T 0029 + GEN("PAGE",4,4); % 50208000 T 0038 + END; % 50209000 T 0048 + START OF SEGMENT ********** 22 + 22 IS 6 LONG, NEXT SEG 21 + GEN("(",1,7); FILEPARAM(0); % 50210000 T 0048 + IF FILENAME=0 THEN ERROR(78); % 50211000 T 0112 + F:=TYPETAB1[CURTYPE].FORM; 50212000 T 0114 + IF F=FILES AND PROCNUM=5 THEN ERROR(80); 50213000 T 0116 + GENID("F",FILENAME,5); GEN(",",1,7); 50214000 T 0119 + GENID("V",FILENAME,5); GEN(",",1,7); 50215000 T 0139 + GENID("I",FILENAME,5); GEN(",",1,7); 50216000 T 0160 + GENINT(CARDCNT); GEN(")",1,7); 50217000 T 0180 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50218000 T 0231 + IF CURSY=RPAR THEN INSYMBOL; 50219000 T 0234 + END OF FILEHANDLING; 50220000 T 0236 + 21 IS 239 LONG, NEXT SEG 2 + 50221000 T 0368 + 50222000 T 0368 + PROCEDURE PACK; 50223000 T 0368 + BEGIN 50224000 T 0368 + INTEGER IT,T; 50225000 T 0368 + START OF SEGMENT ********** 23 + GEN("PACK(",5,3); 50226000 T 0000 + INSYMBOL; 50227000 T 0009 + IF CURSY=LPAR THEN 50228000 T 0009 + BEGIN 50229000 T 0010 + INSYMBOL; 50230000 T 0010 + IF CURSY=IDENTIFIER THEN 50231000 T 0011 + BEGIN 50232000 T 0012 + SEARCH; 50233000 T 0012 + IF FOUND THEN 50234000 T 0041 + BEGIN 50235000 T 0042 + IF THISID.IDCLASS=VAR THEN 50236000 T 0042 + BEGIN 50237000 T 0043 + T:=TYPETAB1[THISID.TYPE]; 50238000 T 0044 + IF T.FORM=ARRAYS THEN 50239000 T 0045 + BEGIN 50240000 T 0047 + IT:=T.INXTYPE; 50241000 T 0047 + IF TYPETAB1[T.ARRTYPE].FORM!CHAR THEN ERROR(88); 50242000 T 0048 + GENID("V",1000|THISLEVEL+THISINDEX,5); 50243000 T 0052 + IF THISLEVEL>1 AND THISLEVEL!CURLEVEL THEN ERROR(5); 50244000 T 0064 + GEN(",",1,7); GENINT(TYPETAB2[THISID.TYPE]); 50245000 T 0067 + GEN(",",1,7); GENINT(TYPETAB3[THISID.TYPE]); 50246000 T 0119 + END ELSE ERROR(88); 50247000 T 0172 + END ELSE ERROR(88); 50248000 T 0174 + END ELSE ERROR(1); 50249000 T 0175 + END ELSE ERROR(9); 50250000 T 0176 + INSYMBOL; 50251000 T 0177 + IF CURSY=COMMA THEN 50252000 T 0178 + BEGIN 50253000 T 0179 + GEN(",",1,7); 50254000 T 0179 + INSYMBOL; EXPRESSION; CHECKTYPES(IT,CURTYPE); 50255000 T 0188 + IF CURSY=COMMA THEN 50256000 T 0247 + BEGIN 50257000 T 0248 + GEN(",",1,7); 50258000 T 0248 + INSYMBOL; 50259000 T 0257 + IF CURSY=IDENTIFIER THEN 50260000 T 0258 + BEGIN 50261000 T 0259 + SEARCH; 50262000 T 0259 + IF FOUND THEN 50263000 T 0287 + BEGIN 50264000 T 0287 + IF THISID.IDCLASS=VAR OR 50265000 T 0287 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 50266000 T 0289 + BEGIN 50267000 T 0291 + VARIABLE; WRITEEXPR; 50268000 T 0292 + IF CURTYPE>0 THEN 50269000 T 0370 + IF TYPETAB1[CURTYPE].FORM!ALFA THEN ERROR(12); 50270000 T 0370 + END ELSE ERROR(8); 50271000 T 0374 + END ELSE ERROR(1); 50272000 T 0375 + END ELSE ERROR(9); 50273000 T 0376 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50274000 T 0377 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50275000 T 0379 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50276000 T 0381 + IF CURSY=RPAR THEN INSYMBOL; 50277000 T 0384 + END ELSE BEGIN ERROR(3); INSYMBOL END; 50278000 T 0386 + GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50279000 T 0389 + END OF PACK; 50280000 T 0449 + 23 IS 455 LONG, NEXT SEG 2 + 50281000 T 0368 + 50282000 T 0368 + PROCEDURE UNPACK; 50283000 T 0368 + BEGIN 50284000 T 0368 + INTEGER IT,T; 50285000 T 0368 + START OF SEGMENT ********** 24 + GEN("UNPACK(",7,1); INSYMBOL; 50286000 T 0000 + IF CURSY=LPAR THEN 50287000 T 0009 + BEGIN 50288000 T 0010 + INSYMBOL; EXPRESSION; 50289000 T 0010 + IF CURTYPE>0 THEN IF TYPETAB1[CURTYPE].FORM!ALFA THEN ERROR(17); 50290000 T 0011 + IF CURSY=COMMA THEN 50291000 T 0015 + BEGIN 50292000 T 0016 + GEN(",",1,7); INSYMBOL; 50293000 T 0017 + IF CURSY=IDENTIFIER THEN 50294000 T 0026 + BEGIN 50295000 T 0027 + SEARCH; 50296000 T 0027 + IF FOUND THEN 50297000 T 0056 + BEGIN 50298000 T 0057 + IF THISID.IDCLASS=VAR THEN 50299000 T 0057 + BEGIN 50300000 T 0058 + T:=TYPETAB1[THISID.TYPE]; 50301000 T 0059 + IF T.FORM=ARRAYS THEN 50302000 T 0060 + BEGIN 50303000 T 0062 + IT:=T.INXTYPE; 50304000 T 0062 + IF TYPETAB1[T.ARRTYPE].FORM!CHAR THEN ERROR(88); 50305000 T 0063 + IF THISLEVEL>1 AND THISLEVEL!CURLEVEL THEN ERROR(5); 50306000 T 0067 + GENID("V",1000|THISLEVEL+THISINDEX,5); 50307000 T 0070 + GEN(",",1,7); GENINT(TYPETAB2[THISID.TYPE]); 50308000 T 0082 + GEN(",",1,7); GENINT(TYPETAB3[THISID.TYPE]); 50309000 T 0134 + END ELSE ERROR(88); 50310000 T 0187 + END ELSE ERROR(88); 50311000 T 0189 + END ELSE ERROR(1); 50312000 T 0190 + END ELSE ERROR(9); 50313000 T 0191 + INSYMBOL; 50314000 T 0192 + IF CURSY=COMMA THEN 50315000 T 0193 + BEGIN 50316000 T 0194 + GEN(",",1,7); 50317000 T 0194 + INSYMBOL; EXPRESSION; CHECKTYPES(IT,CURTYPE); 50318000 T 0203 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50319000 T 0262 + END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50320000 T 0264 + IF CURSY!RPAR THEN BEGIN ERROR(89); SKIP(RPAR) END; 50321000 T 0266 + IF CURSY=RPAR THEN INSYMBOL; 50322000 T 0269 + END ELSE BEGIN ERROR(3); INSYMBOL END; 50323000 T 0271 + GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50324000 T 0273 + END OF UNPACK; 50325000 T 0333 + 24 IS 339 LONG, NEXT SEG 2 + 50326000 T 0368 + 50327000 T 0368 + PROCEDURE NEWDISP; %*** "NEW","DISPOSE" 50328000 T 0368 + BEGIN 50329000 T 0368 + INTEGER T1; 50330000 T 0368 + START OF SEGMENT ********** 25 + IF CURNAME1="3000NEW" THEN GEN("NEW(",4,4) ELSE 50331000 T 0000 + BEGIN GEN("DISPOSE",7,1); GEN("(",1,7) END; 50332000 T 0010 + INSYMBOL; 50333000 T 0031 + IF CURSY=LPAR THEN 50334000 T 0031 + BEGIN 50335000 T 0032 + INSYMBOL; 50336000 T 0032 + IF CURSY=IDENTIFIER THEN 50337000 T 0033 + BEGIN 50338000 T 0034 + SEARCH; 50339000 T 0034 + IF FOUND THEN 50340000 T 0063 + BEGIN 50341000 T 0064 + VARIABLE; 50342000 T 0064 + IF CURTYPE>0 THEN IF TYPETAB1[CURTYPE].FORM=POINTERS THEN 50343000 T 0065 + BEGIN 50344000 T 0067 + WRITEEXPR; GEN(",",1,7); 50345000 T 0068 + T1:=TYPETAB1[CURTYPE].POINTTYPE; 50346000 T 0154 + T1:=TYPETAB1[T1].SIZE; 50347000 T 0155 + IF T1>1023 THEN ERROR(86); 50348000 T 0157 + GENINT(T1); GEN(")",1,7); 50349000 T 0159 + END ELSE ERROR(81); 50350000 T 0209 + END ELSE BEGIN ERROR(1); INSYMBOL END; 50351000 T 0211 + END ELSE ERROR(9); 50352000 T 0212 + WHILE CURSY=COMMA DO 50353000 T 0214 + BEGIN INSYMBOL; 50354000 T 0215 + IF CURSY NEQ IDENTIFIER THEN ERROR(9); 50355000 T 0215 + IF CURSY NEQ RPAR THEN INSYMBOL; 50356000 T 0217 + END; 50357000 T 0219 + END ELSE BEGIN ERROR(58); SKIP(RPAR) END; 50358000 T 0220 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50359000 T 0222 + IF CURSY=RPAR THEN INSYMBOL; 50360000 T 0224 + END OF NEWDISP; 50361000 T 0226 + 25 IS 229 LONG, NEXT SEG 2 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 60001000 T 0368 + % % 60002000 T 0368 + % % 60003000 T 0368 + % % 60004000 T 0368 + % PART 6: THE STATEMENT PARSER. % 60005000 T 0368 + % --------------------- % 60006000 T 0368 + % % 60007000 T 0368 + % % 60008000 T 0368 + % % 60009000 T 0368 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 60010000 T 0368 + 60011000 T 0368 + 60012000 T 0368 + 60013000 T 0368 + PROCEDURE STATEMENT; FORWARD; 60014000 T 0368 + 60015000 T 0368 + PROCEDURE ASSIGNMENT; 60016000 T 0368 + BEGIN 60017000 T 0368 + INTEGER LEFTTYPE; 60018000 T 0368 + START OF SEGMENT ********** 26 + LABEL ASSIGN,EXIT; 60019000 T 0000 + IF FOUND THEN 60050000 T 0000 + BEGIN 60051000 T 0000 + IF THISID.IDCLASS=VAR OR 60052000 T 0000 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 60053000 T 0002 + BEGIN 60054000 T 0004 + VARIABLE; LEFTTYPE:=CURTYPE; 60055000 T 0005 + ASSIGN: IF CURSY!ASSIGNSY THEN 60056000 T 0006 + BEGIN ERROR(28); SKIP(ASSIGNSY); 60057000 T 0007 + IF SYMKIND[CURSY]=TERMINAL THEN GO TO EXIT; 60058000 T 0009 + END; 60059000 T 0011 + INSYMBOL; 60060000 T 0011 + IF TYPETAB1[LEFTTYPE].STRUCT>0 THEN 60061000 T 0011 + BEGIN 60062000 T 0013 + ERROR(95); 60063000 T 0013 + END ELSE 60080000 T 0014 + BEGIN 60081000 T 0014 + WRITEEXPR; GEN(":=",2,6); 60082000 T 0015 + IF CHECKOPTION AND TYPETAB1[LEFTTYPE].FORM{CHAR THEN 60083000 T 0101 + CHECKEXPR(TYPETAB2[LEFTTYPE],TYPETAB3[LEFTTYPE]) ELSE 60084000 T 0103 + EXPRESSION; 60085000 T 0181 + WRITEEXPR; 60086000 T 0182 + CHECKTYPES(LEFTTYPE,CURTYPE); 60087000 T 0259 + END; 60088000 T 0317 + END ELSE 60089000 T 0317 + BEGIN % FUNCTION ASSIGNMENT. 60090000 T 0317 + IF THISLEVEL!CURLEVEL-1 OR THISINDEX!CURFUNC THEN ERROR(5); 60091000 T 0318 + GENID("V",1000|THISLEVEL+THISINDEX,5); LEFTTYPE:=THISID.TYPE; 60092000 T 0321 + INSYMBOL; GO TO ASSIGN; 60093000 T 0335 + END; 60094000 T 0336 + END ELSE 60095000 T 0336 + BEGIN 60096000 T 0336 + SKIP(ASSIGNSY); 60097000 T 0338 + IF CURSY=ASSIGNSY THEN GO TO ASSIGN; 60098000 T 0338 + END; 60099000 T 0340 + EXIT: 60100000 T 0340 + END OF ASSIGNMENT; 60101000 T 0340 + 26 IS 347 LONG, NEXT SEG 2 + 60102000 T 0368 + 60103000 T 0368 + PROCEDURE COMPSTAT; 60104000 T 0368 + BEGIN 60105000 T 0368 + INTEGER BEGINNUM; 60106000 T 0368 + START OF SEGMENT ********** 27 + 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 0028 + IF CURSY=SEMICOLON OR CURSY=BEGINSY THEN INSYMBOL; 60112000 T 0028 + STATM: STATEMENT; 60113000 T 0031 + GEN(";",1,7); 60114000 T 0032 + IF CURSY=ELSESY THEN BEGIN ERROR(20); INSYMBOL; GO STATM END; 60115000 T 0041 + IF SYMKIND[CURSY]=INITIAL THEN BEGIN ERROR(21); GO STATM END; 60116000 T 0047 + END UNTIL CURSY!SEMICOLON; 60117000 T 0049 + IF CURSY!ENDSY THEN 60118000 T 0051 + BEGIN ERROR(24); SKIP(ENDSY); 60119000 T 0051 + IF CURSY!ENDSY THEN BEGIN INSYMBOL; GO TO STATM END; 60120000 T 0053 + END; 60121000 T 0056 + GEN(" END",5,4); MARGIN(" E",BEGINNUM); 60122000 T 0056 + INSYMBOL; 60123000 T 0082 + END OF COMPSTAT; 60124000 T 0083 + 27 IS 88 LONG, NEXT SEG 2 + 60125000 T 0368 + 60126000 T 0368 + PROCEDURE IFSTAT; 60127000 T 0368 + BEGIN 60128000 T 0368 + LABEL EXIT; 60129000 T 0368 + START OF SEGMENT ********** 28 + GEN("IF",3,6); 60130000 T 0000 + INSYMBOL; BOOLEXPR; 60131000 T 0009 + IF CURSY!THENSY THEN 60132000 T 0111 + BEGIN IF CURTYPE>0 THEN ERROR(27); 60133000 T 0111 + SKIP(THENSY); 60134000 T 0114 + IF CURSY!THENSY THEN 60135000 T 0115 + BEGIN IF CURTYPE=0 THEN ERROR(27); 60136000 T 0115 + IF SYMKIND[CURSY]=TERMINAL THEN GO TO EXIT; 60137000 T 0118 + END; END; 60138000 T 0119 + GEN(" THEN",6,3); 60139000 T 0119 + INSYMBOL; STATEMENT; 60140000 T 0128 + IF CURSY=ELSESY THEN 60141000 T 0129 + BEGIN GEN(" ELSE",6,3); INSYMBOL; STATEMENT END; 60142000 T 0130 + EXIT: 60143000 T 0141 + END OF IFSTAT; 60144000 T 0141 + 28 IS 144 LONG, NEXT SEG 2 + 60145000 T 0368 + 60146000 T 0368 + PROCEDURE CASESTAT; 60147000 T 0368 + BEGIN 60148000 T 0368 + DEFINE CASEHASH(N)=(N).[38:39] MOD MAXCASES#; 60149000 T 0368 + START OF SEGMENT ********** 29 + 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 0054 + GEN(";",1,7); CASETYPE:=CURTYPE; 60159000 T 0055 + IF TYPETAB1[CASETYPE].FORM}FLOATING THEN 60160000 T 0065 + BEGIN ERROR(17); CASETYPE:=0 END; 60161000 T 0066 + IF CURSY!OFSY THEN 60162000 T 0068 + BEGIN IF CASETYPE>0 THEN ERROR(18); 60163000 T 0069 + SKIP(OFSY); 60164000 T 0072 + IF CURSY=OFSY THEN INSYMBOL ELSE 60165000 T 0072 + IF CASETYPE=0 THEN ERROR(18); 60166000 T 0074 + END ELSE INSYMBOL; 60167000 T 0079 + DO BEGIN 60168000 T 0080 + WHILE CURSY=SEMICOLON DO INSYMBOL; 60169000 T 0080 + FIRST:=TRUE; 60170000 T 0082 + IF CURSY!ENDSY THEN 60171000 T 0083 + BEGIN 60172000 T 0083 + GEN("IF",3,6); 60173000 T 0084 + DO BEGIN 60174000 T 0093 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 60175000 T 0093 + CONSTANT(CONVAL,CONTYPE); 60176000 T 0097 + IF CONTYPE>0 THEN 60177000 T 0184 + BEGIN 60178000 T 0185 + IF CASETYPE=0 THEN CASETYPE:=CONTYPE ELSE 60179000 T 0185 + CHECKTYPES(CASETYPE,CONTYPE); 60180000 T 0187 + GENID("T",TEMPVARNUM,2); GEN("=",1,7); GENINT(CONVAL); 60181000 T 0246 + NCASELABS:=NCASELABS+1; 60182000 T 0308 + IF NCASELABS0 THEN ERROR(19); 60219000 T 0111 + SKIP(DOSY); 60220000 T 0114 + IF CURSY!DOSY THEN 60221000 T 0115 + BEGIN IF CURTYPE=0 THEN ERROR(19); 60222000 T 0115 + GO TO IF SYMKIND[CURSY]=INITIAL THEN STATM ELSE EXIT; 60223000 T 0118 + END; END; 60224000 T 0123 + GEN(" DO",4,5); 60225000 T 0123 + INSYMBOL; 60226000 T 0132 + STATM: STATEMENT; 60227000 T 0133 + EXIT: 60228000 T 0133 + END OF WHILESTAT; 60229000 T 0134 + 30 IS 140 LONG, NEXT SEG 2 + 60230000 T 0368 + 60231000 T 0368 + PROCEDURE REPEATSTAT; 60232000 T 0368 + BEGIN 60233000 T 0368 + INTEGER REPNUM; 60234000 T 0368 + START OF SEGMENT ********** 31 + 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 0037 + INSYMBOL; 60241000 T 0037 + NEWTRY: STATEMENT; 60242000 T 0038 + GEN(";",1,7); 60243000 T 0038 + IF CURSY=ELSESY THEN BEGIN ERROR(20);INSYMBOL; GO NEWTRY END; 60244000 T 0047 + IF SYMKIND[CURSY]=INITIAL THEN BEGIN ERROR(21); GO NEWTRY END; 60245000 T 0054 + END UNTIL CURSY!SEMICOLON; 60246000 T 0056 + IF CURSY!UNTILSY THEN 60247000 T 0058 + BEGIN 60248000 T 0058 + ERROR(22); 60249000 T 0059 + WHILE CURSY!UNTILSY AND SYMKIND[CURSY]!INITIAL DO 60250000 T 0060 + BEGIN INSYMBOL; SKIP(UNTILSY) END; 60251000 T 0062 + IF CURSY!UNTILSY THEN GO TO NEWTRY; 60252000 T 0064 + END; 60253000 T 0065 + GEN(" END",5,4); GEN("UNTIL",6,3); MARGIN(" U",REPNUM); 60254000 T 0065 + INSYMBOL; BOOLEXPR; 60255000 T 0101 + END OF REPEATSTAT; 60256000 T 0205 + 31 IS 208 LONG, NEXT SEG 2 + 60257000 T 0368 + 60258000 T 0368 + PROCEDURE FORSTAT; 60259000 T 0368 + BEGIN 60260000 T 0368 + INTEGER VARTYPE,VARNUM,LLIM,ULIM; 60261000 T 0368 + START OF SEGMENT ********** 32 + BOOLEAN DOWN; 60262000 T 0000 + LABEL STATM; 60263000 T 0000 + 60264000 T 0000 + GEN("BEGIN",6,3); 60265000 T 0000 + INSYMBOL; 60266000 T 0009 + IF CURSY=IDENTIFIER THEN 60267000 T 0009 + BEGIN 60268000 T 0010 + SEARCH; 60269000 T 0010 + IF FOUND THEN 60270000 T 0039 + BEGIN 60271000 T 0040 + VARNUM:=1000|THISLEVEL+THISINDEX; 60272000 T 0040 + IF THISID.IDCLASS=VAR OR 60273000 T 0042 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 60274000 T 0043 + BEGIN 60275000 T 0046 + IF THISLEVEL>1 AND THISLEVELCURLEVEL THEN ERROR(83); 60277000 T 0049 + VARTYPE:=THISID.TYPE; 60278000 T 0051 + IF TYPETAB1[VARTYPE].FORM{CHAR THEN 60279000 T 0052 + BEGIN 60280000 T 0054 + LLIM:=TYPETAB2[VARTYPE]; ULIM:=TYPETAB3[VARTYPE]; 60281000 T 0054 + END ELSE BEGIN ERROR(12); VARTYPE:=0 END; 60282000 T 0056 + END ELSE ERROR(8); 60283000 T 0058 + END ELSE ERROR(1); 60284000 T 0060 + END ELSE ERROR(9); 60285000 T 0061 + INSYMBOL; 60286000 T 0062 + IF CURSY!ASSIGNSY THEN 60287000 T 0063 + BEGIN ERROR(28); 60288000 T 0063 + SKIP(ASSIGNSY); 60289000 T 0065 + IF CURSY=ASSIGNSY THEN INSYMBOL ELSE 60290000 T 0065 + IF SYMKIND[CURSY]=INITIAL THEN GO TO STATM; 60291000 T 0067 + END ELSE INSYMBOL; 60292000 T 0069 + GENID("V",VARNUM,5); GEN("~",1,7); 60293000 T 0070 + IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 60294000 T 0091 + WRITEEXPR; 60295000 T 0168 + GEN(";",1,7); 60296000 T 0245 + IF VARTYPE=0 THEN VARTYPE:=CURTYPE ELSE CHECKTYPES(VARTYPE,CURTYPE); 60297000 T 0254 + NUMTEMPS:=NUMTEMPS+1; IF NUMTEMPS>MAXTEMPS THEN ERROR(16); 60298000 T 0314 + IF CURSY=TOSY THEN INSYMBOL ELSE 60299000 T 0317 + IF CURSY=DOWNTOSY THEN BEGIN DOWN:=TRUE; INSYMBOL END ELSE 60300000 T 0319 + BEGIN IF CURTYPE>0 THEN ERROR(23); 60301000 T 0322 + SKIP(TOSY); 60302000 T 0325 + IF CURSY=TOSY THEN INSYMBOL ELSE 60303000 T 0325 + BEGIN IF CURTYPE=0 THEN ERROR(23); 60304000 T 0327 + IF SYMKIND[CURSY]=INITIAL THEN GO TO STATM; 60305000 T 0330 + END; END; 60306000 T 0331 + GENID("T",NUMTEMPS,2); GEN("~",1,7); 60307000 T 0331 + IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 60308000 T 0352 + WRITEEXPR; 60309000 T 0429 + GEN(";",1,7); 60310000 T 0506 + IF VARTYPE=0 THEN VARTYPE:=CURTYPE ELSE CHECKTYPES(VARTYPE,CURTYPE); 60311000 T 0515 + IF CURSY!DOSY THEN 60312000 T 0575 + BEGIN IF CURTYPE>0 THEN ERROR(19); 60313000 T 0576 + SKIP(DOSY); 60314000 T 0578 + IF CURSY=DOSY THEN INSYMBOL ELSE 60315000 T 0579 + IF CURTYPE=0 THEN ERROR(19); 60316000 T 0581 + END ELSE INSYMBOL; 60317000 T 0583 + GEN("FOR",4,5); GENID("V",VARNUM,5); GEN("~",1,7); 60318000 T 0584 + GENID("V",VARNUM,5); GEN(" ",1,7); 60319000 T 0614 + IF DOWN THEN GEN("DOWNTO",7,2) ELSE GEN("UPTO",5,4); 60320000 T 0634 + GENID("T",NUMTEMPS,2); GEN(" DO",4,5); 60321000 T 0656 + STATM: STATEMENT; 60322000 T 0676 + GEN(" END",5,4); 60323000 T 0677 + NUMTEMPS:=NUMTEMPS-1; 60324000 T 0686 + END OF FORSTAT; 60325000 T 0687 + 32 IS 694 LONG, NEXT SEG 2 + 60326000 T 0368 + 60327000 T 0368 + PROCEDURE GOTOSTAT; 60328000 T 0368 + BEGIN 60329000 T 0368 + INTEGER I; 60330000 T 0368 + START OF SEGMENT ********** 33 + 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 0029 + END ELSE ERROR(10); 60338000 T 0030 + END OF GOTOSTAT; 60339000 T 0032 + 33 IS 35 LONG, NEXT SEG 2 + 60340000 T 0368 + 60341000 T 0368 + PROCEDURE WITHSTAT; 60342000 T 0368 + BEGIN 60343000 T 0368 + INTEGER STARTLEVEL,VERYFIRSTWITHSYM,I; 60344000 T 0368 + START OF SEGMENT ********** 34 + REAL D; 60345000 T 0000 + STARTLEVEL:=TOPLEVEL; VERYFIRSTWITHSYM:=NWITHSYMS; 60346000 T 0000 + DO BEGIN 60347000 T 0001 + INSYMBOL; 60348000 T 0001 + IF CURSY=IDENTIFIER THEN 60349000 T 0002 + BEGIN 60350000 T 0002 + SEARCH; 60351000 T 0003 + IF FOUND THEN 60352000 T 0030 + BEGIN 60353000 T 0031 + IF THISID.IDCLASS=VAR THEN 60354000 T 0031 + BEGIN 60355000 T 0032 + VARIABLE; 60356000 T 0033 + IF CURTYPE>0 THEN 60357000 T 0033 + IF TYPETAB1[CURTYPE].FORM!RECORD THEN ERROR(98); 60358000 T 0034 + IF SIMPLEVARIABLE THEN 60359000 T 0037 + BEGIN PUTSYM("["); INSIDEBRACKETS:=TRUE END; 60360000 T 0038 + IF TOPLEVELMAXWITHSYMS THEN ERROR(63) ELSE 60369000 T 0058 + FOR I:=1 STEP 1 UNTIL NUMSYMS DO 60370000 T 0061 + BEGIN 60371000 T 0063 + WITHTAB[NWITHSYMS]:=SYMTAB[I]; 60372000 T 0063 + NWITHSYMS:=NWITHSYMS+1; 60373000 T 0064 + END; 60374000 T 0065 + D.LASTWITHSYM:=NWITHSYMS-1; 60375000 T 0068 + DISPLAY[TOPLEVEL]:=D; 60376000 T 0070 + END ELSE ERROR(84); 60377000 T 0071 + END ELSE BEGIN ERROR(8); INSYMBOL END; 60378000 T 0072 + END ELSE BEGIN ERROR(1); INSYMBOL END; 60379000 T 0074 + END ELSE BEGIN ERROR(9); INSYMBOL END; 60380000 T 0076 + NUMSYMS:=0; 60381000 T 0078 + NUMPOINTERS := 0; 60382000 T 0078 + END UNTIL CURSY!COMMA; 60383000 T 0079 + IF CURSY!DOSY THEN 60384000 T 0080 + BEGIN ERROR(19); SKIP(DOSY); 60385000 T 0081 + IF CURSY=DOSY THEN INSYMBOL; 60386000 T 0083 + END ELSE INSYMBOL; 60387000 T 0085 + STATEMENT; 60388000 T 0086 + TOPLEVEL:=STARTLEVEL; NWITHSYMS:=VERYFIRSTWITHSYM; 60389000 T 0086 + END OF WITHSTAT; 60390000 T 0088 + 34 IS 92 LONG, NEXT SEG 2 + 60391000 T 0368 + 60392000 T 0368 + PROCEDURE STATEMENT; 60393000 T 0368 + BEGIN 60394000 T 0368 + INTEGER I; 60395000 T 0368 + START OF SEGMENT ********** 35 + LABEL LABFOUND; 60396000 T 0000 + 60397000 T 0000 + IF CURSY=INTCONST THEN % *** LABELED STATEMENT *** 60398000 T 0000 + BEGIN 60399000 T 0000 + FOR I:=FIRSTLAB STEP 1 UNTIL NUMLABS DO 60400000 T 0001 + IF LABTAB[I].LABVAL=CURVAL THEN 60401000 T 0002 + BEGIN IF LABTAB[I].LABDEF=1 THEN ERROR(31); 60402000 T 0003 + LABTAB[I].LABDEF:=1; 60403000 T 0006 + GO TO LABFOUND; 60404000 T 0009 + END; 60405000 T 0009 + ERROR(15); 60406000 T 0012 + LABFOUND: GENID("L",CURVAL,4); GEN(":",1,7); 60407000 T 0012 + INSYMBOL; 60408000 T 0033 + IF CURSY!COLON THEN 60409000 T 0034 + BEGIN ERROR(26); 60410000 T 0034 + SKIP(COLON); IF CURSY=COLON THEN INSYMBOL; 60411000 T 0036 + END ELSE INSYMBOL; 60412000 T 0038 + END; 60413000 T 0039 + 60414000 T 0039 + COMMENT *** START OF STATEMENT *** ; 60415000 T 0039 + 60416000 T 0039 + IF CURSY=IDENTIFIER THEN 60417000 T 0039 + BEGIN 60418000 T 0040 + SEARCH; 60419000 T 0040 + IF FOUND THEN 60420000 T 0068 + BEGIN 60421000 T 0068 + IF THISID.IDCLASS=VAR OR 60422000 T 0069 + THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) OR 60423000 T 0070 + THISID.IDCLASS=FUNC THEN ASSIGNMENT ELSE 60424000 T 0072 + IF THISID.IDCLASS=PROC THEN 60425000 T 0075 + BEGIN 60426000 T 0077 + IF THISLEVEL=0 THEN % *** INTRINSIC PROCEDURE *** 60427000 T 0077 + BEGIN 60428000 T 0078 + IF CURNAME1="50WRITE" THEN PWRITE(FALSE) ELSE 60429000 T 0078 + IF CURNAME1="7WRITEL" AND 60430000 T 0080 + CURNAME2="000000N" THEN PWRITE(TRUE) ELSE 60431000 T 0083 + IF CURNAME1="400READ" THEN PREAD(FALSE) ELSE 60432000 T 0086 + IF CURNAME1="6READLN" THEN PREAD(TRUE) ELSE 60433000 T 0090 + IF CURNAME1="400PAGE" THEN FILEHANDLING(5) ELSE 60434000 T 0094 + IF CURNAME1="3000GET" THEN FILEHANDLING(2) ELSE 60435000 T 0098 + IF CURNAME1="3000PUT" THEN FILEHANDLING(1) ELSE 60436000 T 0102 + IF CURNAME1="50RESET" THEN FILEHANDLING(3) ELSE 60437000 T 0106 + IF CURNAME1="7REWRIT" AND 60438000 T 0110 + CURNAME2="000000E" THEN FILEHANDLING(4) ELSE 60439000 T 0112 + IF CURNAME1="3000NEW" THEN NEWDISP ELSE 60440000 T 0115 + IF CURNAME1="7DISPOS" AND 60441000 T 0118 + CURNAME2="000000E" THEN NEWDISP ELSE 60442000 T 0121 + IF CURNAME1="400PACK" THEN PACK ELSE 60443000 T 0123 + IF CURNAME1="6UNPACK" THEN UNPACK ELSE ERROR(0); 60444000 T 0127 + END ELSE PASSPARAMS; 60445000 T 0134 + WRITEEXPR; 60446000 T 0135 + END ELSE BEGIN ERROR(13); SKIP(99) END; 60447000 T 0213 + END ELSE BEGIN ERROR(1); ASSIGNMENT END; 60448000 T 0215 + END OF IDENTIFIER ELSE 60449000 T 0216 + IF CURSY=BEGINSY THEN COMPSTAT ELSE 60450000 T 0216 + IF CURSY=IFSY THEN IFSTAT ELSE 60451000 T 0219 + IF CURSY=CASESY THEN CASESTAT ELSE 60452000 T 0221 + IF CURSY=WHILESY THEN WHILESTAT ELSE 60453000 T 0223 + IF CURSY=REPEATSY THEN REPEATSTAT ELSE 60454000 T 0225 + IF CURSY=FORSY THEN FORSTAT ELSE 60455000 T 0228 + IF CURSY=WITHSY THEN WITHSTAT ELSE 60456000 T 0230 + IF CURSY=GOTOSY THEN GOTOSTAT ELSE 60457000 T 0232 + IF SYMKIND[CURSY]!TERMINAL THEN 60458000 T 0234 + BEGIN ERROR(13); INSYMBOL; SKIP(SEMICOLON) END; 60459000 T 0236 + END OF STATEMENT; 60460000 T 0238 + 35 IS 241 LONG, NEXT SEG 2 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 70001000 T 0368 + % % 70002000 T 0368 + % % 70003000 T 0368 + % % 70004000 T 0368 + % PART 7: TYPE DECLARATIONS. % 70005000 T 0368 + % ------------------ % 70006000 T 0368 + % % 70007000 T 0368 + % % 70008000 T 0368 + % % 70009000 T 0368 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 70010000 T 0368 + 70011000 T 0368 + 70012000 T 0368 + REAL VALX1,VALX2; 70013000 T 0368 + INTEGER TYPEX1,TYPEX2; 70014000 T 0368 + BOOLEAN PACKED; 70015000 T 0368 + 70016000 T 0368 + PROCEDURE FIELDLIST(RECTAB,FIRSTADDR,LASTADDR); 70017000 T 0368 + VALUE RECTAB,FIRSTADDR; 70018000 T 0368 + INTEGER RECTAB,FIRSTADDR,LASTADDR; 70019000 T 0368 + FORWARD; 70020000 T 0368 + 70021000 T 0368 + DEFINE SUBRANGE= %*** SUBRANGE DECLARATION*** 70022000 T 0368 + BEGIN %*************************** 70023000 T 0368 + CONSTANT(VALX1,TYPEX1); 70024000 T 0368 + IF TYPETAB1[TYPEX1].FORM>CHAR THEN ERROR(11); 70025000 T 0368 + IF CURSY!DOUBLEDOT THEN ERROR(53); 70026000 T 0368 + INSYMBOL; 70027000 T 0368 + CONSTANT(VALX2,TYPEX2); 70028000 T 0368 + IF TYPEX1>0 AND TYPEX2>0 THEN 70029000 T 0368 + IF TYPEX1!TYPEX2 THEN ERROR(11) ELSE 70030000 T 0368 + IF VALX1>VALX2 THEN ERROR(54); 70031000 T 0368 + T1:=TYPETAB1[TYPEX1].FORM; IF T1=SYMBOLIC THEN T1:=SUBTYPE; 70032000 T 0368 + NEWTYPE; TTYPE:=TYPEINDEX; 70033000 T 0368 + T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; T1.MAINTYPE:=TYPEX1; 70034000 T 0368 + TYPETAB1[TYPEINDEX]:=T1; 70035000 T 0368 + TYPETAB2[TYPEINDEX]:=VALX1; TYPETAB3[TYPEINDEX]:=VALX2; 70036000 T 0368 + END OF SUBRANGE#; 70037000 T 0368 + 70038000 T 0368 + 70039000 T 0368 + PROCEDURE TYPEDECL(TTYPE,TSIZE); 70040000 T 0368 + INTEGER TTYPE,TSIZE; 70041000 T 0368 + BEGIN 70042000 T 0368 + PROCEDURE TYPERR(ERRNUM,TTYPE,TSIZE); 70043000 T 0368 + START OF SEGMENT ********** 36 + 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; 70048000 T 0002 + 70049000 T 0002 + INTEGER RECINX,ARRSTRUCT,TX,SX,T1,T2,T3,T,N; 70050000 T 0002 + BOOLEAN FIRST; 70051000 T 0002 + 70052000 T 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 0032 + BEGIN 70085000 T 0032 + IF THISID.IDCLASS=TYPES THEN 70086000 T 0033 + BEGIN 70087000 T 0034 + TTYPE:=THISID.TYPE; TSIZE:=TYPETAB1[TTYPE].SIZE; 70088000 T 0035 + INSYMBOL; 70089000 T 0038 + END ELSE IF THISID.IDCLASS=CONST THEN SUBRANGE 70090000 T 0038 + ELSE TYPERR(7,TTYPE,TSIZE); 70091000 T 0245 + END ELSE BEGIN TYPERR(1,TTYPE,TSIZE); INSYMBOL END; 70092000 T 0248 + END ELSE 70093000 T 0251 + IF CURSY{CHARCONST OR CURSY=PLUS OR CURSY=MINUS THEN SUBRANGE ELSE 70094000 T 0251 + IF CURSY=LPAR THEN 70095000 T 0460 + BEGIN 70096000 T 0461 + N:=0; 70097000 T 0462 + NEWTYPE; T3.IDCLASS:=CONST; T3.TYPE:=TYPEINDEX; 70098000 T 0462 + DO BEGIN 70099000 T 0471 + INSYMBOL; 70100000 T 0471 + IF CURSY=IDENTIFIER THEN 70101000 T 0471 + BEGIN 70102000 T 0472 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); 70103000 T 0473 + T3.INFO:=N; NAMETAB3[CURLEVEL,THISINDEX]:=T3; 70104000 T 0495 + N:=N+1; INSYMBOL; 70105000 T 0498 + END ELSE ERROR(9); 70106000 T 0500 + END UNTIL CURSY!COMMA; 70107000 T 0501 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 70108000 T 0503 + T1:=SYMBOLIC; T1.STRUCT:=0; 70109000 T 0505 + T1.SIZE:=TSIZE:=1; TTYPE:=TYPEINDEX; 70110000 T 0508 + TYPETAB1[TYPEINDEX]:=T1; 70111000 T 0511 + TYPETAB2[TYPEINDEX]:=0; TYPETAB3[TYPEINDEX]:=N-1; 70112000 T 0513 + IF CURSY=RPAR THEN INSYMBOL; 70113000 T 0516 + END ELSE 70114000 T 0517 + 70115000 T 0517 + IF CURSY=ARROW THEN %*** POINTER DECLARATION *** 70116000 T 0517 + BEGIN %*************************** 70117000 T 0519 + INSYMBOL; 70118000 T 0519 + IF CURSY=IDENTIFIER THEN 70119000 T 0520 + BEGIN 70120000 T 0520 + NEWTYPE; TTYPE:=TYPEINDEX; T1:=POINTERS; 70121000 T 0521 + T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; 70122000 T 0528 + TYPETAB1[TYPEINDEX]:=T1; 70123000 T 0532 + SEARCH; 70124000 T 0533 + IF FOUND THEN 70125000 T 0561 + BEGIN 70126000 T 0561 + IF THISID.IDCLASS=TYPES THEN 70127000 T 0561 + TYPETAB1[TYPEINDEX].POINTTYPE:=THISID.TYPE ELSE 70128000 T 0563 + TYPERR(7,TTYPE,TSIZE); 70129000 T 0566 + END ELSE 70130000 T 0569 + BEGIN 70131000 T 0569 + IF NUMPNTRS0 THEN 70150000 T 0593 + BEGIN 70151000 T 0594 + IF TYPETAB1[TX].FORM>CHAR THEN ERROR(48); 70152000 T 0594 + T1:=ARRAYS; T1.INXTYPE:=TX; T1.ARRTYPE:=T; 70153000 T 0597 + T2:=TYPETAB2[TX]; T3:=TYPETAB3[TX]; 70154000 T 0601 + IF T3-T2>1022 THEN ERROR(61); 70155000 T 0603 + T1.SIZE:=MIN(1023,T3-T2+1); 70156000 T 0606 + NEWTYPE; 70157000 T 0611 + TYPETAB1[TYPEINDEX]:=T1; 70158000 T 0616 + TYPETAB2[TYPEINDEX]:=T2; TYPETAB3[TYPEINDEX]:=T3; 70159000 T 0617 + T:=TYPEINDEX; 70160000 T 0619 + END; 70161000 T 0620 + END UNTIL CURSY!COMMA; 70162000 T 0620 + IF CURSY!RBRACKET THEN ERROR(59) ELSE INSYMBOL; 70163000 T 0621 + IF CURSY!OFSY THEN BEGIN ERROR(18); SKIP(OFSY) END; 70164000 T 0624 + INSYMBOL; 70165000 T 0627 + TYPEDECL(TX,SX); 70166000 T 0628 + IF TYPETAB1[TX].FORM}FILES THEN ERROR(60); 70167000 T 0629 + ARRSTRUCT:=TYPETAB1[TX].STRUCT; 70168000 T 0631 + WHILE T>0 DO 70169000 T 0633 + BEGIN 70170000 T 0634 + T1:=TYPETAB1[T]; T3:=T1.ARRTYPE; 70171000 T 0634 + T1.ARRTYPE:=TX; T1.STRUCT:=ARRSTRUCT:=ARRSTRUCT+1; 70172000 T 0636 + T1.SIZE:=SX:=MIN(1024,SX|T1.SIZE); 70173000 T 0641 + TYPETAB1[T]:=T1; TX:=T; T:=T3; 70174000 T 0646 + END; 70175000 T 0649 + TTYPE:=TX; TSIZE:=SX; 70176000 T 0651 + END OF ARRAY DECLARATION ELSE 70177000 T 0653 + 70178000 T 0653 + IF CURSY=FILESY THEN %*** FILE DECLARATION *** 70179000 T 0653 + BEGIN %************************ 70180000 T 0654 + INSYMBOL; 70181000 T 0654 + IF CURSY!OFSY THEN 70182000 T 0655 + BEGIN ERROR(18); 70183000 T 0656 + IF CURSY!IDENTIFIER THEN INSYMBOL; 70184000 T 0657 + END ELSE INSYMBOL; 70185000 T 0659 + TYPEDECL(TX,SX); 70186000 T 0660 + IF TX>0 THEN 70187000 T 0661 + BEGIN T:=TYPETAB1[TX]; 70188000 T 0661 + IF T.FORM}FILES THEN ERROR(50) ELSE 70189000 T 0663 + IF T.STRUCT>1 THEN ERROR(49) 70190000 T 0665 + END; 70191000 T 0668 + NEWTYPE; TTYPE:=TYPEINDEX; 70192000 T 0668 + T1:=IF T.FORM=CHAR THEN TEXTFILE ELSE FILES; 70193000 T 0674 + T1.SIZE:=TSIZE:=SX; T1.FILETYPE:=TX; 70194000 T 0678 + T1.STRUCT:=1; 70195000 T 0682 + TYPETAB1[TYPEINDEX]:=T1; 70196000 T 0684 + END OF FILE DECLARATION ELSE 70197000 T 0685 + 70198000 T 0685 + IF CURSY=SETSY THEN %*** SET DECLARATION *** 70199000 T 0685 + BEGIN %*********************** 70200000 T 0686 + INSYMBOL; 70201000 T 0687 + IF CURSY!OFSY THEN 70202000 T 0687 + BEGIN ERROR(18); 70203000 T 0688 + IF CURSY>CHARCONST THEN INSYMBOL; 70204000 T 0689 + END ELSE INSYMBOL; 70205000 T 0691 + TYPEDECL(TX,SX); 70206000 T 0692 + IF TX>0 THEN 70207000 T 0693 + BEGIN 70208000 T 0694 + IF TYPETAB1[TX].FORM>CHAR THEN ERROR(48) ELSE 70209000 T 0694 + IF TYPETAB2[TX]<0 OR TYPETAB3[TX]>38 THEN ERROR(51); 70210000 T 0697 + END; 70211000 T 0701 + NEWTYPE; TTYPE:=TYPEINDEX; 70212000 T 0701 + T1:=SET; T1.SETTYPE:=TX; T1.STRUCT:=0; 70213000 T 0707 + T1.SIZE:=TSIZE:=1; TYPETAB1[TYPEINDEX]:=T1; 70214000 T 0711 + TYPETAB2[TYPEINDEX]:=TYPETAB2[TX]; 70215000 T 0715 + TYPETAB3[TYPEINDEX]:=TYPETAB3[TX]; 70216000 T 0716 + END OF SET DECLARATION ELSE 70217000 T 0718 + 70218000 T 0718 + IF CURSY=RECORDSY THEN %*** RECORD DECLARATION *** 70219000 T 0718 + BEGIN %************************** 70220000 T 0719 + IF LASTREC-1>CURLEVEL THEN LASTREC:=LASTREC-1 ELSE ERROR(55); 70221000 T 0720 + RECINX:=LASTREC; 70222000 T 0724 + BLOCKTAB[RECINX]:=NUMBLOCKS:=NUMBLOCKS+1; 70223000 T 0725 + INSYMBOL; 70224000 T 0727 + FIELDLIST(RECINX,0,SX); 70225000 T 0727 + IF SX>1022 THEN BEGIN ERROR(56); SX:=1022 END; 70226000 T 0729 + NEWTYPE; TTYPE:=TYPEINDEX; 70227000 T 0731 + T1:=RECORD; T1.RECTAB:=RECINX; T1.STRUCT:=1; 70228000 T 0737 + T1.SIZE:=TSIZE:=SX; TYPETAB1[TYPEINDEX]:=T1; 70229000 T 0742 + TYPETAB2[TYPEINDEX]:=0; TYPETAB3[TYPEINDEX]:=SX-1; 70230000 T 0745 + IF CURSY!ENDSY THEN BEGIN ERROR(24); SKIP(ENDSY) END; 70231000 T 0748 + IF CURSY=ENDSY THEN INSYMBOL; 70232000 T 0751 + END ELSE BEGIN ERROR(4); SKIP(99) END; 70233000 T 0753 + END; 70234000 T 0755 + END OF TYPEDECL; 70235000 T 0755 + 36 IS 768 LONG, NEXT SEG 2 + 70236000 T 0368 + 70237000 T 0368 + PROCEDURE FIELDLIST(RECTAB,FIRSTADDR,LASTADDR); 70238000 T 0368 + VALUE RECTAB,FIRSTADDR; 70239000 T 0368 + INTEGER RECTAB,FIRSTADDR,LASTADDR; 70240000 T 0368 + BEGIN 70241000 T 0368 + INTEGER ARRAY ILIST[0:LISTLENGTH]; 70242000 T 0368 + START OF SEGMENT ********** 37 + INTEGER LISTINX; 70243000 T 0001 + INTEGER CASETYPE,ADDR,MAXADDR,INDEX,CTYPE,TX,SX,T1,T3,LLIM,ULIM,I; 70244000 T 0001 + BOOLEAN FIRST; 70245000 T 0001 + REAL CVAL; 70246000 T 0001 + LABEL CASETYPEID,CASEPART,EXIT; 70247000 T 0001 + 70248000 T 0001 + ADDR:=FIRSTADDR; 70249000 T 0001 + DO BEGIN 70250000 T 0002 + WHILE CURSY=SEMICOLON DO INSYMBOL; 70251000 T 0002 + IF CURSY=CASESY THEN GO TO CASEPART; 70252000 T 0004 + IF CURSY=IDENTIFIER THEN 70253000 T 0006 + BEGIN 70254000 T 0006 + LISTINX:=0; FIRST:=TRUE; 70255000 T 0007 + DO BEGIN 70256000 T 0008 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 70257000 T 0008 + IF CURSY=IDENTIFIER THEN 70258000 T 0011 + BEGIN 70259000 T 0012 + IF LISTINX}LISTLENGTH THEN BEGIN ERROR(37); LISTINX:=0 END; 70260000 T 0012 + LISTINX:=LISTINX+1; 70261000 T 0015 + NEWNAME(CURNAME1,CURNAME2,RECTAB); 70262000 T 0016 + ILIST[LISTINX]:=THISINDEX; 70263000 T 0038 + INSYMBOL; 70264000 T 0039 + END ELSE 70265000 T 0040 + BEGIN ERROR(9); 70266000 T 0040 + IF CURSY!COMMA THEN INSYMBOL; 70267000 T 0041 + END; 70268000 T 0043 + END UNTIL CURSY!COMMA; 70269000 T 0043 + IF CURSY!COLON THEN BEGIN ERROR(26); SKIP(COLON) END; 70270000 T 0044 + INSYMBOL; 70271000 T 0047 + TYPEDECL(TX,SX); 70272000 T 0047 + IF TX>0 THEN IF TYPETAB1[TX].FORM}FILES THEN ERROR(57); 70273000 T 0048 + T3.IDCLASS:=VAR; T3.TYPE:=TX; 70274000 T 0052 + FOR I:=1 STEP 1 UNTIL LISTINX DO 70275000 T 0056 + BEGIN 70276000 T 0057 + T3.INFO:=ADDR; ADDR:=MIN(ADDR+SX,1024); 70277000 T 0057 + NAMETAB3[RECTAB,ILIST[I]]:=T3; 70278000 T 0062 + END; 70279000 T 0064 + END; 70280000 T 0066 + END UNTIL CURSY!SEMICOLON; 70281000 T 0066 + LASTADDR:=ADDR; 70282000 T 0068 + GO TO EXIT; 70283000 T 0069 + 70284000 T 0071 + CASEPART: 70285000 T 0071 + LISTINX:=0; LASTADDR:=ADDR; INDEX:=-1; 70286000 T 0071 + INSYMBOL; 70287000 T 0073 + IF CURSY=IDENTIFIER THEN 70288000 T 0074 + BEGIN 70289000 T 0075 + SEARCH; 70290000 T 0075 + IF FOUND AND THISID.IDCLASS=TYPES THEN GO TO CASETYPEID; 70291000 T 0103 + NEWNAME(CURNAME1,CURNAME2,RECTAB); INDEX:=THISINDEX; 70292000 T 0105 + INSYMBOL; 70293000 T 0128 + IF CURSY!COLON THEN ERROR(26); 70294000 T 0128 + INSYMBOL; 70295000 T 0130 + IF CURSY=IDENTIFIER THEN 70296000 T 0131 + BEGIN 70297000 T 0132 + SEARCH; 70298000 T 0132 + IF FOUND THEN 70299000 T 0160 + BEGIN 70300000 T 0160 + IF THISID.IDCLASS=TYPES THEN 70301000 T 0160 + BEGIN 70302000 T 0162 + CASETYPEID: CASETYPE:=THISID.TYPE; T1:=TYPETAB1[CASETYPE]; 70303000 T 0162 + LLIM:=TYPETAB2[CASETYPE]; ULIM:=TYPETAB3[CASETYPE]; 70304000 T 0165 + IF T1.FORM>CHAR THEN ERROR(48); 70305000 T 0167 + IF INDEX}0 THEN 70306000 T 0169 + BEGIN 70307000 T 0170 + T3.IDCLASS:=VAR; T3.TYPE:=CASETYPE; T3.INFO:=ADDR; 70308000 T 0171 + ADDR:=LASTADDR:=ADDR+1; NAMETAB3[RECTAB,INDEX]:=T3; 70309000 T 0176 + END; 70310000 T 0180 + INSYMBOL; 70311000 T 0180 + END ELSE BEGIN ERROR(7); SKIP(OFSY) END; 70312000 T 0180 + END ELSE BEGIN ERROR(1); SKIP(OFSY) END; 70313000 T 0182 + END ELSE BEGIN ERROR(9); SKIP(OFSY) END; 70314000 T 0184 + END ELSE BEGIN ERROR(9); SKIP(OFSY) END; 70315000 T 0186 + IF CURSY!OFSY THEN BEGIN ERROR(18); SKIP(RPAR) END; 70316000 T 0188 + IF CURSY=OFSY THEN INSYMBOL; 70317000 T 0191 + IF CASETYPE=0 THEN BEGIN LLIM:=-MAXINT; ULIM:=MAXINT END; 70318000 T 0193 + DO BEGIN 70319000 T 0196 + WHILE CURSY=SEMICOLON DO INSYMBOL; 70320000 T 0196 + IF CURSY{CHARCONST OR CURSY=PLUS OR CURSY=MINUS THEN 70321000 T 0200 + BEGIN 70322000 T 0202 + FIRST:=TRUE; 70323000 T 0203 + DO BEGIN 70324000 T 0204 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 70325000 T 0204 + CONSTANT(CVAL,CTYPE); 70326000 T 0206 + IF CTYPE>0 THEN 70327000 T 0293 + BEGIN 70328000 T 0294 + IF CASETYPE=0 THEN CASETYPE:=CTYPE ELSE 70329000 T 0294 + IF CVALULIM THEN ERROR(14) ELSE 70330000 T 0296 + CHECKTYPES(CASETYPE,CTYPE); 70331000 T 0300 + IF LISTINX}LISTLENGTH THEN BEGIN ERROR(30); LISTINX:=0 END; 70332000 T 0358 + LISTINX:=LISTINX+1; 70333000 T 0361 + ILIST[LISTINX]:=CVAL; I:=1; 70334000 T 0362 + WHILE ILIST[I]!CVAL DO I:=I+1; 70335000 T 0364 + IF ILASTADDR THEN LASTADDR:=MAXADDR; 70344000 T 0378 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 70345000 T 0380 + INSYMBOL; 70346000 T 0383 + END ELSE ERROR(58); 70347000 T 0384 + END; 70348000 T 0385 + END UNTIL CURSY NEQ SEMICOLON; % 70349000 T 0385 + EXIT: 70350000 T 0386 + END OF FIELDLIST; 70351000 T 0387 + 37 IS 395 LONG, NEXT SEG 2 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 80001000 T 0368 + % % 80002000 T 0368 + % % 80003000 T 0368 + % % 80004000 T 0368 + % PART 8: THE PROCEDURE BLOCK. % 80005000 T 0368 + % -------------------- % 80006000 T 0368 + % % 80007000 T 0368 + % % 80008000 T 0368 + % % 80009000 T 0368 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 80010000 T 0368 + 80011000 T 0368 + 80012000 T 0368 + 80013000 T 0368 + PROCEDURE DECLAREVARS(PARAM,TAB,FIRST,LAST,LEVEL); 80014000 T 0368 + VALUE PARAM,FIRST,LAST,LEVEL; 80015000 T 0368 + INTEGER ARRAY TAB[0]; 80016000 T 0368 + INTEGER FIRST,LAST,LEVEL; 80017000 T 0368 + BOOLEAN PARAM; 80018000 T 0368 + BEGIN 80019000 T 0368 + INTEGER LEVEL1000,TYP,NAM,NAMTAB,T1,I,J,RECSIZE; 80020000 T 0368 + START OF SEGMENT ********** 38 + BOOLEAN REALVAR,ARRAYVAR,FIRSTDIM,EXTFILE; 80021000 T 0000 + ALPHA FNAME; 80022000 T 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 0019 + END; 80036000 T 0020 + IF NAMTAB.IDCLASS=FUNC THEN GEN("REAL",5,4); 80037000 T 0020 + GEN("PROCEDU",8,1); 80038000 T 0031 + GENID("V",LEVEL1000+NAM,5); GEN(";",1,7); 80039000 T 0040 + END ELSE 80040000 T 0061 + IF T1.STRUCT=0 THEN %*** SIMPLE TYPE *** 80041000 T 0061 + BEGIN 80042000 T 0065 + IF ARRAYVAR THEN BEGIN GEN(";",1,7); ARRAYVAR:=FALSE END; 80043000 T 0065 + IF REALVAR THEN GEN(",",1,7) ELSE 80044000 T 0076 + BEGIN GEN("REAL",5,4); REALVAR:=TRUE END; 80045000 T 0086 + GENID("V",LEVEL1000+NAM,5); 80046000 T 0096 + END ELSE 80047000 T 0108 + BEGIN 80048000 T 0108 + IF REALVAR THEN BEGIN GEN(";",1,7); REALVAR:=FALSE END; 80049000 T 0110 + IF T1.FORM0 AND CURKIND=CONST THEN ERROR(94); 80201000 T 0113 + END ELSE IF T.STRUCT>0 THEN ERROR(38); 80202000 T 0117 + END ELSE BEGIN ERROR(7); T3:=0 END; 80203000 T 0120 + END ELSE BEGIN ERROR(1); T3:=0 END; 80204000 T 0122 + END ELSE BEGIN ERROR(9); T3:=0 END; 80205000 T 0124 + INSYMBOL; 80206000 T 0126 + END ELSE 80207000 T 0126 + BEGIN 80208000 T 0126 + IF CURKIND!PROC THEN ERROR(7); 80209000 T 0127 + T3:=0; 80210000 T 0129 + END; 80211000 T 0130 + T3.IDCLASS:=CURKIND; T3.FORMAL:=1; 80212000 T 0130 + FOR I:=P1 STEP 1 UNTIL NUMPARAMS DO 80213000 T 0133 + NAMETAB3[CURLEVEL+1,PARAMTAB[I].PARAMNAME]:=T3; 80214000 T 0135 + END UNTIL CURSY!SEMICOLON; 80215000 T 0140 + IF CURSY!RPAR THEN 80216000 T 0141 + BEGIN ERROR(49); SKIP(RPAR); 80217000 T 0142 + IF CURSY=RPAR THEN INSYMBOL; 80218000 T 0144 + END ELSE INSYMBOL; 80219000 T 0146 + END; 80220000 T 0147 + PARAMTAB[FIRSTPARAM]:=NUMPARAMS-FIRSTPARAM; 80221000 T 0147 + END OF PARAMETERLIST; 80222000 T 0149 + 39 IS 154 LONG, NEXT SEG 2 + 80223000 T 0368 + 80400000 T 0368 + PROCEDURE BLOCK; 80401000 T 0368 + BEGIN 80402000 T 0368 + INTEGER INDEX,CTYPE,NUMFORWARDS,T,T3,TX,I; 80403000 T 0368 + START OF SEGMENT ********** 40 + REAL CVAL; 80404000 T 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 + IF CURLEVEL>1 THEN GEN("BEGIN",6,3); 80421000 T 0007 + START: 80422000 T 0018 + IF CURSY=LABELSY THEN %*** LABEL DECLARATION *** 80423000 T 0018 + BEGIN %************************* 80424000 T 0018 + GEN("LABEL",6,3); 80425000 T 0019 + DO BEGIN 80426000 T 0028 + INSYMBOL; 80427000 T 0028 + IF CURSY=INTCONST THEN 80428000 T 0028 + BEGIN 80429000 T 0029 + GENID("L",CURVAL,4); 80430000 T 0030 + IF CURVAL>9999 THEN ERROR(33); 80431000 T 0041 + FOR I:=FIRSTLAB STEP 1 UNTIL NUMLABS DO 80432000 T 0043 + IF LABTAB[I].LABVAL=CURVAL THEN ERROR(31); 80433000 T 0048 + IF NUMLABS}MAXLABS THEN BEGIN ERROR(34); NUMLABS:=0 END; 80434000 T 0053 + NUMLABS:=NUMLABS+1; 80435000 T 0055 + LABTAB[NUMLABS]:=CURVAL; 80436000 T 0057 + INSYMBOL; 80437000 T 0058 + END ELSE BEGIN ERROR(10); SKIP(COMMA) END; 80438000 T 0058 + IF CURSY=COMMA THEN GEN(",",1,7); 80439000 T 0060 + END UNTIL CURSY!COMMA; 80440000 T 0071 + IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80441000 T 0072 + GEN(";",1,7); 80442000 T 0075 + IF SYMKIND[CURSY]!INITIAL THEN INSYMBOL; 80443000 T 0084 + END OF LABEL DECLARATION; 80444000 T 0086 + 80445000 T 0086 + IF CURSY=CONSTSY THEN %*** CONSTANT DECLARATION *** 80446000 T 0086 + BEGIN %**************************** 80447000 T 0086 + INSYMBOL; 80448000 T 0087 + DO BEGIN 80449000 T 0087 + IF CURSY=IDENTIFIER THEN 80450000 T 0087 + BEGIN 80451000 T 0088 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80452000 T 0089 + INSYMBOL; 80453000 T 0111 + IF CURSY=EQLSY THEN 80454000 T 0112 + BEGIN 80455000 T 0113 + INSYMBOL; CONSTANT(CVAL,CTYPE); 80456000 T 0113 + T3:=CTYPE; T3.IDCLASS:=CONST; 80457000 T 0200 + IF CVAL.[46:8]!0 OR CVAL>1023 THEN 80458000 T 0203 + BEGIN 80459000 T 0205 + IF NUMCONSTS}MAXCONSTS THEN 80460000 T 0206 + BEGIN ERROR(35); NUMCONSTS:=0 END; 80461000 T 0206 + NUMCONSTS:=NUMCONSTS+1; 80462000 T 0208 + CONSTTAB[NUMCONSTS]:=CVAL; 80463000 T 0210 + T3.INFO:=1023+NUMCONSTS; 80464000 T 0211 + END ELSE T3.INFO:=CVAL; 80465000 T 0213 + NAMETAB3[CURLEVEL,INDEX]:=T3; 80466000 T 0215 + END ELSE BEGIN ERROR(36); SKIP(SEMICOLON) END; 80467000 T 0217 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80468000 T 0219 + IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80469000 T 0221 + IF SYMKIND[CURSY]!INITIAL THEN INSYMBOL; 80470000 T 0224 + END UNTIL CURSY!IDENTIFIER; 80471000 T 0226 + END OF CONSTANT DECLARATION; 80472000 T 0227 + 80473000 T 0227 + IF CURSY=TYPESY THEN %*** TYPE DECLARATION **** 80474000 T 0227 + BEGIN %************************* 80475000 T 0228 + INSYMBOL; 80476000 T 0229 + DO BEGIN 80477000 T 0229 + IF CURSY=IDENTIFIER THEN 80478000 T 0229 + BEGIN 80479000 T 0230 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80480000 T 0230 + INSYMBOL; 80481000 T 0253 + IF CURSY=EQLSY THEN 80482000 T 0254 + BEGIN 80483000 T 0254 + INSYMBOL; 80484000 T 0255 + TYPEDECL(CTYPE,TX); 80485000 T 0255 + T3:=CTYPE; T3.IDCLASS:=TYPES; 80486000 T 0256 + NAMETAB3[CURLEVEL,INDEX]:=T3; 80487000 T 0259 + END ELSE BEGIN ERROR(36); SKIP(SEMICOLON) END; 80488000 T 0261 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80489000 T 0263 + IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80490000 T 0265 + IF SYMKIND[CURSY]!INITIAL THEN INSYMBOL; 80491000 T 0268 + END UNTIL CURSY!IDENTIFIER; 80492000 T 0270 + END OF TYPE DECLARATION; 80493000 T 0271 + 80494000 T 0271 + IF CURSY=VARSY THEN %*** VARIABLE DECLARATION *** 80495000 T 0271 + BEGIN %**************************** 80496000 T 0272 + VARINDEX:=0; 80497000 T 0272 + DO BEGIN 80498000 T 0273 + FIRSTVAR:=VARINDEX+1; 80499000 T 0273 + DO BEGIN 80500000 T 0274 + IF CURSY=VARSY OR CURSY=COMMA THEN INSYMBOL; 80501000 T 0274 + IF CURSY=IDENTIFIER THEN 80502000 T 0277 + BEGIN 80503000 T 0278 + IF VARINDEX}LISTLENGTH THEN 80504000 T 0278 + BEGIN ERROR(37); VARINDEX:=0 END; 80505000 T 0279 + VARINDEX:=VARINDEX+1; 80506000 T 0281 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); 80507000 T 0282 + VARLIST[VARINDEX]:=THISINDEX; 80508000 T 0304 + INSYMBOL; 80509000 T 0305 + END ELSE BEGIN ERROR(9); SKIP(COLON) END; 80510000 T 0306 + END UNTIL CURSY!COMMA; 80511000 T 0308 + IF CURSY!COLON THEN BEGIN ERROR(26); SKIP(COLON) END; 80512000 T 0309 + IF CURSY=COLON THEN 80513000 T 0312 + BEGIN 80514000 T 0313 + INSYMBOL; 80515000 T 0313 + TYPEDECL(CTYPE,TX); 80516000 T 0314 + T3:=CTYPE; T3.IDCLASS:=VAR; 80517000 T 0315 + FOR I:=FIRSTVAR STEP 1 UNTIL VARINDEX DO 80518000 T 0317 + NAMETAB3[CURLEVEL,VARLIST[I]]:=T3; 80519000 T 0319 + END ELSE BEGIN ERROR(26); SKIP(SEMICOLON) END; 80520000 T 0323 + IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80521000 T 0325 + IF SYMKIND[CURSY]!INITIAL THEN INSYMBOL; 80522000 T 0328 + END UNTIL CURSY!IDENTIFIER; 80523000 T 0330 + DECLAREVARS(FALSE,VARLIST,1,VARINDEX,CURLEVEL); 80524000 T 0331 + END OF VARIABLE DECLARATIONS; 80525000 T 0333 + 80526000 T 0333 + IF NUMPNTRS>0 THEN 80527000 T 0333 + BEGIN 80528000 T 0334 + C1:=CURNAME1; C2:=CURNAME2; 80529000 T 0335 + FOR I:=1 STEP 1 UNTIL NUMPNTRS DO 80530000 T 0336 + BEGIN 80531000 T 0338 + CURNAME1:=PNTRTAB1[I]; CURNAME2:=PNTRTAB2[I]; 80532000 T 0338 + SEARCHTAB(CURLEVEL); 80533000 T 0340 + THISID:=NAMETAB3[CURLEVEL,THISINDEX]; 80534000 T 0358 + IF FOUND AND THISID.IDCLASS=TYPES THEN 80535000 T 0359 + TYPETAB1[PNTRTAB3[I]].POINTTYPE:=THISID.TYPE ELSE ERROR(62); 80536000 T 0361 + END; 80537000 T 0366 + CURNAME1:=C1; CURNAME2:=C2; NUMPNTRS:=0; 80538000 T 0368 + END; 80539000 T 0371 + 80540000 T 0371 + WHILE CURSY=FUNCSY OR CURSY=PROCSY DO %*** PROC/FUNC DECLARATION *** 80541000 T 0371 + BEGIN %***************************** 80542000 T 0373 + FUN:=CURSY=FUNCSY; INSYMBOL; 80543000 T 0373 + IF CURSY=IDENTIFIER THEN 80544000 T 0375 + BEGIN 80545000 T 0375 + SEARCHTAB(CURLEVEL); 80546000 T 0376 + THISID:=NAMETAB3[CURLEVEL,THISINDEX]; 80547000 T 0394 + IF FOUND AND THISID.IDCLASS}PROC THEN 80548000 T 0396 + BEGIN 80549000 T 0397 + INDEX:=THISINDEX; 80550000 T 0398 + IF THISID.FORWARDDEF=1 THEN 80551000 T 0399 + BEGIN 80552000 T 0400 + NAMETAB3[THISLEVEL,THISINDEX].FORWARDDEF:=0; 80553000 T 0400 + NUMFORWARDS:=NUMFORWARDS-1; 80554000 T 0404 + IF(THISID.IDCLASS=PROC AND FUN)OR 80555000 T 0405 + (THISID.IDCLASS=FUNC AND NOT FUN) THEN ERROR(43); 80556000 T 0407 + INSYMBOL; 80567000 T 0410 + END ELSE BEGIN ERROR(2); SKIP(SEMICOLON) END; 80568000 T 0411 + END ELSE 80569000 T 0413 + BEGIN 80570000 T 0413 + NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80571000 T 0413 + T3:=0; T3.INFO:=NUMPARAMS+1; 80572000 T 0436 + T3.IDCLASS:=IF FUN THEN FUNC ELSE PROC; 80573000 T 0439 + NAMETAB3[CURLEVEL,INDEX]:=T3; 80574000 T 0442 + INSYMBOL; PARAMETERLIST; 80575000 T 0444 + IF CURSY=COLON THEN 80576000 T 0445 + BEGIN 80577000 T 0446 + IF NOT FUN THEN ERROR(48); 80578000 T 0446 + INSYMBOL; 80579000 T 0448 + IF CURSY=IDENTIFIER THEN 80580000 T 0449 + BEGIN 80581000 T 0449 + SEARCH; 80582000 T 0450 + IF FOUND THEN 80583000 T 0477 + BEGIN 80584000 T 0478 + IF THISID.IDCLASS=TYPES THEN 80585000 T 0478 + BEGIN 80586000 T 0479 + T:=TYPETAB1[THISID.TYPE]; 80587000 T 0480 + IF T.FORM{ALFA OR T.FORM=POINTERS THEN 80588000 T 0481 + BEGIN 80589000 T 0484 + NAMETAB3[CURLEVEL,INDEX].TYPE:=THISID.TYPE; 80590000 T 0485 + END ELSE ERROR(38); 80591000 T 0488 + END ELSE ERROR(7); 80592000 T 0490 + END ELSE ERROR(1); 80593000 T 0491 + END ELSE ERROR(9); 80594000 T 0492 + INSYMBOL; 80595000 T 0493 + END ELSE IF FUN THEN 80596000 T 0494 + BEGIN ERROR(26); SKIP(SEMICOLON) END; 80597000 T 0495 + END; 80598000 T 0497 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80599000 T 0497 + IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80600000 T 0499 + IF FUN THEN GEN("FUNCTN",7,2) ELSE 80601000 T 0501 + GEN("PROCEDU",8,1); GENID("V",1000|CURLEVEL+INDEX,5); 80602000 T 0511 + T:=NAMETAB3[CURLEVEL,INDEX].INFO; TX:=T+PARAMTAB[T]; 80603000 T 0534 + IF TX>T THEN 80604000 T 0538 + BEGIN 80605000 T 0539 + GEN("(",1,7); 80606000 T 0539 + FOR I:=T+1 STEP 1 UNTIL TX DO 80607000 T 0548 + BEGIN GENID("V",1000|(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80608000 T 0552 + IF BOOLEAN(PARAMTAB[I].PARAMFILE) THEN 80609000 T 0566 + BEGIN 80610000 T 0567 + GEN(",",1,7); 80611000 T 0568 + GENID("F",1000|(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80612000 T 0577 + GEN(",",1,7); 80613000 T 0590 + GENID("I",1000|(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80614000 T 0599 + END; 80615000 T 0613 + IF I LSS TX THEN GEN(",",1,7); 80616000 T 0613 + END; 80617000 T 0625 + GEN(");",2,6); 80618000 T 0626 + VALUEPARAMS:=FALSE; 80619000 T 0635 + FOR I:=T+1 STEP 1 UNTIL TX DO 80620000 T 0636 + IF PARAMTAB[I].PARAMKIND=CONST THEN 80621000 T 0640 + BEGIN 80622000 T 0641 + IF NOT VALUEPARAMS THEN 80623000 T 0642 + BEGIN GEN("VALUE",6,3); 80624000 T 0642 + VALUEPARAMS:=TRUE; 80625000 T 0652 + END ELSE GEN(",",1,7); 80626000 T 0653 + GENID("V",1000|(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80627000 T 0665 + END; 80628000 T 0678 + IF VALUEPARAMS THEN GEN(";",1,7); 80629000 T 0679 + DECLAREVARS(TRUE,PARAMTAB,T+1,TX,CURLEVEL+1); 80630000 T 0689 + END ELSE GEN(";",1,7); 80631000 T 0692 + 80632000 T 0701 + INSYMBOL; 80633000 T 0701 + IF CURNAME1="7FORWAR" AND CURNAME2="D" THEN 80634000 T 0702 + BEGIN 80635000 T 0704 + NAMETAB3[CURLEVEL,INDEX].FORWARDDEF:=1; 80636000 T 0704 + NUMFORWARDS:=NUMFORWARDS+1; 80637000 T 0707 + GEN("FORWARD",8,1); 80638000 T 0709 + INSYMBOL; 80639000 T 0718 + END ELSE 80640000 T 0718 + BEGIN 80641000 T 0718 + CURLEVEL:=CURLEVEL+1; 80642000 T 0721 + IF CURLEVEL}LASTREC THEN ERROR(55); 80643000 T 0722 + BLOCKTAB[CURLEVEL]:=NUMBLOCKS:=NUMBLOCKS+1; 80644000 T 0724 + T:=CURFUNC; CURFUNC:=IF FUN THEN INDEX ELSE -1; 80645000 T 0726 + BLOCK; %*** COMPILE PROCEDURE BODY *** 80646000 T 0729 + REPLACE POINTER(NAMETAB1[CURLEVEL,*]) BY 0 80647000 T 0730 + FOR MAXNAMES+1 WORDS; 80648000 T 0732 + CURLEVEL:=CURLEVEL-1; CURFUNC:=T; 80649000 T 0735 + TOPLEVEL:=CURLEVEL; 80650000 T 0737 + END; 80651000 T 0738 + IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80652000 T 0738 + GEN(";",1,7); 80653000 T 0741 + IF SYMKIND[CURSY]!INITIAL THEN INSYMBOL; 80654000 T 0750 + END OF PROCEDURE DECLARATION; 80655000 T 0752 + 80656000 T 0752 + 80657000 T 0752 + IF NUMFORWARDS>0 THEN ERROR(44); 80658000 T 0752 + GEN("INTEGER",8,1); 80659000 T 0756 + FOR I:=1 STEP 1 UNTIL MAXTEMPS DO 80660000 T 0765 + BEGIN GENID("T",I,2); 80661000 T 0767 + IF I1 THEN GEN("END",4,5); 80703000 T 0955 + END OF BLOCK; 80704000 T 0965 + 40 IS 976 LONG, NEXT SEG 2 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90001000 T 0368 + % % 90002000 T 0368 + % % 90003000 T 0368 + % % 90004000 T 0368 + % PART 9: THE MAIN PROGRAM. % 90005000 T 0368 + % ----------------- % 90006000 T 0368 + % % 90007000 T 0368 + % % 90008000 T 0368 + % % 90009000 T 0368 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90010000 T 0368 + 90011000 T 0368 + 90012000 T 0368 + INTEGER PROGNAMELENGTH; 90013000 T 0368 + ALPHA PROGNAME,ALGOLNAME; 90014000 T 0368 + 90015000 T 0368 + ALGOLNAME:="PASC000"&ENTIER(TIME(4) MOD 10)[17:5:6]; 90016000 T 0368 + ALGOLNAME:=ALGOLNAME&ENTIER(TIME(4) DIV 7)[11:5:6]; 90017000 T 0371 + ALGOLNAME:=ALGOLNAME&ENTIER(TIME(4) MOD 9)[5:5:6]; 90018000 T 0375 + USER:=TIME(-1); 90019000 T 0379 + FILL PASCALGOL WITH ALGOLNAME,USER; 90020000 T 0380 + BEGIN 90021000 T 0384 + FILE PASCRUN DISK SERIAL "PASCRUN"/"DISK" (2,10,150); 90022000 T 0384 + START OF SEGMENT ********** 41 + ARRAY BUF[0:9]; 90023000 T 0004 + LABEL EOF; 90024000 T 0006 + 90025000 T 0006 + WHILE TRUE DO 90026000 T 0006 + BEGIN 90027000 T 0007 + READ(PASCRUN,9,BUF[*]) [EOF]; 90028000 T 0007 + WRITE(PASCALGOL,10,BUF[*]); 90029000 T 0012 + END; 90030000 T 0017 + EOF: 90031000 T 0017 + END OF TRANSFER OF RUN TIME SYSTEM; 90032000 T 0018 + 41 IS 21 LONG, NEXT SEG 2 + CARDLENGTH:=72; 90033000 T 0387 + INITIALIZE; NEWCARD; 90034000 T 0387 + LISTOPTION:=CHECKOPTION:=TRUE; 90035000 T 0451 + C:=" "; INSYMBOL; 90036000 T 0453 + IF CURSY=PROGRAMSY THEN 90037000 T 0454 + BEGIN 90038000 T 0455 + INSYMBOL; 90039000 T 0455 + IF CURSY=IDENTIFIER THEN 90040000 T 0456 + BEGIN 90041000 T 0456 + PROGNAME:=CURNAME1.[35:36]; PROGNAMELENGTH:=MIN(6,CURLENGTH); 90042000 T 0457 + INSYMBOL; 90043000 T 0461 + IF CURSY=LPAR THEN 90044000 T 0462 + BEGIN 90045000 T 0462 + DO BEGIN 90046000 T 0463 + INSYMBOL; 90047000 T 0463 + IF CURSY=IDENTIFIER THEN 90048000 T 0463 + BEGIN 90049000 T 0464 + IF CURNAME1="50INPUT" THEN INPUTDECL:=TRUE ELSE 90050000 T 0465 + IF CURNAME1="6OUTPUT" THEN OUTPUTDECL:=TRUE ELSE 90051000 T 0467 + BEGIN 90052000 T 0471 + IF CURLENGTH>6 THEN ERROR(77); 90053000 T 0473 + NUMEXTFILES:=NUMEXTFILES+1; 90054000 T 0475 + IF NUMEXTFILES{MAXEXTFILES THEN 90055000 T 0476 + EXTFILETAB[NUMEXTFILES]:=CURNAME1 ELSE 90056000 T 0477 + IF NUMEXTFILES=MAXEXTFILES+1 THEN ERROR(73); 90057000 T 0478 + END; 90058000 T 0481 + END ELSE ERROR(9); 90059000 T 0481 + INSYMBOL; 90060000 T 0483 + END UNTIL CURSY!COMMA; 90061000 T 0483 + IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(SEMICOLON) END; 90062000 T 0484 + IF CURSY=RPAR THEN INSYMBOL; 90063000 T 0487 + IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 90064000 T 0489 + END ELSE BEGIN ERROR(58); SKIP(SEMICOLON) END; 90065000 T 0492 + END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 90066000 T 0494 + END ELSE BEGIN ERROR(75); SKIP(SEMICOLON) END; 90067000 T 0496 + INSYMBOL; 90068000 T 0498 + CURLEVEL:=1; 90069000 T 0498 + LASTREC:=MAXTABLES+1; 90070000 T 0499 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90071000 T 0500 + % % 90072000 T 0500 + BLOCK; % COMPILE USER PROGRAM. % 90073000 T 0500 + % % 90074000 T 0501 + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90075000 T 0501 + IF CURSY!DOT THEN 90076000 T 0501 + BEGIN 90077000 T 0501 + ERROR(76); 90078000 T 0502 + DO BLOCK UNTIL CURSY=DOT; 90079000 T 0503 + END; 90080000 T 0504 + IF FALSE THEN 90081000 T 0504 + BEGIN 90082000 T 0505 + ENDOFINPUT: ERROR(87); CHARCNT:=-1; 90083000 T 0505 + WRITE(LINES,TERMMESS); 90084000 T 0507 + END; 90085000 T 0510 + IF LISTOPTION AND CHARCNT}0 THEN PRINTLINE; 90086000 T 0510 + IF ERRINX>0 THEN PRINTERRORS; 90087000 T 0554 + WRITE(LINES[DBL]); 90088000 T 0556 + WRITE(LINES[DBL]); 90089000 T 0560 + IF NUMERRS=0 THEN 90090000 T 0564 + BEGIN 90091000 T 0565 + ARRAY ZIPARRAY[0:19], Z[0:0]; 90092000 T 0565 + START OF SEGMENT ********** 42 + POINTER ZIPPNT; 90093000 T 0005 + 90094000 T 0005 + DEFINE ZIPTEXT(TEXT,L)= 90095000 T 0005 + BEGIN 90096000 T 0005 + Z[0]:=TEXT; 90097000 T 0005 + REPLACE ZIPPNT:ZIPPNT BY POINTER(Z[*])+(8-L) FOR L; 90098000 T 0005 + END#; 90099000 T 0005 + 90100000 T 0005 + PROCEDURE ZIPNUM(N); % TRANSFERS A NUMBER TO THE ZIP BUFFER. 90101000 T 0005 + VALUE N; INTEGER N; 90102000 T 0005 + IF N{9 THEN ZIPTEXT(N,1) ELSE 90103000 T 0005 + BEGIN ZIPNUM(N DIV 10); ZIPTEXT(ENTIER(N MOD 10),1) END; 90104000 T 0014 + 90105000 T 0027 + WRITEALGOL; 90106000 T 0027 + WRITE(PASCALGOL,LASTLINE); 90107000 T 0027 + LOCK(PASCALGOL,SAVE); 90108000 T 0030 + ZIPPNT:=POINTER(ZIPARRAY[*]); 90109000 T 0032 + REPLACE ZIPPNT BY " " FOR 20 WORDS; 90110000 T 0033 + WRITE(LINES,NOERRORS); 90111000 T 0037 + ZIPTEXT("CC ",3); ZIPTEXT("COMPILE",7); 90112000 T 0040 + ZIPTEXT(" ",1); ZIPTEXT(PROGNAME,PROGNAMELENGTH); 90113000 T 0054 + ZIPTEXT("/",1); ZIPTEXT(USER,7); 90114000 T 0069 + ZIPTEXT(" XALGOL",7); ZIPTEXT(" ",1); 90115000 T 0083 + IF SAVEFACTOR>0 THEN ZIPTEXT("LIBRARY",7); 90116000 T 0098 + IF SAVEFACTOR<0 THEN ZIPTEXT("SYNTAX",6); 90117000 T 0106 + ZIPTEXT(";",1); 90118000 T 0115 + ZIPTEXT("XALGOL",6); ZIPTEXT(" FILE",5); 90119000 T 0122 + ZIPTEXT(" CARD=",6); ZIPTEXT(ALGOLNAME,7); 90120000 T 0137 + ZIPTEXT("/",1); ZIPTEXT(USER,7); 90121000 T 0160 + ZIPTEXT(" SERIAL",7); ZIPTEXT(";",1); 90122000 T 0174 + IF SAVEFACTOR>0 THEN 90123000 T 0189 + BEGIN 90124000 T 0190 + ZIPTEXT("SAVE=",5); ZIPNUM(SAVEFACTOR); 90125000 T 0190 + ZIPTEXT(";",1); 90126000 T 0198 + END; 90127000 T 0205 + ZIPTEXT("END.",4); 90128000 T 0205 + ZIP WITH ZIPARRAY[*]; 90129000 T 0213 + END OF COMPILER ZIP ELSE 90130000 T 0214 + 42 IS 221 LONG, NEXT SEG 2 + BEGIN 91001000 T 0566 + INTEGER I; 91002000 T 0566 + START OF SEGMENT ********** 43 + SWITCH FORMAT ERRORMESS1 := 91003000 T 0000 + START OF SEGMENT ********** 44 + (" 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 VARIABLE NOT ACCESSIBLE (HARDWARE RESTRICTION)."), 91009000 T 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."), 91045000 T 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 TOO MANY RECORDS DECLARED AT ONE TIME."), 91060000 T 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 + 44 IS 590 LONG, NEXT SEG 43 + 91065000 T 0000 + SWITCH FORMAT ERRORMESS2 := 91066000 T 0000 + START OF SEGMENT ********** 45 + (" 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 DISCOVERED."), 91094000 T 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 ASSIGNMENT OF STRUCTURED VARIABLES NOT IMPLIMENTED."), 91102000 T 0000 + (" 96 INPUT/OUPUT NOT DECLARED."), 91103000 T 0000 + (" 97 TOO MANY FILES IN USE."), 91104000 T 0000 + (" 98 RECORD IDENTIFIER EXPECTED."), 91105000 T 0000 + (" 99 UNRECOGNIZED ITEM."), 91106000 T 0000 + (); 91107000 T 0000 + 45 IS 428 LONG, NEXT SEG 43 + 91108000 T 0000 + 91109000 T 0000 + WRITE(LINES,ERRORS,NUMERRS); 91110000 T 0000 + FOR I:=0 STEP 1 UNTIL 59 DO IF ERR[I] THEN 91111000 T 0007 + WRITE(LINES,ERRORMESS1[I]); 91112000 T 0008 + FOR I:=60 STEP 1 UNTIL 119 DO IF ERR[I] THEN 91113000 T 0015 + WRITE(LINES,ERRORMESS2[I-60]); 91114000 T 0016 + END OF ERROR MESSAGES; 91115000 T 0023 + 43 IS 28 LONG, NEXT SEG 2 + IF XREFOPTION THEN 92001000 T 0567 + BEGIN 92002000 T 0567 + REPLACE POINTER(XREFLINE[*]) BY " " FOR 17 WORDS; 92003000 T 0567 + HEADING; 92004000 T 0572 + SORT(PRINTXREF,XREFFILE,0,XREFMAX,XREFCOMPARE,3,1000,6000); 92005000 T 0592 + END; 92006000 T 0612 + END OF B5700 PASCAL COMPILER COMPILER................................... 99001000 T 0612 + 2 IS 618 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 = 311 SECONDS. + +PRT SIZE = 280; TOTAL SEGMENT SIZE = 15629 WORDS; DISK SIZE = 720 SEGS; NO. PGM. SEGS = 62 + +ESTIMATED CORE STORAGE REQUIRED = 25989 WORDS. + +ESTIMATED AUXILIARY MEMORY REQUIRED = 0 WORDS. + + + + + LABEL 0XALGOL 0COMPILE00186180?COMPILE PASCAL/DISK XALGOL LIBRARY XALGOL /PASCAL + + + + + diff --git a/PASCAL-Heriot-Watt/PASCAL.MKXIII.card b/PASCAL-Heriot-Watt/PASCAL.MKXIII.card new file mode 100644 index 0000000..20d77b2 --- /dev/null +++ b/PASCAL-Heriot-Watt/PASCAL.MKXIII.card @@ -0,0 +1,23 @@ +?COMPILE PASCAL/DISK XALGOL LIBRARY +?XALGOL FILE TAPE=SYMBOL/PASCAL SERIAL +?DATA CARD +$ TAPE LIST SINGLE SEQXEQ 00000010 + ALIST ("$ CARD LIST SINGLE"), 10189000 + NOALIST ("$ CARD"), 10190000 + FILL SYMKIND[*] WITH 20305000 + MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE, 20305100 + MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE, 20305200 + MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE, 20305300 + MIDDLE,MIDDLE,MIDDLE,MIDDLE, 20305400 + TERMINAL,MIDDLE,MIDDLE,MIDDLE,MIDDLE,INITIAL,TERMINAL, 20305500 + MIDDLE,INITIAL,MIDDLE,MIDDLE,INITIAL,MIDDLE,INITIAL, 20307000 + MIDDLE,MIDDLE,MIDDLE,MIDDLE, 20307100 + INITIAL,INITIAL,INITIAL,INITIAL,INITIAL,INITIAL,INITIAL,MIDDLE; 20308000 + FILL SYMBOL[*] WITH 0,0,0,0,0,0,0,0,0,0,0, 20310000 + ARROW,0,COLON,GTRSY,GEQSY,PLUS,0,0,0,0,0,0,0,0,0, 20310100 + DOT,LBRACKET,ANDSY,LPAR,LSSSY,ARROW, 20311000 + 0,0,0,0,0,0,0,0,0,0,0,ASTERISK,MINUS, 20311100 + RPAR,SEMICOLON,LEQSY,0,SLASH, 20312000 + 0,0,0,0,0,0,0,0,COMMA,0,NEQSY,EQLSY,RBRACKET,0,DOUBLEDOT; 20313000 +END;END. LAST CARD IN PATCH DECK 99999999 +?END diff --git a/PASCAL-Heriot-Watt/PASCRUN.DISK.alg_m b/PASCAL-Heriot-Watt/PASCRUN.DISK.alg_m index 2841e56..1c2c5ef 100644 --- a/PASCAL-Heriot-Watt/PASCRUN.DISK.alg_m +++ b/PASCAL-Heriot-Watt/PASCRUN.DISK.alg_m @@ -1,481 +1,475 @@ -?EXECUTE OBJECT/READER -?COMMON=3 -?FILE NEWTAPE = PASCRUN/DISK SERIAL -?DATA CARD -$ CARD SEQSEQ RESSET LIST% 00001 -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00002 -% % 00003 -% THE PASCAL RUN TIME-SYSTEM. % 00004 -% --------------------------- % 00005 -% % 00006 -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00007 -BEGIN% 00008 -INTEGER V00167,V00168,V00169;% 00009 -FILE INPUT "INPUT" (2,10);% 00010 -FILE OUTPUT 1 (2,17);% 00011 -% 00012 -DEFINE PROCEDU =PROCEDURE#,% 00013 - FUNCTN =REAL PROCEDURE#,% 00014 - DOWNTO =STEP -1 UNTIL#,% 00015 - UPTO =STEP 1 UNTIL#,% 00016 - B =BOOLEAN#,% 00017 - F00603 =INPUT#,% 00018 - F00742 =OUTPUT#,% 00019 - LASTCH =[5:6]#,% 00020 - BUFSIZE =[13:8]#,% 00021 - BUFPNT =[21:8]#,% 00022 - EOF =[22:1]#,% 00023 - EOLN =[23:1]#,% 00024 - INP =[24:1]#,% 00025 - OUTP =[25:1]#,% 00026 - ENDFOUND=[26:1]#,% 00027 - MEMSIZE =10000#,% 00028 - MAXINT =549755813887#;% 00029 -% 00030 -ARRAY MEM[0:MEMSIZE DIV 1022,0:1022], TEXT,CHAR[0:0], TEMPTEXT[0:19],% 00031 - V00603[0:9], V00742[0:16];% 00032 -INTEGER MEMPNT,T,T1,I00603,I00742;% 00033 -POINTER CHARPNT,TEXTPNT;% 00034 -LABEL TERMINATE;% 00035 -FORMAT TERMMESS ("**** PROGRAM EXECUTION TERMINATED AT LINE ",I*,"."),% 00036 - CHECKERR ("**** THE VALUE ",I*," IS NOT IN THE RANGE ",I*,"..",% 00037 - I*,"."),% 00038 - ERRMARK (X*,"X"),% 00039 - CONCATERR("**** CONCAT ERROR: [",I*,":",I*,":",I*,"]"),% 00040 - ILLEGALCC("**** ILLEGAL CARRIAGE CONTROL CHARACTER:"""",A1,""");% 00041 -SWITCH FORMAT ERRMESS :=% 00042 - (),% 00043 - ("**** NO READING WHILE EOF IS TRUE."), %1 00044 - ("**** NO WRITING WHILE EOF IS FALSE."), %2 00045 - ("**** ILLEGAL CHARACTER,"), %3 00046 - ("**** OVERFLOW ERROR."), %4 00047 - ("**** NO RESET/REWRITE ON INPUT/OUTPUT."), %5 00048 - ("**** LINE IMAGE OVERFLOW."); %6 00049 -MONITOR EXPOVR:=REALOVERFLOW;% 00050 -% 00051 -INTEGER PROCEDURE NUMDIGITS(N);% 00052 -VALUE N; INTEGER N;% 00053 -NUMDIGITS:=IF N<0 THEN 1+NUMDIGITS(-N) ELSE% 00054 - IF N>9 THEN 1+NUMDIGITS(N DIV 10) ELSE 1;% 00055 -% 00056 -PROCEDURE RUNERR(ERRNUM,LINENUM); %*** RUN TIME ERROR *** 00057 -VALUE ERRNUM,LINENUM;% 00058 -INTEGER ERRNUM,LINENUM;% 00059 -BEGIN% 00060 - WRITE(OUTPUT,ERRMESS[ERRNUM]);% 00061 - WRITE(OUTPUT,TERMMESS,NUMDIGITS(LINENUM),LINENUM);% 00062 - GO TO TERMINATE;% 00063 -END OF RUNNER;% 00064 -% 00065 -INTEGER PROCEDURE CHECK(VAL,LIM1,LIM2,LINENUM);% 00066 -VALUE VAL,LIM1,LIM2,LINENUM;% 00067 -INTEGER VAL,LIM1,LIM2,LINENUM;% 00068 -BEGIN% 00069 - IF VALLIM2 THEN% 00070 - BEGIN WRITE(OUTPUT,CHECKERR,NUMDIGITS(VAL),VAL,NUMDIGITS(LIM1),% 00071 - LIM1,NUMDIGITS(LIM2),LIM2);% 00072 - RUNERR(4,LINENUM);% 00073 - END;% 00074 - CHECK:=VAL;% 00075 -END OF CHECK;% 00076 -% 00077 -ALPHA PROCEDURE CURDAT;% 00078 -CURDAT:=" "&TIME(5)[41:35:36];% 00079 -% 00080 -ALPHA PROCEDURE WEEKDA;% 00081 -WEEKDA:=TIME(6)&" "[41:5:6];% 00082 -% 00083 -INTEGER PROCEDURE TRUNC(X,LINENUM);% 00084 -VALUE X,LINENUM;% 00085 -REAL X; INTEGER LINENUM;% 00086 -BEGIN% 00087 - IF ABS(X)>MAXINT THEN RUNERR(4,LINENUM);% 00088 - TRUNC:=IF X<0 THEN -ENTIER(-X) ELSE ENTIER(X);% 00089 -END OF TRUNC; 00090 -% 00091 -INTEGER PROCEDURE ROUND(X,LINENUM);% 00092 -VALUE X,LINENUM;% 00093 -REAL X; INTEGER LINENUM;% 00094 -BEGIN% 00095 - IF ABS(X)>MAXINT THEN RUNERR(4,LINENUM);% 00096 - ROUND:=X;% 00097 -END OF ROUND;% 00098 -% 00099 -BOOLEAN PROCEDURE ODD(N);% 00100 -VALUE N; INTEGER N;% 00101 -ODD:=N MOD 2 = 1;% 00102 -% 00103 -REAL PROCEDURE SQR(X,LINENUM);% 00104 -VALUE X,LINENUM;% 00105 -REAL X; INTEGER LINENUM;% 00106 -BEGIN% 00107 - IF ABS(X)>2.0769187@34 THEN RUNERR(4,LINENUM);% 00108 - SQR:=X|X;% 00109 -END OF SQR;% 00110 -% 00111 -BOOLEAN PROCEDURE INCL1(A,B); %*** IS THE SET "A" INCLUDED 00112 -VALUE A,B; REAL A,B; %*** IN THE SET "B". 00113 -INCL1:=REAL(BOOLEAN(A) AND NOT BOOLEAN(B))=0;% 00114 -% 00115 -BOOLEAN PROCEDURE INCL2(A,B); %*** IS THE SET "B" INCLUDED 00116 -VALUE A,B; REAL A,B; %*** IN THE SET "A". 00117 -INCL2:=REAL(BOOLEAN(B) AND NOT BOOLEAN(A))=0;% 00118 -% 00119 -BOOLEAN PROCEDURE INTST(A,B); %*** IS THE VALUE "A" AN ELEMENT 00120 -VALUE A,B; REAL A,B; %*** IN THE SET "B". 00121 -INTST:=IF A<0 OR B>38 THEN FALSE ELSE 0&B[0:38-A:1]=1;% 00122 -% 00123 -PROCEDURE NEW(P,SIZE);% 00124 -VALUE SIZE; REAL P; INTEGER SIZE;% 00125 -BEGIN% 00126 - P:=IF MEMPNT+SIZE>MEMSIZE THEN 0 ELSE MEMPNT;% 00127 - MEMPNT:=MEMPNT+SIZE;% 00128 -END OF NEW;% 00129 -% 00130 -PROCEDURE DISPOSE(P,SIZE);% 00131 -VALUE SIZE; REAL P; INTEGER SIZE;% 00132 -BEGIN% 00133 -END OF DISPOSE;% 00134 -% 00135 -PROCEDURE PACK(A,LLIM,ULIM,I,Z,LINENUM);% 00136 -VALUE LLIM,ULIM,I,LINENUM;% 00137 -ARRAY A[*]; ALPHA Z;% 00138 -INTEGER LLIM,ULIM,I,LINENUM;% 00139 -BEGIN;% 00140 - Z:=0;% 00141 - FOR T1:=0 STEP 1 UNTIL 6 DO% 00142 - Z:=A[CHECK(I+T1,LLIM,ULIM,LINENUM)] & Z [41:35:36];% 00143 -END;% 00144 -% 00145 -PROCEDURE UNPACK(Z,A,LLIM,ULIM,I,LINENUM);% 00146 -VALUE Z,LLIM,ULIM,I,LINENUM;% 00147 -ARRAY A[*]; ALPHA Z;% 00148 -INTEGER LLIM,ULIM,I,LINENUM;% 00149 -FOR T1:=0 STEP 1 UNTIL 6 DO% 00150 -A[CHECK(I+T1,LLIM,ULIM,LINENUM)]:= 0 & Z [5:41-6|T1:6];% 00151 -% 00152 -REAL PROCEDURE CONCAT(A,B,AS,BS,N,LINENUM);% 00153 -VALUE A,B,AS,BS,N,LINENUM;% 00154 -REAL A,B; INTEGER AS,BS,N,LINENUM;% 00155 -BEGIN% 00156 - IF AS<1 OR BS<1 OR N<0 OR AS+N>48 OR BS+N>48 THEN% 00157 - BEGIN% 00158 - WRITE(OUTPUT,CONCATERR,NUMDIGITS(AS),AS,NUMDIGITS(BS),% 00159 - BS,NUMDIGITS(N),N);% 00160 - RUNERR(0,LINENUM);% 00161 - END; 00162 - CONCAT:=A & B [47-AS:47-BS:N];% 00163 -END OF CONCAT;% 00164 -% 00165 -BOOLEAN PROCEDURE BIT(N,LINENUM);% %*** SET BIT NO "N" IN A WORD. 00166 -VALUE N,LINENUM; INTEGER N,LINENUM;% 00167 -BIT:=BOOLEAN(0 & 1 [38-CHECK(N,0,38,LINENUM):0:1]);% 00168 -% 00169 -BOOLEAN PROCEDURE BITS(N1,N2,LINENUM); %*** SET BITS "N1".."N2". 00170 -VALUE N1,N2,LINENUM;% 00171 -INTEGER N1,N2,LINENUM;% 00172 -BITS:=BOOLEAN(0 & 3"7777777777777" [38-CHECK(N1,0,38,LINENUM):38:% 00173 - CHECK(N2,0,38,LINENUM)-N1+1]);% 00174 -% 00175 -PROCEDURE RLINE(F,BUF,INFO);% 00176 -FILE F; ARRAY BUF[0]; INTEGER INFO;% 00177 -BEGIN% 00178 - LABEL ENDFILE;% 00179 - INFO.EOLN:=0; INFO.BUFPNT:=1;% 00180 - READ(F,999,BUF[*]) [ENDFILE];% 00181 - REPLACE CHARPNT BY POINTER(BUF[*]) FOR 1;% 00182 - INFO.LASTCH:=CHAR[0];% 00183 - IF FALSE THEN% 00184 - BEGIN ENDFILE: INFO.ENDFOUND:=1;% 00185 - END;% 00186 -END OF RLINE;% 00187 -% 00188 -REAL PROCEDURE PREAD(F,BUF,INFO,MODE,LINENUM);% 00189 -VALUE MODE,LINENUM;% 00190 -FILE F; ARRAY BUF[0];% 00191 -INTEGER INFO,MODE,LINENUM;% 00192 -BEGIN% 00193 - DEFINE GETCHAR=% 00194 - BEGIN% 00195 - IF BOOLEAN(INFO.EOLN) THEN% 00196 - BEGIN% 00197 - RLINE(F,BUF,INFO); CH:=INFO.LASTCH;% 00198 - END ELSE% 00199 - IF INFO.BUFPNT=INFO.BUFSIZE THEN% 00200 - BEGIN CH:=" "; INFO.EOLN:=1 END ELSE% 00201 - BEGIN% 00202 - REPLACE CHARPNT BY POINTER(BUF[*])+INFO.BUFPNT FOR 1;% 00203 - CH:=CHAR[0]; INFO.BUFPNT:=INFO.BUFPNT+1;% 00204 - END END OF GETCHAR#;% 00205 -% 00206 - DEFINE READERR(ERRNUM)=% 00207 - BEGIN 00208 - WRITE(OUTPUT,999,BUF[*]);% 00209 - WRITE(OUTPUT,ERRMARK,INFO.BUFPNT-1);% 00210 - RUNERR(ERRNUM,LINENUM);% 00211 - END READERR#;% 00212 -% 00213 - REAL RES; ALPHA CH;% 00214 - BOOLEAN NEGATIVE,NEGEXP; INTEGER POWER,EXP;% 00215 - LABEL OVERFLOW,RETURN;% 00216 -% 00217 - IF BOOLEAN(INFO.EOF) THEN RUNERR(1,LINENUM);% 00218 - IF BOOLEAN(INFO.ENDFOUND) THEN% 00219 - BEGIN% 00220 - INFO.EOF:=1; PREAD:=0;% 00221 - GO TO RETURN;% 00222 - END;% 00223 - IF MODE=1 THEN %*** MODE = CHAR *** 00224 - BEGIN% 00225 - PREAD:=INFO.LASTCH; GETCHAR; INFO.LASTCH:=CH;% 00226 - END ELSE% 00227 - BEGIN %*** MODE = REAL/INTEGER *** 00228 - CH:=INFO.LASTCH;% 00229 - WHILE CH=" " AND NOT BOOLEAN(INFO.ENDFOUND) DO GETCHAR;% 00230 - IF BOOLEAN(INFO.ENDFOUND) THEN% 00231 - BEGIN% 00232 - INFO.EOF:=1; PREAD:=0;% 00233 - GO TO RETURN;% 00234 - END;% 00235 - IF CH="+" OR CH="-" THEN BEGIN NEGATIVE:=CH="-"; GETCHAR END;% 00236 - IF CH>9 THEN READERR(3);% 00237 - RES:=CH; GETCHAR;% 00238 - WHILE CH{9 DO BEGIN RES:=10|RES+CH; GETCHAR END;% 00239 - IF MODE=3 THEN % MODE = REAL. 00240 - BEGIN% 00241 - IF CH="." THEN% 00242 - BEGIN% 00243 - GETCHAR; IF CH>9 THEN READERR(3);% 00244 - WHILE CH{9 DO BEGIN RES:=10|RES+CH;POWER:=POWER-1;GETCHAR END; 00245 - END;% 00246 - IF CH="E" THEN% 00247 - BEGIN% 00248 - GETCHAR;% 00249 - IF CH="+" OR CH="-" THEN BEGIN NEGEXP:=CH="-"; GETCHAR END;% 00250 - IF CH>9 THEN READERR(3);% 00251 - WHILE CH{9 DO BEGIN EXP:=10|EXP+CH; GETCHAR END;% 00252 - IF NEGEXP THEN EXP:=-EXP;% 00253 - END; 00254 - POWER:=POWER+EXP;% 00255 - REALOVERFLOW:=OVERFLOW; RES:=RES|10*POWER;% 00256 - IF FALSE THEN OVERFLOW: READERR(4);% 00257 - REALOVERFLOW:=0;% 00258 - END ELSE IF RES>MAXINT THEN READERR(4);% 00259 - PREAD:=IF NEGATIVE THEN -RES ELSE RES;% 00260 - INFO.LASTCH:=CH;% 00261 - END;% 00262 -RETURN:% 00263 -END OF PREAD;% 00264 -% 00265 -% 00266 -PROCEDURE WLINE(F,BUF,INFO); %*** PRINT A LINE.*** 00267 -FILE F; ARRAY BUF[0]; INTEGER INFO;% 00268 -BEGIN% 00269 - ALPHA CC;% 00270 - IF BOOLEAN(INFO.OUTP) THEN% 00271 - BEGIN% 00272 - REPLACE CHARPNT BY POINTER(BUF[*]) FOR 1; CC:=CHAR[0];% 00273 - REPLACE POINTER(BUF[*]) BY " ";% 00274 - IF CC=" " THEN WRITE(OUTPUT,999,BUF[*]) ELSE% 00275 - IF CC="+" THEN WRITE(OUTPUT[NO],999,BUF[*]) ELSE% 00276 - BEGIN% 00277 - IF CC="0" THEN WRITE(OUTPUT) ELSE% 00278 - IF CC="-" THEN WRITE(OUTPUT[DBL]) ELSE% 00279 - IF CC="1" THEN WRITE(OUTPUT[PAGE]) ELSE% 00280 - WRITE(OUTPUT,ILLEGALCC,CC);% 00281 - WRITE(OUTPUT,999,BUF[*]);% 00282 - END;% 00283 - END ELSE WRITE(F,999,BUF[*]);% 00284 - REPLACE POINTER(BUF[*]) BY " " FOR INFO.BUFSIZE;% 00285 - INFO.BUFPNT:=0;% 00286 -END OF WLINE;% 00287 -% 00288 -% 00289 -PROCEDURE CHFIL(F);% 00290 -FILE F;% 00291 -BEGIN% 00292 - ARRAY A[0:6];% 00293 - SEARCH(F,A[*]);% 00294 - IF A[0]=-1 THEN% 00295 - BEGIN% 00296 - F.AREAS := 20;% 00297 - F.AREASIZE := 300;% 00298 - END;% 00299 -END OF CHFIL;% 00300 -% 00301 -% 00302 -PROCEDURE WALFA(F,BUF,INFO,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,ALENG, 00303 - LINENUM);% 00304 -VALUE A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,ALENG,LINENUM;% 00305 -FILE F; ARRAY BUF[0]; INTEGER INFO,ALENG,LINENUM;% 00306 -ALPHA A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12;% 00307 -BEGIN% 00308 - ALPHA A; POINTER PNT;% 00309 - LABEL EXIT;% 00310 - IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00311 - IF INFO.BUFPNT+ALENG}INFO.BUFSIZE THEN WLINE(F,BUF,INFO);% 00312 - PNT:=POINTER(BUF[*])+INFO.BUFPNT;% 00313 - INFO.BUFPNT:=INFO.BUFPNT+ALENG;% 00314 - FOR A:=A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12 DO% 00315 - BEGIN% 00316 - TEXT[0]:=A;% 00317 - REPLACE PNT:PNT BY TEXTPNT FOR MIN(ALENG,7);% 00318 - ALENG:=ALENG-7; IF ALENG{0 THEN GO TO EXIT;% 00319 - END;% 00320 -EXIT:% 00321 -END OF WALFA;% 00322 -% 00323 -% 00324 -PROCEDURE PWRITE(F,BUF,INFO,E,EMODE,M,N,LINENUM);% 00325 -VALUE E,EMODE,M,N,LINENUM;% 00326 -FILE F; ARRAY BUF[0]; REAL E; 00327 -INTEGER INFO,EMODE,M,N,LINENUM;% 00328 -BEGIN% 00329 - INTEGER NCHARS,NEXP,I; POINTER CPNT;% 00330 - DEFINE PUTCHAR(C)= % PUTS A CHARACTER INTO TEMPTEXT 00331 - BEGIN CHAR[0]:=C; NCHARS:=NCHARS+1;% 00332 - REPLACE CPNT:CPNT BY CHARPNT FOR 1;% 00333 - END#;% 00334 -% 00335 - PROCEDURE PUTINT(N); % PUTS AN INTEGER INTO TEMPTEXT 00336 - VALUE N; INTEGER N; % WITH ZERO SUPPRESSION. 00337 - IF N{9 THEN PUTCHAR(N) ELSE% 00338 - BEGIN PUTINT(N DIV 10); PUTCHAR(ENTIER(N MOD 10)) END;% 00339 -% 00340 - CPNT:=POINTER(TEMPTEXT[*]);% 00341 - IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00342 - IF EMODE=1 THEN %*** MODE = INTEGER *** 00343 - BEGIN% 00344 - IF E<0 THEN BEGIN PUTCHAR("-"); E:=-E END;% 00345 - PUTINT(E);% 00346 - END ELSE% 00347 - IF EMODE=2 THEN %*** MODE = REAL *** 00348 - BEGIN% 00349 - PUTCHAR(" ");% 00350 - IF E<0 THEN BEGIN PUTCHAR("-"); E:=-E END;% 00351 - IF E>MAXINT OR N<0 THEN % FLOATING-POINT. 00352 - BEGIN% 00353 - IF E>0 THEN% 00354 - BEGIN% 00355 - WHILE E<1 DO BEGIN NEXP:=NEXP-1; E:=10|E END;% 00356 - WHILE E}10 DO BEGIN NEXP:=NEXP+1; E:=E/10 END;% 00357 - END; 00358 - I:=MAX(M-8,1);% 00359 - E:=E+0.5|10*(-I);% 00360 - IF E GEQ 10 THEN BEGIN NEXP:=NEXP+1; E:=E/10 END;% 00361 - PUTCHAR(ENTIER(E)); E:=E-ENTIER(E); PUTCHAR(".");% 00362 - DO BEGIN% 00363 - E:=10|E; PUTCHAR(ENTIER(E));% 00364 - E:=E-ENTIER(E); I:=I-1;% 00365 - END UNTIL I{0;% 00366 - PUTCHAR("E");% 00367 - IF NEXP<0 THEN BEGIN PUTCHAR("-"); NEXP:=-NEXP END% 00368 - ELSE PUTCHAR("+");% 00369 - PUTCHAR(NEXP DIV 10); PUTCHAR(ENTIER(NEXP MOD 10));% 00370 - END ELSE% 00371 - BEGIN % FIXED-POINT. 00372 - E:=E+0.5|10*(-N);% 00373 - PUTINT(ENTIER(E)); PUTCHAR("."); E:=E-ENTIER(E);% 00374 - IF N>150 THEN RUNERR(6,LINENUM);% 00375 - FOR I:=1 STEP 1 UNTIL N DO% 00376 - BEGIN E:=10|E; PUTCHAR(ENTIER(E));% 00377 - E:=E-ENTIER(E);% 00378 - END END END ELSE% 00379 - IF EMODE=3 THEN %*** MODE = BOOLEAN *** 00380 - BEGIN% 00381 - IF E<0.5 THEN REPLACE CPNT BY "FALSE" ELSE REPLACE CPNT BY "TRUE"; 00382 - NCHARS:=IF E<0.5 THEN 5 ELSE 4;% 00383 - END ELSE% 00384 - IF EMODE=5 THEN %*** MODE = ALFA *** 00385 - BEGIN% 00386 - TEXT[0]:=E; NCHARS:=MIN(M,7);% 00387 - REPLACE CPNT:CPNT BY TEXTPNT FOR 7;% 00388 - END ELSE% 00389 - BEGIN %*** MODE = CHAR *** 00390 - PUTCHAR(E);% 00391 - END;% 00392 - IF NCHARS>M THEN M:=NCHARS;% 00393 - IF INFO.BUFPNT+M>INFO.BUFSIZE THEN WLINE(F,BUF,INFO);% 00394 - IF M>INFO.BUFSIZE THEN RUNERR(6,LINENUM);% 00395 - REPLACE POINTER(BUF[*])+(INFO.BUFPNT+M-NCHARS) BY% 00396 - POINTER(TEMPTEXT[*]) FOR NCHARS;% 00397 - INFO.BUFPNT:=INFO.BUFPNT+M;% 00398 -END OF PWRITE;% 00399 -% 00400 -% 00401 -PROCEDURE PUT(F,BUF,INFO,LINENUM);% 00402 -VALUE LINENUM;% 00403 -FILE F; ARRAY BUF[*];% 00404 -INTEGER INFO,LINENUM;% 00405 -BEGIN% 00406 - IF INFO.BUFSIZE=0 THEN% 00407 - BEGIN% 00408 - IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00409 - WRITE(F,1023,BUF[*]);% 00410 - END ELSE PWRITE(F,BUF,INFO,INFO.LASTCH,4,1,1,LINENUM);% 00411 -END OF PUT;% 00412 -% 00413 -% 00414 -PROCEDURE GET(F,BUF,INFO,LINENUM);% 00415 -VALUE LINENUM;% 00416 -FILE F; ARRAY BUF[*];% 00417 -INTEGER INFO,LINENUM;% 00418 -BEGIN% 00419 - ALPHA X; LABEL ENDFILE;% 00420 - IF INFO.BUFSIZE=0 THEN% 00421 - BEGIN% 00422 - IF BOOLEAN(INFO.EOF) THEN RUNERR(1,LINENUM);% 00423 - READ(F,1023,BUF[*]) [ENDFILE];% 00424 - IF FALSE THEN ENDFILE: INFO.EOF:=1;% 00425 - END ELSE X:=PREAD(F,BUF,INFO,1,LINENUM);% 00426 -END OF GET; 00427 -% 00428 -% 00429 -PROCEDURE PPAGE(F,BUF,INFO,LINENUM);% 00430 -VALUE LINENUM;% 00431 -FILE F; ARRAY BUF[*];% 00432 -INTEGER INFO,LINENUM;% 00433 -BEGIN% 00434 - IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00435 - WRITE(F[PAGE]);% 00436 -END OF PPAGE;% 00437 -% 00438 -% 00439 -PROCEDURE RESET(F,BUF,INFO,LINENUM);% 00440 -VALUE LINENUM;% 00441 -FILE F; ARRAY BUF[*];% 00442 -INTEGER INFO,LINENUM;% 00443 -BEGIN% 00444 - IF BOOLEAN(INFO.INP) OR BOOLEAN(INFO.OUTP) THEN RUNERR(5,LINENUM);% 00445 - REWIND(F); INFO.EOF:=0; INFO.EOLN:=0; INFO.BUFPNT:=0;% 00446 - INFO.ENDFOUND:=0;% 00447 - IF INFO.BUFSIZE=0 THEN GET(F,BUF,INFO,LINENUM)% 00448 - ELSE RLINE(F,BUF,INFO);% 00449 -END OF RESET;% 00450 -% 00451 -PROCEDURE REWRITE(F,BUF,INFO,LINENUM);% 00452 -VALUE LINENUM;% 00453 -FILE F; ARRAY BUF[*];% 00454 -INTEGER INFO,LINENUM;% 00455 -BEGIN% 00456 - IF BOOLEAN(INFO.INP) OR BOOLEAN(INFO.OUTP) THEN RUNERR(5,LINENUM);% 00457 - REWIND(F); INFO.EOF:=1; INFO.BUFPNT:=0; INFO.ENDFOUND:=0;% 00458 - IF INFO.BUFSIZE>0 THEN% 00459 - REPLACE POINTER(BUF[*]) BY " " FOR INFO.BUFSIZE;% 00460 -END OF REWRITE;% 00461 -% 00462 -% 00463 -PROCEDURE INIT(INPUTDECL);% 00464 -VALUE INPUTDECL;% 00465 -BOOLEAN INPUTDECL;% 00466 -BEGIN% 00467 - MEMPNT:=1;% 00468 - CHARPNT:=POINTER(CHAR[*])+7; TEXTPNT:=POINTER(TEXT[*])+1;% 00469 - T:=0; T.BUFSIZE:=80; T.BUFPNT:=80; T.EOLN:=1; T.INP:=1;% 00470 - I00603:=T; IF INPUTDECL THEN RLINE(INPUT,V00603,I00603);% 00471 - T:=0; T.BUFSIZE:=132; T.EOLN:=1; T.OUTP:=1; T.EOF:=1;% 00472 - I00742:=T;% 00473 - REPLACE POINTER(V00742[*]) BY " " FOR 17 WORDS;% 00474 -END OF INIT;% 00475 -?END. - \ No newline at end of file +$ CARD SEQXEQ RESET LIST% 00000001 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00000002 +% % 00000003 +% THE PASCAL RUN TIME-SYSTEM. % 00000004 +% --------------------------- % 00000005 +% % 00000006 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00000007 +BEGIN% 00000008 +INTEGER V00167,V00168,V00169;% 00000009 +FILE INPUT "INPUT" (2,10);% 00000010 +FILE OUTPUT 1 (2,17);% 00000011 +% 00000012 +DEFINE PROCEDU =PROCEDURE#,% 00000013 + FUNCTN =REAL PROCEDURE#,% 00000014 + DOWNTO =STEP -1 UNTIL#,% 00000015 + UPTO =STEP 1 UNTIL#,% 00000016 + B =BOOLEAN#,% 00000017 + F00603 =INPUT#,% 00000018 + F00742 =OUTPUT#,% 00000019 + LASTCH =[5:6]#,% 00000020 + BUFSIZE =[13:8]#,% 00000021 + BUFPNT =[21:8]#,% 00000022 + EOF =[22:1]#,% 00000023 + EOLN =[23:1]#,% 00000024 + INP =[24:1]#,% 00000025 + OUTP =[25:1]#,% 00000026 + ENDFOUND=[26:1]#,% 00000027 + MEMSIZE =10000#,% 00000028 + MAXINT =549755813887#;% 00000029 +% 00000030 +ARRAY MEM[0:MEMSIZE DIV 1022,0:1022], TEXT,CHAR[0:0], TEMPTEXT[0:19],% 00000031 + V00603[0:9], V00742[0:16];% 00000032 +INTEGER MEMPNT,T,T1,I00603,I00742;% 00000033 +POINTER CHARPNT,TEXTPNT;% 00000034 +LABEL TERMINATE;% 00000035 +FORMAT TERMMESS ("**** PROGRAM EXECUTION TERMINATED AT LINE ",I*,"."),% 00000036 + CHECKERR ("**** THE VALUE ",I*," IS NOT IN THE RANGE ",I*,"..",% 00000037 + I*,"."),% 00000038 + ERRMARK (X*,"|"),% 00000039 + CONCATERR("**** CONCAT ERROR: [",I*,":",I*,":",I*,"]"),% 00000040 + ILLEGALCC("**** ILLEGAL CARRIAGE CONTROL CHARACTER:"""",A1,""");%00000041 +SWITCH FORMAT ERRMESS :=% 00000042 + (),% 00000043 + ("**** NO READING WHILE EOF IS TRUE."), %1 00000044 + ("**** NO WRITING WHILE EOF IS FALSE."), %2 00000045 + ("**** ILLEGAL CHARACTER,"), %3 00000046 + ("**** OVERFLOW ERROR."), %4 00000047 + ("**** NO RESET/REWRITE ON INPUT/OUTPUT."), %5 00000048 + ("**** LINE IMAGE OVERFLOW."); %6 00000049 +MONITOR EXPOVR:=REALOVERFLOW;% 00000050 +% 00000051 +INTEGER PROCEDURE NUMDIGITS(N);% 00000052 +VALUE N; INTEGER N;% 00000053 +NUMDIGITS:=IF N<0 THEN 1+NUMDIGITS(-N) ELSE% 00000054 + IF N>9 THEN 1+NUMDIGITS(N DIV 10) ELSE 1;% 00000055 +% 00000056 +PROCEDURE RUNERR(ERRNUM,LINENUM); %*** RUN TIME ERROR *** 00000057 +VALUE ERRNUM,LINENUM;% 00000058 +INTEGER ERRNUM,LINENUM;% 00000059 +BEGIN% 00000060 + WRITE(OUTPUT,ERRMESS[ERRNUM]);% 00000061 + WRITE(OUTPUT,TERMMESS,NUMDIGITS(LINENUM),LINENUM);% 00000062 + GO TO TERMINATE;% 00000063 +END OF RUNNER;% 00000064 +% 00000065 +INTEGER PROCEDURE CHECK(VAL,LIM1,LIM2,LINENUM);% 00000066 +VALUE VAL,LIM1,LIM2,LINENUM;% 00000067 +INTEGER VAL,LIM1,LIM2,LINENUM;% 00000068 +BEGIN% 00000069 + IF VALLIM2 THEN% 00000070 + BEGIN WRITE(OUTPUT,CHECKERR,NUMDIGITS(VAL),VAL,NUMDIGITS(LIM1),% 00000071 + LIM1,NUMDIGITS(LIM2),LIM2);% 00000072 + RUNERR(4,LINENUM);% 00000073 + END;% 00000074 + CHECK:=VAL;% 00000075 +END OF CHECK;% 00000076 +% 00000077 +ALPHA PROCEDURE CURDAT;% 00000078 +CURDAT:=" "&TIME(5)[41:35:36];% 00000079 +% 00000080 +ALPHA PROCEDURE WEEKDA;% 00000081 +WEEKDA:=TIME(6)&" "[41:5:6];% 00000082 +% 00000083 +INTEGER PROCEDURE TRUNC(X,LINENUM);% 00000084 +VALUE X,LINENUM;% 00000085 +REAL X; INTEGER LINENUM;% 00000086 +BEGIN% 00000087 + IF ABS(X)>MAXINT THEN RUNERR(4,LINENUM);% 00000088 + TRUNC:=IF X<0 THEN -ENTIER(-X) ELSE ENTIER(X);% 00000089 +END OF TRUNC;% 00000090 +% 00000091 +INTEGER PROCEDURE ROUND(X,LINENUM);% 00000092 +VALUE X,LINENUM;% 00000093 +REAL X; INTEGER LINENUM;% 00000094 +BEGIN% 00000095 + IF ABS(X)>MAXINT THEN RUNERR(4,LINENUM);% 00000096 + ROUND:=X;% 00000097 +END OF ROUND;% 00000098 +% 00000099 +BOOLEAN PROCEDURE ODD(N);% 00000100 +VALUE N; INTEGER N;% 00000101 +ODD:=N MOD 2 = 1;% 00000102 +% 00000103 +REAL PROCEDURE SQR(X,LINENUM);% 00000104 +VALUE X,LINENUM;% 00000105 +REAL X; INTEGER LINENUM;% 00000106 +BEGIN% 00000107 + IF ABS(X)>2.0769187@34 THEN RUNERR(4,LINENUM);% 00000108 + SQR:=X|X;% 00000109 +END OF SQR;% 00000110 +% 00000111 +BOOLEAN PROCEDURE INCL1(A,B); %*** IS THE SET "A" INCLUDED 00000112 +VALUE A,B; REAL A,B; %*** IN THE SET "B". 00000113 +INCL1:=REAL(BOOLEAN(A) AND NOT BOOLEAN(B))=0;% 00000114 +% 00000115 +BOOLEAN PROCEDURE INCL2(A,B); %*** IS THE SET "B" INCLUDED 00000116 +VALUE A,B; REAL A,B; %*** IN THE SET "A". 00000117 +INCL2:=REAL(BOOLEAN(B) AND NOT BOOLEAN(A))=0;% 00000118 +% 00000119 +BOOLEAN PROCEDURE INTST(A,B); %*** IS THE VALUE "A" AN ELEMENT00000120 +VALUE A,B; REAL A,B; %*** IN THE SET "B". 00000121 +INTST:=IF A<0 OR B>38 THEN FALSE ELSE 0&B[0:38-A:1]=1;% 00000122 +% 00000123 +PROCEDURE NEW(P,SIZE);% 00000124 +VALUE SIZE; REAL P; INTEGER SIZE;% 00000125 +BEGIN% 00000126 + P:=IF MEMPNT+SIZE>MEMSIZE THEN 0 ELSE MEMPNT;% 00000127 + MEMPNT:=MEMPNT+SIZE;% 00000128 +END OF NEW;% 00000129 +% 00000130 +PROCEDURE DISPOSE(P,SIZE);% 00000131 +VALUE SIZE; REAL P; INTEGER SIZE;% 00000132 +BEGIN% 00000133 +END OF DISPOSE;% 00000134 +% 00000135 +PROCEDURE PACK(A,LLIM,ULIM,I,Z,LINENUM);% 00000136 +VALUE LLIM,ULIM,I,LINENUM;% 00000137 +ARRAY A[*]; ALPHA Z;% 00000138 +INTEGER LLIM,ULIM,I,LINENUM;% 00000139 +BEGIN;% 00000140 + Z:=0;% 00000141 + FOR T1:=0 STEP 1 UNTIL 6 DO% 00000142 + Z:=A[CHECK(I+T1,LLIM,ULIM,LINENUM)] & Z [41:35:36];% 00000143 +END;% 00000144 +% 00000145 +PROCEDURE UNPACK(Z,A,LLIM,ULIM,I,LINENUM);% 00000146 +VALUE Z,LLIM,ULIM,I,LINENUM;% 00000147 +ARRAY A[*]; ALPHA Z;% 00000148 +INTEGER LLIM,ULIM,I,LINENUM;% 00000149 +FOR T1:=0 STEP 1 UNTIL 6 DO% 00000150 +A[CHECK(I+T1,LLIM,ULIM,LINENUM)]:= 0 & Z [5:41-6|T1:6];% 00000151 +% 00000152 +REAL PROCEDURE CONCAT(A,B,AS,BS,N,LINENUM);% 00000153 +VALUE A,B,AS,BS,N,LINENUM;% 00000154 +REAL A,B; INTEGER AS,BS,N,LINENUM;% 00000155 +BEGIN% 00000156 + IF AS<1 OR BS<1 OR N<0 OR AS+N>48 OR BS+N>48 THEN% 00000157 + BEGIN% 00000158 + WRITE(OUTPUT,CONCATERR,NUMDIGITS(AS),AS,NUMDIGITS(BS),% 00000159 + BS,NUMDIGITS(N),N);% 00000160 + RUNERR(0,LINENUM);% 00000161 + END;% 00000162 + CONCAT:=A & B [47-AS:47-BS:N];% 00000163 +END OF CONCAT;% 00000164 +% 00000165 +BOOLEAN PROCEDURE BIT(N,LINENUM);% %*** SET BIT NO "N" IN A WORD. 00000166 +VALUE N,LINENUM; INTEGER N,LINENUM;% 00000167 +BIT:=BOOLEAN(0 & 1 [38-CHECK(N,0,38,LINENUM):0:1]);% 00000168 +% 00000169 +BOOLEAN PROCEDURE BITS(N1,N2,LINENUM); %*** SET BITS "N1".."N2". 00000170 +VALUE N1,N2,LINENUM;% 00000171 +INTEGER N1,N2,LINENUM;% 00000172 +BITS:=BOOLEAN(0 & 3"7777777777777" [38-CHECK(N1,0,38,LINENUM):38:% 00000173 + CHECK(N2,0,38,LINENUM)-N1+1]);% 00000174 +% 00000175 +PROCEDURE RLINE(F,BUF,INFO);% 00000176 +FILE F; ARRAY BUF[0]; INTEGER INFO;% 00000177 +BEGIN% 00000178 + LABEL ENDFILE;% 00000179 + INFO.EOLN:=0; INFO.BUFPNT:=1;% 00000180 + READ(F,999,BUF[*]) [ENDFILE];% 00000181 + REPLACE CHARPNT BY POINTER(BUF[*]) FOR 1;% 00000182 + INFO.LASTCH:=CHAR[0];% 00000183 + IF FALSE THEN% 00000184 + BEGIN ENDFILE: INFO.ENDFOUND:=1;% 00000185 + END;% 00000186 +END OF RLINE;% 00000187 +% 00000188 +REAL PROCEDURE PREAD(F,BUF,INFO,MODE,LINENUM);% 00000189 +VALUE MODE,LINENUM;% 00000190 +FILE F; ARRAY BUF[0];% 00000191 +INTEGER INFO,MODE,LINENUM;% 00000192 +BEGIN% 00000193 + DEFINE GETCHAR=% 00000194 + BEGIN% 00000195 + IF BOOLEAN(INFO.EOLN) THEN% 00000196 + BEGIN% 00000197 + RLINE(F,BUF,INFO); CH:=INFO.LASTCH;% 00000198 + END ELSE% 00000199 + IF INFO.BUFPNT=INFO.BUFSIZE THEN% 00000200 + BEGIN CH:=" "; INFO.EOLN:=1 END ELSE% 00000201 + BEGIN% 00000202 + REPLACE CHARPNT BY POINTER(BUF[*])+INFO.BUFPNT FOR 1;% 00000203 + CH:=CHAR[0]; INFO.BUFPNT:=INFO.BUFPNT+1;% 00000204 + END END OF GETCHAR#;% 00000205 +% 00000206 + DEFINE READERR(ERRNUM)=% 00000207 + BEGIN% 00000208 + WRITE(OUTPUT,999,BUF[*]);% 00000209 + WRITE(OUTPUT,ERRMARK,INFO.BUFPNT-1);% 00000210 + RUNERR(ERRNUM,LINENUM);% 00000211 + END READERR#;% 00000212 +% 00000213 + REAL RES; ALPHA CH;% 00000214 + BOOLEAN NEGATIVE,NEGEXP; INTEGER POWER,EXP;% 00000215 + LABEL OVERFLOW,RETURN;% 00000216 +% 00000217 + IF BOOLEAN(INFO.EOF) THEN RUNERR(1,LINENUM);% 00000218 + IF BOOLEAN(INFO.ENDFOUND) THEN% 00000219 + BEGIN% 00000220 + INFO.EOF:=1; PREAD:=0;% 00000221 + GO TO RETURN;% 00000222 + END;% 00000223 + IF MODE=1 THEN %*** MODE = CHAR *** 00000224 + BEGIN% 00000225 + PREAD:=INFO.LASTCH; GETCHAR; INFO.LASTCH:=CH;% 00000226 + END ELSE% 00000227 + BEGIN %*** MODE = REAL/INTEGER *** 00000228 + CH:=INFO.LASTCH;% 00000229 + WHILE CH=" " AND NOT BOOLEAN(INFO.ENDFOUND) DO GETCHAR;% 00000230 + IF BOOLEAN(INFO.ENDFOUND) THEN% 00000231 + BEGIN% 00000232 + INFO.EOF:=1; PREAD:=0;% 00000233 + GO TO RETURN;% 00000234 + END;% 00000235 + IF CH="+" OR CH="-" THEN BEGIN NEGATIVE:=CH="-"; GETCHAR END;% 00000236 + IF CH>9 THEN READERR(3);% 00000237 + RES:=CH; GETCHAR;% 00000238 + WHILE CH{9 DO BEGIN RES:=10|RES+CH; GETCHAR END;% 00000239 + IF MODE=3 THEN % MODE = REAL. 00000240 + BEGIN% 00000241 + IF CH="." THEN% 00000242 + BEGIN% 00000243 + GETCHAR; IF CH>9 THEN READERR(3);% 00000244 + WHILE CH{9 DO BEGIN RES:=10|RES+CH;POWER:=POWER-1;GETCHAR END;00000245 + END;% 00000246 + IF CH="E" THEN% 00000247 + BEGIN% 00000248 + GETCHAR;% 00000249 + IF CH="+" OR CH="-" THEN BEGIN NEGEXP:=CH="-"; GETCHAR END;% 00000250 + IF CH>9 THEN READERR(3);% 00000251 + WHILE CH{9 DO BEGIN EXP:=10|EXP+CH; GETCHAR END;% 00000252 + IF NEGEXP THEN EXP:=-EXP;% 00000253 + END;% 00000254 + POWER:=POWER+EXP;% 00000255 + REALOVERFLOW:=OVERFLOW; RES:=RES|10*POWER;% 00000256 + IF FALSE THEN OVERFLOW: READERR(4);% 00000257 + REALOVERFLOW:=0;% 00000258 + END ELSE IF RES>MAXINT THEN READERR(4);% 00000259 + PREAD:=IF NEGATIVE THEN -RES ELSE RES;% 00000260 + INFO.LASTCH:=CH;% 00000261 + END;% 00000262 +RETURN:% 00000263 +END OF PREAD;% 00000264 +% 00000265 +% 00000266 +PROCEDURE WLINE(F,BUF,INFO); %*** PRINT A LINE.*** 00000267 +FILE F; ARRAY BUF[0]; INTEGER INFO;% 00000268 +BEGIN% 00000269 + ALPHA CC;% 00000270 + IF BOOLEAN(INFO.OUTP) THEN% 00000271 + BEGIN% 00000272 + REPLACE CHARPNT BY POINTER(BUF[*]) FOR 1; CC:=CHAR[0];% 00000273 + REPLACE POINTER(BUF[*]) BY " ";% 00000274 + IF CC=" " THEN WRITE(OUTPUT,999,BUF[*]) ELSE% 00000275 + IF CC="+" THEN WRITE(OUTPUT[NO],999,BUF[*]) ELSE% 00000276 + BEGIN% 00000277 + IF CC="0" THEN WRITE(OUTPUT) ELSE% 00000278 + IF CC="-" THEN WRITE(OUTPUT[DBL]) ELSE% 00000279 + IF CC="1" THEN WRITE(OUTPUT[PAGE]) ELSE% 00000280 + WRITE(OUTPUT,ILLEGALCC,CC);% 00000281 + WRITE(OUTPUT,999,BUF[*]);% 00000282 + END;% 00000283 + END ELSE WRITE(F,999,BUF[*]);% 00000284 + REPLACE POINTER(BUF[*]) BY " " FOR INFO.BUFSIZE;% 00000285 + INFO.BUFPNT:=0;% 00000286 +END OF WLINE;% 00000287 +% 00000288 +% 00000289 +PROCEDURE CHFIL(F);% 00000290 +FILE F;% 00000291 +BEGIN% 00000292 + ARRAY A[0:6];% 00000293 + SEARCH(F,A[*]);% 00000294 + IF A[0]=-1 THEN% 00000295 + BEGIN% 00000296 + F.AREAS := 20;% 00000297 + F.AREASIZE := 300;% 00000298 + END;% 00000299 +END OF CHFIL;% 00000300 +% 00000301 +% 00000302 +PROCEDURE WALFA(F,BUF,INFO,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,ALENG,00000303 + LINENUM);% 00000304 +VALUE A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,ALENG,LINENUM;% 00000305 +FILE F; ARRAY BUF[0]; INTEGER INFO,ALENG,LINENUM;% 00000306 +ALPHA A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12;% 00000307 +BEGIN% 00000308 + ALPHA A; POINTER PNT;% 00000309 + LABEL EXIT;% 00000310 + IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00000311 + IF INFO.BUFPNT+ALENG}INFO.BUFSIZE THEN WLINE(F,BUF,INFO);% 00000312 + PNT:=POINTER(BUF[*])+INFO.BUFPNT;% 00000313 + INFO.BUFPNT:=INFO.BUFPNT+ALENG;% 00000314 + FOR A:=A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12 DO% 00000315 + BEGIN% 00000316 + TEXT[0]:=A;% 00000317 + REPLACE PNT:PNT BY TEXTPNT FOR MIN(ALENG,7);% 00000318 + ALENG:=ALENG-7; IF ALENG{0 THEN GO TO EXIT;% 00000319 + END;% 00000320 +EXIT:% 00000321 +END OF WALFA;% 00000322 +% 00000323 +% 00000324 +PROCEDURE PWRITE(F,BUF,INFO,E,EMODE,M,N,LINENUM);% 00000325 +VALUE E,EMODE,M,N,LINENUM;% 00000326 +FILE F; ARRAY BUF[0]; REAL E;% 00000327 +INTEGER INFO,EMODE,M,N,LINENUM;% 00000328 +BEGIN% 00000329 + INTEGER NCHARS,NEXP,I; POINTER CPNT;% 00000330 + DEFINE PUTCHAR(C)= % PUTS A CHARACTER INTO TEMPTEXT00000331 + BEGIN CHAR[0]:=C; NCHARS:=NCHARS+1;% 00000332 + REPLACE CPNT:CPNT BY CHARPNT FOR 1;% 00000333 + END#;% 00000334 +% 00000335 + PROCEDURE PUTINT(N); % PUTS AN INTEGER INTO TEMPTEXT 00000336 + VALUE N; INTEGER N; % WITH ZERO SUPPRESSION. 00000337 + IF N{9 THEN PUTCHAR(N) ELSE% 00000338 + BEGIN PUTINT(N DIV 10); PUTCHAR(ENTIER(N MOD 10)) END;% 00000339 +% 00000340 + CPNT:=POINTER(TEMPTEXT[*]);% 00000341 + IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00000342 + IF EMODE=1 THEN %*** MODE = INTEGER *** 00000343 + BEGIN% 00000344 + IF E<0 THEN BEGIN PUTCHAR("-"); E:=-E END;% 00000345 + PUTINT(E);% 00000346 + END ELSE% 00000347 + IF EMODE=2 THEN %*** MODE = REAL *** 00000348 + BEGIN% 00000349 + PUTCHAR(" ");% 00000350 + IF E<0 THEN BEGIN PUTCHAR("-"); E:=-E END;% 00000351 + IF E>MAXINT OR N<0 THEN % FLOATING-POINT. 00000352 + BEGIN% 00000353 + IF E>0 THEN% 00000354 + BEGIN% 00000355 + WHILE E<1 DO BEGIN NEXP:=NEXP-1; E:=10|E END;% 00000356 + WHILE E}10 DO BEGIN NEXP:=NEXP+1; E:=E/10 END;% 00000357 + END;% 00000358 + I:=MAX(M-8,1);% 00000359 + E:=E+0.5|10*(-I);% 00000360 + IF E GEQ 10 THEN BEGIN NEXP:=NEXP+1; E:=E/10 END;% 00000361 + PUTCHAR(ENTIER(E)); E:=E-ENTIER(E); PUTCHAR(".");% 00000362 + DO BEGIN% 00000363 + E:=10|E; PUTCHAR(ENTIER(E));% 00000364 + E:=E-ENTIER(E); I:=I-1;% 00000365 + END UNTIL I{0;% 00000366 + PUTCHAR("E");% 00000367 + IF NEXP<0 THEN BEGIN PUTCHAR("-"); NEXP:=-NEXP END% 00000368 + ELSE PUTCHAR("+");% 00000369 + PUTCHAR(NEXP DIV 10); PUTCHAR(ENTIER(NEXP MOD 10));% 00000370 + END ELSE% 00000371 + BEGIN % FIXED-POINT. 00000372 + E:=E+0.5|10*(-N);% 00000373 + PUTINT(ENTIER(E)); PUTCHAR("."); E:=E-ENTIER(E);% 00000374 + IF N>150 THEN RUNERR(6,LINENUM);% 00000375 + FOR I:=1 STEP 1 UNTIL N DO% 00000376 + BEGIN E:=10|E; PUTCHAR(ENTIER(E));% 00000377 + E:=E-ENTIER(E);% 00000378 + END END END ELSE% 00000379 + IF EMODE=3 THEN %*** MODE = BOOLEAN *** 00000380 + BEGIN% 00000381 + IF E<0.5 THEN REPLACE CPNT BY "FALSE" ELSE REPLACE CPNT BY "TRUE";00000382 + NCHARS:=IF E<0.5 THEN 5 ELSE 4;% 00000383 + END ELSE% 00000384 + IF EMODE=5 THEN %*** MODE = ALFA *** 00000385 + BEGIN% 00000386 + TEXT[0]:=E; NCHARS:=MIN(M,7);% 00000387 + REPLACE CPNT:CPNT BY TEXTPNT FOR 7;% 00000388 + END ELSE% 00000389 + BEGIN %*** MODE = CHAR *** 00000390 + PUTCHAR(E);% 00000391 + END;% 00000392 + IF NCHARS>M THEN M:=NCHARS;% 00000393 + IF INFO.BUFPNT+M>INFO.BUFSIZE THEN WLINE(F,BUF,INFO);% 00000394 + IF M>INFO.BUFSIZE THEN RUNERR(6,LINENUM);% 00000395 + REPLACE POINTER(BUF[*])+(INFO.BUFPNT+M-NCHARS) BY% 00000396 + POINTER(TEMPTEXT[*]) FOR NCHARS;% 00000397 + INFO.BUFPNT:=INFO.BUFPNT+M;% 00000398 +END OF PWRITE;% 00000399 +% 00000400 +% 00000401 +PROCEDURE PUT(F,BUF,INFO,LINENUM);% 00000402 +VALUE LINENUM;% 00000403 +FILE F; ARRAY BUF[*];% 00000404 +INTEGER INFO,LINENUM;% 00000405 +BEGIN% 00000406 + IF INFO.BUFSIZE=0 THEN% 00000407 + BEGIN% 00000408 + IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00000409 + WRITE(F,1023,BUF[*]);% 00000410 + END ELSE PWRITE(F,BUF,INFO,INFO.LASTCH,4,1,1,LINENUM);% 00000411 +END OF PUT;% 00000412 +% 00000413 +% 00000414 +PROCEDURE GET(F,BUF,INFO,LINENUM);% 00000415 +VALUE LINENUM;% 00000416 +FILE F; ARRAY BUF[*];% 00000417 +INTEGER INFO,LINENUM;% 00000418 +BEGIN% 00000419 + ALPHA X; LABEL ENDFILE;% 00000420 + IF INFO.BUFSIZE=0 THEN% 00000421 + BEGIN% 00000422 + IF BOOLEAN(INFO.EOF) THEN RUNERR(1,LINENUM);% 00000423 + READ(F,1023,BUF[*]) [ENDFILE];% 00000424 + IF FALSE THEN ENDFILE: INFO.EOF:=1;% 00000425 + END ELSE X:=PREAD(F,BUF,INFO,1,LINENUM);% 00000426 +END OF GET;% 00000427 +% 00000428 +% 00000429 +PROCEDURE PPAGE(F,BUF,INFO,LINENUM);% 00000430 +VALUE LINENUM;% 00000431 +FILE F; ARRAY BUF[*];% 00000432 +INTEGER INFO,LINENUM;% 00000433 +BEGIN% 00000434 + IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00000435 + WRITE(F[PAGE]);% 00000436 +END OF PPAGE;% 00000437 +% 00000438 +% 00000439 +PROCEDURE RESET(F,BUF,INFO,LINENUM);% 00000440 +VALUE LINENUM;% 00000441 +FILE F; ARRAY BUF[*];% 00000442 +INTEGER INFO,LINENUM;% 00000443 +BEGIN% 00000444 + IF BOOLEAN(INFO.INP) OR BOOLEAN(INFO.OUTP) THEN RUNERR(5,LINENUM);% 00000445 + REWIND(F); INFO.EOF:=0; INFO.EOLN:=0; INFO.BUFPNT:=0;% 00000446 + INFO.ENDFOUND:=0;% 00000447 + IF INFO.BUFSIZE=0 THEN GET(F,BUF,INFO,LINENUM)% 00000448 + ELSE RLINE(F,BUF,INFO);% 00000449 +END OF RESET;% 00000450 +% 00000451 +PROCEDURE REWRITE(F,BUF,INFO,LINENUM);% 00000452 +VALUE LINENUM;% 00000453 +FILE F; ARRAY BUF[*];% 00000454 +INTEGER INFO,LINENUM;% 00000455 +BEGIN% 00000456 + IF BOOLEAN(INFO.INP) OR BOOLEAN(INFO.OUTP) THEN RUNERR(5,LINENUM);% 00000457 + REWIND(F); INFO.EOF:=1; INFO.BUFPNT:=0; INFO.ENDFOUND:=0;% 00000458 + IF INFO.BUFSIZE>0 THEN% 00000459 + REPLACE POINTER(BUF[*]) BY " " FOR INFO.BUFSIZE;% 00000460 +END OF REWRITE;% 00000461 +% 00000462 +% 00000463 +PROCEDURE INIT(INPUTDECL);% 00000464 +VALUE INPUTDECL;% 00000465 +BOOLEAN INPUTDECL;% 00000466 +BEGIN% 00000467 + MEMPNT:=1;% 00000468 + CHARPNT:=POINTER(CHAR[*])+7; TEXTPNT:=POINTER(TEXT[*])+1;% 00000469 + T:=0; T.BUFSIZE:=80; T.BUFPNT:=80; T.EOLN:=1; T.INP:=1;% 00000470 + I00603:=T; IF INPUTDECL THEN RLINE(INPUT,V00603,I00603);% 00000471 + T:=0; T.BUFSIZE:=132; T.EOLN:=1; T.OUTP:=1; T.EOF:=1;% 00000472 + I00742:=T;% 00000473 + REPLACE POINTER(V00742[*]) BY " " FOR 17 WORDS;% 00000474 +END OF INIT;% 00000475 diff --git a/PASCAL-Heriot-Watt/README.txt b/PASCAL-Heriot-Watt/README.txt index e68408c..bd1fb5f 100644 --- a/PASCAL-Heriot-Watt/README.txt +++ b/PASCAL-Heriot-Watt/README.txt @@ -14,6 +14,26 @@ The compiler, run-time system, and patches were originally transcribed by Rich Cornwell of North Carolina, US. Proofing and correction were performed by Paul Kimpel of San Diego, California, US. +HMSS2.TEST.card + Card deck to compile and run a sample Pascal program. This program + computes the temperature profile in a square chimney with one side + against a perfectly-insulated wall and the other three sides exposed + to ambient air. Note that this program takes almost nine minutes to + run in the retro-B5500 emulator (which is close to the performance + of a real B5500). + +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 + 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.MARKXIII-Compile.lst + Listing produced by running the PASCAL.MARKXIII.card job. + PASCRUN.DISK.alg_m Algol source for the run-time system inserted into the translated Algol by the compiler. Transcribed from @@ -33,5 +53,11 @@ SYMBOL.PASCAL.alg_m B5700_Pascal_Mar79.pdf. -Paul Kimpel -June 2016 +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. + diff --git a/PASCAL-Heriot-Watt/SYMBOL.PASCAL.alg_m b/PASCAL-Heriot-Watt/SYMBOL.PASCAL.alg_m index 0a11837..08a636a 100644 --- a/PASCAL-Heriot-Watt/SYMBOL.PASCAL.alg_m +++ b/PASCAL-Heriot-Watt/SYMBOL.PASCAL.alg_m @@ -1,40 +1,40 @@ 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 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 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="2.3"#; 10028000 -INTEGER NUMERRS, % @R+21: NUMBER OF ERROS IN PROGRAM. 10029000 - SAVEFACTOR, % @R+22: SAVEFACTOR FOR CODE FILE. 10030000 - % >0 COMPILE TO LIBRARY. 10031000 - % =0 COMPILE AND RUN. 10032000 - % <0 COMPILE FOR SYNTAX. 10033000 - CARDCNT; % @R+23: NUMBER OF CARDS READ. 10034000 -FILE CARD "SOURCE" (2,10,150); % SOURCE CODE INPUT FILE 10035000 -FILE LINES 1 (2,17); % PRINT FILE. 10036000 -FILE PASCALGOL DISK SERIAL [20:610] (2,10,150,SAVE 0); % CODE FILE 10037000 +INTEGER NUMERRS, % @R+21: NUMBER OF ERRORS IN PROGRAM. 10029000 + SAVEFACTOR, % @R+22: SAVEFACTOR FOR CODE FILE. 10030000 + % >0 COMPILE TO LIBRARY. 10031000 + % =0 COMPILE AND RUN. 10032000 + % <0 COMPILE FOR SYNTAX. 10033000 + CARDCNT; % @R+23: NUMBER OF CARDS READ. 10034000 +FILE CARD "SOURCE" (2,10,150); % SOURCE CODE INPUT FILE 10035000 +FILE LINES 1 (2,17); % PRINT FILE. 10036000 +FILE PASCALGOL DISK SERIAL [20:600] (2,10,150,SAVE 0); % CODE FILE 10037000 DEFINE LINESPERPAGE=58#, 10038000 MAXINT=549755813887#; 10039000 10040000 @@ -43,14 +43,14 @@ DEFINE MAXTABLES =50#, %MAX NUMBER OF NAME TABLES. 10042000 MAXNAMES =997#, %MAX NAMES IN EACH TABLE. 10043000 MAXLEVEL =15#, %MAX DEPTH OF PROCEDURE DECLARATIONS. 10044000 MAXCASES =211#, %MAX LABELS IN A CASE-STATEMENT. 10045000 - MAXLABS =110#, %MAX NUMBER OF LABELS. 10046000 - MAXPARAMS =210#, %MAX NUMBER OF PARAMETERS IN WHOLE PROGRAM.10047000 + MAXLABS =100#, %MAX NUMBER OF LABELS. 10046000 + MAXPARAMS =200#, %MAX NUMBER OF PARAMETERS IN WHOLE PROGRAM.10047000 MAXTYPES =1022#, %MAX NUMBER OF DIFFERENT TYPES. 10048000 - MAXCONSTS =210#, %SIZE OF CONSTANT TABLE. 10049000 + MAXCONSTS =200#, %SIZE OF CONSTANT TABLE. 10049000 MAXTEMPS =5#, %NUMBER OF EXTRA VARS IN EACH PROCEDURE. 10050000 MAXWITHSYMS=250#, %MAX NUMBER OF SYMBOLS USED BY WITH-STATMS.10051000 - MAXSYMS =810#, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 - LISTLENGTH =810#, %MAX LENGTH OF VAR AND PARAM LISTS. 10053000 + MAXSYMS =800#, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 + LISTLENGTH =800#, %MAX LENGTH OF VAR AND PARAM LISTS. 10053000 MAXEXTFILES=20#, %MAX NUMBER OF EXTERNAL FILES. 10054000 MAXFILES =20#, %MAX NUMBER OF FILES DECLARED AT ONE TIME. 10055000 MAXPNTRS =50#; %MAX NUMBER OF UNDECLARED POINTERS. 10056000 @@ -134,10 +134,10 @@ ARRAY HEADTEXT[0:10], ERRLINE[0:16]; 10133000 INTEGER LINECNT,PAGECNT,ERRINX; 10134000 10135000 %*** XREF FILE AND TABLE *** 10136000 -FILE XREFFILE DISK SERIAL [20:3100] (2,3,15); 10137000 +FILE XREFFILE DISK SERIAL [20:3000] (2,3,150); 10137000 ARRAY BLOCKTAB[0:MAXTABLES], XREFLINE[0:16]; 10138000 INTEGER NUMXREF,NUMBLOCKS; POINTER XREFPNT; 10139000 - 10140000 +% 10140000 %*** OTHER TABLES *** 10141000 INTEGER ARRAY VARLIST[0:LISTLENGTH]; % TEMPORARY LIST OF VARIABLES. 10142000 INTEGER VARINDEX,FIRSTVAR; 10143000 @@ -212,13 +212,13 @@ DEFINE IDENTIFIER=1#, INTCONST=2#, REALCONST=3#, ALFACONST=4#, 10196000 10212000 DEFINE INITIAL=0#, MIDDLE=1#, TERMINAL=2#; 10213000 DEFINE NUMBER=0#, BITPATTERN=1#; 10214000 -$ PAGE 10215000 +$ PAGE 20000000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%20001000 % %20002000 % %20003000 % %20004000 -% PART 2: COMPILER UTILITY ROUTINES. %20005000 -% -------------------------- %20006000 +% PART 2: COMPILER UTILITY ROUTINES. %20005000 +% -------------------------- %20006000 % %20007000 % %20008000 % %20009000 @@ -332,7 +332,7 @@ BEGIN 20102000 IF ABSX> 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 + 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 @@ -432,7 +432,7 @@ BEGIN %*** IDENTIFIER JUST READ. 20209000 END; 20217000 FOUND:=TNAME!0; 20218000 IF XREFOPTION THEN 20219000 - IF FOUND THEN NEWXREF(CURNAME1,CURNAME2,TAB,FALSE); 20220000 + IF FOUND THEN NEWXREF(CURNAME1,CURNAME2,TAB,FALSE); % 20220000 END OF SEARCHTAB#; 20221000 20222000 DEFINE SEARCH= %*** SEARCH ALL TABLES CURRENTLY IN USE. 20223000 @@ -505,11 +505,11 @@ BEGIN %********************** 20302000 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 + 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 + 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 @@ -517,11 +517,11 @@ BEGIN %********************** 20302000 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 + NEWNAME("7BOOLEA","N",0); T3.IDCLASS:=TYPES; 20353000 NAMETAB3[0,THISINDEX]:=T3; 20354000 - BOOLTYPE:=T3:=5; %*** "CHAR" *** 20355000 + CHARTYPE:=T3:=5; %*** "CHAR" *** 20355000 T1.FORM:=CHAR; TYPETAB1[5]:=T1; TYPETAB3[5]:=63; 20356000 - NEWNAME("400CHAR", 0,0); T3.IDCLASS:=TYPES; 20357000 + 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 @@ -530,22 +530,22 @@ BEGIN %********************** 20302000 NUMTYPES:=5; 20363000 NILTYPE:=-1; %*** TYPE OF "NIL" *** 20364000 EMPTYSET:=-2; %*** TYPE OF [] *** 20365000 - NEWNAME("6MAXINT",0,0); T3:=INTTYPE; %*** "MAXINT" *** 20366000 + 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 20370000 - T3:=0; T3.IDCLASS:=PROC; %*** PROCEDURES *** 20371000 + T3:=0; T3.IDCLASS:=PROC; %*** PROCEDURES *** 20371000 FOR A:="3000GET", "3000NEW", "400PACK", "400PAGE", "3000PUT", 20372000 "400READ", "6READLN", "50RESET", "6UNPACK", "50WRITE" DO 20373000 BEGIN 20374000 - NEWNAME(A,0,0); NAMETAB3[0,THISINDEX]:=T3; 20375000 + 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 + 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 + 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 @@ -554,18 +554,18 @@ BEGIN %********************** 20302000 DO BEGIN 20387000 NEWNAME(A,0,0); NAMETAB3[0,THISINDEX]:=T3; 20388000 END; 20389000 - NEWNAME("7ELAPSE","D",0); NAMETAB3[0,THISINDEX]:=T3; 20390000 - NEWNAME("7WEEKDA","Y",0); NAMETAB3[0,THISINDEX]:=T3; 20391000 + NEWNAME("7ELAPSE","D",0); NAMETAB3[0,THISINDEX]:=T3; 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 + 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:=TEXTTYPE; T3.IDCLASS:=VAR; %*** "INPUT" *** 20397000 T3.EXTERNALFILE:=1; 20398000 - NEWNAME("50INPUT",0,0); INPUTFILE:=THISINDEX; 20399000 + NEWNAME("50INPUT",0,0); INPUTFILE:=THISINDEX; 20399000 NAMETAB3[0,THISINDEX]:=T3; 20400000 - NEWNAME("6OUTPUT",0,0); %*** "OUTPUT" *** 20401000 + NEWNAME("6OUTPUT",0,0); %*** "OUTPUT" *** 20401000 NAMETAB3[0,THISINDEX]:=T3; OUTPUTFILE:=THISINDEX; 20402000 END OF INTIALIZED; 20403000 20404000 @@ -596,14 +596,14 @@ END OF NEWXREF; 20522000 PROCEDURE XREFMAX(A); 20524000 ARRAY A[0]; 20525000 BEGIN 20526000 - A[0]:="AZZZZZZ"; A[1]:="ZZZZZZ"; A[2]:=9999999999; 20527000 + 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 - A0:=A[0]; B0:=B[0]; A1:=A[1]; B1:=B[1]; 20534000 + 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]0 AND RT>0 THEN 20832000 IF LT!RT THEN 20833000 IF F1!NUMERIC OR F2!NUMERIC THEN 20834000 @@ -730,8 +730,8 @@ END OF FILEPARAM#; 20869000 INTEGER TFORM; 20872000 BOOLEAN SIGNED,NEGATIVE; 20873000 20874000 -DEFINE CONSTANT(CVAL,CTYPE)= %*** *** 20875000 -BEGIN %****************** 20876000 +DEFINE CONSTANT(CVAL,CTYPE)= %*** *** 20875000 +BEGIN %****************** 20876000 IF CURSY=MINUS OR CURSY=PLUS THEN 20877000 BEGIN SIGNED:=TRUE; NEGATIVE:=CURSY=MINUS; 20878000 INSYMBOL; 20879000 @@ -768,7 +768,7 @@ BEGIN %****************** 20876000 IF SIGNED THEN 20910000 BEGIN 20911000 TFORM:=TYPETAB1[THISID.TYPE].FORM; 20912000 - IF TFORM!NUMERIC AND TFORM!FLOATING THEN ERROR(29) ELSE%20913000 + 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 @@ -777,82 +777,82 @@ BEGIN %****************** 20876000 END ELSE BEGIN ERROR(32); CVAL:=CTYPE:=0 END; 20919000 INSYMBOL; 20920000 END OF CONSTANT#; 20921000 -$ PAGE 20922000 +$ PAGE 30000000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%30001000 % %30002000 % %30003000 % %30004000 -% PART 3: THE SCANNER. %30005000 -% ------------ %30006000 +% PART 3: THE SCANNER. %30005000 +% ------------ %30006000 % %30007000 % %30008000 % %30009000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%30010000 -% 30011000 -% INTERNAL INTERNAL SYMBOL 30012000 -% SYMBOL NUMBER NAME KIND 30013000 + 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 +% 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 30076000 30077000 DEFINE BLANK=48#, EQUAL=61#, QUOTES=63#, DOLLAR=42#, 30078000 @@ -912,21 +912,21 @@ START: 30103000 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="3010END" THEN ENDSY ELSE 30135000 - IF CURNAME1="3010FOR" THEN FORSY ELSE 30136000 - IF CURNAME1="3010DIV" THEN DIVSY ELSE 30137000 - IF CURNAME1="3010MOD" THEN MODSY ELSE 30138000 - IF CURNAME1="3010NIL" THEN NILSY ELSE 30139000 - IF CURNAME1="3010AND" THEN ANDSY ELSE 30140000 - IF CURNAME1="3010NOT" THEN NOTSY ELSE 30141000 - IF CURNAME1="3010VAR" THEN VARSY ELSE 30142000 - IF CURNAME1="3010SET" THEN SETSY ELSE 30143000 - IF CURNAME1="3010LSS" THEN LSSSY ELSE 30144000 - IF CURNAME1="3010LEQ" THEN LEQSY ELSE 30145000 - IF CURNAME1="3010GEQ" THEN GEQSY ELSE 30146000 - IF CURNAME1="3010GTR" THEN GTRSY ELSE 30147000 - IF CURNAME1="3010NEQ" THEN NEQSY ELSE 30148000 - IF CURNAME1="3010EQL" THEN EQLSY ELSE IDENTIFIER; 30149000 + 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 @@ -944,7 +944,7 @@ START: 30103000 IF CURNAME1="6DOWNTO" THEN DOWNTOSY ELSE 30164000 IF CURNAME1="6RECORD" THEN RECORDSY ELSE 30165000 IF CURNAME1="6PACKED" THEN PACKEDSY ELSE IDENTIFIER; 30166000 - CURSY:=IF CURNAME1="7PROGRA" AND CURNAME2="M" THEN PROGRAMSY %30167000 + 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 @@ -963,7 +963,7 @@ START: 30103000 END OF LETTER ELSE 30183000 IF C{9 THEN 30184000 BEGIN 30185000 - CURVAL:=C; CURSY:=INTCONST; 30186000 + CURVAL:=C; CURSY:=INTCONST; 30186000 NEXTCHAR; 30187000 WHILE C{9 DO BEGIN CURVAL:=10|CURVAL+C; NEXTCHAR END; 30188000 IF C="." THEN 30189000 @@ -1036,17 +1036,17 @@ OVERFLOW: ERROR(14); CURVAL:=0; REALOVERFLOW:=0; 30219000 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 + BEGIN % *** COMMENT *** 30259000 NEXTCHAR; 30260000 IF C=DOLLAR THEN % DOLLAR INDICATES COMPILER OPTIONS. 30261000 DO BEGIN 30262000 NEXTCHAR; CX:=C; NEXTCHAR; 30263000 IF CX="L" THEN IF C=1 THEN HEADING 30264000 - ELSE LISTOPTION:=C="+" ELSE 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 + ELSE LISTOPTION:=C="+" ELSE 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 @@ -1074,13 +1074,13 @@ OVERFLOW: ERROR(14); CURVAL:=0; REALOVERFLOW:=0; 30219000 END OF COMMENT; 30294000 END; 30295000 END OF INSYMBOL; 30296000 -$ PAGE 30297000 +$ PAGE 40000000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%40001000 % %40002000 % %40003000 % %40004000 -% PART 4: EXPRESSION PARSER. %40005000 -% ------------------ %40006000 +% PART 4: EXPRESSION PARSER. %40005000 +% ------------------ %40006000 % %40007000 % %40008000 % %40009000 @@ -1131,13 +1131,13 @@ DEFINE WRITEEXPR= 40053000 BEGIN 40054000 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,7,1) ELSE 40060000 - BEGIN 40061000 - T1:=T1+1; SX:=SYMTAB[T1]; 40062000 - IF SX.[44:6]=0 THEN GENINT(SX) ELSE GENREAL(SX); 40063000 + 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#; 40066000 @@ -1166,7 +1166,7 @@ BEGIN 40084000 40089000 STARTSYM:=NUMSYMS+1; 40090000 IF THISLEVEL>CURLEVEL THEN % VARIABLE IN FIELD LIST OF 40091000 - BEGIN % RECORD USED IN WITH-STATEMENT 40092000 + BEGIN % RECORD USED IN WITH-STATEMENT. 40092000 T:=DISPLAY[THISLEVEL]; 40093000 T4:=T.FIRSTWITHSYM; T5:=T.LASTWITHSYM; 40094000 FOR T3:=T4 STEP 1 UNTIL T5 DO PUTTEXT(WITHTAB[T3]); 40095000 @@ -1225,8 +1225,8 @@ BEGIN 40084000 IF FOUND THEN 40148000 BEGIN 40149000 THISID:=NAMETAB3[T.RECTAB,THISINDEX]; 40150000 - ADDADDR: PUTSYM("+"); 40151000 - PUTCONST(THISID.INFO); CURTYPE:=THISID.TYPE; 40152000 +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 @@ -1327,8 +1327,8 @@ BEGIN 40205000 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("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 @@ -1373,7 +1373,7 @@ BEGIN %************** 40294000 BOOLEAN FIRST; 40296000 REAL VAL; 40297000 40298000 - DEFINE PARAMETER= %*** CHECK THAT THE FUNCTION HAS 1 PARAM. 40299000 + DEFINE PARAMETER= %*** CHECK THAT THE FUNCTION HAS 1 PARAM. 40299000 BEGIN 40300000 INSYMBOL; 40301000 IF CURSY=LPAR THEN 40302000 @@ -1396,19 +1396,19 @@ BEGIN %************** 40294000 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 + 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 + IF THISTAB=0 THEN %*** INTRINSIC FUNCTION *** 40329000 BEGIN 40330000 INTEGER DUMMY; 40350000 - IF CURNAME1="3000ABS" THEN % "ABS" 40351000 + IF CURNAME1="3000ABS" THEN % "ABS" 40351000 BEGIN 40352000 - PUTTEXT(" ABS"); PARAMETER; 40353000 + PUTTEXT(" ABS"); PARAMETER; 40353000 IF CURTYPE!REALTYPE AND CURTYPE!INTTYPE THEN ERROR(67); 40354000 END ELSE 40355000 IF CURNAME1="3000CHR" THEN % "CHR" 40356000 @@ -1416,47 +1416,47 @@ BEGIN %************** 40294000 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 + 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 @@ -1474,7 +1474,7 @@ BEGIN %************** 40294000 END ELSE 40416000 IF CURNAME1="50ROUND" THEN % "ROUND" 40417000 BEGIN 40418000 - PUTTEXT(" ROUND"); PARAMETER; 40419000 + PUTTEXT(" ROUND"); PARAMETER; 40419000 IF CURTYPE!REALTYPE THEN ERROR(67); 40420000 NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40421000 PUTCONST(CARDCNT); PUTSYM(")"); 40422000 @@ -1483,15 +1483,15 @@ BEGIN %************** 40294000 IF CURNAME1="3000SQR" THEN % "SQR" 40425000 BEGIN 40426000 PUTTEXT(" SQR"); PARAMETER; 40427000 - NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40428000 - PUTCONST(CARDCNT); PUTSYM(")"); 40429000 + 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 + NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40435000 + PUTCONST(CARDCNT); PUTSYM(")"); 40436000 IF CURTYPE!REALTYPE THEN ERROR(67); 40437000 CURTYPE:=INTTYPE; 40438000 END ELSE 40439000 @@ -1499,7 +1499,7 @@ BEGIN %************** 40294000 CONCAT ELSE 40441000 IF CURNAME1="400TIME" THEN % "TIME" 40442000 BEGIN 40443000 - PUTTEXT("(TIME("); PUTTEXT("1)/60"); 40444000 + PUTTEXT("(TIME("); PUTTEXT("1)/60)"); 40444000 CURTYPE:=REALTYPE; INSYMBOL 40445000 END ELSE 40446000 IF CURNAME1="400DATE" THEN % "DATE" 40447000 @@ -1517,7 +1517,7 @@ BEGIN %************** 40294000 PUTTEXT("(TIME("); PUTTEXT("3)/60)"); 40459000 CURTYPE:=REALTYPE; INSYMBOL; 40460000 END ELSE 40461000 - IF CURNAME1="7WEEKDA" AND CURNAME2="Y" THEN % "WEEKDAY" 40462000 + IF CURNAME1="7WEEKDA" AND CURNAME2="Y" THEN % "WEEKDAY" 40462000 BEGIN 40463000 PUTTEXT("WEEKDA"); 40464000 CURTYPE:=ALFATYPE; INSYMBOL; 40465000 @@ -1525,7 +1525,7 @@ BEGIN %************** 40294000 BEGIN 40467000 PUTTEXT(" TIME"); PUTTEXT(" (-1)"); 40468000 CURTYPE:=ALFATYPE; INSYMBOL; 40469000 - END ELSE % "SIN", "COS" ETC. 40470000 + END ELSE % "SIN","COS" ETC.40470000 BEGIN 40471000 PUTTEXT(IF CURNAME1="3000SIN" THEN " SIN" ELSE 40472000 IF CURNAME1="3000COS" THEN " COS" ELSE 40473000 @@ -1537,88 +1537,88 @@ BEGIN %************** 40294000 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 - PUTCONST(0); CURTYPE:=EMPTYSET; CURMODE:=NUMBER; 40529000 - INSYMBOL; 40530000 - END ELSE 40531000 - BEGIN 40532000 - FIRST:=TRUE; 40533000 - DO BEGIN 40534000 - IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 40535000 - PUTTEXT(" BIT("); STARTSYM:=NUMSYMS; 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]:=" BITS("; 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 CURSY=COMMA THEN PUTTEXT(" OR"); 40552000 - 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:=1; T1.STRUCT:=0; 40558000 - T1.SETTYPE:=STYPE; TYPETAB1[TYPEINDEX]:=T1; 40559000 - CURTYPE:=TYPEINDEX; 40560000 - CURMODE:=BITPATTERN; 40561000 - END; 40562000 - END OF SET CONSTANT ELSE BEGIN ERROR(99); INSYMBOL END; 40563000 + 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 + PUTCONST(0); CURTYPE:=EMPTYSET; CURMODE:=NUMBER; 40529000 + INSYMBOL; 40530000 + END ELSE 40531000 + BEGIN 40532000 + FIRST:=TRUE; 40533000 + DO BEGIN 40534000 + IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 40535000 + PUTTEXT(" BIT("); STARTSYM:=NUMSYMS; 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]:=" BITS("; 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 CURSY=COMMA THEN PUTTEXT(" OR"); 40552000 + 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:=1; T1.STRUCT:=0; 40558000 + T1.SETTYPE:=STYPE; TYPETAB1[TYPEINDEX]:=T1; 40559000 + CURTYPE:=TYPEINDEX; 40560000 + CURMODE:=BITPATTERN; 40561000 + END; 40562000 + END OF SET CONSTANT ELSE BEGIN ERROR(99); INSYMBOL END; 40563000 END OF FACTOR; 40564000 40565000 40566000 @@ -1671,8 +1671,8 @@ BEGIN %************ 40568000 END OF TERM; 40613000 40614000 40615000 -PROCEDURE SIMPLEEXPRESSION; %*** SIMPLE EXPRESSION *** 40616000 -BEGIN %************************* 40617000 +PROCEDURE SIMPLEEXPRESSION; %*** SIMPLE EXPRESSION *** 40616000 +BEGIN %************************* 40617000 INTEGER STARTSYM,MODE,TYPE1,F; 40618000 BOOLEAN SIGNED; 40619000 40620000 @@ -1731,8 +1731,8 @@ BEGIN %************************* 40617000 END OF SIMPLEEXPRESSION; 40673000 40674000 40675000 -PROCEDURE EXPRESSION; %*** EXPRESSION *** 40676000 -BEGIN %****************** 40677000 +PROCEDURE EXPRESSION; %*** EXPRESSION *** 40676000 +BEGIN %****************** 40677000 INTEGER STARTSYM,FIRSTSYM,TYPE1,RELOPTR,F; 40678000 BOOLEAN CALLGEN; 40679000 40680000 @@ -1745,7 +1745,7 @@ BEGIN %****************** 40677000 PUTDUMMY; STARTSYM:=NUMSYMS; 40687000 PUTDUMMY; 40688000 SIMPLEEXPRESSION; 40689000 - IF CURSY}LSSSY AND CURSY{INSY THEN % "<","{","}",">","=","!","IN" 40690000 + IF CURSY}LSSSY AND CURSY{INSY THEN % "<","{","}",">","=","!","IN"40690000 BEGIN 40691000 TYPE1:=CURTYPE; F:=TYPETAB1[TYPE1].FORM; 40692000 RELOPTR:=CURSY; 40693000 @@ -1793,21 +1793,21 @@ BEGIN %****************** 40677000 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 - WRITEEXPR; 40751000 - END; 40752000 + 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 + WRITEEXPR; 40751000 + END; 40752000 END OF EXPRESSION; 40753000 40754000 40755000 @@ -1819,13 +1819,13 @@ BEGIN 40757000 BEGIN SYMTAB[1]:=" B("; PUTSYM(")") END; 40761000 EXPRLEVEL:=0; WRITEEXPR; 40762000 END OF BOOLEAN#; 40763000 -$ PAGE 40764000 +$ PAGE 50000000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%50001000 % %50002000 % %50003000 % %50004000 -% PART 5: INTRINSIC ROUTINES. %50005000 -% ------------------- %50006000 +% PART 5: INTRINSIC ROUTINES. %50005000 +% ------------------- %50006000 % %50007000 % %50008000 % %50009000 @@ -1892,44 +1892,44 @@ BEGIN 50057000 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 - CHECK:=CHECKOPTION AND F!FLOATING; 50079000 - WRITEEXPR; GEN(":=",2,6); 50080000 - IF CHECK THEN GEN("CHECK(",6,2); 50081000 - GEN("PREAD(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 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 - GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50087000 - IF CHECK THEN 50088000 - BEGIN 50089000 - GEN(",",1,7); GENINT(TYPETAB2[CURTYPE]); GEN(",",1,7);50090000 - GENINT(TYPETAB3[CURTYPE]); GEN(",",1,7); 50091000 - GENINT(CARDCNT); GEN(")",1,7); 50092000 - END; 50093000 - 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 + 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 + CHECK:=CHECKOPTION AND F!FLOATING; 50079000 + WRITEEXPR; GEN(":=",2,6); 50080000 + IF CHECK THEN GEN("CHECK(",6,2); 50081000 + GEN("PREAD(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 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 + GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50087000 + IF CHECK THEN 50088000 + BEGIN 50089000 + GEN(",",1,7); GENINT(TYPETAB2[CURTYPE]); GEN(",",1,7); 50090000 + GENINT(TYPETAB3[CURTYPE]); GEN(",",1,7); 50091000 + GENINT(CARDCNT); GEN(")",1,7); 50092000 + END; 50093000 + 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 @@ -1948,7 +1948,7 @@ BEGIN 50115000 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,6); GEN(",",1,7); 50129000 + 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 @@ -1995,7 +1995,7 @@ BEGIN 50115000 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 + GEN(",-1,",4,4); 50176000 END; 50177000 END ELSE ERROR(17); 50178000 GENINT(CARDCNT); GEN(")",1,7); 50179000 @@ -2024,13 +2024,13 @@ BEGIN %*** 1) PUT 50200000 CASE PROCNUM OF %*** 3) RESET 50202000 BEGIN ; %*** 4) REWRITE 50203000 GEN("PUT",3,5); %*** 5) PAGE 50204000 - GEN("GET",3,5); 50205000 - GEN("RESET",5,3); 50206000 - GEN("REWRITE",7,1); 50207000 - GEN("PAGE",4,4); 50208000 - END; 50209000 - GEN("(",1,7); FILEPARAM(0); 50210000 - IF FILENAME=0 THEN ERROR(78); 50211000 + GEN("GET",3,5); % 50205000 + GEN("RESET",5,3); % 50206000 + GEN("REWRITE",7,1); % 50207000 + GEN("PAGE",4,4); % 50208000 + 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 @@ -2098,7 +2098,7 @@ BEGIN 50224000 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 + GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50279000 END OF PACK; 50280000 50281000 50282000 @@ -2127,8 +2127,8 @@ BEGIN 50284000 IF TYPETAB1[T.ARRTYPE].FORM!CHAR THEN ERROR(88); 50305000 IF THISLEVEL>1 AND THISLEVEL!CURLEVEL THEN ERROR(5); 50306000 GENID("V",1000|THISLEVEL+THISINDEX,5); 50307000 - GEN(",",1,7); GENINT(TYPETAB2[THISID.TYPE]); 50308000 - GEN(",",1,7); GENINT(TYPETAB3[THISID.TYPE]); 50309000 + 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 @@ -2147,7 +2147,7 @@ BEGIN 50284000 END OF UNPACK; 50325000 50326000 50327000 -PROCEDURE NEWDISP; %*** "NEW","DISPOSE" 50328000 +PROCEDURE NEWDISP; %*** "NEW","DISPOSE" 50328000 BEGIN 50329000 INTEGER T1; 50330000 IF CURNAME1="3000NEW" THEN GEN("NEW(",4,4) ELSE 50331000 @@ -2181,13 +2181,13 @@ BEGIN 50329000 IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50359000 IF CURSY=RPAR THEN INSYMBOL; 50360000 END OF NEWDISP; 50361000 -$ PAGE 50362000 +$ PAGE 60000000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%60001000 % %60002000 % %60003000 % %60004000 -% PART 6: THE STATEMENT PARSER. %60005000 -% --------------------- %60006000 +% PART 6: THE STATEMENT PARSER. %60005000 +% --------------------- %60006000 % %60007000 % %60008000 % %60009000 @@ -2195,7 +2195,7 @@ $ PAGE 50362000 60011000 60012000 60013000 -PROCEDURE STATEMENT; FORWARD; 60014000 +PROCEDURE STATEMENT; FORWARD; 60014000 60015000 PROCEDURE ASSIGNMENT; 60016000 BEGIN 60017000 @@ -2273,11 +2273,11 @@ BEGIN 60128000 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 + 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 @@ -2292,7 +2292,7 @@ BEGIN 60148000 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 + 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 @@ -2316,12 +2316,12 @@ BEGIN 60148000 BEGIN 60178000 IF CASETYPE=0 THEN CASETYPE:=CONTYPE ELSE 60179000 CHECKTYPES(CASETYPE,CONTYPE); 60180000 - GENID("T",TEMPVARNUM,2); GEN("=",1,7); GENINT(CONVAL); 60181000 + GENID("T",TEMPVARNUM,2); GEN("=",1,7); GENINT(CONVAL); 60181000 NCASELABS:=NCASELABS+1; 60182000 IF NCASELABSCHAR THEN ERROR(11); 70025000 IF CURSY!DOUBLEDOT THEN ERROR(53); 70026000 @@ -2630,7 +2630,7 @@ BEGIN %*************************** 70023000 IF VALX1>VALX2 THEN ERROR(54); 70031000 T1:=TYPETAB1[TYPEX1].FORM; IF T1=SYMBOLIC THEN T1:=SUBTYPE; 70032000 NEWTYPE; TTYPE:=TYPEINDEX; 70033000 - T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; T1.MAINTYPE:=TYPEX1; 70034000 + T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; T1.MAINTYPE:=TYPEX1; 70034000 TYPETAB1[TYPEINDEX]:=T1; 70035000 TYPETAB2[TYPEINDEX]:=VALX1; TYPETAB3[TYPEINDEX]:=VALX2; 70036000 END OF SUBRANGE#; 70037000 @@ -2650,8 +2650,8 @@ BEGIN 70042000 BOOLEAN FIRST; 70051000 70052000 PACKED:=FALSE; 70080000 - IF CURSY=IDENTIFIER THEN %*** SIMPLE TYPE DECLARATION *** 70081000 - BEGIN %******************************* 70082000 + IF CURSY=IDENTIFIER THEN %*** SIMPLE TYPE DECLARATION ***70081000 + BEGIN %*******************************70082000 SEARCH; 70083000 IF FOUND THEN 70084000 BEGIN 70085000 @@ -2667,7 +2667,7 @@ BEGIN 70042000 IF CURSY=LPAR THEN 70095000 BEGIN 70096000 N:=0; 70097000 - NEWTYPE; T3.IDCLASS:=CONST; T3.TYPE:=TYPEINDEX; 70098000 + NEWTYPE; T3.IDCLASS:=CONST; T3.TYPE:=TYPEINDEX; 70098000 DO BEGIN 70099000 INSYMBOL; 70100000 IF CURSY=IDENTIFIER THEN 70101000 @@ -2685,8 +2685,8 @@ BEGIN 70042000 IF CURSY=RPAR THEN INSYMBOL; 70113000 END ELSE 70114000 70115000 - IF CURSY=ARROW THEN %*** POINTER DECLARATION *** 70116000 - BEGIN %*************************** 70117000 + IF CURSY=ARROW THEN %*** POINTER DECLARATION *** 70116000 + BEGIN %*************************** 70117000 INSYMBOL; 70118000 IF CURSY=IDENTIFIER THEN 70119000 BEGIN 70120000 @@ -2711,8 +2711,8 @@ BEGIN 70042000 BEGIN 70139000 IF CURSY=PACKEDSY THEN BEGIN PACKED:=TRUE; INSYMBOL END; 70140000 70141000 - IF CURSY=ARRAYSY THEN %*** ARRAY DECLARATION *** 70142000 - BEGIN %************************* 70143000 + IF CURSY=ARRAYSY THEN %*** ARRAY DECLARATION *** 70142000 + BEGIN %************************* 70143000 INSYMBOL; 70144000 IF CURSY!LBRACKET THEN ERROR(47) ELSE INSYMBOL; 70145000 T1:=0; FIRST:=TRUE; 70146000 @@ -2728,7 +2728,7 @@ BEGIN 70042000 T1.SIZE:=MIN(1023,T3-T2+1); 70156000 NEWTYPE; 70157000 TYPETAB1[TYPEINDEX]:=T1; 70158000 - TYPETAB2[TYPEINDEX]:=T2; TYPETAB3[TYPEINDEX]:=T3; 70159000 + TYPETAB2[TYPEINDEX]:=T2; TYPETAB3[TYPEINDEX]:=T3; 70159000 T:=TYPEINDEX; 70160000 END; 70161000 END UNTIL CURSY!COMMA; 70162000 @@ -2812,7 +2812,7 @@ VALUE RECTAB,FIRSTADDR; 70239000 INTEGER RECTAB,FIRSTADDR,LASTADDR; 70240000 BEGIN 70241000 INTEGER ARRAY ILIST[0:LISTLENGTH]; 70242000 - INTEGER LISTINX; 70243000 + INTEGER LISTINX; 70243000 INTEGER CASETYPE,ADDR,MAXADDR,INDEX,CTYPE,TX,SX,T1,T3,LLIM,ULIM,I; 70244000 BOOLEAN FIRST; 70245000 REAL CVAL; 70246000 @@ -2824,7 +2824,7 @@ BEGIN 70241000 IF CURSY=CASESY THEN GO TO CASEPART; 70252000 IF CURSY=IDENTIFIER THEN 70253000 BEGIN 70254000 - LISTINX:=0; FIRST:=TRUE; 70255000 + LISTINX:=0; FIRST:=TRUE; 70255000 DO BEGIN 70256000 IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 70257000 IF CURSY=IDENTIFIER THEN 70258000 @@ -2846,7 +2846,7 @@ BEGIN 70241000 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 + T3.INFO:=ADDR; ADDR:=MIN(ADDR+SX,1024); 70277000 NAMETAB3[RECTAB,ILIST[I]]:=T3; 70278000 END; 70279000 END; 70280000 @@ -2918,16 +2918,16 @@ CASETYPEID: CASETYPE:=THISID.TYPE; T1:=TYPETAB1[CASETYPE]; 70303000 INSYMBOL; 70346000 END ELSE ERROR(58); 70347000 END; 70348000 - END UNTIL CURSY NEQ SEMICOLON; 70349000 + END UNTIL CURSY NEQ SEMICOLON; % 70349000 EXIT: 70350000 END OF FIELDLIST; 70351000 -$ PAGE 70352000 +$ PAGE 80000000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%80001000 % %80002000 % %80003000 % %80004000 -% PART 8: THE PROCEDURE BLOCK. %80005000 -% -------------------- %80006000 +% PART 8: THE PROCEDURE BLOCK. %80005000 +% -------------------- %80006000 % %80007000 % %80008000 % %80009000 @@ -2944,7 +2944,7 @@ BEGIN 80019000 INTEGER LEVEL1000,TYP,NAM,NAMTAB,T1,I,J,RECSIZE; 80020000 BOOLEAN REALVAR,ARRAYVAR,FIRSTDIM,EXTFILE; 80021000 ALPHA FNAME; 80022000 - INTEGER FNLENGTH,FNSTART; 80023000 + INTEGER FNLENGTH,FNSTART; % 80023000 80024000 LEVEL1000:=LEVEL|1000; 80025000 FOR I:=FIRST STEP 1 UNTIL LAST DO 80026000 @@ -2962,7 +2962,7 @@ BEGIN 80019000 GEN("PROCEDU",8,1); 80038000 GENID("V",LEVEL1000+NAM,5); GEN(";",1,7); 80039000 END ELSE 80040000 - IF T1.STRUCT=0 THEN %*** SIMPLE TYPE *** 80041000 + 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 @@ -2971,7 +2971,7 @@ BEGIN 80019000 END ELSE 80047000 BEGIN 80048000 IF REALVAR THEN BEGIN GEN(";",1,7); REALVAR:=FALSE END; 80049000 - IF T1.FORM1 THEN GEN("END",4,5); 80703000 END OF BLOCK; 80704000 -$PAGE 80705000 +$PAGE 90000000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%90001000 % %90002000 % %90003000 % %90004000 -% PART 9: THE MAIN PROGRAM. %90005000 -% ----------------- %90006000 +% PART 9: THE MAIN PROGRAM. %90005000 +% ----------------- %90006000 % %90007000 % %90008000 % %90009000 @@ -3513,7 +3513,7 @@ CURLEVEL:=1; 90069000 LASTREC:=MAXTABLES+1; 90070000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%90071000 % %90072000 -% BLOCK; COMPILE USER PROGRAM. %90073000 + BLOCK; % COMPILE USER PROGRAM. %90073000 % %90074000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%90075000 IF CURSY!DOT THEN 90076000 @@ -3565,7 +3565,7 @@ BEGIN 90091000 ZIPTEXT(" SERIAL",7); ZIPTEXT(";",1); 90122000 IF SAVEFACTOR>0 THEN 90123000 BEGIN 90124000 - ZIPTEXT("SAVE=",5); ZIPNUM(SAVEFACTOR); 90125000 + ZIPTEXT("SAVE=",5); ZIPNUM(SAVEFACTOR); 90125000 ZIPTEXT(";",1); 90126000 END; 90127000 ZIPTEXT("END.",4); 90128000 @@ -3574,110 +3574,110 @@ 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 VARIABLE NOT ACCESSIBLE (HARDWARE RESTRICTION)."), 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""" 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."), 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 TOO MANY RECORDS DECLARED AT ONE TIME."), 91060000 - (" 56 THE RECORD CONTAINS MORE THEN 1023 WORDS."), 91061000 - (" 57 FILES NOT ALLOWED IN RECORDS."), 91062000 - (" 58 """(""" EXPECTED."), 91063000 - (" 59 """]""" EXPECTED."); 91064000 + (" 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 VARIABLE NOT ACCESSIBLE (HARDWARE RESTRICTION)."), 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."), 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 TOO MANY RECORDS DECLARED AT ONE TIME."), 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."), 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 DISCOVERED."), 91094000 - (" 88 CHARACTER ARRAY EXPECTED."), 91095000 - (" 89 """,""" EXPECTED."), 91096000 - (" 91 PROCEDURES MAY NOT HAVE ANY TYPE."), 91097000 - (" 91 PARAMETERS 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 ASSIGNMENT OF STRUCTURED VARIABLES NOT IMPLIMENTED."), 91102000 - (" 96 INPUT/OUPUT NOT DECLARED."), 91103000 - (" 97 TOO MANY FILES IN USE."), 91104000 - (" 98 RECORD IDENTIFIER EXPECTED."), 91105000 - (" 99 UNRECOGNIZED ITEM."), 91106000 - (); 91107000 + (" 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 DISCOVERED."), 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 ASSIGNMENT OF STRUCTURED VARIABLES NOT IMPLIMENTED."), 91102000 + (" 96 INPUT/OUPUT NOT DECLARED."), 91103000 + (" 97 TOO MANY FILES IN USE."), 91104000 + (" 98 RECORD IDENTIFIER EXPECTED."), 91105000 + (" 99 UNRECOGNIZED ITEM."), 91106000 + (); 91107000 91108000 91109000 WRITE(LINES,ERRORS,NUMERRS); 91110000 @@ -3692,5 +3692,5 @@ BEGIN 92002000 HEADING; 92004000 SORT(PRINTXREF,XREFFILE,0,XREFMAX,XREFCOMPARE,3,1000,6000); 92005000 END; 92006000 -END OF B5700 PASCAL COMPILER COMPILER.. ................................99001000 +END OF B5700 PASCAL COMPILER COMPILER...................................99001000 END;END. LAST CARD IMAGE ON SOURCE TAPE FILE 99999999