github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-05-01 22:06:24 +00:00
Code Issues Releases Wiki Activity

1. Commit proofreading corrections to SYMBOL.PASCAL and PASCRUN.DISK.

Browse Source 
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.
This commit is contained in:
Paul Kimpel
2016-07-04 18:35:59 -07:00
parent bf63d2340e
commit c9fe38ede3
7 changed files with 6750 additions and 1035 deletions
Download Patch File Download Diff File Expand all files Collapse all files

182
PASCAL-Heriot-Watt/HMSS2.TEST.card Normal file
View File

@@ -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

1674
PASCAL-Heriot-Watt/HMSS2.TEST.lst Normal file
View File

File diff suppressed because it is too large Load Diff

3816
PASCAL-Heriot-Watt/PASCAL.MKXIII-Compile.lst Normal file
View File

File diff suppressed because it is too large Load Diff

23
PASCAL-Heriot-Watt/PASCAL.MKXIII.card Normal file
View File

@@ -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

956
PASCAL-Heriot-Watt/PASCRUN.DISK.alg_m
View File

@@ -1,481 +1,475 @@
?EXECUTE OBJECT/READER $ CARD SEQXEQ RESET LIST% 00000001
?COMMON=3 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00000002
?FILE NEWTAPE = PASCRUN/DISK SERIAL % % 00000003
?DATA CARD % THE PASCAL RUN TIME-SYSTEM. % 00000004
$ CARD SEQSEQ RESSET LIST% 00001 % --------------------------- % 00000005
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00002 % % 00000006
% % 00003 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00000007
% THE PASCAL RUN TIME-SYSTEM. % 00004 BEGIN% 00000008
% --------------------------- % 00005 INTEGER V00167,V00168,V00169;% 00000009
% % 00006 FILE INPUT "INPUT" (2,10);% 00000010
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00007 FILE OUTPUT 1 (2,17);% 00000011
BEGIN% 00008 % 00000012
INTEGER V00167,V00168,V00169;% 00009 DEFINE PROCEDU =PROCEDURE#,% 00000013
FILE INPUT "INPUT" (2,10);% 00010 FUNCTN =REAL PROCEDURE#,% 00000014
FILE OUTPUT 1 (2,17);% 00011 DOWNTO =STEP -1 UNTIL#,% 00000015
% 00012 UPTO =STEP 1 UNTIL#,% 00000016
DEFINE PROCEDU =PROCEDURE#,% 00013 B =BOOLEAN#,% 00000017
FUNCTN =REAL PROCEDURE#,% 00014 F00603 =INPUT#,% 00000018
DOWNTO =STEP -1 UNTIL#,% 00015 F00742 =OUTPUT#,% 00000019
UPTO =STEP 1 UNTIL#,% 00016 LASTCH =[5:6]#,% 00000020
B =BOOLEAN#,% 00017 BUFSIZE =[13:8]#,% 00000021
F00603 =INPUT#,% 00018 BUFPNT =[21:8]#,% 00000022
F00742 =OUTPUT#,% 00019 EOF =[22:1]#,% 00000023
LASTCH =[5:6]#,% 00020 EOLN =[23:1]#,% 00000024
BUFSIZE =[13:8]#,% 00021 INP =[24:1]#,% 00000025
BUFPNT =[21:8]#,% 00022 OUTP =[25:1]#,% 00000026
EOF =[22:1]#,% 00023 ENDFOUND=[26:1]#,% 00000027
EOLN =[23:1]#,% 00024 MEMSIZE =10000#,% 00000028
INP =[24:1]#,% 00025 MAXINT =549755813887#;% 00000029
OUTP =[25:1]#,% 00026 % 00000030
ENDFOUND=[26:1]#,% 00027 ARRAY MEM[0:MEMSIZE DIV 1022,0:1022], TEXT,CHAR[0:0], TEMPTEXT[0:19],% 00000031
MEMSIZE =10000#,% 00028 V00603[0:9], V00742[0:16];% 00000032
MAXINT =549755813887#;% 00029 INTEGER MEMPNT,T,T1,I00603,I00742;% 00000033
% 00030 POINTER CHARPNT,TEXTPNT;% 00000034
ARRAY MEM[0:MEMSIZE DIV 1022,0:1022], TEXT,CHAR[0:0], TEMPTEXT[0:19],% 00031 LABEL TERMINATE;% 00000035
V00603[0:9], V00742[0:16];% 00032 FORMAT TERMMESS ("**** PROGRAM EXECUTION TERMINATED AT LINE ",I*,"."),% 00000036
INTEGER MEMPNT,T,T1,I00603,I00742;% 00033 CHECKERR ("**** THE VALUE ",I*," IS NOT IN THE RANGE ",I*,"..",% 00000037
POINTER CHARPNT,TEXTPNT;% 00034 I*,"."),% 00000038
LABEL TERMINATE;% 00035 ERRMARK (X*,"|"),% 00000039
FORMAT TERMMESS ("**** PROGRAM EXECUTION TERMINATED AT LINE ",I*,"."),% 00036 CONCATERR("**** CONCAT ERROR: [",I*,":",I*,":",I*,"]"),% 00000040
CHECKERR ("**** THE VALUE ",I*," IS NOT IN THE RANGE ",I*,"..",% 00037 ILLEGALCC("**** ILLEGAL CARRIAGE CONTROL CHARACTER:"""",A1,""");%00000041
I*,"."),% 00038 SWITCH FORMAT ERRMESS :=% 00000042
ERRMARK (X*,"X"),% 00039 (),% 00000043
CONCATERR("**** CONCAT ERROR: [",I*,":",I*,":",I*,"]"),% 00040 ("**** NO READING WHILE EOF IS TRUE."), %1 00000044
ILLEGALCC("**** ILLEGAL CARRIAGE CONTROL CHARACTER:"""",A1,""");% 00041 ("**** NO WRITING WHILE EOF IS FALSE."), %2 00000045
SWITCH FORMAT ERRMESS :=% 00042 ("**** ILLEGAL CHARACTER,"), %3 00000046
(),% 00043 ("**** OVERFLOW ERROR."), %4 00000047
("**** NO READING WHILE EOF IS TRUE."), %1 00044 ("**** NO RESET/REWRITE ON INPUT/OUTPUT."), %5 00000048
("**** NO WRITING WHILE EOF IS FALSE."), %2 00045 ("**** LINE IMAGE OVERFLOW."); %6 00000049
("**** ILLEGAL CHARACTER,"), %3 00046 MONITOR EXPOVR:=REALOVERFLOW;% 00000050
("**** OVERFLOW ERROR."), %4 00047 % 00000051
("**** NO RESET/REWRITE ON INPUT/OUTPUT."), %5 00048 INTEGER PROCEDURE NUMDIGITS(N);% 00000052
("**** LINE IMAGE OVERFLOW."); %6 00049 VALUE N; INTEGER N;% 00000053
MONITOR EXPOVR:=REALOVERFLOW;% 00050 NUMDIGITS:=IF N<0 THEN 1+NUMDIGITS(-N) ELSE% 00000054
% 00051 IF N>9 THEN 1+NUMDIGITS(N DIV 10) ELSE 1;% 00000055
INTEGER PROCEDURE NUMDIGITS(N);% 00052 % 00000056
VALUE N; INTEGER N;% 00053 PROCEDURE RUNERR(ERRNUM,LINENUM); %*** RUN TIME ERROR *** 00000057
NUMDIGITS:=IF N<0 THEN 1+NUMDIGITS(-N) ELSE% 00054 VALUE ERRNUM,LINENUM;% 00000058
IF N>9 THEN 1+NUMDIGITS(N DIV 10) ELSE 1;% 00055 INTEGER ERRNUM,LINENUM;% 00000059
% 00056 BEGIN% 00000060
PROCEDURE RUNERR(ERRNUM,LINENUM); %*** RUN TIME ERROR *** 00057 WRITE(OUTPUT,ERRMESS[ERRNUM]);% 00000061
VALUE ERRNUM,LINENUM;% 00058 WRITE(OUTPUT,TERMMESS,NUMDIGITS(LINENUM),LINENUM);% 00000062
INTEGER ERRNUM,LINENUM;% 00059 GO TO TERMINATE;% 00000063
BEGIN% 00060 END OF RUNNER;% 00000064
WRITE(OUTPUT,ERRMESS[ERRNUM]);% 00061 % 00000065
WRITE(OUTPUT,TERMMESS,NUMDIGITS(LINENUM),LINENUM);% 00062 INTEGER PROCEDURE CHECK(VAL,LIM1,LIM2,LINENUM);% 00000066
GO TO TERMINATE;% 00063 VALUE VAL,LIM1,LIM2,LINENUM;% 00000067
END OF RUNNER;% 00064 INTEGER VAL,LIM1,LIM2,LINENUM;% 00000068
% 00065 BEGIN% 00000069
INTEGER PROCEDURE CHECK(VAL,LIM1,LIM2,LINENUM);% 00066 IF VAL<LIM1 OR VAL>LIM2 THEN% 00000070
VALUE VAL,LIM1,LIM2,LINENUM;% 00067 BEGIN WRITE(OUTPUT,CHECKERR,NUMDIGITS(VAL),VAL,NUMDIGITS(LIM1),% 00000071
INTEGER VAL,LIM1,LIM2,LINENUM;% 00068 LIM1,NUMDIGITS(LIM2),LIM2);% 00000072
BEGIN% 00069 RUNERR(4,LINENUM);% 00000073
IF VAL<LIM1 OR VAL>LIM2 THEN% 00070 END;% 00000074
BEGIN WRITE(OUTPUT,CHECKERR,NUMDIGITS(VAL),VAL,NUMDIGITS(LIM1),% 00071 CHECK:=VAL;% 00000075
LIM1,NUMDIGITS(LIM2),LIM2);% 00072 END OF CHECK;% 00000076
RUNERR(4,LINENUM);% 00073 % 00000077
END;% 00074 ALPHA PROCEDURE CURDAT;% 00000078
CHECK:=VAL;% 00075 CURDAT:=" "&TIME(5)[41:35:36];% 00000079
END OF CHECK;% 00076 % 00000080
% 00077 ALPHA PROCEDURE WEEKDA;% 00000081
ALPHA PROCEDURE CURDAT;% 00078 WEEKDA:=TIME(6)&" "[41:5:6];% 00000082
CURDAT:=" "&TIME(5)[41:35:36];% 00079 % 00000083
% 00080 INTEGER PROCEDURE TRUNC(X,LINENUM);% 00000084
ALPHA PROCEDURE WEEKDA;% 00081 VALUE X,LINENUM;% 00000085
WEEKDA:=TIME(6)&" "[41:5:6];% 00082 REAL X; INTEGER LINENUM;% 00000086
% 00083 BEGIN% 00000087
INTEGER PROCEDURE TRUNC(X,LINENUM);% 00084 IF ABS(X)>MAXINT THEN RUNERR(4,LINENUM);% 00000088
VALUE X,LINENUM;% 00085 TRUNC:=IF X<0 THEN -ENTIER(-X) ELSE ENTIER(X);% 00000089
REAL X; INTEGER LINENUM;% 00086 END OF TRUNC;% 00000090
BEGIN% 00087 % 00000091
IF ABS(X)>MAXINT THEN RUNERR(4,LINENUM);% 00088 INTEGER PROCEDURE ROUND(X,LINENUM);% 00000092
TRUNC:=IF X<0 THEN -ENTIER(-X) ELSE ENTIER(X);% 00089 VALUE X,LINENUM;% 00000093
END OF TRUNC; 00090 REAL X; INTEGER LINENUM;% 00000094
% 00091 BEGIN% 00000095
INTEGER PROCEDURE ROUND(X,LINENUM);% 00092 IF ABS(X)>MAXINT THEN RUNERR(4,LINENUM);% 00000096
VALUE X,LINENUM;% 00093 ROUND:=X;% 00000097
REAL X; INTEGER LINENUM;% 00094 END OF ROUND;% 00000098
BEGIN% 00095 % 00000099
IF ABS(X)>MAXINT THEN RUNERR(4,LINENUM);% 00096 BOOLEAN PROCEDURE ODD(N);% 00000100
ROUND:=X;% 00097 VALUE N; INTEGER N;% 00000101
END OF ROUND;% 00098 ODD:=N MOD 2 = 1;% 00000102
% 00099 % 00000103
BOOLEAN PROCEDURE ODD(N);% 00100 REAL PROCEDURE SQR(X,LINENUM);% 00000104
VALUE N; INTEGER N;% 00101 VALUE X,LINENUM;% 00000105
ODD:=N MOD 2 = 1;% 00102 REAL X; INTEGER LINENUM;% 00000106
% 00103 BEGIN% 00000107
REAL PROCEDURE SQR(X,LINENUM);% 00104 IF ABS(X)>2.0769187@34 THEN RUNERR(4,LINENUM);% 00000108
VALUE X,LINENUM;% 00105 SQR:=X|X;% 00000109
REAL X; INTEGER LINENUM;% 00106 END OF SQR;% 00000110
BEGIN% 00107 % 00000111
IF ABS(X)>2.0769187@34 THEN RUNERR(4,LINENUM);% 00108 BOOLEAN PROCEDURE INCL1(A,B); %*** IS THE SET "A" INCLUDED 00000112
SQR:=X|X;% 00109 VALUE A,B; REAL A,B; %*** IN THE SET "B". 00000113
END OF SQR;% 00110 INCL1:=REAL(BOOLEAN(A) AND NOT BOOLEAN(B))=0;% 00000114
% 00111 % 00000115
BOOLEAN PROCEDURE INCL1(A,B); %*** IS THE SET "A" INCLUDED 00112 BOOLEAN PROCEDURE INCL2(A,B); %*** IS THE SET "B" INCLUDED 00000116
VALUE A,B; REAL A,B; %*** IN THE SET "B". 00113 VALUE A,B; REAL A,B; %*** IN THE SET "A". 00000117
INCL1:=REAL(BOOLEAN(A) AND NOT BOOLEAN(B))=0;% 00114 INCL2:=REAL(BOOLEAN(B) AND NOT BOOLEAN(A))=0;% 00000118
% 00115 % 00000119
BOOLEAN PROCEDURE INCL2(A,B); %*** IS THE SET "B" INCLUDED 00116 BOOLEAN PROCEDURE INTST(A,B); %*** IS THE VALUE "A" AN ELEMENT00000120
VALUE A,B; REAL A,B; %*** IN THE SET "A". 00117 VALUE A,B; REAL A,B; %*** IN THE SET "B". 00000121
INCL2:=REAL(BOOLEAN(B) AND NOT BOOLEAN(A))=0;% 00118 INTST:=IF A<0 OR B>38 THEN FALSE ELSE 0&B[0:38-A:1]=1;% 00000122
% 00119 % 00000123
BOOLEAN PROCEDURE INTST(A,B); %*** IS THE VALUE "A" AN ELEMENT 00120 PROCEDURE NEW(P,SIZE);% 00000124
VALUE A,B; REAL A,B; %*** IN THE SET "B". 00121 VALUE SIZE; REAL P; INTEGER SIZE;% 00000125
INTST:=IF A<0 OR B>38 THEN FALSE ELSE 0&B[0:38-A:1]=1;% 00122 BEGIN% 00000126
% 00123 P:=IF MEMPNT+SIZE>MEMSIZE THEN 0 ELSE MEMPNT;% 00000127
PROCEDURE NEW(P,SIZE);% 00124 MEMPNT:=MEMPNT+SIZE;% 00000128
VALUE SIZE; REAL P; INTEGER SIZE;% 00125 END OF NEW;% 00000129
BEGIN% 00126 % 00000130
P:=IF MEMPNT+SIZE>MEMSIZE THEN 0 ELSE MEMPNT;% 00127 PROCEDURE DISPOSE(P,SIZE);% 00000131
MEMPNT:=MEMPNT+SIZE;% 00128 VALUE SIZE; REAL P; INTEGER SIZE;% 00000132
END OF NEW;% 00129 BEGIN% 00000133
% 00130 END OF DISPOSE;% 00000134
PROCEDURE DISPOSE(P,SIZE);% 00131 % 00000135
VALUE SIZE; REAL P; INTEGER SIZE;% 00132 PROCEDURE PACK(A,LLIM,ULIM,I,Z,LINENUM);% 00000136
BEGIN% 00133 VALUE LLIM,ULIM,I,LINENUM;% 00000137
END OF DISPOSE;% 00134 ARRAY A[*]; ALPHA Z;% 00000138
% 00135 INTEGER LLIM,ULIM,I,LINENUM;% 00000139
PROCEDURE PACK(A,LLIM,ULIM,I,Z,LINENUM);% 00136 BEGIN;% 00000140
VALUE LLIM,ULIM,I,LINENUM;% 00137 Z:=0;% 00000141
ARRAY A[*]; ALPHA Z;% 00138 FOR T1:=0 STEP 1 UNTIL 6 DO% 00000142
INTEGER LLIM,ULIM,I,LINENUM;% 00139 Z:=A[CHECK(I+T1,LLIM,ULIM,LINENUM)] & Z [41:35:36];% 00000143
BEGIN;% 00140 END;% 00000144
Z:=0;% 00141 % 00000145
FOR T1:=0 STEP 1 UNTIL 6 DO% 00142 PROCEDURE UNPACK(Z,A,LLIM,ULIM,I,LINENUM);% 00000146
Z:=A[CHECK(I+T1,LLIM,ULIM,LINENUM)] & Z [41:35:36];% 00143 VALUE Z,LLIM,ULIM,I,LINENUM;% 00000147
END;% 00144 ARRAY A[*]; ALPHA Z;% 00000148
% 00145 INTEGER LLIM,ULIM,I,LINENUM;% 00000149
PROCEDURE UNPACK(Z,A,LLIM,ULIM,I,LINENUM);% 00146 FOR T1:=0 STEP 1 UNTIL 6 DO% 00000150
VALUE Z,LLIM,ULIM,I,LINENUM;% 00147 A[CHECK(I+T1,LLIM,ULIM,LINENUM)]:= 0 & Z [5:41-6|T1:6];% 00000151
ARRAY A[*]; ALPHA Z;% 00148 % 00000152
INTEGER LLIM,ULIM,I,LINENUM;% 00149 REAL PROCEDURE CONCAT(A,B,AS,BS,N,LINENUM);% 00000153
FOR T1:=0 STEP 1 UNTIL 6 DO% 00150 VALUE A,B,AS,BS,N,LINENUM;% 00000154
A[CHECK(I+T1,LLIM,ULIM,LINENUM)]:= 0 & Z [5:41-6|T1:6];% 00151 REAL A,B; INTEGER AS,BS,N,LINENUM;% 00000155
% 00152 BEGIN% 00000156
REAL PROCEDURE CONCAT(A,B,AS,BS,N,LINENUM);% 00153 IF AS<1 OR BS<1 OR N<0 OR AS+N>48 OR BS+N>48 THEN% 00000157
VALUE A,B,AS,BS,N,LINENUM;% 00154 BEGIN% 00000158
REAL A,B; INTEGER AS,BS,N,LINENUM;% 00155 WRITE(OUTPUT,CONCATERR,NUMDIGITS(AS),AS,NUMDIGITS(BS),% 00000159
BEGIN% 00156 BS,NUMDIGITS(N),N);% 00000160
IF AS<1 OR BS<1 OR N<0 OR AS+N>48 OR BS+N>48 THEN% 00157 RUNERR(0,LINENUM);% 00000161
BEGIN% 00158 END;% 00000162
WRITE(OUTPUT,CONCATERR,NUMDIGITS(AS),AS,NUMDIGITS(BS),% 00159 CONCAT:=A & B [47-AS:47-BS:N];% 00000163
BS,NUMDIGITS(N),N);% 00160 END OF CONCAT;% 00000164
RUNERR(0,LINENUM);% 00161 % 00000165
END; 00162 BOOLEAN PROCEDURE BIT(N,LINENUM);% %*** SET BIT NO "N" IN A WORD. 00000166
CONCAT:=A & B [47-AS:47-BS:N];% 00163 VALUE N,LINENUM; INTEGER N,LINENUM;% 00000167
END OF CONCAT;% 00164 BIT:=BOOLEAN(0 & 1 [38-CHECK(N,0,38,LINENUM):0:1]);% 00000168
% 00165 % 00000169
BOOLEAN PROCEDURE BIT(N,LINENUM);% %*** SET BIT NO "N" IN A WORD. 00166 BOOLEAN PROCEDURE BITS(N1,N2,LINENUM); %*** SET BITS "N1".."N2". 00000170
VALUE N,LINENUM; INTEGER N,LINENUM;% 00167 VALUE N1,N2,LINENUM;% 00000171
BIT:=BOOLEAN(0 & 1 [38-CHECK(N,0,38,LINENUM):0:1]);% 00168 INTEGER N1,N2,LINENUM;% 00000172
% 00169 BITS:=BOOLEAN(0 & 3"7777777777777" [38-CHECK(N1,0,38,LINENUM):38:% 00000173
BOOLEAN PROCEDURE BITS(N1,N2,LINENUM); %*** SET BITS "N1".."N2". 00170 CHECK(N2,0,38,LINENUM)-N1+1]);% 00000174
VALUE N1,N2,LINENUM;% 00171 % 00000175
INTEGER N1,N2,LINENUM;% 00172 PROCEDURE RLINE(F,BUF,INFO);% 00000176
BITS:=BOOLEAN(0 & 3"7777777777777" [38-CHECK(N1,0,38,LINENUM):38:% 00173 FILE F; ARRAY BUF[0]; INTEGER INFO;% 00000177
CHECK(N2,0,38,LINENUM)-N1+1]);% 00174 BEGIN% 00000178
% 00175 LABEL ENDFILE;% 00000179
PROCEDURE RLINE(F,BUF,INFO);% 00176 INFO.EOLN:=0; INFO.BUFPNT:=1;% 00000180
FILE F; ARRAY BUF[0]; INTEGER INFO;% 00177 READ(F,999,BUF[*]) [ENDFILE];% 00000181
BEGIN% 00178 REPLACE CHARPNT BY POINTER(BUF[*]) FOR 1;% 00000182
LABEL ENDFILE;% 00179 INFO.LASTCH:=CHAR[0];% 00000183
INFO.EOLN:=0; INFO.BUFPNT:=1;% 00180 IF FALSE THEN% 00000184
READ(F,999,BUF[*]) [ENDFILE];% 00181 BEGIN ENDFILE: INFO.ENDFOUND:=1;% 00000185
REPLACE CHARPNT BY POINTER(BUF[*]) FOR 1;% 00182 END;% 00000186
INFO.LASTCH:=CHAR[0];% 00183 END OF RLINE;% 00000187
IF FALSE THEN% 00184 % 00000188
BEGIN ENDFILE: INFO.ENDFOUND:=1;% 00185 REAL PROCEDURE PREAD(F,BUF,INFO,MODE,LINENUM);% 00000189
END;% 00186 VALUE MODE,LINENUM;% 00000190
END OF RLINE;% 00187 FILE F; ARRAY BUF[0];% 00000191
% 00188 INTEGER INFO,MODE,LINENUM;% 00000192
REAL PROCEDURE PREAD(F,BUF,INFO,MODE,LINENUM);% 00189 BEGIN% 00000193
VALUE MODE,LINENUM;% 00190 DEFINE GETCHAR=% 00000194
FILE F; ARRAY BUF[0];% 00191 BEGIN% 00000195
INTEGER INFO,MODE,LINENUM;% 00192 IF BOOLEAN(INFO.EOLN) THEN% 00000196
BEGIN% 00193 BEGIN% 00000197
DEFINE GETCHAR=% 00194 RLINE(F,BUF,INFO); CH:=INFO.LASTCH;% 00000198
BEGIN% 00195 END ELSE% 00000199
IF BOOLEAN(INFO.EOLN) THEN% 00196 IF INFO.BUFPNT=INFO.BUFSIZE THEN% 00000200
BEGIN% 00197 BEGIN CH:=" "; INFO.EOLN:=1 END ELSE% 00000201
RLINE(F,BUF,INFO); CH:=INFO.LASTCH;% 00198 BEGIN% 00000202
END ELSE% 00199 REPLACE CHARPNT BY POINTER(BUF[*])+INFO.BUFPNT FOR 1;% 00000203
IF INFO.BUFPNT=INFO.BUFSIZE THEN% 00200 CH:=CHAR[0]; INFO.BUFPNT:=INFO.BUFPNT+1;% 00000204
BEGIN CH:=" "; INFO.EOLN:=1 END ELSE% 00201 END END OF GETCHAR#;% 00000205
BEGIN% 00202 % 00000206
REPLACE CHARPNT BY POINTER(BUF[*])+INFO.BUFPNT FOR 1;% 00203 DEFINE READERR(ERRNUM)=% 00000207
CH:=CHAR[0]; INFO.BUFPNT:=INFO.BUFPNT+1;% 00204 BEGIN% 00000208
END END OF GETCHAR#;% 00205 WRITE(OUTPUT,999,BUF[*]);% 00000209
% 00206 WRITE(OUTPUT,ERRMARK,INFO.BUFPNT-1);% 00000210
DEFINE READERR(ERRNUM)=% 00207 RUNERR(ERRNUM,LINENUM);% 00000211
BEGIN 00208 END READERR#;% 00000212
WRITE(OUTPUT,999,BUF[*]);% 00209 % 00000213
WRITE(OUTPUT,ERRMARK,INFO.BUFPNT-1);% 00210 REAL RES; ALPHA CH;% 00000214
RUNERR(ERRNUM,LINENUM);% 00211 BOOLEAN NEGATIVE,NEGEXP; INTEGER POWER,EXP;% 00000215
END READERR#;% 00212 LABEL OVERFLOW,RETURN;% 00000216
% 00213 % 00000217
REAL RES; ALPHA CH;% 00214 IF BOOLEAN(INFO.EOF) THEN RUNERR(1,LINENUM);% 00000218
BOOLEAN NEGATIVE,NEGEXP; INTEGER POWER,EXP;% 00215 IF BOOLEAN(INFO.ENDFOUND) THEN% 00000219
LABEL OVERFLOW,RETURN;% 00216 BEGIN% 00000220
% 00217 INFO.EOF:=1; PREAD:=0;% 00000221
IF BOOLEAN(INFO.EOF) THEN RUNERR(1,LINENUM);% 00218 GO TO RETURN;% 00000222
IF BOOLEAN(INFO.ENDFOUND) THEN% 00219 END;% 00000223
BEGIN% 00220 IF MODE=1 THEN %*** MODE = CHAR *** 00000224
INFO.EOF:=1; PREAD:=0;% 00221 BEGIN% 00000225
GO TO RETURN;% 00222 PREAD:=INFO.LASTCH; GETCHAR; INFO.LASTCH:=CH;% 00000226
END;% 00223 END ELSE% 00000227
IF MODE=1 THEN %*** MODE = CHAR *** 00224 BEGIN %*** MODE = REAL/INTEGER *** 00000228
BEGIN% 00225 CH:=INFO.LASTCH;% 00000229
PREAD:=INFO.LASTCH; GETCHAR; INFO.LASTCH:=CH;% 00226 WHILE CH=" " AND NOT BOOLEAN(INFO.ENDFOUND) DO GETCHAR;% 00000230
END ELSE% 00227 IF BOOLEAN(INFO.ENDFOUND) THEN% 00000231
BEGIN %*** MODE = REAL/INTEGER *** 00228 BEGIN% 00000232
CH:=INFO.LASTCH;% 00229 INFO.EOF:=1; PREAD:=0;% 00000233
WHILE CH=" " AND NOT BOOLEAN(INFO.ENDFOUND) DO GETCHAR;% 00230 GO TO RETURN;% 00000234
IF BOOLEAN(INFO.ENDFOUND) THEN% 00231 END;% 00000235
BEGIN% 00232 IF CH="+" OR CH="-" THEN BEGIN NEGATIVE:=CH="-"; GETCHAR END;% 00000236
INFO.EOF:=1; PREAD:=0;% 00233 IF CH>9 THEN READERR(3);% 00000237
GO TO RETURN;% 00234 RES:=CH; GETCHAR;% 00000238
END;% 00235 WHILE CH{9 DO BEGIN RES:=10|RES+CH; GETCHAR END;% 00000239
IF CH="+" OR CH="-" THEN BEGIN NEGATIVE:=CH="-"; GETCHAR END;% 00236 IF MODE=3 THEN % MODE = REAL. 00000240
IF CH>9 THEN READERR(3);% 00237 BEGIN% 00000241
RES:=CH; GETCHAR;% 00238 IF CH="." THEN% 00000242
WHILE CH{9 DO BEGIN RES:=10|RES+CH; GETCHAR END;% 00239 BEGIN% 00000243
IF MODE=3 THEN % MODE = REAL. 00240 GETCHAR; IF CH>9 THEN READERR(3);% 00000244
BEGIN% 00241 WHILE CH{9 DO BEGIN RES:=10|RES+CH;POWER:=POWER-1;GETCHAR END;00000245
IF CH="." THEN% 00242 END;% 00000246
BEGIN% 00243 IF CH="E" THEN% 00000247
GETCHAR; IF CH>9 THEN READERR(3);% 00244 BEGIN% 00000248
WHILE CH{9 DO BEGIN RES:=10|RES+CH;POWER:=POWER-1;GETCHAR END; 00245 GETCHAR;% 00000249
END;% 00246 IF CH="+" OR CH="-" THEN BEGIN NEGEXP:=CH="-"; GETCHAR END;% 00000250
IF CH="E" THEN% 00247 IF CH>9 THEN READERR(3);% 00000251
BEGIN% 00248 WHILE CH{9 DO BEGIN EXP:=10|EXP+CH; GETCHAR END;% 00000252
GETCHAR;% 00249 IF NEGEXP THEN EXP:=-EXP;% 00000253
IF CH="+" OR CH="-" THEN BEGIN NEGEXP:=CH="-"; GETCHAR END;% 00250 END;% 00000254
IF CH>9 THEN READERR(3);% 00251 POWER:=POWER+EXP;% 00000255
WHILE CH{9 DO BEGIN EXP:=10|EXP+CH; GETCHAR END;% 00252 REALOVERFLOW:=OVERFLOW; RES:=RES|10*POWER;% 00000256
IF NEGEXP THEN EXP:=-EXP;% 00253 IF FALSE THEN OVERFLOW: READERR(4);% 00000257
END; 00254 REALOVERFLOW:=0;% 00000258
POWER:=POWER+EXP;% 00255 END ELSE IF RES>MAXINT THEN READERR(4);% 00000259
REALOVERFLOW:=OVERFLOW; RES:=RES|10*POWER;% 00256 PREAD:=IF NEGATIVE THEN -RES ELSE RES;% 00000260
IF FALSE THEN OVERFLOW: READERR(4);% 00257 INFO.LASTCH:=CH;% 00000261
REALOVERFLOW:=0;% 00258 END;% 00000262
END ELSE IF RES>MAXINT THEN READERR(4);% 00259 RETURN:% 00000263
PREAD:=IF NEGATIVE THEN -RES ELSE RES;% 00260 END OF PREAD;% 00000264
INFO.LASTCH:=CH;% 00261 % 00000265
END;% 00262 % 00000266
RETURN:% 00263 PROCEDURE WLINE(F,BUF,INFO); %*** PRINT A LINE.*** 00000267
END OF PREAD;% 00264 FILE F; ARRAY BUF[0]; INTEGER INFO;% 00000268
% 00265 BEGIN% 00000269
% 00266 ALPHA CC;% 00000270
PROCEDURE WLINE(F,BUF,INFO); %*** PRINT A LINE.*** 00267 IF BOOLEAN(INFO.OUTP) THEN% 00000271
FILE F; ARRAY BUF[0]; INTEGER INFO;% 00268 BEGIN% 00000272
BEGIN% 00269 REPLACE CHARPNT BY POINTER(BUF[*]) FOR 1; CC:=CHAR[0];% 00000273
ALPHA CC;% 00270 REPLACE POINTER(BUF[*]) BY " ";% 00000274
IF BOOLEAN(INFO.OUTP) THEN% 00271 IF CC=" " THEN WRITE(OUTPUT,999,BUF[*]) ELSE% 00000275
BEGIN% 00272 IF CC="+" THEN WRITE(OUTPUT[NO],999,BUF[*]) ELSE% 00000276
REPLACE CHARPNT BY POINTER(BUF[*]) FOR 1; CC:=CHAR[0];% 00273 BEGIN% 00000277
REPLACE POINTER(BUF[*]) BY " ";% 00274 IF CC="0" THEN WRITE(OUTPUT) ELSE% 00000278
IF CC=" " THEN WRITE(OUTPUT,999,BUF[*]) ELSE% 00275 IF CC="-" THEN WRITE(OUTPUT[DBL]) ELSE% 00000279
IF CC="+" THEN WRITE(OUTPUT[NO],999,BUF[*]) ELSE% 00276 IF CC="1" THEN WRITE(OUTPUT[PAGE]) ELSE% 00000280
BEGIN% 00277 WRITE(OUTPUT,ILLEGALCC,CC);% 00000281
IF CC="0" THEN WRITE(OUTPUT) ELSE% 00278 WRITE(OUTPUT,999,BUF[*]);% 00000282
IF CC="-" THEN WRITE(OUTPUT[DBL]) ELSE% 00279 END;% 00000283
IF CC="1" THEN WRITE(OUTPUT[PAGE]) ELSE% 00280 END ELSE WRITE(F,999,BUF[*]);% 00000284
WRITE(OUTPUT,ILLEGALCC,CC);% 00281 REPLACE POINTER(BUF[*]) BY " " FOR INFO.BUFSIZE;% 00000285
WRITE(OUTPUT,999,BUF[*]);% 00282 INFO.BUFPNT:=0;% 00000286
END;% 00283 END OF WLINE;% 00000287
END ELSE WRITE(F,999,BUF[*]);% 00284 % 00000288
REPLACE POINTER(BUF[*]) BY " " FOR INFO.BUFSIZE;% 00285 % 00000289
INFO.BUFPNT:=0;% 00286 PROCEDURE CHFIL(F);% 00000290
END OF WLINE;% 00287 FILE F;% 00000291
% 00288 BEGIN% 00000292
% 00289 ARRAY A[0:6];% 00000293
PROCEDURE CHFIL(F);% 00290 SEARCH(F,A[*]);% 00000294
FILE F;% 00291 IF A[0]=-1 THEN% 00000295
BEGIN% 00292 BEGIN% 00000296
ARRAY A[0:6];% 00293 F.AREAS := 20;% 00000297
SEARCH(F,A[*]);% 00294 F.AREASIZE := 300;% 00000298
IF A[0]=-1 THEN% 00295 END;% 00000299
BEGIN% 00296 END OF CHFIL;% 00000300
F.AREAS := 20;% 00297 % 00000301
F.AREASIZE := 300;% 00298 % 00000302
END;% 00299 PROCEDURE WALFA(F,BUF,INFO,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,ALENG,00000303
END OF CHFIL;% 00300 LINENUM);% 00000304
% 00301 VALUE A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,ALENG,LINENUM;% 00000305
% 00302 FILE F; ARRAY BUF[0]; INTEGER INFO,ALENG,LINENUM;% 00000306
PROCEDURE WALFA(F,BUF,INFO,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,ALENG, 00303 ALPHA A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12;% 00000307
LINENUM);% 00304 BEGIN% 00000308
VALUE A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,ALENG,LINENUM;% 00305 ALPHA A; POINTER PNT;% 00000309
FILE F; ARRAY BUF[0]; INTEGER INFO,ALENG,LINENUM;% 00306 LABEL EXIT;% 00000310
ALPHA A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12;% 00307 IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00000311
BEGIN% 00308 IF INFO.BUFPNT+ALENG}INFO.BUFSIZE THEN WLINE(F,BUF,INFO);% 00000312
ALPHA A; POINTER PNT;% 00309 PNT:=POINTER(BUF[*])+INFO.BUFPNT;% 00000313
LABEL EXIT;% 00310 INFO.BUFPNT:=INFO.BUFPNT+ALENG;% 00000314
IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00311 FOR A:=A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12 DO% 00000315
IF INFO.BUFPNT+ALENG}INFO.BUFSIZE THEN WLINE(F,BUF,INFO);% 00312 BEGIN% 00000316
PNT:=POINTER(BUF[*])+INFO.BUFPNT;% 00313 TEXT[0]:=A;% 00000317
INFO.BUFPNT:=INFO.BUFPNT+ALENG;% 00314 REPLACE PNT:PNT BY TEXTPNT FOR MIN(ALENG,7);% 00000318
FOR A:=A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12 DO% 00315 ALENG:=ALENG-7; IF ALENG{0 THEN GO TO EXIT;% 00000319
BEGIN% 00316 END;% 00000320
TEXT[0]:=A;% 00317 EXIT:% 00000321
REPLACE PNT:PNT BY TEXTPNT FOR MIN(ALENG,7);% 00318 END OF WALFA;% 00000322
ALENG:=ALENG-7; IF ALENG{0 THEN GO TO EXIT;% 00319 % 00000323
END;% 00320 % 00000324
EXIT:% 00321 PROCEDURE PWRITE(F,BUF,INFO,E,EMODE,M,N,LINENUM);% 00000325
END OF WALFA;% 00322 VALUE E,EMODE,M,N,LINENUM;% 00000326
% 00323 FILE F; ARRAY BUF[0]; REAL E;% 00000327
% 00324 INTEGER INFO,EMODE,M,N,LINENUM;% 00000328
PROCEDURE PWRITE(F,BUF,INFO,E,EMODE,M,N,LINENUM);% 00325 BEGIN% 00000329
VALUE E,EMODE,M,N,LINENUM;% 00326 INTEGER NCHARS,NEXP,I; POINTER CPNT;% 00000330
FILE F; ARRAY BUF[0]; REAL E; 00327 DEFINE PUTCHAR(C)= % PUTS A CHARACTER INTO TEMPTEXT00000331
INTEGER INFO,EMODE,M,N,LINENUM;% 00328 BEGIN CHAR[0]:=C; NCHARS:=NCHARS+1;% 00000332
BEGIN% 00329 REPLACE CPNT:CPNT BY CHARPNT FOR 1;% 00000333
INTEGER NCHARS,NEXP,I; POINTER CPNT;% 00330 END#;% 00000334
DEFINE PUTCHAR(C)= % PUTS A CHARACTER INTO TEMPTEXT 00331 % 00000335
BEGIN CHAR[0]:=C; NCHARS:=NCHARS+1;% 00332 PROCEDURE PUTINT(N); % PUTS AN INTEGER INTO TEMPTEXT 00000336
REPLACE CPNT:CPNT BY CHARPNT FOR 1;% 00333 VALUE N; INTEGER N; % WITH ZERO SUPPRESSION. 00000337
END#;% 00334 IF N{9 THEN PUTCHAR(N) ELSE% 00000338
% 00335 BEGIN PUTINT(N DIV 10); PUTCHAR(ENTIER(N MOD 10)) END;% 00000339
PROCEDURE PUTINT(N); % PUTS AN INTEGER INTO TEMPTEXT 00336 % 00000340
VALUE N; INTEGER N; % WITH ZERO SUPPRESSION. 00337 CPNT:=POINTER(TEMPTEXT[*]);% 00000341
IF N{9 THEN PUTCHAR(N) ELSE% 00338 IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00000342
BEGIN PUTINT(N DIV 10); PUTCHAR(ENTIER(N MOD 10)) END;% 00339 IF EMODE=1 THEN %*** MODE = INTEGER *** 00000343
% 00340 BEGIN% 00000344
CPNT:=POINTER(TEMPTEXT[*]);% 00341 IF E<0 THEN BEGIN PUTCHAR("-"); E:=-E END;% 00000345
IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00342 PUTINT(E);% 00000346
IF EMODE=1 THEN %*** MODE = INTEGER *** 00343 END ELSE% 00000347
BEGIN% 00344 IF EMODE=2 THEN %*** MODE = REAL *** 00000348
IF E<0 THEN BEGIN PUTCHAR("-"); E:=-E END;% 00345 BEGIN% 00000349
PUTINT(E);% 00346 PUTCHAR(" ");% 00000350
END ELSE% 00347 IF E<0 THEN BEGIN PUTCHAR("-"); E:=-E END;% 00000351
IF EMODE=2 THEN %*** MODE = REAL *** 00348 IF E>MAXINT OR N<0 THEN % FLOATING-POINT. 00000352
BEGIN% 00349 BEGIN% 00000353
PUTCHAR(" ");% 00350 IF E>0 THEN% 00000354
IF E<0 THEN BEGIN PUTCHAR("-"); E:=-E END;% 00351 BEGIN% 00000355
IF E>MAXINT OR N<0 THEN % FLOATING-POINT. 00352 WHILE E<1 DO BEGIN NEXP:=NEXP-1; E:=10|E END;% 00000356
BEGIN% 00353 WHILE E}10 DO BEGIN NEXP:=NEXP+1; E:=E/10 END;% 00000357
IF E>0 THEN% 00354 END;% 00000358
BEGIN% 00355 I:=MAX(M-8,1);% 00000359
WHILE E<1 DO BEGIN NEXP:=NEXP-1; E:=10|E END;% 00356 E:=E+0.5|10*(-I);% 00000360
WHILE E}10 DO BEGIN NEXP:=NEXP+1; E:=E/10 END;% 00357 IF E GEQ 10 THEN BEGIN NEXP:=NEXP+1; E:=E/10 END;% 00000361
END; 00358 PUTCHAR(ENTIER(E)); E:=E-ENTIER(E); PUTCHAR(".");% 00000362
I:=MAX(M-8,1);% 00359 DO BEGIN% 00000363
E:=E+0.5|10*(-I);% 00360 E:=10|E; PUTCHAR(ENTIER(E));% 00000364
IF E GEQ 10 THEN BEGIN NEXP:=NEXP+1; E:=E/10 END;% 00361 E:=E-ENTIER(E); I:=I-1;% 00000365
PUTCHAR(ENTIER(E)); E:=E-ENTIER(E); PUTCHAR(".");% 00362 END UNTIL I{0;% 00000366
DO BEGIN% 00363 PUTCHAR("E");% 00000367
E:=10|E; PUTCHAR(ENTIER(E));% 00364 IF NEXP<0 THEN BEGIN PUTCHAR("-"); NEXP:=-NEXP END% 00000368
E:=E-ENTIER(E); I:=I-1;% 00365 ELSE PUTCHAR("+");% 00000369
END UNTIL I{0;% 00366 PUTCHAR(NEXP DIV 10); PUTCHAR(ENTIER(NEXP MOD 10));% 00000370
PUTCHAR("E");% 00367 END ELSE% 00000371
IF NEXP<0 THEN BEGIN PUTCHAR("-"); NEXP:=-NEXP END% 00368 BEGIN % FIXED-POINT. 00000372
ELSE PUTCHAR("+");% 00369 E:=E+0.5|10*(-N);% 00000373
PUTCHAR(NEXP DIV 10); PUTCHAR(ENTIER(NEXP MOD 10));% 00370 PUTINT(ENTIER(E)); PUTCHAR("."); E:=E-ENTIER(E);% 00000374
END ELSE% 00371 IF N>150 THEN RUNERR(6,LINENUM);% 00000375
BEGIN % FIXED-POINT. 00372 FOR I:=1 STEP 1 UNTIL N DO% 00000376
E:=E+0.5|10*(-N);% 00373 BEGIN E:=10|E; PUTCHAR(ENTIER(E));% 00000377
PUTINT(ENTIER(E)); PUTCHAR("."); E:=E-ENTIER(E);% 00374 E:=E-ENTIER(E);% 00000378
IF N>150 THEN RUNERR(6,LINENUM);% 00375 END END END ELSE% 00000379
FOR I:=1 STEP 1 UNTIL N DO% 00376 IF EMODE=3 THEN %*** MODE = BOOLEAN *** 00000380
BEGIN E:=10|E; PUTCHAR(ENTIER(E));% 00377 BEGIN% 00000381
E:=E-ENTIER(E);% 00378 IF E<0.5 THEN REPLACE CPNT BY "FALSE" ELSE REPLACE CPNT BY "TRUE";00000382
END END END ELSE% 00379 NCHARS:=IF E<0.5 THEN 5 ELSE 4;% 00000383
IF EMODE=3 THEN %*** MODE = BOOLEAN *** 00380 END ELSE% 00000384
BEGIN% 00381 IF EMODE=5 THEN %*** MODE = ALFA *** 00000385
IF E<0.5 THEN REPLACE CPNT BY "FALSE" ELSE REPLACE CPNT BY "TRUE"; 00382 BEGIN% 00000386
NCHARS:=IF E<0.5 THEN 5 ELSE 4;% 00383 TEXT[0]:=E; NCHARS:=MIN(M,7);% 00000387
END ELSE% 00384 REPLACE CPNT:CPNT BY TEXTPNT FOR 7;% 00000388
IF EMODE=5 THEN %*** MODE = ALFA *** 00385 END ELSE% 00000389
BEGIN% 00386 BEGIN %*** MODE = CHAR *** 00000390
TEXT[0]:=E; NCHARS:=MIN(M,7);% 00387 PUTCHAR(E);% 00000391
REPLACE CPNT:CPNT BY TEXTPNT FOR 7;% 00388 END;% 00000392
END ELSE% 00389 IF NCHARS>M THEN M:=NCHARS;% 00000393
BEGIN %*** MODE = CHAR *** 00390 IF INFO.BUFPNT+M>INFO.BUFSIZE THEN WLINE(F,BUF,INFO);% 00000394
PUTCHAR(E);% 00391 IF M>INFO.BUFSIZE THEN RUNERR(6,LINENUM);% 00000395
END;% 00392 REPLACE POINTER(BUF[*])+(INFO.BUFPNT+M-NCHARS) BY% 00000396
IF NCHARS>M THEN M:=NCHARS;% 00393 POINTER(TEMPTEXT[*]) FOR NCHARS;% 00000397
IF INFO.BUFPNT+M>INFO.BUFSIZE THEN WLINE(F,BUF,INFO);% 00394 INFO.BUFPNT:=INFO.BUFPNT+M;% 00000398
IF M>INFO.BUFSIZE THEN RUNERR(6,LINENUM);% 00395 END OF PWRITE;% 00000399
REPLACE POINTER(BUF[*])+(INFO.BUFPNT+M-NCHARS) BY% 00396 % 00000400
POINTER(TEMPTEXT[*]) FOR NCHARS;% 00397 % 00000401
INFO.BUFPNT:=INFO.BUFPNT+M;% 00398 PROCEDURE PUT(F,BUF,INFO,LINENUM);% 00000402
END OF PWRITE;% 00399 VALUE LINENUM;% 00000403
% 00400 FILE F; ARRAY BUF[*];% 00000404
% 00401 INTEGER INFO,LINENUM;% 00000405
PROCEDURE PUT(F,BUF,INFO,LINENUM);% 00402 BEGIN% 00000406
VALUE LINENUM;% 00403 IF INFO.BUFSIZE=0 THEN% 00000407
FILE F; ARRAY BUF[*];% 00404 BEGIN% 00000408
INTEGER INFO,LINENUM;% 00405 IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00000409
BEGIN% 00406 WRITE(F,1023,BUF[*]);% 00000410
IF INFO.BUFSIZE=0 THEN% 00407 END ELSE PWRITE(F,BUF,INFO,INFO.LASTCH,4,1,1,LINENUM);% 00000411
BEGIN% 00408 END OF PUT;% 00000412
IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00409 % 00000413
WRITE(F,1023,BUF[*]);% 00410 % 00000414
END ELSE PWRITE(F,BUF,INFO,INFO.LASTCH,4,1,1,LINENUM);% 00411 PROCEDURE GET(F,BUF,INFO,LINENUM);% 00000415
END OF PUT;% 00412 VALUE LINENUM;% 00000416
% 00413 FILE F; ARRAY BUF[*];% 00000417
% 00414 INTEGER INFO,LINENUM;% 00000418
PROCEDURE GET(F,BUF,INFO,LINENUM);% 00415 BEGIN% 00000419
VALUE LINENUM;% 00416 ALPHA X; LABEL ENDFILE;% 00000420
FILE F; ARRAY BUF[*];% 00417 IF INFO.BUFSIZE=0 THEN% 00000421
INTEGER INFO,LINENUM;% 00418 BEGIN% 00000422
BEGIN% 00419 IF BOOLEAN(INFO.EOF) THEN RUNERR(1,LINENUM);% 00000423
ALPHA X; LABEL ENDFILE;% 00420 READ(F,1023,BUF[*]) [ENDFILE];% 00000424
IF INFO.BUFSIZE=0 THEN% 00421 IF FALSE THEN ENDFILE: INFO.EOF:=1;% 00000425
BEGIN% 00422 END ELSE X:=PREAD(F,BUF,INFO,1,LINENUM);% 00000426
IF BOOLEAN(INFO.EOF) THEN RUNERR(1,LINENUM);% 00423 END OF GET;% 00000427
READ(F,1023,BUF[*]) [ENDFILE];% 00424 % 00000428
IF FALSE THEN ENDFILE: INFO.EOF:=1;% 00425 % 00000429
END ELSE X:=PREAD(F,BUF,INFO,1,LINENUM);% 00426 PROCEDURE PPAGE(F,BUF,INFO,LINENUM);% 00000430
END OF GET; 00427 VALUE LINENUM;% 00000431
% 00428 FILE F; ARRAY BUF[*];% 00000432
% 00429 INTEGER INFO,LINENUM;% 00000433
PROCEDURE PPAGE(F,BUF,INFO,LINENUM);% 00430 BEGIN% 00000434
VALUE LINENUM;% 00431 IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00000435
FILE F; ARRAY BUF[*];% 00432 WRITE(F[PAGE]);% 00000436
INTEGER INFO,LINENUM;% 00433 END OF PPAGE;% 00000437
BEGIN% 00434 % 00000438
IF NOT BOOLEAN(INFO.EOF) THEN RUNERR(2,LINENUM);% 00435 % 00000439
WRITE(F[PAGE]);% 00436 PROCEDURE RESET(F,BUF,INFO,LINENUM);% 00000440
END OF PPAGE;% 00437 VALUE LINENUM;% 00000441
% 00438 FILE F; ARRAY BUF[*];% 00000442
% 00439 INTEGER INFO,LINENUM;% 00000443
PROCEDURE RESET(F,BUF,INFO,LINENUM);% 00440 BEGIN% 00000444
VALUE LINENUM;% 00441 IF BOOLEAN(INFO.INP) OR BOOLEAN(INFO.OUTP) THEN RUNERR(5,LINENUM);% 00000445
FILE F; ARRAY BUF[*];% 00442 REWIND(F); INFO.EOF:=0; INFO.EOLN:=0; INFO.BUFPNT:=0;% 00000446
INTEGER INFO,LINENUM;% 00443 INFO.ENDFOUND:=0;% 00000447
BEGIN% 00444 IF INFO.BUFSIZE=0 THEN GET(F,BUF,INFO,LINENUM)% 00000448
IF BOOLEAN(INFO.INP) OR BOOLEAN(INFO.OUTP) THEN RUNERR(5,LINENUM);% 00445 ELSE RLINE(F,BUF,INFO);% 00000449
REWIND(F); INFO.EOF:=0; INFO.EOLN:=0; INFO.BUFPNT:=0;% 00446 END OF RESET;% 00000450
INFO.ENDFOUND:=0;% 00447 % 00000451
IF INFO.BUFSIZE=0 THEN GET(F,BUF,INFO,LINENUM)% 00448 PROCEDURE REWRITE(F,BUF,INFO,LINENUM);% 00000452
ELSE RLINE(F,BUF,INFO);% 00449 VALUE LINENUM;% 00000453
END OF RESET;% 00450 FILE F; ARRAY BUF[*];% 00000454
% 00451 INTEGER INFO,LINENUM;% 00000455
PROCEDURE REWRITE(F,BUF,INFO,LINENUM);% 00452 BEGIN% 00000456
VALUE LINENUM;% 00453 IF BOOLEAN(INFO.INP) OR BOOLEAN(INFO.OUTP) THEN RUNERR(5,LINENUM);% 00000457
FILE F; ARRAY BUF[*];% 00454 REWIND(F); INFO.EOF:=1; INFO.BUFPNT:=0; INFO.ENDFOUND:=0;% 00000458
INTEGER INFO,LINENUM;% 00455 IF INFO.BUFSIZE>0 THEN% 00000459
BEGIN% 00456 REPLACE POINTER(BUF[*]) BY " " FOR INFO.BUFSIZE;% 00000460
IF BOOLEAN(INFO.INP) OR BOOLEAN(INFO.OUTP) THEN RUNERR(5,LINENUM);% 00457 END OF REWRITE;% 00000461
REWIND(F); INFO.EOF:=1; INFO.BUFPNT:=0; INFO.ENDFOUND:=0;% 00458 % 00000462
IF INFO.BUFSIZE>0 THEN% 00459 % 00000463
REPLACE POINTER(BUF[*]) BY " " FOR INFO.BUFSIZE;% 00460 PROCEDURE INIT(INPUTDECL);% 00000464
END OF REWRITE;% 00461 VALUE INPUTDECL;% 00000465
% 00462 BOOLEAN INPUTDECL;% 00000466
% 00463 BEGIN% 00000467
PROCEDURE INIT(INPUTDECL);% 00464 MEMPNT:=1;% 00000468
VALUE INPUTDECL;% 00465 CHARPNT:=POINTER(CHAR[*])+7; TEXTPNT:=POINTER(TEXT[*])+1;% 00000469
BOOLEAN INPUTDECL;% 00466 T:=0; T.BUFSIZE:=80; T.BUFPNT:=80; T.EOLN:=1; T.INP:=1;% 00000470
BEGIN% 00467 I00603:=T; IF INPUTDECL THEN RLINE(INPUT,V00603,I00603);% 00000471
MEMPNT:=1;% 00468 T:=0; T.BUFSIZE:=132; T.EOLN:=1; T.OUTP:=1; T.EOF:=1;% 00000472
CHARPNT:=POINTER(CHAR[*])+7; TEXTPNT:=POINTER(TEXT[*])+1;% 00469 I00742:=T;% 00000473
T:=0; T.BUFSIZE:=80; T.BUFPNT:=80; T.EOLN:=1; T.INP:=1;% 00470 REPLACE POINTER(V00742[*]) BY " " FOR 17 WORDS;% 00000474
I00603:=T; IF INPUTDECL THEN RLINE(INPUT,V00603,I00603);% 00471 END OF INIT;% 00000475
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.

30
PASCAL-Heriot-Watt/README.txt
View File

@@ -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 by Rich Cornwell of North Carolina, US. Proofing and correction were
performed by Paul Kimpel of San Diego, California, US. 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 PASCRUN.DISK.alg_m
Algol source for the run-time system inserted into the translated Algol source for the run-time system inserted into the translated
Algol by the compiler. Transcribed from Algol by the compiler. Transcribed from
@@ -33,5 +53,11 @@ SYMBOL.PASCAL.alg_m
B5700_Pascal_Mar79.pdf. B5700_Pascal_Mar79.pdf.
Paul Kimpel 2016-06-12 Paul Kimpel
June 2016 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.

1104
PASCAL-Heriot-Watt/SYMBOL.PASCAL.alg_m
View File

File diff suppressed because it is too large Load Diff