github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-01-13 15:17:03 +00:00
Code Issues Releases Wiki Activity
retro-software.B5500-software/PASCAL-Heriot-Watt/PATCHES.PASCAL.MKXV-Compile.lst
Paul Kimpel 8a0e5a60cb 1. Commit proofreading corrections to PASCAL.PATCHES.card. 
2. Commit listings and updated compiler source from running PASCAL.PATCHES.card under Mark XV system software. See README.txt for details.
3. Minor change to HMMS2.TEST.card and .lst to reflect symmetry in the chimney temperature profile.
2016-07-16 17:47:15 -07:00

7256 lines
700 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

LABEL 000000000LINE 00186197?EXECUTE PATCH/MERGE PATCH /MERGE
BURROUGHS B-5700 PATCH/MERGE PROGRAM MARK XV.3.00 WEDNESDAY, 07/16/86, 11:45 AM.
INPUT
********** **********************************************************************************
$. 39 PATCHES FOR PASCAL WITH CONFLICTS
$*COMPILE PASCAL/NEW XALGOL LIBRARY
$*XALGOL STACK=800
$*XALGOL FILE TAPE=SYMBOL/PASCAL SERIAL
$*XALGOL FILE NEWTAPE=SYMNEW/PASCAL SERIAL
$*XALGOL FILE LINE=LINE PRINT
$*DATA CARD
$- DOLLAR CARDS FOR COMPILATION
$ TAPE LIST SINGLE SEQXEQ NEW TAPE
$# PATCH 1 FOR PASCAL.XVI.O CONTAINS 10 CARDS. CORRECT SPELLING & TABULATION C 001
$: PATCH TO CORRECT SPELLING IN SOME ERROR MESSAGES, CURRECT TABULATION OF CODE C 001
$: OR COMMENTS, AND TO CORRECT THE CALL ON THE PROCEDURE TO GIVE A NEW PAGE. C 001
$: *** NOTE THAT ERROR(71) IS NOW NO LONGER USED - SEE PATCH 513. C 001
$: IS WAS USED ONCE, BUT INCORRECTLY. ERROR(63) IS CALLED IN ITS PLACE. C 001
$: *** NOTE THAT THE ALGOL CODE FILE "PASCRUN"/"DISK" HAS BEEN RENAMED C 001
$: "PASCAL"/"PRELUDE". IT IS NO LONGER REFERENCED DIRECTLY IN THIS COMPILER C 001
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 001
$: C 001
BEGIN ; % NULL %*** 4) REWRITE 50203000 C 001
GEN("PUT",3,5); %*** 5) PAGE 50204000 C 001
GEN("PPAGE",5,3); % 50208000 C 001
BLOCK; %*** COMPILE PROCEDURE BODY *** 80646000 C 001
COMPSTAT; %*** COMPILE STATEMENT PART *** 80691000 C 001
(" 41 ALFA CONSTANTS MAY NOT BE LONGER THAN 7 CHARACTERS."), 91045000 C 001
(" 55 PROCEDURE NESTING DEPTH + NO OF RECORDS IS TOO GREAT."), 91060000 C 001
(" 87 END-OF-INPUT ENCOUNTERED UNEXPECTEDLY."), 91094000 C 001
(" 97 TOO MANY FILES IN USE."), 91104000 C 001
END OF B5700 PASCAL COMPILER............................................99001000 C 001
$# PATCH 2 FOR PASCAL CONTAINS 171 CARDS. C 002
$: PATCH TO MERGE DAG LANGMYHRS PPP10 TO PPP11 COSY PATCHES C 002
$: WITH NILS OTTES MODIFIED PPP10 SOURCE. C 002
$: DAVID A COOPER , HERIOT-WATT UNIVERSITY, JANUARY 1978. C 002
$: C 002
FILE CARD "SOURCE" (1,10,30); % SOURCE CODE FILE 10035000 C 002
FILE LINES 1 (1,17); % PRINT FILE 10036000 C 002
FILE PASCALGOL DISK SERIAL [20:600] (1,10,30,SAVE 0); % CODE FILE 10037000 C 002
ARRAY PARAMTAB, FORWPARAM1, FORWPARAM2[0:MAXPARAMS]; 10109000 C 002
FILE XREFFILE DISK SERIAL [20:3000] (1,3,30); 10137000 C 002
ALPHA ARRAY XBUFF[0:2]; 10138500 C 002
BOOLEAN XINB; 10138550 C 002
INTEGER ARRAY SYMKIND[0:62]; %USED IN ERROR RECOVERY. 10149000 C 002
ERROR100MESS (//"100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION10188500 C 002
. THE VALUE 07 IS SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT TH10188600 C 002
E COMPILATION ERRORS COUNT."//),% 10188700 C 002
PACKEDSY=61#, ASSERTSY=62#; 10211000 C 002
% 20181500 C 002
% 20181550 C 002
IF ERRNUM=100 20181600 C 002
THEN NUMERRS:=NUMERRS-1;% * ERROR NUMBER 100 ALONE SHOULD NOT 20181650 C 002
% * PREVENT THE XALGOL COMPILATION BEING 20181700 C 002
% * ZIPPED AS THE VALUE 7 IS SUBSTITUTED 20181750 C 002
% * FOR A BAD SAVE CONSTANT IN AN "S" 20181800 C 002
% * OPTION. 20181850 C 002
% 20181900 C 002
% 20181950 C 002
7(INITIAL),MIDDLE,INITIAL; 20308000 C 002
"400READ", "6READLN", "50RESET", "6UNPACK", "50WRITE", 20373000 C 002
"6QQJZXL" DO 20373500 C 002
IF DECL THEN AX := -AX; 20520000 C 002
ABS(A[2]) LEQ ABS(B[2]); 20539000 C 002
% 20541100 C 002
% 20541150 C 002
% 20541200 C 002
BOOLEAN PROCEDURE XREFINPUT(A); 20541250 C 002
ARRAY A[0]; 20541300 C 002
BEGIN 20541350 C 002
LABEL EOF; 20541400 C 002
INTEGER I; 20541450 C 002
% 20541500 C 002
READ(XREFFILE,3,XBUFF[*])[EOF]; 20541550 C 002
FOR I:=0,1,2 DO 20541600 C 002
A[I] := XBUFF[I]; 20541650 C 002
IF FALSE THEN EOF: BEGIN 20541700 C 002
CLOSE(XREFFILE,RELEASE); 20541750 C 002
XINB := TRUE; 20541800 C 002
END; 20541850 C 002
XREFINPUT := XINB; 20541900 C 002
% 20541950 C 002
END OF XREFINPUT; 20541960 C 002
A2 := -A2; 20570000 C 002
BOOLEAN LPARFOUND,SAVEXREFOPT; 20842000 C 002
SAVEXREFOPT := XREFOPTION; XREFOPTION := FALSE; 20847500 C 002
IF SAVEXREFOPT THEN NEWXREF(CURNAME1,CURNAME2,THISLEVEL, 20861500 C 002
FALSE); 20861550 C 002
XREFOPTION := SAVEXREFOPT; 20868500 C 002
% ASSERT 62 ASSERTSY INITIAL 30075500 C 002
IF CURNAME1="6ASSERT" THEN ASSERTSY ELSE 30165500 C 002
END% 30280000 C 002
% 30280025 C 002
% 30280050 C 002
% THE FOLLOWING LINES DECODE ANY OCCURRENCE OF THE "S" OPTION AND 30280075 C 002
% SETS THE GLOBAL INTEGER VARIABLE "SAVEFACTOR" WHICH CONTROLS THE 30280100 C 002
% TYPE OF COMPILATION INITIATED BY THE ZIP. THERE ARE THREE LEGAL FORMS 30280125 C 002
% OF THE "S" OPTION AS FOLLOWS.- 30280150 C 002
% 30280175 C 002
% "S-" WILL GIVE NO ZIP IE. PASCAL SYNTAX CHECK ONLY 30280200 C 002
% "S+" WILL GIVE A ZIP FOR COMPILE AND GO 30280225 C 002
% "S??" WILL GIVE A ZIP FOR COMPILE TO LIBRARY 30280250 C 002
% WHERE ?? IS THE TWO DIGIT DECIMAL SAVE 30280275 C 002
% CONSTANT GIVEN THE OBJECT CODE FILE 30280300 C 002
% NB. IF THE SAVE CONSTANT IS TO BE 30280325 C 002
% LESS THAN 10 THE FIRST DIGIT 30280350 C 002
% MUST BE INCLUDED IE. A "0". 30280375 C 002
% 30280400 C 002
% 30280425 C 002
ELSE 30280450 C 002
IF CX="S" THEN 30280475 C 002
BEGIN 30280500 C 002
IF C="-" THEN SAVEFACTOR:=-1 ELSE 30280525 C 002
IF C="+" THEN SAVEFACTOR:= 0 ELSE 30280550 C 002
IF C LEQ 9 THEN 30280575 C 002
BEGIN 30280600 C 002
SAVEFACTOR := 10 × C; NEXTCHAR; 30280625 C 002
SAVEFACTOR := SAVEFACTOR + C; 30280650 C 002
IF C GTR 9 THEN ERROR(100); 30280675 C 002
END 30280700 C 002
ELSE 30280720 C 002
BEGIN 30280735 C 002
ERROR(100); 30280750 C 002
SAVEFACTOR := 7; 30280765 C 002
END; 30280780 C 002
END; 30280800 C 002
% 30280825 C 002
% 30280850 C 002
% 30280875 C 002
INTEGER EXPRLEVEL,TX,EXPINVARCNT;% 40018000 C 002
BOOLEAN INBRACKET,INRECORD,SIMPLEVAR; 40087000 C 002
SIMPLEVAR := FALSE; 40099000 C 002
CURTYPE := THISID.TYPE; SIMPLEVAR := TRUE; 40104000 C 002
SIMPLEVAR := FALSE; 40109000 C 002
EXPINVARCNT:=EXPINVARCNT+1;% 40120500 C 002
EXPINVARCNT:=EXPINVARCNT-1;% 40121500 C 002
SIMPLEVARIABLE := SIMPLEVAR; 40199500 C 002
IF EXPINVARCNT=0 THEN WRITEEXPR; % 40751000 C 002
LABEL EFH; 50201500 C 002
%*** 6) OPEN & CLOSE (INPUT) FOR 50204500 C 002
% CUMULATIVE FREQUENCY COUNT50204550 C 002
BEGIN 50208100 C 002
GEN("QQJZXL",6,2); 50208200 C 002
INSYMBOL; 50208300 C 002
GO TO EFH; % 50208400 C 002
END; 50208500 C 002
EFH: 50219500 C 002
EXPRLEVEL := 1; 60346500 C 002
IF THISID.IDCLASS=VAR OR 60354000 C 002
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN % 60354500 C 002
EXPRLEVEL := 0; 60383500 C 002
PROCEDURE ASSERTSTAT; 60391100 C 002
BEGIN 60391200 C 002
GEN("IF NOT(",7,1); 60391400 C 002
INSYMBOL; BOOLEXPR; 60391500 C 002
GEN(") THEN",7,2); GEN("RUNERR(",7,1); GEN("7,",2,6); 60391600 C 002
GENINT(CARDCNT); GEN(")",1,7); 60391700 C 002
END OF ASSERTSTAT; 60391800 C 002
IF CURNAME1="6QQJZXL" THEN FILEHANDLING(6) ELSE 60443500 C 002
IF CURSY=ASSERTSY THEN ASSERTSTAT ELSE 60457500 C 002
IF PARAM THEN GEN("0",1,7) ELSE BEGIN 80129000 C 002
GEN("0:",2,6); 80129100 C 002
GENINT(RECSIZE-1); 80129200 C 002
END 80129300 C 002
FORWPARAM1[NUMPARAMS] := CURNAME1; 80177500 C 002
FORWPARAM2[NUMPARAMS] := CURNAME2; 80177600 C 002
INTEGER INDEX, CTYPE, NUMFORWARDS, T, TX, I; 80403000 C 002
ALPHA T3; 80403500 C 002
LABEL LL1; % 80447010 C 002
LABEL LL2; % 80496010 C 002
LABEL LL3; % 80542010 C 002
IF CURLEVEL GEQ MAXTABLES THEN ERROR(101) ELSE 80543500 C 002
BLOCKTAB[CURLEVEL+1] := NUMBLOCKS := NUMBLOCKS + 1; 80543600 C 002
NAMETAB3[CURLEVEL,THISINDEX].FORWARDDEF := 0; 80553000 C 002
T := NAMETAB3[CURLEVEL,THISINDEX].INFO; 80554500 C 002
TX := T + PARAMTAB[T]; 80554600 C 002
FOR I:=T+1 STEP 1 UNTIL TX DO 80554700 C 002
NEWNAME(FORWPARAM1[I],FORWPARAM2[I],CURLEVEL+1); 80554800 C 002
REPLACE POINTER(NAMETAB1[CURLEVEL+1,*]) BY 0 80637500 C 002
FOR MAXNAMES+1 WORDS; 80637600 C 002
IF CURLEVEL GEQ LASTREC THEN ERROR(101); % 80643000 C 002
% 90014100 C 002
% 90014200 C 002
SAVEFACTOR:=0;% * DEFAULT ZIP IS COMPILE AND GO UNLESS 90014300 C 002
% * CHANGED BY THE USE OF THE "S" OPTION 90014400 C 002
% 90014500 C 002
% 90014600 C 002
% 90042100 C 002
% THE FOLLOWING LINES ADD A "0" ONTO THE FRONT OF THE PROGRAM NAME OR90042200 C 002
% THE FIRST SIX CHARACTERS THEREOF IF IT IS LONGER THAN SIX CHARACTERS 90042300 C 002
% THUS GIVING THE NAME OF THE XALGOL OBJECT CODE FILE PRODUCED. 90042400 C 002
% 90042500 C 002
PROGNAME := CURNAME1.[35:36]; PROGNAMELENGTH := MIN(6,CURLENGTH)+1;90042600 C 002
% 90042700 C 002
% 90042800 C 002
BEGIN% 90090400 C 002
WRITE(LINE ,NOERRORS);% 90090500 C 002
IF ERR[100]% 90090600 C 002
THEN WRITE(LINE ,ERROR100MESS);% 90090700 C 002
IF SAVEFACTOR≥0 THEN% *A ZIP IS REQUIRED 90090800 C 002
$VOIDT 90111000 C 002
END% 90129500 C 002
("100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION. THE VALUE 07 IS91106500 C 002
SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT THE COMPILATION ERRO91106600 C 002
RS COUNT."),% 91106700 C 002
("101 PROCEDURES/FUNCTIONS NESTED TOO DEEP."), 91106800 C 002
REWIND(XREFFILE); 92003500 C 002
SORT(PRINTXREF,XREFINPUT,0,XREFMAX,XREFCOMPARE,3,1000,6000); 92005000 C 002
$# PATCH 500 FOR PASCAL.XVI.O CONTAINS 5 CARDS. PRT CELLS 25 TO 30 C 500
$: THIS PATCH CORRECTS THE DOCUMENTATION FOR THE COMPILERS PRT CELLS 25 TO 27 C 500
$: (NOT 21 TO 23). FURTHERMORE. IT USES PRT CELL 30 FOR THE CARD COUNT (IN PLACE C 500
$: OF 27) TO BE CONSISTANT WITH THE OTHER SYSTEM COMPILERS. PRT CELL 27 IS USED C 500
$: FOR THE PAGE COUNT FORMERLY AT SEQUENCE 10134000. C 500
$: NILS OTTE, UNIVERISTY OF NATAL, DURBAN. AUG - NOV 1977. C 500
$: C 500
INTEGER NUMERRS, % @R+25: NUMBER OF ERRORS IN PROGRAM. 10029000 C 500
SAVEFACTOR, % @R+26: SAVEFACTOR FOR CODE FILE. 10030000 C 500
PAGECNT, % @R+27: NUMBER OF PAGES PRINTED. 10033800 C 500
CARDCNT; % @R+30: NUMBER OF CARDS READ. 10034000 C 500
INTEGER LINECNT, ERRINX; % PAGECNT @ PRT+27 10134000 C 500
$# PATCH 501 FOR PASCAL.XVI.O CONTAINS 3 CARDS. "PRT25" FOR USER-S PASCAL PROG. C 501
$: THIS PATCH INCORPORATES THE PRE-DEFINED IDENTIFIER "PRT25" LOCATED C 501
$: AT PRT CELL 25 AS PER DOCUMENTATION. (THE DOCUMENTATION MUST BE C 501
$: AMENDED TO DELETE PRT26 AND PRT27 FROM THE PRE-DEFINED IDENTIFIER LIST.) C 501
$: ** NOTE THAT FILE PASCAL/PRELUDE MUST BE UPDATED FOR "PRT25". C 501
$: THE VARIABLE "PRT25" MAY BE SET BY THE Q COMMON = N CONTROL CARD. C 501
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 501
$: C 501
NEWNAME("50PRT25",0,0); %*** "PRT25" *** 20369100 C 501
T3:=INTTYPE; T3.IDCLASS:=VAR; % GLOBAL INTEGER VARIABLE 20369200 C 501
NAMETAB3[0,THISINDEX] := T3; 20369300 C 501
$# PATCH 502 FOR PASCAL.XVI.O CONTAINS 3 CARDS. LINE COUNT WHEN DEBUGGING C 502
$: TO CORRECT THE LINE COUNT WHEN THE DEBUGGING OPTION TO LIST THE ALGOL C 502
$: CODE GENERATED IS SET (*$D+ *), OTHERWISE LINES PER PAGE GOES WRONG. C 502
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 502
$: C 502
DEFINE LINESPERPAGE = 60 #, 10038000 C 502
IF DUMPOPTION THEN BEGIN IF (LINECNT:=LINECNT+1)≥LINESPERPAGE 20149000 C 502
THEN HEADING; WRITE(LINE,10,ALGOLCARD[*]) END; 20149100 C 502
$# PATCH 503 FOR PASCAL.XVI.O CONTAINS 9 CARDS. INTEGER TO REAL FOR TYPETAB1 C 503
$: WHEN MORE THAN 63 ENTRIES WERE ENTERED IN THE "TYPETAB*" ARRAYS, THE C 503
$: PASCAL COMPILER WAS DISCONTINUED DUE TO INTEGER OVERFLOW, WHICH COULD OCCUR C 503
$: IN A NUMBER OF PROCEDURES AS A RESULT OF ASSIGNING TO AN INTEGER AN ARRAY C 503
$: ELEMENT WHOSE EXPONENT FIELD WAS NOT ZERO. THE FIELD "ARRTYPE" IS C 503
$: [43:10] AND HAS THE 4 HIGH ORDER BITS IN THE EXPONENT FIELD. THIS PATCH C 503
$: ALTERS THE DECLARATIONS OF ALL IDENTIFIER TO WHICH "TYPETAB1" MAY BE C 503
$: ASSIGNED FROM INTEGER TO REAL TO CORRECT THIS ERROR. C 503
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 503
$: C 503
INTEGER IT; REAL T; 50225000 C 503
INTEGER IT; REAL T; 50285000 C 503
INTEGER CASETYPE,ADDR,MAXADDR,INDEX,CTYPE,TX,SX, T3,LLIM,ULIM,I; 70244000 C 503
REAL T1, CVAL; 70246000 C 503
INTEGER LEVEL1000, TYP, NAM, NAMTAB, I, J, RECSIZE; 80020000 C 503
ALPHA T1, FNAME; 80022000 C 503
INTEGER FIRSTPARAM, CURKIND, P1, PX, I, T3; REAL T; 80148000 C 503
INTEGER INDEX, CTYPE, NUMFORWARDS, T3, TX, I; 80403000 C 503
REAL T, CVAL; 80404000 C 503
$# PATCH 504 FOR PASCAL.XVI.O CONTAINS 23 CARDS. IMPLEMENT FORWARD DECLARATIONS C 504
$: FORWARD DECLARATIONS OF PROCEDURES ENDED IN CHAOS DUE TO THE PARAMETERS AND C 504
$: THEIR TYPES NOT BEING KEPT, RESULTING IN GLOBALS BEING REFERENCED WHERE C 504
$: POSSIBLE, AND FORWARD DECLARATIONS OF FUNCTIONS DID NOT WORK AT ALL. C 504
$: THE PROBLEM WAS THAT THE INFORMATION ON THE PARAMETERS WAS BEING STORED C 504
$: IN THE "NAMETAB*" ROWS FOR THE CURRENT LEVEL, WHICH WERE BEING SET TO ZERO C 504
$: ON EXIT FROM PROCEDURE BLOCKS AT THAT LEVEL THEREAFTER. C 504
$: THIS PATCH CORRECTS THE ERROR BY MARKING THE ENTRIES FOR PARAMETERS OF C 504
$: FORWARD PROCEDURES AND FUNCTIONS, SETTING TO ZERO ONLY THOSE ELEMENTS WHICH C 504
$: ARE NOT SO MARKED ON EXIT FROM A BLOCK, AND UNMARKING THE RELEVANT PARAMETERS C 504
$: WHEN THE PROCEDURE OR FUNCTION IS DEFINED. THE MARKING OF THE PARAMETERS C 504
$: IS DONE IN SUCH A WAY THAT THE SAME IDENTIFIER NAME MAY BE USED AT THE SAME C 504
$: LEVEL WITHOUT SYNTAX ERROR 2 TO REPORT THAT THE IDENTIFIER IS ALREADY DEFINED C 504
$: THE UNMARKING REPLACES THE IDENTIFIER NAME IN "NAMETAB*" TO ALLOW FOR THE C 504
$: SAME NAME OR ONE THAT HASHES TO THE SAME PLACE TO HAVE BEEN USED PREVIOUSLY C 504
$: AND NOW DELETED. C 504
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 504
IF FOUND AND THISID.IDCLASS≥FUNC THEN 80548000 C 504
NAMETAB3[CURLEVEL,THISINDEX].FORWARDDEF:=0; 80553000 C 504
(THISID.IDCLASS=FUNC AND NOT FUN) THEN ERROR(43); 80555100 C 504
TX:=(T:=THISID.INFO)+PARAMTAB[T]; % UNMARK FORWARD PARMS 80556000 C 504
FOR I:=T+1 STEP 1 UNTIL TX DO % TO ALLOW REFERENCE 80557000 C 504
BEGIN T3:=PARAMTAB[I].PARAMNAME; 80558000 C 504
CURNAME1:=ABS(NAMETAB1[CURLEVEL+1,T3]); 80559000 C 504
CURNAME2:= NAMETAB2[CURLEVEL+1,T3]; 80560000 C 504
NAMETAB1[CURLEVEL+1,T3]:=0; 80561000 C 504
NEWNAME(CURNAME1,CURNAME2,CURLEVEL+1); 80562000 C 504
IF T3≠THISINDEX THEN BEGIN 80563000 C 504
PARAMTAB[I].PARAMNAME:=THISINDEX; 80564000 C 504
NAMETAB3[CURLEVEL+1,THISINDEX] := 80565000 C 504
NAMETAB3[CURLEVEL+1,T3]; 80565010 C 504
END END; % OF UNMARKING FORWARD PARAMETERS. 80566000 C 504
TX:=(T:=NAMETAB3[CURLEVEL,INDEX].INFO)+PARAMTAB[T]; 80636100 C 504
FOR I:=T+1 STEP 1 UNTIL TX DO % MARK FORWARD PARAMETERS 80636200 C 504
NAMETAB1[CURLEVEL+1,PARAMTAB[I].PARAMNAME].[46:1] := 1; 80636210 C 504
TX:=CURFUNC; CURFUNC:=IF FUN THEN INDEX ELSE -1; 80645000 C 504
FOR I:=0 STEP 1 UNTIL MAXNAMES DO % LEAVE FORWARD PARAMETERS 80647000 C 504
IF NAMETAB1[CURLEVEL,I]>0 THEN NAMETAB1[CURLEVEL,I]:=0; 80648000 C 504
CURLEVEL:=CURLEVEL-1; CURFUNC:=TX; 80649000 C 504
FOR I:=LASTREC STEP 1 UNTIL TOPREC-1 DO % CLEAR RECORD DECS 80693000 C 504
$# PATCH 505 FOR PASCAL.XVI.O CONTAINS 9 CARDS. CHECK FOR HASH TABLE FULL C 505
$: WHEN THERE ARE "MAXNAMES" IDENTIFIERS AT ONE LEVEL, THE "NAMETAB*" ROWS C 505
$: BECOME FULL AND THIS USED TO PUT THE COMPILER INTO AN INFINITE LOOP, C 505
$: EITHER IN "NEWNAME" OR "SEARCHTAB". THIS PATCH INSERTS TEST FOR WRAP AROUND C 505
$: LEADING BACK TO THE HASHED STARTING POINT, FOR WHICH IT GIVES SYNTAX ERROR C 505
$: 40, TOO MANY IDENTIFIERS DECLARED. C 505
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 505
$: C 505
DEFINE HASH(HASH1) = ENTIER((HASH1) MOD MAXNAMES) #; 20202000 C 505
BEGIN ALPHA TNAME; INTEGER WRAPAROUND; 20209000 C 505
WRAPAROUND:=THISINDEX:=HASH(CURNAME1); 20210000 C 505
IF THISINDEX=WRAPAROUND THEN TNAME:=0; % TABLE IS FULL 20216100 C 505
ALPHA TNAME; INTEGER WRAPAROUND; 20237100 C 505
WRAPAROUND:=THISINDEX:=HASH(NAME1); 20238000 C 505
IF THISINDEX=WRAPAROUND THEN % TABLE AT THIS LEVEL IS FULL 20244100 C 505
BEGIN ERROR(40); NAME1:=TNAME; NAME2:=NAMETAB2[TAB,THISINDEX]20244200 C 505
END; 20244300 C 505
$# PATCH 506 FOR PASCAL.XVI.O CONTAINS 2 CARDS. RESERVED WORD ENDING AT CC 80 C 506
$: IF A RESERVED WORD ENDED AT CARD COLUMN 79 OR 80 AND IF THE "BOLDFACE" FOR C 506
$: RESERVED WORDS OPTION IS SET (*$R+ *), AN INVALID INDEX OCCURRED IN THE C 506
$: SCANNER "INSYMBOL". THE PROBLEM IS CURED BY CORRECTLY COMPUTING THE STARTING C 506
$: AND ENDING POINT OF THE RESERVED WORDS. C 506
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 506
$: C 506
BEGIN T1 := CARDLENGTH-CHARCNT-CURLENGTH-1; 30178000 C 506
FOR CURLENGTH+REAL(CHARCNT=0); 30181000 C 506
$# PATCH 507 FOR PASCAL.XVI.O CONTAINS 5 CARDS. "VARIABLE", "SIMPLEVARIABLE" C 507
$: IN PROCEDURE "VARIABLE", "SIMPLEVARIABLE" IS SET TRUE IF A SUBSCRIPT IS C 507
$: SIMPLE, RESULTING IN ALGOL CODE BEING WRITTEN PREMATURELY DURING RECURSIVE C 507
$: CALLS ON PROCEDURE "EXPRESSION", WHICH IN SOME CASES LEAD TO ALGOL SYNTAX C 507
$: ERRORS. SINCE WRITING THE ALGOL CODE IS DEPENDANT ON "EXPRLEVEL" BEING ZERO, C 507
$: THIS PATCH BUMPS ITS VALUE PRIOR TO ANALYSING THE SUBSCRIPT, AND SETS C 507
$: "SIMPLEVARIABLE" FALSE AFTERWARDS. C 507
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 507
$: C 507
EXPRLEVEL := EXPRLEVEL+1; % DO NOT "WRITEEXPR" YET 40120900 C 507
EXPRLEVEL := EXPRLEVEL-1; 40121100 C 507
SIMPLEVARIABLE := FALSE; % RECURSION ON "VARIABLE" 40121200 C 507
EXPRLEVEL := EXPRLEVEL+1; 60063900 C 507
EXPRLEVEL := EXPRLEVEL-1; 60065100 C 507
$# PATCH 509 FOR PASCAL.XVI.O CONTAINS 1 CARD. "CONCAT" A FUNCTION OF ANY TYPE C 509
$: THE INTRINSIC FUNCTION "CONCAT" COULD ONLY BE ASSIGNED TO A VARIABLE DECLARED C 509
$: "REAL" TO AVOID TYPE CONFLICT SYNTAX ERRORS. THIS PATCH MAKES "CONCAT" C 509
$: TYPELESS. C 509
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 509
$: C 509
CURTYPE := 0; % ALFATYPE OR REALTYPE 50050000 C 509
$# PATCH 511 FOR PASCAL.XVI.O CONTAINS 7 CARDS. ALLOW UP-LEVEL ADDRESSING C 511
$: TO ALLOW UP-LEVEL IDENTIFIER REFERENCES. FORMERLY, REFERENCES TO GLOBAL C 511
$: IDENTIFIERS WHICH WERE NOT IN THE OUTER BLOCK WERE FLAGGED BY SYNTAX ERROR C 511
$: 5, UP-LEVEL ADDRESSING NOT IMPLEMENTED DUE TO HARDWARE RESTRICTION. C 511
$: ALTHOUGH THE RESTRICTION EXISTS IN EXTENDED ALGOL, IT IS NOT TRUE THAT THE C 511
$: RESTRICTION IS DUE TO HARDWARE, FOR UP-LEVEL ADDRESSING IS ALLOWED IN C 511
$: COMPATIBLE ALGOL WITH THE CAUTION THAT IT IS INEFFICIENT (THE IMPLEMENTATION C 511
$: IS SIMILAR TO AN ARRAY ELEMENT REFERENCE). C 511
$: THIS PATCH PERMITS SUCH GOBAL REFERENCES, EXCEPT C 511
$: (1) THAT IF THE CONTROL VARIABLE OF A FOR STATEMENT IS NOT LOCAL OR IN THE C 511
$: OUTER BLOCK (PTR) A WARNING IS ISSUED (IN THE FORM OF A SYNTAX ERROR, C 511
$: BUT THE ERROR COUNT IS NOT INCREMENTED), AND C 511
$: (2) THE RESTRICTION IS STILL APPLIED TO FUNCTION NAMES. THE MESSAGE FOR C 511
$: SYNTAX ERROR IS AMENDED ACCORDINGLY. C 511
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 511
$: C 511
IF ERRNUM<0 THEN ERRNUM:=ABS(ERRNUM) ELSE 20180900 C 511
$ %IF THISLEVEL>1 AND THISLEVEL<CURLEVEL THEN ERROR5; 40103000 C 511
$ %IF THISLEVEL>1 AND THISLEVEL≠CURLEVEL THEN ERROR5; 50244000 C 511
$ %IF THISLEVEL>1 AND THISLEVEL≠CURLEVEL THEN ERROR5; 50306000 C 511
IF THISLEVEL≠CURLEVEL-1 OR THISINDEX≠CURFUNC THEN ERROR(5); 60091000 C 511
IF THISLEVEL>1 AND THISLEVEL<CURLEVEL THEN ERROR(-5); 60276000 C 511
(" 5 FUNCTION NAME NOT ACCESSIBLE AT THIS LEVEL."), 91009000 C 511
$# PATCH 512 FOR PASCAL.XVI.O CONTAINS 24 CARDS. IMPLEMENT STRUCTURED ASSIGNMENT C 512
$: TO ALLOW STRUCTURED ASSIGNMENT. FORMERLY, AN ASSIGNMENT OF A STRUCTURE C 512
$: WAS NOT IMPLEMENTED, EG A, B: RECORD ... END; A := B;. C 512
$: THIS PATCH ATTEMPTS TO IMPLEMENT ASSIGNMENT OF STRUCTURES OF ANY KIND, C 512
$: BUT IT WOULD FAIL IF THE STRUCTURE WERE TRANSLATED INTO A MULTI-DIMENSIONAL C 512
$: ALGOL ARRAY. THIS IMPLEMENTATION DOES WORK FOR ARRAYS, RECORDS, C 512
$: SUBSTRUCTURES, AND FOR STRUCTURES ALLOCATED IN THE HEAP. C 512
$: THIS PATCH NEEDS PATH 507 IN ORDER TO SUCCEED. C 512
$: FOR THIS IMPLEMENTATION, THE FOLLOWING DEFINE IS REQUIRED IN THE FILE C 512
$: PASCAL/PRELUDE: DEFINE ASSIGN(DEST, SOURCE, LENGTH) = REPLACE POINTER(DEST) C 512
$: BY POINTER(SOURCE) FOR LENGTH WORDS #; C 512
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 512
$: C 512
60020000 C 512
PROCEDURE WRITESEXPR; %*** FIX STRUCTURE FOR ASSIGNMENT 60021000 C 512
BEGIN % USED ONLY IN ASSIGNMENT OF STRUCTURES 60022000 C 512
IF INSIDEBRACKETS THEN IF SYMTAB[NUMSYMS] = "100000," 60023000 C 512
THEN SYMTAB[NUMSYMS] := ", 0 ] " ELSE PUTSYM("]"); 60024000 C 512
WHILE NUMPOINTERS>0 DO 60025000 C 512
BEGIN NUMPOINTERS := NUMPOINTERS-1; 60026000 C 512
IF NUMSYMS+4 ≥ MAXSYMS THEN WRITEEXPR; 60027000 C 512
REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY 60028000 C 512
"00-1)DIV00 1022,00 T MOD00 1022]"; 60029000 C 512
NUMSYMS := NUMSYMS+4; 60030000 C 512
END; % OF WHILE 60031000 C 512
WRITEEXPR; GEN( ",", 1,7 ); 60032000 C 512
END WRITESEXPR; 60033000 C 512
60034000 C 512
%ERROR(95); % STRUCTURED ASSIGNMENT NOT IMPLEMENTED. 60063000 C 512
GEN("ASSIGN(",7,1); WRITESEXPR; 60064000 C 512
EXPRESSION; WRITESEXPR; 60065000 C 512
GENINT(TYPETAB1[LEFTTYPE].SIZE); GEN(")",1,7); 60066000 C 512
IF TYPETAB1[LEFTTYPE].SIZE≠TYPETAB1[CURTYPE].SIZE 60067000 C 512
THEN ERROR(95); 60068000 C 512
END; 60087000 C 512
CHECKTYPES( LEFTTYPE, CURTYPE ); 60088000 C 512
(" 95 SIZE OF STRUCTURES IN ASSIGNMENT ARE NOT THE SAME."), 91102000 C 512
$# PATCH 513 FOR PASCAL.XVI.O CONTAINS 16 CARDS. FIX POINTERS VIA POINTERS C 513
$: TO CORRECT THE CODE GENERATED FOR CHAINED REFERENCES THROUGH THE HEAP, C 513
$: IE FOR POINTERS TO POINTERS. THE OFFSET FOR COMPONENTS WITHIN RECORDS C 513
$: WAS INCORRECTLY BEING ADDED TO THE RECORD IN THE LEFTMOST REFERENCE, IE THE C 513
$: INNERMOST, INSTEAD OF AT THE EXPECTED LEVEL. C 513
$: FOR EXAMPLE, THE FOLLOWING TWO REFERENCES WOULD BOTH BE TRANSLATED TO C 513
$: THE SAME ALGOL CODE EQUIVALENT TO HEAP[HEAP[ID+IPART+ICOMP]]; C 513
$: ID@.PART@.COMP, ID@.PART.COMP@, C 513
$: WHEN THE FIRST SHOULD HAVE BEEN: HEAP[HEAP[ID+IPART]+ICOMP]. C 513
$: IN ADDITION, THIS PATCH IMPROVES THE COMPILERS CODE FOR GENERATING THE C 513
$: "MEM" ARRAY SUBSCRIPT. C 513
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. 1977-11-14 C 513
$: C 513
IF NUMSYMS+6 ≤ MAXSYMS THEN 40175000 C 513
NUMSYMS := NUMSYMS+2; 40180400 C 513
IF NUMPOINTERS > 0 % POINTER VIA POINTER 40180500 C 513
THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY 40180600 C 513
"00-1)DIV00 1022,00 T MOD00 1022]"; 40180700 C 513
NUMSYMS := NUMSYMS+4; 40180800 C 513
END 40180900 C 513
ELSE NUMPOINTERS := 1; 40181000 C 513
% INBRACKET := FALSE; 40191100 C 513
BEGIN NUMPOINTERS := NUMPOINTERS-1; 40193000 C 513
IF NUMSYMS+4 ≤ MAXSYMS 40194000 C 513
THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY 40194100 C 513
"00-1)DIV00 1022,00 T MOD00 1022]"; 40194200 C 513
NUMSYMS := NUMSYMS+4; 40194300 C 513
END 40194400 C 513
ELSE ERROR(63); % EXPRESSION IS TOO LONG FOR SYMTAB[*] 40195000 C 513
$# PATCH 514 FOR PASCAL.XVI.O CONTAINS 2 CARDS. PROCESS TIME FUNCTION FOR RUN C 514
$: PATCH TO CHANGE THE NAME OF THE FUNCTION ON THE B5700 VERSION WHICH SUPPLIES C 514
$: THE PROCESS TIME USED BY THE PASCAL PROGRAM ON THE CURRENT RUN FROM "ELAPSED" C 514
$: WHICH MEANS PLATFORM TIME, TO "CPUTIME" WHICH IS THE WIDELY ACCEPTED TERM C 514
$: FOR THIS QUANTITY. C 514
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 514
$: C 514
NEWNAME("7CPUTIM","E",0); NAMETAB3[0,THISINDEX]:=T3; 20390000 C 514
IF CURNAME1="7CPUTIM" AND CURNAME2="E" THEN % "CPUTIME" 40452000 C 514
$# PATCH 516 FOR PASCAL.XVI.O. CONTAINS 2 CARDS. CORRECT "NO LISTING" ERROR C 516
$: THIS PATCH CORRECTS AN ERROR WHEREBY IF LISTING WAS TURNED OFF C 516
$: AND PAGE THROW WAS INVOKED, A HEADING WAS PRINTED REGARDLESS. C 516
$: DAVID A COOPER, HERIOT-WATT UNIVERSITY.....JUNE, 1978. C 516
$: C 516
IF CX="L" THEN IF C=1 THEN 30264000 C 516
IF LISTOPTION THEN HEADING ELSE 30264500 C 516
$# PATCH 517 FOR PASCAL.XVI.O. CONTAINS 2 CARD. C 517
$: THIS PATCH CORRECTS AN ERROR THAT CAUSED A FILE DECLARATION C 517
$: TO HAVE ITS NAME STRING SPLIT OVER TWO LINES IN THE GENERATED XALGOL. C 517
$: ALSO CHANGES SYMTAB FORM TYPE REAL TO TYPE ALPHA. C 517
$: DAVID A COOPER, HERIOT-WATT UNIVERSITY.....JUNE, 1978. C 517
$: C 517
ALPHA ARRAY SYMTAB[0:MAXSYMS]; % USED BY "EXPRESSION". 10144000 C 517
IF ALGOLCNT LSS 14 THEN WRITEALGOL; 80103000 C 517
$# PATCH 518 FOR PASCAL.XVI.O. CONTAINS 224 CARDS. C 518
$: THIS PATCH CHANGES THE WAY THAT MULTI-DIMENSION ARRAYS C 518
$: REPRESENTING RECORDS ARE DECLARED. PREVIOSLY THEY WRE DECLARED C 518
$: THE WRONG WAY ROUND FOR XALGOL. THIS PATCH SORTS THE DIMENSIONS C 518
$: INTO ASCENDING ORDER FORM LEFT TO RIGHT AND GENERATES APPROPRIATE C 518
$: DEFINES AND CODE FOR HANDLING THE ARRAYS. C 518
$: STUART ANDERSON, COMPUTER SCIENCE, HERIOT-WATT UNIVERSITY, JUNE.....1978. C 518
$: C 518
DEFINE 10156200 C 518
PERMSUB = 0 #, MAXTOTALSUBSCRS = 100#, 10156300 C 518
ARRNAM = 1 #; 10156400 C 518
ARRAY ARRSUBPERMTAB[0:1,0:MAXTOTALSUBSCRS]; 10156500 C 518
INTEGER PASSPERMTAB, MAXPERMTAB, REMEMBERPOSN; 10156600 C 518
$ 40080000 C 518
BOOLEAN SIMPLEVARIABLE,INSIDEBRACKETS,INSIDEPARENS; 40080100 C 518
$ 40105000 C 518
IF INSIDEPARENS AND TYPETAB1[CURTYPE].STRUCT > 0 AND 40105100 C 518
TYPETAB1[CURTYPE].FORM < FILES THEN 40105200 C 518
PUTID("H",1000×THISLEVEL+THISINDEX,5) 40105300 C 518
ELSE 40105400 C 518
PUTID("V",1000×THISLEVEL+THISINDEX,5); 40105500 C 518
INSIDEPARENS := TRUE; 40258100 C 518
INSIDEPARENS := FALSE; 40259100 C 518
$ 50243000 C 518
GENID("H",1000×THISLEVEL+THISINDEX,5); 50243100 C 518
$ 50307000 C 518
GENID("H",1000×THISLEVEL+THISINDEX,5); 50307100 C 518
$SET VOIDT 80052000 C 518
$POP VOIDT 80064000 C 518
DEFINE 80064005 C 518
LOWSUBS = 0 #, 80064010 C 518
HISUBS = 1 #, 80064015 C 518
NEXTSUBS= 2 #, 80064020 C 518
MAXNOOFSUBSCRIPTS = 20 #, 80064025 C 518
STOPPERSUBTAB = 21 #; 80064030 C 518
ARRAY ARRSUBSCRIPTRANGE[0:2,0:MAXNOOFSUBSCRIPTS]; 80064035 C 518
INTEGER FIRSTRANGE, NEXTFREEENTRY, PASSSUBRANGE, PREVPASS, 80064040 C 518
MP, POSNO, SUBDIFF; 80064045 C 518
IF ARRAYVAR THEN GEN(";",1,7) ELSE ARRAYVAR := TRUE; 80064050 C 518
IF NOT PARAM THEN 80064055 C 518
BEGIN 80064060 C 518
GEN("DEFINE",7,2); 80064065 C 518
GENID("V",LEVEL1000+NAM,5); 80064070 C 518
GEN("[",1,7); 80064075 C 518
END; 80064080 C 518
FIRSTRANGE := STOPPERSUBTAB; NEXTFREEENTRY := 0; 80064085 C 518
POSNO := 1; 80064090 C 518
MP := 10; FIRSTDIM := TRUE; 80064095 C 518
DO 80064100 C 518
BEGIN 80064105 C 518
IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE 80064110 C 518
BEGIN 80064111 C 518
IF NOT PARAM THEN GEN(",",1,7); 80064112 C 518
END; 80064113 C 518
IF NOT PARAM THEN GENID("V",(LEVEL1000+NAM)×MP+POSNO,IF MP=10 80064115 C 518
THEN 6 ELSE 7); POSNO := POSNO + 1; 80064120 C 518
IF POSNO = MP THEN MP := MP×10; 80064125 C 518
IF NEXTFREEENTRY = STOPPERSUBTAB THEN 80064130 C 518
BEGIN 80064135 C 518
ERROR(0); 80064140 C 518
END 80064145 C 518
ELSE 80064150 C 518
BEGIN 80064155 C 518
ARRSUBSCRIPTRANGE[LOWSUBS,NEXTFREEENTRY]:=TYPETAB2[TYP]; 80064160 C 518
ARRSUBSCRIPTRANGE[HISUBS,NEXTFREEENTRY] := TYPETAB3[TYP]; 80064165 C 518
END; 80064170 C 518
SUBDIFF := TYPETAB3[TYP] - TYPETAB2[TYP]; 80064175 C 518
IF FIRSTRANGE = STOPPERSUBTAB THEN 80064180 C 518
BEGIN 80064185 C 518
FIRSTRANGE := NEXTFREEENTRY; 80064190 C 518
NEXTFREEENTRY := NEXTFREEENTRY + 1; 80064195 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,FIRSTRANGE] := STOPPERSUBTAB; 80064200 C 518
END 80064205 C 518
ELSE 80064210 C 518
BEGIN 80064215 C 518
PASSSUBRANGE := FIRSTRANGE; 80064220 C 518
PREVPASS := STOPPERSUBTAB; NEXTFREEENTRY:=NEXTFREEENTRY+1;80064225 C 518
WHILE(SUBDIFF ≥ ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE] 80064230 C 518
-ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE]) AND 80064235 C 518
(ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] ≠ 80064240 C 518
STOPPERSUBTAB) DO 80064245 C 518
BEGIN 80064250 C 518
PREVPASS := PASSSUBRANGE; 80064255 C 518
PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS, 8006426 C 518
PASSSUBRANGE]; 80064265 C 518
END; 80064270 C 518
IF PREVPASS = STOPPERSUBTAB THEN 80064275 C 518
BEGIN 80064280 C 518
IF SUBDIFF ≥ ARRSUBSCRIPTRANGE[HISUBS, 80064285 C 518
PASSSUBRANGE] - 80064290 C 518
ARRSUBSCRIPTRANGE[LOWSUBS, 80064295 C 518
PASSSUBRANGE] THEN 80064300 C 518
BEGIN 80064305 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] := 80064310 C 518
NEXTFREEENTRY - 1; 80064315 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] := 80064320 C 518
STOPPERSUBTAB; 80064325 C 518
END 80064330 C 518
ELSE 80064335 C 518
BEGIN 80064340 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] := 80064345 C 518
FIRSTRANGE; 80064350 C 518
FIRSTRANGE := NEXTFREEENTRY-1; 80064355 C 518
END 80064360 C 518
END 80064365 C 518
ELSE 80064370 C 518
BEGIN 80064375 C 518
IF SUBDIFF ≥ ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE] - 80064380 C 518
ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE] 80064385 C 518
THEN 80064390 C 518
BEGIN 80064395 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] := 80064400 C 518
NEXTFREEENTRY - 1; 80064405 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] := 80064410 C 518
STOPPERSUBTAB; 80064415 C 518
END 80064420 C 518
ELSE 80064425 C 518
BEGIN 80064430 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,PREVPASS] := 80064435 C 518
NEXTFREEENTRY -1; 80064440 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] := 80064445 C 518
PASSSUBRANGE; 80064450 C 518
END 80064455 C 518
END 80064460 C 518
END;TYP:=IF T1.FORM = ARRAYS THEN T1.ARRTYPE ELSE REALTYPE; 80064465 C 518
T1 := TYPETAB1[TYP]; 80064470 C 518
END UNTIL T1.STRUCT = 0 ; 80064475 C 518
IF NOT PARAM THEN 80064480 C 518
BEGIN 80064485 C 518
GEN("]=",2,6); 80064490 C 518
GENID("H",LEVEL1000+NAM,5); 80064495 C 518
GEN("[",1,7); 80064500 C 518
PASSSUBRANGE:= FIRSTRANGE; FIRSTDIM := TRUE; 80064505 C 518
WHILE PASSSUBRANGE ≠ STOPPERSUBTAB DO 80064510 C 518
BEGIN 80064515 C 518
IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE GEN(",",1,7); 80064520 C 518
GENID("V",(LEVEL1000+NAM)×(IF PASSSUBRANGE>9 THEN 100 ELSE 8006453 C 518
10)+PASSSUBRANGE+1,IF PASSSUBRANGE>9 THEN 7 ELSE 6); 80064535 C 518
PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE]; 80064540 C 518
END; 80064545 C 518
GEN("]#;",3,5); 80064550 C 518
END; 80064555 C 518
PASSSUBRANGE := FIRSTRANGE; 80064560 C 518
FIRSTDIM := TRUE; GEN("ARRAY",6,3); GENID("H",LEVEL1000+NAM,5); 80064565 C 518
GEN("[",1,7); 80064570 C 518
WHILE PASSSUBRANGE ≠ STOPPERSUBTAB DO 80064575 C 518
BEGIN 80064580 C 518
IF MAXPERMTAB LEQ MAXTOTALSUBSCRS AND PARAM THEN 80064585 C 518
BEGIN 80064590 C 518
ARRSUBPERMTAB[ARRNAM,MAXPERMTAB] := 80064595 C 518
IF FIRSTDIM THEN NAM ELSE -1; 80064600 C 518
ARRSUBPERMTAB[PERMSUB,MAXPERMTAB] := PASSSUBRANGE; 80064605 C 518
MAXPERMTAB := MAXPERMTAB + 1; 80064610 C 518
END 80064615 C 518
ELSE 80064620 C 518
BEGIN 80064625 C 518
IF MAXPERMTAB > MAXTOTALSUBSCRS THEN ERROR(0); 80064630 C 518
END; 80064640 C 518
IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE GEN(",",1,7); 80064645 C 518
GENINT(ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE]); 80064650 C 518
IF NOT PARAM THEN 80064655 C 518
BEGIN 80064660 C 518
GEN(":",1,7); 80064665 C 518
GENINT(ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE]); 80064670 C 518
END; 80064675 C 518
PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE]; 80064680 C 518
END; 80064685 C 518
GEN("]",1,7); 80064950 C 518
$ 80421000 C 518
IF CURLEVEL > 1 THEN 80421010 C 518
BEGIN 80421020 C 518
INTEGER NAMOFTHING,DIFF; 80421030 C 518
BOOLEAN FIRSTTIME; 80421040 C 518
GEN("BEGIN",6,3); 80421050 C 518
IF MAXPERMTAB > 0 THEN 80421060 C 518
BEGIN 80421070 C 518
PASSPERMTAB := 0; 80421080 C 518
DO 80421090 C 518
BEGIN 80421100 C 518
REMEMBERPOSN := PASSPERMTAB; 80421110 C 518
GEN("DEFINE",7,2); 80421120 C 518
NAMOFTHING := ARRSUBPERMTAB[ARRNAM,PASSPERMTAB]; 80421130 C 518
GENID("V",1000×CURLEVEL+NAMOFTHING,5); 80421140 C 518
GEN("[",1,7); 80421150 C 518
FIRSTTIME := TRUE; 80421160 C 518
DO 80421170 C 518
BEGIN 80421180 C 518
IF FIRSTTIME THEN FIRSTTIME := FALSE ELSE GEN(",",180421190 C 518
,7);80421200 C 518
DIFF := PASSPERMTAB-REMEMBERPOSN+1; 80421210 C 518
GENID("V",(1000+CURLEVEL+NAMOFTHING)×(IF DIFF>9 THEN 100 ELSE 80421220 C 518
10)+DIFF,(IF DIFF > 9 THEN 7 ELSE 6)); 80421230 C 518
PASSPERMTAB := PASSPERMTAB + 1; END 80421270 C 518
UNTIL PASSPERMTAB = MAXPERMTAB OR 80421280 C 518
ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ≠ -1; 80421290 C 518
GEN("]",1,7); 80421300 C 518
GEN("=",1,7); 80421310 C 518
GENID("H",1000×CURLEVEL+NAMOFTHING,5); 80421320 C 518
GEN("[",1,7); 80421340 C 518
PASSPERMTAB := REMEMBERPOSN; FIRSTTIME := TRUE; 80421350 C 518
DO 80421360 C 518
BEGIN 80421370 C 518
IF FIRSTTIME THEN FIRSTTIME := FALSE ELSE GEN(",", 80421380 C 518
1,7);80421390 C 518
DIFF := ARRSUBPERMTAB[PERMSUB,PASSPERMTAB]+1; 80421400 C 518
GENID("V",(1000×CURLEVEL+NAMOFTHING)×(IF DIFF>9 THEN80421410 C 518
100 ELSE 10)+DIFF,(IF DIFF>9 THEN 7 ELSE 6)); 80421420 C 518
PASSPERMTAB := PASSPERMTAB +1; 80421430 C 518
END 80421440 C 518
UNTIL PASSPERMTAB = MAXPERMTAB OR 80421450 C 518
ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ≠ -1; 80421460 C 518
GEN("]#;",3,5); 80421470 C 518
END 80421480 C 518
UNTIL PASSPERMTAB = MAXPERMTAB; 80421490 C 518
MAXPERMTAB := 0; 80421500 C 518
END 80421510 C 518
END; 80421520 C 518
$ 80608000 C 518
BEGIN 80608010 C 518
BEGIN 80608020 C 518
INTEGER NAM,T1,SCRATCH; 80608030 C 518
NAM := PARAMTAB[I].[9:10]; 80608040 C 518
SCRATCH := NAMETAB3[CURLEVEL+1,NAM]; 80608050 C 518
SCRATCH := SCRATCH.TYPE; 80608060 C 518
T1 := TYPETAB1[SCRATCH]; 80608070 C 518
IF T1.STRUCT ≠ 0 AND T1.FORM < FILES THEN 80608080 C 518
GENID("H",1000×(CURLEVEL+1)+NAM,5) 80608090 C 518
ELSE 80608100 C 518
GENID("V",1000×(CURLEVEL+1)+NAM,5); 80608110 C 518
END; 80608120 C 518
MAXPERMTAB := 0; 90070100 C 518
INSIDEPARENS := FALSE; 90070200 C 518
$# PATCH 519 FOR PASCAL.XVI.O. CONTAINS 1 CARDS. INCREASE RUNTIME STACK. C 519
$: C 519
" XALGOL STACK = 2048; STACK = 1024; END."; % 90120500 C 519
$# PATCH 600 FOR PASCAL.XVI.O. CONTAINS 22 CARDS. DAGS DEC77 PATCHES. C 600
$: PATCHES RECEIVED FROM D.LANGMYHR AND TRANSPOSED FROM COSY FORMAT BY C 600
$: DAVID A COOPER. FEBRUARY 1978. C 600
$: C 600
IF(F1 NEQ SET OR RT NEQ EMPTYSET) % 20813000 C 600
AND % 20813050 C 600
(F2 NEQ SET OR LT NEQ EMPTYSET) THEN % 20813100 C 600
IF(F1 NEQ POINTERS OR RT NEQ NILTYPE) % 20814000 C 600
AND % 20814050 C 600
(F2 NEQ POINTERS OR LT NEQ NILTYPE) THEN % 20814100 C 600
BEGIN ERROR(63); % 40023000 C 600
$ 50059000 C 600
GEN("PREAD(",6,2); WRITEEXPR; GEN(",",1,7); % 50079000 C 600
$ 50080000 C 600
$ 50081000 C 600
GENID("F",FILEID,5); GEN(",",1,7); % 50082000 C 600
IF F=NUMERIC THEN % 50086010 C 600
BEGIN % 50086050 C 600
GEN(",",1,7); GENINT(TYPETAB2[CURTYPE]); % 50086100 C 600
GEN(",",1,7); GENINT(TYPETAB3[CURTYPE]); % 50086150 C 600
END ELSE GEN(",0,0,",4,4); % 50086200 C 600
$ SET VOIDT 50088000 C 600
$ POP VOIDT 50093000 C 600
IF NAMTAB.IDCLASS=FUNC THEN GEN("FUNCTN",7,2) % 80037000 C 600
ELSE GEN("PROCEDU",8,1); % 80038000 C 600
IF FOUND AND (THISID.IDCLASS=PROC OR THISID.IDCLASS=FUNC) THEN 80548000 C 600
$#PATCH 601 FOR PASCAL.XVI.O.CONTAINS 147 CARDS. EXTENDE SET MODS. C 601
$: PATCHES RECEIVED FROM D.LANGMYHR AND TRANSPOSED FROM COSY FORMAT BY C 601
$: DAVID A COOPER. FEBRUARY 1978. C 601
$: THIS PATCH MODIFIES THE SET HANDLING ROUTINES TO ALLOW SETS OF 0..93 C 601
$: ELEMENTS C 601
$: NB. THE RUN TIME SYSTEM MUST BE CHANGED ACCORDINGLY..... C 601
$: --- --- ---- ------ ---- -- ------- ---------------- C 601
% 40052050 C 601
% 40052055 C 601
PROCEDURE SPLIT(SPLITINX,WIDTH); % 40052100 C 601
VALUE SPLITINX, WIDTH; % 40052150 C 601
INTEGER SPLITINX, WIDTH ; % 40052200 C 601
BEGIN % 40052250 C 601
INTEGER I; % 40052300 C 601
% 40052350 C 601
IF NUMSYMS+WIDTH LEQ MAXSYMS THEN % 40052400 C 601
BEGIN % 40052450 C 601
FOR I:=NUMSYMS STEP -1 UNTIL SPLITINX DO % 40052500 C 601
SYMTAB[I+WIDTH] := SYMTAB[I]; % 40052550 C 601
FOR I:=1 STEP 1 UNTIL WIDTH DO % 40052600 C 601
SYMTAB[SPLITINX+I-1] := "3000000"; % 40052650 C 601
NUMSYMS := NUMSYMS + WIDTH; % 40052700 C 601
END % 40052750 C 601
ELSE 40052800 C 601
BEGIN % 40052830 C 601
ERROR(63); % 40052860 C 601
NUMSYMS := 1; % 40052890 C 601
END; % 40052900 C 601
END OF SPLIT; % 40052950 C 601
% 40052960 C 601
% 40052965 C 601
END; % 40188005 C 601
IF TYPETAB1[CURTYPE].FORM=SET THEN % *** SET VARIABLES 40188010 C 601
BEGIN % --- --- --------- 40188025 C 601
INTEGER THISSYML, I; % 40188050 C 601
% 40188075 C 601
SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SLOAD("; % 40188100 C 601
IF SIMPLEVAR THEN % 40188125 C 601
BEGIN % 40188150 C 601
PUTSYM(","); % 40188175 C 601
PUTID("W",1000×THISLEVEL+THISINDEX,5); % 40188200 C 601
END % 40188225 C 601
ELSE % 40188250 C 601
IF INBRACKET AND NOT INRECORD THEN % 40188275 C 601
BEGIN % 40188300 C 601
PUTSYM(","); THISSYML := NUMSYMS; % 40188325 C 601
PUTCONST(0); PUTSYM(" "); PUTSYM(","); % 40188350 C 601
FOR I:=STARTSYM+1 STEP 1 UNTIL THISSYML DO % 40188375 C 601
PUTTEXT(SYMTAB[I]); 40188400 C 601
PUTTEXT(" 1] "); % 40188425 C 601
END % 40188450 C 601
ELSE % 40188475 C 601
BEGIN % 40188500 C 601
THISSYML := NUMSYMS; % 40188525 C 601
IF INBRACKET THEN PUTSYM("]"); % 40188550 C 601
FOR I:=1 STEP 1 UNTIL NUMPOINTERS DO % 40188575 C 601
BEGIN % 40188600 C 601
PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); % 40188625 C 601
PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); % 40188650 C 601
END; % 40188675 C 601
PUTSYM(","); % 40188700 C 601
FOR I:=STARTSYM+1 STEP 1 UNTIL THISSYML DO % 40188725 C 601
PUTTEXT(SYMTAB[I]); % 40188775 C 601
PUTTEXT(" +1 "); % 40188800 C 601
IF INBRACKET THEN PUTSYM("]"); % 40188825 C 601
FOR I:=1 STEP 1 UNTIL NUMPOINTERS DO % 40188850 C 601
BEGIN % 40188875 C 601
PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); % 40188900 C 601
PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); % 40188915 C 601
END; % 40188930 C 601
NUMPOINTERS := 0; % 40188945 C 601
END; 40188960 C 601
PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); % 40188975 C 601
END OF SET VARIABLES; % 40188990 C 601
$ 40198000 C 601
IF TYPETAB1[THISID.TYPE].FORM=SET THEN 40274200 C 601
BEGIN % 40274220 C 601
GEN(",",1,7); % 40274240 C 601
GENID("W",1000×THISLEVEL+THISINDEX,5); % 40274260 C 601
END; % 40274280 C 601
BOOLEAN FIRST, SPLITTED; % 40296000 C 601
PUTTEXT("SETBS("); PUTTEXT(" 3,2,"); PUTCONST(CARDCNT); % 40529000 C 601
PUTSYM(")"); % 40529300 C 601
CURTYPE := EMPTYSET; CURMODE := NUMBER; % 40529600 C 601
STARTSYM := NUMSYMS + 1; % 40533500 C 601
PUTTEXT(" SETB("); % 40536000 C 601
PUTSYM(","); SYMTAB[STARTSYM] := "SETBS("; % 40544000 C 601
IF SPLITTED THEN PUTSYM(")"); % 40551500 C 601
IF CURSY=COMMA THEN % 40552000 C 601
BEGIN % 40552200 C 601
SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SUNIO("; % 40552400 C 601
PUTSYM(","); % 40552600 C 601
SPLITTED := TRUE; % 40552800 C 601
END; % 40552850 C 601
NEWTYPE; T1 := SET; T1.SIZE := 2; T1.STRUCT := 0; % 40558000 C 601
CURMODE := NUMBER; % 40561000 C 601
IF CURTYPE=BOOLTYPE THEN % 40587000 C 601
IF CURSY NEQ ANDSY THEN ERROR(64); 40593000 C 601
END ELSE % 40593100 C 601
IF F=SET THEN % 40593200 C 601
BEGIN % 40593300 C 601
IF CURSY=ASTERISK THEN % 40593400 C 601
BEGIN % 40593500 C 601
SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SINTS("; % 40593600 C 601
PUTSYM(","); % 40593700 C 601
END ELSE ERROR(64); % 40593800 C 601
MODE := NUMBER; % 40593900 C 601
IF F=SET THEN PUTSYM(")"); % 40608500 C 601
SPLIT(STARTSYM,1); % 40650000 C 601
IF CURSY=PLUS THEN SYMTAB[STARTSYM] := "SUNIO(" ELSE % 40651000 C 601
IF CURSY=MINUS THEN SYMTAB[STARTSYM] := "SDIFF(" ELSE % 40652000 C 601
ERROR(64); % 40653000 C 601
PUTSYM(","); MODE := NUMBER; % 40654000 C 601
$ 40655000 C 601
IF F=SET THEN PUTSYM(")"); % 40668500 C 601
$ 40688000 C 601
IF CURSY=EQLSY THEN SYMTAB[STARTSYM] := "SEQUA(" % 40713000 C 601
ELSE 40713150 C 601
IF CURSY=NEQSY THEN % 40713300 C 601
BEGIN % 40714000 C 601
SPLIT(STARTSYM,1); SYMTAB[STARTSYM]:= " NOT "; % 40714150 C 601
SYMTAB[STARTSYM+1] := "SEQUA("; % 40714300 C 601
IF TYPETAB1[LEFTTYPE].FORM=SET THEN % 60080100 C 601
BEGIN % 60080200 C 601
SYMTAB[1] := "SSTOR("; NUMSYMS := NUMSYMS - 3; % 60080300 C 601
EXPRESSION; % 60080400 C 601
PUTSYM(")"); CHECKTYPES(LEFTTYPE,CURTYPE); % 60080500 C 601
WRITEEXPR; % 60080600 C 601
END ELSE % 60080700 C 601
IF TYPETAB2[TX] LSS 0 OR TYPETAB3[TX] GTR 93 THEN ERROR(51); 70210000 C 601
T1.SIZE := TSIZE := 2; TYPETAB1[TYPEINDEX] := T1; % 70214000 C 601
IF T1.FORM=SET THEN % 80046200 C 601
BEGIN % 80046400 C 601
GEN(",",1,7); GENID("W",LEVEL1000+NAM,5); % 80046600 C 601
END; % 80046800 C 601
IF T1.FORM=SET THEN % 80064700 C 601
BEGIN % 80064750 C 601
GEN(",0",2,6); % 80064800 C 601
IF NOT PARAM THEN GEN(":1",2,6); % 80064850 C 601
END; % 80064900 C 601
BEGIN % 80608105 C 601
IF T1.FORM=SET THEN % 80608111 C 601
BEGIN % 80608113 C 601
GEN(",",1,7); % 80608115 C 601
GENID("W",1000×(CURLEVEL+1)+NAM,5); % 80608117 C 601
END; 80608118 C 601
END; % 80608119 C 601
IF TYPETAB1[NAMETAB3[CURLEVEL+1,PARAMTAB[I].PARAMNAME].TYPE80627200 C 601
].FORM=SET 80627205 C 601
THEN BEGIN % 80627400 C 601
GEN(",",1,7); % 80627600 C 601
GENID("W",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME 80627800 C 601
,5); % 80627801 C 601
END; 80627850 C 601
$#PATCH 602 FOR PASCAL.XVI./ CONTAINS 5 CARDS. CORRECT REPRESENTATION OF "NIL". C 602
$: RECEIVED FROM DAG LANGHYMR ON 6/07/78. C 602
$: DAVID A COOPER , HERIOT-WATT UNIVERSITY... JULY 1978. C 602
NILTYPE := 6; %*** TYPE OF "NIL" *** 20363000 C 602
T1.FORM := POINTERS; TYPETAB1[6] := T1; 20364000 C 602
EMPTYSET := 7; % 20364500 C 602
T1.FORM := SET; TYPETAB1[7] := T1; 20365000 C 602
NUMTYPES := 7; % 20365500 C 602
$# PATCH 603 FOR PASCAL XVI.O CONTAINS 6 CARDS. CORRECT TO PATCH 601 C 603
$: DAVID A COOPER & S O ANDERSON, HERIOT-WATT UNIVERSITY. UST AUGUST 1978 C 603
$: C 603
INTEGER STARTSYM,FIRSTSYM,MODE,TYPE1,F; 40618000 C 603
PUTDUMMY; STARTSYM := FIRSTSYM := NUMSYMS; 40621000 C 603
SPLIT(FIRSTSYM,1); 40650000 C 603
IF CURSY = PLUS THEN SYMTAB[FIRSTSYM] := "SUNIO(" ELSE 40651000 C 603
IF CURSY = MINUS THEN SYMTAB[FIRSTSYM] := "SDIFF(" ELSE 40652000 C 603
ERROR(64); 40653000 C 603
$# PATCH 615 FOR PASCAL.XVI.O. CONTAINS 7 CARDS. C 615
$ 40105100 C 615
$ 40105200 C 615
$ 40105300 C 615
$ 40105400 C 615
IF INSIDEPARENS AND SIMPLEVAR AND TYPETAB1[CURTYPE].STRUCT > 0 AND 40198500 C 615
TYPETAB1[CURTYPE].FORM < FILES THEN SYMTAB[STARTSYM].[35:6] := 40198600 C 615
"H"; 40198700 C 615
$# PATCH 700 FOR PASCAL.XVI.O HAS 179 CARDS. REDUCE THRASHING BY CODE CHANGE C 700
$: TO IMPROVE RUN TIME EFFICIENCY BY REAARRANGING THE THE COMPILERS CODE. C 700
$: THE COMPILER HAD A HIGH OVERLAY I/O TIME AND HIGH ELAPSED TIME IN RELATION C 700
$: TO THE PROCESS TIME, AND OBSERVATION OF THE B5700 CONFIRMED THAT IT WAS C 700
$: THRASHING IN 32K. THIS PATCH ATTEMPTS TO REDUCE THE CORE REQUIREMENT BY C 700
$: REARRANGING THE SEGMENTATION OF THE CODE. LARGE SEGMENTS ARE ELIMINATED C 700
$: SO AS TO AVOID PULLING CODE THAT WILL NOT BE EXECUTED INTO CORE AND TO C 700
$: RELEASE CODE SEGMENTS AS SO AS EXECUTION HAS PASSED. FOR EXAMPLE, THE C 700
$: CROSS REFERENCE ROUTINES WERE ALL CONTAINED IN THE LARGE OUTER BLOCK CODE C 700
$: SEGMENT WHICH INCLUDED VARIOUS UTILITY ROUTINES. C 700
$: A FEATURE WHICH CONTRIBUTED SIGNIFICANTLY TO LARGE SEGMENTS WAS THE HIGH C 700
$: NUMBER OF "DEFINES" WHICH RESULTED IN SIZEABLE SECTIONS OF CODE BEING C 700
$: GENERATED IN-LINE, SOMETIMES MANY TIMES IN ONE SEGMENT. THESE "DEFINES" C 700
$: WERE READILY CHANGED INTO PROCEDURES. (A SIDE EFFECT OF VIRTUALLY ELIMINATING C 700
$: DEFINES FOR CODE IS THAT THE "BEND" OPTION NO LONGER RESULTS IN NUMEROUS C 700
$: BLANK LINES REPEATING THE SAME SEQUENCE NUMBER FOR EVERY "END" IN THE NESTED C 700
$: DEFINES.) C 700
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN AUG - NOV 1977. C 700
$: C 700
$ 10167000 C 700
$ 10168000 C 700
$ 10169000 C 700
VALUE NAME1,NAME2,TABLE,DECL; 20016000 C 700
REAL NAME1,NAME2; 20017000 C 700
INTEGER TABLE; BOOLEAN DECL; 20018000 C 700
FORWARD; 20019000 C 700
PROCEDURE PRINTERRORS; FORWARD; 20020000 C 700
PROCEDURE HEADING; %*** PRINTS A HEADING AT START OF NEW PAGE.20026000 C 700
BEGIN DEFINE NEWSEGMENT = HERE #; 20027000 C 700
END OF HEADING; 20033000 C 700
PROCEDURE PRINTLINE; %*** PRINTS A PASCAL SOURCE CODE LINE 20036000 C 700
BEGIN DEFINE NEWSEGMENT = HERE #; 20037000 C 700
END OF PRINTLINE; 20047000 C 700
PROCEDURE NEWCARD; %*** READS A NEW PASCAL SOURCE CODE CARD 20050000 C 700
BEGIN DEFINE RESULT = ICARD[*], ETC #; 20051000 C 700
REPLACE XLINEPNT BY " " FOR 16 WORDS; 20056000 C 700
REPLACE LINEPNT BY CARDPNT FOR 10 WORDS, XLINEPNT FOR 6 WORDS; 20057000 C 700
END OF NEWCARD; 20061000 C 700
DEFINE GEN(GEN1,GEN2,GEN3) = GENI(TRUE,GEN1,GEN3,GEN2) #, 20063100 C 700
GENID(GENID1,GENID2,GENID3)= GENI(FALSE,GENID1,GENID2,GENID3) #; 20063200 C 700
20063300 C 700
PROCEDURE GENI(GENT, TXT, NUM, N ); 20063400 C 700
VALUE GENT, TXT, NUM, N; 20063500 C 700
BOOLEAN GENT; ALPHA TXT; INTEGER NUM, N; 20063600 C 700
BEGIN DEFINE START = NUM #, NDIG = N #; 20063700 C 700
20063800 C 700
IF GENT THEN %*** GENERATE A TEXT "TXT", CONSISTING OF 20064000 C 700
TEXT[0] := TXT; 20067000 C 700
END 20070000 C 700
ELSE %*** GENERATE AN ALGOL IDENTIFIER. 20073000 C 700
CH[0] := TXT; 20076000 C 700
END END GENI; 20079000 C 700
PROCEDURE GENINT( N ); 20082000 C 700
VALUE N; INTEGER N; 20083000 C 700
BEGIN DEFINE RESULT = ALGOL CODE #; 20084000 C 700
INTEGER NABS, NSIZE; 20085000 C 700
END OF GENINT; 20097000 C 700
PROCEDURE WRITEALGOL; %*** WRITES A COMPLETED ALGOL CARD TO 20145000 C 700
DEFINE NEWSEGMENT = HERE #; 20146100 C 700
DEFINE NEWSEGMENT = HERE #; 20168100 C 700
DEFINE NEWSEGMENT = HERE #; 20180100 C 700
DEFINE NEWSEGMENT = HERE #; 20193100 C 700
ALPHA THISID, CURNAME1, CURNAME2; % USED IN SCANNER 20205000 C 700
PROCEDURE SEARCHTAB( TAB ); %*** SEARCH NAME TABLE "TAB" FOR THE 20208000 C 700
VALUE TAB; INTEGER TAB; %*** IDENTIFIER JUST READ. 20208100 C 700
END OF SEARCHTAB; 20221000 C 700
PROCEDURE SEARCH; %*** SEARCH ALL TABLES CURRENTLY IN USE. 20223000 C 700
BEGIN DEFINE RESULT = THISID #; 20224000 C 700
END OF SEARCH; 20233000 C 700
PROCEDURE NEWNAME( NAME1,NAME2, TAB ); 20236000 C 700
VALUE NAME1, NAME2, TAB; 20236100 C 700
ALPHA NAME1, NAME2; INTEGER TAB; 20236200 C 700
END OF NEWNAME; 20250000 C 700
DEFINE NEWSEGMENT = HERE #; 20515100 C 700
DEFINE NEWSEGMENT = HERE #; 20533100 C 700
DEFINE NEWSEGMENT = HERE #; 20546100 C 700
PROCEDURE CHECKTYPES( LEFTTYPE, RIGHTTYPE ); 20802000 C 700
VALUE LEFTTYPE, RIGHTTYPE; INTEGER LEFTTYPE, RIGHTTYPE; 20803000 C 700
BEGIN 20804000 C 700
REAL TT1, TT2; INTEGER F1, F2, LT, RT; 20805000 C 700
END OF CHECKTYPES; 20838000 C 700
PROCEDURE FILEPARAM( DEFAULTFILE ); %*** CHECKS THE FIRST PARAMETER 20844000 C 700
VALUE DEFAULTFILE; INTEGER DEFAULTFILE;%*** TO SEE IF IT IS A FILE. 20844100 C 700
BEGIN DEFINE RESULTS = FILENAME & LPARFOUND #; 20845000 C 700
END OF FILEPARAM; 20869000 C 700
REAL CURVAL; INTEGER CURLENGTH; 20872000 C 700
20873000 C 700
PROCEDURE CONSTANT( CVAL, CTYPE ); 20874000 C 700
REAL CVAL; INTEGER CTYPE; 20875000 C 700
BEGIN 20876000 C 700
INTEGER TFORM; BOOLEAN SIGNED, NEGATIVE; 20876100 C 700
END OF CONSTANT; 20921000 C 700
$ 30082000 C 700
ALPHA C, CX; %( CURNAME1 & CURNAME2 MOVED TO 20205000 ) 30083000 C 700
INTEGER LASTCHARPOS; %( CURVAL, CURLENGTH MOVED TO 20872000 ) 30084000 C 700
PROCEDURE INSYMBOL; %*** IDENTIFIES THE NEXT SYMBOL ****** 30087000 C 700
BEGIN 30087100 C 700
30087200 C 700
PROCEDURE NEXTCHAR; %*** GETS THE NEXT CHARACTER. 30088000 C 700
END OF NEXTCHAR; 30093000 C 700
$ SET VOIDT 30095000 C 700
$ POP VOIDT 30098000 C 700
DEFINE T1 = EXP #; % USED AT 30178000 30099100 C 700
BEGIN DEFINE NEWSEGMENT = HERE #; 30261100 C 700
END NEWSEGEMENT; 30282200 C 700
$ 40016000 C 700
$ 40017000 C 700
INTEGER EXPRLEVEL; 40018000 C 700
DEFINE PUTSYM(S) = PUTTEXT( (S)&1[41:5:6] ) #; 40029000 C 700
$ SET VOIDT 40029900 C 700
$ POP VOIDT 40033000 C 700
DEFINE PUTDUMMY = PUTTEXT("3000000") #; 40041000 C 700
$ SET VOIDT 40042000 C 700
$ POP VOIDT 40044000 C 700
PROCEDURE WRITEEXPR; %*** WRITE GENERATED ALGOL EXPRESSION 40053000 C 700
REAL SX; INTEGER T1, TX; 40054100 C 700
END OF WRITEEXPR; 40066000 C 700
PROCEDURE CHECKEXPR( LLIM, ULIM ); %*** WRITE CODE TO CHECK VALUE 40069000 C 700
VALUE LLIM, ULIM; INTEGER LLIM, ULIM; 40069100 C 700
BEGIN DEFINE CHECK = VALUE #; 40070000 C 700
END OF CHECKEXPR; 40077000 C 700
INTEGER T1, T5; % USED ONCE EACH 40086100 C 700
T1:=T.FIRSTWITHSYM; T5:=T.LASTWITHSYM; 40094000 C 700
FOR T1:=T1 STEP 1 UNTIL T5 DO PUTTEXT(WITHTAB[T1]); 40095000 C 700
DEFINE T1 = T #; % USED AT 40558000 40298000 C 700
$ SET VOIDT 40299000 C 700
$ POP VOIDT 40309000 C 700
40331000 C 700
PROCEDURE PARAMETER; %*** CHECK THAT THE FUNCTION HAS 1 PARAM.40332000 C 700
BEGIN 40333000 C 700
INSYMBOL; 40334000 C 700
IF CURSY=LPAR 40335000 C 700
THEN BEGIN 40336000 C 700
PUTSYM("("); INSYMBOL; EXPRESSION; 40337000 C 700
IF TYPETAB1[CURTYPE].FORM=NUMERIC THEN CURTYPE:=INTTYPE; 40338000 C 700
IF CURSY≠RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; 40339000 C 700
PUTSYM(")"); IF CURSY=RPAR THEN INSYMBOL; 40340000 C 700
END ELSE ERROR(3); % OR ERROR(58) 40341000 C 700
END OF PARAMETER; 40342000 C 700
40350000 C 700
$ 60396000 C 700
BEGIN LABEL LABFOUND; 60399000 C 700
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) OR 60423000 C 700
THISID.IDCLASS=FUNC 60423200 C 700
THEN ASSIGNMENT ELSE 60424000 C 700
$ SET VOIDT 70013000 C 700
$ POP VOIDT 70016000 C 700
VALUE RECTAB,FIRSTADDR; 70018000 C 700
INTEGER RECTAB,FIRSTADDR,LASTADDR; 70019000 C 700
$ SET VOIDT 70022000 C 700
$ POP VOIDT 70034000 C 700
70035000 C 700
PROCEDURE TYPEDECL( TTYPE, TSIZE ); %***** TYPE DECLARATION ***** 70036000 C 700
INTEGER TTYPE, TSIZE; %**************************** 70037000 C 700
BEGIN 70038000 C 700
INTEGER RECINX, ARRSTRUCT, TX, SX, T, N; REAL T1, T2, T3; 70039000 C 700
BOOLEAN FIRST, PACKED; 70040000 C 700
70041000 C 700
$ 70042000 C 700
END TYPERR; 70048000 C 700
PROCEDURE SUBRANGE; %*** SUBRANGE DECLARATION *** 70050000 C 700
BEGIN %**************************** 70051000 C 700
REAL VALX1, VALX2, T1; 70052000 C 700
INTEGER TYPEX1, TYPEX2; 70053000 C 700
70054000 C 700
CONSTANT(VALX1,TYPEX1); 70055000 C 700
IF TYPETAB1[TYPEX1].FORM>CHAR THEN ERROR(11); 70056000 C 700
IF CURSY≠DOUBLEDOT THEN ERROR(53); 70057000 C 700
INSYMBOL; 70058000 C 700
CONSTANT(VALX2,TYPEX2); 70059000 C 700
IF TYPEX1>0 AND TYPEX2>0 THEN 70060000 C 700
IF TYPEX1≠TYPEX2 THEN ERROR(11) ELSE 70061000 C 700
IF VALX1>VALX2 THEN ERROR(54); 70062000 C 700
IF (T1:=TYPETAB1[TYPEX1].FORM) = SYMBOLIC THEN T1:=SUBTYPE; 70063000 C 700
NEWTYPE; TTYPE:=TYPEINDEX; 70064000 C 700
T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; T1.MAINTYPE:=TYPEX1; 70065000 C 700
TYPETAB1[TYPEINDEX]:=T1; 70066000 C 700
TYPETAB2[TYPEINDEX]:=VALX1; TYPETAB3[TYPEINDEX]:=VALX2; 70067000 C 700
END OF SUBRANGE; 70068000 C 700
70069000 C 700
DEFINE DEC = POINTER #; 70117100 C 700
DEFINE DEC = ARRAY #; 70143100 C 700
DEFINE DEC = FILE #; 70180100 C 700
DEFINE DEC = SET #; 70200100 C 700
DEFINE DEC = RECORD #; 70220100 C 700
LABEL CASEPART, EXIT; 70247000 C 700
BEGIN DEFINE DEC = VARIANT #; 70285100 C 700
LABEL CASETYPEID; 70285200 C 700
END; 70349100 C 700
DEFINE DEC = FILE #; 80066100 C 700
GEN(""/",2,6); 80107000 C 700
DEFINE DEC = LABEL #; 80424100 C 700
DEFINE DEC = CONST #; 80447100 C 700
DEFINE DEC = TYPE #; 80475100 C 700
DEFINE DEC = VAR #; 80496100 C 700
IF CURSY=FUNCSY OR CURSY=PROCSY % 80540900 C 700
THEN BEGIN DEFINE DEC = CODE #; 80540910 C 700
END OF SEGMENT FOR PROCEDURE DECLARATIONS; 80658100 C 700
$# PATCH 701 FOR PASCAL.XVI.O CONTAINS 14 CARDS. REDUCE THRASHING BY ARRAY CUTS C 701
$: TO IMPROVE RUN TIME EFFICIENCY BY REDUCING ARRAY SIZES. THE MOST SIGNIFICANT C 701
$: CONTRIBUTION TO THE COMPILERS THRASHING BEHAVIOUR WAS THE EXCESSIVELY LARGE C 701
$: DATA ARRAYS. THIS PATCH SUCCEEDS IN DRASTICALLY REDUCING THE CORE REQUIREMENT C 701
$: OF THE COMPILER BY MAKING MOST OF THE LARGE ARRAYS MUCH SMALLER WITHOUT C 701
$: IMPOSING UNREASONABLE RESTRICTIONS. IN PARTICULAR, THE THREE ARRAYS, C 701
$: NAMETAB1, NAMETAB2, NAMETAB3 WERE EACH [0:50, 0:1022], AND HAVE BEEN REDUCED C 701
$: TO [0:30, 0:307]. THESE REDUCTIONS HAVE NOT PREVENTED THE COMPILATION OF C 701
$: A LARGE PASCAL PROGRAM OF ABOUT 4000 LINES, NAMELY THE P4 PASCAL COMPILER C 701
$: FROM ZURICH. IN FACT, PRIOR TO THE CHANGES INTRODUCED BY PATCHES 700 & 701, C 701
$: THE P4 PASCAL COMPILER TOOK 60 MINUTES ELAPSED TIME TO COMPILE, WHICH WAS C 701
$: REDUCED TO 9 MINUTES BY THESE PATCHES, WHILE THE PROCESS TIME HAS REMAINED C 701
$: CONSTANT AT 9 MINUTES. C 701
$:**** NOTE THAT IF "MAXNAMES" IS CHANGED THEN THERE ARE 7 DEFINES IN THE FILE C 701
$: PASCAL/PRELUDE THAT MUST ALSO BE CHANGED. C 701
$: "MAXNAMES" IS CHOSEN AS A PRIME NUMBER AS IT IS USED AS A MODULUS FOR A HASH C 701
$: FUNCTION. THE PASCAL IDENTIFIERS ARE TRANSLATED TO ALGOL NAMES USING LEVEL C 701
$: AND HASH INDEX. HENCE CHANGING "MAXNAMES" CHANGES THE ALGOL NAMES FOR C 701
$: "INPUT", "OUTPUT", & "PRT25". C 701
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN AUG - NOV 1977. C 701
$: C 701
DEFINE MAXTABLES = 30 #, %MAX NUMBER OF LEVELS IN IDENTIFIER TABLE.10042000 C 701
MAXNAMES =307 #, %MAX NAMES IN EACH ROW OF IDENTIFIER TABLE.10043000 C 701
% ONLY USED IN WITH STATEMENT TO TEST 10044001 C 701
MAXCASES =64 #, %MAX LABELS IN A CASE-STATEMENT. 10045000 C 701
MAXLABS =50 #, %MAX NUMBER OF IN PROGRAM LABELS. 10046000 C 701
MAXPARAMS =200 #, %MAX NUMBER OF PARAMETERS IN WHOLE PROGRAM.10047000 C 701
MAXTYPES =250 #, %MAX NUMBER OF DIFFERENT TYPES. 10048000 C 701
MAXCONSTS =100 #, %SIZE OF TABLE FOR CONSTANTS. 10049000 C 701
MAXWITHSYMS= 70 #, %MAX NUMBER OF SYMBOLS USED BY WITH-STATMS.10051000 C 701
MAXSYMS =200 #, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 C 701
LISTLENGTH =100 #, %MAX LENGTH OF VAR AND PARAM LISTS. 10053000 C 701
MAXEXTFILES=10 #, %MAX NUMBER OF EXTERNAL FILES. 10054000 C 701
MAXFILES =10 #, %MAX NUMBER OF FILES DECLARED AT ONE TIME. 10055000 C 701
MAXPNTRS =10 #; %MAX NUMBER OF UNDECLARED POINTERS (FORWD).10056000 C 701
$# PATCH 702 FOR PASCAL.XVI.O CONTAINS 4 CARDS. BOOLEAN ARRAY "ERR" 120 TO 4 C 702
$: TO EXTEND THE REDUCTIONS OF PATCH 701 TO THE BOOLEAN ARRAY "ERR" FOR NOTING C 702
$: THE SYNTAX ERRORS THAT HAVE OCCURRED. THIS PATCH COMPRESSES THE ARRAY FROM C 702
$: 120 WORDS TO 4 WORDS BY USING 32 BITS IN EACH WORD. C 702
$: IN ADDITION, THIS PATCH INSERTS THE ERROR COUNT ON THE LEFT OF THE LINE C 702
$: WHICH REPORTS THE SYNTAX ERRORS. C 702
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 702
$: C 702
ARRAY ERRP[0:3]; % HOLDS 128 BITS % RECORDS ERROR MESSAGES USED. 10156000 C 702
DEFINE ERR[ERR1] = BOOLEAN(0&ERRP[ERR1.[6:2]][0:ERR1.[4:5]:1]) #; 10156100 C 702
ERRP[ERRNUM.[6:2]]:=ERRP[ERRNUM.[6:2]] & 1[ERRNUM.[4:5]:0:1]; 20182000 C 702
REPLACE POINTER(ERRLINE[0])+4 BY NUMERRS FOR 4 DIGITS; 20194900 C 702
$# PATCH 703 FOR PASCAL.XVI.O CONTAINS 6 CARDS. REDUCE THRASHING BY SAVE CORE C 703
$: TO IMPROVE RUN-TIME EFFICIENCY BY REDUCING NON-OVERLAYABLE AREAS. C 703
$: THIS PATCH REDUCES THE SAVE CORE REQUIREMENTS BY DECREASING THE FILE BLOCK C 703
$: SIZES AND ALSO THE NUMBER OF BUFFERS WITHOUT UNDULY RETARDING THE COMPILATION C 703
$: SPEED. THE SIZE OF THE DISK AREAS IS KEPT A MULTIPLE OF THE ORIGINAL BLOCK C 703
$: SIZE WHERE RELEVANT TO AVOID INCOMPATIBILITY PROBLEMS. COMPARABLE REDUCTIONS C 703
$: IN BLOCK SIZES OF THE OBJECT PROGRAM ARE ALSO MADE. C 703
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 703
$: C 703
FILE CARD "SOURCE" (1,10,30); % PASCAL SOURCE CODE INPUT FILE 10035000 C 703
FILE PASCALGOL DISK SERIAL [20:300] (1,10,30,SAVE 0); % ALGOL CODE FILE10037000 C 703
FILE XREFFILE DISK SERIAL [20:3000] (1,3,30); % FOR CROSS REFERENCE 10137000 C 703
IF RECSIZE=1 OR RECSIZE=10 THEN GENINT(30) 80119000 C 703
GEN(",SAVE",6,3); 80122000 C 703
GEN("30);", 4,4); 80123000 C 703
$# PATCH 704 FOR PASCAL.XVI.O HAS 8 CARDS. REDUCE OVERHEADS IN COPYING FILE C 704
$: TO REDUCE THE COMPILER-S OVERHEADS. FIRSTLY, THE ALGOL CODE FILE C 704
$: PASCRUN/DISK IS RENAMED PASCAL/PRELUDE. ORIGINALLY, THE COMPILER COPIED C 704
$: THE PASCAL/PRELUDE FILE INTO THE GENERATED CODE FILE BEFORE STARTING TO C 704
$: TRANSLATE THE PASCAL PROGRAM. THIS PATCH SAVES THE 3 SECONDS OR SO REQUIRED C 704
$: FOR THIS BY SETTING THE "TAPE" OPTION FOR THE ALGOL COMPILER AND LABEL C 704
$: EQUATING THE TAPE FILE TO PASCAL/PRELUDE. THE OVERHEAD TO THE ALGOL COMPILER C 704
$: IS NEGLIGIBLE. THE ADVANTAGE IS EVEN GREATER IF THE PROGRAM FAILS TO C 704
$: COMPILE SYNTAX FREE. THE FILE PASCAL/PRELUDE IS NO LONGER REFERENCED C 704
$: DIRECTLY IN THE PASCAL COMPILER. C 704
$: SEE PATCH 711. THIS NEEDS PATCH 705. C 704
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 704
$: C 704
ERRORS (I5," ERRORS DETECTED ",20("#") /), 10188000 C 704
ALIST ("$ SET LIST "), 10189000 C 704
MERGE ("$ SET TAPE RESET $" / 10190100 C 704
"$ RESET TAPE", T73,"99000000" ), 10190200 C 704
TERMMESS ("**** COMPILATION TERMINATED."); 10192000 C 704
WRITE(PASCALGOL,MERGE); % ALGOL MUST COMPILE PRELUDE FIRST 90022000 C 704
$ SET VOIDT 90023000 C 704
$ POP VOIDT 90032000 C 704
$: "; ALGOL FILE TAPE= PASCAL/PRELUDE SERIAL; ALGOL FILE CARD=", 90119000 C 704
$# PATCH 705 FOR PASCAL.XVI.O CONTAINS 21 CARDS. GENERATE A BETTER ZIP C 705
$: THIS PATCH TIDIES UP THE CODE THAT GENERATES THE ZIP TO PASS CONTROL TO THE C 705
$: COMPATABLE ALGOL COMPILER. C 705
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 705
$: C 705
$ 90013000 C 705
PROGNAME := IF CURLENGTH < 7 90042000 C 705
THEN " "&CURNAME1[41:6×CURLENGTH-1:6×CURLENGTH] 90042010 C 705
ELSE CURNAME2.[5:6]&CURNAME1[41:35:36]; 90042020 C 705
$: ARRAY ZIPARRAY[0:16]; 90092000 C 705
DEFINE PPROGNAME = 13 #, PALGOLNAME = 14 #, 90095000 C 705
PLIBRARY = 15 #, PUSER = 16 #, 90096000 C 705
P(P1) = POINTER(ZIPARRAY[P1])+1 FOR 7 #; 90097000 C 705
$ SET VOIDT 90098000 C 705
$ POP VOIDT 90104000 C 705
$ 90109000 C 705
ZIPARRAY[PPROGNAME]:=PROGNAME; ZIPARRAY[PALGOLNAME]:=ALGOLNAME; 90112000 C 705
ZIPARRAY[PLIBRARY]:= IF SAVEFACTOR>0 THEN "LIBRARY" ELSE 90113000 C 705
IF SAVEFACTOR<0 THEN " SYNTAX" ELSE " & RUN "; 90114000 C 705
ZIPARRAY[PUSER]:=USER; 90115000 C 705
REPLACE POINTER(ZIPARRAY[*]) BY "CC COMPILE ", 90116000 C 705
P(PPROGNAME), "/", P(PUSER), 90117000 C 705
" XALGOL ", P(PLIBRARY), 90118000 C 705
"; ALGOL FILE TAPE= PASCAL/PRELUDE SERIAL; ALGOL FILE CARD=", 90119000 C 705
P(PALGOLNAME), "/", P(PUSER), " SERIAL; END."; 90120000 C 705
$ SET VOIDT 90121000 C 705
$ POP VOIDT 90128000 C 705
$# PATCH 708 FOR PASCAL.XVI.O CONTAINS 25 CARDS. LINE PRINT FILE MAY BE DISK C 708
$: TO ENABLE THE COMPILER-S PRINT FILE TO BE LABEL EQUATED TO DISK AS FOR OTHER C 708
$: B5700 COMPILERS. IN PARTICULAR, THIS PATCH CHANGES THE NAME TO LINE TO BE C 708
$: CONSISTENT WITH ALL THE SYSTEM COMPILERS. THE ABILITY TO LABEL EQUATE FILE C 708
$: "LINE" TO DISK IS NECESSARY IF THE COMPILER IS TO BE USED FROM A TERMINAL. C 708
$: NOTE THAT A BLOCKED FILE SHOULD NOT HAVE VARIABLE LENGTH RECORDS IF IT IS C 708
$: TO BE LABEL EQUATED TO A PRINTER. IF LESS THAN A THE MAX NUMBER OF WORDS PER C 708
$: RECORD IS WRITTEN, THE BALANCE OF THE RECORD REMAINS UNCHANGED FROM WHAT WAS C 708
$: LAST IN THE FILE BUFFER, SO THAT ON BEING PRINTED "GARBAGE", APPEARS AT THE C 708
$: END OF SUCH LINES. C 708
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 708
$: C 708
SAVE FILE OUT LINE DISK SERIAL [20:1200] (1,17,90,SAVE 1); % PRINT FILE 10036000 C 708
% AVOID BLOCKING RECORDS OF VARIABLE LENGTH 10036001 C 708
ARRAY ICARD, ALGOLCARD[0:9], LINES, XLINE[0:16]; 10130000 C 708
% AVOID BLOCKING VARIABLE LENGTH RECORDS 10130001 C 708
ARRAY HEADTEXT, ERRLINE[0:16]; 10133000 C 708
WRITE( LINE[NO],17,XLINE[*]); 20042000 C 708
WRITE( LINE[NO],17,XLINE[*]); 20043000 C 708
WRITE(LINE, 17,LINES[*]); 20045000 C 708
WRITE(LINE, 17,ERRLINE[*]); 20195000 C 708
LINEPNT :=POINTER(LINES[1]); 20315000 C 708
REPLACE LINEPNT-8 BY " " FOR 17 WORDS; 20317000 C 708
REPLACE XLINEPNT-8 BY LINEPNT-8 FOR 17 WORDS; 20318000 C 708
REPLACE POINTER(ERRLINE[*]) BY "**** ", LINEPNT FOR 16 WORDS; 20319000 C 708
REPLACE ALGOLPNT BY LINEPNT FOR 9 WORDS; 20321000 C 708
REPLACE POINTER(HEADTEXT[*]) BY LINEPNT FOR 10 WORDS, "PAGE 1 ", 20326000 C 708
LINEPNT FOR 6 WORDS; 20326100 C 708
WRITE(LINE, 17,XREFLINE[*]); 20549000 C 708
LOCK( LINE, * ); % & CRUNCH 20550000 C 708
WRITE(LINE, 17,XREFLINE[*]); LINECNT:=LINECNT+1; 20560000 C 708
WRITE(LINE, 17,XREFLINE[*]); LINECNT:=LINECNT+1; 20571000 C 708
WRITE(LINE, TERMMESS); 90084000 C 708
WRITE(LINE, NOERRORS); 90111000 C 708
WRITE(LINE, ERRORS,NUMERRS); 91110000 C 708
WRITE(LINE, ERRORMESS1[I]); 91112000 C 708
WRITE(LINE, ERRORMESS2[I-60]); 91114000 C 708
$# PATCH 709 FOR PASCAL.XVI.O CONTAINS 17 CARDS. NO PRINT IF NO LIST & NO ERRORS C 709
$: TO OPEN THE PRINT FILE ONLY IF THE LIST OPTION IS SET OR IF SYNTAX ERRORS C 709
$: ARE DETECTED. IF THE FIRST CARD IN THE PASCAL SOURCE RESETS THE LIST OPTION C 709
$: (*$L- *) AND NO SYNTAX ERRORS ARE DETECTED, THEN THE PRINT FILE WILL NOT BE C 709
$: CREATED (EVEN FOR THE HEADING) AS FOR OTHER COMPILERS. IN PARTICULAR, THIS C 709
$: IMPLEMENTATION DOES NOT REQUIRE A TEST PRIOR TO PRINTING EACH LINE TO C 709
$: DETERMINE WHETHER A HEADING HAS BEEN PRINTED. IT ONLY DOES THIS TEST WHEN C 709
$: THE LIST OPTION IS SET AFTER THE FIRST CARD OR EXPLICITLY THEREAFTER, OR C 709
$: IN THE "PRINTERRORS" ROUTINE. C 709
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 709
$: C 709
IF PAGECNT=1 THEN WRITE(LINE[NO],17,HEADTEXT[*]) ELSE 20029900 C 709
WRITE( LINE[PAGE]); 20030000 C 709
WRITE( LINE[DBL],17,HEADTEXT[*]); 20031000 C 709
IF NOT LISTOPTION THEN 20194000 C 709
BEGIN IF PAGECNT=0 THEN HEADING; PRINTLINE END; 20194100 C 709
REPLACE POINTER(HEADTEXT[*])+45 BY TEXTPNT+5 FOR 2,"/", 20329000 C 709
TEXTPNT+1 FOR 2, "/", TEXTPNT+3 FOR 2; 20330000 C 709
NEWCARD; LISTOPTION:=CHECKOPTION:=TRUE; % DEFAULT 20402100 C 709
INSYMBOL; % ANALYSING FIRST CARD MAY CHANGE DEFAULT LIST OPTN 20402200 C 709
IF LISTOPTION AND PAGECNT=0 THEN HEADING; % ON FIRST PAGE. 20402300 C 709
IF LISTOPTION THEN IF PAGECNT=0 THEN HEADING; % ON FIRST PAGE30282100 C 709
C := " "; % TO INITIALIZE "INSYMBOL" 90034000 C 709
INITIALIZE; % COMPILER TABLES, NEWCARD, INSYMBOL 90035000 C 709
$ 90036000 C 709
IF PAGECNT > 0 % THERE HAS BEEN SOME LISTING 90088000 C 709
THEN BEGIN WRITE( LINE[DBL] ); WRITE( LINE[DBL] ) END; 90089000 C 709
IF PAGECNT>0 THEN % THERE HAS BEEN LISTING 90110000 C 709
$# PATCH 710 FOR PASCAL.XVI.0 CONTAINS 4 CARDS. NO OVERPRINTING WITH BLANK LINE C 710
$: TO PREVENT OVERPRINTING WITH BLANK LINES. IF THE OPTION FOR "BOLDFACE" C 710
$: PRINTING OF RESERVED WORDS IS SET (*$R+ *) THEN EACH LINE IS CONSTRUCTED BY C 710
$: 2 OVERPRINTS FOR THE RESERVED WORDS ONLY, THEN ONE PRINT OF THE FULL TEXT. C 710
$: THE AIM OF THIS PATCH IS TO SKIP THE OVERPRINTING FOR ALL THOSE LINES IN C 710
$: WHICH NO RESERVED WORDS OCCUR. C 710
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 710
$: C 710
DEFINE RESWORDPRESENT = RESWORDOPTION.[1:1] #; 10159100 C 710
IF REAL(RESWORDOPTION) = 3 THEN % RESERVED WORD IS PRESENT 20040000 C 710
RESWORDOPTION := RESWORDOPTION AND TRUE; % RESET RESWORDPRESENT 20057100 C 710
RESWORDOPTION := BOOLEAN(3); % SET RESWORDPRESENT BIT 30179000 C 710
$# PATCH 711 FOR PASCAL.XVI.O CONTAINS 10 CARDS. PASC001/USERCODE UNIQUE NAME C 711
$: TO GENERATE A UNIQUE FILE NAME IN THE DISK DIRECTORY. THIS PATCH CHANGES THE C 711
$: METHOD FOR GENERATING A UNIQUE FILE NAME FOR THE ALGOL SOURCE CODE OUTPUT OF C 711
$: THE COMPILER. FORMERLY, THIS WAS DONE USING THE TIME FUNCTION TO OBTAIN C 711
$: SOME RANDOM DIGITS. THE METHOD USED IN PATCH/MERGE IS ADOPTED HERE, NAMELY C 711
$: STARTING WITH THE PREFIX (MFID) "PASC001", A SEARCH IS PERFORMED TO DETERMINE C 711
$: WHETHER SUCH A FILE NAME IS ALREADY CATALOGUED. IF SO, 1 IS ADDED AND THE C 711
$: SEARCH REPEATED. IN ADDITION, THE FILE IS CREATED WITH A SAVE FACTOR C 711
$: (RETENTION PERIOD) OF ZERO DAYS SO THAT A HALT-LOAD WILL REMOVE THE FILE C 711
$: AUTOMATICALLY. C 711
$: SEE PATCH 704. C 711
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 711
$: C 711
PROCEDURE SEARCHDISKDIRECTORY( F, A ); FILE F; ARRAY A[0]; 20222100 C 711
SEARCH( F, A[*] ); % END OF SEARCHDISKDIRECTORY; 20222200 C 711
20222300 C 711
CHARPNT := POINTER(CH[0])+7; CH[0] := " "; 20322000 C 711
CH[0] := "PASC000"; CHARPNT := POINTER(CH[0])+5; 90016000 C 711
PASCALGOL.FID := USER := TIME(-1); 90017000 C 711
DO BEGIN C:=C+1; REPLACE CHARPNT BY C FOR 3 DIGITS; 90018000 C 711
PASCALGOL.MFID := ALGOLNAME := CH[0]; 90019000 C 711
SEARCHDISKDIRECTORY( PASCALGOL, LINES[*] ); 90020000 C 711
END UNTIL LINES[0]=-1; % FILE NOT ON DISK 90021000 C 711
$# PATCH 712 FOR PASCAL.XVI.O CONTAINS 2 CARDS. MARK PROCEDURE LEVELS IN MARGIN C 712
$: PATCH TO MARK THE START AND END OF PROCEDURES AND FUNCTIONS BY ANNOTATING THE C 712
$: MARGIN WITH THE SYMBOLS "+P" & "-P" FOLLOWED BY THE LEVEL NUMBER. C 712
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 712
$: C 712
MARGIN("+P",CURLEVEL); % MARK PROCEDURE LEVEL 80420100 C 712
MARGIN("-P",CURLEVEL); % MARK END OF PROCEDURE 80702100 C 712
$# PATCH 713 FOR PASCAL.XVI.O. CONTAINS 14 CARDS.CORRECTS ERROR MESSAGE ETC. C 713
$: CORRECTS THE DOUBLE "NO ERRORS" MESSAGE AND THE OUTPUT OF HEADINGS C 713
$: WHEN L1 IS SET AFTER L-. C 713
$: ALSO CORRECTS THE SCANNING PROBLEM WHEN COMPILER OPTIONS ARE INCORRECT. C 713
$: DAVID A COOPER, HERIOT-WATT UNIVERISTY ...... AUGUST 1978 C 713
$: C 713
ERROR102MESS(//"102 *** WARNING ONLY, ILLEGAL COMPILER OPTION.")10188750 C 713
, % 10188751 C 713
IF ERRNUM=100 OR ERRNUM=102 20181600 C 713
THEN NUMERRS := NUMERRS - 1; %*ERROR NUMBER 102 IS ONLY AN ILLEGAL 20181610 C 713
% * DOLLAR OPTION WARNING & 20181620 C 713
% *ERROR NUMBER 100 ALONE SHOULD NOT 20181650 C 713
ELSE LISTOPTION := C="+" ELSE 30265000 C 713
END 30280800 C 713
ELSE ERROR(102); 30280810 C 713
IF ERR(102) THEN 90090710 C 713
WRITE(LINE,ERROR102MESS); 90090720 C 713
$ 90110000 C 713
$ 90111000 C 713
("102 ***WARNING ONLY, ILLEGAL DOLLAR OPTION."), 91106900 C 713
$# PATCH 800 FOR PASCAL.XVI.O.CONTAINS 10 CARDS. C 800
$: TO REMOVE CONFLICTS BETWEEN HERIOT-WATT & NATAL EXISTING PATCHES. C 800
$: C 800
MAXSYMS = 800#, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 C 800
MAXPNTRS = 25#; %MAX NUMBER OF UNDECLARED POINTERS(FORWD). 10056000 C 800
DEFINE ERR(ERR1) = BOOLEAN(0&ERRP[(ERR1).[6:2]][0:((ERR1).[4:5]):1])#; 10156100 C 800
INTEGER EXPRLEVEL, EXPINVARCNT; % 40018000 C 800
INTEGER INDEX, CTYPE, NUMFORWARDS,TX, I; % 80403000 C 800
INTEGER PROGNAMELENGTH; % 90013900 C 800
IF ERR(100) % 90090600 C 800
"; ALGOL FILE TAPE=PASCRUN/DISK SERIAL; ALGOL FILE CARD=", 90119000 C 800
P(PALGOLNAME),"/",P(PUSER)," SERIAL;", % 90120000 C 800
" XALGOL STACK = 2048; END."; % 90120500 C 800
$# PATCH 998 FOR PASCAL.XVI.O CONTAINS 10 CARDS. INSERT PAGE THROWS AT DESIRED C 998
$: PATCH TO INSERT PAGE THROWS AT DESIRED POINTS IN THE SOURCE TO PRODUCE A C 998
$: NICELY LAID OUT LISTING. C 998
$: C 998
$ PAGE 19000000 C 998
$ PAGE 20290000 C 998
$ PAGE 29000000 C 998
$ PAGE 39000000 C 998
$ PAGE 49000000 C 998
$ PAGE 59000000 C 998
$ PAGE 69000000 C 998
$ PAGE 79000000 C 998
$ PAGE 89000000 C 998
$ PAGE 90070999 C 998
$: NILS A OTTE, UNIVERSITY OF NATAL, DURBAN. AUG - NOV 1977. C 998
$: C 998
$# PATCH 999 FOR PASCAL.XVI.O. CONTAINS 1 CARDS. VERISON NUMBER. C 999
$: C 999
DEFINE EDITION = "4.4"#;%AUGUST 1978...DAVID A COOPER... 10028000 C 999
CONFLICTS
********** **********************************************************************************
FILE CARD "SOURCE" (1,10,30); % PASCAL SOURCE CODE INPUT FILE 10035000 C 703 CONFLICTED WITH:
FILE CARD "SOURCE" (1,10,30); % SOURCE CODE FILE 10035000 C 002 DISCARDED
SAVE FILE OUT LINE DISK SERIAL [20:1200] (1,17,90,SAVE 1); % PRINT FILE 10036000 C 708 CONFLICTED WITH:
FILE LINES 1 (1,17); % PRINT FILE 10036000 C 002 DISCARDED
FILE PASCALGOL DISK SERIAL [20:300] (1,10,30,SAVE 0); % ALGOL CODE FILE10037000 C 703 CONFLICTED WITH:
FILE PASCALGOL DISK SERIAL [20:600] (1,10,30,SAVE 0); % CODE FILE 10037000 C 002 DISCARDED
MAXSYMS = 800#, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 C 800 CONFLICTED WITH:
MAXSYMS =200 #, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 C 701 DISCARDED
MAXPNTRS = 25#; %MAX NUMBER OF UNDECLARED POINTERS(FORWD). 10056000 C 800 CONFLICTED WITH:
MAXPNTRS =10 #; %MAX NUMBER OF UNDECLARED POINTERS (FORWD).10056000 C 701 DISCARDED
FILE XREFFILE DISK SERIAL [20:3000] (1,3,30); % FOR CROSS REFERENCE 10137000 C 703 CONFLICTED WITH:
FILE XREFFILE DISK SERIAL [20:3000] (1,3,30); 10137000 C 002 DISCARDED
DEFINE ERR(ERR1) = BOOLEAN(0&ERRP[(ERR1).[6:2]][0:((ERR1).[4:5]):1])#; 10156100 C 800 CONFLICTED WITH:
DEFINE ERR[ERR1] = BOOLEAN(0&ERRP[ERR1.[6:2]][0:ERR1.[4:5]:1]) #; 10156100 C 702 DISCARDED
IF ERRNUM=100 OR ERRNUM=102 20181600 C 713 CONFLICTED WITH:
IF ERRNUM=100 20181600 C 002 DISCARDED
% *ERROR NUMBER 100 ALONE SHOULD NOT 20181650 C 713 CONFLICTED WITH:
THEN NUMERRS:=NUMERRS-1;% * ERROR NUMBER 100 ALONE SHOULD NOT 20181650 C 002 DISCARDED
END 30280800 C 713 CONFLICTED WITH:
END; 30280800 C 002 DISCARDED
INTEGER EXPRLEVEL, EXPINVARCNT; % 40018000 C 800 CONFLICTED WITH:
INTEGER EXPRLEVEL; 40018000 C 700 DISCARDED
INTEGER EXPRLEVEL,TX,EXPINVARCNT;% 40018000 C 002 DISCARDED
$ 40105100 C 615 CONFLICTED WITH:
IF INSIDEPARENS AND TYPETAB1[CURTYPE].STRUCT > 0 AND 40105100 C 518 DISCARDED
$ 40105200 C 615 CONFLICTED WITH:
TYPETAB1[CURTYPE].FORM < FILES THEN 40105200 C 518 DISCARDED
$ 40105300 C 615 CONFLICTED WITH:
PUTID("H",1000×THISLEVEL+THISINDEX,5) 40105300 C 518 DISCARDED
$ 40105400 C 615 CONFLICTED WITH:
ELSE 40105400 C 518 DISCARDED
SPLIT(FIRSTSYM,1); 40650000 C 603 CONFLICTED WITH:
SPLIT(STARTSYM,1); % 40650000 C 601 DISCARDED
IF CURSY = PLUS THEN SYMTAB[FIRSTSYM] := "SUNIO(" ELSE 40651000 C 603 CONFLICTED WITH:
IF CURSY=PLUS THEN SYMTAB[STARTSYM] := "SUNIO(" ELSE % 40651000 C 601 DISCARDED
IF CURSY = MINUS THEN SYMTAB[FIRSTSYM] := "SDIFF(" ELSE 40652000 C 603 CONFLICTED WITH:
IF CURSY=MINUS THEN SYMTAB[STARTSYM] := "SDIFF(" ELSE % 40652000 C 601 DISCARDED
ERROR(64); 40653000 C 603 CONFLICTED WITH:
ERROR(64); % 40653000 C 601 DISCARDED
INTEGER INDEX, CTYPE, NUMFORWARDS,TX, I; % 80403000 C 800 CONFLICTED WITH:
INTEGER INDEX, CTYPE, NUMFORWARDS, T3, TX, I; 80403000 C 503 DISCARDED
INTEGER INDEX, CTYPE, NUMFORWARDS,TX, I; % 80403000 C 800 CONFLICTED WITH:
INTEGER INDEX, CTYPE, NUMFORWARDS, T, TX, I; 80403000 C 002 DISCARDED
IF FOUND AND (THISID.IDCLASS=PROC OR THISID.IDCLASS=FUNC) THEN 80548000 C 600 CONFLICTED WITH:
IF FOUND AND THISID.IDCLASS≥FUNC THEN 80548000 C 504 DISCARDED
NAMETAB3[CURLEVEL,THISINDEX].FORWARDDEF:=0; 80553000 C 504 CONFLICTED WITH:
NAMETAB3[CURLEVEL,THISINDEX].FORWARDDEF := 0; 80553000 C 002 DISCARDED
IF ERR(100) % 90090600 C 800 CONFLICTED WITH:
IF ERR[100]% 90090600 C 002 DISCARDED
$ 90110000 C 713 CONFLICTED WITH:
IF PAGECNT>0 THEN % THERE HAS BEEN LISTING 90110000 C 709 DISCARDED
$ 90111000 C 713 CONFLICTED WITH:
WRITE(LINE, NOERRORS); 90111000 C 708 DISCARDED
$VOIDT 90111000 C 002 DISCARDED
"; ALGOL FILE TAPE=PASCRUN/DISK SERIAL; ALGOL FILE CARD=", 90119000 C 800 CONFLICTED WITH:
"; ALGOL FILE TAPE= PASCAL/PRELUDE SERIAL; ALGOL FILE CARD=", 90119000 C 705 DISCARDED
P(PALGOLNAME),"/",P(PUSER)," SERIAL;", % 90120000 C 800 CONFLICTED WITH:
P(PALGOLNAME), "/", P(PUSER), " SERIAL; END."; 90120000 C 705 DISCARDED
" XALGOL STACK = 2048; END."; % 90120500 C 800 CONFLICTED WITH:
" XALGOL STACK = 2048; STACK = 1024; END."; % 90120500 C 519 DISCARDED
GENERATED OUTPUT
********** **********************************************************************************
? COMPILE PASCAL/NEW XALGOL LIBRARY 00000001
? XALGOL STACK=800 00000002
? XALGOL FILE TAPE=SYMBOL/PASCAL SERIAL 00000003
? XALGOL FILE NEWTAPE=SYMNEW/PASCAL SERIAL 00000004
? XALGOL FILE LINE=LINE PRINT 00000005
? DATA CARD 000000≥
$ TAPE LIST SINGLE SEQXEQ NEW TAPE
DEFINE EDITION = "4.4"#;%AUGUST 1978...DAVID A COOPER... %999-10028000 C 999
INTEGER NUMERRS, % @R+25: NUMBER OF ERRORS IN PROGRAM. %500-10029000 C 500
SAVEFACTOR, % @R+26: SAVEFACTOR FOR CODE FILE. %500-10030000 C 500
PAGECNT, % @R+27: NUMBER OF PAGES PRINTED. %500-10033800 C 500
CARDCNT; % @R+30: NUMBER OF CARDS READ. %500-10034000 C 500
FILE CARD "SOURCE" (1,10,30); % PASCAL SOURCE CODE INPUT FILE %703-10035000 C 703
SAVE FILE OUT LINE DISK SERIAL [20:1200] (1,17,90,SAVE 1); % PRINT FILE 10036000 C 708
% AVOID BLOCKING RECORDS OF VARIABLE LENGTH%708-10036001 C 708
FILE PASCALGOL DISK SERIAL [20:300] (1,10,30,SAVE 0); % ALGOL CODE FILE10037000 C 703
DEFINE LINESPERPAGE = 60 #, %502-10038000 C 502
DEFINE MAXTABLES = 30 #, %MAX NUMBER OF LEVELS IN IDENTIFIER TABLE.10042000 C 701
MAXNAMES =307 #, %MAX NAMES IN EACH ROW OF IDENTIFIER TABLE.10043000 C 701
% ONLY USED IN WITH STATEMENT TO TEST %701-10044001 C 701
MAXCASES =64 #, %MAX LABELS IN A CASE-STATEMENT. %701-10045000 C 701
MAXLABS =50 #, %MAX NUMBER OF IN PROGRAM LABELS. %701-10046000 C 701
MAXPARAMS =200 #, %MAX NUMBER OF PARAMETERS IN WHOLE PROGRAM.10047000 C 701
MAXTYPES =250 #, %MAX NUMBER OF DIFFERENT TYPES. %701-10048000 C 701
MAXCONSTS =100 #, %SIZE OF TABLE FOR CONSTANTS. %701-10049000 C 701
MAXWITHSYMS= 70 #, %MAX NUMBER OF SYMBOLS USED BY WITH-STATMS.10051000 C 701
MAXSYMS = 800#, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 C 800
LISTLENGTH =100 #, %MAX LENGTH OF VAR AND PARAM LISTS. %701-10053000 C 701
MAXEXTFILES=10 #, %MAX NUMBER OF EXTERNAL FILES. %701-10054000 C 701
MAXFILES =10 #, %MAX NUMBER OF FILES DECLARED AT ONE TIME. 10055000 C 701
MAXPNTRS = 25#; %MAX NUMBER OF UNDECLARED POINTERS(FORWD). 10056000 C 800
ARRAY PARAMTAB, FORWPARAM1, FORWPARAM2[0:MAXPARAMS]; %002-10109000 C 002
ARRAY ICARD, ALGOLCARD[0:9], LINES, XLINE[0:16]; %708-10130000 C 708
% AVOID BLOCKING VARIABLE LENGTH RECORDS 10130001 C 708
ARRAY HEADTEXT, ERRLINE[0:16]; %708-10133000 C 708
INTEGER LINECNT, ERRINX; % PAGECNT @ PRT+27 %500-10134000 C 500
FILE XREFFILE DISK SERIAL [20:3000] (1,3,30); % FOR CROSS REFERENCE 10137000 C 703
ALPHA ARRAY XBUFF[0:2]; %002-10138500 C 002
BOOLEAN XINB; %002-10138550 C 002
ALPHA ARRAY SYMTAB[0:MAXSYMS]; % USED BY "EXPRESSION". %517-10144000 C 517
INTEGER ARRAY SYMKIND[0:62]; %USED IN ERROR RECOVERY. %002-10149000 C 002
ARRAY ERRP[0:3]; % HOLDS 128 BITS % RECORDS ERROR MESSAGES USED. 10156000 C 702
DEFINE ERR(ERR1) = BOOLEAN(0&ERRP[(ERR1).[6:2]][0:((ERR1).[4:5]):1])#; 10156100 C 800
DEFINE %518-10156200 C 518
PERMSUB = 0 #, MAXTOTALSUBSCRS = 100#, %518-10156300 C 518
ARRNAM = 1 #; %518-10156400 C 518
ARRAY ARRSUBPERMTAB[0:1,0:MAXTOTALSUBSCRS]; %518-10156500 C 518
INTEGER PASSPERMTAB, MAXPERMTAB, REMEMBERPOSN; %518-10156600 C 518
DEFINE RESWORDPRESENT = RESWORDOPTION.[1:1] #; %710-10159100 C 710
$ %700-10167000 C 700
$ %700-10168000 C 700
$ %700-10169000 C 700
ERRORS (I5," ERRORS DETECTED ",20("#") /), %704-10188000 C 704
ERROR100MESS (//"100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION10188500 C 002
. THE VALUE 07 IS SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT TH10188600 C 002
E COMPILATION ERRORS COUNT."//),% %002-10188700 C 002
ERROR102MESS(//"102 *** WARNING ONLY, ILLEGAL COMPILER OPTION.")10188750 C 713
, % %713-10188751 C 713
ALIST ("$ SET LIST "), %704-10189000 C 704
MERGE ("$ SET TAPE RESET $" / %704-10190100 C 704
"$ RESET TAPE", T73,"99000000" ), %704-10190200 C 704
TERMMESS ("**** COMPILATION TERMINATED."); %704-10192000 C 704
PACKEDSY=61#, ASSERTSY=62#; %002-10211000 C 002
$ PAGE %998-19000000 C 998
VALUE NAME1,NAME2,TABLE,DECL; %700-20016000 C 700
REAL NAME1,NAME2; %700-20017000 C 700
INTEGER TABLE; BOOLEAN DECL; %700-20018000 C 700
FORWARD; %700-20019000 C 700
PROCEDURE PRINTERRORS; FORWARD; %700-20020000 C 700
PROCEDURE HEADING; %*** PRINTS A HEADING AT START OF NEW PAGE.20026000 C 700
BEGIN DEFINE NEWSEGMENT = HERE #; %700-20027000 C 700
IF PAGECNT=1 THEN WRITE(LINE[NO],17,HEADTEXT[*]) ELSE %709-20029900 C 709
WRITE( LINE[PAGE]); %709-20030000 C 709
WRITE( LINE[DBL],17,HEADTEXT[*]); %709-20031000 C 709
END OF HEADING; %700-20033000 C 700
PROCEDURE PRINTLINE; %*** PRINTS A PASCAL SOURCE CODE LINE %700-20036000 C 700
BEGIN DEFINE NEWSEGMENT = HERE #; %700-20037000 C 700
IF REAL(RESWORDOPTION) = 3 THEN % RESERVED WORD IS PRESENT %710-20040000 C 710
WRITE( LINE[NO],17,XLINE[*]); %708-20042000 C 708
WRITE( LINE[NO],17,XLINE[*]); %708-20043000 C 708
WRITE(LINE, 17,LINES[*]); %708-20045000 C 708
END OF PRINTLINE; %700-20047000 C 700
PROCEDURE NEWCARD; %*** READS A NEW PASCAL SOURCE CODE CARD 20050000 C 700
BEGIN DEFINE RESULT = ICARD[*], ETC #; %700-20051000 C 700
REPLACE XLINEPNT BY " " FOR 16 WORDS; %700-20056000 C 700
REPLACE LINEPNT BY CARDPNT FOR 10 WORDS, XLINEPNT FOR 6 WORDS;%700-20057000 C 700
RESWORDOPTION := RESWORDOPTION AND TRUE; % RESET RESWORDPRESENT 20057100 C 710
END OF NEWCARD; %700-20061000 C 700
DEFINE GEN(GEN1,GEN2,GEN3) = GENI(TRUE,GEN1,GEN3,GEN2) #, %700-20063100 C 700
GENID(GENID1,GENID2,GENID3)= GENI(FALSE,GENID1,GENID2,GENID3) #; %700-20063200 C 700
%700-20063300 C 700
PROCEDURE GENI(GENT, TXT, NUM, N ); %700-20063400 C 700
VALUE GENT, TXT, NUM, N; %700-20063500 C 700
BOOLEAN GENT; ALPHA TXT; INTEGER NUM, N; %700-20063600 C 700
BEGIN DEFINE START = NUM #, NDIG = N #; %700-20063700 C 700
%700-20063800 C 700
IF GENT THEN %*** GENERATE A TEXT "TXT", CONSISTING OF 20064000 C 700
TEXT[0] := TXT; %700-20067000 C 700
END %700-20070000 C 700
ELSE %*** GENERATE AN ALGOL IDENTIFIER. %700-20073000 C 700
CH[0] := TXT; %700-20076000 C 700
END END GENI; %700-20079000 C 700
PROCEDURE GENINT( N ); %700-20082000 C 700
VALUE N; INTEGER N; %700-20083000 C 700
BEGIN DEFINE RESULT = ALGOL CODE #; %700-20084000 C 700
INTEGER NABS, NSIZE; %700-20085000 C 700
END OF GENINT; %700-20097000 C 700
PROCEDURE WRITEALGOL; %*** WRITES A COMPLETED ALGOL CARD TO%700-20145000 C 700
DEFINE NEWSEGMENT = HERE #; %700-20146100 C 700
IF DUMPOPTION THEN BEGIN IF (LINECNT:=LINECNT+1)≥LINESPERPAGE %502-20149000 C 502
THEN HEADING; WRITE(LINE,10,ALGOLCARD[*]) END; %502-20149100 C 502
DEFINE NEWSEGMENT = HERE #; %700-20168100 C 700
DEFINE NEWSEGMENT = HERE #; %700-20180100 C 700
IF ERRNUM<0 THEN ERRNUM:=ABS(ERRNUM) ELSE %511-20180900 C 511
% %002-20181500 C 002
% %002-20181550 C 002
IF ERRNUM=100 OR ERRNUM=102 %713-20181600 C 713
THEN NUMERRS := NUMERRS - 1; %*ERROR NUMBER 102 IS ONLY AN ILLEGAL 20181610 C 713
% * DOLLAR OPTION WARNING & %713-20181620 C 713
% *ERROR NUMBER 100 ALONE SHOULD NOT %713-20181650 C 713
% * PREVENT THE XALGOL COMPILATION BEING 20181700 C 002
% * ZIPPED AS THE VALUE 7 IS SUBSTITUTED 20181750 C 002
% * FOR A BAD SAVE CONSTANT IN AN "S"%002-20181800 C 002
% * OPTION. %002-20181850 C 002
% %002-20181900 C 002
% %002-20181950 C 002
ERRP[ERRNUM.[6:2]]:=ERRP[ERRNUM.[6:2]] & 1[ERRNUM.[4:5]:0:1]; %702-20182000 C 702
DEFINE NEWSEGMENT = HERE #; %700-20193100 C 700
IF NOT LISTOPTION THEN %709-20194000 C 709
BEGIN IF PAGECNT=0 THEN HEADING; PRINTLINE END; %709-20194100 C 709
REPLACE POINTER(ERRLINE[0])+4 BY NUMERRS FOR 4 DIGITS; %702-20194900 C 702
WRITE(LINE, 17,ERRLINE[*]); %708-20195000 C 708
DEFINE HASH(HASH1) = ENTIER((HASH1) MOD MAXNAMES) #; %505-20202000 C 505
ALPHA THISID, CURNAME1, CURNAME2; % USED IN SCANNER %700-20205000 C 700
PROCEDURE SEARCHTAB( TAB ); %*** SEARCH NAME TABLE "TAB" FOR THE %700-20208000 C 700
VALUE TAB; INTEGER TAB; %*** IDENTIFIER JUST READ. %700-20208100 C 700
BEGIN ALPHA TNAME; INTEGER WRAPAROUND; %505-20209000 C 505
WRAPAROUND:=THISINDEX:=HASH(CURNAME1); %505-20210000 C 505
IF THISINDEX=WRAPAROUND THEN TNAME:=0; % TABLE IS FULL %505-20216100 C 505
END OF SEARCHTAB; %700-20221000 C 700
PROCEDURE SEARCHDISKDIRECTORY( F, A ); FILE F; ARRAY A[0]; %711-20222100 C 711
SEARCH( F, A[*] ); % END OF SEARCHDISKDIRECTORY; %711-20222200 C 711
%711-20222300 C 711
PROCEDURE SEARCH; %*** SEARCH ALL TABLES CURRENTLY IN USE. 20223000 C 700
BEGIN DEFINE RESULT = THISID #; %700-20224000 C 700
END OF SEARCH; %700-20233000 C 700
PROCEDURE NEWNAME( NAME1,NAME2, TAB ); %700-20236000 C 700
VALUE NAME1, NAME2, TAB; %700-20236100 C 700
ALPHA NAME1, NAME2; INTEGER TAB; %700-20236200 C 700
ALPHA TNAME; INTEGER WRAPAROUND; %505-20237100 C 505
WRAPAROUND:=THISINDEX:=HASH(NAME1); %505-20238000 C 505
IF THISINDEX=WRAPAROUND THEN % TABLE AT THIS LEVEL IS FULL 20244100 C 505
BEGIN ERROR(40); NAME1:=TNAME; NAME2:=NAMETAB2[TAB,THISINDEX]20244200 C 505
END; %505-20244300 C 505
END OF NEWNAME; %700-20250000 C 700
$ PAGE %998-20290000 C 998
7(INITIAL),MIDDLE,INITIAL; %002-20308000 C 002
LINEPNT :=POINTER(LINES[1]); %708-20315000 C 708
REPLACE LINEPNT-8 BY " " FOR 17 WORDS; %708-20317000 C 708
REPLACE XLINEPNT-8 BY LINEPNT-8 FOR 17 WORDS; %708-20318000 C 708
REPLACE POINTER(ERRLINE[*]) BY "**** ", LINEPNT FOR 16 WORDS; 20319000 C 708
REPLACE ALGOLPNT BY LINEPNT FOR 9 WORDS; %708-20321000 C 708
CHARPNT := POINTER(CH[0])+7; CH[0] := " "; %711-20322000 C 711
REPLACE POINTER(HEADTEXT[*]) BY LINEPNT FOR 10 WORDS, "PAGE 1 ", 20326000 C 708
LINEPNT FOR 6 WORDS; %708-20326100 C 708
REPLACE POINTER(HEADTEXT[*])+45 BY TEXTPNT+5 FOR 2,"/", %709-20329000 C 709
TEXTPNT+1 FOR 2, "/", TEXTPNT+3 FOR 2; %709-20330000 C 709
NILTYPE := 6; %*** TYPE OF "NIL" *** %602-20363000 C 602
T1.FORM := POINTERS; TYPETAB1[6] := T1; %602-20364000 C 602
EMPTYSET := 7; % %602-20364500 C 602
T1.FORM := SET; TYPETAB1[7] := T1; %602-20365000 C 602
NUMTYPES := 7; % %602-20365500 C 602
NEWNAME("50PRT25",0,0); %*** "PRT25" *** %501-20369100 C 501
T3:=INTTYPE; T3.IDCLASS:=VAR; % GLOBAL INTEGER VARIABLE %501-20369200 C 501
NAMETAB3[0,THISINDEX] := T3; %501-20369300 C 501
"400READ", "6READLN", "50RESET", "6UNPACK", "50WRITE", %002-20373000 C 002
"6QQJZXL" DO %002-20373500 C 002
NEWNAME("7CPUTIM","E",0); NAMETAB3[0,THISINDEX]:=T3; %514-20390000 C 514
NEWCARD; LISTOPTION:=CHECKOPTION:=TRUE; % DEFAULT %709-20402100 C 709
INSYMBOL; % ANALYSING FIRST CARD MAY CHANGE DEFAULT LIST OPTN 20402200 C 709
IF LISTOPTION AND PAGECNT=0 THEN HEADING; % ON FIRST PAGE. %709-20402300 C 709
DEFINE NEWSEGMENT = HERE #; %700-20515100 C 700
IF DECL THEN AX := -AX; %002-20520000 C 002
DEFINE NEWSEGMENT = HERE #; %700-20533100 C 700
ABS(A[2]) LEQ ABS(B[2]); %002-20539000 C 002
% %002-20541100 C 002
% %002-20541150 C 002
% %002-20541200 C 002
BOOLEAN PROCEDURE XREFINPUT(A); %002-20541250 C 002
ARRAY A[0]; %002-20541300 C 002
BEGIN %002-20541350 C 002
LABEL EOF; %002-20541400 C 002
INTEGER I; %002-20541450 C 002
% %002-20541500 C 002
READ(XREFFILE,3,XBUFF[*])[EOF]; %002-20541550 C 002
FOR I:=0,1,2 DO %002-20541600 C 002
A[I] := XBUFF[I]; %002-20541650 C 002
IF FALSE THEN EOF: BEGIN %002-20541700 C 002
CLOSE(XREFFILE,RELEASE); %002-20541750 C 002
XINB := TRUE; %002-20541800 C 002
END; %002-20541850 C 002
XREFINPUT := XINB; %002-20541900 C 002
% %002-20541950 C 002
END OF XREFINPUT; %002-20541960 C 002
DEFINE NEWSEGMENT = HERE #; %700-20546100 C 700
WRITE(LINE, 17,XREFLINE[*]); %708-20549000 C 708
LOCK( LINE, * ); % & CRUNCH %708-20550000 C 708
WRITE(LINE, 17,XREFLINE[*]); LINECNT:=LINECNT+1; %708-20560000 C 708
A2 := -A2; %002-20570000 C 002
WRITE(LINE, 17,XREFLINE[*]); LINECNT:=LINECNT+1; %708-20571000 C 708
PROCEDURE CHECKTYPES( LEFTTYPE, RIGHTTYPE ); %700-20802000 C 700
VALUE LEFTTYPE, RIGHTTYPE; INTEGER LEFTTYPE, RIGHTTYPE; %700-20803000 C 700
BEGIN %700-20804000 C 700
REAL TT1, TT2; INTEGER F1, F2, LT, RT; %700-20805000 C 700
IF(F1 NEQ SET OR RT NEQ EMPTYSET) % %600-20813000 C 600
AND % %600-20813050 C 600
(F2 NEQ SET OR LT NEQ EMPTYSET) THEN % %600-20813100 C 600
IF(F1 NEQ POINTERS OR RT NEQ NILTYPE) % %600-20814000 C 600
AND % %600-20814050 C 600
(F2 NEQ POINTERS OR LT NEQ NILTYPE) THEN % %600-20814100 C 600
END OF CHECKTYPES; %700-20838000 C 700
BOOLEAN LPARFOUND,SAVEXREFOPT; %002-20842000 C 002
PROCEDURE FILEPARAM( DEFAULTFILE ); %*** CHECKS THE FIRST PARAMETER 20844000 C 700
VALUE DEFAULTFILE; INTEGER DEFAULTFILE;%*** TO SEE IF IT IS A FILE.%700-20844100 C 700
BEGIN DEFINE RESULTS = FILENAME & LPARFOUND #; %700-20845000 C 700
SAVEXREFOPT := XREFOPTION; XREFOPTION := FALSE; %002-20847500 C 002
IF SAVEXREFOPT THEN NEWXREF(CURNAME1,CURNAME2,THISLEVEL, 20861500 C 002
FALSE); %002-20861550 C 002
XREFOPTION := SAVEXREFOPT; %002-20868500 C 002
END OF FILEPARAM; %700-20869000 C 700
REAL CURVAL; INTEGER CURLENGTH; %700-20872000 C 700
%700-20873000 C 700
PROCEDURE CONSTANT( CVAL, CTYPE ); %700-20874000 C 700
REAL CVAL; INTEGER CTYPE; %700-20875000 C 700
BEGIN %700-20876000 C 700
INTEGER TFORM; BOOLEAN SIGNED, NEGATIVE; %700-20876100 C 700
END OF CONSTANT; %700-20921000 C 700
$ PAGE %998-29000000 C 998
% ASSERT 62 ASSERTSY INITIAL %002-30075500 C 002
$ %700-30082000 C 700
ALPHA C, CX; %( CURNAME1 & CURNAME2 MOVED TO 20205000 ) %700-30083000 C 700
INTEGER LASTCHARPOS; %( CURVAL, CURLENGTH MOVED TO 20872000 ) %700-30084000 C 700
PROCEDURE INSYMBOL; %*** IDENTIFIES THE NEXT SYMBOL ******%700-30087000 C 700
BEGIN %700-30087100 C 700
%700-30087200 C 700
PROCEDURE NEXTCHAR; %*** GETS THE NEXT CHARACTER. %700-30088000 C 700
END OF NEXTCHAR; %700-30093000 C 700
$ SET VOIDT 30095000 C 700
$ POP VOIDT 30098000 C 700
DEFINE T1 = EXP #; % USED AT 30178000 %700-30099100 C 700
IF CURNAME1="6ASSERT" THEN ASSERTSY ELSE %002-30165500 C 002
BEGIN T1 := CARDLENGTH-CHARCNT-CURLENGTH-1; %506-30178000 C 506
RESWORDOPTION := BOOLEAN(3); % SET RESWORDPRESENT BIT 30179000 C 710
FOR CURLENGTH+REAL(CHARCNT=0); %506-30181000 C 506
BEGIN DEFINE NEWSEGMENT = HERE #; %700-30261100 C 700
IF CX="L" THEN IF C=1 THEN %516-30264000 C 516
IF LISTOPTION THEN HEADING ELSE %516-30264500 C 516
ELSE LISTOPTION := C="+" ELSE %713-30265000 C 713
END% %002-30280000 C 002
% %002-30280025 C 002
% %002-30280050 C 002
% THE FOLLOWING LINES DECODE ANY OCCURRENCE OF THE "S" OPTION AND 30280075 C 002
% SETS THE GLOBAL INTEGER VARIABLE "SAVEFACTOR" WHICH CONTROLS THE %002-30280100 C 002
% TYPE OF COMPILATION INITIATED BY THE ZIP. THERE ARE THREE LEGAL FORMS 30280125 C 002
% OF THE "S" OPTION AS FOLLOWS.- %002-30280150 C 002
% %002-30280175 C 002
% "S-" WILL GIVE NO ZIP IE. PASCAL SYNTAX CHECK ONLY %002-30280200 C 002
% "S+" WILL GIVE A ZIP FOR COMPILE AND GO %002-30280225 C 002
% "S??" WILL GIVE A ZIP FOR COMPILE TO LIBRARY %002-30280250 C 002
% WHERE ?? IS THE TWO DIGIT DECIMAL SAVE %002-30280275 C 002
% CONSTANT GIVEN THE OBJECT CODE FILE %002-30280300 C 002
% NB. IF THE SAVE CONSTANT IS TO BE %002-30280325 C 002
% LESS THAN 10 THE FIRST DIGIT %002-30280350 C 002
% MUST BE INCLUDED IE. A "0". %002-30280375 C 002
% %002-30280400 C 002
% %002-30280425 C 002
ELSE %002-30280450 C 002
IF CX="S" THEN %002-30280475 C 002
BEGIN %002-30280500 C 002
IF C="-" THEN SAVEFACTOR:=-1 ELSE %002-30280525 C 002
IF C="+" THEN SAVEFACTOR:= 0 ELSE %002-30280550 C 002
IF C LEQ 9 THEN %002-30280575 C 002
BEGIN %002-30280600 C 002
SAVEFACTOR := 10 × C; NEXTCHAR; %002-30280625 C 002
SAVEFACTOR := SAVEFACTOR + C; %002-30280650 C 002
IF C GTR 9 THEN ERROR(100); %002-30280675 C 002
END %002-30280700 C 002
ELSE %002-30280720 C 002
BEGIN %002-30280735 C 002
ERROR(100); %002-30280750 C 002
SAVEFACTOR := 7; %002-30280765 C 002
END; %002-30280780 C 002
END %713-30280800 C 713
ELSE ERROR(102); %713-30280810 C 713
% %002-30280825 C 002
% %002-30280850 C 002
% %002-30280875 C 002
IF LISTOPTION THEN IF PAGECNT=0 THEN HEADING; % ON FIRST PAGE30282100 C 709
END NEWSEGEMENT; %700-30282200 C 700
$ PAGE %998-39000000 C 998
$ %700-40016000 C 700
$ %700-40017000 C 700
INTEGER EXPRLEVEL, EXPINVARCNT; % %800-40018000 C 800
BEGIN ERROR(63); % %600-40023000 C 600
DEFINE PUTSYM(S) = PUTTEXT( (S)&1[41:5:6] ) #; %700-40029000 C 700
$ SET VOIDT 40029900 C 700
$ POP VOIDT 40033000 C 700
DEFINE PUTDUMMY = PUTTEXT("3000000") #; %700-40041000 C 700
$ SET VOIDT 40042000 C 700
$ POP VOIDT 40044000 C 700
% %601-40052050 C 601
% %601-40052055 C 601
PROCEDURE SPLIT(SPLITINX,WIDTH); % %601-40052100 C 601
VALUE SPLITINX, WIDTH; % %601-40052150 C 601
INTEGER SPLITINX, WIDTH ; % %601-40052200 C 601
BEGIN % %601-40052250 C 601
INTEGER I; % %601-40052300 C 601
% %601-40052350 C 601
IF NUMSYMS+WIDTH LEQ MAXSYMS THEN % %601-40052400 C 601
BEGIN % %601-40052450 C 601
FOR I:=NUMSYMS STEP -1 UNTIL SPLITINX DO % %601-40052500 C 601
SYMTAB[I+WIDTH] := SYMTAB[I]; % %601-40052550 C 601
FOR I:=1 STEP 1 UNTIL WIDTH DO % %601-40052600 C 601
SYMTAB[SPLITINX+I-1] := "3000000"; % %601-40052650 C 601
NUMSYMS := NUMSYMS + WIDTH; % %601-40052700 C 601
END % %601-40052750 C 601
ELSE %601-40052800 C 601
BEGIN % %601-40052830 C 601
ERROR(63); % %601-40052860 C 601
NUMSYMS := 1; % %601-40052890 C 601
END; % %601-40052900 C 601
END OF SPLIT; % %601-40052950 C 601
% %601-40052960 C 601
% %601-40052965 C 601
PROCEDURE WRITEEXPR; %*** WRITE GENERATED ALGOL EXPRESSION %700-40053000 C 700
REAL SX; INTEGER T1, TX; %700-40054100 C 700
END OF WRITEEXPR; %700-40066000 C 700
PROCEDURE CHECKEXPR( LLIM, ULIM ); %*** WRITE CODE TO CHECK VALUE 40069000 C 700
VALUE LLIM, ULIM; INTEGER LLIM, ULIM; %700-40069100 C 700
BEGIN DEFINE CHECK = VALUE #; %700-40070000 C 700
END OF CHECKEXPR; %700-40077000 C 700
$ %518-40080000 C 518
BOOLEAN SIMPLEVARIABLE,INSIDEBRACKETS,INSIDEPARENS; %518-40080100 C 518
INTEGER T1, T5; % USED ONCE EACH %700-40086100 C 700
BOOLEAN INBRACKET,INRECORD,SIMPLEVAR; %002-40087000 C 002
T1:=T.FIRSTWITHSYM; T5:=T.LASTWITHSYM; %700-40094000 C 700
FOR T1:=T1 STEP 1 UNTIL T5 DO PUTTEXT(WITHTAB[T1]); %700-40095000 C 700
SIMPLEVAR := FALSE; %002-40099000 C 002
$ %IF THISLEVEL>1 AND THISLEVEL<CURLEVEL THEN ERROR5; %511-40103000 C 511
CURTYPE := THISID.TYPE; SIMPLEVAR := TRUE; %002-40104000 C 002
$ %518-40105000 C 518
$ %615-40105100 C 615
$ %615-40105200 C 615
$ %615-40105300 C 615
$ %615-40105400 C 615
PUTID("V",1000×THISLEVEL+THISINDEX,5); %518-40105500 C 518
SIMPLEVAR := FALSE; %002-40109000 C 002
EXPINVARCNT:=EXPINVARCNT+1;% %002-40120500 C 002
EXPRLEVEL := EXPRLEVEL+1; % DO NOT "WRITEEXPR" YET %507-40120900 C 507
EXPRLEVEL := EXPRLEVEL-1; %507-40121100 C 507
SIMPLEVARIABLE := FALSE; % RECURSION ON "VARIABLE" %507-40121200 C 507
EXPINVARCNT:=EXPINVARCNT-1;% %002-40121500 C 002
IF NUMSYMS+6 ≤ MAXSYMS THEN %513-40175000 C 513
NUMSYMS := NUMSYMS+2; %513-40180400 C 513
IF NUMPOINTERS > 0 % POINTER VIA POINTER %513-40180500 C 513
THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY %513-40180600 C 513
"00-1)DIV00 1022,00 T MOD00 1022]"; %513-40180700 C 513
NUMSYMS := NUMSYMS+4; %513-40180800 C 513
END %513-40180900 C 513
ELSE NUMPOINTERS := 1; %513-40181000 C 513
END; % %601-40188005 C 601
IF TYPETAB1[CURTYPE].FORM=SET THEN % *** SET VARIABLES %601-40188010 C 601
BEGIN % --- --- --------- %601-40188025 C 601
INTEGER THISSYML, I; % %601-40188050 C 601
% %601-40188075 C 601
SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SLOAD("; % %601-40188100 C 601
IF SIMPLEVAR THEN % %601-40188125 C 601
BEGIN % %601-40188150 C 601
PUTSYM(","); % %601-40188175 C 601
PUTID("W",1000×THISLEVEL+THISINDEX,5); % %601-40188200 C 601
END % %601-40188225 C 601
ELSE % %601-40188250 C 601
IF INBRACKET AND NOT INRECORD THEN % %601-40188275 C 601
BEGIN % %601-40188300 C 601
PUTSYM(","); THISSYML := NUMSYMS; % %601-40188325 C 601
PUTCONST(0); PUTSYM(" "); PUTSYM(","); % %601-40188350 C 601
FOR I:=STARTSYM+1 STEP 1 UNTIL THISSYML DO % %601-40188375 C 601
PUTTEXT(SYMTAB[I]); %601-40188400 C 601
PUTTEXT(" 1] "); % %601-40188425 C 601
END % %601-40188450 C 601
ELSE % %601-40188475 C 601
BEGIN % %601-40188500 C 601
THISSYML := NUMSYMS; % %601-40188525 C 601
IF INBRACKET THEN PUTSYM("]"); % %601-40188550 C 601
FOR I:=1 STEP 1 UNTIL NUMPOINTERS DO % %601-40188575 C 601
BEGIN % %601-40188600 C 601
PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); % %601-40188625 C 601
PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); % %601-40188650 C 601
END; % %601-40188675 C 601
PUTSYM(","); % %601-40188700 C 601
FOR I:=STARTSYM+1 STEP 1 UNTIL THISSYML DO % %601-40188725 C 601
PUTTEXT(SYMTAB[I]); % %601-40188775 C 601
PUTTEXT(" +1 "); % %601-40188800 C 601
IF INBRACKET THEN PUTSYM("]"); % %601-40188825 C 601
FOR I:=1 STEP 1 UNTIL NUMPOINTERS DO % %601-40188850 C 601
BEGIN % %601-40188875 C 601
PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); % %601-40188900 C 601
PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); % %601-40188915 C 601
END; % %601-40188930 C 601
NUMPOINTERS := 0; % %601-40188945 C 601
END; %601-40188960 C 601
PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); % %601-40188975 C 601
END OF SET VARIABLES; % %601-40188990 C 601
% INBRACKET := FALSE; %513-40191100 C 513
BEGIN NUMPOINTERS := NUMPOINTERS-1; %513-40193000 C 513
IF NUMSYMS+4 ≤ MAXSYMS %513-40194000 C 513
THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY %513-40194100 C 513
"00-1)DIV00 1022,00 T MOD00 1022]"; %513-40194200 C 513
NUMSYMS := NUMSYMS+4; %513-40194300 C 513
END %513-40194400 C 513
ELSE ERROR(63); % EXPRESSION IS TOO LONG FOR SYMTAB[*] 40195000 C 513
$ %601-40198000 C 601
IF INSIDEPARENS AND SIMPLEVAR AND TYPETAB1[CURTYPE].STRUCT > 0 AND 40198500 C 615
TYPETAB1[CURTYPE].FORM < FILES THEN SYMTAB[STARTSYM].[35:6] := 40198600 C 615
"H"; %615-40198700 C 615
SIMPLEVARIABLE := SIMPLEVAR; %002-40199500 C 002
INSIDEPARENS := TRUE; %518-40258100 C 518
INSIDEPARENS := FALSE; %518-40259100 C 518
IF TYPETAB1[THISID.TYPE].FORM=SET THEN %601-40274200 C 601
BEGIN % %601-40274220 C 601
GEN(",",1,7); % %601-40274240 C 601
GENID("W",1000×THISLEVEL+THISINDEX,5); % %601-40274260 C 601
END; % %601-40274280 C 601
BOOLEAN FIRST, SPLITTED; % %601-40296000 C 601
DEFINE T1 = T #; % USED AT 40558000 %700-40298000 C 700
$ SET VOIDT 40299000 C 700
$ POP VOIDT 40309000 C 700
%700-40331000 C 700
PROCEDURE PARAMETER; %*** CHECK THAT THE FUNCTION HAS 1 PARAM.40332000 C 700
BEGIN %700-40333000 C 700
INSYMBOL; %700-40334000 C 700
IF CURSY=LPAR %700-40335000 C 700
THEN BEGIN %700-40336000 C 700
PUTSYM("("); INSYMBOL; EXPRESSION; %700-40337000 C 700
IF TYPETAB1[CURTYPE].FORM=NUMERIC THEN CURTYPE:=INTTYPE; 40338000 C 700
IF CURSY≠RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; %700-40339000 C 700
PUTSYM(")"); IF CURSY=RPAR THEN INSYMBOL; %700-40340000 C 700
END ELSE ERROR(3); % OR ERROR(58) %700-40341000 C 700
END OF PARAMETER; %700-40342000 C 700
%700-40350000 C 700
IF CURNAME1="7CPUTIM" AND CURNAME2="E" THEN % "CPUTIME" 40452000 C 514
PUTTEXT("SETBS("); PUTTEXT(" 3,2,"); PUTCONST(CARDCNT); % 40529000 C 601
PUTSYM(")"); % %601-40529300 C 601
CURTYPE := EMPTYSET; CURMODE := NUMBER; % %601-40529600 C 601
STARTSYM := NUMSYMS + 1; % %601-40533500 C 601
PUTTEXT(" SETB("); % %601-40536000 C 601
PUTSYM(","); SYMTAB[STARTSYM] := "SETBS("; % %601-40544000 C 601
IF SPLITTED THEN PUTSYM(")"); % %601-40551500 C 601
IF CURSY=COMMA THEN % %601-40552000 C 601
BEGIN % %601-40552200 C 601
SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SUNIO("; % %601-40552400 C 601
PUTSYM(","); % %601-40552600 C 601
SPLITTED := TRUE; % %601-40552800 C 601
END; % %601-40552850 C 601
NEWTYPE; T1 := SET; T1.SIZE := 2; T1.STRUCT := 0; % %601-40558000 C 601
CURMODE := NUMBER; % %601-40561000 C 601
IF CURTYPE=BOOLTYPE THEN % %601-40587000 C 601
IF CURSY NEQ ANDSY THEN ERROR(64); %601-40593000 C 601
END ELSE % %601-40593100 C 601
IF F=SET THEN % %601-40593200 C 601
BEGIN % %601-40593300 C 601
IF CURSY=ASTERISK THEN % %601-40593400 C 601
BEGIN % %601-40593500 C 601
SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SINTS("; % %601-40593600 C 601
PUTSYM(","); % %601-40593700 C 601
END ELSE ERROR(64); % %601-40593800 C 601
MODE := NUMBER; % %601-40593900 C 601
IF F=SET THEN PUTSYM(")"); % %601-40608500 C 601
INTEGER STARTSYM,FIRSTSYM,MODE,TYPE1,F; %603-40618000 C 603
PUTDUMMY; STARTSYM := FIRSTSYM := NUMSYMS; %603-40621000 C 603
SPLIT(FIRSTSYM,1); %603-40650000 C 603
IF CURSY = PLUS THEN SYMTAB[FIRSTSYM] := "SUNIO(" ELSE %603-40651000 C 603
IF CURSY = MINUS THEN SYMTAB[FIRSTSYM] := "SDIFF(" ELSE %603-40652000 C 603
ERROR(64); %603-40653000 C 603
PUTSYM(","); MODE := NUMBER; % %601-40654000 C 601
$ %601-40655000 C 601
IF F=SET THEN PUTSYM(")"); % %601-40668500 C 601
$ %601-40688000 C 601
IF CURSY=EQLSY THEN SYMTAB[STARTSYM] := "SEQUA(" % %601-40713000 C 601
ELSE %601-40713150 C 601
IF CURSY=NEQSY THEN % %601-40713300 C 601
BEGIN % %601-40714000 C 601
SPLIT(STARTSYM,1); SYMTAB[STARTSYM]:= " NOT "; % %601-40714150 C 601
SYMTAB[STARTSYM+1] := "SEQUA("; % %601-40714300 C 601
IF EXPINVARCNT=0 THEN WRITEEXPR; % %002-40751000 C 002
$ PAGE %998-49000000 C 998
CURTYPE := 0; % ALFATYPE OR REALTYPE %509-50050000 C 509
$ %600-50059000 C 600
GEN("PREAD(",6,2); WRITEEXPR; GEN(",",1,7); % %600-50079000 C 600
$ %600-50080000 C 600
$ %600-50081000 C 600
GENID("F",FILEID,5); GEN(",",1,7); % %600-50082000 C 600
IF F=NUMERIC THEN % %600-50086010 C 600
BEGIN % %600-50086050 C 600
GEN(",",1,7); GENINT(TYPETAB2[CURTYPE]); % %600-50086100 C 600
GEN(",",1,7); GENINT(TYPETAB3[CURTYPE]); % %600-50086150 C 600
END ELSE GEN(",0,0,",4,4); % %600-50086200 C 600
$ SET VOIDT %600-50088000 C 600
$ POP VOIDT %600-50093000 C 600
LABEL EFH; %002-50201500 C 002
BEGIN ; % NULL %*** 4) REWRITE %001-50203000 C 001
GEN("PUT",3,5); %*** 5) PAGE %001-50204000 C 001
%*** 6) OPEN & CLOSE (INPUT) FOR 50204500 C 002
% CUMULATIVE FREQUENCY COUNT50204550 C 002
GEN("PPAGE",5,3); % %001-50208000 C 001
BEGIN %002-50208100 C 002
GEN("QQJZXL",6,2); %002-50208200 C 002
INSYMBOL; %002-50208300 C 002
GO TO EFH; % %002-50208400 C 002
END; %002-50208500 C 002
EFH: %002-50219500 C 002
INTEGER IT; REAL T; %503-50225000 C 503
$ %518-50243000 C 518
GENID("H",1000×THISLEVEL+THISINDEX,5); %518-50243100 C 518
$ %IF THISLEVEL>1 AND THISLEVEL≠CURLEVEL THEN ERROR5; %511-50244000 C 511
INTEGER IT; REAL T; %503-50285000 C 503
$ %IF THISLEVEL>1 AND THISLEVEL≠CURLEVEL THEN ERROR5; %511-50306000 C 511
$ %518-50307000 C 518
GENID("H",1000×THISLEVEL+THISINDEX,5); %518-50307100 C 518
$ PAGE %998-59000000 C 998
%512-60020000 C 512
PROCEDURE WRITESEXPR; %*** FIX STRUCTURE FOR ASSIGNMENT %512-60021000 C 512
BEGIN % USED ONLY IN ASSIGNMENT OF STRUCTURES 60022000 C 512
IF INSIDEBRACKETS THEN IF SYMTAB[NUMSYMS] = "100000," %512-60023000 C 512
THEN SYMTAB[NUMSYMS] := ", 0 ] " ELSE PUTSYM("]"); %512-60024000 C 512
WHILE NUMPOINTERS>0 DO %512-60025000 C 512
BEGIN NUMPOINTERS := NUMPOINTERS-1; %512-60026000 C 512
IF NUMSYMS+4 ≥ MAXSYMS THEN WRITEEXPR; %512-60027000 C 512
REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY %512-60028000 C 512
"00-1)DIV00 1022,00 T MOD00 1022]"; %512-60029000 C 512
NUMSYMS := NUMSYMS+4; %512-60030000 C 512
END; % OF WHILE %512-60031000 C 512
WRITEEXPR; GEN( ",", 1,7 ); %512-60032000 C 512
END WRITESEXPR; %512-60033000 C 512
%512-60034000 C 512
%ERROR(95); % STRUCTURED ASSIGNMENT NOT IMPLEMENTED. %512-60063000 C 512
EXPRLEVEL := EXPRLEVEL+1; %507-60063900 C 507
GEN("ASSIGN(",7,1); WRITESEXPR; %512-60064000 C 512
EXPRESSION; WRITESEXPR; %512-60065000 C 512
EXPRLEVEL := EXPRLEVEL-1; %507-60065100 C 507
GENINT(TYPETAB1[LEFTTYPE].SIZE); GEN(")",1,7); %512-60066000 C 512
IF TYPETAB1[LEFTTYPE].SIZE≠TYPETAB1[CURTYPE].SIZE %512-60067000 C 512
THEN ERROR(95); %512-60068000 C 512
IF TYPETAB1[LEFTTYPE].FORM=SET THEN % %601-60080100 C 601
BEGIN % %601-60080200 C 601
SYMTAB[1] := "SSTOR("; NUMSYMS := NUMSYMS - 3; % %601-60080300 C 601
EXPRESSION; % %601-60080400 C 601
PUTSYM(")"); CHECKTYPES(LEFTTYPE,CURTYPE); % %601-60080500 C 601
WRITEEXPR; % %601-60080600 C 601
END ELSE % %601-60080700 C 601
END; %512-60087000 C 512
CHECKTYPES( LEFTTYPE, CURTYPE ); %512-60088000 C 512
IF THISLEVEL≠CURLEVEL-1 OR THISINDEX≠CURFUNC THEN ERROR(5);%511-60091000 C 511
IF THISLEVEL>1 AND THISLEVEL<CURLEVEL THEN ERROR(-5); %511-60276000 C 511
EXPRLEVEL := 1; %002-60346500 C 002
IF THISID.IDCLASS=VAR OR %002-60354000 C 002
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN %%002-60354500 C 002
EXPRLEVEL := 0; %002-60383500 C 002
PROCEDURE ASSERTSTAT; %002-60391100 C 002
BEGIN %002-60391200 C 002
GEN("IF NOT(",7,1); %002-60391400 C 002
INSYMBOL; BOOLEXPR; %002-60391500 C 002
GEN(") THEN",7,2); GEN("RUNERR(",7,1); GEN("7,",2,6); %002-60391600 C 002
GENINT(CARDCNT); GEN(")",1,7); %002-60391700 C 002
END OF ASSERTSTAT; %002-60391800 C 002
$ %700-60396000 C 700
BEGIN LABEL LABFOUND; %700-60399000 C 700
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) OR %700-60423000 C 700
THISID.IDCLASS=FUNC %700-60423200 C 700
THEN ASSIGNMENT ELSE %700-60424000 C 700
IF CURNAME1="6QQJZXL" THEN FILEHANDLING(6) ELSE %002-60443500 C 002
IF CURSY=ASSERTSY THEN ASSERTSTAT ELSE %002-60457500 C 002
$ PAGE %998-69000000 C 998
$ SET VOIDT 70013000 C 700
$ POP VOIDT 70016000 C 700
VALUE RECTAB,FIRSTADDR; %700-70018000 C 700
INTEGER RECTAB,FIRSTADDR,LASTADDR; %700-70019000 C 700
$ SET VOIDT 70022000 C 700
$ POP VOIDT 70034000 C 700
%700-70035000 C 700
PROCEDURE TYPEDECL( TTYPE, TSIZE ); %***** TYPE DECLARATION ***** 70036000 C 700
INTEGER TTYPE, TSIZE; %**************************** 70037000 C 700
BEGIN %700-70038000 C 700
INTEGER RECINX, ARRSTRUCT, TX, SX, T, N; REAL T1, T2, T3; %700-70039000 C 700
BOOLEAN FIRST, PACKED; %700-70040000 C 700
%700-70041000 C 700
$ %700-70042000 C 700
END TYPERR; %700-70048000 C 700
PROCEDURE SUBRANGE; %*** SUBRANGE DECLARATION *** 70050000 C 700
BEGIN %**************************** 70051000 C 700
REAL VALX1, VALX2, T1; %700-70052000 C 700
INTEGER TYPEX1, TYPEX2; %700-70053000 C 700
%700-70054000 C 700
CONSTANT(VALX1,TYPEX1); %700-70055000 C 700
IF TYPETAB1[TYPEX1].FORM>CHAR THEN ERROR(11); %700-70056000 C 700
IF CURSY≠DOUBLEDOT THEN ERROR(53); %700-70057000 C 700
INSYMBOL; %700-70058000 C 700
CONSTANT(VALX2,TYPEX2); %700-70059000 C 700
IF TYPEX1>0 AND TYPEX2>0 THEN %700-70060000 C 700
IF TYPEX1≠TYPEX2 THEN ERROR(11) ELSE %700-70061000 C 700
IF VALX1>VALX2 THEN ERROR(54); %700-70062000 C 700
IF (T1:=TYPETAB1[TYPEX1].FORM) = SYMBOLIC THEN T1:=SUBTYPE; %700-70063000 C 700
NEWTYPE; TTYPE:=TYPEINDEX; %700-70064000 C 700
T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; T1.MAINTYPE:=TYPEX1; %700-70065000 C 700
TYPETAB1[TYPEINDEX]:=T1; %700-70066000 C 700
TYPETAB2[TYPEINDEX]:=VALX1; TYPETAB3[TYPEINDEX]:=VALX2; %700-70067000 C 700
END OF SUBRANGE; %700-70068000 C 700
%700-70069000 C 700
DEFINE DEC = POINTER #; %700-70117100 C 700
DEFINE DEC = ARRAY #; %700-70143100 C 700
DEFINE DEC = FILE #; %700-70180100 C 700
DEFINE DEC = SET #; %700-70200100 C 700
IF TYPETAB2[TX] LSS 0 OR TYPETAB3[TX] GTR 93 THEN ERROR(51); 70210000 C 601
T1.SIZE := TSIZE := 2; TYPETAB1[TYPEINDEX] := T1; % %601-70214000 C 601
DEFINE DEC = RECORD #; %700-70220100 C 700
INTEGER CASETYPE,ADDR,MAXADDR,INDEX,CTYPE,TX,SX, T3,LLIM,ULIM,I; 70244000 C 503
REAL T1, CVAL; %503-70246000 C 503
LABEL CASEPART, EXIT; %700-70247000 C 700
BEGIN DEFINE DEC = VARIANT #; %700-70285100 C 700
LABEL CASETYPEID; %700-70285200 C 700
END; %700-70349100 C 700
$ PAGE %998-79000000 C 998
INTEGER LEVEL1000, TYP, NAM, NAMTAB, I, J, RECSIZE; %503-80020000 C 503
ALPHA T1, FNAME; %503-80022000 C 503
IF NAMTAB.IDCLASS=FUNC THEN GEN("FUNCTN",7,2) % %600-80037000 C 600
ELSE GEN("PROCEDU",8,1); % %600-80038000 C 600
IF T1.FORM=SET THEN % %601-80046200 C 601
BEGIN % %601-80046400 C 601
GEN(",",1,7); GENID("W",LEVEL1000+NAM,5); % %601-80046600 C 601
END; % %601-80046800 C 601
$SET VOIDT %518-80052000 C 518
$POP VOIDT %518-80064000 C 518
DEFINE %518-80064005 C 518
LOWSUBS = 0 #, %518-80064010 C 518
HISUBS = 1 #, %518-80064015 C 518
NEXTSUBS= 2 #, %518-80064020 C 518
MAXNOOFSUBSCRIPTS = 20 #, %518-80064025 C 518
STOPPERSUBTAB = 21 #; %518-80064030 C 518
ARRAY ARRSUBSCRIPTRANGE[0:2,0:MAXNOOFSUBSCRIPTS]; %518-80064035 C 518
INTEGER FIRSTRANGE, NEXTFREEENTRY, PASSSUBRANGE, PREVPASS, %518-80064040 C 518
MP, POSNO, SUBDIFF; %518-80064045 C 518
IF ARRAYVAR THEN GEN(";",1,7) ELSE ARRAYVAR := TRUE; %518-80064050 C 518
IF NOT PARAM THEN %518-80064055 C 518
BEGIN %518-80064060 C 518
GEN("DEFINE",7,2); %518-80064065 C 518
GENID("V",LEVEL1000+NAM,5); %518-80064070 C 518
GEN("[",1,7); %518-80064075 C 518
END; %518-80064080 C 518
FIRSTRANGE := STOPPERSUBTAB; NEXTFREEENTRY := 0; %518-80064085 C 518
POSNO := 1; %518-80064090 C 518
MP := 10; FIRSTDIM := TRUE; %518-80064095 C 518
DO %518-80064100 C 518
BEGIN %518-80064105 C 518
IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE %518-80064110 C 518
BEGIN %518-80064111 C 518
IF NOT PARAM THEN GEN(",",1,7); %518-80064112 C 518
END; %518-80064113 C 518
IF NOT PARAM THEN GENID("V",(LEVEL1000+NAM)×MP+POSNO,IF MP=10 80064115 C 518
THEN 6 ELSE 7); POSNO := POSNO + 1; %518-80064120 C 518
IF POSNO = MP THEN MP := MP×10; %518-80064125 C 518
IF NEXTFREEENTRY = STOPPERSUBTAB THEN %518-80064130 C 518
BEGIN %518-80064135 C 518
ERROR(0); %518-80064140 C 518
END %518-80064145 C 518
ELSE %518-80064150 C 518
BEGIN %518-80064155 C 518
ARRSUBSCRIPTRANGE[LOWSUBS,NEXTFREEENTRY]:=TYPETAB2[TYP]; 80064160 C 518
ARRSUBSCRIPTRANGE[HISUBS,NEXTFREEENTRY] := TYPETAB3[TYP]; 80064165 C 518
END; %518-80064170 C 518
SUBDIFF := TYPETAB3[TYP] - TYPETAB2[TYP]; %518-80064175 C 518
IF FIRSTRANGE = STOPPERSUBTAB THEN %518-80064180 C 518
BEGIN %518-80064185 C 518
FIRSTRANGE := NEXTFREEENTRY; %518-80064190 C 518
NEXTFREEENTRY := NEXTFREEENTRY + 1; %518-80064195 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,FIRSTRANGE] := STOPPERSUBTAB; 80064200 C 518
END %518-80064205 C 518
ELSE %518-80064210 C 518
BEGIN %518-80064215 C 518
PASSSUBRANGE := FIRSTRANGE; %518-80064220 C 518
PREVPASS := STOPPERSUBTAB; NEXTFREEENTRY:=NEXTFREEENTRY+1;80064225 C 518
WHILE(SUBDIFF ≥ ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE] %518-80064230 C 518
-ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE]) AND 80064235 C 518
(ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] ≠ %518-80064240 C 518
STOPPERSUBTAB) DO %518-80064245 C 518
BEGIN %518-80064250 C 518
PREVPASS := PASSSUBRANGE; %518-80064255 C 518
PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS, %518-8006426 C 518
PASSSUBRANGE]; 80064265 C 518
END; %518-80064270 C 518
IF PREVPASS = STOPPERSUBTAB THEN %518-80064275 C 518
BEGIN %518-80064280 C 518
IF SUBDIFF ≥ ARRSUBSCRIPTRANGE[HISUBS, %518-80064285 C 518
PASSSUBRANGE] - %518-80064290 C 518
ARRSUBSCRIPTRANGE[LOWSUBS, %518-80064295 C 518
PASSSUBRANGE] THEN%518-80064300 C 518
BEGIN %518-80064305 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] := %518-80064310 C 518
NEXTFREEENTRY - 1; %518-80064315 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] :=%518-80064320 C 518
STOPPERSUBTAB; %518-80064325 C 518
END %518-80064330 C 518
ELSE %518-80064335 C 518
BEGIN %518-80064340 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] :=%518-80064345 C 518
FIRSTRANGE; %518-80064350 C 518
FIRSTRANGE := NEXTFREEENTRY-1; %518-80064355 C 518
END %518-80064360 C 518
END %518-80064365 C 518
ELSE %518-80064370 C 518
BEGIN %518-80064375 C 518
IF SUBDIFF ≥ ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE] - 80064380 C 518
ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE] 80064385 C 518
THEN %518-80064390 C 518
BEGIN %518-80064395 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] := %518-80064400 C 518
NEXTFREEENTRY - 1; %518-80064405 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] := %518-80064410 C 518
STOPPERSUBTAB; %518-80064415 C 518
END %518-80064420 C 518
ELSE %518-80064425 C 518
BEGIN %518-80064430 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,PREVPASS] := %518-80064435 C 518
NEXTFREEENTRY -1; %518-80064440 C 518
ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] := %518-80064445 C 518
PASSSUBRANGE; %518-80064450 C 518
END %518-80064455 C 518
END %518-80064460 C 518
END;TYP:=IF T1.FORM = ARRAYS THEN T1.ARRTYPE ELSE REALTYPE; 80064465 C 518
T1 := TYPETAB1[TYP]; %518-80064470 C 518
END UNTIL T1.STRUCT = 0 ; %518-80064475 C 518
IF NOT PARAM THEN %518-80064480 C 518
BEGIN %518-80064485 C 518
GEN("]=",2,6); %518-80064490 C 518
GENID("H",LEVEL1000+NAM,5); %518-80064495 C 518
GEN("[",1,7); %518-80064500 C 518
PASSSUBRANGE:= FIRSTRANGE; FIRSTDIM := TRUE; %518-80064505 C 518
WHILE PASSSUBRANGE ≠ STOPPERSUBTAB DO %518-80064510 C 518
BEGIN %518-80064515 C 518
IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE GEN(",",1,7); 80064520 C 518
GENID("V",(LEVEL1000+NAM)×(IF PASSSUBRANGE>9 THEN 100 ELSE 8006453 C 518
10)+PASSSUBRANGE+1,IF PASSSUBRANGE>9 THEN 7 ELSE 6); 80064535 C 518
PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE]; 80064540 C 518
END; %518-80064545 C 518
GEN("]#;",3,5); %518-80064550 C 518
END; %518-80064555 C 518
PASSSUBRANGE := FIRSTRANGE; %518-80064560 C 518
FIRSTDIM := TRUE; GEN("ARRAY",6,3); GENID("H",LEVEL1000+NAM,5); 80064565 C 518
GEN("[",1,7); %518-80064570 C 518
WHILE PASSSUBRANGE ≠ STOPPERSUBTAB DO %518-80064575 C 518
BEGIN %518-80064580 C 518
IF MAXPERMTAB LEQ MAXTOTALSUBSCRS AND PARAM THEN %518-80064585 C 518
BEGIN %518-80064590 C 518
ARRSUBPERMTAB[ARRNAM,MAXPERMTAB] := %518-80064595 C 518
IF FIRSTDIM THEN NAM ELSE -1; %518-80064600 C 518
ARRSUBPERMTAB[PERMSUB,MAXPERMTAB] := PASSSUBRANGE; %518-80064605 C 518
MAXPERMTAB := MAXPERMTAB + 1; %518-80064610 C 518
END %518-80064615 C 518
ELSE %518-80064620 C 518
BEGIN %518-80064625 C 518
IF MAXPERMTAB > MAXTOTALSUBSCRS THEN ERROR(0); %518-80064630 C 518
END; %518-80064640 C 518
IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE GEN(",",1,7); %518-80064645 C 518
GENINT(ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE]); %518-80064650 C 518
IF NOT PARAM THEN %518-80064655 C 518
BEGIN %518-80064660 C 518
GEN(":",1,7); %518-80064665 C 518
GENINT(ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE]); %518-80064670 C 518
END; %518-80064675 C 518
PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE]; %518-80064680 C 518
END; %518-80064685 C 518
IF T1.FORM=SET THEN % %601-80064700 C 601
BEGIN % %601-80064750 C 601
GEN(",0",2,6); % %601-80064800 C 601
IF NOT PARAM THEN GEN(":1",2,6); % %601-80064850 C 601
END; % %601-80064900 C 601
GEN("]",1,7); %518-80064950 C 518
DEFINE DEC = FILE #; %700-80066100 C 700
IF ALGOLCNT LSS 14 THEN WRITEALGOL; %517-80103000 C 517
GEN(""/",2,6); %700-80107000 C 700
IF RECSIZE=1 OR RECSIZE=10 THEN GENINT(30) %703-80119000 C 703
GEN(",SAVE",6,3); %703-80122000 C 703
GEN("30);", 4,4); %703-80123000 C 703
IF PARAM THEN GEN("0",1,7) ELSE BEGIN %002-80129000 C 002
GEN("0:",2,6); %002-80129100 C 002
GENINT(RECSIZE-1); %002-80129200 C 002
END %002-80129300 C 002
INTEGER FIRSTPARAM, CURKIND, P1, PX, I, T3; REAL T; %503-80148000 C 503
FORWPARAM1[NUMPARAMS] := CURNAME1; %002-80177500 C 002
FORWPARAM2[NUMPARAMS] := CURNAME2; %002-80177600 C 002
INTEGER INDEX, CTYPE, NUMFORWARDS,TX, I; % %800-80403000 C 800
ALPHA T3; %002-80403500 C 002
REAL T, CVAL; %503-80404000 C 503
MARGIN("+P",CURLEVEL); % MARK PROCEDURE LEVEL %712-80420100 C 712
$ %518-80421000 C 518
IF CURLEVEL > 1 THEN %518-80421010 C 518
BEGIN %518-80421020 C 518
INTEGER NAMOFTHING,DIFF; %518-80421030 C 518
BOOLEAN FIRSTTIME; %518-80421040 C 518
GEN("BEGIN",6,3); %518-80421050 C 518
IF MAXPERMTAB > 0 THEN %518-80421060 C 518
BEGIN %518-80421070 C 518
PASSPERMTAB := 0; %518-80421080 C 518
DO %518-80421090 C 518
BEGIN %518-80421100 C 518
REMEMBERPOSN := PASSPERMTAB; %518-80421110 C 518
GEN("DEFINE",7,2); %518-80421120 C 518
NAMOFTHING := ARRSUBPERMTAB[ARRNAM,PASSPERMTAB]; %518-80421130 C 518
GENID("V",1000×CURLEVEL+NAMOFTHING,5); %518-80421140 C 518
GEN("[",1,7); %518-80421150 C 518
FIRSTTIME := TRUE; %518-80421160 C 518
DO %518-80421170 C 518
BEGIN %518-80421180 C 518
IF FIRSTTIME THEN FIRSTTIME := FALSE ELSE GEN(",",180421190 C 518
,7);80421200 C 518
DIFF := PASSPERMTAB-REMEMBERPOSN+1; %518-80421210 C 518
GENID("V",(1000+CURLEVEL+NAMOFTHING)×(IF DIFF>9 THEN 100 ELSE 80421220 C 518
10)+DIFF,(IF DIFF > 9 THEN 7 ELSE 6)); %518-80421230 C 518
PASSPERMTAB := PASSPERMTAB + 1; END %518-80421270 C 518
UNTIL PASSPERMTAB = MAXPERMTAB OR %518-80421280 C 518
ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ≠ -1; %518-80421290 C 518
GEN("]",1,7); %518-80421300 C 518
GEN("=",1,7); %518-80421310 C 518
GENID("H",1000×CURLEVEL+NAMOFTHING,5); %518-80421320 C 518
GEN("[",1,7); %518-80421340 C 518
PASSPERMTAB := REMEMBERPOSN; FIRSTTIME := TRUE; %518-80421350 C 518
DO %518-80421360 C 518
BEGIN %518-80421370 C 518
IF FIRSTTIME THEN FIRSTTIME := FALSE ELSE GEN(",", 80421380 C 518
1,7);80421390 C 518
DIFF := ARRSUBPERMTAB[PERMSUB,PASSPERMTAB]+1; %518-80421400 C 518
GENID("V",(1000×CURLEVEL+NAMOFTHING)×(IF DIFF>9 THEN80421410 C 518
100 ELSE 10)+DIFF,(IF DIFF>9 THEN 7 ELSE 6)); 80421420 C 518
PASSPERMTAB := PASSPERMTAB +1; %518-80421430 C 518
END %518-80421440 C 518
UNTIL PASSPERMTAB = MAXPERMTAB OR %518-80421450 C 518
ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ≠ -1; %518-80421460 C 518
GEN("]#;",3,5); %518-80421470 C 518
END %518-80421480 C 518
UNTIL PASSPERMTAB = MAXPERMTAB; %518-80421490 C 518
MAXPERMTAB := 0; %518-80421500 C 518
END %518-80421510 C 518
END; %518-80421520 C 518
DEFINE DEC = LABEL #; %700-80424100 C 700
LABEL LL1; % %002-80447010 C 002
DEFINE DEC = CONST #; %700-80447100 C 700
DEFINE DEC = TYPE #; %700-80475100 C 700
LABEL LL2; % %002-80496010 C 002
DEFINE DEC = VAR #; %700-80496100 C 700
IF CURSY=FUNCSY OR CURSY=PROCSY % %700-80540900 C 700
THEN BEGIN DEFINE DEC = CODE #; %700-80540910 C 700
LABEL LL3; % %002-80542010 C 002
IF CURLEVEL GEQ MAXTABLES THEN ERROR(101) ELSE %002-80543500 C 002
BLOCKTAB[CURLEVEL+1] := NUMBLOCKS := NUMBLOCKS + 1; %002-80543600 C 002
IF FOUND AND (THISID.IDCLASS=PROC OR THISID.IDCLASS=FUNC) THEN %600-80548000 C 600
NAMETAB3[CURLEVEL,THISINDEX].FORWARDDEF:=0; %504-80553000 C 504
T := NAMETAB3[CURLEVEL,THISINDEX].INFO; %002-80554500 C 002
TX := T + PARAMTAB[T]; %002-80554600 C 002
FOR I:=T+1 STEP 1 UNTIL TX DO %002-80554700 C 002
NEWNAME(FORWPARAM1[I],FORWPARAM2[I],CURLEVEL+1); %002-80554800 C 002
(THISID.IDCLASS=FUNC AND NOT FUN) THEN ERROR(43); %504-80555100 C 504
TX:=(T:=THISID.INFO)+PARAMTAB[T]; % UNMARK FORWARD PARMS 80556000 C 504
FOR I:=T+1 STEP 1 UNTIL TX DO % TO ALLOW REFERENCE 80557000 C 504
BEGIN T3:=PARAMTAB[I].PARAMNAME; %504-80558000 C 504
CURNAME1:=ABS(NAMETAB1[CURLEVEL+1,T3]); %504-80559000 C 504
CURNAME2:= NAMETAB2[CURLEVEL+1,T3]; %504-80560000 C 504
NAMETAB1[CURLEVEL+1,T3]:=0; %504-80561000 C 504
NEWNAME(CURNAME1,CURNAME2,CURLEVEL+1); %504-80562000 C 504
IF T3≠THISINDEX THEN BEGIN %504-80563000 C 504
PARAMTAB[I].PARAMNAME:=THISINDEX; %504-80564000 C 504
NAMETAB3[CURLEVEL+1,THISINDEX] := %504-80565000 C 504
NAMETAB3[CURLEVEL+1,T3]; %504-80565010 C 504
END END; % OF UNMARKING FORWARD PARAMETERS. %504-80566000 C 504
$ %518-80608000 C 518
BEGIN %518-80608010 C 518
BEGIN %518-80608020 C 518
INTEGER NAM,T1,SCRATCH; %518-80608030 C 518
NAM := PARAMTAB[I].[9:10]; %518-80608040 C 518
SCRATCH := NAMETAB3[CURLEVEL+1,NAM]; %518-80608050 C 518
SCRATCH := SCRATCH.TYPE; %518-80608060 C 518
T1 := TYPETAB1[SCRATCH]; %518-80608070 C 518
IF T1.STRUCT ≠ 0 AND T1.FORM < FILES THEN %518-80608080 C 518
GENID("H",1000×(CURLEVEL+1)+NAM,5) %518-80608090 C 518
ELSE %518-80608100 C 518
BEGIN % %601-80608105 C 601
GENID("V",1000×(CURLEVEL+1)+NAM,5); %518-80608110 C 518
IF T1.FORM=SET THEN % %601-80608111 C 601
BEGIN % %601-80608113 C 601
GEN(",",1,7); % %601-80608115 C 601
GENID("W",1000×(CURLEVEL+1)+NAM,5); % %601-80608117 C 601
END; %601-80608118 C 601
END; % %601-80608119 C 601
END; %518-80608120 C 518
IF TYPETAB1[NAMETAB3[CURLEVEL+1,PARAMTAB[I].PARAMNAME].TYPE80627200 C 601
].FORM=SET %601-80627205 C 601
THEN BEGIN % %601-80627400 C 601
GEN(",",1,7); % %601-80627600 C 601
GENID("W",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME 80627800 C 601
,5); % %601-80627801 C 601
END; %601-80627850 C 601
TX:=(T:=NAMETAB3[CURLEVEL,INDEX].INFO)+PARAMTAB[T]; %504-80636100 C 504
FOR I:=T+1 STEP 1 UNTIL TX DO % MARK FORWARD PARAMETERS 80636200 C 504
NAMETAB1[CURLEVEL+1,PARAMTAB[I].PARAMNAME].[46:1] := 1; 80636210 C 504
REPLACE POINTER(NAMETAB1[CURLEVEL+1,*]) BY 0 %002-80637500 C 002
FOR MAXNAMES+1 WORDS; %002-80637600 C 002
IF CURLEVEL GEQ LASTREC THEN ERROR(101); % %002-80643000 C 002
TX:=CURFUNC; CURFUNC:=IF FUN THEN INDEX ELSE -1; %504-80645000 C 504
BLOCK; %*** COMPILE PROCEDURE BODY *** 80646000 C 001
FOR I:=0 STEP 1 UNTIL MAXNAMES DO % LEAVE FORWARD PARAMETERS 80647000 C 504
IF NAMETAB1[CURLEVEL,I]>0 THEN NAMETAB1[CURLEVEL,I]:=0; 80648000 C 504
CURLEVEL:=CURLEVEL-1; CURFUNC:=TX; %504-80649000 C 504
END OF SEGMENT FOR PROCEDURE DECLARATIONS; %700-80658100 C 700
COMPSTAT; %*** COMPILE STATEMENT PART *** 80691000 C 001
FOR I:=LASTREC STEP 1 UNTIL TOPREC-1 DO % CLEAR RECORD DECS %504-80693000 C 504
MARGIN("-P",CURLEVEL); % MARK END OF PROCEDURE %712-80702100 C 712
$ PAGE %998-89000000 C 998
$ %705-90013000 C 705
INTEGER PROGNAMELENGTH; % %800-90013900 C 800
% %002-90014100 C 002
% %002-90014200 C 002
SAVEFACTOR:=0;% * DEFAULT ZIP IS COMPILE AND GO UNLESS %002-90014300 C 002
% * CHANGED BY THE USE OF THE "S" OPTION %002-90014400 C 002
% %002-90014500 C 002
% %002-90014600 C 002
CH[0] := "PASC000"; CHARPNT := POINTER(CH[0])+5; %711-90016000 C 711
PASCALGOL.FID := USER := TIME(-1); %711-90017000 C 711
DO BEGIN C:=C+1; REPLACE CHARPNT BY C FOR 3 DIGITS; %711-90018000 C 711
PASCALGOL.MFID := ALGOLNAME := CH[0]; %711-90019000 C 711
SEARCHDISKDIRECTORY( PASCALGOL, LINES[*] ); %711-90020000 C 711
END UNTIL LINES[0]=-1; % FILE NOT ON DISK %711-90021000 C 711
WRITE(PASCALGOL,MERGE); % ALGOL MUST COMPILE PRELUDE FIRST %704-90022000 C 704
$ SET VOIDT 90023000 C 704
$ POP VOIDT 90032000 C 704
C := " "; % TO INITIALIZE "INSYMBOL" %709-90034000 C 709
INITIALIZE; % COMPILER TABLES, NEWCARD, INSYMBOL %709-90035000 C 709
$ %709-90036000 C 709
PROGNAME := IF CURLENGTH < 7 %705-90042000 C 705
THEN " "&CURNAME1[41:6×CURLENGTH-1:6×CURLENGTH] 90042010 C 705
ELSE CURNAME2.[5:6]&CURNAME1[41:35:36]; %705-90042020 C 705
% %002-90042100 C 002
% THE FOLLOWING LINES ADD A "0" ONTO THE FRONT OF THE PROGRAM NAME OR90042200 C 002
% THE FIRST SIX CHARACTERS THEREOF IF IT IS LONGER THAN SIX CHARACTERS 90042300 C 002
% THUS GIVING THE NAME OF THE XALGOL OBJECT CODE FILE PRODUCED. %002-90042400 C 002
% %002-90042500 C 002
PROGNAME := CURNAME1.[35:36]; PROGNAMELENGTH := MIN(6,CURLENGTH)+1;90042600 C 002
% %002-90042700 C 002
% %002-90042800 C 002
MAXPERMTAB := 0; %518-90070100 C 518
INSIDEPARENS := FALSE; %518-90070200 C 518
$ PAGE %998-90070999 C 998
WRITE(LINE, TERMMESS); %708-90084000 C 708
IF PAGECNT > 0 % THERE HAS BEEN SOME LISTING %709-90088000 C 709
THEN BEGIN WRITE( LINE[DBL] ); WRITE( LINE[DBL] ) END; %709-90089000 C 709
BEGIN% %002-90090400 C 002
WRITE(LINE ,NOERRORS);% %002-90090500 C 002
IF ERR(100) % %800-90090600 C 800
THEN WRITE(LINE ,ERROR100MESS);% %002-90090700 C 002
IF ERR(102) THEN %713-90090710 C 713
WRITE(LINE,ERROR102MESS); %713-90090720 C 713
IF SAVEFACTOR≥0 THEN% *A ZIP IS REQUIRED %002-90090800 C 002
DEFINE PPROGNAME = 13 #, PALGOLNAME = 14 #, %705-90095000 C 705
PLIBRARY = 15 #, PUSER = 16 #, %705-90096000 C 705
P(P1) = POINTER(ZIPARRAY[P1])+1 FOR 7 #; %705-90097000 C 705
$ SET VOIDT 90098000 C 705
$ POP VOIDT 90104000 C 705
$ %705-90109000 C 705
$ %713-90110000 C 713
$ %713-90111000 C 713
ZIPARRAY[PPROGNAME]:=PROGNAME; ZIPARRAY[PALGOLNAME]:=ALGOLNAME; 90112000 C 705
ZIPARRAY[PLIBRARY]:= IF SAVEFACTOR>0 THEN "LIBRARY" ELSE %705-90113000 C 705
IF SAVEFACTOR<0 THEN " SYNTAX" ELSE " & RUN "; 90114000 C 705
ZIPARRAY[PUSER]:=USER; %705-90115000 C 705
REPLACE POINTER(ZIPARRAY[*]) BY "CC COMPILE ", %705-90116000 C 705
P(PPROGNAME), "/", P(PUSER), %705-90117000 C 705
" XALGOL ", P(PLIBRARY), %705-90118000 C 705
"; ALGOL FILE TAPE=PASCRUN/DISK SERIAL; ALGOL FILE CARD=", %800-90119000 C 800
P(PALGOLNAME),"/",P(PUSER)," SERIAL;", % %800-90120000 C 800
" XALGOL STACK = 2048; END."; % %800-90120500 C 800
$ SET VOIDT 90121000 C 705
$ POP VOIDT 90128000 C 705
END% %002-90129500 C 002
(" 5 FUNCTION NAME NOT ACCESSIBLE AT THIS LEVEL."), %511-91009000 C 511
(" 41 ALFA CONSTANTS MAY NOT BE LONGER THAN 7 CHARACTERS."),%001-91045000 C 001
(" 55 PROCEDURE NESTING DEPTH + NO OF RECORDS IS TOO GREAT."), 91060000 C 001
(" 87 END-OF-INPUT ENCOUNTERED UNEXPECTEDLY."), %001-91094000 C 001
(" 95 SIZE OF STRUCTURES IN ASSIGNMENT ARE NOT THE SAME."), %512-91102000 C 512
(" 97 TOO MANY FILES IN USE."), %001-91104000 C 001
("100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION. THE VALUE 07 IS91106500 C 002
SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT THE COMPILATION ERRO91106600 C 002
RS COUNT."),% %002-91106700 C 002
("101 PROCEDURES/FUNCTIONS NESTED TOO DEEP."), %002-91106800 C 002
("102 ***WARNING ONLY, ILLEGAL DOLLAR OPTION."), %713-91106900 C 713
WRITE(LINE, ERRORS,NUMERRS); %708-91110000 C 708
WRITE(LINE, ERRORMESS1[I]); %708-91112000 C 708
WRITE(LINE, ERRORMESS2[I-60]); %708-91114000 C 708
REWIND(XREFFILE); %002-92003500 C 002
SORT(PRINTXREF,XREFINPUT,0,XREFMAX,XREFCOMPARE,3,1000,6000); %002-92005000 C 002
END OF B5700 PASCAL COMPILER............................................99001000 C 001
%001-99999999 C 001
? END. 000000≥
NUMBER OF ERRORS DETECTED = 0.
PROCESSOR TIME = 46 SECONDS.
I/O TIME = 115 SECONDS.
LABEL 000000000LINE 00186197?EXECUTE PATCH/MERGE PATCH /MERGE
LABEL 000000000LINE 00186197? COMPILE PASCAL/NEW XALGOL LIBRARY XALGOL /PASCAL
BURROUGHS B-5700 XALGOL COMPILER MARK XV.3.00 WEDNESDAY, 07/16/86, 11:50 AM.
PASCAL /NEW
===============
10001000 T 0000
10002000 T 0000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10003000 T 0000
% % 10004000 T 0000
% % 10005000 T 0000
% * * % 10006000 T 0000
% * P A S C A L C O M P I L E R * % 10007000 T 0000
% *********************************** % 10008000 T 0000
% % 10009000 T 0000
% % 10010000 T 0000
% WRITTEN 1975 BY % 10011000 T 0000
% DAG F. LANGMYHR, % 10012000 T 0000
% HERIOT-WATT UNIVERSITY, % 10013000 T 0000
% EDINBURGH. % 10014000 T 0000
% % 10015000 T 0000
% % 10016000 T 0000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10017000 T 0000
% % 10018000 T 0000
% % 10019000 T 0000
% PART 1: DECLARATIONS. % 10020000 T 0000
% ------------- % 10021000 T 0000
% % 10022000 T 0000
% % 10023000 T 0000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10024000 T 0000
10025000 T 0000
10026000 T 0000
BEGIN 10027000 T 0000
START OF SEGMENT ********** 2
DEFINE EDITION = "4.4"#;%AUGUST 1978...DAVID A COOPER... %999- 10028000 P 0000
INTEGER NUMERRS, % @R+25: NUMBER OF ERRORS IN PROGRAM. %500- 10029000 P 0000
SAVEFACTOR, % @R+26: SAVEFACTOR FOR CODE FILE. %500- 10030000 P 0000
% >0 COMPILE TO LIBRARY. 10031000 T 0000
% =0 COMPILE AND RUN. 10032000 T 0000
% <0 COMPILE FOR SYNTAX. 10033000 T 0000
PAGECNT, % @R+27: NUMBER OF PAGES PRINTED. %500- 10033800 C 0000
CARDCNT; % @R+30: NUMBER OF CARDS READ. %500- 10034000 P 0000
FILE CARD "SOURCE" (1,10,30); % PASCAL SOURCE CODE INPUT FILE %703- 10035000 P 0000
SAVE FILE OUT LINE DISK SERIAL [20:1200] (1,17,90,SAVE 1); % PRINT FILE 10036000 P 0003
% AVOID BLOCKING RECORDS OF VARIABLE LENGTH%708- 10036001 C 0009
FILE PASCALGOL DISK SERIAL [20:300] (1,10,30,SAVE 0); % ALGOL CODE FILE 10037000 P 0009
DEFINE LINESPERPAGE = 60 #, %502- 10038000 P 0016
MAXINT=549755813887#; 10039000 T 0016
10040000 T 0016
%*** COMPILER CONSTANTS *** 10041000 T 0016
DEFINE MAXTABLES = 30 #, %MAX NUMBER OF LEVELS IN IDENTIFIER TABLE. 10042000 P 0016
MAXNAMES =307 #, %MAX NAMES IN EACH ROW OF IDENTIFIER TABLE. 10043000 P 0016
MAXLEVEL =15#, %MAX DEPTH OF PROCEDURE DECLARATIONS. 10044000 T 0016
% ONLY USED IN WITH STATEMENT TO TEST %701- 10044001 C 0016
MAXCASES =64 #, %MAX LABELS IN A CASE-STATEMENT. %701- 10045000 P 0016
MAXLABS =50 #, %MAX NUMBER OF IN PROGRAM LABELS. %701- 10046000 P 0016
MAXPARAMS =200 #, %MAX NUMBER OF PARAMETERS IN WHOLE PROGRAM. 10047000 P 0016
MAXTYPES =250 #, %MAX NUMBER OF DIFFERENT TYPES. %701- 10048000 P 0016
MAXCONSTS =100 #, %SIZE OF TABLE FOR CONSTANTS. %701- 10049000 P 0016
MAXTEMPS =5#, %NUMBER OF EXTRA VARS IN EACH PROCEDURE. 10050000 T 0016
MAXWITHSYMS= 70 #, %MAX NUMBER OF SYMBOLS USED BY WITH-STATMS. 10051000 P 0016
MAXSYMS = 800#, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 P 0016
LISTLENGTH =100 #, %MAX LENGTH OF VAR AND PARAM LISTS. %701- 10053000 P 0016
MAXEXTFILES=10 #, %MAX NUMBER OF EXTERNAL FILES. %701- 10054000 P 0016
MAXFILES =10 #, %MAX NUMBER OF FILES DECLARED AT ONE TIME. 10055000 P 0016
MAXPNTRS = 25#; %MAX NUMBER OF UNDECLARED POINTERS(FORWD). 10056000 P 0016
10057000 T 0016
%*** NAME TABLES *** 10058000 T 0016
ARRAY NAMETAB1,NAMETAB2,NAMETAB3[0:MAXTABLES,0:MAXNAMES]; 10059000 T 0016
DEFINE NAMELENGTH =[41:6]#, 10060000 T 0018
TYPE =[9:10]#, 10061000 T 0018
IDCLASS =[12:3]#, 10062000 T 0018
VAR =0#, 10063000 T 0018
CONST=1#, 10064000 T 0018
FUNC =2#, 10065000 T 0018
PROC =3#, 10066000 T 0018
TYPES=4#, 10067000 T 0018
INFO =[23:11]#, 10068000 T 0018
FORMAL =[24:1]#, 10069000 T 0018
FORWARDDEF =[25:1]#, 10070000 T 0018
EXTERNALFILE=[26:1]#; 10071000 T 0018
10072000 T 0018
%*** DISPLAY VECTOR *** 10073000 T 0018
ARRAY DISPLAY[0:MAXLEVEL]; 10074000 T 0018
DEFINE RECTYPE =[9:10]#, 10075000 T 0020
FIRSTWITHSYM =[19:10]#, 10076000 T 0020
LASTWITHSYM =[29:10]#, 10077000 T 0020
NUMPNTRSINWITH=[35:6]#, 10078000 T 0020
BRACKETSINWITH=[36:1]#, 10079000 T 0020
NAMETAB =[46:7]#; 10080000 T 0020
10081000 T 0020
%*** TYPE TABLES *** 10082000 T 0020
ARRAY TYPETAB1,TYPETAB2,TYPETAB3[0:MAXTYPES]; 10083000 T 0020
DEFINE FORM =[3:4]#, 10084000 T 0022
NUMERIC =0#, 10085000 T 0022
SYMBOLIC=1#, 10086000 T 0022
SUBTYPE =2#, 10087000 T 0022
MAINTYPE=[33:10]#, 10088000 T 0022
CHAR =3#, 10089000 T 0022
FLOATING=4#, 10090000 T 0022
ALFA =5#, 10091000 T 0022
SET =6#, 10092000 T 0022
SETTYPE =[33:10]#, 10093000 T 0022
POINTERS=7#, 10094000 T 0022
POINTTYPE=[33:10]#, 10095000 T 0022
ARRAYS =8#, 10096000 T 0022
INXTYPE =[33:10]#, 10097000 T 0022
ARRTYPE =[43:10]#, 10098000 T 0022
RECORD =9#, 10099000 T 0022
RECTAB =[33:10]#, 10100000 T 0022
FILES =10#, 10101000 T 0022
FILETYPE=[33:10]#, 10102000 T 0022
TEXTFILE=11#, 10103000 T 0022
SIZE =[15:12]#, 10104000 T 0022
STRUCT=[23:8]#; 10105000 T 0022
INTEGER NUMTYPES; 10106000 T 0022
10107000 T 0022
%*** PARAMETER TABLE *** 10108000 T 0022
ARRAY PARAMTAB, FORWPARAM1, FORWPARAM2[0:MAXPARAMS]; %002- 10109000 P 0022
DEFINE PARAMNAME =[9:10]#, 10110000 T 0024
PARAMKIND =[13:4]#, 10111000 T 0024
PARAMLEVEL=[23:10]#, 10112000 T 0024
PARAMTYPE =[33:10]#, 10113000 T 0024
PARAMFILE =[34:1]#; 10114000 T 0024
INTEGER NUMPARAMS; 10115000 T 0024
10116000 T 0024
%*** CONSTANT TABLE *** 10117000 T 0024
ARRAY CONSTTAB[0:MAXCONSTS]; 10118000 T 0024
INTEGER NUMCONSTS; 10119000 T 0026
10120000 T 0026
%*** LABEL TABLE *** 10121000 T 0026
ARRAY LABTAB[0:MAXLABS]; 10122000 T 0026
DEFINE LABVAL=[14:15]#, 10123000 T 0028
LABDEF=[15:1]#; 10124000 T 0028
INTEGER NUMLABS,FIRSTLAB; 10125000 T 0028
10126000 T 0028
%*** TABLES FOR I/O AND CHARACTER HANDLING *** 10127000 T 0028
ARRAY CH[0:0], TEXT[0:1], STRING[0:11]; 10128000 T 0028
POINTER CHARPNT,TEXTPNT,TEXTPNT0,STRINGPNT; 10129000 T 0033
ARRAY ICARD, ALGOLCARD[0:9], LINES, XLINE[0:16]; %708- 10130000 P 0033
% AVOID BLOCKING VARIABLE LENGTH RECORDS 10130001 C 0037
POINTER CARDPNT,LINEPNT,XLINEPNT,ALGOLPNT; 10131000 T 0037
INTEGER CHARCNT,ALGOLCNT,MARGINCNT; 10132000 T 0037
ARRAY HEADTEXT, ERRLINE[0:16]; %708- 10133000 P 0037
INTEGER LINECNT, ERRINX; % PAGECNT @ PRT+27 %500- 10134000 P 0039
10135000 T 0039
%*** XREF FILE AND TABLE *** 10136000 T 0039
FILE XREFFILE DISK SERIAL [20:3000] (1,3,30); % FOR CROSS REFERENCE 10137000 P 0039
ARRAY BLOCKTAB[0:MAXTABLES], XREFLINE[0:16]; 10138000 T 0043
ALPHA ARRAY XBUFF[0:2]; %002- 10138500 C 0046
BOOLEAN XINB; %002- 10138550 C 0048
INTEGER NUMXREF,NUMBLOCKS; POINTER XREFPNT; 10139000 T 0048
% 10140000 T 0048
%*** OTHER TABLES *** 10141000 T 0048
INTEGER ARRAY VARLIST[0:LISTLENGTH]; % TEMPORARY LIST OF VARIABLES. 10142000 T 0048
INTEGER VARINDEX,FIRSTVAR; 10143000 T 0050
ALPHA ARRAY SYMTAB[0:MAXSYMS]; % USED BY "EXPRESSION". %517- 10144000 P 0050
INTEGER NUMSYMS; 10145000 T 0051
ARRAY WITHTAB[0:MAXWITHSYMS]; % USED BY "WITHSTAT". 10146000 T 0051
INTEGER NWITHSYMS; 10147000 T 0053
INTEGER ARRAY SYMBOL[0:64]; % USED BY "INSYMBOL". 10148000 T 0053
INTEGER ARRAY SYMKIND[0:62]; %USED IN ERROR RECOVERY. %002- 10149000 P 0055
ARRAY PNTRTAB1,PNTRTAB2,PNTRTAB3[0:MAXPNTRS];% USED FOR FORWARD POINTERS 10150000 T 0057
INTEGER NUMPNTRS; 10151000 T 0059
ARRAY EXTFILETAB[0:MAXEXTFILES]; % EXTERNAL FILES. 10152000 T 0059
INTEGER NUMEXTFILES; 10153000 T 0061
ARRAY FILETAB[0:MAXFILES]; % FILES IN USE. 10154000 T 0061
INTEGER NUMFILES; 10155000 T 0062
ARRAY ERRP[0:3]; % HOLDS 128 BITS % RECORDS ERROR MESSAGES USED. 10156000 P 0062
DEFINE ERR(ERR1) = BOOLEAN(0&ERRP[(ERR1).[6:2]][0:((ERR1).[4:5]):1])#; 10156100 C 0064
DEFINE %518- 10156200 C 0064
PERMSUB = 0 #, MAXTOTALSUBSCRS = 100#, %518- 10156300 C 0064
ARRNAM = 1 #; %518- 10156400 C 0064
ARRAY ARRSUBPERMTAB[0:1,0:MAXTOTALSUBSCRS]; %518- 10156500 C 0064
INTEGER PASSPERMTAB, MAXPERMTAB, REMEMBERPOSN; %518- 10156600 C 0066
10157000 T 0066
%*** COMPILE TIME OPTIONS *** 10158000 T 0066
BOOLEAN LISTOPTION,RESWORDOPTION,CHECKOPTION,DUMPOPTION,XREFOPTION; 10159000 T 0066
DEFINE RESWORDPRESENT = RESWORDOPTION.[1:1] #; %710- 10159100 C 0066
INTEGER CARDLENGTH; 10160000 T 0066
10161000 T 0066
%*** INTRINSIC TYPES *** 10162000 T 0066
INTEGER INTTYPE,REALTYPE,ALFATYPE,CHARTYPE,BOOLTYPE,NILTYPE,TEXTTYPE, 10163000 T 0066
INPUTFILE,OUTPUTFILE,EMPTYSET; 10164000 T 0066
BOOLEAN INPUTDECL,OUTPUTDECL; 10165000 T 0066
10166000 T 0066
%*** OTHER VARIABLES *** 10170000 T 0066
ALPHA USER; % THE USER NUMBER FOUND ON THE USER CARD. 10171000 T 0066
10172000 T 0066
INTEGER CURLEVEL, % CURRENT PROCEDURE LEVEL. 10173000 T 0066
TOPLEVEL, % TOP LEVEL IN DISPLAY VECTOR. 10174000 T 0066
NUMBEGINS, % NUMBER OF "BEGIN"S IN THE PROGRAM. 10175000 T 0066
NUMCASES, % NUMBER OF CASE-STATEMENTS IN PROGRAM. 10176000 T 0066
NUMREPS, % NUMBER OF REPEAT-STATEMENTS IN PROGRAM. 10177000 T 0066
NUMTEMPS, % NUMBER OF TEMPORARY VARIABLES IN USE. 10178000 T 0066
CURFUNC, % INDEX OF FUNCTION CURRENTLY COMPILED. 10179000 T 0066
CURSY, % LAST SYMBOL READ BY SCANNER. 10180000 T 0066
CURTYPE, % TYPE OF ENTITY LAST COMPILED. 10181000 T 0066
CURMODE, % CURRENT EXPRESSION MODE. 10182000 T 0066
LASTREC; % LAST RECORD TABLE DEFINED. 10183000 T 0066
10184000 T 0066
LABEL ENDOFINPUT; 10185000 T 0066
10186000 T 0066
FORMAT NOERRORS ("NO ERRORS DETECTED."), 10187000 T 0066
START OF SEGMENT ********** 3
ERRORS (I5," ERRORS DETECTED ",20("#") /), %704- 10188000 P 0066
ERROR100MESS (//"100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION 10188500 C 0066
. THE VALUE 07 IS SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT TH 10188600 C 0066
E COMPILATION ERRORS COUNT."//),% %002- 10188700 C 0066
ERROR102MESS(//"102 *** WARNING ONLY, ILLEGAL COMPILER OPTION.") 10188750 C 0066
, % %713- 10188751 C 0066
ALIST ("$ SET LIST "), %704- 10189000 P 0066
NOALIST ("$ RESET LIST"), 10190000 T 0066
MERGE ("$ SET TAPE RESET $" / %704- 10190100 C 0066
"$ RESET TAPE", T73,"99000000" ), %704- 10190200 C 0066
LASTLINE ("; TERMINATE: END OF PASCAL PROGRAM."), 10191000 T 0066
TERMMESS ("**** COMPILATION TERMINATED."); %704- 10192000 P 0066
3 IS 106 LONG, NEXT SEG 2
MONITOR EXPOVR:=REALOVERFLOW; 10193000 T 0066
10194000 T 0069
%*** SCANNER SYMBOLS *** 10195000 T 0069
DEFINE IDENTIFIER=1#, INTCONST=2#, REALCONST=3#, ALFACONST=4#, 10196000 T 0069
CHARCONST=5#, NOTSY=6#, ASTERISK=7#, SLASH=8#, 10197000 T 0069
ANDSY=9#, DIVSY=10#, MODSY=11#, PLUS=12#, 10198000 T 0069
MINUS=13#, ORSY=14#, LSSSY=15#, LEQSY=16#, 10199000 T 0069
GEQSY=17#, GTRSY=18#, NEQSY=19#, EQLSY=20#, 10200000 T 0069
INSY=21#, LPAR=22#, RPAR=23#, LBRACKET=24#, 10201000 T 0069
RBRACKET=25#, DOUBLEDOT=26#, COMMA=27#, SEMICOLON=28#, 10202000 T 0069
DOT=29#, ARROW=30#, COLON=31#, ASSIGNSY=32#, 10203000 T 0069
BEGINSY=33#, ENDSY=34#, IFSY=35#, THENSY=36#, 10204000 T 0069
ELSESY=37#, CASESY=38#, OFSY=39#, REPEATSY=40#, 10205000 T 0069
UNTILSY=41#, WHILESY=42#, DOSY=43#, FORSY=44#, 10206000 T 0069
TOSY=45#, DOWNTOSY=46#, GOTOSY=47#, NILSY=48#, 10207000 T 0069
TYPESY=49#, ARRAYSY=50#, RECORDSY=51#, FILESY=52#, 10208000 T 0069
SETSY=53#, CONSTSY=54#, VARSY=55#, LABELSY=56#, 10209000 T 0069
FUNCSY=57#, PROCSY=58#, WITHSY=59#, PROGRAMSY=60#, 10210000 T 0069
PACKEDSY=61#, ASSERTSY=62#; %002- 10211000 P 0069
10212000 T 0069
DEFINE INITIAL=0#, MIDDLE=1#, TERMINAL=2#; 10213000 T 0069
DEFINE NUMBER=0#, BITPATTERN=1#; 10214000 T 0069
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20001000 T 0069
% % 20002000 T 0069
% % 20003000 T 0069
% % 20004000 T 0069
% PART 2: COMPILER UTILITY ROUTINES. % 20005000 T 0069
% -------------------------- % 20006000 T 0069
% % 20007000 T 0069
% % 20008000 T 0069
% % 20009000 T 0069
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20010000 T 0069
20011000 T 0069
20012000 T 0069
PROCEDURE INSYMBOL; FORWARD; 20013000 T 0069
PROCEDURE WRITEALGOL; FORWARD; 20014000 T 0073
PROCEDURE NEWXREF(NAME1,NAME2,TABLE,DECL); 20015000 T 0073
VALUE NAME1,NAME2,TABLE,DECL; %700- 20016000 P 0073
REAL NAME1,NAME2; %700- 20017000 P 0073
INTEGER TABLE; BOOLEAN DECL; %700- 20018000 P 0073
FORWARD; %700- 20019000 P 0073
PROCEDURE PRINTERRORS; FORWARD; %700- 20020000 P 0073
20021000 T 0073
DEFINE NDIGITS(N)= 20022000 T 0073
IF N≤ 9 THEN 1 ELSE 20023000 T 0073
IF N≤99 THEN 2 ELSE 3 DIGITS#; 20024000 T 0073
20025000 T 0073
PROCEDURE HEADING; %*** PRINTS A HEADING AT START OF NEW PAGE. 20026000 P 0073
BEGIN DEFINE NEWSEGMENT = HERE #; %700- 20027000 P 0073
START OF SEGMENT ********** 4
PAGECNT:=PAGECNT+1; 20028000 T 0000
REPLACE POINTER(HEADTEXT[*])+85 BY PAGECNT FOR NDIGITS(PAGECNT); 20029000 T 0001
IF PAGECNT=1 THEN WRITE(LINE[NO],17,HEADTEXT[*]) ELSE %709- 20029900 C 0011
WRITE( LINE[PAGE]); %709- 20030000 P 0017
WRITE( LINE[DBL],17,HEADTEXT[*]); %709- 20031000 P 0021
LINECNT:=2; 20032000 T 0025
END OF HEADING; %700- 20033000 P 0026
4 IS 27 LONG, NEXT SEG 2
20034000 T 0073
20035000 T 0073
PROCEDURE PRINTLINE; %*** PRINTS A PASCAL SOURCE CODE LINE %700- 20036000 P 0073
BEGIN DEFINE NEWSEGMENT = HERE #; %700- 20037000 P 0073
START OF SEGMENT ********** 5
REPLACE LINEPNT-8 BY CARDCNT FOR 5 DIGITS; 20038000 T 0000
IF LINECNT≥LINESPERPAGE THEN HEADING; 20039000 T 0005
IF REAL(RESWORDOPTION) = 3 THEN % RESERVED WORD IS PRESENT %710- 20040000 P 0007
BEGIN 20041000 T 0008
WRITE( LINE[NO],17,XLINE[*]); %708- 20042000 P 0008
WRITE( LINE[NO],17,XLINE[*]); %708- 20043000 P 0012
END; 20044000 T 0017
WRITE(LINE, 17,LINES[*]); %708- 20045000 P 0017
LINECNT:=LINECNT+1; 20046000 T 0021
END OF PRINTLINE; %700- 20047000 P 0022
5 IS 23 LONG, NEXT SEG 2
20048000 T 0073
20049000 T 0073
PROCEDURE NEWCARD; %*** READS A NEW PASCAL SOURCE CODE CARD 20050000 P 0073
BEGIN DEFINE RESULT = ICARD[*], ETC #; %700- 20051000 P 0073
START OF SEGMENT ********** 6
IF LISTOPTION THEN PRINTLINE; 20052000 T 0000
IF ERRINX>0 THEN PRINTERRORS; 20053000 T 0001
READ(CARD,10,ICARD[*]) [ENDOFINPUT]; 20054000 T 0003
CARDPNT:=POINTER(ICARD[*]); 20055000 T 0008
REPLACE XLINEPNT BY " " FOR 16 WORDS; %700- 20056000 P 0009
REPLACE LINEPNT BY CARDPNT FOR 10 WORDS, XLINEPNT FOR 6 WORDS;%700- 20057000 P 0013
RESWORDOPTION := RESWORDOPTION AND TRUE; % RESET RESWORDPRESENT 20057100 C 0018
CHARCNT:=CARDLENGTH; 20058000 T 0019
MARGINCNT:=85; 20059000 T 0020
CARDCNT:=CARDCNT+1; 20060000 T 0021
END OF NEWCARD; %700- 20061000 P 0022
6 IS 27 LONG, NEXT SEG 2
20062000 T 0073
20063000 T 0073
DEFINE GEN(GEN1,GEN2,GEN3) = GENI(TRUE,GEN1,GEN3,GEN2) #, %700- 20063100 C 0073
GENID(GENID1,GENID2,GENID3)= GENI(FALSE,GENID1,GENID2,GENID3) #; %700- 20063200 C 0073
%700- 20063300 C 0073
PROCEDURE GENI(GENT, TXT, NUM, N ); %700- 20063400 C 0073
VALUE GENT, TXT, NUM, N; %700- 20063500 C 0073
BOOLEAN GENT; ALPHA TXT; INTEGER NUM, N; %700- 20063600 C 0073
BEGIN DEFINE START = NUM #, NDIG = N #; %700- 20063700 C 0073
START OF SEGMENT ********** 7
%700- 20063800 C 0000
IF GENT THEN %*** GENERATE A TEXT "TXT", CONSISTING OF 20064000 P 0000
BEGIN %*** "N" LETTERS, STARTING AT "START". 20065000 T 0000
IF ALGOLCNT<N THEN WRITEALGOL; 20066000 T 0000
TEXT[0] := TXT; %700- 20067000 P 0002
REPLACE ALGOLPNT:ALGOLPNT BY TEXTPNT0+START FOR N; 20068000 T 0003
ALGOLCNT:=ALGOLCNT-N; 20069000 T 0008
END %700- 20070000 P 0009
20071000 T 0009
20072000 T 0009
ELSE %*** GENERATE AN ALGOL IDENTIFIER. %700- 20073000 P 0009
BEGIN 20074000 T 0009
IF ALGOLCNT≤NDIG THEN WRITEALGOL; 20075000 T 0010
CH[0] := TXT; %700- 20076000 P 0012
REPLACE ALGOLPNT:ALGOLPNT BY CHARPNT FOR 1, NUM FOR NDIG DIGITS; 20077000 T 0013
ALGOLCNT:=ALGOLCNT-NDIG-1; 20078000 T 0020
END END GENI; %700- 20079000 P 0021
7 IS 22 LONG, NEXT SEG 2
20080000 T 0073
20081000 T 0073
PROCEDURE GENINT( N ); %700- 20082000 P 0073
VALUE N; INTEGER N; %700- 20083000 P 0073
BEGIN DEFINE RESULT = ALGOL CODE #; %700- 20084000 P 0073
START OF SEGMENT ********** 8
INTEGER NABS, NSIZE; %700- 20085000 P 0000
NABS:=ABS(N); IF N<0 THEN GEN("-",1,7); 20086000 T 0000
NSIZE:=IF NABS≤ 9 THEN 1 ELSE 20087000 T 0003
IF NABS≤ 999 THEN 3 ELSE 20088000 T 0005
IF NABS≤ 99999 THEN 5 ELSE 20089000 T 0007
IF NABS≤99999999 THEN 8 ELSE 12; 20090000 T 0009
IF ALGOLCNT<NSIZE THEN WRITEALGOL; 20091000 T 0012
IF NSIZE=12 THEN 20092000 T 0014
REPLACE ALGOLPNT:ALGOLPNT BY (NABS DIV 1000000) FOR 6 DIGITS, 20093000 T 0015
ENTIER(NABS MOD 1000000) FOR 6 DIGITS ELSE 20094000 T 0020
REPLACE ALGOLPNT:ALGOLPNT BY NABS FOR NSIZE DIGITS; 20095000 T 0025
ALGOLCNT:=ALGOLCNT-NSIZE; 20096000 T 0033
END OF GENINT; %700- 20097000 P 0034
8 IS 38 LONG, NEXT SEG 2
20098000 T 0073
20099000 T 0073
PROCEDURE GENREAL(X); 20100000 T 0073
VALUE X; REAL X; 20101000 T 0073
BEGIN 20102000 T 0073
REAL ABSX; 20103000 T 0073
START OF SEGMENT ********** 9
INTEGER POWER,V1,V2; 20104000 T 0000
20105000 T 0000
IF X.[46:5]=0 THEN 20106000 T 0000
BEGIN 20107000 T 0001
IF ALGOLCNT<9 THEN WRITEALGOL; 20108000 T 0001
TEXT[0]:=X; 20109000 T 0003
REPLACE ALGOLPNT:ALGOLPNT BY """, TEXTPNT FOR 7, """; 20110000 T 0004
ALGOLCNT:=ALGOLCNT-9; 20111000 T 0013
END ELSE 20112000 T 0015
BEGIN 20113000 T 0015
IF ALGOLCNT<22 THEN WRITEALGOL; 20114000 T 0015
IF X<0 THEN GEN("(-",2,6); 20115000 T 0017
ABSX:=ABS(X); 20116000 T 0020
IF ABSX> 0 THEN 20117000 T 0021
BEGIN 20118000 T 0021
WHILE ABSX≥1@7 DO BEGIN ABSX:=ABSX/10; POWER:=POWER+1; END; 20119000 T 0022
WHILE ABSX<1@6 DO BEGIN ABSX:=ABSX×10; POWER:=POWER-1; END; 20120000 T 0030
V1:=ENTIER(ABSX); 20121000 T 0036
V2:=ENTIER((ABSX-V1)×1000000); 20122000 T 0037
REPLACE ALGOLPNT:ALGOLPNT BY V1 FOR 7 DIGITS, ".", 20123000 T 0040
V2 FOR 6 DIGITS, "@"; 20124000 T 0047
ALGOLCNT:=ALGOLCNT-15; 20125000 T 0053
IF POWER<0 THEN GEN("-",1,7); 20126000 T 0054
POWER:=ABS(POWER); 20127000 T 0057
REPLACE ALGOLPNT:ALGOLPNT BY POWER FOR 2 DIGITS; 20128000 T 0058
ALGOLCNT:=ALGOLCNT-2; 20129000 T 0062
END ELSE GEN("0",1,7); 20130000 T 0063
IF X<0 THEN GEN(")",1,7); 20131000 T 0067
END; 20132000 T 0070
END OF GENREAL; 20133000 T 0070
9 IS 74 LONG, NEXT SEG 2
20134000 T 0073
20135000 T 0073
INTEGER TYPEINDEX; 20136000 T 0073
20137000 T 0073
DEFINE NEWTYPE= 20138000 T 0073
BEGIN 20139000 T 0073
IF NUMTYPES≥MAXTYPES THEN BEGIN ERROR(45);NUMTYPES:=MAXTYPES-20 END; 20140000 T 0073
TYPEINDEX:=NUMTYPES:=NUMTYPES+1; 20141000 T 0073
END #; 20142000 T 0073
20143000 T 0073
20144000 T 0073
PROCEDURE WRITEALGOL; %*** WRITES A COMPLETED ALGOL CARD TO%700- 20145000 P 0073
BEGIN %*** THE FILE. 20146000 T 0073
DEFINE NEWSEGMENT = HERE #; %700- 20146100 C 0073
START OF SEGMENT ********** 10
REPLACE POINTER(ALGOLCARD[9]) BY CARDCNT FOR 8 DIGITS; 20147000 T 0000
WRITE(PASCALGOL,10,ALGOLCARD[*]); 20148000 T 0005
IF DUMPOPTION THEN BEGIN IF (LINECNT:=LINECNT+1)≥LINESPERPAGE %502- 20149000 P 0010
THEN HEADING; WRITE(LINE,10,ALGOLCARD[*]) END; %502- 20149100 C 0012
ALGOLPNT:=POINTER(ALGOLCARD[*]); ALGOLCNT:=71; 20150000 T 0017
REPLACE ALGOLPNT BY " " FOR 9 WORDS; 20151000 T 0020
END OF WRITEALGOL; 20152000 T 0023
10 IS 24 LONG, NEXT SEG 2
20153000 T 0073
20154000 T 0073
DEFINE MARGIN(LETTER,NUM)= 20155000 T 0073
BEGIN COMMENT *** PLACES INFORMATION IN THE MARGIN. ; 20156000 T 0073
IF MARGINCNT≤118 THEN 20157000 T 0073
BEGIN TEXT[0]:=LETTER; 20158000 T 0073
REPLACE LINEPNT+MARGINCNT BY TEXTPNT+5 FOR 2, 20159000 T 0073
NUM FOR NDIGITS(NUM); 20160000 T 0073
MARGINCNT:=MARGINCNT+6; 20161000 T 0073
END; 20162000 T 0073
END OF MARGIN#; 20163000 T 0073
20164000 T 0073
20165000 T 0073
PROCEDURE SKIP(SYMBOL); %*** SKIP SYMBOLS TO RECOVER FROM ERROR 20166000 T 0073
VALUE SYMBOL; INTEGER SYMBOL; %*** CONDITION. 20167000 T 0073
BEGIN 20168000 T 0073
DEFINE NEWSEGMENT = HERE #; %700- 20168100 C 0073
START OF SEGMENT ********** 11
WHILE CURSY≠SYMBOL AND SYMKIND[CURSY]=MIDDLE DO 20169000 T 0000
IF CURSY=RECORDSY THEN 20170000 T 0002
BEGIN DO BEGIN INSYMBOL; 20171000 T 0003
SKIP(99); 20172000 T 0004
END UNTIL CURSY≠SEMICOLON AND CURSY≠CASESY; 20173000 T 0005
END ELSE INSYMBOL; 20174000 T 0007
END OF SKIP; 20175000 T 0009
11 IS 10 LONG, NEXT SEG 2
20176000 T 0073
20177000 T 0073
PROCEDURE ERROR(ERRNUM); 20178000 T 0073
VALUE ERRNUM; INTEGER ERRNUM; 20179000 T 0073
BEGIN COMMENT *** ARRANGE ERROR INDICATOR. ; 20180000 T 0073
DEFINE NEWSEGMENT = HERE #; %700- 20180100 C 0073
START OF SEGMENT ********** 12
IF ERRNUM<0 THEN ERRNUM:=ABS(ERRNUM) ELSE %511- 20180900 C 0000
NUMERRS:=NUMERRS+1; 20181000 T 0002
% %002- 20181500 C 0004
% %002- 20181550 C 0004
IF ERRNUM=100 OR ERRNUM=102 %713- 20181600 C 0004
THEN NUMERRS := NUMERRS - 1; %*ERROR NUMBER 102 IS ONLY AN ILLEGAL 20181610 C 0005
% * DOLLAR OPTION WARNING & %713- 20181620 C 0007
% *ERROR NUMBER 100 ALONE SHOULD NOT %713- 20181650 C 0007
% * PREVENT THE XALGOL COMPILATION BEING 20181700 C 0007
% * ZIPPED AS THE VALUE 7 IS SUBSTITUTED 20181750 C 0007
% * FOR A BAD SAVE CONSTANT IN AN "S"%002- 20181800 C 0007
% * OPTION. %002- 20181850 C 0007
% %002- 20181900 C 0007
% %002- 20181950 C 0007
ERRP[ERRNUM.[6:2]]:=ERRP[ERRNUM.[6:2]] & 1[ERRNUM.[4:5]:0:1]; %702- 20182000 P 0007
ERRINX:=MAX(ERRINX,CARDLENGTH-2-CHARCNT); 20183000 T 0013
IF ERRINX≤115 THEN 20184000 T 0017
BEGIN REPLACE POINTER(ERRLINE[1])+ERRINX BY "×", 20185000 T 0017
ERRNUM FOR NDIGITS(ERRNUM); 20186000 T 0026
ERRINX:=ERRINX+(IF ERRNUM≤ 9 THEN 2 ELSE 20187000 T 0032
IF ERRNUM≤99 THEN 3 ELSE 4); 20188000 T 0035
END END OF ERROR; 20189000 T 0038
12 IS 39 LONG, NEXT SEG 2
20190000 T 0073
20191000 T 0073
PROCEDURE PRINTERRORS; 20192000 T 0073
BEGIN COMMENT *** PRINT ERROR INDICATORS. ; 20193000 T 0073
DEFINE NEWSEGMENT = HERE #; %700- 20193100 C 0073
START OF SEGMENT ********** 13
IF NOT LISTOPTION THEN %709- 20194000 P 0000
BEGIN IF PAGECNT=0 THEN HEADING; PRINTLINE END; %709- 20194100 C 0000
REPLACE POINTER(ERRLINE[0])+4 BY NUMERRS FOR 4 DIGITS; %702- 20194900 C 0003
WRITE(LINE, 17,ERRLINE[*]); %708- 20195000 P 0011
LINECNT:=LINECNT+1; 20196000 T 0015
REPLACE POINTER(ERRLINE[1]) BY " " FOR 16 WORDS; 20197000 T 0016
ERRINX:=0; 20198000 T 0022
END OF PRINT ERRORS; 20199000 T 0023
13 IS 24 LONG, NEXT SEG 2
20200000 T 0073
20201000 T 0073
DEFINE HASH(HASH1) = ENTIER((HASH1) MOD MAXNAMES) #; %505- 20202000 P 0073
20203000 T 0073
INTEGER THISLEVEL,THISTAB,THISINDEX; 20204000 T 0073
ALPHA THISID, CURNAME1, CURNAME2; % USED IN SCANNER %700- 20205000 P 0073
BOOLEAN FOUND; 20206000 T 0073
20207000 T 0073
PROCEDURE SEARCHTAB( TAB ); %*** SEARCH NAME TABLE "TAB" FOR THE %700- 20208000 P 0073
VALUE TAB; INTEGER TAB; %*** IDENTIFIER JUST READ. %700- 20208100 C 0073
BEGIN ALPHA TNAME; INTEGER WRAPAROUND; %505- 20209000 P 0073
START OF SEGMENT ********** 14
WRAPAROUND:=THISINDEX:=HASH(CURNAME1); %505- 20210000 P 0000
TNAME:=NAMETAB1[TAB,THISINDEX]; 20211000 T 0002
WHILE (IF TNAME=CURNAME1 THEN NAMETAB2[TAB,THISINDEX]≠CURNAME2 20212000 T 0004
ELSE TNAME≠0) DO 20213000 T 0007
BEGIN 20214000 T 0009
THISINDEX:=IF THISINDEX=0 THEN MAXNAMES ELSE THISINDEX-1; 20215000 T 0009
TNAME:=NAMETAB1[TAB,THISINDEX]; 20216000 T 0013
IF THISINDEX=WRAPAROUND THEN TNAME:=0; % TABLE IS FULL %505- 20216100 C 0014
END; 20217000 T 0016
FOUND:=TNAME≠0; 20218000 T 0019
IF XREFOPTION THEN 20219000 T 0020
IF FOUND THEN NEWXREF(CURNAME1,CURNAME2,TAB,FALSE); % 20220000 T 0020
END OF SEARCHTAB; %700- 20221000 P 0023
14 IS 27 LONG, NEXT SEG 2
20222000 T 0073
PROCEDURE SEARCHDISKDIRECTORY( F, A ); FILE F; ARRAY A[0]; %711- 20222100 C 0073
SEARCH( F, A[*] ); % END OF SEARCHDISKDIRECTORY; %711- 20222200 C 0073
%711- 20222300 C 0075
PROCEDURE SEARCH; %*** SEARCH ALL TABLES CURRENTLY IN USE. 20223000 P 0075
BEGIN DEFINE RESULT = THISID #; %700- 20224000 P 0075
START OF SEGMENT ********** 15
THISLEVEL:=TOPLEVEL+1; 20225000 T 0000
DO BEGIN 20226000 T 0001
THISLEVEL:=THISLEVEL-1; 20227000 T 0002
THISTAB:=IF THISLEVEL≤CURLEVEL THEN THISLEVEL 20228000 T 0003
ELSE DISPLAY[THISLEVEL].NAMETAB; 20229000 T 0004
SEARCHTAB(THISTAB); 20230000 T 0006
END UNTIL FOUND OR THISLEVEL=0; 20231000 T 0007
THISID:=NAMETAB3[THISTAB,THISINDEX]; 20232000 T 0009
END OF SEARCH; %700- 20233000 P 0011
15 IS 12 LONG, NEXT SEG 2
20234000 T 0075
20235000 T 0075
PROCEDURE NEWNAME( NAME1,NAME2, TAB ); %700- 20236000 P 0075
VALUE NAME1, NAME2, TAB; %700- 20236100 C 0075
ALPHA NAME1, NAME2; INTEGER TAB; %700- 20236200 C 0075
BEGIN %*** ENTER A NEW NAME INTO THE NAME TABLE "TAB". 20237000 T 0075
ALPHA TNAME; INTEGER WRAPAROUND; %505- 20237100 C 0075
START OF SEGMENT ********** 16
WRAPAROUND:=THISINDEX:=HASH(NAME1); %505- 20238000 P 0000
TNAME:=NAMETAB1[TAB,THISINDEX]; 20239000 T 0002
WHILE(IF TNAME=NAME1 THEN NAMETAB2[TAB,THISINDEX]≠NAME2 20240000 T 0004
ELSE TNAME≠0) DO 20241000 T 0007
BEGIN 20242000 T 0009
THISINDEX:=IF THISINDEX=0 THEN MAXNAMES ELSE THISINDEX-1; 20243000 T 0009
TNAME:=NAMETAB1[TAB,THISINDEX]; 20244000 T 0013
IF THISINDEX=WRAPAROUND THEN % TABLE AT THIS LEVEL IS FULL 20244100 C 0014
BEGIN ERROR(40); NAME1:=TNAME; NAME2:=NAMETAB2[TAB,THISINDEX] 20244200 C 0015
END; %505- 20244300 C 0018
END; 20245000 T 0019
IF TNAME≠0 THEN ERROR(2); 20246000 T 0021
NAMETAB1[TAB,THISINDEX]:=NAME1; 20247000 T 0023
NAMETAB2[TAB,THISINDEX]:=NAME2; 20248000 T 0025
IF XREFOPTION THEN NEWXREF(NAME1,NAME2,TAB,TRUE); 20249000 T 0027
END OF NEWNAME; %700- 20250000 P 0029
16 IS 33 LONG, NEXT SEG 2
20251000 T 0075
20300000 T 0075
PROCEDURE INITIALIZE; %*** INITIALIZATION *** 20301000 T 0075
BEGIN %********************** 20302000 T 0075
INTEGER T1,T3; 20303000 T 0075
START OF SEGMENT ********** 17
ALPHA A; 20304000 T 0000
FILL SYMKIND[*] WITH 28(MIDDLE),TERMINAL,4(MIDDLE),INITIAL,TERMINAL, 20305000 T 0000
START OF SEGMENT ********** 18
INITIAL,MIDDLE,TERMINAL,INITIAL,MIDDLE,INITIAL,TERMINAL,INITIAL, 20306000 T 0001
MIDDLE,INITIAL,2(MIDDLE),INITIAL,MIDDLE,INITIAL,4(MIDDLE), 20307000 T 0001
7(INITIAL),MIDDLE,INITIAL; %002- 20308000 P 0001
18 IS 63 LONG, NEXT SEG 17
20309000 T 0001
FILL SYMBOL[*] WITH 10(0),0,ARROW,0,COLON,GTRSY,GEQSY,PLUS,9(0), 20310000 T 0001
START OF SEGMENT ********** 19
DOT,LBRACKET,ANDSY,LPAR,LSSSY,ARROW,0,9(0),0,ASTERISK,MINUS, 20311000 T 0003
RPAR,SEMICOLON,LEQSY,0,SLASH,8(0),COMMA,0,NEQSY,EQLSY,RBRACKET, 20312000 T 0003
0,DOUBLEDOT; 20313000 T 0003
19 IS 65 LONG, NEXT SEG 17
20314000 T 0003
LINEPNT :=POINTER(LINES[1]); %708- 20315000 P 0003
XLINEPNT:=POINTER(XLINE[1]); 20316000 T 0006
REPLACE LINEPNT-8 BY " " FOR 17 WORDS; %708- 20317000 P 0009
REPLACE XLINEPNT-8 BY LINEPNT-8 FOR 17 WORDS; %708- 20318000 P 0015
REPLACE POINTER(ERRLINE[*]) BY "**** ", LINEPNT FOR 16 WORDS; 20319000 P 0021
ALGOLPNT:=POINTER(ALGOLCARD[*]); ALGOLCNT:=71; 20320000 T 0028
REPLACE ALGOLPNT BY LINEPNT FOR 9 WORDS; %708- 20321000 P 0030
CHARPNT := POINTER(CH[0])+7; CH[0] := " "; %711- 20322000 P 0033
TEXTPNT:=POINTER(TEXT[*])+1; TEXTPNT0:=TEXTPNT-1; 20323000 T 0039
REPLACE TEXTPNT BY " " FOR 15; 20324000 T 0046
STRINGPNT:=POINTER(STRING[*]); 20325000 T 0049
REPLACE POINTER(HEADTEXT[*]) BY LINEPNT FOR 10 WORDS, "PAGE 1 ", 20326000 P 0051
LINEPNT FOR 6 WORDS; %708- 20326100 C 0059
REPLACE POINTER(HEADTEXT[*]) BY "PASCAL(", EDITION, ")/B-5700"; 20327000 T 0061
TEXT[0]:=TIME(5); 20328000 T 0072
REPLACE POINTER(HEADTEXT[*])+45 BY TEXTPNT+5 FOR 2,"/", %709- 20329000 P 0073
TEXTPNT+1 FOR 2, "/", TEXTPNT+3 FOR 2; %709- 20330000 P 0084
T1:=TIME(1)/3600; 20331000 T 0095
REPLACE POINTER(HEADTEXT[*])+57 BY (T1 DIV 60) FOR 2 DIGITS, ":", 20332000 T 0097
ENTIER(T1 MOD 60) FOR 2 DIGITS; 20333000 T 0107
HEADING; 20334000 T 0111
20335000 T 0112
%*** INITIALIZE INTRINSIC TYPES, CONSTANTS ETC. *** 20336000 T 0112
20337000 T 0112
INTTYPE:=T3:=1; %*** "INTEGER" *** 20338000 T 0112
T1:=NUMERIC; T1.SIZE:=1; T1.STRUCT:=0; 20339000 T 0113
TYPETAB1[1]:=T1; TYPETAB2[1]:=-MAXINT; TYPETAB3[1]:=MAXINT; 20340000 T 0117
NEWNAME("7INTEGE","R",0); T3.IDCLASS:=TYPES; 20341000 T 0121
NAMETAB3[0,THISINDEX]:=T3; 20342000 T 0124
REALTYPE:=T3:=2; %*** "REAL" *** 20343000 T 0126
T1.FORM:=FLOATING; TYPETAB1[2]:=T1; 20344000 T 0128
NEWNAME("400REAL",0,0); T3.IDCLASS:=TYPES; 20345000 T 0131
NAMETAB3[0,THISINDEX]:=T3; 20346000 T 0134
ALFATYPE:=T3:=3; %*** "ALFA" *** 20347000 T 0136
T1.FORM:=ALFA; TYPETAB1[3]:=T1; 20348000 T 0137
NEWNAME("400ALFA",0,0); T3.IDCLASS:=TYPES; 20349000 T 0140
NAMETAB3[0,THISINDEX]:=T3; 20350000 T 0143
BOOLTYPE:=T3:=4; %*** "BOOLEAN" *** 20351000 T 0145
T1.FORM:=SYMBOLIC; TYPETAB1[4]:=T1; TYPETAB3[4]:=1; 20352000 T 0146
NEWNAME("7BOOLEA","N",0); T3.IDCLASS:=TYPES; 20353000 T 0150
NAMETAB3[0,THISINDEX]:=T3; 20354000 T 0153
CHARTYPE:=T3:=5; %*** "CHAR" *** 20355000 T 0155
T1.FORM:=CHAR; TYPETAB1[5]:=T1; TYPETAB3[5]:=63; 20356000 T 0157
NEWNAME("400CHAR",0,0); T3.IDCLASS:=TYPES; 20357000 T 0161
NAMETAB3[0,THISINDEX]:=T3; 20358000 T 0164
T3:=BOOLTYPE; T3.IDCLASS:=CONST; %*** "FALSE" *** 20359000 T 0177
NEWNAME("50FALSE",0,0); NAMETAB3[0,THISINDEX]:=T3; 20360000 T 0179
T3.INFO:=1; %*** "TRUE" *** 20361000 T 0182
NEWNAME("400TRUE",0,0); NAMETAB3[0,THISINDEX]:=T3; 20362000 T 0184
NILTYPE := 6; %*** TYPE OF "NIL" *** %602- 20363000 P 0187
T1.FORM := POINTERS; TYPETAB1[6] := T1; %602- 20364000 P 0188
EMPTYSET := 7; % %602- 20364500 C 0191
T1.FORM := SET; TYPETAB1[7] := T1; %602- 20365000 P 0192
NUMTYPES := 7; % %602- 20365500 C 0195
NEWNAME("6MAXINT",0,0); T3:=INTTYPE; %*** "MAXINT" *** 20366000 T 0196
T3.IDCLASS:=CONST; T3.INFO:=1024; 20367000 T 0198
NAMETAB3[0,THISINDEX]:=T3; 20368000 T 0201
NUMCONSTS:=1; CONSTTAB[1]:=MAXINT; 20369000 T 0203
NEWNAME("50PRT25",0,0); %*** "PRT25" *** %501- 20369100 C 0205
T3:=INTTYPE; T3.IDCLASS:=VAR; % GLOBAL INTEGER VARIABLE %501- 20369200 C 0206
NAMETAB3[0,THISINDEX] := T3; %501- 20369300 C 0209
20370000 T 0211
T3:=0; T3.IDCLASS:=PROC; %*** PROCEDURES *** 20371000 T 0211
FOR A:="3000GET", "3000NEW", "400PACK", "400PAGE", "3000PUT", 20372000 T 0213
"400READ", "6READLN", "50RESET", "6UNPACK", "50WRITE", %002- 20373000 P 0223
"6QQJZXL" DO %002- 20373500 C 0233
BEGIN 20374000 T 0236
NEWNAME(A,0,0); NAMETAB3[0,THISINDEX]:=T3; 20375000 T 0236
END; 20376000 T 0239
NEWNAME("7DISPOS","E",0); NAMETAB3[0,THISINDEX]:=T3; 20377000 T 0257
NEWNAME("7REWRIT","E",0); NAMETAB3[0,THISINDEX]:=T3; 20378000 T 0260
NEWNAME("7WRITEL","N",0); NAMETAB3[0,THISINDEX]:=T3; 20379000 T 0263
20380000 T 0266
T3.IDCLASS:=FUNC; %*** FUNCTIONS *** 20381000 T 0266
FOR A:="3000ABS", "6ARCTAN", "3000CHR", "3000COS", "3000EOF", 20382000 T 0268
"400EOLN", "3000EXP", "20000LN", "3000ODD", "400PRED", 20383000 T 0278
"400SUCC", "50ROUND", "3000SIN", "3000SQR", "400SQRT", 20384000 T 0288
"50TRUNC", "6CONCAT", "400TIME", "400DATE", "6IOTIME", 20385000 T 0298
"400USER", "3000ORD" 20386000 T 0308
DO BEGIN 20387000 T 0311
NEWNAME(A,0,0); NAMETAB3[0,THISINDEX]:=T3; 20388000 T 0313
END; 20389000 T 0316
NEWNAME("7CPUTIM","E",0); NAMETAB3[0,THISINDEX]:=T3; %514- 20390000 P 0342
NEWNAME("7WEEKDA","Y",0); NAMETAB3[0,THISINDEX]:=T3; 20391000 T 0345
20392000 T 0348
TEXTTYPE:=T3:=NUMTYPES:=NUMTYPES+1; %*** "TEXT" *** 20393000 T 0348
T1 := TEXTFILE; T1.STRUCT := 1; TYPETAB1[TEXTTYPE] := T1; % 20394000 T 0350
T3.IDCLASS := TYPES; % 20395000 T 0354
NEWNAME("400TEXT",0,0); NAMETAB3[0,THISINDEX]:=T3; 20396000 T 0356
T3:=TEXTTYPE; T3.IDCLASS:=VAR; %*** "INPUT" *** 20397000 T 0359
T3.EXTERNALFILE:=1; 20398000 T 0362
NEWNAME("50INPUT",0,0); INPUTFILE:=THISINDEX; 20399000 T 0363
NAMETAB3[0,THISINDEX]:=T3; 20400000 T 0365
NEWNAME("6OUTPUT",0,0); %*** "OUTPUT" *** 20401000 T 0367
NAMETAB3[0,THISINDEX]:=T3; OUTPUTFILE:=THISINDEX; 20402000 T 0369
NEWCARD; LISTOPTION:=CHECKOPTION:=TRUE; % DEFAULT %709- 20402100 C 0371
INSYMBOL; % ANALYSING FIRST CARD MAY CHANGE DEFAULT LIST OPTN 20402200 C 0373
IF LISTOPTION AND PAGECNT=0 THEN HEADING; % ON FIRST PAGE. %709- 20402300 C 0374
END OF INTIALIZED; 20403000 T 0376
17 IS 385 LONG, NEXT SEG 2
20404000 T 0075
20500000 T 0075
20501000 T 0075
%*** XREF ROUTINES *** 20502000 T 0075
%********************** 20503000 T 0075
20504000 T 0075
DEFINE XREFCARD=[16:17]#, 20505000 T 0075
XREFBLOCK=[26:10]#; 20506000 T 0075
REAL A0,B0,A1,B1,LASTA0,LASTA1; 20507000 T 0075
INTEGER NL,LASTBLOCK,A2,AX; 20508000 T 0075
20509000 T 0075
PROCEDURE NEWXREF(NAME1,NAME2,TABLE,DECL); 20510000 T 0075
VALUE NAME1,NAME2,TABLE,DECL; 20511000 T 0075
REAL NAME1,NAME2; 20512000 T 0075
INTEGER TABLE; 20513000 T 0075
BOOLEAN DECL; 20514000 T 0075
BEGIN 20515000 T 0075
DEFINE NEWSEGMENT = HERE #; %700- 20515100 C 0075
START OF SEGMENT ********** 20
NL:=NAME1.NAMELENGTH; 20516000 T 0000
IF NL<7 THEN NAME1:=0&NAME1[41:41:6]&NAME1[35:6×NL-1:6×NL] 20517000 T 0001
ELSE NAME2:=0&NAME2[35:6×(NL-6)-1:6×(NL-6)]; 20518000 T 0008
AX:=CARDCNT; AX.XREFBLOCK:=BLOCKTAB[TABLE]; 20519000 T 0015
IF DECL THEN AX := -AX; %002- 20520000 P 0017
WRITE(XREFFILE,*,NAME1,NAME2,AX); 20521000 T 0019
END OF NEWXREF; 20522000 T 0030
20 IS 31 LONG, NEXT SEG 2
20523000 T 0075
PROCEDURE XREFMAX(A); 20524000 T 0075
ARRAY A[0]; 20525000 T 0075
BEGIN 20526000 T 0075
A[0]:="AZZZZZZ"; A[1]:="ZZZZZZ"; A[2]:=9999999999; 20527000 T 0075
END OF XREFMAX; 20528000 T 0078
20529000 T 0082
20530000 T 0082
BOOLEAN PROCEDURE XREFCOMPARE(A,B); 20531000 T 0082
ARRAY A,B[0]; 20532000 T 0082
BEGIN 20533000 T 0082
DEFINE NEWSEGMENT = HERE #; %700- 20533100 C 0082
START OF SEGMENT ********** 21
A0:=A[0]; B0:=B[0]; A1:=A[1]; B1:=B[1]; 20534000 T 0000
XREFCOMPARE:= 20535000 T 0004
IF A0.[35:36]≠B0.[35:36] THEN A0.[35:36]<B0.[35:36] ELSE 20536000 T 0004
IF A1≠B1 THEN A1<B1 ELSE 20537000 T 0008
IF A0≠B0 THEN A0.NAMELENGTH<B0.NAMELENGTH ELSE 20538000 T 0011
ABS(A[2]) LEQ ABS(B[2]); %002- 20539000 P 0014
END OF XREFCOMPARE; 20540000 T 0016
21 IS 20 LONG, NEXT SEG 2
20541000 T 0082
% %002- 20541100 C 0082
% %002- 20541150 C 0082
% %002- 20541200 C 0082
BOOLEAN PROCEDURE XREFINPUT(A); %002- 20541250 C 0082
ARRAY A[0]; %002- 20541300 C 0082
BEGIN %002- 20541350 C 0082
LABEL EOF; %002- 20541400 C 0082
START OF SEGMENT ********** 22
INTEGER I; %002- 20541450 C 0000
% %002- 20541500 C 0000
READ(XREFFILE,3,XBUFF[*])[EOF]; %002- 20541550 C 0000
FOR I:=0,1,2 DO %002- 20541600 C 0005
A[I] := XBUFF[I]; %002- 20541650 C 0011
IF FALSE THEN EOF: BEGIN %002- 20541700 C 0013
CLOSE(XREFFILE,RELEASE); %002- 20541750 C 0015
XINB := TRUE; %002- 20541800 C 0016
END; %002- 20541850 C 0017
XREFINPUT := XINB; %002- 20541900 C 0017
% %002- 20541950 C 0018
END OF XREFINPUT; %002- 20541960 C 0018
22 IS 24 LONG, NEXT SEG 2
20542000 T 0082
PROCEDURE PRINTXREF(FINIS,A); 20543000 T 0082
VALUE FINIS; BOOLEAN FINIS; 20544000 T 0082
ARRAY A[0]; 20545000 T 0082
BEGIN 20546000 T 0082
DEFINE NEWSEGMENT = HERE #; %700- 20546100 C 0082
START OF SEGMENT ********** 23
IF FINIS THEN 20547000 T 0000
BEGIN 20548000 T 0000
WRITE(LINE, 17,XREFLINE[*]); %708- 20549000 P 0000
LOCK( LINE, * ); % & CRUNCH %708- 20550000 P 0005
CLOSE(XREFFILE); 20551000 T 0006
END 20552000 T 0008
ELSE 20553000 T 0008
BEGIN 20554000 T 0008
A0:=A[0]; A1:=A[1]; A2:=A[2]; 20555000 T 0009
IF A0=LASTA0 AND A1=LASTA1 AND A2.XREFBLOCK=LASTBLOCK THEN 20556000 T 0012
BEGIN 20557000 T 0015
IF NUMXREF=15 THEN 20558000 T 0015
BEGIN 20559000 T 0016
WRITE(LINE, 17,XREFLINE[*]); LINECNT:=LINECNT+1; %708- 20560000 P 0017
IF LINECNT>LINESPERPAGE THEN HEADING; 20561000 T 0022
XREFPNT:=POINTER(XREFLINE[*]); NUMXREF:=0; 20562000 T 0024
REPLACE XREFPNT BY " " FOR 17 WORDS; XREFPNT:=XREFPNT+24; 20563000 T 0026
END; 20564000 T 0032
REPLACE XREFPNT BY A2.XREFCARD FOR 5 DIGITS; 20565000 T 0032
XREFPNT:=XREFPNT+7; NUMXREF:=NUMXREF+1; 20566000 T 0036
END ELSE 20567000 T 0040
IF A2<0 THEN 20568000 T 0040
BEGIN 20569000 T 0042
A2 := -A2; %002- 20570000 P 0042
WRITE(LINE, 17,XREFLINE[*]); LINECNT:=LINECNT+1; %708- 20571000 P 0043
IF LINECNT>LINESPERPAGE THEN HEADING; 20572000 T 0049
XREFPNT:=POINTER(XREFLINE[*]); NUMXREF:=0; 20573000 T 0050
REPLACE XREFPNT BY " " FOR 17 WORDS; 20574000 T 0053
TEXT[0]:=A0.[35:36]; LASTA0:=A0; 20575000 T 0056
REPLACE XREFPNT BY TEXTPNT+1 FOR A0.NAMELENGTH; 20576000 T 0059
TEXT[0]:=LASTA1:=A1; 20577000 T 0064
IF A0.NAMELENGTH>6 THEN 20578000 T 0066
REPLACE XREFPNT+6 BY TEXTPNT+1 FOR A0.NAMELENGTH-6; 20579000 T 0067
REPLACE XREFPNT+17 BY A2.XREFCARD FOR 5 DIGITS; 20580000 T 0075
XREFPNT:=XREFPNT+24; LASTBLOCK:=A2.XREFBLOCK; 20581000 T 0081
END; 20582000 T 0085
END; 20583000 T 0085
END OF PRINTXREF; 20584000 T 0085
23 IS 86 LONG, NEXT SEG 2
20585000 T 0082
20800000 T 0082
20801000 T 0082
PROCEDURE CHECKTYPES( LEFTTYPE, RIGHTTYPE ); %700- 20802000 P 0082
VALUE LEFTTYPE, RIGHTTYPE; INTEGER LEFTTYPE, RIGHTTYPE; %700- 20803000 P 0082
BEGIN %700- 20804000 P 0082
REAL TT1, TT2; INTEGER F1, F2, LT, RT; %700- 20805000 P 0082
START OF SEGMENT ********** 24
IF LEFTTYPE>0 AND RIGHTTYPE>0 THEN 20806000 T 0000
IF LEFTTYPE≠RIGHTTYPE THEN 20807000 T 0001
BEGIN 20808000 T 0003
LT:=LEFTTYPE; RT:=RIGHTTYPE; 20809000 T 0003
TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20810000 T 0005
F1:=TT1.FORM; F2:=TT2.FORM; 20811000 T 0007
IF LT≠REALTYPE OR F2≠NUMERIC THEN 20812000 T 0009
IF(F1 NEQ SET OR RT NEQ EMPTYSET) % %600- 20813000 P 0011
AND % %600- 20813050 C 0013
(F2 NEQ SET OR LT NEQ EMPTYSET) THEN % %600- 20813100 C 0013
IF(F1 NEQ POINTERS OR RT NEQ NILTYPE) % %600- 20814000 P 0015
AND % %600- 20814050 C 0017
(F2 NEQ POINTERS OR LT NEQ NILTYPE) THEN % %600- 20814100 C 0017
BEGIN 20815000 T 0019
IF F1=SET AND F2=SET THEN 20816000 T 0020
BEGIN 20817000 T 0022
LT:=TT1.SETTYPE; RT:=TT2.SETTYPE; 20818000 T 0022
TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20819000 T 0025
F1:=TT1.FORM; F2:=TT2.FORM; 20820000 T 0027
END; 20821000 T 0029
IF F1=POINTERS AND F2=POINTERS THEN 20822000 T 0029
BEGIN 20823000 T 0031
LT:=TT1.POINTTYPE; RT:=TT2.POINTTYPE; 20824000 T 0031
TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20825000 T 0034
F1:=TT1.FORM; F2:=TT2.FORM; 20826000 T 0036
END; 20827000 T 0038
WHILE F1=SUBTYPE DO 20828000 T 0038
BEGIN LT:=TT1.MAINTYPE; TT1:=TYPETAB1[LT]; F1:=TT1.FORM END; 20829000 T 0040
WHILE F2=SUBTYPE DO 20830000 T 0044
BEGIN RT:=TT2.MAINTYPE; TT2:=TYPETAB1[RT]; F2:=TT2.FORM END; 20831000 T 0046
IF LT>0 AND RT>0 THEN 20832000 T 0050
IF LT≠RT THEN 20833000 T 0052
IF F1≠NUMERIC OR F2≠NUMERIC THEN 20834000 T 0053
IF F1≠CHAR OR F2≠CHAR THEN ERROR(17); 20835000 T 0055
END; 20836000 T 0059
END; 20837000 T 0059
END OF CHECKTYPES; %700- 20838000 P 0059
24 IS 64 LONG, NEXT SEG 2
20839000 T 0082
20840000 T 0082
INTEGER FILENAME; 20841000 T 0082
BOOLEAN LPARFOUND,SAVEXREFOPT; %002- 20842000 P 0082
20843000 T 0082
PROCEDURE FILEPARAM( DEFAULTFILE ); %*** CHECKS THE FIRST PARAMETER 20844000 P 0082
VALUE DEFAULTFILE; INTEGER DEFAULTFILE;%*** TO SEE IF IT IS A FILE.%700- 20844100 C 0082
BEGIN DEFINE RESULTS = FILENAME & LPARFOUND #; %700- 20845000 P 0082
START OF SEGMENT ********** 25
INSYMBOL; FILENAME:=CURTYPE:=0; 20846000 T 0000
LPARFOUND:=CURSY=LPAR; 20847000 T 0001
SAVEXREFOPT := XREFOPTION; XREFOPTION := FALSE; %002- 20847500 C 0003
IF LPARFOUND THEN 20848000 T 0004
BEGIN 20849000 T 0004
INSYMBOL; 20850000 T 0005
IF CURSY=IDENTIFIER THEN 20851000 T 0005
BEGIN 20852000 T 0006
SEARCH; 20853000 T 0007
IF FOUND THEN 20854000 T 0007
BEGIN 20855000 T 0007
IF THISID.IDCLASS=VAR THEN 20856000 T 0008
BEGIN 20857000 T 0009
CURTYPE:=THISID.TYPE; 20858000 T 0010
IF TYPETAB1[CURTYPE].FORM≥FILES THEN 20859000 T 0011
BEGIN 20860000 T 0012
FILENAME:=1000×THISLEVEL+THISINDEX; 20861000 T 0013
IF SAVEXREFOPT THEN NEWXREF(CURNAME1,CURNAME2,THISLEVEL, 20861500 C 0015
FALSE); %002- 20861550 C 0016
INSYMBOL; 20862000 T 0017
END END END END; 20863000 T 0017
IF SYMKIND[CURSY]=TERMINAL THEN ERROR(46); 20864000 T 0017
END; 20865000 T 0020
IF FILENAME=0 THEN FILENAME:=DEFAULTFILE; 20866000 T 0020
IF (FILENAME=INPUTFILE AND NOT INPUTDECL) OR 20867000 T 0022
(FILENAME=OUTPUTFILE AND NOT OUTPUTDECL) THEN ERROR(96); 20868000 T 0023
XREFOPTION := SAVEXREFOPT; %002- 20868500 C 0026
END OF FILEPARAM; %700- 20869000 P 0027
25 IS 28 LONG, NEXT SEG 2
20870000 T 0082
20871000 T 0082
REAL CURVAL; INTEGER CURLENGTH; %700- 20872000 P 0082
%700- 20873000 P 0082
PROCEDURE CONSTANT( CVAL, CTYPE ); %700- 20874000 P 0082
REAL CVAL; INTEGER CTYPE; %700- 20875000 P 0082
BEGIN %700- 20876000 P 0082
INTEGER TFORM; BOOLEAN SIGNED, NEGATIVE; %700- 20876100 C 0082
START OF SEGMENT ********** 26
IF CURSY=MINUS OR CURSY=PLUS THEN 20877000 T 0000
BEGIN SIGNED:=TRUE; NEGATIVE:=CURSY=MINUS; 20878000 T 0001
INSYMBOL; 20879000 T 0004
END ELSE SIGNED:=NEGATIVE:=FALSE; 20880000 T 0004
IF CURSY=INTCONST THEN 20881000 T 0006
BEGIN CTYPE:=INTTYPE; 20882000 T 0007
CVAL:=IF NEGATIVE THEN -CURVAL ELSE CURVAL; 20883000 T 0008
END ELSE 20884000 T 0011
IF CURSY=CHARCONST THEN 20885000 T 0011
BEGIN IF SIGNED THEN ERROR(29); 20886000 T 0012
CTYPE:=CHARTYPE; CVAL:=CURVAL; 20887000 T 0014
END ELSE 20888000 T 0016
IF CURSY=REALCONST THEN 20889000 T 0016
BEGIN CTYPE:=REALTYPE; 20890000 T 0018
CVAL:=IF NEGATIVE THEN -CURVAL ELSE CURVAL; 20891000 T 0019
END ELSE 20892000 T 0022
IF CURSY=ALFACONST THEN 20893000 T 0022
BEGIN IF SIGNED THEN ERROR(29); 20894000 T 0023
IF CURLENGTH>7 THEN ERROR(41); 20895000 T 0025
CTYPE:=ALFATYPE; CVAL:=CURVAL; 20896000 T 0027
END ELSE 20897000 T 0029
IF CURSY=IDENTIFIER THEN 20898000 T 0029
BEGIN 20899000 T 0030
SEARCH; 20900000 T 0031
IF FOUND THEN 20901000 T 0031
BEGIN 20902000 T 0032
IF THISID.IDCLASS=CONST AND NOT BOOLEAN(THISID.FORMAL) THEN 20903000 T 0032
BEGIN 20904000 T 0035
IF TYPETAB1[THISID.TYPE].FORM≤ALFA THEN 20905000 T 0035
BEGIN 20906000 T 0037
CVAL:=THISID.INFO; 20907000 T 0038
IF CVAL>1023 THEN CVAL:=CONSTTAB[CVAL-1023]; 20908000 T 0039
CTYPE:=THISID.TYPE; 20909000 T 0042
IF SIGNED THEN 20910000 T 0044
BEGIN 20911000 T 0044
TFORM:=TYPETAB1[THISID.TYPE].FORM; 20912000 T 0044
IF TFORM≠NUMERIC AND TFORM≠FLOATING THEN ERROR(29) ELSE 20913000 T 0046
IF NEGATIVE THEN CVAL:=-CVAL; 20914000 T 0049
END; 20915000 T 0052
END ELSE BEGIN ERROR(48); CVAL:=CTYPE:=0 END; 20916000 T 0052
END ELSE BEGIN ERROR(32); CVAL:=CTYPE:=0 END; 20917000 T 0055
END ELSE BEGIN ERROR(1); CVAL:=CTYPE:=0 END; 20918000 T 0058
END ELSE BEGIN ERROR(32); CVAL:=CTYPE:=0 END; 20919000 T 0061
INSYMBOL; 20920000 T 0064
END OF CONSTANT; %700- 20921000 P 0064
26 IS 68 LONG, NEXT SEG 2
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 30001000 T 0082
% % 30002000 T 0082
% % 30003000 T 0082
% % 30004000 T 0082
% PART 3: THE SCANNER. % 30005000 T 0082
% ------------ % 30006000 T 0082
% % 30007000 T 0082
% % 30008000 T 0082
% % 30009000 T 0082
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 30010000 T 0082
30011000 T 0082
% INTERNAL INTERNAL SYMBOL 30012000 T 0082
% SYMBOL NUMBER NAME KIND 30013000 T 0082
% 30014000 T 0082
% IDENTIFIER 1 IDENTIFIER MIDDLE 30015000 T 0082
% 122 2 INTCONST MIDDLE 30016000 T 0082
% 2.5 3 REALCONST MIDDLE 30017000 T 0082
% "ABCD" 4 ALFACONST MIDDLE 30018000 T 0082
% "C" 5 CHARCONST MIDDLE 30019000 T 0082
% NOT 6 NOTSY MIDDLE 30020000 T 0082
% * 7 ASTERISK MIDDLE 30021000 T 0082
% / 8 SLASH MIDDLE 30022000 T 0082
% & AND 9 ANDSY MIDDLE 30023000 T 0082
% DIV 10 DIVSY MIDDLE 30024000 T 0082
% MOD 11 MODSY MIDDLE 30025000 T 0082
% + 12 PLUS MIDDLE 30026000 T 0082
% - 13 MINUS MIDDLE 30027000 T 0082
% OR 14 ORSY MIDDLE 30028000 T 0082
% < LSS 15 LSSSY MIDDLE 30029000 T 0082
% <= LEQ ≤ 16 LEQSY MIDDLE 30030000 T 0082
% >= GEQ ≥ 17 GEQSY MIDDLE 30031000 T 0082
% > GTR 18 GTRSY MIDDLE 30032000 T 0082
% <> NEQ ≠ 19 NEQSY MIDDLE 30033000 T 0082
% = EQL 30 EQLSY MIDDLE 30034000 T 0082
% IN 21 INSY MIDDLE 30035000 T 0082
% ( 22 LPAR MIDDLE 30036000 T 0082
% ) 23 RPAR MIDDLE 30037000 T 0082
% [ 24 LBRACKET MIDDLE 30038000 T 0082
% ] 25 RBRACKET MIDDLE 30039000 T 0082
% .. 26 DOUBLEDOT MIDDLE 30040000 T 0082
% , 27 COMMA MIDDLE 30041000 T 0082
% ; 28 SEMICOLON TERMINAL 30042000 T 0082
% . 29 DOT MIDDLE 30043000 T 0082
% ← @ 30 ARROW MIDDLE 30044000 T 0082
% : 31 COLON MIDDLE 30045000 T 0082
% := 32 ASSIGNSY MIDDLE 30046000 T 0082
% BEGIN 33 BEGINSY INITIAL 30047000 T 0082
% END 34 ENDSY TERMINAL 30048000 T 0082
% IF 35 IFSY INITIAL 30049000 T 0082
% THEN 36 THENSY MIDDLE 30050000 T 0082
% ELSE 37 ELSESY TERMINAL 30051000 T 0082
% CASE 38 CASESY INITIAL 30052000 T 0082
% OF 39 OFSY MIDDLE 30053000 T 0082
% REPEAT 40 REPEATSY INITIAL 30054000 T 0082
% UNTIL 41 UNTILSY TERMINAL 30055000 T 0082
% WHILE 42 WHILESY INITIAL 30056000 T 0082
% DO 43 DOSY MIDDLE 30057000 T 0082
% FOR 44 FORSY INITIAL 30058000 T 0082
% TO 45 TOSY MIDDLE 30059000 T 0082
% DOWNTO 46 DOWNTOSY MIDDLE 30060000 T 0082
% GOTO 47 GOTOSY INITIAL 30061000 T 0082
% NIL 48 NILSY MIDDLE 30062000 T 0082
% TYPE 49 TYPESY INITIAL 30063000 T 0082
% ARRAY 50 ARRAYSY MIDDLE 30064000 T 0082
% RECORD 51 RECORDSY MIDDLE 30065000 T 0082
% FILE 52 FILESY MIDDLE 30066000 T 0082
% SET 53 SETSY MIDDLE 30067000 T 0082
% CONST 54 CONSTSY INITIAL 30068000 T 0082
% VAR 55 VARSY INITIAL 30069000 T 0082
% LABEL 56 LABELSY INITIAL 30070000 T 0082
% FUNCTION 57 FUNCSY INITIAL 30071000 T 0082
% PROCEDURE 58 PROCSY INITIAL 30072000 T 0082
% WITH 59 WITHSY INITIAL 30073000 T 0082
% PROGRAM 60 PROGRAMSY INITIAL 30074000 T 0082
% PACKED 61 PACKEDSY MIDDLE 30075000 T 0082
% ASSERT 62 ASSERTSY INITIAL %002- 30075500 C 0082
30076000 T 0082
30077000 T 0082
DEFINE BLANK=48#, EQUAL=61#, QUOTES=63#, DOLLAR=42#, 30078000 T 0082
LETTER(C)=(17≤C AND C≤25)OR(33≤C AND C≤41)OR(50≤C AND C≤57)#, 30079000 T 0082
ALFANUM(C)=(LETTER(C) OR C≤9)#; 30080000 T 0082
30081000 T 0082
ALPHA C, CX; %( CURNAME1 & CURNAME2 MOVED TO 20205000 ) %700- 30083000 P 0082
INTEGER LASTCHARPOS; %( CURVAL, CURLENGTH MOVED TO 20872000 ) %700- 30084000 P 0082
BOOLEAN FINIS; 30085000 T 0082
30086000 T 0082
PROCEDURE INSYMBOL; %*** IDENTIFIES THE NEXT SYMBOL ******%700- 30087000 P 0082
BEGIN %700- 30087100 C 0082
%700- 30087200 C 0082
PROCEDURE NEXTCHAR; %*** GETS THE NEXT CHARACTER. %700- 30088000 P 0082
START OF SEGMENT ********** 27
IF CHARCNT=0 THEN C:=BLANK ELSE 30089000 T 0000
BEGIN 30090000 T 0002
REPLACE CHARPNT BY CARDPNT:CARDPNT FOR 1; 30091000 T 0002
C:=CH[0]; CHARCNT:=CHARCNT-1; 30092000 T 0005
END OF NEXTCHAR; %700- 30093000 P 0007
30094000 T 0007
INTEGER SCALE,EXP; 30099000 T 0007
DEFINE T1 = EXP #; % USED AT 30178000 %700- 30099100 C 0007
BOOLEAN NEGEXP; 30100000 T 0007
LABEL START,OVERFLOW; 30101000 T 0007
30102000 T 0007
START: 30103000 T 0007
IF C=BLANK THEN 30104000 T 0008
BEGIN SCAN CARDPNT:CARDPNT FOR CHARCNT:CHARCNT WHILE =" "; 30105000 T 0008
IF CHARCNT=0 THEN BEGIN NEWCARD; GO TO START END; 30106000 T 0011
NEXTCHAR; 30107000 T 0013
END; 30108000 T 0014
IF LETTER(C) THEN 30109000 T 0014
BEGIN 30110000 T 0020
CURLENGTH:=1; CURNAME1:=C; CURNAME2:=0; 30111000 T 0020
NEXTCHAR; 30112000 T 0023
WHILE ALFANUM(C) AND CURLENGTH<6 DO 30113000 T 0024
BEGIN CURNAME1:=C&CURNAME1[35:29:30]; 30114000 T 0032
CURLENGTH:=CURLENGTH+1; NEXTCHAR; 30115000 T 0034
END; 30116000 T 0036
IF CURLENGTH=6 THEN 30117000 T 0036
BEGIN 30118000 T 0037
WHILE ALFANUM(C) AND CURLENGTH<12 DO 30119000 T 0038
BEGIN CURNAME2:=C&CURNAME2[35:29:30]; 30120000 T 0046
CURLENGTH:=CURLENGTH+1; NEXTCHAR; 30121000 T 0048
END; 30122000 T 0050
WHILE ALFANUM(C) DO NEXTCHAR; 30123000 T 0050
END; 30124000 T 0059
CURNAME1.NAMELENGTH:=CURLENGTH; 30125000 T 0059
CASE CURLENGTH OF 30126000 T 0061
BEGIN ; 30127000 T 0061
CURSY:=IDENTIFIER; 30128000 T 0062
CURSY:=IF CURNAME1="20000IF" THEN IFSY ELSE 30129000 T 0063
IF CURNAME1="20000DO" THEN DOSY ELSE 30130000 T 0065
IF CURNAME1="20000TO" THEN TOSY ELSE 30131000 T 0067
IF CURNAME1="20000OR" THEN ORSY ELSE 30132000 T 0069
IF CURNAME1="20000OF" THEN OFSY ELSE 30133000 T 0071
IF CURNAME1="20000IN" THEN INSY ELSE IDENTIFIER; 30134000 T 0073
CURSY:=IF CURNAME1="3000END" THEN ENDSY ELSE 30135000 T 0076
IF CURNAME1="3000FOR" THEN FORSY ELSE 30136000 T 0078
IF CURNAME1="3000DIV" THEN DIVSY ELSE 30137000 T 0080
IF CURNAME1="3000MOD" THEN MODSY ELSE 30138000 T 0082
IF CURNAME1="3000NIL" THEN NILSY ELSE 30139000 T 0084
IF CURNAME1="3000AND" THEN ANDSY ELSE 30140000 T 0086
IF CURNAME1="3000NOT" THEN NOTSY ELSE 30141000 T 0088
IF CURNAME1="3000VAR" THEN VARSY ELSE 30142000 T 0090
IF CURNAME1="3000SET" THEN SETSY ELSE 30143000 T 0092
IF CURNAME1="3000LSS" THEN LSSSY ELSE 30144000 T 0094
IF CURNAME1="3000LEQ" THEN LEQSY ELSE 30145000 T 0096
IF CURNAME1="3000GEQ" THEN GEQSY ELSE 30146000 T 0098
IF CURNAME1="3000GTR" THEN GTRSY ELSE 30147000 T 0100
IF CURNAME1="3000NEQ" THEN NEQSY ELSE 30148000 T 0102
IF CURNAME1="3000EQL" THEN EQLSY ELSE IDENTIFIER; 30149000 T 0104
CURSY:=IF CURNAME1="400THEN" THEN THENSY ELSE 30150000 T 0108
IF CURNAME1="400ELSE" THEN ELSESY ELSE 30151000 T 0110
IF CURNAME1="400WITH" THEN WITHSY ELSE 30152000 T 0112
IF CURNAME1="400CASE" THEN CASESY ELSE 30153000 T 0114
IF CURNAME1="400GOTO" THEN GOTOSY ELSE 30154000 T 0116
IF CURNAME1="400TYPE" THEN TYPESY ELSE 30155000 T 0118
IF CURNAME1="400FILE" THEN FILESY ELSE IDENTIFIER; 30156000 T 0120
CURSY:=IF CURNAME1="50BEGIN" THEN BEGINSY ELSE 30157000 T 0123
IF CURNAME1="50WHILE" THEN WHILESY ELSE 30158000 T 0125
IF CURNAME1="50UNTIL" THEN UNTILSY ELSE 30159000 T 0127
IF CURNAME1="50ARRAY" THEN ARRAYSY ELSE 30160000 T 0129
IF CURNAME1="50CONST" THEN CONSTSY ELSE 30161000 T 0131
IF CURNAME1="50LABEL" THEN LABELSY ELSE IDENTIFIER; 30162000 T 0133
CURSY:=IF CURNAME1="6REPEAT" THEN REPEATSY ELSE 30163000 T 0136
IF CURNAME1="6DOWNTO" THEN DOWNTOSY ELSE 30164000 T 0138
IF CURNAME1="6RECORD" THEN RECORDSY ELSE 30165000 T 0140
IF CURNAME1="6ASSERT" THEN ASSERTSY ELSE %002- 30165500 C 0142
IF CURNAME1="6PACKED" THEN PACKEDSY ELSE IDENTIFIER; 30166000 T 0144
CURSY:=IF CURNAME1="7PROGRA" AND CURNAME2="M" THEN PROGRAMSY 30167000 T 0147
ELSE IDENTIFIER; 30168000 T 0150
CURSY:=IF CURNAME1="8FUNCTI" AND CURNAME2="ON" THEN FUNCSY 30169000 T 0152
ELSE IDENTIFIER; 30170000 T 0154
CURSY:=IF CURNAME1="9PROCED" AND CURNAME2="URE" THEN PROCSY 30171000 T 0156
ELSE IDENTIFIER; 30172000 T 0158
CURSY:=IDENTIFIER; % 10 CHARACTERS. 30173000 T 0160
CURSY:=IDENTIFIER; % 11 CHARACTERS. 30174000 T 0161
CURSY:=IDENTIFIER; % 12 CHARACTERS. 30175000 T 0163
END OF CASE; 30176000 T 0164
START OF SEGMENT ********** 28
28 IS 14 LONG, NEXT SEG 27
IF RESWORDOPTION AND CURSY≠IDENTIFIER THEN 30177000 T 0209
BEGIN T1 := CARDLENGTH-CHARCNT-CURLENGTH-1; %506- 30178000 P 0210
RESWORDOPTION := BOOLEAN(3); % SET RESWORDPRESENT BIT 30179000 P 0213
REPLACE XLINEPNT+T1 BY CARDPNT-(CURLENGTH+1) 30180000 T 0214
FOR CURLENGTH+REAL(CHARCNT=0); %506- 30181000 P 0218
END; 30182000 T 0222
END OF LETTER ELSE 30183000 T 0222
IF C≤9 THEN 30184000 T 0222
BEGIN 30185000 T 0223
CURVAL:=C; CURSY:=INTCONST; 30186000 T 0224
NEXTCHAR; 30187000 T 0225
WHILE C≤9 DO BEGIN CURVAL:=10×CURVAL+C; NEXTCHAR END; 30188000 T 0226
IF C="." THEN 30189000 T 0231
BEGIN 30190000 T 0232
NEXTCHAR; 30191000 T 0232
IF C≤9 THEN 30192000 T 0233
BEGIN CURSY:=REALCONST; 30193000 T 0234
DO BEGIN CURVAL:=10×CURVAL+C; 30194000 T 0235
SCALE:=SCALE-1; NEXTCHAR; 30195000 T 0237
END UNTIL C>9; 30196000 T 0240
END ELSE IF C="." THEN C:=64 % SPECIAL MARK FOR ".." 30197000 T 0241
ELSE ERROR(4); 30198000 T 0243
END; 30199000 T 0245
IF C="E" THEN 30200000 T 0245
BEGIN 30201000 T 0245
CURSY:=REALCONST; NEXTCHAR; 30202000 T 0246
IF C="+" OR C="-" THEN BEGIN NEGEXP:=C="-"; NEXTCHAR END; 30203000 T 0248
IF C≤9 THEN 30204000 T 0252
BEGIN EXP:=C; NEXTCHAR; 30205000 T 0253
WHILE C≤9 DO BEGIN EXP:=10×EXP+C; NEXTCHAR END; 30206000 T 0255
IF NEGEXP THEN EXP:=-EXP; 30207000 T 0260
END ELSE ERROR(4); 30208000 T 0262
SCALE:=SCALE+EXP; 30209000 T 0263
END; 30210000 T 0264
IF CURSY=REALCONST THEN 30211000 T 0264
BEGIN 30212000 T 0265
REALOVERFLOW:=OVERFLOW; 30213000 T 0266
CURVAL:=CURVAL×10*SCALE; 30214000 T 0267
REALOVERFLOW:=0; 30215000 T 0271
END ELSE 30216000 T 0271
IF CURVAL>MAXINT THEN 30217000 T 0271
BEGIN 30218000 T 0273
OVERFLOW: ERROR(14); CURVAL:=0; REALOVERFLOW:=0; 30219000 T 0273
END; 30220000 T 0276
END OF DIGIT ELSE 30221000 T 0276
IF C=QUOTES THEN 30222000 T 0276
BEGIN 30223000 T 0278
CURSY:=ALFACONST; CURLENGTH:=0; NEXTCHAR; 30224000 T 0279
FINIS:=FALSE; 30225000 T 0281
DO BEGIN 30226000 T 0282
IF C=QUOTES THEN BEGIN NEXTCHAR; FINIS:=C≠QUOTES END ELSE 30227000 T 0283
IF CHARCNT=0 THEN BEGIN ERROR(6); FINIS:=TRUE END; 30228000 T 0286
IF NOT FINIS THEN 30229000 T 0289
BEGIN 30230000 T 0290
REPLACE STRINGPNT+CURLENGTH BY CHARPNT FOR 1; 30231000 T 0290
CURLENGTH:=CURLENGTH+1; 30232000 T 0295
NEXTCHAR; 30233000 T 0296
END END UNTIL FINIS; 30234000 T 0297
IF CURLENGTH=0 THEN ERROR(4) ELSE 30235000 T 0298
IF CURLENGTH=1 THEN 30236000 T 0300
BEGIN CURSY:=CHARCONST; 30237000 T 0301
REPLACE CHARPNT BY STRINGPNT FOR 1; CURVAL:=CH[0]; 30238000 T 0303
END ELSE 30239000 T 0306
IF CURLENGTH≤7 THEN 30240000 T 0306
BEGIN TEXT[0]:=" "; 30241000 T 0308
REPLACE TEXTPNT BY STRINGPNT FOR CURLENGTH; 30242000 T 0309
CURVAL:=TEXT[0]; 30243000 T 0312
END; 30244000 T 0313
END OF STRINGS ELSE 30245000 T 0313
BEGIN 30246000 T 0313
CURSY:=SYMBOL[C]; NEXTCHAR; 30247000 T 0315
IF CURSY=COLON AND C=EQUAL THEN 30248000 T 0317
BEGIN CURSY:=ASSIGNSY; NEXTCHAR END ELSE 30249000 T 0318
IF CURSY=DOT AND C="." THEN 30250000 T 0321
BEGIN CURSY:=DOUBLEDOT; NEXTCHAR END ELSE 30251000 T 0323
IF CURSY=LSSSY AND C=EQUAL THEN 30252000 T 0325
BEGIN CURSY:=LEQSY; NEXTCHAR END ELSE 30253000 T 0327
IF CURSY=LSSSY AND C=">" THEN 30254000 T 0330
BEGIN CURSY:=NEQSY; NEXTCHAR END ELSE 30255000 T 0332
IF CURSY=GTRSY AND C=EQUAL THEN 30256000 T 0334
BEGIN CURSY:=GEQSY; NEXTCHAR END ELSE 30257000 T 0336
IF CURSY=LPAR AND C="*" THEN 30258000 T 0339
BEGIN % *** COMMENT *** 30259000 T 0341
NEXTCHAR; 30260000 T 0341
IF C=DOLLAR THEN % DOLLAR INDICATES COMPILER OPTIONS. 30261000 T 0342
BEGIN DEFINE NEWSEGMENT = HERE #; %700- 30261100 C 0343
START OF SEGMENT ********** 29
DO BEGIN 30262000 T 0000
NEXTCHAR; CX:=C; NEXTCHAR; 30263000 T 0000
IF CX="L" THEN IF C=1 THEN %516- 30264000 P 0002
IF LISTOPTION THEN HEADING ELSE %516- 30264500 C 0004
ELSE LISTOPTION := C="+" ELSE %713- 30265000 P 0006
IF CX="R" THEN RESWORDOPTION:=C="+" ELSE 30266000 T 0008
IF CX="C" THEN CHECKOPTION:=C="+" ELSE 30267000 T 0011
IF CX="D" THEN DUMPOPTION:=C="+" ELSE 30268000 T 0014
IF CX="X" THEN XREFOPTION:=C="+" ELSE 30269000 T 0017
IF CX="A" THEN 30270000 T 0020
IF C="+" THEN WRITE(PASCALGOL,ALIST) 30271000 T 0022
ELSE WRITE(PASCALGOL,NOALIST) ELSE 30272000 T 0026
IF CX="T" THEN 30273000 T 0030
BEGIN LASTCHARPOS := CHARCNT - CARDLENGTH; 30274000 T 0031
CARDLENGTH:=10×C; 30275000 T 0033
NEXTCHAR; CARDLENGTH:=CARDLENGTH+C; 30276000 T 0034
IF CARDLENGTH≤9 OR CARDLENGTH>80 THEN 30277000 T 0036
BEGIN ERROR(14); CARDLENGTH:=72 END; 30278000 T 0038
CHARCNT:=MAX(0,LASTCHARPOS+CARDLENGTH-1); 30279000 T 0040
END% %002- 30280000 P 0044
% %002- 30280025 C 0044
% %002- 30280050 C 0044
% THE FOLLOWING LINES DECODE ANY OCCURRENCE OF THE "S" OPTION AND 30280075 C 0044
% SETS THE GLOBAL INTEGER VARIABLE "SAVEFACTOR" WHICH CONTROLS THE %002- 30280100 C 0044
% TYPE OF COMPILATION INITIATED BY THE ZIP. THERE ARE THREE LEGAL FORMS 30280125 C 0044
% OF THE "S" OPTION AS FOLLOWS.- %002- 30280150 C 0044
% %002- 30280175 C 0044
% "S-" WILL GIVE NO ZIP IE. PASCAL SYNTAX CHECK ONLY %002- 30280200 C 0044
% "S+" WILL GIVE A ZIP FOR COMPILE AND GO %002- 30280225 C 0044
% "S??" WILL GIVE A ZIP FOR COMPILE TO LIBRARY %002- 30280250 C 0044
% WHERE ?? IS THE TWO DIGIT DECIMAL SAVE %002- 30280275 C 0044
% CONSTANT GIVEN THE OBJECT CODE FILE %002- 30280300 C 0044
% NB. IF THE SAVE CONSTANT IS TO BE %002- 30280325 C 0044
% LESS THAN 10 THE FIRST DIGIT %002- 30280350 C 0044
% MUST BE INCLUDED IE. A "0". %002- 30280375 C 0044
% %002- 30280400 C 0044
% %002- 30280425 C 0044
ELSE %002- 30280450 C 0044
IF CX="S" THEN %002- 30280475 C 0044
BEGIN %002- 30280500 C 0045
IF C="-" THEN SAVEFACTOR:=-1 ELSE %002- 30280525 C 0046
IF C="+" THEN SAVEFACTOR:= 0 ELSE %002- 30280550 C 0048
IF C LEQ 9 THEN %002- 30280575 C 0051
BEGIN %002- 30280600 C 0052
SAVEFACTOR := 10 × C; NEXTCHAR; %002- 30280625 C 0052
SAVEFACTOR := SAVEFACTOR + C; %002- 30280650 C 0055
IF C GTR 9 THEN ERROR(100); %002- 30280675 C 0056
END %002- 30280700 C 0058
ELSE %002- 30280720 C 0058
BEGIN %002- 30280735 C 0058
ERROR(100); %002- 30280750 C 0058
SAVEFACTOR := 7; %002- 30280765 C 0059
END; %002- 30280780 C 0060
END %713- 30280800 C 0060
ELSE ERROR(102); %713- 30280810 C 0060
% %002- 30280825 C 0061
% %002- 30280850 C 0061
% %002- 30280875 C 0061
NEXTCHAR; 30281000 T 0061
END UNTIL C≠","; 30282000 T 0062
IF LISTOPTION THEN IF PAGECNT=0 THEN HEADING; % ON FIRST PAGE 30282100 C 0063
END NEWSEGEMENT; %700- 30282200 C 0066
29 IS 70 LONG, NEXT SEG 27
FINIS:=FALSE; 30283000 T 0345
DO BEGIN 30284000 T 0345
IF C≠"*" THEN 30285000 T 0346
SCAN CARDPNT:CARDPNT FOR CHARCNT:CHARCNT UNTIL ="*"; 30286000 T 0346
IF CHARCNT=0 THEN NEWCARD ELSE 30287000 T 0349
BEGIN NEXTCHAR; 30288000 T 0351
WHILE C="*" DO NEXTCHAR; 30289000 T 0352
FINIS:=C=")"; 30290000 T 0355
END END UNTIL FINIS; 30291000 T 0357
NEXTCHAR; 30292000 T 0357
GO TO START; 30293000 T 0358
END OF COMMENT; 30294000 T 0359
END; 30295000 T 0359
END OF INSYMBOL; 30296000 T 0359
27 IS 367 LONG, NEXT SEG 2
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 40001000 T 0082
% % 40002000 T 0082
% % 40003000 T 0082
% % 40004000 T 0082
% PART 4: EXPRESSION PARSER. % 40005000 T 0082
% ------------------ % 40006000 T 0082
% % 40007000 T 0082
% % 40008000 T 0082
% % 40009000 T 0082
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 40010000 T 0082
40011000 T 0082
40012000 T 0082
PROCEDURE EXPRESSION; FORWARD; 40013000 T 0082
PROCEDURE CONCAT; FORWARD; 40014000 T 0082
40015000 T 0082
INTEGER EXPRLEVEL, EXPINVARCNT; % %800- 40018000 P 0082
40019000 T 0082
DEFINE PUTTEXT(T)= 40020000 T 0082
BEGIN 40021000 T 0082
IF NUMSYMS=MAXSYMS THEN 40022000 T 0082
BEGIN ERROR(63); % %600- 40023000 P 0082
NUMSYMS:=1; 40024000 T 0082
END ELSE NUMSYMS:=NUMSYMS+1; 40025000 T 0082
SYMTAB[NUMSYMS]:=T; 40026000 T 0082
END OF PUTTEXT #; 40027000 T 0082
40028000 T 0082
DEFINE PUTSYM(S) = PUTTEXT( (S)&1[41:5:6] ) #; %700- 40029000 P 0082
40034000 T 0082
DEFINE PUTCONST(VAL)= 40035000 T 0082
BEGIN 40036000 T 0082
PUTTEXT("2000000"); 40037000 T 0082
PUTTEXT(VAL); 40038000 T 0082
END OF PUTCONST #; 40039000 T 0082
40040000 T 0082
DEFINE PUTDUMMY = PUTTEXT("3000000") #; %700- 40041000 P 0082
40045000 T 0082
DEFINE PUTID(L,NUM,NUMDIG)= 40046000 T 0082
BEGIN 40047000 T 0082
TEXT[0]:=" " & L [35:5:6]; 40048000 T 0082
REPLACE TEXTPNT+2 BY NUM FOR NUMDIG DIGITS; 40049000 T 0082
PUTTEXT(TEXT[0]); 40050000 T 0082
END OF PUTID#; 40051000 T 0082
40052000 T 0082
% %601- 40052050 C 0082
% %601- 40052055 C 0082
PROCEDURE SPLIT(SPLITINX,WIDTH); % %601- 40052100 C 0082
VALUE SPLITINX, WIDTH; % %601- 40052150 C 0082
INTEGER SPLITINX, WIDTH ; % %601- 40052200 C 0082
BEGIN % %601- 40052250 C 0082
INTEGER I; % %601- 40052300 C 0082
START OF SEGMENT ********** 30
% %601- 40052350 C 0000
IF NUMSYMS+WIDTH LEQ MAXSYMS THEN % %601- 40052400 C 0000
BEGIN % %601- 40052450 C 0001
FOR I:=NUMSYMS STEP -1 UNTIL SPLITINX DO % %601- 40052500 C 0001
SYMTAB[I+WIDTH] := SYMTAB[I]; % %601- 40052550 C 0003
FOR I:=1 STEP 1 UNTIL WIDTH DO % %601- 40052600 C 0007
SYMTAB[SPLITINX+I-1] := "3000000"; % %601- 40052650 C 0008
NUMSYMS := NUMSYMS + WIDTH; % %601- 40052700 C 0012
END % %601- 40052750 C 0013
ELSE %601- 40052800 C 0013
BEGIN % %601- 40052830 C 0013
ERROR(63); % %601- 40052860 C 0016
NUMSYMS := 1; % %601- 40052890 C 0016
END; % %601- 40052900 C 0017
END OF SPLIT; % %601- 40052950 C 0017
30 IS 20 LONG, NEXT SEG 2
% %601- 40052960 C 0082
% %601- 40052965 C 0082
PROCEDURE WRITEEXPR; %*** WRITE GENERATED ALGOL EXPRESSION %700- 40053000 P 0082
BEGIN 40054000 T 0082
REAL SX; INTEGER T1, TX; %700- 40054100 C 0082
START OF SEGMENT ********** 31
FOR T1:=1 STEP 1 UNTIL NUMSYMS DO 40055000 T 0000
BEGIN 40056000 T 0001
SX:=SYMTAB[T1]; TX:=SX.[41:6]; 40057000 T 0001
IF TX=0 THEN GEN(SX,7,2) ELSE 40058000 T 0003
IF TX=3 THEN ELSE 40059000 T 0006
IF TX=1 THEN GEN(SX,1,7) ELSE 40060000 T 0007
BEGIN 40061000 T 0011
T1:=T1+1; SX:=SYMTAB[T1]; 40062000 T 0011
IF SX.[44:6]=0 THEN GENINT(SX) ELSE GENREAL(SX); 40063000 T 0013
END END; 40064000 T 0017
NUMSYMS:=0; 40065000 T 0019
END OF WRITEEXPR; %700- 40066000 P 0020
31 IS 24 LONG, NEXT SEG 2
40067000 T 0082
40068000 T 0082
PROCEDURE CHECKEXPR( LLIM, ULIM ); %*** WRITE CODE TO CHECK VALUE 40069000 P 0082
VALUE LLIM, ULIM; INTEGER LLIM, ULIM; %700- 40069100 C 0082
BEGIN DEFINE CHECK = VALUE #; %700- 40070000 P 0082
START OF SEGMENT ********** 32
PUTTEXT("CHECK("); 40071000 T 0000
EXPRESSION; 40072000 T 0005
PUTSYM(","); PUTCONST(LLIM); 40073000 T 0006
PUTSYM(","); PUTCONST(ULIM); 40074000 T 0027
PUTSYM(","); PUTCONST(CARDCNT); 40075000 T 0047
PUTSYM(")"); 40076000 T 0067
END OF CHECKEXPR; %700- 40077000 P 0074
32 IS 75 LONG, NEXT SEG 2
40078000 T 0082
40079000 T 0082
BOOLEAN SIMPLEVARIABLE,INSIDEBRACKETS,INSIDEPARENS; %518- 40080100 C 0082
INTEGER NUMPOINTERS; 40081000 T 0082
40082000 T 0082
PROCEDURE VARIABLE; 40083000 T 0082
BEGIN 40084000 T 0082
INTEGER STARTSYM,LLIM,ULIM; 40085000 T 0082
START OF SEGMENT ********** 33
REAL T; 40086000 T 0000
INTEGER T1, T5; % USED ONCE EACH %700- 40086100 C 0000
BOOLEAN INBRACKET,INRECORD,SIMPLEVAR; %002- 40087000 P 0000
LABEL ADDADDR; 40088000 T 0000
40089000 T 0000
STARTSYM:=NUMSYMS+1; 40090000 T 0000
IF THISLEVEL>CURLEVEL THEN % VARIABLE IN FIELD LIST OF 40091000 T 0001
BEGIN % RECORD USED IN WITH-STATEMENT. 40092000 T 0002
T:=DISPLAY[THISLEVEL]; 40093000 T 0002
T1:=T.FIRSTWITHSYM; T5:=T.LASTWITHSYM; %700- 40094000 P 0003
FOR T1:=T1 STEP 1 UNTIL T5 DO PUTTEXT(WITHTAB[T1]); %700- 40095000 P 0006
INRECORD:=TRUE; 40096000 T 0015
INBRACKET:=BOOLEAN(T.BRACKETSINWITH); 40097000 T 0016
NUMPOINTERS:=NUMPOINTERS+T.NUMPNTRSINWITH; 40098000 T 0017
SIMPLEVAR := FALSE; %002- 40099000 P 0019
CURTYPE:=T.RECTYPE; T:=TYPETAB1[CURTYPE]; 40100000 T 0019
GO TO ADDADDR; 40101000 T 0022
END; 40102000 T 0022
CURTYPE := THISID.TYPE; SIMPLEVAR := TRUE; %002- 40104000 P 0022
PUTID("V",1000×THISLEVEL+THISINDEX,5); %518- 40105500 C 0024
INSYMBOL; 40106000 T 0040
IF CURSY=LBRACKET OR CURSY=DOT OR CURSY=ARROW THEN 40107000 T 0041
BEGIN 40108000 T 0044
SIMPLEVAR := FALSE; %002- 40109000 P 0044
DO BEGIN 40110000 T 0045
IF CURSY=LBRACKET THEN 40111000 T 0046
BEGIN 40112000 T 0046
IF NOT(INBRACKET OR INRECORD) THEN 40113000 T 0047
BEGIN PUTSYM("["); INBRACKET:=TRUE END; 40114000 T 0048
DO BEGIN 40115000 T 0056
T:=TYPETAB1[CURTYPE]; 40116000 T 0057
LLIM:=TYPETAB2[CURTYPE]; ULIM:=TYPETAB3[CURTYPE]; 40117000 T 0058
IF T.FORM≠ARRAYS THEN ERROR(12); 40118000 T 0060
IF INRECORD THEN PUTTEXT(" +("); 40119000 T 0062
INSYMBOL; 40120000 T 0069
EXPINVARCNT:=EXPINVARCNT+1;% %002- 40120500 C 0069
EXPRLEVEL := EXPRLEVEL+1; % DO NOT "WRITEEXPR" YET %507- 40120900 C 0070
IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 40121000 T 0072
EXPRLEVEL := EXPRLEVEL-1; %507- 40121100 C 0076
SIMPLEVARIABLE := FALSE; % RECURSION ON "VARIABLE" %507- 40121200 C 0077
EXPINVARCNT:=EXPINVARCNT-1;% %002- 40121500 C 0078
CHECKTYPES(T.INXTYPE,CURTYPE); 40122000 T 0079
CURTYPE:=T.ARRTYPE; 40123000 T 0081
IF INRECORD THEN 40124000 T 0082
BEGIN 40125000 T 0082
IF LLIM<0 THEN BEGIN PUTSYM("+"); PUTCONST(-LLIM) END ELSE 40126000 T 0083
IF LLIM>0 THEN BEGIN PUTSYM("-"); PUTCONST( LLIM) END; 40127000 T 0104
PUTSYM(")"); 40128000 T 0126
IF TYPETAB1[CURTYPE].SIZE>1 THEN 40129000 T 0133
BEGIN PUTSYM("×"); PUTCONST(TYPETAB1[CURTYPE].SIZE) END; 40130000 T 0134
END ELSE IF TYPETAB1[CURTYPE].STRUCT>0 THEN PUTSYM(","); 40131000 T 0155
END UNTIL CURSY≠COMMA; 40132000 T 0164
IF CURSY≠RBRACKET THEN 40133000 T 0165
BEGIN ERROR(59); SKIP(RBRACKET); 40134000 T 0166
IF CURSY=RBRACKET THEN INSYMBOL; 40135000 T 0168
END ELSE INSYMBOL; 40136000 T 0170
END OF BRACKETS ELSE 40137000 T 0171
IF CURSY=DOT THEN 40138000 T 0171
BEGIN 40139000 T 0172
IF NOT(INBRACKET OR INRECORD) THEN 40140000 T 0173
BEGIN PUTSYM("["); INBRACKET:=TRUE END; 40141000 T 0174
T:=TYPETAB1[CURTYPE]; 40142000 T 0182
IF T.FORM≠RECORD THEN ERROR(12); 40143000 T 0183
INSYMBOL; 40144000 T 0185
IF CURSY=IDENTIFIER THEN 40145000 T 0186
BEGIN 40146000 T 0186
SEARCHTAB(T.RECTAB); 40147000 T 0187
IF FOUND THEN 40148000 T 0188
BEGIN 40149000 T 0188
THISID:=NAMETAB3[T.RECTAB,THISINDEX]; 40150000 T 0189
ADDADDR: PUTSYM("+"); 40151000 T 0191
PUTCONST(THISID.INFO); CURTYPE:=THISID.TYPE; 40152000 T 0198
END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40153000 T 0213
END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40154000 T 0215
INRECORD:=TRUE; 40155000 T 0217
INSYMBOL; 40156000 T 0218
END OF DOT ELSE 40157000 T 0218
BEGIN % CURSY=ARROW 40158000 T 0218
T:=TYPETAB1[CURTYPE]; 40159000 T 0219
IF T.FORM=FILES THEN 40160000 T 0220
BEGIN 40161000 T 0221
CURTYPE:=T.FILETYPE; 40162000 T 0221
IF TYPETAB1[CURTYPE].STRUCT=0 THEN PUTTEXT(" [0]"); 40163000 T 0223
END ELSE 40164000 T 0230
IF T.FORM=TEXTFILE THEN 40165000 T 0230
BEGIN 40166000 T 0234
SYMTAB[NUMSYMS]:=SYMTAB[NUMSYMS] & "I" [35:5:6]; 40167000 T 0234
PUTSYM("."); PUTTEXT("LASTCH"); 40168000 T 0237
CURTYPE:=CHARTYPE; 40169000 T 0249
END ELSE 40170000 T 0250
IF T.FORM=POINTERS THEN 40171000 T 0250
BEGIN 40172000 T 0253
IF INBRACKET THEN PUTSYM("]"); 40173000 T 0253
INBRACKET:=FALSE; 40174000 T 0261
IF NUMSYMS+6 ≤ MAXSYMS THEN %513- 40175000 P 0262
BEGIN 40176000 T 0263
FOR T1:=NUMSYMS STEP -1 UNTIL STARTSYM DO 40177000 T 0263
SYMTAB[T1+2]:=SYMTAB[T1]; 40178000 T 0265
SYMTAB[STARTSYM]:=" MEM["; 40179000 T 0269
SYMTAB[STARTSYM+1]:=" (T:="; 40180000 T 0270
NUMSYMS := NUMSYMS+2; %513- 40180400 C 0272
IF NUMPOINTERS > 0 % POINTER VIA POINTER %513- 40180500 C 0273
THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY %513- 40180600 C 0273
"00-1)DIV00 1022,00 T MOD00 1022]"; %513- 40180700 C 0278
NUMSYMS := NUMSYMS+4; %513- 40180800 C 0282
END %513- 40180900 C 0283
ELSE NUMPOINTERS := 1; %513- 40181000 P 0283
INRECORD:=TRUE; 40182000 T 0286
END ELSE ERROR(63); 40183000 T 0287
CURTYPE:=T.POINTTYPE; 40184000 T 0288
END ELSE BEGIN ERROR(12); CURTYPE:=0 END; 40185000 T 0290
INSYMBOL; 40186000 T 0292
END OF ARROW; 40187000 T 0292
END UNTIL CURSY≠LBRACKET AND CURSY≠DOT AND CURSY≠ARROW; 40188000 T 0292
END; % %601- 40188005 C 0295
IF TYPETAB1[CURTYPE].FORM=SET THEN % *** SET VARIABLES %601- 40188010 C 0295
BEGIN % --- --- --------- %601- 40188025 C 0297
INTEGER THISSYML, I; % %601- 40188050 C 0297
START OF SEGMENT ********** 34
% %601- 40188075 C 0000
SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SLOAD("; % %601- 40188100 C 0000
IF SIMPLEVAR THEN % %601- 40188125 C 0002
BEGIN % %601- 40188150 C 0002
PUTSYM(","); % %601- 40188175 C 0003
PUTID("W",1000×THISLEVEL+THISINDEX,5); % %601- 40188200 C 0011
END % %601- 40188225 C 0027
ELSE % %601- 40188250 C 0027
IF INBRACKET AND NOT INRECORD THEN % %601- 40188275 C 0027
BEGIN % %601- 40188300 C 0029
PUTSYM(","); THISSYML := NUMSYMS; % %601- 40188325 C 0029
PUTCONST(0); PUTSYM(" "); PUTSYM(","); % %601- 40188350 C 0037
FOR I:=STARTSYM+1 STEP 1 UNTIL THISSYML DO % %601- 40188375 C 0064
PUTTEXT(SYMTAB[I]); %601- 40188400 C 0068
PUTTEXT(" 1] "); % %601- 40188425 C 0074
END % %601- 40188450 C 0080
ELSE % %601- 40188475 C 0080
BEGIN % %601- 40188500 C 0080
THISSYML := NUMSYMS; % %601- 40188525 C 0082
IF INBRACKET THEN PUTSYM("]"); % %601- 40188550 C 0082
FOR I:=1 STEP 1 UNTIL NUMPOINTERS DO % %601- 40188575 C 0090
BEGIN % %601- 40188600 C 0091
PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); % %601- 40188625 C 0091
PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); % %601- 40188650 C 0103
END; % %601- 40188675 C 0117
PUTSYM(","); % %601- 40188700 C 0119
FOR I:=STARTSYM+1 STEP 1 UNTIL THISSYML DO % %601- 40188725 C 0127
PUTTEXT(SYMTAB[I]); % %601- 40188775 C 0131
PUTTEXT(" +1 "); % %601- 40188800 C 0138
IF INBRACKET THEN PUTSYM("]"); % %601- 40188825 C 0144
FOR I:=1 STEP 1 UNTIL NUMPOINTERS DO % %601- 40188850 C 0152
BEGIN % %601- 40188875 C 0154
PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); % %601- 40188900 C 0154
PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); % %601- 40188915 C 0166
END; % %601- 40188930 C 0180
NUMPOINTERS := 0; % %601- 40188945 C 0182
END; %601- 40188960 C 0183
PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); % %601- 40188975 C 0183
END OF SET VARIABLES; % %601- 40188990 C 0211
34 IS 212 LONG, NEXT SEG 33
IF TYPETAB1[CURTYPE].STRUCT=0 THEN 40189000 T 0299
BEGIN 40190000 T 0300
IF INBRACKET THEN PUTSYM("]"); 40191000 T 0301
% INBRACKET := FALSE; %513- 40191100 C 0308
WHILE NUMPOINTERS>0 DO 40192000 T 0308
BEGIN NUMPOINTERS := NUMPOINTERS-1; %513- 40193000 P 0310
IF NUMSYMS+4 ≤ MAXSYMS %513- 40194000 P 0311
THEN BEGIN REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY %513- 40194100 C 0312
"00-1)DIV00 1022,00 T MOD00 1022]"; %513- 40194200 C 0317
NUMSYMS := NUMSYMS+4; %513- 40194300 C 0320
END %513- 40194400 C 0321
ELSE ERROR(63); % EXPRESSION IS TOO LONG FOR SYMTAB[*] 40195000 P 0321
END; 40196000 T 0323
END; 40197000 T 0323
IF INSIDEPARENS AND SIMPLEVAR AND TYPETAB1[CURTYPE].STRUCT > 0 AND 40198500 C 0323
TYPETAB1[CURTYPE].FORM < FILES THEN SYMTAB[STARTSYM].[35:6] := 40198600 C 0326
"H"; %615- 40198700 C 0329
INSIDEBRACKETS:=INBRACKET; 40199000 T 0330
SIMPLEVARIABLE := SIMPLEVAR; %002- 40199500 C 0331
CURMODE:=NUMBER; 40200000 T 0332
END OF VARIABLE; 40201000 T 0333
33 IS 339 LONG, NEXT SEG 2
40202000 T 0082
40203000 T 0082
PROCEDURE PASSPARAMS; 40204000 T 0082
BEGIN 40205000 T 0082
INTEGER NPARS,PARAM,PTYPE,P,FIRSTSYM; 40206000 T 0082
START OF SEGMENT ********** 35
BOOLEAN FORMALPROC,CHECK; 40207000 T 0000
LABEL EXIT; 40208000 T 0000
40209000 T 0000
PUTID("V",1000×THISLEVEL+THISINDEX,5); 40210000 T 0000
P:=THISID.INFO; 40211000 T 0015
FORMALPROC:=BOOLEAN(THISID.FORMAL); 40212000 T 0017
NPARS:=PARAMTAB[P]; P:=P+1; 40213000 T 0018
IF FORMALPROC THEN NPARS:=9999; 40214000 T 0020
INSYMBOL; 40215000 T 0022
IF CURSY=LPAR THEN 40216000 T 0022
BEGIN 40217000 T 0023
PUTSYM("("); 40218000 T 0023
DO BEGIN 40219000 T 0031
INSYMBOL; 40220000 T 0032
IF NPARS=0 THEN BEGIN ERROR(3); SKIP(RPAR); GO TO EXIT END; 40221000 T 0032
PARAM:=PARAMTAB[P]; P:=P+1; 40222000 T 0035
PTYPE:=PARAM.PARAMTYPE; 40223000 T 0038
IF PARAM.PARAMKIND=CONST THEN 40224000 T 0039
BEGIN 40225000 T 0040
CHECK:=CHECKOPTION AND TYPETAB1[PTYPE].FORM LEQ CHAR; 40226000 T 0041
IF CHECK THEN PUTTEXT("CHECK("); 40227000 T 0043
PUTDUMMY; FIRSTSYM:=NUMSYMS; 40228000 T 0050
EXPRLEVEL:=EXPRLEVEL+1; 40229000 T 0058
EXPRESSION; EXPRLEVEL:=EXPRLEVEL-1; 40230000 T 0059
IF CURMODE=BITPATTERN THEN 40231000 T 0061
BEGIN SYMTAB[FIRSTSYM]:=" REAL("; PUTSYM(")"); END; 40232000 T 0062
IF CHECK THEN 40233000 T 0072
BEGIN 40234000 T 0072
PUTSYM(","); PUTCONST(TYPETAB2[PTYPE]); 40235000 T 0073
PUTSYM(","); PUTCONST(TYPETAB3[PTYPE]); 40236000 T 0092
PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); 40237000 T 0112
END; 40238000 T 0139
END ELSE 40239000 T 0139
IF PARAM.PARAMKIND=VAR THEN 40240000 T 0139
BEGIN 40241000 T 0141
IF CURSY=IDENTIFIER THEN 40242000 T 0141
BEGIN 40243000 T 0142
SEARCH; 40244000 T 0142
IF FOUND THEN 40245000 T 0143
BEGIN 40246000 T 0143
IF THISID.IDCLASS=VAR OR 40247000 T 0144
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 40248000 T 0145
BEGIN 40249000 T 0147
IF PARAM.PARAMFILE=1 THEN 40250000 T 0148
BEGIN 40251000 T 0149
CURTYPE:=THISID.TYPE; 40252000 T 0150
PUTID("V",1000×THISLEVEL+THISINDEX,5); PUTSYM(","); 40253000 T 0151
PUTID("F",1000×THISLEVEL+THISINDEX,5); PUTSYM(","); 40254000 T 0174
PUTID("I",1000×THISLEVEL+THISINDEX,5); 40255000 T 0197
INSYMBOL; 40256000 T 0213
END ELSE 40257000 T 0214
BEGIN 40258000 T 0214
INSIDEPARENS := TRUE; %518- 40258100 C 0214
VARIABLE; 40259000 T 0215
INSIDEPARENS := FALSE; %518- 40259100 C 0216
IF TYPETAB1[CURTYPE].STRUCT>0 THEN 40260000 T 0216
IF NOT SIMPLEVARIABLE THEN ERROR(92); 40261000 T 0218
END; 40262000 T 0220
END ELSE BEGIN ERROR(8); CURTYPE:=0 END; 40263000 T 0220
END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40264000 T 0222
END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40265000 T 0224
END ELSE 40266000 T 0226
BEGIN 40267000 T 0226
IF CURSY=IDENTIFIER THEN 40268000 T 0227
BEGIN 40269000 T 0227
SEARCH; 40270000 T 0228
IF FOUND THEN 40271000 T 0228
BEGIN 40272000 T 0229
IF THISID.IDCLASS≠PARAM.PARAMKIND THEN ERROR(91); 40273000 T 0229
PUTID("V",1000×THISLEVEL+THISINDEX,5); 40274000 T 0232
IF TYPETAB1[THISID.TYPE].FORM=SET THEN %601- 40274200 C 0248
BEGIN % %601- 40274220 C 0250
GEN(",",1,7); % %601- 40274240 C 0251
GENID("W",1000×THISLEVEL+THISINDEX,5); % %601- 40274260 C 0252
END; % %601- 40274280 C 0255
CURTYPE:=IF THISID.IDCLASS=FUNC THEN THISID.TYPE ELSE 0; 40275000 T 0255
INSYMBOL; 40276000 T 0259
END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40277000 T 0259
END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40278000 T 0261
END; 40279000 T 0263
CHECKTYPES(PTYPE,CURTYPE); 40280000 T 0263
NPARS:=NPARS-1; 40281000 T 0264
IF CURSY=COMMA THEN PUTSYM(","); 40282000 T 0265
END UNTIL CURSY≠COMMA; 40283000 T 0273
IF CURSY≠RPAR THEN BEGIN ERROR(89); SKIP(RPAR) END; 40284000 T 0275
EXIT: PUTSYM(")"); 40285000 T 0277
IF CURSY=RPAR THEN INSYMBOL; 40286000 T 0284
END; 40287000 T 0286
IF NPARS>0 AND NOT FORMALPROC THEN ERROR(3); 40288000 T 0286
CURMODE:=NUMBER; 40289000 T 0289
END OF PASSPARAMS; 40290000 T 0290
35 IS 297 LONG, NEXT SEG 2
40291000 T 0082
40292000 T 0082
PROCEDURE FACTOR; %*** FACTOR *** 40293000 T 0082
BEGIN %************** 40294000 T 0082
INTEGER STARTSYM,STYPE,T; 40295000 T 0082
START OF SEGMENT ********** 36
BOOLEAN FIRST, SPLITTED; % %601- 40296000 P 0000
REAL VAL; 40297000 T 0000
DEFINE T1 = T #; % USED AT 40558000 %700- 40298000 P 0000
40310000 T 0000
CURMODE:=NUMBER; 40311000 T 0000
IF CURSY=IDENTIFIER THEN 40312000 T 0000
BEGIN 40313000 T 0001
SEARCH; 40314000 T 0002
IF FOUND THEN 40315000 T 0002
BEGIN 40316000 T 0002
IF THISID.IDCLASS=VAR OR 40317000 T 0003
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) 40318000 T 0004
THEN VARIABLE ELSE 40319000 T 0005
IF THISID.IDCLASS=CONST THEN 40320000 T 0008
BEGIN 40321000 T 0009
IF THISID.INFO≤1023 THEN PUTCONST(THISID.INFO) 40322000 T 0010
ELSE PUTCONST(CONSTTAB[THISID.INFO-1023]); 40323000 T 0011
CURTYPE:=THISID.TYPE; CURMODE:=NUMBER; 40324000 T 0039
INSYMBOL; 40325000 T 0041
END ELSE 40326000 T 0042
IF THISID.IDCLASS=FUNC THEN 40327000 T 0042
BEGIN 40328000 T 0044
IF THISTAB=0 THEN %*** INTRINSIC FUNCTION *** 40329000 T 0044
BEGIN 40330000 T 0045
%700- 40331000 C 0045
PROCEDURE PARAMETER; %*** CHECK THAT THE FUNCTION HAS 1 PARAM. 40332000 C 0045
START OF SEGMENT ********** 37
BEGIN %700- 40333000 C 0000
INSYMBOL; %700- 40334000 C 0000
IF CURSY=LPAR %700- 40335000 C 0000
THEN BEGIN %700- 40336000 C 0000
PUTSYM("("); INSYMBOL; EXPRESSION; %700- 40337000 C 0001
IF TYPETAB1[CURTYPE].FORM=NUMERIC THEN CURTYPE:=INTTYPE; 40338000 C 0009
IF CURSY≠RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; %700- 40339000 C 0012
PUTSYM(")"); IF CURSY=RPAR THEN INSYMBOL; %700- 40340000 C 0015
END ELSE ERROR(3); % OR ERROR(58) %700- 40341000 C 0023
END OF PARAMETER; %700- 40342000 C 0024
%700- 40350000 P 0025
IF CURNAME1="3000ABS" THEN % "ABS" 40351000 T 0025
BEGIN 40352000 T 0025
PUTTEXT(" ABS"); PARAMETER; 40353000 T 0026
IF CURTYPE≠REALTYPE AND CURTYPE≠INTTYPE THEN ERROR(67); 40354000 T 0034
END ELSE 40355000 T 0037
IF CURNAME1="3000CHR" THEN % "CHR" 40356000 T 0037
BEGIN 40357000 T 0039
INSYMBOL; 40358000 T 0040
IF CURSY=LPAR THEN 40359000 T 0040
BEGIN INSYMBOL; CHECKEXPR(0,63); 40360000 T 0041
IF TYPETAB1[CURTYPE].FORM≠NUMERIC THEN ERROR(67); 40361000 T 0043
IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40362000 T 0046
IF CURSY=RPAR THEN INSYMBOL; 40363000 T 0049
END ELSE ERROR(58); 40364000 T 0050
CURTYPE:=CHARTYPE; 40365000 T 0053
END ELSE 40366000 T 0054
IF CURNAME1="3000EOF" OR % "EOF"/"EOLN" 40367000 T 0054
CURNAME1="400EOLN" THEN 40368000 T 0055
BEGIN 40369000 T 0056
FIRST:=CURNAME1="3000EOF"; 40370000 T 0057
FILEPARAM(INPUTFILE); 40371000 T 0058
PUTID("I",FILENAME,5); 40372000 T 0059
PUTTEXT(IF FIRST THEN " .EOF" ELSE " .EOLN"); 40373000 T 0076
IF LPARFOUND THEN 40374000 T 0084
BEGIN 40375000 T 0084
IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40376000 T 0084
IF CURSY=RPAR THEN INSYMBOL; 40377000 T 0087
END; 40378000 T 0089
CURTYPE:=BOOLTYPE; 40379000 T 0089
END ELSE 40380000 T 0090
IF CURNAME1="3000ODD" THEN % "ODD" 40381000 T 0090
BEGIN 40382000 T 0093
PUTTEXT(" ODD"); PARAMETER; 40383000 T 0094
IF CURTYPE≠INTTYPE THEN ERROR(67); 40384000 T 0102
CURTYPE:=BOOLTYPE; CURMODE:=BITPATTERN; 40385000 T 0104
END ELSE 40386000 T 0106
IF CURNAME1="3000ORD" THEN % "ORD" 40387000 T 0106
BEGIN 40388000 T 0108
PUTSYM("("); INSYMBOL; 40389000 T 0109
IF CURSY=LPAR THEN 40390000 T 0118
BEGIN 40391000 T 0118
INSYMBOL; EXPRESSION; 40392000 T 0119
IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(67); 40393000 T 0120
IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40394000 T 0123
INSYMBOL; 40395000 T 0125
END ELSE ERROR(58); 40396000 T 0126
CURTYPE:=INTTYPE; PUTSYM(")"); 40397000 T 0127
END ELSE 40398000 T 0135
IF CURNAME1="400PRED" OR % "PRED"/"SUCC" 40399000 T 0135
CURNAME1="400SUCC" THEN 40400000 T 0136
BEGIN 40401000 T 0137
FIRST:=CURNAME1="400PRED"; 40402000 T 0137
PUTTEXT("CHECK("); INSYMBOL; 40403000 T 0139
IF CURSY=LPAR THEN 40404000 T 0148
BEGIN 40405000 T 0148
INSYMBOL; EXPRESSION; 40406000 T 0149
PUTSYM(IF FIRST THEN "-" ELSE "+"); PUTSYM("1"); 40407000 T 0150
IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(67); 40408000 T 0166
PUTSYM(","); PUTCONST(TYPETAB2[CURTYPE]); 40409000 T 0169
PUTSYM(","); PUTCONST(TYPETAB3[CURTYPE]); 40410000 T 0189
PUTSYM(","); PUTCONST(CARDCNT); 40411000 T 0209
PUTSYM(")"); 40412000 T 0229
IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40413000 T 0236
IF CURSY=RPAR THEN INSYMBOL; 40414000 T 0239
END ELSE BEGIN ERROR(58); CURTYPE:=0 END; 40415000 T 0240
END ELSE 40416000 T 0242
IF CURNAME1="50ROUND" THEN % "ROUND" 40417000 T 0242
BEGIN 40418000 T 0244
PUTTEXT(" ROUND"); PARAMETER; 40419000 T 0244
IF CURTYPE≠REALTYPE THEN ERROR(67); 40420000 T 0252
NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40421000 T 0254
PUTCONST(CARDCNT); PUTSYM(")"); 40422000 T 0263
CURTYPE:=INTTYPE; 40423000 T 0283
END ELSE 40424000 T 0284
IF CURNAME1="3000SQR" THEN % "SQR" 40425000 T 0284
BEGIN 40426000 T 0285
PUTTEXT(" SQR"); PARAMETER; 40427000 T 0285
NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40428000 T 0293
PUTCONST(CARDCNT); PUTSYM(")"); 40429000 T 0302
IF CURTYPE≠REALTYPE AND CURTYPE≠INTTYPE THEN ERROR(67); 40430000 T 0322
END ELSE 40431000 T 0325
IF CURNAME1="50TRUNC" THEN % "TRUNC" 40432000 T 0325
BEGIN 40433000 T 0326
PUTTEXT(" TRUNC"); PARAMETER; 40434000 T 0327
NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40435000 T 0335
PUTCONST(CARDCNT); PUTSYM(")"); 40436000 T 0344
IF CURTYPE≠REALTYPE THEN ERROR(67); 40437000 T 0364
CURTYPE:=INTTYPE; 40438000 T 0366
END ELSE 40439000 T 0367
IF CURNAME1="6CONCAT" THEN % "CONCAT" 40440000 T 0367
CONCAT ELSE 40441000 T 0368
IF CURNAME1="400TIME" THEN % "TIME" 40442000 T 0369
BEGIN 40443000 T 0371
PUTTEXT("(TIME("); PUTTEXT("1)/60)"); 40444000 T 0372
CURTYPE:=REALTYPE; INSYMBOL 40445000 T 0386
END ELSE 40446000 T 0387
IF CURNAME1="400DATE" THEN % "DATE" 40447000 T 0387
BEGIN 40448000 T 0390
PUTTEXT("CURDAT"); 40449000 T 0391
CURTYPE:=ALFATYPE; INSYMBOL; 40450000 T 0398
END ELSE 40451000 T 0399
IF CURNAME1="7CPUTIM" AND CURNAME2="E" THEN % "CPUTIME" 40452000 P 0399
BEGIN 40453000 T 0403
PUTTEXT("(TIME("); PUTTEXT("2)/60)"); 40454000 T 0404
CURTYPE:=REALTYPE; INSYMBOL; 40455000 T 0418
END ELSE 40456000 T 0419
IF CURNAME1="6IOTIME" THEN % "IOTIME" 40457000 T 0419
BEGIN 40458000 T 0422
PUTTEXT("(TIME("); PUTTEXT("3)/60)"); 40459000 T 0423
CURTYPE:=REALTYPE; INSYMBOL; 40460000 T 0437
END ELSE 40461000 T 0438
IF CURNAME1="7WEEKDA" AND CURNAME2="Y" THEN % "WEEKDAY" 40462000 T 0438
BEGIN 40463000 T 0442
PUTTEXT("WEEKDA"); 40464000 T 0443
CURTYPE:=ALFATYPE; INSYMBOL; 40465000 T 0450
END ELSE IF CURNAME1="400USER" THEN % "USER" 40466000 T 0451
BEGIN 40467000 T 0454
PUTTEXT(" TIME"); PUTTEXT(" (-1)"); 40468000 T 0455
CURTYPE:=ALFATYPE; INSYMBOL; 40469000 T 0469
END ELSE % "SIN","COS" ETC. 40470000 T 0470
BEGIN 40471000 T 0470
PUTTEXT(IF CURNAME1="3000SIN" THEN " SIN" ELSE 40472000 T 0473
IF CURNAME1="3000COS" THEN " COS" ELSE 40473000 T 0473
IF CURNAME1="6ARCTAN" THEN "ARCTAN" ELSE 40474000 T 0473
IF CURNAME1="400SQRT" THEN " SQRT" ELSE 40475000 T 0473
IF CURNAME1="3000EXP" THEN " EXP" ELSE 40476000 T 0473
" LN"); 40477000 T 0473
PARAMETER; 40478000 T 0488
IF CURTYPE≠REALTYPE AND CURTYPE≠INTTYPE THEN ERROR(67); 40479000 T 0489
CURTYPE:=REALTYPE; 40480000 T 0492
END; 40481000 T 0493
END OF INTRINSIC FUNCTIONS ELSE 40482000 T 0493
37 IS 517 LONG, NEXT SEG 36
BEGIN 40483000 T 0047
T:=THISID.TYPE; 40484000 T 0047
PASSPARAMS; 40485000 T 0048
CURTYPE:=T; 40486000 T 0049
END; 40487000 T 0050
END OF FUNCTIONS ELSE 40488000 T 0050
IF THISID.IDCLASS=PROC THEN 40489000 T 0050
BEGIN 40490000 T 0051
ERROR(68); PASSPARAMS; 40491000 T 0052
CURTYPE:=0; 40492000 T 0053
END ELSE BEGIN ERROR(69); CURTYPE:=0; INSYMBOL END; 40493000 T 0054
END ELSE BEGIN ERROR(1); CURTYPE:=0; INSYMBOL END; 40494000 T 0056
END OF IDENTIFIER ELSE 40495000 T 0059
IF CURSY≤CHARCONST THEN 40496000 T 0059
BEGIN 40497000 T 0060
CONSTANT(VAL,CURTYPE); PUTCONST(VAL); 40498000 T 0061
END ELSE 40499000 T 0074
IF CURSY=NOTSY THEN 40500000 T 0074
BEGIN 40501000 T 0075
PUTTEXT(" NOT "); PUTDUMMY; STARTSYM:=NUMSYMS; 40502000 T 0076
INSYMBOL; FACTOR; 40503000 T 0090
IF CURTYPE>0 THEN 40504000 T 0091
IF CURTYPE≠BOOLTYPE THEN BEGIN ERROR(17); CURTYPE:=0 END; 40505000 T 0092
IF CURMODE=NUMBER THEN 40506000 T 0095
BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")"); 40507000 T 0096
CURMODE:=BITPATTERN; 40508000 T 0106
END; 40509000 T 0107
END ELSE 40510000 T 0107
IF CURSY=NILSY THEN 40511000 T 0107
BEGIN 40512000 T 0108
PUTCONST(0); CURTYPE:=NILTYPE; 40513000 T 0109
INSYMBOL; 40514000 T 0122
END ELSE 40515000 T 0122
IF CURSY=LPAR THEN 40516000 T 0122
BEGIN 40517000 T 0124
PUTSYM("("); 40518000 T 0124
INSYMBOL; EXPRESSION; 40519000 T 0131
IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40520000 T 0132
PUTSYM(")"); 40521000 T 0135
INSYMBOL; 40522000 T 0141
END ELSE 40523000 T 0142
IF CURSY=LBRACKET THEN %*** SET CONSTANT *** 40524000 T 0142
BEGIN 40525000 T 0143
INSYMBOL; 40526000 T 0144
IF CURSY=RBRACKET THEN 40527000 T 0144
BEGIN 40528000 T 0145
PUTTEXT("SETBS("); PUTTEXT(" 3,2,"); PUTCONST(CARDCNT); % 40529000 P 0145
PUTSYM(")"); % %601- 40529300 C 0172
CURTYPE := EMPTYSET; CURMODE := NUMBER; % %601- 40529600 C 0179
INSYMBOL; 40530000 T 0180
END ELSE 40531000 T 0181
BEGIN 40532000 T 0181
FIRST:=TRUE; 40533000 T 0181
STARTSYM := NUMSYMS + 1; % %601- 40533500 C 0182
DO BEGIN 40534000 T 0183
IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 40535000 T 0184
PUTTEXT(" SETB("); % %601- 40536000 P 0186
EXPRESSION; 40537000 T 0192
IF STYPE=0 THEN 40538000 T 0192
BEGIN STYPE:=CURTYPE; 40539000 T 0193
IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(72); 40540000 T 0194
END ELSE CHECKTYPES(STYPE,CURTYPE); 40541000 T 0197
IF CURSY=DOUBLEDOT THEN 40542000 T 0200
BEGIN 40543000 T 0200
PUTSYM(","); SYMTAB[STARTSYM] := "SETBS("; % %601- 40544000 P 0201
INSYMBOL; EXPRESSION; 40545000 T 0209
IF STYPE=0 THEN 40546000 T 0210
BEGIN STYPE:=CURTYPE; 40547000 T 0211
IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(72); 40548000 T 0212
END ELSE CHECKTYPES(STYPE,CURTYPE); 40549000 T 0215
END; 40550000 T 0218
PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); 40551000 T 0218
IF SPLITTED THEN PUTSYM(")"); % %601- 40551500 C 0244
IF CURSY=COMMA THEN % %601- 40552000 P 0251
BEGIN % %601- 40552200 C 0252
SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SUNIO("; % %601- 40552400 C 0253
PUTSYM(","); % %601- 40552600 C 0255
SPLITTED := TRUE; % %601- 40552800 C 0263
END; % %601- 40552850 C 0264
END UNTIL CURSY≠COMMA; 40553000 T 0264
IF CURSY≠RBRACKET THEN 40554000 T 0265
BEGIN ERROR(59); SKIP(RBRACKET); 40555000 T 0266
IF CURSY=RBRACKET THEN INSYMBOL; 40556000 T 0268
END ELSE INSYMBOL; 40557000 T 0270
NEWTYPE; T1 := SET; T1.SIZE := 2; T1.STRUCT := 0; % %601- 40558000 P 0271
T1.SETTYPE:=STYPE; TYPETAB1[TYPEINDEX]:=T1; 40559000 T 0280
CURTYPE:=TYPEINDEX; 40560000 T 0283
CURMODE := NUMBER; % %601- 40561000 P 0284
END; 40562000 T 0284
END OF SET CONSTANT ELSE BEGIN ERROR(99); INSYMBOL END; 40563000 T 0284
END OF FACTOR; 40564000 T 0286
36 IS 292 LONG, NEXT SEG 2
40565000 T 0082
40566000 T 0082
PROCEDURE TERM; %*** TERM *** 40567000 T 0082
BEGIN %************ 40568000 T 0082
INTEGER STARTSYM,MODE,TYPE1,MULOPTR,F; 40569000 T 0082
START OF SEGMENT ********** 38
PUTDUMMY; STARTSYM:=NUMSYMS; 40570000 T 0000
FACTOR; 40571000 T 0006
MODE:=CURMODE; 40572000 T 0007
WHILE CURSY≥ASTERISK AND CURSY≤MODSY DO % "*","/","DIV","MOD","AND" 40573000 T 0007
BEGIN 40574000 T 0010
TYPE1:=CURTYPE; MULOPTR:=CURSY; 40575000 T 0010
F:=TYPETAB1[TYPE1].FORM; 40576000 T 0011
IF F=NUMERIC OR F=FLOATING THEN 40577000 T 0013
BEGIN 40578000 T 0015
MODE:=NUMBER; 40579000 T 0015
IF CURSY=ASTERISK THEN PUTSYM("×") ELSE 40580000 T 0016
IF CURSY=SLASH THEN PUTSYM("/") ELSE 40581000 T 0025
IF CURSY=ANDSY THEN ERROR(64) ELSE 40582000 T 0034
BEGIN 40583000 T 0036
IF F=FLOATING THEN ERROR(64); 40584000 T 0037
IF CURSY=DIVSY THEN PUTTEXT(" DIV") ELSE PUTTEXT(" MOD"); 40585000 T 0039
END END ELSE 40586000 T 0053
IF CURTYPE=BOOLTYPE THEN % %601- 40587000 P 0053
BEGIN 40588000 T 0056
MODE:=BITPATTERN; 40589000 T 0057
IF CURMODE≠MODE THEN 40590000 T 0058
BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40591000 T 0058
PUTTEXT(" AND "); 40592000 T 0068
IF CURSY NEQ ANDSY THEN ERROR(64); %601- 40593000 P 0074
END ELSE % %601- 40593100 C 0076
IF F=SET THEN % %601- 40593200 C 0076
BEGIN % %601- 40593300 C 0078
IF CURSY=ASTERISK THEN % %601- 40593400 C 0079
BEGIN % %601- 40593500 C 0080
SPLIT(STARTSYM,1); SYMTAB[STARTSYM] := "SINTS("; % %601- 40593600 C 0080
PUTSYM(","); % %601- 40593700 C 0082
END ELSE ERROR(64); % %601- 40593800 C 0090
MODE := NUMBER; % %601- 40593900 C 0091
END ELSE ERROR(64); 40594000 T 0092
PUTDUMMY; STARTSYM:=NUMSYMS; 40595000 T 0093
INSYMBOL; FACTOR; 40596000 T 0100
IF CURTYPE>0 AND TYPE1>0 THEN 40597000 T 0101
BEGIN 40598000 T 0103
IF CURTYPE≠TYPE1 THEN 40599000 T 0103
BEGIN 40600000 T 0104
IF TYPETAB1[TYPE1].FORM≠NUMERIC OR CURTYPE≠REALTYPE THEN 40601000 T 0104
CHECKTYPES(TYPE1,CURTYPE); 40602000 T 0107
IF TYPE1=REALTYPE THEN CURTYPE:=REALTYPE; 40603000 T 0108
END; 40604000 T 0110
IF CURTYPE=REALTYPE AND MULOPTR≥DIVSY THEN ERROR(65); 40605000 T 0110
END; 40606000 T 0113
IF MULOPTR=SLASH THEN CURTYPE:=REALTYPE; 40607000 T 0113
IF CURTYPE=0 THEN CURTYPE:=TYPE1; 40608000 T 0115
IF F=SET THEN PUTSYM(")"); % %601- 40608500 C 0117
END OF WHILE LOOP; 40609000 T 0127
IF MODE=BITPATTERN AND CURMODE≠MODE THEN 40610000 T 0128
BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40611000 T 0129
CURMODE:=MODE; 40612000 T 0139
END OF TERM; 40613000 T 0140
38 IS 144 LONG, NEXT SEG 2
40614000 T 0082
40615000 T 0082
PROCEDURE SIMPLEEXPRESSION; %*** SIMPLE EXPRESSION *** 40616000 T 0082
BEGIN %************************* 40617000 T 0082
INTEGER STARTSYM,FIRSTSYM,MODE,TYPE1,F; %603- 40618000 P 0082
START OF SEGMENT ********** 39
BOOLEAN SIGNED; 40619000 T 0000
40620000 T 0000
PUTDUMMY; STARTSYM := FIRSTSYM := NUMSYMS; %603- 40621000 P 0000
IF CURSY=PLUS OR CURSY=MINUS THEN 40622000 T 0007
BEGIN SIGNED:=TRUE; 40623000 T 0008
PUTSYM(IF CURSY=PLUS THEN"+" ELSE "-"); 40624000 T 0010
INSYMBOL; 40625000 T 0020
END; 40626000 T 0021
TERM; 40627000 T 0021
MODE:=CURMODE; 40628000 T 0021
IF SIGNED THEN 40629000 T 0022
BEGIN F:=TYPETAB1[CURTYPE].FORM; 40630000 T 0022
IF F≠NUMERIC AND F≠FLOATING THEN ERROR(29); 40631000 T 0024
END; 40632000 T 0027
WHILE CURSY≥PLUS AND CURSY≤ORSY DO % "+","-","OR" 40633000 T 0027
BEGIN 40634000 T 0030
TYPE1:=CURTYPE; F:=TYPETAB1[TYPE1].FORM; 40635000 T 0030
IF F=NUMERIC OR F=FLOATING THEN 40636000 T 0032
BEGIN MODE:=NUMBER; 40637000 T 0034
IF CURSY=PLUS THEN PUTSYM("+") ELSE 40638000 T 0035
IF CURSY=MINUS THEN PUTSYM("-") ELSE ERROR(64); 40639000 T 0043
END ELSE 40640000 T 0053
IF CURTYPE=BOOLTYPE THEN 40641000 T 0053
BEGIN 40642000 T 0054
MODE:=BITPATTERN; 40643000 T 0055
IF CURMODE≠MODE THEN 40644000 T 0055
BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40645000 T 0056
IF CURSY=ORSY THEN PUTTEXT(" OR") ELSE ERROR(64); 40646000 T 0066
END ELSE 40647000 T 0075
IF F=SET THEN 40648000 T 0075
BEGIN 40649000 T 0077
SPLIT(FIRSTSYM,1); %603- 40650000 P 0077
IF CURSY = PLUS THEN SYMTAB[FIRSTSYM] := "SUNIO(" ELSE %603- 40651000 P 0078
IF CURSY = MINUS THEN SYMTAB[FIRSTSYM] := "SDIFF(" ELSE %603- 40652000 P 0081
ERROR(64); %603- 40653000 P 0085
PUTSYM(","); MODE := NUMBER; % %601- 40654000 P 0087
END ELSE ERROR(64); 40656000 T 0095
INSYMBOL; 40657000 T 0096
PUTDUMMY; STARTSYM:=NUMSYMS; 40658000 T 0097
TERM; 40659000 T 0103
IF CURTYPE>0 AND TYPE1>0 THEN 40660000 T 0104
BEGIN 40661000 T 0105
IF CURTYPE≠TYPE1 THEN 40662000 T 0106
BEGIN 40663000 T 0107
IF TYPETAB1[TYPE1].FORM≠NUMERIC OR CURTYPE≠REALTYPE THEN 40664000 T 0107
CHECKTYPES(TYPE1,CURTYPE); 40665000 T 0110
IF TYPE1=REALTYPE THEN CURTYPE:=REALTYPE; 40666000 T 0111
END END; 40667000 T 0113
IF CURTYPE=0 THEN CURTYPE:=TYPE1; 40668000 T 0113
IF F=SET THEN PUTSYM(")"); % %601- 40668500 C 0115
END OF WHILE LOOP; 40669000 T 0124
IF MODE=BITPATTERN AND CURMODE≠BITPATTERN THEN 40670000 T 0125
BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40671000 T 0126
CURMODE:=MODE; 40672000 T 0136
END OF SIMPLEEXPRESSION; 40673000 T 0137
39 IS 142 LONG, NEXT SEG 2
40674000 T 0082
40675000 T 0082
PROCEDURE EXPRESSION; %*** EXPRESSION *** 40676000 T 0082
BEGIN %****************** 40677000 T 0082
INTEGER STARTSYM,FIRSTSYM,TYPE1,RELOPTR,F; 40678000 T 0082
START OF SEGMENT ********** 40
BOOLEAN CALLGEN; 40679000 T 0000
40680000 T 0000
EXPRLEVEL:=EXPRLEVEL+1; 40681000 T 0000
IF EXPRLEVEL = 1 THEN 40682000 T 0001
BEGIN 40683000 T 0002
PUTDUMMY; 40684000 T 0002
FIRSTSYM := NUMSYMS; 40685000 T 0008
END; 40686000 T 0009
PUTDUMMY; STARTSYM:=NUMSYMS; 40687000 T 0009
SIMPLEEXPRESSION; 40689000 T 0017
IF CURSY≥LSSSY AND CURSY≤INSY THEN % "<","≤","≥",">","=","≠","IN" 40690000 T 0017
BEGIN 40691000 T 0019
TYPE1:=CURTYPE; F:=TYPETAB1[TYPE1].FORM; 40692000 T 0020
RELOPTR:=CURSY; 40693000 T 0022
IF F≤ALFA THEN 40694000 T 0023
BEGIN 40695000 T 0023
IF CURMODE=BITPATTERN THEN 40696000 T 0024
BEGIN SYMTAB[STARTSYM]:=" REAL("; PUTSYM(")") END; 40697000 T 0025
IF CURSY=LSSSY THEN PUTSYM("<") ELSE 40698000 T 0035
IF CURSY=LEQSY THEN PUTSYM("≤") ELSE 40699000 T 0043
IF CURSY=GEQSY THEN PUTSYM("≥") ELSE 40700000 T 0052
IF CURSY=GTRSY THEN PUTSYM(">") ELSE 40701000 T 0060
IF CURSY=EQLSY THEN PUTSYM("=") ELSE 40702000 T 0069
IF CURSY=NEQSY THEN PUTSYM("≠") ELSE 40703000 T 0077
BEGIN 40704000 T 0086
IF F≥FLOATING THEN ERROR(64); 40705000 T 0086
SYMTAB[STARTSYM]:="INTST("; PUTSYM(","); CALLGEN:=TRUE; 40706000 T 0088
END; 40707000 T 0098
END ELSE 40708000 T 0098
IF F=SET THEN 40709000 T 0098
BEGIN 40710000 T 0099
IF CURMODE=BITPATTERN THEN 40711000 T 0100
BEGIN SYMTAB[STARTSYM+1]:=" REAL("; PUTSYM(")") END; 40712000 T 0100
IF CURSY=EQLSY THEN SYMTAB[STARTSYM] := "SEQUA(" % %601- 40713000 P 0111
ELSE %601- 40713150 C 0113
IF CURSY=NEQSY THEN % %601- 40713300 C 0114
BEGIN % %601- 40714000 P 0116
SPLIT(STARTSYM,1); SYMTAB[STARTSYM]:= " NOT "; % %601- 40714150 C 0117
SYMTAB[STARTSYM+1] := "SEQUA("; % %601- 40714300 C 0119
END ELSE 40715000 T 0121
BEGIN 40716000 T 0121
IF CURSY=LEQSY THEN SYMTAB[STARTSYM]:="INCL1(" ELSE 40717000 T 0124
IF CURSY=GEQSY THEN SYMTAB[STARTSYM]:="INCL2(" ELSE ERROR(64); 40718000 T 0126
PUTSYM(","); CALLGEN:=TRUE; 40719000 T 0132
END END ELSE 40720000 T 0140
IF F=POINTERS THEN 40721000 T 0140
BEGIN 40722000 T 0141
IF CURSY=EQLSY THEN PUTSYM("=") ELSE 40723000 T 0142
IF CURSY=NEQSY THEN PUTSYM("≠") ELSE ERROR(64); 40724000 T 0150
END ELSE ERROR(64); 40725000 T 0159
INSYMBOL; 40726000 T 0161
PUTDUMMY; STARTSYM:=NUMSYMS; 40727000 T 0161
SIMPLEEXPRESSION; 40728000 T 0168
IF CURTYPE>0 AND TYPE1>0 THEN 40729000 T 0168
IF CURTYPE≠TYPE1 THEN 40730000 T 0170
IF RELOPTR≠INSY THEN 40731000 T 0171
BEGIN 40732000 T 0172
IF TYPETAB1[TYPE1].FORM≠NUMERIC OR CURTYPE≠REALTYPE THEN 40733000 T 0173
CHECKTYPES(TYPE1,CURTYPE); 40734000 T 0175
END ELSE 40735000 T 0177
IF TYPETAB1[CURTYPE].FORM≠SET THEN ERROR(66) 40736000 T 0177
ELSE CHECKTYPES(TYPE1,TYPETAB1[CURTYPE].SETTYPE); 40737000 T 0181
IF CURMODE=BITPATTERN THEN 40738000 T 0184
BEGIN SYMTAB[STARTSYM]:=" REAL("; PUTSYM(")") END; 40739000 T 0184
IF CALLGEN THEN PUTSYM(")"); 40740000 T 0194
CURTYPE:=BOOLTYPE; CURMODE:=BITPATTERN; 40741000 T 0202
END; 40742000 T 0203
EXPRLEVEL:=EXPRLEVEL-1; 40743000 T 0203
IF EXPRLEVEL=0 THEN 40744000 T 0204
BEGIN 40745000 T 0205
IF CURMODE=BITPATTERN THEN 40746000 T 0206
BEGIN 40747000 T 0206
SYMTAB[FIRSTSYM] := " REAL("; 40748000 T 0207
PUTSYM(")"); 40749000 T 0208
END; 40750000 T 0216
IF EXPINVARCNT=0 THEN WRITEEXPR; % %002- 40751000 P 0216
END; 40752000 T 0218
END OF EXPRESSION; 40753000 T 0218
40 IS 223 LONG, NEXT SEG 2
40754000 T 0082
40755000 T 0082
DEFINE BOOLEXPR= 40756000 T 0082
BEGIN 40757000 T 0082
PUTDUMMY; EXPRLEVEL:=1; EXPRESSION; 40758000 T 0082
IF CURTYPE>0 THEN IF CURTYPE≠BOOLTYPE THEN ERROR(17); 40759000 T 0082
IF CURMODE≠BITPATTERN THEN 40760000 T 0082
BEGIN SYMTAB[1]:=" B("; PUTSYM(")") END; 40761000 T 0082
EXPRLEVEL:=0; WRITEEXPR; 40762000 T 0082
END OF BOOLEAN#; 40763000 T 0082
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50001000 T 0082
% % 50002000 T 0082
% % 50003000 T 0082
% % 50004000 T 0082
% PART 5: INTRINSIC ROUTINES. % 50005000 T 0082
% ------------------- % 50006000 T 0082
% % 50007000 T 0082
% % 50008000 T 0082
% % 50009000 T 0082
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50010000 T 0082
50011000 T 0082
50012000 T 0082
PROCEDURE CONCAT; %*** "CONCAT" *** 50013000 T 0082
BEGIN %**************** 50014000 T 0082
DEFINE INTEXPR= 50015000 T 0082
START OF SEGMENT ********** 41
BEGIN INSYMBOL; EXPRESSION; 50016000 T 0000
IF CURTYPE>0 THEN 50017000 T 0000
IF TYPETAB1[CURTYPE].FORM≠NUMERIC THEN ERROR(17); 50018000 T 0000
END #; 50019000 T 0000
50020000 T 0000
PUTTEXT("CONCAT"); PUTSYM("("); 50021000 T 0000
INSYMBOL; 50022000 T 0013
IF CURSY=LPAR THEN 50023000 T 0014
BEGIN 50024000 T 0014
INSYMBOL; EXPRESSION; 50025000 T 0015
IF CURTYPE>0 THEN 50026000 T 0016
IF TYPETAB1[CURTYPE].FORM>ALFA THEN ERROR(17); 50027000 T 0017
IF CURSY=COMMA THEN 50028000 T 0020
BEGIN 50029000 T 0021
PUTSYM(","); INSYMBOL; EXPRESSION; 50030000 T 0021
IF CURTYPE>0 THEN 50031000 T 0029
IF TYPETAB1[CURTYPE].FORM>ALFA THEN ERROR(17); 50032000 T 0030
IF CURSY=COMMA THEN 50033000 T 0033
BEGIN 50034000 T 0034
PUTSYM(","); INTEXPR; 50035000 T 0034
IF CURSY=COMMA THEN 50036000 T 0046
BEGIN 50037000 T 0047
PUTSYM(","); INTEXPR; 50038000 T 0047
IF CURSY=COMMA THEN 50039000 T 0059
BEGIN 50040000 T 0060
PUTSYM(","); INTEXPR; 50041000 T 0060
PUTSYM(","); PUTCONST(CARDCNT); 50042000 T 0072
PUTSYM(")"); 50043000 T 0091
IF CURSY≠RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; 50044000 T 0098
END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50045000 T 0101
END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50046000 T 0103
END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50047000 T 0105
END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50048000 T 0107
END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50049000 T 0109
CURTYPE := 0; % ALFATYPE OR REALTYPE %509- 50050000 P 0111
IF CURSY=RPAR THEN INSYMBOL; 50051000 T 0111
END OF CONCAT; 50052000 T 0113
41 IS 114 LONG, NEXT SEG 2
50053000 T 0082
50054000 T 0082
PROCEDURE PREAD(CHANGELINE); 50055000 T 0082
VALUE CHANGELINE; BOOLEAN CHANGELINE; 50056000 T 0082
BEGIN 50057000 T 0082
INTEGER FILEID,F; 50058000 T 0082
START OF SEGMENT ********** 42
GEN(" BEGIN",7,2); 50060000 T 0000
FILEPARAM(INPUTFILE); FILEID:=FILENAME; 50061000 T 0001
IF TYPETAB1[CURTYPE].FORM=FILES THEN ERROR(85); 50062000 T 0003
IF SYMKIND[CURSY]≠TERMINAL THEN 50063000 T 0005
BEGIN 50064000 T 0006
IF CURSY NEQ RPAR THEN 50065000 T 0007
DO BEGIN 50066000 T 0008
WHILE CURSY=COMMA DO INSYMBOL; 50067000 T 0009
IF CURSY=IDENTIFIER THEN 50068000 T 0013
BEGIN 50069000 T 0013
SEARCH; 50070000 T 0014
IF FOUND THEN 50071000 T 0014
BEGIN 50072000 T 0015
IF THISID.IDCLASS=VAR OR 50073000 T 0015
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 50074000 T 0016
BEGIN 50075000 T 0019
VARIABLE; F:=TYPETAB1[CURTYPE].FORM; 50076000 T 0019
IF F=NUMERIC OR F=FLOATING OR F=CHAR THEN 50077000 T 0021
BEGIN 50078000 T 0024
GEN("PREAD(",6,2); WRITEEXPR; GEN(",",1,7); % %600- 50079000 P 0025
GENID("F",FILEID,5); GEN(",",1,7); % %600- 50082000 P 0028
GENID("V",FILEID,5); GEN(",",1,7); 50083000 T 0031
GENID("I",FILEID,5); GEN(",",1,7); 50084000 T 0034
IF F=NUMERIC THEN GENINT(2) ELSE 50085000 T 0037
IF F=FLOATING THEN GENINT(3) ELSE GENINT(1); 50086000 T 0039
IF F=NUMERIC THEN % %600- 50086010 C 0044
BEGIN % %600- 50086050 C 0045
GEN(",",1,7); GENINT(TYPETAB2[CURTYPE]); % %600- 50086100 C 0045
GEN(",",1,7); GENINT(TYPETAB3[CURTYPE]); % %600- 50086150 C 0048
END ELSE GEN(",0,0,",4,4); % %600- 50086200 C 0050
GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50087000 T 0052
END ELSE BEGIN ERROR(82); INSYMBOL END; 50094000 T 0056
END ELSE BEGIN ERROR(8); INSYMBOL END; 50095000 T 0059
END ELSE BEGIN ERROR(1); INSYMBOL END; 50096000 T 0061
END ELSE ERROR(9); 50097000 T 0062
GEN(";",1,7); 50098000 T 0064
END UNTIL CURSY≠COMMA; 50099000 T 0065
IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50100000 T 0066
IF CURSY=RPAR THEN INSYMBOL; 50101000 T 0069
END; 50102000 T 0071
IF CHANGELINE THEN 50103000 T 0071
BEGIN 50104000 T 0071
GEN("RLINE(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 50105000 T 0072
GENID("V",FILEID,5); GEN(",",1,7); 50106000 T 0076
GENID("I",FILEID,5); GEN(")",1,7); 50107000 T 0079
END; 50108000 T 0082
GEN("END",4,5); 50109000 T 0082
END OF PREAD; 50110000 T 0084
42 IS 90 LONG, NEXT SEG 2
50111000 T 0082
50112000 T 0082
PROCEDURE PWRITE(LINEFEED); 50113000 T 0082
VALUE LINEFEED; BOOLEAN LINEFEED; 50114000 T 0082
BEGIN 50115000 T 0082
INTEGER FILEID,F,I,LASTSY; 50116000 T 0082
START OF SEGMENT ********** 43
POINTER P; 50117000 T 0000
GEN(" BEGIN",7,2); 50118000 T 0000
FILEPARAM(OUTPUTFILE); FILEID:=FILENAME; 50119000 T 0001
IF TYPETAB1[CURTYPE].FORM=FILES THEN ERROR(85); 50120000 T 0003
IF SYMKIND[CURSY]≠TERMINAL THEN 50121000 T 0005
BEGIN 50122000 T 0006
IF CURSY NEQ RPAR THEN 50123000 T 0007
DO BEGIN 50124000 T 0008
WHILE CURSY=COMMA DO INSYMBOL; 50125000 T 0009
IF CURSY=ALFACONST AND CURLENGTH>7 THEN 50126000 T 0013
BEGIN 50127000 T 0014
GEN("WALFA(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 50128000 T 0015
GENID("V",FILEID,5); GEN(",",1,7); 50129000 T 0019
GENID("I",FILEID,5); GEN(",",1,7); 50130000 T 0022
P:=STRINGPNT; 50131000 T 0025
FOR I:=1 STEP 7 UNTIL 80 DO 50132000 T 0026
IF I≤CURLENGTH THEN 50133000 T 0029
BEGIN 50134000 T 0029
IF ALGOLCNT<10 THEN WRITEALGOL; 50135000 T 0030
REPLACE ALGOLPNT:ALGOLPNT BY """, P:P FOR 7, """, ","; 50136000 T 0032
ALGOLCNT:=ALGOLCNT-10; 50137000 T 0043
END ELSE GEN("0,",2,6); 50138000 T 0045
GENINT(CURLENGTH); GEN(",",1,7); 50139000 T 0049
GENINT(CARDCNT); GEN(")",1,7); 50140000 T 0051
INSYMBOL; 50141000 T 0053
END OF ALFACONST ELSE 50142000 T 0054
BEGIN 50143000 T 0054
GEN("PWRITE(",7,1); GENID("F",FILEID,5); GEN(",",1,7); 50144000 T 0054
GENID("V",FILEID,5); GEN(",",1,7); 50145000 T 0059
GENID("I",FILEID,5); GEN(",",1,7); 50146000 T 0062
LASTSY:=CURSY; 50147000 T 0065
EXPRESSION; F:=TYPETAB1[CURTYPE].FORM; 50148000 T 0066
GEN(",",1,7); 50149000 T 0068
IF F=NUMERIC OR F=FLOATING OR F=CHAR OR F=ALFA OR 50150000 T 0069
CURTYPE=BOOLTYPE THEN 50151000 T 0073
BEGIN 50152000 T 0074
IF F=NUMERIC THEN GENINT(1) ELSE 50153000 T 0074
IF F=FLOATING THEN GENINT(2) ELSE 50154000 T 0076
IF F=ALFA THEN GENINT(5) ELSE 50155000 T 0081
IF F=CHAR THEN GENINT(4) ELSE GENINT(3); 50156000 T 0083
GEN(",",1,7); 50157000 T 0087
IF CURSY=COLON THEN 50158000 T 0088
BEGIN 50159000 T 0089
INSYMBOL; EXPRESSION; 50160000 T 0090
IF TYPETAB1[CURTYPE].FORM NEQ NUMERIC THEN ERROR(17); 50161000 T 0091
GEN(",",1,7); 50162000 T 0093
IF CURSY=COLON THEN 50163000 T 0095
BEGIN 50164000 T 0096
IF F≠FLOATING THEN ERROR(4); 50165000 T 0096
INSYMBOL; EXPRESSION; 50166000 T 0098
IF TYPETAB1[CURTYPE].FORM NEQ NUMERIC THEN ERROR(17); 50167000 T 0099
GEN(",",1,7); 50168000 T 0102
END ELSE GEN("-1,",3,5); 50169000 T 0103
END ELSE 50170000 T 0105
BEGIN 50171000 T 0105
IF F=FLOATING THEN GENINT(16) ELSE 50172000 T 0108
IF F=ALFA AND LASTSY=ALFACONST THEN GENINT(CURLENGTH) ELSE 50173000 T 0110
IF F=ALFA THEN GENINT(7) ELSE 50174000 T 0113
IF F=CHAR THEN GENINT(1) ELSE GENINT(10); 50175000 T 0116
GEN(",-1,",4,4); 50176000 T 0119
END; 50177000 T 0121
END ELSE ERROR(17); 50178000 T 0121
GENINT(CARDCNT); GEN(")",1,7); 50179000 T 0123
END OF EXPRESSION; 50180000 T 0126
GEN(";",1,7); 50181000 T 0126
END UNTIL CURSY≠COMMA; 50182000 T 0127
IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50183000 T 0128
IF CURSY=RPAR THEN INSYMBOL; 50184000 T 0131
END; 50185000 T 0133
FILENAME:=FILEID; 50186000 T 0133
IF LINEFEED THEN 50187000 T 0134
BEGIN 50188000 T 0134
INTEGER DUMMY; 50189000 T 0134
START OF SEGMENT ********** 44
GEN("WLINE(",6,2); GENID("F",FILENAME,5); GEN(",",1,7); 50190000 T 0000
GENID("V",FILENAME,5); GEN(",",1,7); 50191000 T 0004
GENID("I",FILENAME,5); GEN(")",1,7); 50192000 T 0007
END; 50193000 T 0010
44 IS 12 LONG, NEXT SEG 43
GEN("END",4,5); 50194000 T 0136
END OF PWRITE; 50195000 T 0137
43 IS 143 LONG, NEXT SEG 2
50196000 T 0082
50197000 T 0082
PROCEDURE FILEHANDLING(PROCNUM); %*** FILE HANDLING PROCEDURES: 50198000 T 0082
VALUE PROCNUM; INTEGER PROCNUM; %*** 50199000 T 0082
BEGIN %*** 1) PUT 50200000 T 0082
INTEGER F; %*** 2) GET 50201000 T 0082
START OF SEGMENT ********** 45
LABEL EFH; %002- 50201500 C 0000
CASE PROCNUM OF %*** 3) RESET 50202000 T 0000
BEGIN ; % NULL %*** 4) REWRITE %001- 50203000 P 0000
GEN("PUT",3,5); %*** 5) PAGE %001- 50204000 P 0000
%*** 6) OPEN & CLOSE (INPUT) FOR 50204500 C 0002
% CUMULATIVE FREQUENCY COUNT 50204550 C 0002
GEN("GET",3,5); % 50205000 T 0002
GEN("RESET",5,3); % 50206000 T 0004
GEN("REWRITE",7,1); % 50207000 T 0006
GEN("PPAGE",5,3); % %001- 50208000 P 0008
BEGIN %002- 50208100 C 0010
GEN("QQJZXL",6,2); %002- 50208200 C 0010
INSYMBOL; %002- 50208300 C 0012
GO TO EFH; % %002- 50208400 C 0012
END; %002- 50208500 C 0020
END; % 50209000 T 0020
START OF SEGMENT ********** 46
46 IS 8 LONG, NEXT SEG 45
GEN("(",1,7); FILEPARAM(0); % 50210000 T 0021
IF FILENAME=0 THEN ERROR(78); % 50211000 T 0023
F:=TYPETAB1[CURTYPE].FORM; 50212000 T 0025
IF F=FILES AND PROCNUM=5 THEN ERROR(80); 50213000 T 0026
GENID("F",FILENAME,5); GEN(",",1,7); 50214000 T 0029
GENID("V",FILENAME,5); GEN(",",1,7); 50215000 T 0032
GENID("I",FILENAME,5); GEN(",",1,7); 50216000 T 0035
GENINT(CARDCNT); GEN(")",1,7); 50217000 T 0038
IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50218000 T 0041
IF CURSY=RPAR THEN INSYMBOL; 50219000 T 0043
EFH: %002- 50219500 C 0045
END OF FILEHANDLING; 50220000 T 0046
45 IS 49 LONG, NEXT SEG 2
50221000 T 0082
50222000 T 0082
PROCEDURE PACK; 50223000 T 0082
BEGIN 50224000 T 0082
INTEGER IT; REAL T; %503- 50225000 P 0082
START OF SEGMENT ********** 47
GEN("PACK(",5,3); 50226000 T 0000
INSYMBOL; 50227000 T 0001
IF CURSY=LPAR THEN 50228000 T 0002
BEGIN 50229000 T 0002
INSYMBOL; 50230000 T 0003
IF CURSY=IDENTIFIER THEN 50231000 T 0003
BEGIN 50232000 T 0004
SEARCH; 50233000 T 0005
IF FOUND THEN 50234000 T 0005
BEGIN 50235000 T 0005
IF THISID.IDCLASS=VAR THEN 50236000 T 0006
BEGIN 50237000 T 0007
T:=TYPETAB1[THISID.TYPE]; 50238000 T 0008
IF T.FORM=ARRAYS THEN 50239000 T 0009
BEGIN 50240000 T 0010
IT:=T.INXTYPE; 50241000 T 0011
IF TYPETAB1[T.ARRTYPE].FORM≠CHAR THEN ERROR(88); 50242000 T 0012
GENID("H",1000×THISLEVEL+THISINDEX,5); %518- 50243100 C 0015
GEN(",",1,7); GENINT(TYPETAB2[THISID.TYPE]); 50245000 T 0018
GEN(",",1,7); GENINT(TYPETAB3[THISID.TYPE]); 50246000 T 0021
END ELSE ERROR(88); 50247000 T 0024
END ELSE ERROR(88); 50248000 T 0026
END ELSE ERROR(1); 50249000 T 0028
END ELSE ERROR(9); 50250000 T 0029
INSYMBOL; 50251000 T 0030
IF CURSY=COMMA THEN 50252000 T 0031
BEGIN 50253000 T 0031
GEN(",",1,7); 50254000 T 0032
INSYMBOL; EXPRESSION; CHECKTYPES(IT,CURTYPE); 50255000 T 0033
IF CURSY=COMMA THEN 50256000 T 0035
BEGIN 50257000 T 0036
GEN(",",1,7); 50258000 T 0037
INSYMBOL; 50259000 T 0038
IF CURSY=IDENTIFIER THEN 50260000 T 0039
BEGIN 50261000 T 0039
SEARCH; 50262000 T 0040
IF FOUND THEN 50263000 T 0040
BEGIN 50264000 T 0041
IF THISID.IDCLASS=VAR OR 50265000 T 0041
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 50266000 T 0042
BEGIN 50267000 T 0045
VARIABLE; WRITEEXPR; 50268000 T 0045
IF CURTYPE>0 THEN 50269000 T 0046
IF TYPETAB1[CURTYPE].FORM≠ALFA THEN ERROR(12); 50270000 T 0047
END ELSE ERROR(8); 50271000 T 0050
END ELSE ERROR(1); 50272000 T 0052
END ELSE ERROR(9); 50273000 T 0053
END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50274000 T 0054
END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50275000 T 0056
IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50276000 T 0058
IF CURSY=RPAR THEN INSYMBOL; 50277000 T 0061
END ELSE BEGIN ERROR(3); INSYMBOL END; 50278000 T 0063
GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50279000 T 0064
END OF PACK; 50280000 T 0068
47 IS 72 LONG, NEXT SEG 2
50281000 T 0082
50282000 T 0082
PROCEDURE UNPACK; 50283000 T 0082
BEGIN 50284000 T 0082
INTEGER IT; REAL T; %503- 50285000 P 0082
START OF SEGMENT ********** 48
GEN("UNPACK(",7,1); INSYMBOL; 50286000 T 0000
IF CURSY=LPAR THEN 50287000 T 0002
BEGIN 50288000 T 0002
INSYMBOL; EXPRESSION; 50289000 T 0003
IF CURTYPE>0 THEN IF TYPETAB1[CURTYPE].FORM≠ALFA THEN ERROR(17); 50290000 T 0004
IF CURSY=COMMA THEN 50291000 T 0008
BEGIN 50292000 T 0009
GEN(",",1,7); INSYMBOL; 50293000 T 0009
IF CURSY=IDENTIFIER THEN 50294000 T 0011
BEGIN 50295000 T 0012
SEARCH; 50296000 T 0012
IF FOUND THEN 50297000 T 0013
BEGIN 50298000 T 0013
IF THISID.IDCLASS=VAR THEN 50299000 T 0014
BEGIN 50300000 T 0015
T:=TYPETAB1[THISID.TYPE]; 50301000 T 0015
IF T.FORM=ARRAYS THEN 50302000 T 0017
BEGIN 50303000 T 0018
IT:=T.INXTYPE; 50304000 T 0019
IF TYPETAB1[T.ARRTYPE].FORM≠CHAR THEN ERROR(88); 50305000 T 0020
GENID("H",1000×THISLEVEL+THISINDEX,5); %518- 50307100 C 0023
GEN(",",1,7); GENINT(TYPETAB2[THISID.TYPE]); 50308000 T 0026
GEN(",",1,7); GENINT(TYPETAB3[THISID.TYPE]); 50309000 T 0029
END ELSE ERROR(88); 50310000 T 0032
END ELSE ERROR(88); 50311000 T 0034
END ELSE ERROR(1); 50312000 T 0036
END ELSE ERROR(9); 50313000 T 0037
INSYMBOL; 50314000 T 0038
IF CURSY=COMMA THEN 50315000 T 0039
BEGIN 50316000 T 0039
GEN(",",1,7); 50317000 T 0040
INSYMBOL; EXPRESSION; CHECKTYPES(IT,CURTYPE); 50318000 T 0041
END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50319000 T 0043
END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50320000 T 0045
IF CURSY≠RPAR THEN BEGIN ERROR(89); SKIP(RPAR) END; 50321000 T 0047
IF CURSY=RPAR THEN INSYMBOL; 50322000 T 0050
END ELSE BEGIN ERROR(3); INSYMBOL END; 50323000 T 0052
GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50324000 T 0054
END OF UNPACK; 50325000 T 0057
48 IS 61 LONG, NEXT SEG 2
50326000 T 0082
50327000 T 0082
PROCEDURE NEWDISP; %*** "NEW","DISPOSE" 50328000 T 0082
BEGIN 50329000 T 0082
INTEGER T1; 50330000 T 0082
START OF SEGMENT ********** 49
IF CURNAME1="3000NEW" THEN GEN("NEW(",4,4) ELSE 50331000 T 0000
BEGIN GEN("DISPOSE",7,1); GEN("(",1,7) END; 50332000 T 0002
INSYMBOL; 50333000 T 0009
IF CURSY=LPAR THEN 50334000 T 0009
BEGIN 50335000 T 0010
INSYMBOL; 50336000 T 0010
IF CURSY=IDENTIFIER THEN 50337000 T 0011
BEGIN 50338000 T 0012
SEARCH; 50339000 T 0012
IF FOUND THEN 50340000 T 0013
BEGIN 50341000 T 0013
VARIABLE; 50342000 T 0013
IF CURTYPE>0 THEN IF TYPETAB1[CURTYPE].FORM=POINTERS THEN 50343000 T 0014
BEGIN 50344000 T 0017
WRITEEXPR; GEN(",",1,7); 50345000 T 0017
T1:=TYPETAB1[CURTYPE].POINTTYPE; 50346000 T 0019
T1:=TYPETAB1[T1].SIZE; 50347000 T 0021
IF T1>1023 THEN ERROR(86); 50348000 T 0022
GENINT(T1); GEN(")",1,7); 50349000 T 0024
END ELSE ERROR(81); 50350000 T 0026
END ELSE BEGIN ERROR(1); INSYMBOL END; 50351000 T 0029
END ELSE ERROR(9); 50352000 T 0031
WHILE CURSY=COMMA DO 50353000 T 0032
BEGIN INSYMBOL; 50354000 T 0034
IF CURSY NEQ IDENTIFIER THEN ERROR(9); 50355000 T 0034
IF CURSY NEQ RPAR THEN INSYMBOL; 50356000 T 0036
END; 50357000 T 0038
END ELSE BEGIN ERROR(58); SKIP(RPAR) END; 50358000 T 0039
IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50359000 T 0041
IF CURSY=RPAR THEN INSYMBOL; 50360000 T 0043
END OF NEWDISP; 50361000 T 0045
49 IS 48 LONG, NEXT SEG 2
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 60001000 T 0082
% % 60002000 T 0082
% % 60003000 T 0082
% % 60004000 T 0082
% PART 6: THE STATEMENT PARSER. % 60005000 T 0082
% --------------------- % 60006000 T 0082
% % 60007000 T 0082
% % 60008000 T 0082
% % 60009000 T 0082
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 60010000 T 0082
60011000 T 0082
60012000 T 0082
60013000 T 0082
PROCEDURE STATEMENT; FORWARD; 60014000 T 0082
60015000 T 0082
PROCEDURE ASSIGNMENT; 60016000 T 0082
BEGIN 60017000 T 0082
INTEGER LEFTTYPE; 60018000 T 0082
START OF SEGMENT ********** 50
LABEL ASSIGN,EXIT; 60019000 T 0000
%512- 60020000 C 0000
PROCEDURE WRITESEXPR; %*** FIX STRUCTURE FOR ASSIGNMENT %512- 60021000 C 0000
BEGIN % USED ONLY IN ASSIGNMENT OF STRUCTURES 60022000 C 0000
IF INSIDEBRACKETS THEN IF SYMTAB[NUMSYMS] = "100000," %512- 60023000 C 0000
THEN SYMTAB[NUMSYMS] := ", 0 ] " ELSE PUTSYM("]"); %512- 60024000 C 0001
WHILE NUMPOINTERS>0 DO %512- 60025000 C 0012
BEGIN NUMPOINTERS := NUMPOINTERS-1; %512- 60026000 C 0014
IF NUMSYMS+4 ≥ MAXSYMS THEN WRITEEXPR; %512- 60027000 C 0015
REPLACE POINTER(SYMTAB[NUMSYMS+1]) BY %512- 60028000 C 0017
"00-1)DIV00 1022,00 T MOD00 1022]"; %512- 60029000 C 0021
NUMSYMS := NUMSYMS+4; %512- 60030000 C 0025
END; % OF WHILE %512- 60031000 C 0026
WRITEEXPR; GEN( ",", 1,7 ); %512- 60032000 C 0026
END WRITESEXPR; %512- 60033000 C 0028
%512- 60034000 C 0029
IF FOUND THEN 60050000 T 0029
BEGIN 60051000 T 0029
IF THISID.IDCLASS=VAR OR 60052000 T 0029
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 60053000 T 0031
BEGIN 60054000 T 0033
VARIABLE; LEFTTYPE:=CURTYPE; 60055000 T 0034
ASSIGN: IF CURSY≠ASSIGNSY THEN 60056000 T 0035
BEGIN ERROR(28); SKIP(ASSIGNSY); 60057000 T 0036
IF SYMKIND[CURSY]=TERMINAL THEN GO TO EXIT; 60058000 T 0038
END; 60059000 T 0040
INSYMBOL; 60060000 T 0040
IF TYPETAB1[LEFTTYPE].STRUCT>0 THEN 60061000 T 0040
BEGIN 60062000 T 0042
%ERROR(95); % STRUCTURED ASSIGNMENT NOT IMPLEMENTED. %512- 60063000 P 0042
EXPRLEVEL := EXPRLEVEL+1; %507- 60063900 C 0042
GEN("ASSIGN(",7,1); WRITESEXPR; %512- 60064000 C 0044
EXPRESSION; WRITESEXPR; %512- 60065000 C 0046
EXPRLEVEL := EXPRLEVEL-1; %507- 60065100 C 0048
GENINT(TYPETAB1[LEFTTYPE].SIZE); GEN(")",1,7); %512- 60066000 C 0049
IF TYPETAB1[LEFTTYPE].SIZE≠TYPETAB1[CURTYPE].SIZE %512- 60067000 C 0052
THEN ERROR(95); %512- 60068000 C 0053
END ELSE 60080000 T 0055
IF TYPETAB1[LEFTTYPE].FORM=SET THEN % %601- 60080100 C 0055
BEGIN % %601- 60080200 C 0059
SYMTAB[1] := "SSTOR("; NUMSYMS := NUMSYMS - 3; % %601- 60080300 C 0060
EXPRESSION; % %601- 60080400 C 0062
PUTSYM(")"); CHECKTYPES(LEFTTYPE,CURTYPE); % %601- 60080500 C 0063
WRITEEXPR; % %601- 60080600 C 0072
END ELSE % %601- 60080700 C 0073
BEGIN 60081000 T 0073
WRITEEXPR; GEN(":=",2,6); 60082000 T 0073
IF CHECKOPTION AND TYPETAB1[LEFTTYPE].FORM≤CHAR THEN 60083000 T 0075
CHECKEXPR(TYPETAB2[LEFTTYPE],TYPETAB3[LEFTTYPE]) ELSE 60084000 T 0077
EXPRESSION; 60085000 T 0079
WRITEEXPR; 60086000 T 0080
END; %512- 60087000 P 0081
CHECKTYPES( LEFTTYPE, CURTYPE ); %512- 60088000 P 0081
END ELSE 60089000 T 0082
BEGIN % FUNCTION ASSIGNMENT. 60090000 T 0082
IF THISLEVEL≠CURLEVEL-1 OR THISINDEX≠CURFUNC THEN ERROR(5);%511- 60091000 P 0082
GENID("V",1000×THISLEVEL+THISINDEX,5); LEFTTYPE:=THISID.TYPE; 60092000 T 0086
INSYMBOL; GO TO ASSIGN; 60093000 T 0089
END; 60094000 T 0090
END ELSE 60095000 T 0090
BEGIN 60096000 T 0090
SKIP(ASSIGNSY); 60097000 T 0091
IF CURSY=ASSIGNSY THEN GO TO ASSIGN; 60098000 T 0092
END; 60099000 T 0093
EXIT: 60100000 T 0093
END OF ASSIGNMENT; 60101000 T 0094
50 IS 100 LONG, NEXT SEG 2
60102000 T 0082
60103000 T 0082
PROCEDURE COMPSTAT; 60104000 T 0082
BEGIN 60105000 T 0082
INTEGER BEGINNUM; 60106000 T 0082
START OF SEGMENT ********** 51
LABEL STATM; 60107000 T 0000
60108000 T 0000
BEGINNUM:=NUMBEGINS:=NUMBEGINS+1; MARGIN(" B",BEGINNUM); 60109000 T 0000
GEN("BEGIN",6,3); 60110000 T 0019
DO BEGIN 60111000 T 0021
IF CURSY=SEMICOLON OR CURSY=BEGINSY THEN INSYMBOL; 60112000 T 0021
STATM: STATEMENT; 60113000 T 0023
GEN(";",1,7); 60114000 T 0024
IF CURSY=ELSESY THEN BEGIN ERROR(20); INSYMBOL; GO STATM END; 60115000 T 0026
IF SYMKIND[CURSY]=INITIAL THEN BEGIN ERROR(21); GO STATM END; 60116000 T 0031
END UNTIL CURSY≠SEMICOLON; 60117000 T 0033
IF CURSY≠ENDSY THEN 60118000 T 0035
BEGIN ERROR(24); SKIP(ENDSY); 60119000 T 0035
IF CURSY≠ENDSY THEN BEGIN INSYMBOL; GO TO STATM END; 60120000 T 0037
END; 60121000 T 0040
GEN(" END",5,4); MARGIN(" E",BEGINNUM); 60122000 T 0040
INSYMBOL; 60123000 T 0059
END OF COMPSTAT; 60124000 T 0059
51 IS 64 LONG, NEXT SEG 2
60125000 T 0082
60126000 T 0082
PROCEDURE IFSTAT; 60127000 T 0082
BEGIN 60128000 T 0082
LABEL EXIT; 60129000 T 0082
START OF SEGMENT ********** 52
GEN("IF",3,6); 60130000 T 0000
INSYMBOL; BOOLEXPR; 60131000 T 0001
IF CURSY≠THENSY THEN 60132000 T 0026
BEGIN IF CURTYPE>0 THEN ERROR(27); 60133000 T 0027
SKIP(THENSY); 60134000 T 0030
IF CURSY≠THENSY THEN 60135000 T 0030
BEGIN IF CURTYPE=0 THEN ERROR(27); 60136000 T 0031
IF SYMKIND[CURSY]=TERMINAL THEN GO TO EXIT; 60137000 T 0034
END; END; 60138000 T 0035
GEN(" THEN",6,3); 60139000 T 0035
INSYMBOL; STATEMENT; 60140000 T 0037
IF CURSY=ELSESY THEN 60141000 T 0038
BEGIN GEN(" ELSE",6,3); INSYMBOL; STATEMENT END; 60142000 T 0038
EXIT: 60143000 T 0041
END OF IFSTAT; 60144000 T 0042
52 IS 45 LONG, NEXT SEG 2
60145000 T 0082
60146000 T 0082
PROCEDURE CASESTAT; 60147000 T 0082
BEGIN 60148000 T 0082
DEFINE CASEHASH(N)=(N).[38:39] MOD MAXCASES#; 60149000 T 0082
START OF SEGMENT ********** 53
INTEGER ARRAY CASETAB[0:MAXCASES]; 60150000 T 0000
INTEGER CASENUM,CASETYPE,NCASELABS,TEMPVARNUM,CONVAL,CONTYPE,C,T; 60151000 T 0001
BOOLEAN ZEROLAB,FIRST; 60152000 T 0001
60153000 T 0001
CASENUM:=NUMCASES:=NUMCASES+1; MARGIN("CB",CASENUM); 60154000 T 0001
TEMPVARNUM:=NUMTEMPS:=NUMTEMPS+1; 60155000 T 0021
IF TEMPVARNUM>MAXTEMPS THEN ERROR(16); 60156000 T 0023
GEN("BEGIN",6,3); GENID("T",TEMPVARNUM,2); GEN(":=",2,6); 60157000 T 0025
INSYMBOL; EXPRESSION; 60158000 T 0029
GEN(";",1,7); CASETYPE:=CURTYPE; 60159000 T 0030
IF TYPETAB1[CASETYPE].FORM≥FLOATING THEN 60160000 T 0032
BEGIN ERROR(17); CASETYPE:=0 END; 60161000 T 0034
IF CURSY≠OFSY THEN 60162000 T 0036
BEGIN IF CASETYPE>0 THEN ERROR(18); 60163000 T 0037
SKIP(OFSY); 60164000 T 0039
IF CURSY=OFSY THEN INSYMBOL ELSE 60165000 T 0040
IF CASETYPE=0 THEN ERROR(18); 60166000 T 0042
END ELSE INSYMBOL; 60167000 T 0047
DO BEGIN 60168000 T 0048
WHILE CURSY=SEMICOLON DO INSYMBOL; 60169000 T 0048
FIRST:=TRUE; 60170000 T 0050
IF CURSY≠ENDSY THEN 60171000 T 0051
BEGIN 60172000 T 0051
GEN("IF",3,6); 60173000 T 0052
DO BEGIN 60174000 T 0053
IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 60175000 T 0054
CONSTANT(CONVAL,CONTYPE); 60176000 T 0057
IF CONTYPE>0 THEN 60177000 T 0058
BEGIN 60178000 T 0059
IF CASETYPE=0 THEN CASETYPE:=CONTYPE ELSE 60179000 T 0059
CHECKTYPES(CASETYPE,CONTYPE); 60180000 T 0061
GENID("T",TEMPVARNUM,2); GEN("=",1,7); GENINT(CONVAL); 60181000 T 0063
NCASELABS:=NCASELABS+1; 60182000 T 0067
IF NCASELABS<MAXCASES THEN 60183000 T 0068
BEGIN 60184000 T 0069
IF CONVAL=0 THEN 60185000 T 0069
IF ZEROLAB THEN ERROR(31) ELSE ZEROLAB:=TRUE ELSE 60186000 T 0070
BEGIN 60187000 T 0073
T:=CASEHASH(CONVAL); 60188000 T 0074
FOR C:=CASETAB[T] WHILE C≠CONVAL AND C≠0 DO 60189000 T 0075
T:=IF T=0 THEN MAXCASES ELSE T-1; 60190000 T 0079
IF C≠0 THEN ERROR(31) ELSE CASETAB[T]:=CONVAL; 60191000 T 0083
END; 60192000 T 0087
END ELSE IF NCASELABS=MAXCASES THEN ERROR(30); 60193000 T 0087
IF CURSY=COMMA THEN GEN(" OR",4,5); 60194000 T 0089
END; 60195000 T 0092
END UNTIL CURSY≠COMMA; 60196000 T 0092
GEN(" THEN",6,3); 60197000 T 0093
IF CURSY≠COLON THEN BEGIN ERROR(26); SKIP(COLON) END; 60198000 T 0095
IF CURSY=COLON THEN INSYMBOL; 60199000 T 0098
STATEMENT; 60200000 T 0099
IF CURSY≠SEMICOLON AND CURSY≠ENDSY THEN 60201000 T 0100
BEGIN ERROR(21); SKIP(SEMICOLON) END; 60202000 T 0102
END; 60203000 T 0104
IF CURSY=SEMICOLON THEN GEN(" ELSE",6,3); 60204000 T 0104
END UNTIL CURSY≠SEMICOLON; 60205000 T 0106
IF CURSY≠ENDSY THEN BEGIN ERROR(24); SKIP(ENDSY) END; 60206000 T 0108
GEN(" END",5,4); MARGIN("CE",CASENUM); 60207000 T 0110
NUMTEMPS:=NUMTEMPS-1; 60208000 T 0130
INSYMBOL; 60209000 T 0131
END OF CASESTAT; 60210000 T 0131
53 IS 144 LONG, NEXT SEG 2
60211000 T 0082
60212000 T 0082
PROCEDURE WHILESTAT; 60213000 T 0082
BEGIN 60214000 T 0082
LABEL STATM,EXIT; 60215000 T 0082
START OF SEGMENT ********** 54
GEN("WHILE",6,3); 60216000 T 0000
INSYMBOL; BOOLEXPR; 60217000 T 0001
IF CURSY≠DOSY THEN 60218000 T 0026
BEGIN IF CURTYPE>0 THEN ERROR(19); 60219000 T 0027
SKIP(DOSY); 60220000 T 0030
IF CURSY≠DOSY THEN 60221000 T 0030
BEGIN IF CURTYPE=0 THEN ERROR(19); 60222000 T 0031
GO TO IF SYMKIND[CURSY]=INITIAL THEN STATM ELSE EXIT; 60223000 T 0034
END; END; 60224000 T 0039
GEN(" DO",4,5); 60225000 T 0039
INSYMBOL; 60226000 T 0040
STATM: STATEMENT; 60227000 T 0041
EXIT: 60228000 T 0042
END OF WHILESTAT; 60229000 T 0043
54 IS 49 LONG, NEXT SEG 2
60230000 T 0082
60231000 T 0082
PROCEDURE REPEATSTAT; 60232000 T 0082
BEGIN 60233000 T 0082
INTEGER REPNUM; 60234000 T 0082
START OF SEGMENT ********** 55
LABEL NEWTRY; 60235000 T 0000
60236000 T 0000
REPNUM:=NUMREPS:=NUMREPS+1; 60237000 T 0000
MARGIN(" R",REPNUM); 60238000 T 0001
GEN("DO",3,6); GEN("BEGIN",6,3); 60239000 T 0019
DO BEGIN 60240000 T 0022
INSYMBOL; 60241000 T 0023
NEWTRY: STATEMENT; 60242000 T 0023
GEN(";",1,7); 60243000 T 0024
IF CURSY=ELSESY THEN BEGIN ERROR(20);INSYMBOL; GO NEWTRY END; 60244000 T 0026
IF SYMKIND[CURSY]=INITIAL THEN BEGIN ERROR(21); GO NEWTRY END; 60245000 T 0032
END UNTIL CURSY≠SEMICOLON; 60246000 T 0034
IF CURSY≠UNTILSY THEN 60247000 T 0036
BEGIN 60248000 T 0036
ERROR(22); 60249000 T 0037
WHILE CURSY≠UNTILSY AND SYMKIND[CURSY]≠INITIAL DO 60250000 T 0038
BEGIN INSYMBOL; SKIP(UNTILSY) END; 60251000 T 0040
IF CURSY≠UNTILSY THEN GO TO NEWTRY; 60252000 T 0042
END; 60253000 T 0043
GEN(" END",5,4); GEN("UNTIL",6,3); MARGIN(" U",REPNUM); 60254000 T 0043
INSYMBOL; BOOLEXPR; 60255000 T 0064
END OF REPEATSTAT; 60256000 T 0090
55 IS 93 LONG, NEXT SEG 2
60257000 T 0082
60258000 T 0082
PROCEDURE FORSTAT; 60259000 T 0082
BEGIN 60260000 T 0082
INTEGER VARTYPE,VARNUM,LLIM,ULIM; 60261000 T 0082
START OF SEGMENT ********** 56
BOOLEAN DOWN; 60262000 T 0000
LABEL STATM; 60263000 T 0000
60264000 T 0000
GEN("BEGIN",6,3); 60265000 T 0000
INSYMBOL; 60266000 T 0001
IF CURSY=IDENTIFIER THEN 60267000 T 0002
BEGIN 60268000 T 0002
SEARCH; 60269000 T 0003
IF FOUND THEN 60270000 T 0003
BEGIN 60271000 T 0004
VARNUM:=1000×THISLEVEL+THISINDEX; 60272000 T 0004
IF THISID.IDCLASS=VAR OR 60273000 T 0006
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 60274000 T 0007
BEGIN 60275000 T 0010
IF THISLEVEL>1 AND THISLEVEL<CURLEVEL THEN ERROR(-5); %511- 60276000 P 0010
IF THISLEVEL>CURLEVEL THEN ERROR(83); 60277000 T 0013
VARTYPE:=THISID.TYPE; 60278000 T 0015
IF TYPETAB1[VARTYPE].FORM≤CHAR THEN 60279000 T 0017
BEGIN 60280000 T 0018
LLIM:=TYPETAB2[VARTYPE]; ULIM:=TYPETAB3[VARTYPE]; 60281000 T 0019
END ELSE BEGIN ERROR(12); VARTYPE:=0 END; 60282000 T 0021
END ELSE ERROR(8); 60283000 T 0024
END ELSE ERROR(1); 60284000 T 0025
END ELSE ERROR(9); 60285000 T 0027
INSYMBOL; 60286000 T 0028
IF CURSY≠ASSIGNSY THEN 60287000 T 0028
BEGIN ERROR(28); 60288000 T 0029
SKIP(ASSIGNSY); 60289000 T 0030
IF CURSY=ASSIGNSY THEN INSYMBOL ELSE 60290000 T 0031
IF SYMKIND[CURSY]=INITIAL THEN GO TO STATM; 60291000 T 0033
END ELSE INSYMBOL; 60292000 T 0035
GENID("V",VARNUM,5); GEN("←",1,7); 60293000 T 0036
IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 60294000 T 0039
WRITEEXPR; 60295000 T 0042
GEN(";",1,7); 60296000 T 0042
IF VARTYPE=0 THEN VARTYPE:=CURTYPE ELSE CHECKTYPES(VARTYPE,CURTYPE); 60297000 T 0044
NUMTEMPS:=NUMTEMPS+1; IF NUMTEMPS>MAXTEMPS THEN ERROR(16); 60298000 T 0047
IF CURSY=TOSY THEN INSYMBOL ELSE 60299000 T 0050
IF CURSY=DOWNTOSY THEN BEGIN DOWN:=TRUE; INSYMBOL END ELSE 60300000 T 0052
BEGIN IF CURTYPE>0 THEN ERROR(23); 60301000 T 0055
SKIP(TOSY); 60302000 T 0058
IF CURSY=TOSY THEN INSYMBOL ELSE 60303000 T 0058
BEGIN IF CURTYPE=0 THEN ERROR(23); 60304000 T 0060
IF SYMKIND[CURSY]=INITIAL THEN GO TO STATM; 60305000 T 0063
END; END; 60306000 T 0064
GENID("T",NUMTEMPS,2); GEN("←",1,7); 60307000 T 0064
IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 60308000 T 0067
WRITEEXPR; 60309000 T 0070
GEN(";",1,7); 60310000 T 0070
IF VARTYPE=0 THEN VARTYPE:=CURTYPE ELSE CHECKTYPES(VARTYPE,CURTYPE); 60311000 T 0072
IF CURSY≠DOSY THEN 60312000 T 0075
BEGIN IF CURTYPE>0 THEN ERROR(19); 60313000 T 0076
SKIP(DOSY); 60314000 T 0079
IF CURSY=DOSY THEN INSYMBOL ELSE 60315000 T 0079
IF CURTYPE=0 THEN ERROR(19); 60316000 T 0081
END ELSE INSYMBOL; 60317000 T 0084
GEN("FOR",4,5); GENID("V",VARNUM,5); GEN("←",1,7); 60318000 T 0085
GENID("V",VARNUM,5); GEN(" ",1,7); 60319000 T 0089
IF DOWN THEN GEN("DOWNTO",7,2) ELSE GEN("UPTO",5,4); 60320000 T 0092
GENID("T",NUMTEMPS,2); GEN(" DO",4,5); 60321000 T 0099
STATM: STATEMENT; 60322000 T 0102
GEN(" END",5,4); 60323000 T 0103
NUMTEMPS:=NUMTEMPS-1; 60324000 T 0105
END OF FORSTAT; 60325000 T 0106
56 IS 113 LONG, NEXT SEG 2
60326000 T 0082
60327000 T 0082
PROCEDURE GOTOSTAT; 60328000 T 0082
BEGIN 60329000 T 0082
INTEGER I; 60330000 T 0082
START OF SEGMENT ********** 57
INSYMBOL; 60331000 T 0000
IF CURSY=INTCONST THEN 60332000 T 0000
BEGIN I:=NUMLABS; 60333000 T 0001
WHILE I≥1 AND LABTAB[I].LABVAL≠CURVAL DO I:=I-1; 60334000 T 0002
IF I=0 THEN ERROR(15); 60335000 T 0007
GEN("GO",3,6); GENID("L",CURVAL,4); 60336000 T 0009
INSYMBOL; 60337000 T 0012
END ELSE ERROR(10); 60338000 T 0013
END OF GOTOSTAT; 60339000 T 0015
57 IS 18 LONG, NEXT SEG 2
60340000 T 0082
60341000 T 0082
PROCEDURE WITHSTAT; 60342000 T 0082
BEGIN 60343000 T 0082
INTEGER STARTLEVEL,VERYFIRSTWITHSYM,I; 60344000 T 0082
START OF SEGMENT ********** 58
REAL D; 60345000 T 0000
STARTLEVEL:=TOPLEVEL; VERYFIRSTWITHSYM:=NWITHSYMS; 60346000 T 0000
EXPRLEVEL := 1; %002- 60346500 C 0001
DO BEGIN 60347000 T 0002
INSYMBOL; 60348000 T 0003
IF CURSY=IDENTIFIER THEN 60349000 T 0003
BEGIN 60350000 T 0004
SEARCH; 60351000 T 0004
IF FOUND THEN 60352000 T 0005
BEGIN 60353000 T 0005
IF THISID.IDCLASS=VAR OR %002- 60354000 P 0006
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN %%002- 60354500 C 0007
BEGIN 60355000 T 0009
VARIABLE; 60356000 T 0010
IF CURTYPE>0 THEN 60357000 T 0010
IF TYPETAB1[CURTYPE].FORM≠RECORD THEN ERROR(98); 60358000 T 0011
IF SIMPLEVARIABLE THEN 60359000 T 0014
BEGIN PUTSYM("["); INSIDEBRACKETS:=TRUE END; 60360000 T 0015
IF TOPLEVEL<MAXLEVEL THEN 60361000 T 0023
BEGIN 60362000 T 0023
TOPLEVEL:=TOPLEVEL+1; 60363000 T 0024
D.NAMETAB:=TYPETAB1[CURTYPE].RECTAB; 60364000 T 0025
D.RECTYPE:=CURTYPE; 60365000 T 0028
D.NUMPNTRSINWITH:=NUMPOINTERS; 60366000 T 0029
D.FIRSTWITHSYM:=NWITHSYMS; 60367000 T 0031
D.BRACKETSINWITH:=REAL(INSIDEBRACKETS); 60368000 T 0033
IF NWITHSYMS+NUMSYMS>MAXWITHSYMS THEN ERROR(63) ELSE 60369000 T 0035
FOR I:=1 STEP 1 UNTIL NUMSYMS DO 60370000 T 0037
BEGIN 60371000 T 0039
WITHTAB[NWITHSYMS]:=SYMTAB[I]; 60372000 T 0039
NWITHSYMS:=NWITHSYMS+1; 60373000 T 0040
END; 60374000 T 0041
D.LASTWITHSYM:=NWITHSYMS-1; 60375000 T 0044
DISPLAY[TOPLEVEL]:=D; 60376000 T 0046
END ELSE ERROR(84); 60377000 T 0047
END ELSE BEGIN ERROR(8); INSYMBOL END; 60378000 T 0048
END ELSE BEGIN ERROR(1); INSYMBOL END; 60379000 T 0050
END ELSE BEGIN ERROR(9); INSYMBOL END; 60380000 T 0052
NUMSYMS:=0; 60381000 T 0054
NUMPOINTERS := 0; 60382000 T 0054
END UNTIL CURSY≠COMMA; 60383000 T 0055
EXPRLEVEL := 0; %002- 60383500 C 0056
IF CURSY≠DOSY THEN 60384000 T 0057
BEGIN ERROR(19); SKIP(DOSY); 60385000 T 0058
IF CURSY=DOSY THEN INSYMBOL; 60386000 T 0060
END ELSE INSYMBOL; 60387000 T 0062
STATEMENT; 60388000 T 0063
TOPLEVEL:=STARTLEVEL; NWITHSYMS:=VERYFIRSTWITHSYM; 60389000 T 0063
END OF WITHSTAT; 60390000 T 0065
58 IS 69 LONG, NEXT SEG 2
60391000 T 0082
PROCEDURE ASSERTSTAT; %002- 60391100 C 0082
BEGIN %002- 60391200 C 0082
GEN("IF NOT(",7,1); %002- 60391400 C 0082
INSYMBOL; BOOLEXPR; %002- 60391500 C 0083
GEN(") THEN",7,2); GEN("RUNERR(",7,1); GEN("7,",2,6); %002- 60391600 C 0108
GENINT(CARDCNT); GEN(")",1,7); %002- 60391700 C 0113
END OF ASSERTSTAT; %002- 60391800 C 0115
60392000 T 0118
PROCEDURE STATEMENT; 60393000 T 0118
BEGIN 60394000 T 0118
INTEGER I; 60395000 T 0118
START OF SEGMENT ********** 59
60397000 T 0000
IF CURSY=INTCONST THEN % *** LABELED STATEMENT *** 60398000 T 0000
BEGIN LABEL LABFOUND; %700- 60399000 P 0000
START OF SEGMENT ********** 60
FOR I:=FIRSTLAB STEP 1 UNTIL NUMLABS DO 60400000 T 0000
IF LABTAB[I].LABVAL=CURVAL THEN 60401000 T 0001
BEGIN IF LABTAB[I].LABDEF=1 THEN ERROR(31); 60402000 T 0002
LABTAB[I].LABDEF:=1; 60403000 T 0005
GO TO LABFOUND; 60404000 T 0008
END; 60405000 T 0008
ERROR(15); 60406000 T 0011
LABFOUND: GENID("L",CURVAL,4); GEN(":",1,7); 60407000 T 0011
INSYMBOL; 60408000 T 0015
IF CURSY≠COLON THEN 60409000 T 0015
BEGIN ERROR(26); 60410000 T 0016
SKIP(COLON); IF CURSY=COLON THEN INSYMBOL; 60411000 T 0017
END ELSE INSYMBOL; 60412000 T 0020
END; 60413000 T 0021
60 IS 22 LONG, NEXT SEG 59
60414000 T 0002
COMMENT *** START OF STATEMENT *** ; 60415000 T 0002
60416000 T 0002
IF CURSY=IDENTIFIER THEN 60417000 T 0002
BEGIN 60418000 T 0002
SEARCH; 60419000 T 0003
IF FOUND THEN 60420000 T 0003
BEGIN 60421000 T 0004
IF THISID.IDCLASS=VAR OR 60422000 T 0004
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) OR %700- 60423000 P 0005
THISID.IDCLASS=FUNC %700- 60423200 C 0008
THEN ASSIGNMENT ELSE %700- 60424000 P 0009
IF THISID.IDCLASS=PROC THEN 60425000 T 0010
BEGIN 60426000 T 0012
IF THISLEVEL=0 THEN % *** INTRINSIC PROCEDURE *** 60427000 T 0013
BEGIN 60428000 T 0013
IF CURNAME1="50WRITE" THEN PWRITE(FALSE) ELSE 60429000 T 0014
IF CURNAME1="7WRITEL" AND 60430000 T 0016
CURNAME2="000000N" THEN PWRITE(TRUE) ELSE 60431000 T 0018
IF CURNAME1="400READ" THEN PREAD(FALSE) ELSE 60432000 T 0021
IF CURNAME1="6READLN" THEN PREAD(TRUE) ELSE 60433000 T 0025
IF CURNAME1="400PAGE" THEN FILEHANDLING(5) ELSE 60434000 T 0029
IF CURNAME1="3000GET" THEN FILEHANDLING(2) ELSE 60435000 T 0033
IF CURNAME1="3000PUT" THEN FILEHANDLING(1) ELSE 60436000 T 0037
IF CURNAME1="50RESET" THEN FILEHANDLING(3) ELSE 60437000 T 0041
IF CURNAME1="7REWRIT" AND 60438000 T 0045
CURNAME2="000000E" THEN FILEHANDLING(4) ELSE 60439000 T 0047
IF CURNAME1="3000NEW" THEN NEWDISP ELSE 60440000 T 0050
IF CURNAME1="7DISPOS" AND 60441000 T 0053
CURNAME2="000000E" THEN NEWDISP ELSE 60442000 T 0056
IF CURNAME1="400PACK" THEN PACK ELSE 60443000 T 0058
IF CURNAME1="6QQJZXL" THEN FILEHANDLING(6) ELSE %002- 60443500 C 0062
IF CURNAME1="6UNPACK" THEN UNPACK ELSE ERROR(0); 60444000 T 0067
END ELSE PASSPARAMS; 60445000 T 0073
WRITEEXPR; 60446000 T 0074
END ELSE BEGIN ERROR(13); SKIP(99) END; 60447000 T 0075
END ELSE BEGIN ERROR(1); ASSIGNMENT END; 60448000 T 0077
END OF IDENTIFIER ELSE 60449000 T 0079
IF CURSY=BEGINSY THEN COMPSTAT ELSE 60450000 T 0079
IF CURSY=IFSY THEN IFSTAT ELSE 60451000 T 0081
IF CURSY=CASESY THEN CASESTAT ELSE 60452000 T 0083
IF CURSY=WHILESY THEN WHILESTAT ELSE 60453000 T 0085
IF CURSY=REPEATSY THEN REPEATSTAT ELSE 60454000 T 0088
IF CURSY=FORSY THEN FORSTAT ELSE 60455000 T 0090
IF CURSY=WITHSY THEN WITHSTAT ELSE 60456000 T 0092
IF CURSY=GOTOSY THEN GOTOSTAT ELSE 60457000 T 0094
IF CURSY=ASSERTSY THEN ASSERTSTAT ELSE %002- 60457500 C 0097
IF SYMKIND[CURSY]≠TERMINAL THEN 60458000 T 0099
BEGIN ERROR(13); INSYMBOL; SKIP(SEMICOLON) END; 60459000 T 0100
END OF STATEMENT; 60460000 T 0103
59 IS 106 LONG, NEXT SEG 2
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 70001000 T 0118
% % 70002000 T 0118
% % 70003000 T 0118
% % 70004000 T 0118
% PART 7: TYPE DECLARATIONS. % 70005000 T 0118
% ------------------ % 70006000 T 0118
% % 70007000 T 0118
% % 70008000 T 0118
% % 70009000 T 0118
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 70010000 T 0118
70011000 T 0118
70012000 T 0118
PROCEDURE FIELDLIST(RECTAB,FIRSTADDR,LASTADDR); 70017000 T 0118
VALUE RECTAB,FIRSTADDR; %700- 70018000 P 0118
INTEGER RECTAB,FIRSTADDR,LASTADDR; %700- 70019000 P 0118
FORWARD; 70020000 T 0118
70021000 T 0118
%700- 70035000 P 0118
PROCEDURE TYPEDECL( TTYPE, TSIZE ); %***** TYPE DECLARATION ***** 70036000 P 0118
INTEGER TTYPE, TSIZE; %**************************** 70037000 P 0118
BEGIN %700- 70038000 P 0118
INTEGER RECINX, ARRSTRUCT, TX, SX, T, N; REAL T1, T2, T3; %700- 70039000 P 0118
START OF SEGMENT ********** 61
BOOLEAN FIRST, PACKED; %700- 70040000 P 0000
%700- 70041000 P 0000
PROCEDURE TYPERR(ERRNUM,TTYPE,TSIZE); 70043000 T 0000
VALUE ERRNUM; 70044000 T 0000
INTEGER ERRNUM,TTYPE,TSIZE; 70045000 T 0000
BEGIN ERROR(ERRNUM); 70046000 T 0000
TTYPE:=TSIZE:=0; 70047000 T 0000
END TYPERR; %700- 70048000 P 0002
70049000 T 0002
PROCEDURE SUBRANGE; %*** SUBRANGE DECLARATION *** 70050000 P 0002
BEGIN %**************************** 70051000 P 0002
REAL VALX1, VALX2, T1; %700- 70052000 P 0002
START OF SEGMENT ********** 62
INTEGER TYPEX1, TYPEX2; %700- 70053000 C 0000
%700- 70054000 C 0000
CONSTANT(VALX1,TYPEX1); %700- 70055000 C 0000
IF TYPETAB1[TYPEX1].FORM>CHAR THEN ERROR(11); %700- 70056000 C 0001
IF CURSY≠DOUBLEDOT THEN ERROR(53); %700- 70057000 C 0003
INSYMBOL; %700- 70058000 C 0005
CONSTANT(VALX2,TYPEX2); %700- 70059000 C 0006
IF TYPEX1>0 AND TYPEX2>0 THEN %700- 70060000 C 0007
IF TYPEX1≠TYPEX2 THEN ERROR(11) ELSE %700- 70061000 C 0009
IF VALX1>VALX2 THEN ERROR(54); %700- 70062000 C 0011
IF (T1:=TYPETAB1[TYPEX1].FORM) = SYMBOLIC THEN T1:=SUBTYPE; %700- 70063000 C 0014
NEWTYPE; TTYPE:=TYPEINDEX; %700- 70064000 C 0017
T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; T1.MAINTYPE:=TYPEX1; %700- 70065000 C 0024
TYPETAB1[TYPEINDEX]:=T1; %700- 70066000 C 0031
TYPETAB2[TYPEINDEX]:=VALX1; TYPETAB3[TYPEINDEX]:=VALX2; %700- 70067000 C 0032
END OF SUBRANGE; %700- 70068000 C 0035
62 IS 39 LONG, NEXT SEG 61
%700- 70069000 C 0002
PACKED:=FALSE; 70080000 T 0002
IF CURSY=IDENTIFIER THEN %*** SIMPLE TYPE DECLARATION *** 70081000 T 0003
BEGIN %******************************* 70082000 T 0004
SEARCH; 70083000 T 0005
IF FOUND THEN 70084000 T 0005
BEGIN 70085000 T 0005
IF THISID.IDCLASS=TYPES THEN 70086000 T 0006
BEGIN 70087000 T 0007
TTYPE:=THISID.TYPE; TSIZE:=TYPETAB1[TTYPE].SIZE; 70088000 T 0008
INSYMBOL; 70089000 T 0011
END ELSE IF THISID.IDCLASS=CONST THEN SUBRANGE 70090000 T 0011
ELSE TYPERR(7,TTYPE,TSIZE); 70091000 T 0014
END ELSE BEGIN TYPERR(1,TTYPE,TSIZE); INSYMBOL END; 70092000 T 0017
END ELSE 70093000 T 0021
IF CURSY≤CHARCONST OR CURSY=PLUS OR CURSY=MINUS THEN SUBRANGE ELSE 70094000 T 0021
IF CURSY=LPAR THEN 70095000 T 0025
BEGIN 70096000 T 0027
N:=0; 70097000 T 0027
NEWTYPE; T3.IDCLASS:=CONST; T3.TYPE:=TYPEINDEX; 70098000 T 0028
DO BEGIN 70099000 T 0036
INSYMBOL; 70100000 T 0037
IF CURSY=IDENTIFIER THEN 70101000 T 0037
BEGIN 70102000 T 0038
NEWNAME(CURNAME1,CURNAME2,CURLEVEL); 70103000 T 0038
T3.INFO:=N; NAMETAB3[CURLEVEL,THISINDEX]:=T3; 70104000 T 0040
N:=N+1; INSYMBOL; 70105000 T 0043
END ELSE ERROR(9); 70106000 T 0045
END UNTIL CURSY≠COMMA; 70107000 T 0046
IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 70108000 T 0048
T1:=SYMBOLIC; T1.STRUCT:=0; 70109000 T 0050
T1.SIZE:=TSIZE:=1; TTYPE:=TYPEINDEX; 70110000 T 0053
TYPETAB1[TYPEINDEX]:=T1; 70111000 T 0056
TYPETAB2[TYPEINDEX]:=0; TYPETAB3[TYPEINDEX]:=N-1; 70112000 T 0058
IF CURSY=RPAR THEN INSYMBOL; 70113000 T 0061
END ELSE 70114000 T 0062
70115000 T 0062
IF CURSY=ARROW THEN %*** POINTER DECLARATION *** 70116000 T 0062
BEGIN %*************************** 70117000 T 0064
DEFINE DEC = POINTER #; %700- 70117100 C 0064
START OF SEGMENT ********** 63
INSYMBOL; 70118000 T 0000
IF CURSY=IDENTIFIER THEN 70119000 T 0000
BEGIN 70120000 T 0001
NEWTYPE; TTYPE:=TYPEINDEX; T1:=POINTERS; 70121000 T 0001
T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; 70122000 T 0008
TYPETAB1[TYPEINDEX]:=T1; 70123000 T 0012
SEARCH; 70124000 T 0014
IF FOUND THEN 70125000 T 0014
BEGIN 70126000 T 0014
IF THISID.IDCLASS=TYPES THEN 70127000 T 0015
TYPETAB1[TYPEINDEX].POINTTYPE:=THISID.TYPE ELSE 70128000 T 0016
TYPERR(7,TTYPE,TSIZE); 70129000 T 0020
END ELSE 70130000 T 0022
BEGIN 70131000 T 0022
IF NUMPNTRS<MAXPNTRS THEN NUMPNTRS:=NUMPNTRS+1 ELSE ERROR(52); 70132000 T 0023
PNTRTAB1[NUMPNTRS]:=CURNAME1; PNTRTAB2[NUMPNTRS]:=CURNAME2; 70133000 T 0026
PNTRTAB3[NUMPNTRS]:=TYPEINDEX; 70134000 T 0029
END; 70135000 T 0030
INSYMBOL; 70136000 T 0030
END ELSE TYPERR(9,TTYPE,TSIZE); 70137000 T 0031
END OF POINTER DECLARATION ELSE 70138000 T 0034
63 IS 35 LONG, NEXT SEG 61
BEGIN 70139000 T 0065
IF CURSY=PACKEDSY THEN BEGIN PACKED:=TRUE; INSYMBOL END; 70140000 T 0065
70141000 T 0068
IF CURSY=ARRAYSY THEN %*** ARRAY DECLARATION *** 70142000 T 0068
BEGIN %************************* 70143000 T 0068
DEFINE DEC = ARRAY #; %700- 70143100 C 0069
START OF SEGMENT ********** 64
INSYMBOL; 70144000 T 0000
IF CURSY≠LBRACKET THEN ERROR(47) ELSE INSYMBOL; 70145000 T 0000
T1:=0; FIRST:=TRUE; 70146000 T 0003
DO BEGIN 70147000 T 0005
IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 70148000 T 0005
TYPEDECL(TX,SX); 70149000 T 0007
IF TX>0 THEN 70150000 T 0008
BEGIN 70151000 T 0009
IF TYPETAB1[TX].FORM>CHAR THEN ERROR(48); 70152000 T 0009
T1:=ARRAYS; T1.INXTYPE:=TX; T1.ARRTYPE:=T; 70153000 T 0012
T2:=TYPETAB2[TX]; T3:=TYPETAB3[TX]; 70154000 T 0016
IF T3-T2>1022 THEN ERROR(61); 70155000 T 0018
T1.SIZE:=MIN(1023,T3-T2+1); 70156000 T 0021
NEWTYPE; 70157000 T 0026
TYPETAB1[TYPEINDEX]:=T1; 70158000 T 0031
TYPETAB2[TYPEINDEX]:=T2; TYPETAB3[TYPEINDEX]:=T3; 70159000 T 0032
T:=TYPEINDEX; 70160000 T 0035
END; 70161000 T 0035
END UNTIL CURSY≠COMMA; 70162000 T 0035
IF CURSY≠RBRACKET THEN ERROR(59) ELSE INSYMBOL; 70163000 T 0037
IF CURSY≠OFSY THEN BEGIN ERROR(18); SKIP(OFSY) END; 70164000 T 0040
INSYMBOL; 70165000 T 0042
TYPEDECL(TX,SX); 70166000 T 0043
IF TYPETAB1[TX].FORM≥FILES THEN ERROR(60); 70167000 T 0044
ARRSTRUCT:=TYPETAB1[TX].STRUCT; 70168000 T 0047
WHILE T>0 DO 70169000 T 0048
BEGIN 70170000 T 0050
T1:=TYPETAB1[T]; T3:=T1.ARRTYPE; 70171000 T 0050
T1.ARRTYPE:=TX; T1.STRUCT:=ARRSTRUCT:=ARRSTRUCT+1; 70172000 T 0052
T1.SIZE:=SX:=MIN(1024,SX×T1.SIZE); 70173000 T 0057
TYPETAB1[T]:=T1; TX:=T; T:=T3; 70174000 T 0062
END; 70175000 T 0065
TTYPE:=TX; TSIZE:=SX; 70176000 T 0067
END OF ARRAY DECLARATION ELSE 70177000 T 0069
64 IS 70 LONG, NEXT SEG 61
70178000 T 0070
IF CURSY=FILESY THEN %*** FILE DECLARATION *** 70179000 T 0070
BEGIN %************************ 70180000 T 0071
DEFINE DEC = FILE #; %700- 70180100 C 0071
START OF SEGMENT ********** 65
INSYMBOL; 70181000 T 0000
IF CURSY≠OFSY THEN 70182000 T 0000
BEGIN ERROR(18); 70183000 T 0001
IF CURSY≠IDENTIFIER THEN INSYMBOL; 70184000 T 0002
END ELSE INSYMBOL; 70185000 T 0004
TYPEDECL(TX,SX); 70186000 T 0005
IF TX>0 THEN 70187000 T 0006
BEGIN T:=TYPETAB1[TX]; 70188000 T 0007
IF T.FORM≥FILES THEN ERROR(50) ELSE 70189000 T 0008
IF T.STRUCT>1 THEN ERROR(49) 70190000 T 0011
END; 70191000 T 0013
NEWTYPE; TTYPE:=TYPEINDEX; 70192000 T 0014
T1:=IF T.FORM=CHAR THEN TEXTFILE ELSE FILES; 70193000 T 0020
T1.SIZE:=TSIZE:=SX; T1.FILETYPE:=TX; 70194000 T 0023
T1.STRUCT:=1; 70195000 T 0027
TYPETAB1[TYPEINDEX]:=T1; 70196000 T 0029
END OF FILE DECLARATION ELSE 70197000 T 0030
65 IS 31 LONG, NEXT SEG 61
70198000 T 0073
IF CURSY=SETSY THEN %*** SET DECLARATION *** 70199000 T 0073
BEGIN %*********************** 70200000 T 0074
DEFINE DEC = SET #; %700- 70200100 C 0074
START OF SEGMENT ********** 66
INSYMBOL; 70201000 T 0000
IF CURSY≠OFSY THEN 70202000 T 0000
BEGIN ERROR(18); 70203000 T 0001
IF CURSY>CHARCONST THEN INSYMBOL; 70204000 T 0002
END ELSE INSYMBOL; 70205000 T 0004
TYPEDECL(TX,SX); 70206000 T 0005
IF TX>0 THEN 70207000 T 0006
BEGIN 70208000 T 0007
IF TYPETAB1[TX].FORM>CHAR THEN ERROR(48) ELSE 70209000 T 0007
IF TYPETAB2[TX] LSS 0 OR TYPETAB3[TX] GTR 93 THEN ERROR(51); 70210000 P 0010
END; 70211000 T 0014
NEWTYPE; TTYPE:=TYPEINDEX; 70212000 T 0014
T1:=SET; T1.SETTYPE:=TX; T1.STRUCT:=0; 70213000 T 0020
T1.SIZE := TSIZE := 2; TYPETAB1[TYPEINDEX] := T1; % %601- 70214000 P 0024
TYPETAB2[TYPEINDEX]:=TYPETAB2[TX]; 70215000 T 0028
TYPETAB3[TYPEINDEX]:=TYPETAB3[TX]; 70216000 T 0029
END OF SET DECLARATION ELSE 70217000 T 0031
66 IS 32 LONG, NEXT SEG 61
70218000 T 0076
IF CURSY=RECORDSY THEN %*** RECORD DECLARATION *** 70219000 T 0076
BEGIN %************************** 70220000 T 0077
DEFINE DEC = RECORD #; %700- 70220100 C 0077
START OF SEGMENT ********** 67
IF LASTREC-1>CURLEVEL THEN LASTREC:=LASTREC-1 ELSE ERROR(55); 70221000 T 0000
RECINX:=LASTREC; 70222000 T 0004
BLOCKTAB[RECINX]:=NUMBLOCKS:=NUMBLOCKS+1; 70223000 T 0005
INSYMBOL; 70224000 T 0007
FIELDLIST(RECINX,0,SX); 70225000 T 0007
IF SX>1022 THEN BEGIN ERROR(56); SX:=1022 END; 70226000 T 0009
NEWTYPE; TTYPE:=TYPEINDEX; 70227000 T 0011
T1:=RECORD; T1.RECTAB:=RECINX; T1.STRUCT:=1; 70228000 T 0017
T1.SIZE:=TSIZE:=SX; TYPETAB1[TYPEINDEX]:=T1; 70229000 T 0022
TYPETAB2[TYPEINDEX]:=0; TYPETAB3[TYPEINDEX]:=SX-1; 70230000 T 0025
IF CURSY≠ENDSY THEN BEGIN ERROR(24); SKIP(ENDSY) END; 70231000 T 0028
IF CURSY=ENDSY THEN INSYMBOL; 70232000 T 0031
END ELSE BEGIN ERROR(4); SKIP(99) END; 70233000 T 0033
67 IS 34 LONG, NEXT SEG 61
END; 70234000 T 0081
END OF TYPEDECL; 70235000 T 0081
61 IS 90 LONG, NEXT SEG 2
70236000 T 0118
70237000 T 0118
PROCEDURE FIELDLIST(RECTAB,FIRSTADDR,LASTADDR); 70238000 T 0118
VALUE RECTAB,FIRSTADDR; 70239000 T 0118
INTEGER RECTAB,FIRSTADDR,LASTADDR; 70240000 T 0118
BEGIN 70241000 T 0118
INTEGER ARRAY ILIST[0:LISTLENGTH]; 70242000 T 0118
START OF SEGMENT ********** 68
INTEGER LISTINX; 70243000 T 0001
INTEGER CASETYPE,ADDR,MAXADDR,INDEX,CTYPE,TX,SX, T3,LLIM,ULIM,I; 70244000 P 0001
BOOLEAN FIRST; 70245000 T 0001
REAL T1, CVAL; %503- 70246000 P 0001
LABEL CASEPART, EXIT; %700- 70247000 P 0001
70248000 T 0001
ADDR:=FIRSTADDR; 70249000 T 0001
DO BEGIN 70250000 T 0002
WHILE CURSY=SEMICOLON DO INSYMBOL; 70251000 T 0003
IF CURSY=CASESY THEN GO TO CASEPART; 70252000 T 0005
IF CURSY=IDENTIFIER THEN 70253000 T 0006
BEGIN 70254000 T 0007
LISTINX:=0; FIRST:=TRUE; 70255000 T 0007
DO BEGIN 70256000 T 0009
IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 70257000 T 0010
IF CURSY=IDENTIFIER THEN 70258000 T 0012
BEGIN 70259000 T 0013
IF LISTINX≥LISTLENGTH THEN BEGIN ERROR(37); LISTINX:=0 END; 70260000 T 0013
LISTINX:=LISTINX+1; 70261000 T 0016
NEWNAME(CURNAME1,CURNAME2,RECTAB); 70262000 T 0017
ILIST[LISTINX]:=THISINDEX; 70263000 T 0019
INSYMBOL; 70264000 T 0020
END ELSE 70265000 T 0020
BEGIN ERROR(9); 70266000 T 0020
IF CURSY≠COMMA THEN INSYMBOL; 70267000 T 0022
END; 70268000 T 0023
END UNTIL CURSY≠COMMA; 70269000 T 0023
IF CURSY≠COLON THEN BEGIN ERROR(26); SKIP(COLON) END; 70270000 T 0025
INSYMBOL; 70271000 T 0027
TYPEDECL(TX,SX); 70272000 T 0028
IF TX>0 THEN IF TYPETAB1[TX].FORM≥FILES THEN ERROR(57); 70273000 T 0029
T3.IDCLASS:=VAR; T3.TYPE:=TX; 70274000 T 0033
FOR I:=1 STEP 1 UNTIL LISTINX DO 70275000 T 0036
BEGIN 70276000 T 0038
T3.INFO:=ADDR; ADDR:=MIN(ADDR+SX,1024); 70277000 T 0038
NAMETAB3[RECTAB,ILIST[I]]:=T3; 70278000 T 0043
END; 70279000 T 0045
END; 70280000 T 0047
END UNTIL CURSY≠SEMICOLON; 70281000 T 0047
LASTADDR:=ADDR; 70282000 T 0049
GO TO EXIT; 70283000 T 0050
70284000 T 0052
CASEPART: 70285000 T 0052
BEGIN DEFINE DEC = VARIANT #; %700- 70285100 C 0052
START OF SEGMENT ********** 69
LABEL CASETYPEID; %700- 70285200 C 0000
LISTINX:=0; LASTADDR:=ADDR; INDEX:=-1; 70286000 T 0000
INSYMBOL; 70287000 T 0002
IF CURSY=IDENTIFIER THEN 70288000 T 0003
BEGIN 70289000 T 0004
SEARCH; 70290000 T 0004
IF FOUND AND THISID.IDCLASS=TYPES THEN GO TO CASETYPEID; 70291000 T 0005
NEWNAME(CURNAME1,CURNAME2,RECTAB); INDEX:=THISINDEX; 70292000 T 0007
INSYMBOL; 70293000 T 0009
IF CURSY≠COLON THEN ERROR(26); 70294000 T 0010
INSYMBOL; 70295000 T 0012
IF CURSY=IDENTIFIER THEN 70296000 T 0012
BEGIN 70297000 T 0013
SEARCH; 70298000 T 0013
IF FOUND THEN 70299000 T 0014
BEGIN 70300000 T 0014
IF THISID.IDCLASS=TYPES THEN 70301000 T 0015
BEGIN 70302000 T 0016
CASETYPEID: CASETYPE:=THISID.TYPE; T1:=TYPETAB1[CASETYPE]; 70303000 T 0016
LLIM:=TYPETAB2[CASETYPE]; ULIM:=TYPETAB3[CASETYPE]; 70304000 T 0019
IF T1.FORM>CHAR THEN ERROR(48); 70305000 T 0021
IF INDEX≥0 THEN 70306000 T 0023
BEGIN 70307000 T 0024
T3.IDCLASS:=VAR; T3.TYPE:=CASETYPE; T3.INFO:=ADDR; 70308000 T 0025
ADDR:=LASTADDR:=ADDR+1; NAMETAB3[RECTAB,INDEX]:=T3; 70309000 T 0030
END; 70310000 T 0034
INSYMBOL; 70311000 T 0034
END ELSE BEGIN ERROR(7); SKIP(OFSY) END; 70312000 T 0034
END ELSE BEGIN ERROR(1); SKIP(OFSY) END; 70313000 T 0036
END ELSE BEGIN ERROR(9); SKIP(OFSY) END; 70314000 T 0038
END ELSE BEGIN ERROR(9); SKIP(OFSY) END; 70315000 T 0040
IF CURSY≠OFSY THEN BEGIN ERROR(18); SKIP(RPAR) END; 70316000 T 0042
IF CURSY=OFSY THEN INSYMBOL; 70317000 T 0045
IF CASETYPE=0 THEN BEGIN LLIM:=-MAXINT; ULIM:=MAXINT END; 70318000 T 0047
DO BEGIN 70319000 T 0050
WHILE CURSY=SEMICOLON DO INSYMBOL; 70320000 T 0051
IF CURSY≤CHARCONST OR CURSY=PLUS OR CURSY=MINUS THEN 70321000 T 0055
BEGIN 70322000 T 0057
FIRST:=TRUE; 70323000 T 0058
DO BEGIN 70324000 T 0059
IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 70325000 T 0059
CONSTANT(CVAL,CTYPE); 70326000 T 0061
IF CTYPE>0 THEN 70327000 T 0062
BEGIN 70328000 T 0063
IF CASETYPE=0 THEN CASETYPE:=CTYPE ELSE 70329000 T 0063
IF CVAL<LLIM OR CVAL>ULIM THEN ERROR(14) ELSE 70330000 T 0065
CHECKTYPES(CASETYPE,CTYPE); 70331000 T 0069
IF LISTINX≥LISTLENGTH THEN BEGIN ERROR(30); LISTINX:=0 END; 70332000 T 0070
LISTINX:=LISTINX+1; 70333000 T 0073
ILIST[LISTINX]:=CVAL; I:=1; 70334000 T 0074
WHILE ILIST[I]≠CVAL DO I:=I+1; 70335000 T 0076
IF I<LISTINX THEN ERROR(31); 70336000 T 0080
END; 70337000 T 0082
END UNTIL CURSY≠COMMA; 70338000 T 0082
IF CURSY≠COLON THEN BEGIN ERROR(26); SKIP(LPAR) END; 70339000 T 0083
IF CURSY=COLON THEN INSYMBOL; 70340000 T 0086
IF CURSY=LPAR THEN 70341000 T 0088
BEGIN 70342000 T 0088
INSYMBOL; FIELDLIST(RECTAB,ADDR,MAXADDR); 70343000 T 0089
IF MAXADDR>LASTADDR THEN LASTADDR:=MAXADDR; 70344000 T 0091
IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 70345000 T 0093
INSYMBOL; 70346000 T 0096
END ELSE ERROR(58); 70347000 T 0096
END; 70348000 T 0097
END UNTIL CURSY NEQ SEMICOLON; % 70349000 T 0097
END; %700- 70349100 C 0099
69 IS 100 LONG, NEXT SEG 68
EXIT: 70350000 T 0053
END OF FIELDLIST; 70351000 T 0053
68 IS 61 LONG, NEXT SEG 2
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 80001000 T 0118
% % 80002000 T 0118
% % 80003000 T 0118
% % 80004000 T 0118
% PART 8: THE PROCEDURE BLOCK. % 80005000 T 0118
% -------------------- % 80006000 T 0118
% % 80007000 T 0118
% % 80008000 T 0118
% % 80009000 T 0118
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 80010000 T 0118
80011000 T 0118
80012000 T 0118
80013000 T 0118
PROCEDURE DECLAREVARS(PARAM,TAB,FIRST,LAST,LEVEL); 80014000 T 0118
VALUE PARAM,FIRST,LAST,LEVEL; 80015000 T 0118
INTEGER ARRAY TAB[0]; 80016000 T 0118
INTEGER FIRST,LAST,LEVEL; 80017000 T 0118
BOOLEAN PARAM; 80018000 T 0118
BEGIN 80019000 T 0118
INTEGER LEVEL1000, TYP, NAM, NAMTAB, I, J, RECSIZE; %503- 80020000 P 0118
START OF SEGMENT ********** 70
BOOLEAN REALVAR,ARRAYVAR,FIRSTDIM,EXTFILE; 80021000 T 0000
ALPHA T1, FNAME; %503- 80022000 P 0000
INTEGER FNLENGTH,FNSTART; % 80023000 T 0000
80024000 T 0000
LEVEL1000:=LEVEL×1000; 80025000 T 0000
FOR I:=FIRST STEP 1 UNTIL LAST DO 80026000 T 0001
BEGIN 80027000 T 0002
NAM:=TAB[I].[9:10]; NAMTAB:=NAMETAB3[LEVEL,NAM]; 80028000 T 0002
TYP:=NAMTAB.TYPE; T1:=TYPETAB1[TYP]; 80029000 T 0005
IF NAMTAB.IDCLASS GEQ FUNC THEN 80030000 T 0007
BEGIN 80031000 T 0008
IF REALVAR OR ARRAYVAR THEN 80032000 T 0009
BEGIN 80033000 T 0010
GEN(";",1,7); 80034000 T 0010
REALVAR:=ARRAYVAR:=FALSE; 80035000 T 0012
END; 80036000 T 0013
IF NAMTAB.IDCLASS=FUNC THEN GEN("FUNCTN",7,2) % %600- 80037000 P 0013
ELSE GEN("PROCEDU",8,1); % %600- 80038000 P 0016
GENID("V",LEVEL1000+NAM,5); GEN(";",1,7); 80039000 T 0019
END ELSE 80040000 T 0023
IF T1.STRUCT=0 THEN %*** SIMPLE TYPE *** 80041000 T 0023
BEGIN 80042000 T 0026
IF ARRAYVAR THEN BEGIN GEN(";",1,7); ARRAYVAR:=FALSE END; 80043000 T 0026
IF REALVAR THEN GEN(",",1,7) ELSE 80044000 T 0029
BEGIN GEN("REAL",5,4); REALVAR:=TRUE END; 80045000 T 0032
GENID("V",LEVEL1000+NAM,5); 80046000 T 0034
IF T1.FORM=SET THEN % %601- 80046200 C 0036
BEGIN % %601- 80046400 C 0038
GEN(",",1,7); GENID("W",LEVEL1000+NAM,5); % %601- 80046600 C 0038
END; % %601- 80046800 C 0042
END ELSE 80047000 T 0042
BEGIN 80048000 T 0042
IF REALVAR THEN BEGIN GEN(";",1,7); REALVAR:=FALSE END; 80049000 T 0044
IF T1.FORM<FILES THEN %*** ARRAY/RECORD *** 80050000 T 0047
BEGIN 80051000 T 0048
DEFINE %518- 80064005 C 0048
START OF SEGMENT ********** 71
LOWSUBS = 0 #, %518- 80064010 C 0000
HISUBS = 1 #, %518- 80064015 C 0000
NEXTSUBS= 2 #, %518- 80064020 C 0000
MAXNOOFSUBSCRIPTS = 20 #, %518- 80064025 C 0000
STOPPERSUBTAB = 21 #; %518- 80064030 C 0000
ARRAY ARRSUBSCRIPTRANGE[0:2,0:MAXNOOFSUBSCRIPTS]; %518- 80064035 C 0000
INTEGER FIRSTRANGE, NEXTFREEENTRY, PASSSUBRANGE, PREVPASS, %518- 80064040 C 0002
MP, POSNO, SUBDIFF; %518- 80064045 C 0002
IF ARRAYVAR THEN GEN(";",1,7) ELSE ARRAYVAR := TRUE; %518- 80064050 C 0002
IF NOT PARAM THEN %518- 80064055 C 0006
BEGIN %518- 80064060 C 0006
GEN("DEFINE",7,2); %518- 80064065 C 0007
GENID("V",LEVEL1000+NAM,5); %518- 80064070 C 0008
GEN("[",1,7); %518- 80064075 C 0010
END; %518- 80064080 C 0012
FIRSTRANGE := STOPPERSUBTAB; NEXTFREEENTRY := 0; %518- 80064085 C 0012
POSNO := 1; %518- 80064090 C 0013
MP := 10; FIRSTDIM := TRUE; %518- 80064095 C 0014
DO %518- 80064100 C 0016
BEGIN %518- 80064105 C 0016
IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE %518- 80064110 C 0016
BEGIN %518- 80064111 C 0017
IF NOT PARAM THEN GEN(",",1,7); %518- 80064112 C 0019
END; %518- 80064113 C 0021
IF NOT PARAM THEN GENID("V",(LEVEL1000+NAM)×MP+POSNO,IF MP=10 80064115 C 0021
THEN 6 ELSE 7); POSNO := POSNO + 1; %518- 80064120 C 0022
IF POSNO = MP THEN MP := MP×10; %518- 80064125 C 0028
IF NEXTFREEENTRY = STOPPERSUBTAB THEN %518- 80064130 C 0031
BEGIN %518- 80064135 C 0032
ERROR(0); %518- 80064140 C 0032
END %518- 80064145 C 0033
ELSE %518- 80064150 C 0033
BEGIN %518- 80064155 C 0033
ARRSUBSCRIPTRANGE[LOWSUBS,NEXTFREEENTRY]:=TYPETAB2[TYP]; 80064160 C 0033
ARRSUBSCRIPTRANGE[HISUBS,NEXTFREEENTRY] := TYPETAB3[TYP]; 80064165 C 0036
END; %518- 80064170 C 0038
SUBDIFF := TYPETAB3[TYP] - TYPETAB2[TYP]; %518- 80064175 C 0038
IF FIRSTRANGE = STOPPERSUBTAB THEN %518- 80064180 C 0040
BEGIN %518- 80064185 C 0040
FIRSTRANGE := NEXTFREEENTRY; %518- 80064190 C 0041
NEXTFREEENTRY := NEXTFREEENTRY + 1; %518- 80064195 C 0042
ARRSUBSCRIPTRANGE[NEXTSUBS,FIRSTRANGE] := STOPPERSUBTAB; 80064200 C 0043
END %518- 80064205 C 0045
ELSE %518- 80064210 C 0045
BEGIN %518- 80064215 C 0045
PASSSUBRANGE := FIRSTRANGE; %518- 80064220 C 0045
PREVPASS := STOPPERSUBTAB; NEXTFREEENTRY:=NEXTFREEENTRY+1; 80064225 C 0046
WHILE(SUBDIFF ≥ ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE] %518- 80064230 C 0047
-ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE]) AND 80064235 C 0050
(ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] ≠ %518- 80064240 C 0052
STOPPERSUBTAB) DO %518- 80064245 C 0053
BEGIN %518- 80064250 C 0054
PREVPASS := PASSSUBRANGE; %518- 80064255 C 0054
PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS, %518- 8006426 C 0055
PASSSUBRANGE]; 80064265 C 0056
END; %518- 80064270 C 0057
IF PREVPASS = STOPPERSUBTAB THEN %518- 80064275 C 0057
BEGIN %518- 80064280 C 0058
IF SUBDIFF ≥ ARRSUBSCRIPTRANGE[HISUBS, %518- 80064285 C 0059
PASSSUBRANGE] - %518- 80064290 C 0060
ARRSUBSCRIPTRANGE[LOWSUBS, %518- 80064295 C 0060
PASSSUBRANGE] THEN%518- 80064300 C 0061
BEGIN %518- 80064305 C 0062
ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] := %518- 80064310 C 0062
NEXTFREEENTRY - 1; %518- 80064315 C 0064
ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] :=%518- 80064320 C 0065
STOPPERSUBTAB; %518- 80064325 C 0067
END %518- 80064330 C 0067
ELSE %518- 80064335 C 0067
BEGIN %518- 80064340 C 0067
ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] :=%518- 80064345 C 0068
FIRSTRANGE; %518- 80064350 C 0070
FIRSTRANGE := NEXTFREEENTRY-1; %518- 80064355 C 0070
END %518- 80064360 C 0072
END %518- 80064365 C 0072
ELSE %518- 80064370 C 0072
BEGIN %518- 80064375 C 0072
IF SUBDIFF ≥ ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE] - 80064380 C 0072
ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE] 80064385 C 0074
THEN %518- 80064390 C 0075
BEGIN %518- 80064395 C 0075
ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE] := %518- 80064400 C 0076
NEXTFREEENTRY - 1; %518- 80064405 C 0077
ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] := %518- 80064410 C 0078
STOPPERSUBTAB; %518- 80064415 C 0080
END %518- 80064420 C 0081
ELSE %518- 80064425 C 0081
BEGIN %518- 80064430 C 0081
ARRSUBSCRIPTRANGE[NEXTSUBS,PREVPASS] := %518- 80064435 C 0081
NEXTFREEENTRY -1; %518- 80064440 C 0083
ARRSUBSCRIPTRANGE[NEXTSUBS,NEXTFREEENTRY-1] := %518- 80064445 C 0084
PASSSUBRANGE; %518- 80064450 C 0086
END %518- 80064455 C 0086
END %518- 80064460 C 0086
END;TYP:=IF T1.FORM = ARRAYS THEN T1.ARRTYPE ELSE REALTYPE; 80064465 C 0086
T1 := TYPETAB1[TYP]; %518- 80064470 C 0090
END UNTIL T1.STRUCT = 0 ; %518- 80064475 C 0091
IF NOT PARAM THEN %518- 80064480 C 0093
BEGIN %518- 80064485 C 0093
GEN("]=",2,6); %518- 80064490 C 0094
GENID("H",LEVEL1000+NAM,5); %518- 80064495 C 0095
GEN("[",1,7); %518- 80064500 C 0097
PASSSUBRANGE:= FIRSTRANGE; FIRSTDIM := TRUE; %518- 80064505 C 0099
WHILE PASSSUBRANGE ≠ STOPPERSUBTAB DO %518- 80064510 C 0100
BEGIN %518- 80064515 C 0102
IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE GEN(",",1,7); 80064520 C 0102
GENID("V",(LEVEL1000+NAM)×(IF PASSSUBRANGE>9 THEN 100 ELSE 8006453 C 0107
10)+PASSSUBRANGE+1,IF PASSSUBRANGE>9 THEN 7 ELSE 6); 80064535 C 0107
PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE]; 80064540 C 0115
END; %518- 80064545 C 0116
GEN("]#;",3,5); %518- 80064550 C 0117
END; %518- 80064555 C 0118
PASSSUBRANGE := FIRSTRANGE; %518- 80064560 C 0118
FIRSTDIM := TRUE; GEN("ARRAY",6,3); GENID("H",LEVEL1000+NAM,5); 80064565 C 0119
GEN("[",1,7); %518- 80064570 C 0123
WHILE PASSSUBRANGE ≠ STOPPERSUBTAB DO %518- 80064575 C 0125
BEGIN %518- 80064580 C 0127
IF MAXPERMTAB LEQ MAXTOTALSUBSCRS AND PARAM THEN %518- 80064585 C 0127
BEGIN %518- 80064590 C 0128
ARRSUBPERMTAB[ARRNAM,MAXPERMTAB] := %518- 80064595 C 0129
IF FIRSTDIM THEN NAM ELSE -1; %518- 80064600 C 0130
ARRSUBPERMTAB[PERMSUB,MAXPERMTAB] := PASSSUBRANGE; %518- 80064605 C 0132
MAXPERMTAB := MAXPERMTAB + 1; %518- 80064610 C 0134
END %518- 80064615 C 0136
ELSE %518- 80064620 C 0136
BEGIN %518- 80064625 C 0136
IF MAXPERMTAB > MAXTOTALSUBSCRS THEN ERROR(0); %518- 80064630 C 0139
END; %518- 80064640 C 0141
IF FIRSTDIM THEN FIRSTDIM := FALSE ELSE GEN(",",1,7); %518- 80064645 C 0141
GENINT(ARRSUBSCRIPTRANGE[LOWSUBS,PASSSUBRANGE]); %518- 80064650 C 0144
IF NOT PARAM THEN %518- 80064655 C 0146
BEGIN %518- 80064660 C 0146
GEN(":",1,7); %518- 80064665 C 0147
GENINT(ARRSUBSCRIPTRANGE[HISUBS,PASSSUBRANGE]); %518- 80064670 C 0148
END; %518- 80064675 C 0150
PASSSUBRANGE := ARRSUBSCRIPTRANGE[NEXTSUBS,PASSSUBRANGE]; %518- 80064680 C 0150
END; %518- 80064685 C 0152
IF T1.FORM=SET THEN % %601- 80064700 C 0152
BEGIN % %601- 80064750 C 0154
GEN(",0",2,6); % %601- 80064800 C 0154
IF NOT PARAM THEN GEN(":1",2,6); % %601- 80064850 C 0156
END; % %601- 80064900 C 0158
GEN("]",1,7); %518- 80064950 C 0158
END ELSE 80065000 T 0160
71 IS 164 LONG, NEXT SEG 70
BEGIN %*** FILE *** 80066000 T 0050
DEFINE DEC = FILE #; %700- 80066100 C 0050
START OF SEGMENT ********** 72
IF REALVAR OR ARRAYVAR THEN 80067000 T 0000
BEGIN GEN(";",1,7); REALVAR:=ARRAYVAR:=FALSE END; 80068000 T 0000
IF T1.FORM=TEXTFILE AND NOT PARAM THEN 80069000 T 0004
BEGIN 80070000 T 0006
IF NUMFILES≥MAXFILES THEN ERROR(97) 80071000 T 0006
ELSE NUMFILES:=NUMFILES+1; 80072000 T 0008
FILETAB[NUMFILES]:=NAM; 80073000 T 0010
END; 80074000 T 0011
EXTFILE:=FALSE; 80075000 T 0011
FNAME:=NAMETAB1[LEVEL,NAM]; 80076000 T 0012
FNLENGTH := FNAME.NAMELENGTH; FNSTART := 8-FNLENGTH; % 80077000 T 0014
IF FNLENGTH LEQ 6 THEN % 80078000 T 0016
BEGIN 80079000 T 0017
FOR J:=1 STEP 1 UNTIL NUMEXTFILES DO 80080000 T 0017
IF FNAME=EXTFILETAB[J] THEN EXTFILE:=TRUE; 80081000 T 0019
END; 80082000 T 0023
IF EXTFILE AND NOT PARAM THEN 80083000 T 0023
BEGIN 80084000 T 0024
IF NUMFILES GEQ MAXFILES THEN ERROR(97) 80085000 T 0025
ELSE 80086000 T 0026
NUMFILES := NUMFILES + 1; 80087000 T 0027
FILETAB[NUMFILES] := -NAM - 1; 80088000 T 0028
GEN("DEFINE",7,2); GENID("F",LEVEL1000+NAM,5); 80089000 T 0030
GEN("=",1,7); 80090000 T 0034
GEN(FNAME,FNLENGTH,FNSTART); % 80091000 T 0035
GEN("#;",2,6); GEN("SAVE",5,4); GEN("FILE",5,4); 80092000 T 0037
GEN(FNAME,FNLENGTH,FNSTART); % 80093000 T 0041
END ELSE 80094000 T 0043
BEGIN 80095000 T 0043
GEN("FILE",5,4); GENID("F",LEVEL1000+NAM,5); 80096000 T 0047
END; 80097000 T 0050
IF NOT PARAM THEN 80098000 T 0050
BEGIN 80099000 T 0051
GEN(" DISK",6,3); GEN("SERIAL",7,2); 80100000 T 0051
IF EXTFILE THEN 80101000 T 0054
BEGIN 80102000 T 0054
IF ALGOLCNT LSS 14 THEN WRITEALGOL; %517- 80103000 P 0055
GEN("[0:0]",5,3); 80104000 T 0057
GEN(""",1,7); 80105000 T 0058
GEN(FNAME,FNLENGTH,FNSTART); % 80106000 T 0060
GEN(""/",2,6); %700- 80107000 P 0061
IF ALGOLCNT<9 THEN WRITEALGOL; 80108000 T 0063
GEN(""",1,7); GEN(USER,7,1); GEN(""",1,7); 80109000 T 0064
END ELSE 80110000 T 0069
BEGIN 80111000 T 0069
GEN("[20:",4,4); GEN("300]",4,4); 80112000 T 0075
END; 80113000 T 0078
GEN("(1,",3,5); 80114000 T 0078
RECSIZE:=IF T1.FORM=TEXTFILE THEN 10 ELSE 80115000 T 0079
IF TYPETAB1[T1.FILETYPE].STRUCT=0 THEN 1 ELSE 80116000 T 0082
TYPETAB3[T1.FILETYPE]-TYPETAB2[T1.FILETYPE]+1; 80117000 T 0085
GENINT(RECSIZE); GEN(",",1,7); 80118000 T 0088
IF RECSIZE=1 OR RECSIZE=10 THEN GENINT(30) %703- 80119000 P 0090
ELSE GENINT(RECSIZE); 80120000 T 0093
IF ALGOLCNT LSS 10 THEN WRITEALGOL; 80121000 T 0098
GEN(",SAVE",6,3); %703- 80122000 P 0100
GEN("30);", 4,4); %703- 80123000 P 0102
END ELSE GEN(";",1,7); 80124000 T 0103
GEN("ARRAY",6,3); GENID("V",LEVEL1000+NAM,5); 80125000 T 0107
GEN("[",1,7); 80126000 T 0111
IF TYPETAB1[T1.FILETYPE].STRUCT=0 THEN 80127000 T 0112
BEGIN 80128000 T 0114
IF PARAM THEN GEN("0",1,7) ELSE BEGIN %002- 80129000 P 0115
GEN("0:",2,6); %002- 80129100 C 0119
GENINT(RECSIZE-1); %002- 80129200 C 0120
END %002- 80129300 C 0121
END ELSE 80130000 T 0121
BEGIN 80131000 T 0121
GENINT(TYPETAB2[T1.FILETYPE]); 80132000 T 0122
IF NOT PARAM THEN 80133000 T 0123
BEGIN GEN(":",1,7); GENINT(TYPETAB3[T1.FILETYPE]) END; 80134000 T 0124
END; 80135000 T 0127
GEN("];",2,6); 80136000 T 0127
GEN("INTEGER",8,1); GENID("I",LEVEL1000+NAM,5); 80137000 T 0129
GEN(";",1,7); 80138000 T 0132
END; 80139000 T 0134
72 IS 137 LONG, NEXT SEG 70
END; 80140000 T 0051
END OF LOOP; 80141000 T 0051
IF REALVAR OR ARRAYVAR THEN GEN(";",1,7); 80142000 T 0053
END OF DECLAREVARS; 80143000 T 0056
70 IS 65 LONG, NEXT SEG 2
80144000 T 0118
80145000 T 0118
PROCEDURE PARAMETERLIST; 80146000 T 0118
BEGIN 80147000 T 0118
INTEGER FIRSTPARAM, CURKIND, P1, PX, I, T3; REAL T; %503- 80148000 P 0118
START OF SEGMENT ********** 73
BOOLEAN FIRST; 80149000 T 0000
80150000 T 0000
DEFINE NEWPARAM= 80151000 T 0000
BEGIN 80152000 T 0000
IF NUMPARAMS≥MAXPARAMS THEN 80153000 T 0000
BEGIN ERROR(70); NUMPARAMS:=MAXPARAMS-10 END; 80154000 T 0000
NUMPARAMS:=NUMPARAMS+1; 80155000 T 0000
END OF NEWPARAM#; 80156000 T 0000
80157000 T 0000
NEWPARAM; FIRSTPARAM:=NUMPARAMS; 80158000 T 0000
IF CURSY=LPAR THEN 80159000 T 0005
BEGIN 80160000 T 0006
DO BEGIN 80161000 T 0006
INSYMBOL; 80162000 T 0007
IF CURSY=VARSY OR CURSY=FUNCSY OR CURSY=PROCSY THEN 80163000 T 0007
BEGIN 80164000 T 0010
CURKIND:=IF CURSY=VARSY THEN VAR ELSE 80165000 T 0010
IF CURSY=FUNCSY THEN FUNC ELSE PROC; 80166000 T 0012
INSYMBOL; 80167000 T 0015
END ELSE CURKIND:=CONST; 80168000 T 0016
FIRST:=TRUE; P1:=NUMPARAMS+1; 80169000 T 0017
DO BEGIN 80170000 T 0019
IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 80171000 T 0020
IF CURSY=IDENTIFIER THEN 80172000 T 0022
BEGIN 80173000 T 0023
NEWNAME(CURNAME1,CURNAME2,CURLEVEL+1); 80174000 T 0023
PX:=THISINDEX; PX.PARAMKIND:=CURKIND; 80175000 T 0025
PX.PARAMLEVEL:=CURLEVEL+1; 80176000 T 0028
NEWPARAM; PARAMTAB[NUMPARAMS]:=PX; 80177000 T 0030
FORWPARAM1[NUMPARAMS] := CURNAME1; %002- 80177500 C 0036
FORWPARAM2[NUMPARAMS] := CURNAME2; %002- 80177600 C 0037
END ELSE ERROR(9); 80178000 T 0038
INSYMBOL; 80179000 T 0039
END UNTIL CURSY≠COMMA; 80180000 T 0040
IF CURSY=COLON THEN 80181000 T 0041
BEGIN 80182000 T 0042
IF CURKIND=PROC THEN ERROR(90); 80183000 T 0042
INSYMBOL; 80184000 T 0044
IF CURSY=IDENTIFIER THEN 80185000 T 0045
BEGIN 80186000 T 0046
SEARCH; 80187000 T 0046
IF FOUND THEN 80188000 T 0047
BEGIN 80189000 T 0047
IF THISID.IDCLASS=TYPES THEN 80190000 T 0047
BEGIN 80191000 T 0049
T3:=THISID.TYPE; 80192000 T 0049
FOR I:=P1 STEP 1 UNTIL NUMPARAMS DO 80193000 T 0050
PARAMTAB[I].PARAMTYPE:=T3; 80194000 T 0052
IF CURKIND=CONST OR CURKIND=VAR THEN 80195000 T 0056
BEGIN 80196000 T 0058
T:=TYPETAB1[T3]; 80197000 T 0059
IF T.FORM≥FILES THEN 80198000 T 0060
FOR I:=P1 STEP 1 UNTIL NUMPARAMS DO 80199000 T 0061
PARAMTAB[I].PARAMFILE:=1; 80200000 T 0063
IF T.STRUCT>0 AND CURKIND=CONST THEN ERROR(94); 80201000 T 0067
END ELSE IF T.STRUCT>0 THEN ERROR(38); 80202000 T 0071
END ELSE BEGIN ERROR(7); T3:=0 END; 80203000 T 0074
END ELSE BEGIN ERROR(1); T3:=0 END; 80204000 T 0076
END ELSE BEGIN ERROR(9); T3:=0 END; 80205000 T 0078
INSYMBOL; 80206000 T 0080
END ELSE 80207000 T 0080
BEGIN 80208000 T 0080
IF CURKIND≠PROC THEN ERROR(7); 80209000 T 0081
T3:=0; 80210000 T 0083
END; 80211000 T 0084
T3.IDCLASS:=CURKIND; T3.FORMAL:=1; 80212000 T 0084
FOR I:=P1 STEP 1 UNTIL NUMPARAMS DO 80213000 T 0087
NAMETAB3[CURLEVEL+1,PARAMTAB[I].PARAMNAME]:=T3; 80214000 T 0089
END UNTIL CURSY≠SEMICOLON; 80215000 T 0094
IF CURSY≠RPAR THEN 80216000 T 0095
BEGIN ERROR(49); SKIP(RPAR); 80217000 T 0096
IF CURSY=RPAR THEN INSYMBOL; 80218000 T 0098
END ELSE INSYMBOL; 80219000 T 0100
END; 80220000 T 0101
PARAMTAB[FIRSTPARAM]:=NUMPARAMS-FIRSTPARAM; 80221000 T 0101
END OF PARAMETERLIST; 80222000 T 0103
73 IS 108 LONG, NEXT SEG 2
80223000 T 0118
80400000 T 0118
PROCEDURE BLOCK; 80401000 T 0118
BEGIN 80402000 T 0118
INTEGER INDEX, CTYPE, NUMFORWARDS,TX, I; % %800- 80403000 P 0118
START OF SEGMENT ********** 74
ALPHA T3; %002- 80403500 C 0000
REAL T, CVAL; %503- 80404000 P 0000
ALPHA C1,C2; 80405000 T 0000
BOOLEAN VALUEPARAMS,FUN; 80406000 T 0000
LABEL START; 80407000 T 0000
80408000 T 0000
INTEGER LABTABTOP,CONSTTABTOP,TYPETABTOP,PARAMTABTOP,TOPREC, 80409000 T 0000
FORMERFIRSTLAB,FIRSTFILE; 80410000 T 0000
80411000 T 0000
FORMERFIRSTLAB:=FIRSTLAB; 80412000 T 0000
LABTABTOP:=NUMLABS; FIRSTLAB:=LABTABTOP+1; 80413000 T 0000
CONSTTABTOP:=NUMCONSTS; 80414000 T 0002
TYPETABTOP:=NUMTYPES; 80415000 T 0003
PARAMTABTOP:=NUMPARAMS; 80416000 T 0004
TOPREC:=LASTREC; 80417000 T 0005
FIRSTFILE:=NUMFILES+1; 80418000 T 0005
80419000 T 0007
TOPLEVEL:=CURLEVEL; 80420000 T 0007
MARGIN("+P",CURLEVEL); % MARK PROCEDURE LEVEL %712- 80420100 C 0007
IF CURLEVEL > 1 THEN %518- 80421010 C 0025
BEGIN %518- 80421020 C 0026
INTEGER NAMOFTHING,DIFF; %518- 80421030 C 0026
START OF SEGMENT ********** 75
BOOLEAN FIRSTTIME; %518- 80421040 C 0000
GEN("BEGIN",6,3); %518- 80421050 C 0000
IF MAXPERMTAB > 0 THEN %518- 80421060 C 0001
BEGIN %518- 80421070 C 0002
PASSPERMTAB := 0; %518- 80421080 C 0002
DO %518- 80421090 C 0003
BEGIN %518- 80421100 C 0004
REMEMBERPOSN := PASSPERMTAB; %518- 80421110 C 0004
GEN("DEFINE",7,2); %518- 80421120 C 0004
NAMOFTHING := ARRSUBPERMTAB[ARRNAM,PASSPERMTAB]; %518- 80421130 C 0006
GENID("V",1000×CURLEVEL+NAMOFTHING,5); %518- 80421140 C 0008
GEN("[",1,7); %518- 80421150 C 0010
FIRSTTIME := TRUE; %518- 80421160 C 0012
DO %518- 80421170 C 0012
BEGIN %518- 80421180 C 0013
IF FIRSTTIME THEN FIRSTTIME := FALSE ELSE GEN(",",1 80421190 C 0013
,7); 80421200 C 0014
DIFF := PASSPERMTAB-REMEMBERPOSN+1; %518- 80421210 C 0018
GENID("V",(1000+CURLEVEL+NAMOFTHING)×(IF DIFF>9 THEN 100 ELSE 80421220 C 0020
10)+DIFF,(IF DIFF > 9 THEN 7 ELSE 6)); %518- 80421230 C 0020
PASSPERMTAB := PASSPERMTAB + 1; END %518- 80421270 C 0027
UNTIL PASSPERMTAB = MAXPERMTAB OR %518- 80421280 C 0029
ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ≠ -1; %518- 80421290 C 0029
GEN("]",1,7); %518- 80421300 C 0032
GEN("=",1,7); %518- 80421310 C 0034
GENID("H",1000×CURLEVEL+NAMOFTHING,5); %518- 80421320 C 0035
GEN("[",1,7); %518- 80421340 C 0038
PASSPERMTAB := REMEMBERPOSN; FIRSTTIME := TRUE; %518- 80421350 C 0039
DO %518- 80421360 C 0041
BEGIN %518- 80421370 C 0041
IF FIRSTTIME THEN FIRSTTIME := FALSE ELSE GEN(",", 80421380 C 0041
1,7); 80421390 C 0042
DIFF := ARRSUBPERMTAB[PERMSUB,PASSPERMTAB]+1; %518- 80421400 C 0044
GENID("V",(1000×CURLEVEL+NAMOFTHING)×(IF DIFF>9 THEN 80421410 C 0046
100 ELSE 10)+DIFF,(IF DIFF>9 THEN 7 ELSE 6)); 80421420 C 0046
PASSPERMTAB := PASSPERMTAB +1; %518- 80421430 C 0054
END %518- 80421440 C 0055
UNTIL PASSPERMTAB = MAXPERMTAB OR %518- 80421450 C 0055
ARRSUBPERMTAB[ARRNAM,PASSPERMTAB] ≠ -1; %518- 80421460 C 0056
GEN("]#;",3,5); %518- 80421470 C 0059
END %518- 80421480 C 0060
UNTIL PASSPERMTAB = MAXPERMTAB; %518- 80421490 C 0060
MAXPERMTAB := 0; %518- 80421500 C 0061
END %518- 80421510 C 0062
END; %518- 80421520 C 0062
75 IS 64 LONG, NEXT SEG 74
START: 80422000 T 0029
IF CURSY=LABELSY THEN %*** LABEL DECLARATION *** 80423000 T 0029
BEGIN %************************* 80424000 T 0029
DEFINE DEC = LABEL #; %700- 80424100 C 0030
START OF SEGMENT ********** 76
GEN("LABEL",6,3); 80425000 T 0000
DO BEGIN 80426000 T 0001
INSYMBOL; 80427000 T 0002
IF CURSY=INTCONST THEN 80428000 T 0002
BEGIN 80429000 T 0003
GENID("L",CURVAL,4); 80430000 T 0003
IF CURVAL>9999 THEN ERROR(33); 80431000 T 0005
FOR I:=FIRSTLAB STEP 1 UNTIL NUMLABS DO 80432000 T 0007
IF LABTAB[I].LABVAL=CURVAL THEN ERROR(31); 80433000 T 0010
IF NUMLABS≥MAXLABS THEN BEGIN ERROR(34); NUMLABS:=0 END; 80434000 T 0015
NUMLABS:=NUMLABS+1; 80435000 T 0017
LABTAB[NUMLABS]:=CURVAL; 80436000 T 0019
INSYMBOL; 80437000 T 0020
END ELSE BEGIN ERROR(10); SKIP(COMMA) END; 80438000 T 0020
IF CURSY=COMMA THEN GEN(",",1,7); 80439000 T 0022
END UNTIL CURSY≠COMMA; 80440000 T 0025
IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80441000 T 0026
GEN(";",1,7); 80442000 T 0029
IF SYMKIND[CURSY]≠INITIAL THEN INSYMBOL; 80443000 T 0031
END OF LABEL DECLARATION; 80444000 T 0033
76 IS 34 LONG, NEXT SEG 74
80445000 T 0031
IF CURSY=CONSTSY THEN %*** CONSTANT DECLARATION *** 80446000 T 0031
BEGIN %**************************** 80447000 T 0031
LABEL LL1; % %002- 80447010 C 0032
START OF SEGMENT ********** 77
DEFINE DEC = CONST #; %700- 80447100 C 0000
INSYMBOL; 80448000 T 0000
DO BEGIN 80449000 T 0000
IF CURSY=IDENTIFIER THEN 80450000 T 0001
BEGIN 80451000 T 0001
NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80452000 T 0002
INSYMBOL; 80453000 T 0004
IF CURSY=EQLSY THEN 80454000 T 0004
BEGIN 80455000 T 0005
INSYMBOL; CONSTANT(CVAL,CTYPE); 80456000 T 0006
T3:=CTYPE; T3.IDCLASS:=CONST; 80457000 T 0007
IF CVAL.[46:8]≠0 OR CVAL>1023 THEN 80458000 T 0010
BEGIN 80459000 T 0012
IF NUMCONSTS≥MAXCONSTS THEN 80460000 T 0012
BEGIN ERROR(35); NUMCONSTS:=0 END; 80461000 T 0013
NUMCONSTS:=NUMCONSTS+1; 80462000 T 0015
CONSTTAB[NUMCONSTS]:=CVAL; 80463000 T 0016
T3.INFO:=1023+NUMCONSTS; 80464000 T 0018
END ELSE T3.INFO:=CVAL; 80465000 T 0020
NAMETAB3[CURLEVEL,INDEX]:=T3; 80466000 T 0022
END ELSE BEGIN ERROR(36); SKIP(SEMICOLON) END; 80467000 T 0024
END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80468000 T 0026
IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80469000 T 0028
IF SYMKIND[CURSY]≠INITIAL THEN INSYMBOL; 80470000 T 0031
END UNTIL CURSY≠IDENTIFIER; 80471000 T 0033
END OF CONSTANT DECLARATION; 80472000 T 0034
77 IS 35 LONG, NEXT SEG 74
80473000 T 0033
IF CURSY=TYPESY THEN %*** TYPE DECLARATION **** 80474000 T 0033
BEGIN %************************* 80475000 T 0033
DEFINE DEC = TYPE #; %700- 80475100 C 0034
START OF SEGMENT ********** 78
INSYMBOL; 80476000 T 0000
DO BEGIN 80477000 T 0000
IF CURSY=IDENTIFIER THEN 80478000 T 0001
BEGIN 80479000 T 0001
NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80480000 T 0002
INSYMBOL; 80481000 T 0004
IF CURSY=EQLSY THEN 80482000 T 0004
BEGIN 80483000 T 0005
INSYMBOL; 80484000 T 0006
TYPEDECL(CTYPE,TX); 80485000 T 0006
T3:=CTYPE; T3.IDCLASS:=TYPES; 80486000 T 0007
NAMETAB3[CURLEVEL,INDEX]:=T3; 80487000 T 0010
END ELSE BEGIN ERROR(36); SKIP(SEMICOLON) END; 80488000 T 0012
END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80489000 T 0014
IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80490000 T 0016
IF SYMKIND[CURSY]≠INITIAL THEN INSYMBOL; 80491000 T 0018
END UNTIL CURSY≠IDENTIFIER; 80492000 T 0020
END OF TYPE DECLARATION; 80493000 T 0022
78 IS 23 LONG, NEXT SEG 74
80494000 T 0035
IF CURSY=VARSY THEN %*** VARIABLE DECLARATION *** 80495000 T 0035
BEGIN %**************************** 80496000 T 0035
LABEL LL2; % %002- 80496010 C 0036
START OF SEGMENT ********** 79
DEFINE DEC = VAR #; %700- 80496100 C 0000
VARINDEX:=0; 80497000 T 0000
DO BEGIN 80498000 T 0000
FIRSTVAR:=VARINDEX+1; 80499000 T 0001
DO BEGIN 80500000 T 0002
IF CURSY=VARSY OR CURSY=COMMA THEN INSYMBOL; 80501000 T 0003
IF CURSY=IDENTIFIER THEN 80502000 T 0005
BEGIN 80503000 T 0006
IF VARINDEX≥LISTLENGTH THEN 80504000 T 0007
BEGIN ERROR(37); VARINDEX:=0 END; 80505000 T 0007
VARINDEX:=VARINDEX+1; 80506000 T 0009
NEWNAME(CURNAME1,CURNAME2,CURLEVEL); 80507000 T 0011
VARLIST[VARINDEX]:=THISINDEX; 80508000 T 0012
INSYMBOL; 80509000 T 0013
END ELSE BEGIN ERROR(9); SKIP(COLON) END; 80510000 T 0014
END UNTIL CURSY≠COMMA; 80511000 T 0016
IF CURSY≠COLON THEN BEGIN ERROR(26); SKIP(COLON) END; 80512000 T 0017
IF CURSY=COLON THEN 80513000 T 0020
BEGIN 80514000 T 0020
INSYMBOL; 80515000 T 0021
TYPEDECL(CTYPE,TX); 80516000 T 0021
T3:=CTYPE; T3.IDCLASS:=VAR; 80517000 T 0022
FOR I:=FIRSTVAR STEP 1 UNTIL VARINDEX DO 80518000 T 0025
NAMETAB3[CURLEVEL,VARLIST[I]]:=T3; 80519000 T 0026
END ELSE BEGIN ERROR(26); SKIP(SEMICOLON) END; 80520000 T 0030
IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80521000 T 0032
IF SYMKIND[CURSY]≠INITIAL THEN INSYMBOL; 80522000 T 0035
END UNTIL CURSY≠IDENTIFIER; 80523000 T 0037
DECLAREVARS(FALSE,VARLIST,1,VARINDEX,CURLEVEL); 80524000 T 0038
END OF VARIABLE DECLARATIONS; 80525000 T 0040
79 IS 42 LONG, NEXT SEG 74
80526000 T 0037
IF NUMPNTRS>0 THEN 80527000 T 0037
BEGIN 80528000 T 0037
C1:=CURNAME1; C2:=CURNAME2; 80529000 T 0038
FOR I:=1 STEP 1 UNTIL NUMPNTRS DO 80530000 T 0039
BEGIN 80531000 T 0041
CURNAME1:=PNTRTAB1[I]; CURNAME2:=PNTRTAB2[I]; 80532000 T 0041
SEARCHTAB(CURLEVEL); 80533000 T 0043
THISID:=NAMETAB3[CURLEVEL,THISINDEX]; 80534000 T 0043
IF FOUND AND THISID.IDCLASS=TYPES THEN 80535000 T 0045
TYPETAB1[PNTRTAB3[I]].POINTTYPE:=THISID.TYPE ELSE ERROR(62); 80536000 T 0047
END; 80537000 T 0052
CURNAME1:=C1; CURNAME2:=C2; NUMPNTRS:=0; 80538000 T 0054
END; 80539000 T 0056
80540000 T 0056
IF CURSY=FUNCSY OR CURSY=PROCSY % %700- 80540900 C 0056
THEN BEGIN DEFINE DEC = CODE #; %700- 80540910 C 0057
START OF SEGMENT ********** 80
WHILE CURSY=FUNCSY OR CURSY=PROCSY DO %*** PROC/FUNC DECLARATION *** 80541000 T 0000
BEGIN %***************************** 80542000 T 0002
LABEL LL3; % %002- 80542010 C 0002
START OF SEGMENT ********** 81
FUN:=CURSY=FUNCSY; INSYMBOL; 80543000 T 0000
IF CURLEVEL GEQ MAXTABLES THEN ERROR(101) ELSE %002- 80543500 C 0001
BLOCKTAB[CURLEVEL+1] := NUMBLOCKS := NUMBLOCKS + 1; %002- 80543600 C 0003
IF CURSY=IDENTIFIER THEN 80544000 T 0007
BEGIN 80545000 T 0007
SEARCHTAB(CURLEVEL); 80546000 T 0008
THISID:=NAMETAB3[CURLEVEL,THISINDEX]; 80547000 T 0009
IF FOUND AND (THISID.IDCLASS=PROC OR THISID.IDCLASS=FUNC) THEN %600- 80548000 P 0010
BEGIN 80549000 T 0014
INDEX:=THISINDEX; 80550000 T 0014
IF THISID.FORWARDDEF=1 THEN 80551000 T 0015
BEGIN 80552000 T 0016
NAMETAB3[CURLEVEL,THISINDEX].FORWARDDEF:=0; %504- 80553000 P 0017
NUMFORWARDS:=NUMFORWARDS-1; 80554000 T 0020
T := NAMETAB3[CURLEVEL,THISINDEX].INFO; %002- 80554500 C 0021
TX := T + PARAMTAB[T]; %002- 80554600 C 0023
FOR I:=T+1 STEP 1 UNTIL TX DO %002- 80554700 C 0025
NEWNAME(FORWPARAM1[I],FORWPARAM2[I],CURLEVEL+1); %002- 80554800 C 0029
IF(THISID.IDCLASS=PROC AND FUN)OR 80555000 T 0032
(THISID.IDCLASS=FUNC AND NOT FUN) THEN ERROR(43); %504- 80555100 C 0034
TX:=(T:=THISID.INFO)+PARAMTAB[T]; % UNMARK FORWARD PARMS 80556000 P 0037
FOR I:=T+1 STEP 1 UNTIL TX DO % TO ALLOW REFERENCE 80557000 C 0040
BEGIN T3:=PARAMTAB[I].PARAMNAME; %504- 80558000 C 0044
CURNAME1:=ABS(NAMETAB1[CURLEVEL+1,T3]); %504- 80559000 C 0045
CURNAME2:= NAMETAB2[CURLEVEL+1,T3]; %504- 80560000 C 0048
NAMETAB1[CURLEVEL+1,T3]:=0; %504- 80561000 C 0050
NEWNAME(CURNAME1,CURNAME2,CURLEVEL+1); %504- 80562000 C 0053
IF T3≠THISINDEX THEN BEGIN %504- 80563000 C 0054
PARAMTAB[I].PARAMNAME:=THISINDEX; %504- 80564000 C 0056
NAMETAB3[CURLEVEL+1,THISINDEX] := %504- 80565000 C 0058
NAMETAB3[CURLEVEL+1,T3]; %504- 80565010 C 0060
END END; % OF UNMARKING FORWARD PARAMETERS. %504- 80566000 C 0062
INSYMBOL; 80567000 T 0063
END ELSE BEGIN ERROR(2); SKIP(SEMICOLON) END; 80568000 T 0063
END ELSE 80569000 T 0065
BEGIN 80570000 T 0065
NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80571000 T 0066
T3:=0; T3.INFO:=NUMPARAMS+1; 80572000 T 0068
T3.IDCLASS:=IF FUN THEN FUNC ELSE PROC; 80573000 T 0071
NAMETAB3[CURLEVEL,INDEX]:=T3; 80574000 T 0074
INSYMBOL; PARAMETERLIST; 80575000 T 0076
IF CURSY=COLON THEN 80576000 T 0077
BEGIN 80577000 T 0078
IF NOT FUN THEN ERROR(48); 80578000 T 0078
INSYMBOL; 80579000 T 0080
IF CURSY=IDENTIFIER THEN 80580000 T 0080
BEGIN 80581000 T 0081
SEARCH; 80582000 T 0082
IF FOUND THEN 80583000 T 0082
BEGIN 80584000 T 0082
IF THISID.IDCLASS=TYPES THEN 80585000 T 0083
BEGIN 80586000 T 0084
T:=TYPETAB1[THISID.TYPE]; 80587000 T 0085
IF T.FORM≤ALFA OR T.FORM=POINTERS THEN 80588000 T 0086
BEGIN 80589000 T 0089
NAMETAB3[CURLEVEL,INDEX].TYPE:=THISID.TYPE; 80590000 T 0089
END ELSE ERROR(38); 80591000 T 0093
END ELSE ERROR(7); 80592000 T 0094
END ELSE ERROR(1); 80593000 T 0096
END ELSE ERROR(9); 80594000 T 0097
INSYMBOL; 80595000 T 0098
END ELSE IF FUN THEN 80596000 T 0099
BEGIN ERROR(26); SKIP(SEMICOLON) END; 80597000 T 0099
END; 80598000 T 0101
END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80599000 T 0101
IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80600000 T 0103
IF FUN THEN GEN("FUNCTN",7,2) ELSE 80601000 T 0106
GEN("PROCEDU",8,1); GENID("V",1000×CURLEVEL+INDEX,5); 80602000 T 0108
T:=NAMETAB3[CURLEVEL,INDEX].INFO; TX:=T+PARAMTAB[T]; 80603000 T 0115
IF TX>T THEN 80604000 T 0118
BEGIN 80605000 T 0119
GEN("(",1,7); 80606000 T 0120
FOR I:=T+1 STEP 1 UNTIL TX DO 80607000 T 0121
BEGIN %518- 80608010 C 0125
BEGIN %518- 80608020 C 0125
INTEGER NAM,T1,SCRATCH; %518- 80608030 C 0125
START OF SEGMENT ********** 82
NAM := PARAMTAB[I].[9:10]; %518- 80608040 C 0000
SCRATCH := NAMETAB3[CURLEVEL+1,NAM]; %518- 80608050 C 0001
SCRATCH := SCRATCH.TYPE; %518- 80608060 C 0003
T1 := TYPETAB1[SCRATCH]; %518- 80608070 C 0005
IF T1.STRUCT ≠ 0 AND T1.FORM < FILES THEN %518- 80608080 C 0006
GENID("H",1000×(CURLEVEL+1)+NAM,5) %518- 80608090 C 0008
ELSE %518- 80608100 C 0012
BEGIN % %601- 80608105 C 0012
GENID("V",1000×(CURLEVEL+1)+NAM,5); %518- 80608110 C 0012
IF T1.FORM=SET THEN % %601- 80608111 C 0015
BEGIN % %601- 80608113 C 0017
GEN(",",1,7); % %601- 80608115 C 0017
GENID("W",1000×(CURLEVEL+1)+NAM,5); % %601- 80608117 C 0019
END; %601- 80608118 C 0022
END; % %601- 80608119 C 0022
END; %518- 80608120 C 0022
82 IS 23 LONG, NEXT SEG 81
IF BOOLEAN(PARAMTAB[I].PARAMFILE) THEN 80609000 T 0128
BEGIN 80610000 T 0129
GEN(",",1,7); 80611000 T 0129
GENID("F",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80612000 T 0131
GEN(",",1,7); 80613000 T 0134
GENID("I",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80614000 T 0136
END; 80615000 T 0140
IF I LSS TX THEN GEN(",",1,7); 80616000 T 0140
END; 80617000 T 0142
GEN(");",2,6); 80618000 T 0143
VALUEPARAMS:=FALSE; 80619000 T 0144
FOR I:=T+1 STEP 1 UNTIL TX DO 80620000 T 0145
IF PARAMTAB[I].PARAMKIND=CONST THEN 80621000 T 0149
BEGIN 80622000 T 0151
IF NOT VALUEPARAMS THEN 80623000 T 0151
BEGIN GEN("VALUE",6,3); 80624000 T 0152
VALUEPARAMS:=TRUE; 80625000 T 0154
END ELSE GEN(",",1,7); 80626000 T 0155
GENID("V",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80627000 T 0159
IF TYPETAB1[NAMETAB3[CURLEVEL+1,PARAMTAB[I].PARAMNAME].TYPE 80627200 C 0163
].FORM=SET %601- 80627205 C 0165
THEN BEGIN % %601- 80627400 C 0167
GEN(",",1,7); % %601- 80627600 C 0168
GENID("W",1000×(CURLEVEL+1)+PARAMTAB[I].PARAMNAME 80627800 C 0169
,5); % %601- 80627801 C 0169
END; %601- 80627850 C 0173
END; 80628000 T 0173
IF VALUEPARAMS THEN GEN(";",1,7); 80629000 T 0173
DECLAREVARS(TRUE,PARAMTAB,T+1,TX,CURLEVEL+1); 80630000 T 0176
END ELSE GEN(";",1,7); 80631000 T 0179
80632000 T 0181
INSYMBOL; 80633000 T 0181
IF CURNAME1="7FORWAR" AND CURNAME2="D" THEN 80634000 T 0181
BEGIN 80635000 T 0183
NAMETAB3[CURLEVEL,INDEX].FORWARDDEF:=1; 80636000 T 0184
TX:=(T:=NAMETAB3[CURLEVEL,INDEX].INFO)+PARAMTAB[T]; %504- 80636100 C 0187
FOR I:=T+1 STEP 1 UNTIL TX DO % MARK FORWARD PARAMETERS 80636200 C 0190
NAMETAB1[CURLEVEL+1,PARAMTAB[I].PARAMNAME].[46:1] := 1; 80636210 C 0195
NUMFORWARDS:=NUMFORWARDS+1; 80637000 T 0201
REPLACE POINTER(NAMETAB1[CURLEVEL+1,*]) BY 0 %002- 80637500 C 0202
FOR MAXNAMES+1 WORDS; %002- 80637600 C 0205
GEN("FORWARD",8,1); 80638000 T 0208
INSYMBOL; 80639000 T 0209
END ELSE 80640000 T 0210
BEGIN 80641000 T 0210
CURLEVEL:=CURLEVEL+1; 80642000 T 0212
IF CURLEVEL GEQ LASTREC THEN ERROR(101); % %002- 80643000 P 0213
BLOCKTAB[CURLEVEL]:=NUMBLOCKS:=NUMBLOCKS+1; 80644000 T 0215
TX:=CURFUNC; CURFUNC:=IF FUN THEN INDEX ELSE -1; %504- 80645000 P 0217
BLOCK; %*** COMPILE PROCEDURE BODY *** 80646000 P 0220
FOR I:=0 STEP 1 UNTIL MAXNAMES DO % LEAVE FORWARD PARAMETERS 80647000 P 0221
IF NAMETAB1[CURLEVEL,I]>0 THEN NAMETAB1[CURLEVEL,I]:=0; 80648000 P 0222
CURLEVEL:=CURLEVEL-1; CURFUNC:=TX; %504- 80649000 P 0228
TOPLEVEL:=CURLEVEL; 80650000 T 0230
END; 80651000 T 0231
IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80652000 T 0231
GEN(";",1,7); 80653000 T 0234
IF SYMKIND[CURSY]≠INITIAL THEN INSYMBOL; 80654000 T 0235
END OF PROCEDURE DECLARATION; 80655000 T 0237
81 IS 238 LONG, NEXT SEG 80
80656000 T 0003
80657000 T 0003
IF NUMFORWARDS>0 THEN ERROR(44); 80658000 T 0003
END OF SEGMENT FOR PROCEDURE DECLARATIONS; %700- 80658100 C 0005
80 IS 6 LONG, NEXT SEG 74
GEN("INTEGER",8,1); 80659000 T 0060
FOR I:=1 STEP 1 UNTIL MAXTEMPS DO 80660000 T 0061
BEGIN GENID("T",I,2); 80661000 T 0064
IF I<MAXTEMPS THEN GEN(",",1,7) ELSE GEN(";",1,7); 80662000 T 0065
END; 80663000 T 0070
IF CURSY≠BEGINSY THEN 80664000 T 0072
BEGIN ERROR(39); 80665000 T 0073
WHILE SYMKIND[CURSY]≠INITIAL DO 80666000 T 0074
BEGIN INSYMBOL; SKIP(SEMICOLON) END; 80667000 T 0076
IF(CURSY=TYPESY)OR(CONSTSY≤CURSY AND CURSY≤PROCSY)THEN 80668000 T 0078
GO TO START; 80669000 T 0081
END; 80670000 T 0081
IF CURLEVEL=1 THEN 80671000 T 0081
BEGIN 80672000 T 0082
GEN("INIT(",5,3); 80673000 T 0083
IF INPUTDECL THEN GEN("TRUE",4,4) ELSE GEN("FALSE",5,3); 80674000 T 0084
GEN(");",2,6); 80675000 T 0091
END; 80676000 T 0093
FOR I:=FIRSTFILE STEP 1 UNTIL NUMFILES DO 80677000 T 0093
IF FILETAB[I] LSS 0 THEN 80678000 T 0096
BEGIN 80679000 T 0097
GEN("CHFIL(",6,2); 80680000 T 0097
GENID("F",1000×CURLEVEL-FILETAB[I]-1,5); 80681000 T 0099
GEN(");",2,6); 80682000 T 0102
END 80683000 T 0103
ELSE 80684000 T 0103
BEGIN 80685000 T 0103
GENID("I",1000×CURLEVEL+FILETAB[I],5); 80686000 T 0107
GEN(",",1,7); GEN("BUFSIZE",7,1); GEN(":=80;",5,3); 80687000 T 0109
END; 80688000 T 0114
NUMFILES:=FIRSTFILE-1; 80689000 T 0116
80690000 T 0117
COMPSTAT; %*** COMPILE STATEMENT PART *** 80691000 P 0117
80692000 T 0118
FOR I:=LASTREC STEP 1 UNTIL TOPREC-1 DO % CLEAR RECORD DECS %504- 80693000 P 0118
REPLACE POINTER(NAMETAB1[I,*]) BY 0 FOR MAXNAMES+1 WORDS; 80694000 T 0122
FOR I:=FIRSTLAB STEP 1 UNTIL NUMLABS DO 80695000 T 0131
IF LABTAB[I].LABDEF=0 THEN ERROR(93); 80696000 T 0132
LASTREC:=TOPREC; 80697000 T 0137
NUMLABS:=LABTABTOP; 80698000 T 0137
FIRSTLAB:=FORMERFIRSTLAB; 80699000 T 0138
NUMCONSTS:=CONSTTABTOP; 80700000 T 0139
NUMTYPES:=TYPETABTOP; 80701000 T 0140
NUMPARAMS:=PARAMTABTOP; 80702000 T 0140
MARGIN("-P",CURLEVEL); % MARK END OF PROCEDURE %712- 80702100 C 0141
IF CURLEVEL>1 THEN GEN("END",4,5); 80703000 T 0159
END OF BLOCK; 80704000 T 0162
74 IS 173 LONG, NEXT SEG 2
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90001000 T 0118
% % 90002000 T 0118
% % 90003000 T 0118
% % 90004000 T 0118
% PART 9: THE MAIN PROGRAM. % 90005000 T 0118
% ----------------- % 90006000 T 0118
% % 90007000 T 0118
% % 90008000 T 0118
% % 90009000 T 0118
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90010000 T 0118
90011000 T 0118
90012000 T 0118
INTEGER PROGNAMELENGTH; % %800- 90013900 C 0118
ALPHA PROGNAME,ALGOLNAME; 90014000 T 0118
% %002- 90014100 C 0118
% %002- 90014200 C 0118
SAVEFACTOR:=0;% * DEFAULT ZIP IS COMPILE AND GO UNLESS %002- 90014300 C 0118
% * CHANGED BY THE USE OF THE "S" OPTION %002- 90014400 C 0118
% %002- 90014500 C 0118
% %002- 90014600 C 0118
90015000 T 0118
CH[0] := "PASC000"; CHARPNT := POINTER(CH[0])+5; %711- 90016000 P 0118
PASCALGOL.FID := USER := TIME(-1); %711- 90017000 P 0125
DO BEGIN C:=C+1; REPLACE CHARPNT BY C FOR 3 DIGITS; %711- 90018000 P 0129
PASCALGOL.MFID := ALGOLNAME := CH[0]; %711- 90019000 P 0133
SEARCHDISKDIRECTORY( PASCALGOL, LINES[*] ); %711- 90020000 P 0137
END UNTIL LINES[0]=-1; % FILE NOT ON DISK %711- 90021000 P 0139
WRITE(PASCALGOL,MERGE); % ALGOL MUST COMPILE PRELUDE FIRST %704- 90022000 P 0140
CARDLENGTH:=72; 90033000 T 0143
C := " "; % TO INITIALIZE "INSYMBOL" %709- 90034000 P 0144
INITIALIZE; % COMPILER TABLES, NEWCARD, INSYMBOL %709- 90035000 P 0145
IF CURSY=PROGRAMSY THEN 90037000 T 0145
BEGIN 90038000 T 0146
INSYMBOL; 90039000 T 0147
IF CURSY=IDENTIFIER THEN 90040000 T 0147
BEGIN 90041000 T 0148
PROGNAME := IF CURLENGTH < 7 %705- 90042000 P 0148
THEN " "&CURNAME1[41:6×CURLENGTH-1:6×CURLENGTH] 90042010 C 0149
ELSE CURNAME2.[5:6]&CURNAME1[41:35:36]; %705- 90042020 C 0154
% %002- 90042100 C 0157
% THE FOLLOWING LINES ADD A "0" ONTO THE FRONT OF THE PROGRAM NAME OR 90042200 C 0157
% THE FIRST SIX CHARACTERS THEREOF IF IT IS LONGER THAN SIX CHARACTERS 90042300 C 0157
% THUS GIVING THE NAME OF THE XALGOL OBJECT CODE FILE PRODUCED. %002- 90042400 C 0157
% %002- 90042500 C 0157
PROGNAME := CURNAME1.[35:36]; PROGNAMELENGTH := MIN(6,CURLENGTH)+1; 90042600 C 0157
% %002- 90042700 C 0161
% %002- 90042800 C 0162
INSYMBOL; 90043000 T 0162
IF CURSY=LPAR THEN 90044000 T 0162
BEGIN 90045000 T 0163
DO BEGIN 90046000 T 0163
INSYMBOL; 90047000 T 0164
IF CURSY=IDENTIFIER THEN 90048000 T 0164
BEGIN 90049000 T 0165
IF CURNAME1="50INPUT" THEN INPUTDECL:=TRUE ELSE 90050000 T 0165
IF CURNAME1="6OUTPUT" THEN OUTPUTDECL:=TRUE ELSE 90051000 T 0167
BEGIN 90052000 T 0176
IF CURLENGTH>6 THEN ERROR(77); 90053000 T 0178
NUMEXTFILES:=NUMEXTFILES+1; 90054000 T 0180
IF NUMEXTFILES≤MAXEXTFILES THEN 90055000 T 0181
EXTFILETAB[NUMEXTFILES]:=CURNAME1 ELSE 90056000 T 0182
IF NUMEXTFILES=MAXEXTFILES+1 THEN ERROR(73); 90057000 T 0183
END; 90058000 T 0186
END ELSE ERROR(9); 90059000 T 0186
INSYMBOL; 90060000 T 0188
END UNTIL CURSY≠COMMA; 90061000 T 0188
IF CURSY≠RPAR THEN BEGIN ERROR(46); SKIP(SEMICOLON) END; 90062000 T 0189
IF CURSY=RPAR THEN INSYMBOL; 90063000 T 0192
IF CURSY≠SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 90064000 T 0194
END ELSE BEGIN ERROR(58); SKIP(SEMICOLON) END; 90065000 T 0197
END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 90066000 T 0199
END ELSE BEGIN ERROR(75); SKIP(SEMICOLON) END; 90067000 T 0201
INSYMBOL; 90068000 T 0203
CURLEVEL:=1; 90069000 T 0203
LASTREC:=MAXTABLES+1; 90070000 T 0204
MAXPERMTAB := 0; %518- 90070100 C 0205
INSIDEPARENS := FALSE; %518- 90070200 C 0206
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90071000 T 0207
% % 90072000 T 0207
BLOCK; % COMPILE USER PROGRAM. % 90073000 T 0207
% % 90074000 T 0207
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90075000 T 0207
IF CURSY≠DOT THEN 90076000 T 0207
BEGIN 90077000 T 0208
ERROR(76); 90078000 T 0208
DO BLOCK UNTIL CURSY=DOT; 90079000 T 0209
END; 90080000 T 0211
IF FALSE THEN 90081000 T 0211
BEGIN 90082000 T 0212
ENDOFINPUT: ERROR(87); CHARCNT:=-1; 90083000 T 0212
WRITE(LINE, TERMMESS); %708- 90084000 P 0214
END; 90085000 T 0217
IF LISTOPTION AND CHARCNT≥0 THEN PRINTLINE; 90086000 T 0217
IF ERRINX>0 THEN PRINTERRORS; 90087000 T 0220
IF PAGECNT > 0 % THERE HAS BEEN SOME LISTING %709- 90088000 P 0221
THEN BEGIN WRITE( LINE[DBL] ); WRITE( LINE[DBL] ) END; %709- 90089000 P 0222
IF NUMERRS=0 THEN 90090000 T 0231
BEGIN% %002- 90090400 C 0231
WRITE(LINE ,NOERRORS);% %002- 90090500 C 0232
IF ERR(100) % %800- 90090600 C 0235
THEN WRITE(LINE ,ERROR100MESS);% %002- 90090700 C 0239
IF ERR(102) THEN %713- 90090710 C 0243
WRITE(LINE,ERROR102MESS); %713- 90090720 C 0247
IF SAVEFACTOR≥0 THEN% *A ZIP IS REQUIRED %002- 90090800 C 0250
BEGIN 90091000 T 0251
ARRAY ZIPARRAY[0:19], Z[0:0]; 90092000 T 0252
START OF SEGMENT ********** 83
POINTER ZIPPNT; 90093000 T 0005
90094000 T 0005
DEFINE PPROGNAME = 13 #, PALGOLNAME = 14 #, %705- 90095000 P 0005
PLIBRARY = 15 #, PUSER = 16 #, %705- 90096000 P 0005
P(P1) = POINTER(ZIPARRAY[P1])+1 FOR 7 #; %705- 90097000 P 0005
90105000 T 0005
WRITEALGOL; 90106000 T 0005
WRITE(PASCALGOL,LASTLINE); 90107000 T 0005
LOCK(PASCALGOL,SAVE); 90108000 T 0008
ZIPARRAY[PPROGNAME]:=PROGNAME; ZIPARRAY[PALGOLNAME]:=ALGOLNAME; 90112000 P 0010
ZIPARRAY[PLIBRARY]:= IF SAVEFACTOR>0 THEN "LIBRARY" ELSE %705- 90113000 P 0012
IF SAVEFACTOR<0 THEN " SYNTAX" ELSE " & RUN "; 90114000 P 0015
ZIPARRAY[PUSER]:=USER; %705- 90115000 P 0018
REPLACE POINTER(ZIPARRAY[*]) BY "CC COMPILE ", %705- 90116000 P 0019
P(PPROGNAME), "/", P(PUSER), %705- 90117000 P 0025
" XALGOL ", P(PLIBRARY), %705- 90118000 P 0041
"; ALGOL FILE TAPE=PASCRUN/DISK SERIAL; ALGOL FILE CARD=", %800- 90119000 P 0052
P(PALGOLNAME),"/",P(PUSER)," SERIAL;", % %800- 90120000 P 0056
" XALGOL STACK = 2048; END."; % %800- 90120500 C 0077
ZIP WITH ZIPARRAY[*]; 90129000 T 0080
END% %002- 90129500 C 0082
END OF COMPILER ZIP ELSE 90130000 T 0082
83 IS 88 LONG, NEXT SEG 2
BEGIN 91001000 T 0253
INTEGER I; 91002000 T 0253
START OF SEGMENT ********** 84
SWITCH FORMAT ERRORMESS1 := 91003000 T 0000
START OF SEGMENT ********** 85
(" 0 *** COMPILER ERROR *** CONTACT THE COMPUTER CENTRE."), 91004000 T 0000
(" 1 IDENTIFIER NOT DEFINED."), 91005000 T 0000
(" 2 IDENTIFIER ALREADY DEFINED."), 91006000 T 0000
(" 3 WRONG NUMBER OF PARAMETERS."), 91007000 T 0000
(" 4 SYNTAX ERROR."), 91008000 T 0000
(" 5 FUNCTION NAME NOT ACCESSIBLE AT THIS LEVEL."), %511- 91009000 P 0000
(" 6 STRINGS MAY NOT BE CONTINUED FROM ONE CARD TO ANOTHER."), 91010000 T 0000
(" 7 A TYPE EXPECTED."), 91011000 T 0000
(" 8 VARIABLE EXPECTED."), 91012000 T 0000
(" 9 IDENTIFIER EXPECTED."), 91013000 T 0000
(" 10 INTEGER CONSTANT EXPECTED."), 91014000 T 0000
(" 11 CONSTANT OF OTHER TYPE THAN EXPECTED."), 91015000 T 0000
(" 12 VARIABLE OF ILLEGAL TYPE."), 91016000 T 0000
(" 13 UNRECOGNIZABLE STATEMENT."), 91017000 T 0000
(" 14 CONSTANT TOO BIG OR TO SMALL."), 91018000 T 0000
(" 15 UNDEFINED LABEL."), 91019000 T 0000
(" 16 FOR- AND CASE-STATEMENTS NESTED TOO DEEP."), 91020000 T 0000
(" 17 EXPRESSION IS OF WRONG TYPE."), 91021000 T 0000
(" 18 """OF""" EXPECTED."), 91022000 T 0000
(" 19 """DO""" EXPECTED."), 91023000 T 0000
(" 20 """ELSE""" WITHOUT CORRESPONDING """THEN"""."), 91024000 T 0000
(" 21 ILLEGAL TERMINATION OF STATEMENT."), 91025000 T 0000
(" 22 """UNTIL""" EXPECTED."), 91026000 T 0000
(" 23 """TO"""/"""DOWNTO""" EXPECTED."), 91027000 T 0000
(" 24 """END""" EXPECTED."), 91028000 T 0000
(" 25 """;""" EXPECTED."), 91029000 T 0000
(" 26 """:""" EXPECTED."), 91030000 T 0000
(" 27 """THEN""" EXPECTED."), 91031000 T 0000
(" 28 """:=""" EXPECTED."), 91032000 T 0000
(" 29 ONLY NUMBERS MAY BE SIGNED."), 91033000 T 0000
(" 30 TOO MANY CASES."), 91034000 T 0000
(" 31 LABEL USED MORE THAN ONCE."), 91035000 T 0000
(" 32 CONSTANT EXPECTED."), 91036000 T 0000
(" 33 LABEL NOT IN RANGE 0..9999."), 91037000 T 0000
(" 34 TOO MANY LABELS DECLARED."), 91038000 T 0000
(" 35 TOO MANY CONSTANTS DECLARED."), 91039000 T 0000
(" 36 """=""" EXPECTED."), 91040000 T 0000
(" 37 THE LIST IS TOO LONG."), 91041000 T 0000
(" 38 INVALID TYPE FOR A FUNCTION."), 91042000 T 0000
(" 39 """BEGIN""" EXPECTED."), 91043000 T 0000
(" 40 TOO MANY IDENTIFIERS DECLARED."), 91044000 T 0000
(" 41 ALFA CONSTANTS MAY NOT BE LONGER THAN 7 CHARACTERS."),%001- 91045000 P 0000
(" 42 EXPRESSION IS NOT OF TYPE BOOLEAN."), 91046000 T 0000
(" 43 NOT PROPER FORWARD DECLARATION."), 91047000 T 0000
(" 44 UNSATISFIED FORWARD DECLARATION."), 91048000 T 0000
(" 45 TOO MANY DIFFERENT TYPES DECLARED."), 91049000 T 0000
(" 46 """)""" EXPECTED."), 91050000 T 0000
(" 47 """[""" EXPECTED."), 91051000 T 0000
(" 48 A SIMPLE TYPE EXPECTED."), 91052000 T 0000
(" 49 """ARRAY OF ARRAY""" AND """ARRAY OF RECORD""" ILLEGAL", 91053000 T 0000
" AS FILE TYPE."), 91054000 T 0000
(" 50 """FILE OF FILE""" IS ILLEGAL."), 91055000 T 0000
(" 51 SET BOUNDRY IS TOO BIG OR TOO SMALL."), 91056000 T 0000
(" 52 TOO MANY UNDECLARED POINTERS."), 91057000 T 0000
(" 53 """..""" EXPECTED."), 91058000 T 0000
(" 54 FIRST VALUE IS GREATER THAN SECOND VALUE."), 91059000 T 0000
(" 55 PROCEDURE NESTING DEPTH + NO OF RECORDS IS TOO GREAT."), 91060000 P 0000
(" 56 THE RECORD CONTAINS MORE THEN 1023 WORDS."), 91061000 T 0000
(" 57 FILES NOT ALLOWED IN RECORDS."), 91062000 T 0000
(" 58 """(""" EXPECTED."), 91063000 T 0000
(" 59 """]""" EXPECTED."); 91064000 T 0000
85 IS 591 LONG, NEXT SEG 84
91065000 T 0000
SWITCH FORMAT ERRORMESS2 := 91066000 T 0000
START OF SEGMENT ********** 86
(" 60 """ARRAY OF FILE""" NOT ALLOWED."), 91067000 T 0000
(" 61 RANGE OF INDEX IS GREATER THAN 1023."), 91068000 T 0000
(" 62 UNSATISFIED POINTER DECLARATION."), 91069000 T 0000
(" 63 EXPRESSION IS TOO LONG."), 91070000 T 0000
(" 64 ILLEGAL OPERATOR FOR THIS TYPE OF EXPRESSION."), 91071000 T 0000
(" 65 INTEGER EXPRESSION EXPECTED."), 91072000 T 0000
(" 66 A SET EXPECTED."), 91073000 T 0000
(" 67 PARAMETER OF ILLEGAL TYPE."), 91074000 T 0000
(" 68 PROCEDURES NOT ALLOWED IN THIS CONTEXT."), 91075000 T 0000
(" 69 ILLEGAL USE OF THIS TYPE OF IDENTIFIER."), 91076000 T 0000
(" 70 TOO MANY PARAMETERS DECLARED IN THE PROGRAM."), 91077000 T 0000
(" 71 """ARRAY OF CHAR""" EXPECTED."), 91078000 T 0000
(" 72 WRONG TYPE OF SET EXPRESSION."), 91079000 T 0000
(" 73 TOO MANY EXTERNAL FILES."), 91080000 T 0000
(" 74 ILLEGAL IDENTIFIER FOR EXTERNAL FILE."), 91081000 T 0000
(" 75 """PROGRAM""" EXPECTED."), 91082000 T 0000
(" 76 """.""" EXPECTED AT END OF PROGRAM."), 91083000 T 0000
(" 77 EXTERNAL FILE IDENTIFIER MAY NOT EXCEED 6 CHARACTERS."), 91084000 T 0000
(" 78 ILLEGAL FILE PARAMETER."), 91085000 T 0000
(" 79 ILLEGAL USE OF FILE HANDLING PROCEDURE."), 91086000 T 0000
(" 80 TEXT-FILE EXPECTED."), 91087000 T 0000
(" 81 POINTER VARIABLE EXPECTED."), 91088000 T 0000
(" 82 ONLY VALUES OF TYPE REAL, INTEGER OR CHAR MAY BE READ."), 91089000 T 0000
(" 83 VARIABLES IN RECORDS ILLEGAL IN THIS CONTEXT."), 91090000 T 0000
(" 84 DISPLAY OVERFLOW."), 91091000 T 0000
(" 85 READ AND WRITE MAY ONLY BE USED ON TEXT-FILES."), 91092000 T 0000
(" 86 REFERENCED OBJECT IS TOO BIG."), 91093000 T 0000
(" 87 END-OF-INPUT ENCOUNTERED UNEXPECTEDLY."), %001- 91094000 P 0000
(" 88 CHARACTER ARRAY EXPECTED."), 91095000 T 0000
(" 89 """,""" EXPECTED."), 91096000 T 0000
(" 91 PROCEDURES MAY NOT HAVE ANY TYPE."), 91097000 T 0000
(" 91 PARAMETER OF WRONG KIND."), 91098000 T 0000
(" 92 ONLY COMPLETE ARRAYS AND RECORDS MAY BE TRANSMITTED."), 91099000 T 0000
(" 93 DECLARED LABEL NOT USED."), 91100000 T 0000
(" 94 PARAMETERS OF THIS TYPE SHOULD NOT BE VALUE PARAMETERS."), 91101000 T 0000
(" 95 SIZE OF STRUCTURES IN ASSIGNMENT ARE NOT THE SAME."), %512- 91102000 P 0000
(" 96 INPUT/OUPUT NOT DECLARED."), 91103000 T 0000
(" 97 TOO MANY FILES IN USE."), %001- 91104000 P 0000
(" 98 RECORD IDENTIFIER EXPECTED."), 91105000 T 0000
(" 99 UNRECOGNIZED ITEM."), 91106000 T 0000
("100 ILLEGAL SAVE CONSTANT IN """""S""""" OPTION. THE VALUE 07 IS 91106500 C 0000
SUBSTITUTED"/" SO THIS ERROR DOES NOT INCREMENT THE COMPILATION ERRO 91106600 C 0000
RS COUNT."),% %002- 91106700 C 0000
("101 PROCEDURES/FUNCTIONS NESTED TOO DEEP."), %002- 91106800 C 0000
("102 ***WARNING ONLY, ILLEGAL DOLLAR OPTION."), %713- 91106900 C 0000
(); 91107000 T 0000
86 IS 485 LONG, NEXT SEG 84
91108000 T 0000
91109000 T 0000
WRITE(LINE, ERRORS,NUMERRS); %708- 91110000 P 0000
FOR I:=0 STEP 1 UNTIL 59 DO IF ERR[I] THEN 91111000 T 0007
WRITE(LINE, ERRORMESS1[I]); %708- 91112000 P 0012
FOR I:=60 STEP 1 UNTIL 119 DO IF ERR[I] THEN 91113000 T 0019
WRITE(LINE, ERRORMESS2[I-60]); %708- 91114000 P 0024
END OF ERROR MESSAGES; 91115000 T 0031
84 IS 36 LONG, NEXT SEG 2
IF XREFOPTION THEN 92001000 T 0254
BEGIN 92002000 T 0254
REPLACE POINTER(XREFLINE[*]) BY " " FOR 17 WORDS; 92003000 T 0254
REWIND(XREFFILE); %002- 92003500 C 0259
HEADING; 92004000 T 0260
SORT(PRINTXREF,XREFINPUT,0,XREFMAX,XREFCOMPARE,3,1000,6000); %002- 92005000 P 0261
END; 92006000 T 0281
END OF B5700 PASCAL COMPILER............................................ 99001000 P 0281
2 IS 287 LONG, NEXT SEG 1
START OF SEGMENT ********** 87
87 IS 30 LONG, NEXT SEG 1
1 IS 2 LONG, NEXT SEG 0
103 IS 69 LONG, NEXT SEG 0
NUMBER OF ERRORS DETECTED = 0. COMPILATION TIME = 228 SECONDS.
PRT SIZE = 311; TOTAL SEGMENT SIZE = 8668 WORDS; DISK SIZE = 540 SEGS; NO. PGM. SEGS = 103
ESTIMATED CORE STORAGE REQUIRED = 22525 WORDS.
ESTIMATED AUXILIARY MEMORY REQUIRED = 0 WORDS.
NUMBER OF CARD-IMAGES PROCESSED = 4242.
LABEL 000000000LINE 00186197? COMPILE PASCAL/NEW XALGOL LIBRARY XALGOL /PASCAL
Reference in New Issue View Git Blame Copy Permalink