github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-01-11 23:42:42 +00:00
Code Issues Releases Wiki Activity
retro-software.B5500-software/PASCAL-Heriot-Watt/PASCAL.MKXIII-Compile.lst
Paul Kimpel c9fe38ede3 1. Commit proofreading corrections to SYMBOL.PASCAL and PASCRUN.DISK. 
2. Commit compile deck and listing with patches to allow the compiler to work with B5500 Mark XIII Algol.
3. Commit compile & go deck and output listing for HMSS2.TEST sample program.
2016-07-04 18:35:59 -07:00

3817 lines
419 KiB
Plaintext
Raw Permalink 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.

LABEL 0XALGOL 0COMPILE00186180?COMPILE PASCAL/DISK XALGOL LIBRARY XALGOL /PASCAL
BURROUGHS B-5700 XALGOL COMPILER MARK XIII.0 SUNDAY, 06/29/86, 10:38 AM.
10001000 T 0000
10002000 T 0000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10003000 T 0000
% % 10004000 T 0000
% % 10005000 T 0000
% * * % 10006000 T 0000
% * P A S C A L C O M P I L E R * % 10007000 T 0000
% *********************************** % 10008000 T 0000
% % 10009000 T 0000
% % 10010000 T 0000
% WRITTEN 1975 BY % 10011000 T 0000
% DAG F. LANGMYHR, % 10012000 T 0000
% HERIOT-WATT UNIVERSITY, % 10013000 T 0000
% EDINBURGH. % 10014000 T 0000
% % 10015000 T 0000
% % 10016000 T 0000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10017000 T 0000
% % 10018000 T 0000
% % 10019000 T 0000
% PART 1: DECLARATIONS. % 10020000 T 0000
% ------------- % 10021000 T 0000
% % 10022000 T 0000
% % 10023000 T 0000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10024000 T 0000
10025000 T 0000
10026000 T 0000
BEGIN 10027000 T 0000
START OF SEGMENT ********** 2
DEFINE EDITION="2.3"#; 10028000 T 0000
INTEGER NUMERRS, % @R+21: NUMBER OF ERRORS IN PROGRAM. 10029000 T 0000
SAVEFACTOR, % @R+22: SAVEFACTOR FOR CODE FILE. 10030000 T 0000
% >0 COMPILE TO LIBRARY. 10031000 T 0000
% =0 COMPILE AND RUN. 10032000 T 0000
% <0 COMPILE FOR SYNTAX. 10033000 T 0000
CARDCNT; % @R+23: NUMBER OF CARDS READ. 10034000 T 0000
FILE CARD "SOURCE" (2,10,150); % SOURCE CODE INPUT FILE 10035000 T 0000
FILE LINES 1 (2,17); % PRINT FILE. 10036000 T 0003
FILE PASCALGOL DISK SERIAL [20:600] (2,10,150,SAVE 0); % CODE FILE 10037000 T 0007
DEFINE LINESPERPAGE=58#, 10038000 T 0013
MAXINT=549755813887#; 10039000 T 0013
10040000 T 0013
%*** COMPILER CONSTANTS *** 10041000 T 0013
DEFINE MAXTABLES =50#, %MAX NUMBER OF NAME TABLES. 10042000 T 0013
MAXNAMES =997#, %MAX NAMES IN EACH TABLE. 10043000 T 0013
MAXLEVEL =15#, %MAX DEPTH OF PROCEDURE DECLARATIONS. 10044000 T 0013
MAXCASES =211#, %MAX LABELS IN A CASE-STATEMENT. 10045000 T 0013
MAXLABS =100#, %MAX NUMBER OF LABELS. 10046000 T 0013
MAXPARAMS =200#, %MAX NUMBER OF PARAMETERS IN WHOLE PROGRAM. 10047000 T 0013
MAXTYPES =1022#, %MAX NUMBER OF DIFFERENT TYPES. 10048000 T 0013
MAXCONSTS =200#, %SIZE OF CONSTANT TABLE. 10049000 T 0013
MAXTEMPS =5#, %NUMBER OF EXTRA VARS IN EACH PROCEDURE. 10050000 T 0013
MAXWITHSYMS=250#, %MAX NUMBER OF SYMBOLS USED BY WITH-STATMS. 10051000 T 0013
MAXSYMS =800#, %MAX NUMBER OF SYMBOLS IN ONE EXPRESSION. 10052000 T 0013
LISTLENGTH =800#, %MAX LENGTH OF VAR AND PARAM LISTS. 10053000 T 0013
MAXEXTFILES=20#, %MAX NUMBER OF EXTERNAL FILES. 10054000 T 0013
MAXFILES =20#, %MAX NUMBER OF FILES DECLARED AT ONE TIME. 10055000 T 0013
MAXPNTRS =50#; %MAX NUMBER OF UNDECLARED POINTERS. 10056000 T 0013
10057000 T 0013
%*** NAME TABLES *** 10058000 T 0013
ARRAY NAMETAB1,NAMETAB2,NAMETAB3[0:MAXTABLES,0:MAXNAMES]; 10059000 T 0013
DEFINE NAMELENGTH =[41:6]#, 10060000 T 0015
TYPE =[9:10]#, 10061000 T 0015
IDCLASS =[12:3]#, 10062000 T 0015
VAR =0#, 10063000 T 0015
CONST=1#, 10064000 T 0015
FUNC =2#, 10065000 T 0015
PROC =3#, 10066000 T 0015
TYPES=4#, 10067000 T 0015
INFO =[23:11]#, 10068000 T 0015
FORMAL =[24:1]#, 10069000 T 0015
FORWARDDEF =[25:1]#, 10070000 T 0015
EXTERNALFILE=[26:1]#; 10071000 T 0015
10072000 T 0015
%*** DISPLAY VECTOR *** 10073000 T 0015
ARRAY DISPLAY[0:MAXLEVEL]; 10074000 T 0015
DEFINE RECTYPE =[9:10]#, 10075000 T 0017
FIRSTWITHSYM =[19:10]#, 10076000 T 0017
LASTWITHSYM =[29:10]#, 10077000 T 0017
NUMPNTRSINWITH=[35:6]#, 10078000 T 0017
BRACKETSINWITH=[36:1]#, 10079000 T 0017
NAMETAB =[46:7]#; 10080000 T 0017
10081000 T 0017
%*** TYPE TABLES *** 10082000 T 0017
ARRAY TYPETAB1,TYPETAB2,TYPETAB3[0:MAXTYPES]; 10083000 T 0017
DEFINE FORM =[3:4]#, 10084000 T 0019
NUMERIC =0#, 10085000 T 0019
SYMBOLIC=1#, 10086000 T 0019
SUBTYPE =2#, 10087000 T 0019
MAINTYPE=[33:10]#, 10088000 T 0019
CHAR =3#, 10089000 T 0019
FLOATING=4#, 10090000 T 0019
ALFA =5#, 10091000 T 0019
SET =6#, 10092000 T 0019
SETTYPE =[33:10]#, 10093000 T 0019
POINTERS=7#, 10094000 T 0019
POINTTYPE=[33:10]#, 10095000 T 0019
ARRAYS =8#, 10096000 T 0019
INXTYPE =[33:10]#, 10097000 T 0019
ARRTYPE =[43:10]#, 10098000 T 0019
RECORD =9#, 10099000 T 0019
RECTAB =[33:10]#, 10100000 T 0019
FILES =10#, 10101000 T 0019
FILETYPE=[33:10]#, 10102000 T 0019
TEXTFILE=11#, 10103000 T 0019
SIZE =[15:12]#, 10104000 T 0019
STRUCT=[23:8]#; 10105000 T 0019
INTEGER NUMTYPES; 10106000 T 0019
10107000 T 0019
%*** PARAMETER TABLE *** 10108000 T 0019
ARRAY PARAMTAB[0:MAXPARAMS]; 10109000 T 0019
DEFINE PARAMNAME =[9:10]#, 10110000 T 0021
PARAMKIND =[13:4]#, 10111000 T 0021
PARAMLEVEL=[23:10]#, 10112000 T 0021
PARAMTYPE =[33:10]#, 10113000 T 0021
PARAMFILE =[34:1]#; 10114000 T 0021
INTEGER NUMPARAMS; 10115000 T 0021
10116000 T 0021
%*** CONSTANT TABLE *** 10117000 T 0021
ARRAY CONSTTAB[0:MAXCONSTS]; 10118000 T 0021
INTEGER NUMCONSTS; 10119000 T 0023
10120000 T 0023
%*** LABEL TABLE *** 10121000 T 0023
ARRAY LABTAB[0:MAXLABS]; 10122000 T 0023
DEFINE LABVAL=[14:15]#, 10123000 T 0025
LABDEF=[15:1]#; 10124000 T 0025
INTEGER NUMLABS,FIRSTLAB; 10125000 T 0025
10126000 T 0025
%*** TABLES FOR I/O AND CHARACTER HANDLING *** 10127000 T 0025
ARRAY CH[0:0], TEXT[0:1], STRING[0:11]; 10128000 T 0025
POINTER CHARPNT,TEXTPNT,TEXTPNT0,STRINGPNT; 10129000 T 0030
ARRAY ICARD[0:9], LINE[0:16], XLINE[0:10], ALGOLCARD[0:9]; 10130000 T 0030
POINTER CARDPNT,LINEPNT,XLINEPNT,ALGOLPNT; 10131000 T 0037
INTEGER CHARCNT,ALGOLCNT,MARGINCNT; 10132000 T 0037
ARRAY HEADTEXT[0:10], ERRLINE[0:16]; 10133000 T 0037
INTEGER LINECNT,PAGECNT,ERRINX; 10134000 T 0040
10135000 T 0040
%*** XREF FILE AND TABLE *** 10136000 T 0040
FILE XREFFILE DISK SERIAL [20:3000] (2,3,150); 10137000 T 0040
ARRAY BLOCKTAB[0:MAXTABLES], XREFLINE[0:16]; 10138000 T 0044
INTEGER NUMXREF,NUMBLOCKS; POINTER XREFPNT; 10139000 T 0047
% 10140000 T 0047
%*** OTHER TABLES *** 10141000 T 0047
INTEGER ARRAY VARLIST[0:LISTLENGTH]; % TEMPORARY LIST OF VARIABLES. 10142000 T 0047
INTEGER VARINDEX,FIRSTVAR; 10143000 T 0049
ARRAY SYMTAB[0:MAXSYMS]; % USED BY "EXPRESSION". 10144000 T 0049
INTEGER NUMSYMS; 10145000 T 0051
ARRAY WITHTAB[0:MAXWITHSYMS]; % USED BY "WITHSTAT". 10146000 T 0051
INTEGER NWITHSYMS; 10147000 T 0053
INTEGER ARRAY SYMBOL[0:64]; % USED BY "INSYMBOL". 10148000 T 0053
INTEGER ARRAY SYMKIND[0:61]; % USED IN ERROR RECOVERY. 10149000 T 0054
ARRAY PNTRTAB1,PNTRTAB2,PNTRTAB3[0:MAXPNTRS];% USED FOR FORWARD POINTERS 10150000 T 0056
INTEGER NUMPNTRS; 10151000 T 0058
ARRAY EXTFILETAB[0:MAXEXTFILES]; % EXTERNAL FILES. 10152000 T 0058
INTEGER NUMEXTFILES; 10153000 T 0060
ARRAY FILETAB[0:MAXFILES]; % FILES IN USE. 10154000 T 0060
INTEGER NUMFILES; 10155000 T 0062
BOOLEAN ARRAY ERR[0:119]; % RECORDS ERROR MESSAGES. 10156000 T 0062
10157000 T 0064
%*** COMPILE TIME OPTIONS *** 10158000 T 0064
BOOLEAN LISTOPTION,RESWORDOPTION,CHECKOPTION,DUMPOPTION,XREFOPTION; 10159000 T 0064
INTEGER CARDLENGTH; 10160000 T 0064
10161000 T 0064
%*** INTRINSIC TYPES *** 10162000 T 0064
INTEGER INTTYPE,REALTYPE,ALFATYPE,CHARTYPE,BOOLTYPE,NILTYPE,TEXTTYPE, 10163000 T 0064
INPUTFILE,OUTPUTFILE,EMPTYSET; 10164000 T 0064
BOOLEAN INPUTDECL,OUTPUTDECL; 10165000 T 0064
10166000 T 0064
%*** TEMPORARY VARIABLES *** 10167000 T 0064
INTEGER T1,T2,T3,T4,T5; 10168000 T 0064
10169000 T 0064
%*** OTHER VARIABLES *** 10170000 T 0064
ALPHA USER; % THE USER NUMBER FOUND ON THE USER CARD. 10171000 T 0064
10172000 T 0064
INTEGER CURLEVEL, % CURRENT PROCEDURE LEVEL. 10173000 T 0064
TOPLEVEL, % TOP LEVEL IN DISPLAY VECTOR. 10174000 T 0064
NUMBEGINS, % NUMBER OF "BEGIN"S IN THE PROGRAM. 10175000 T 0064
NUMCASES, % NUMBER OF CASE-STATEMENTS IN PROGRAM. 10176000 T 0064
NUMREPS, % NUMBER OF REPEAT-STATEMENTS IN PROGRAM. 10177000 T 0064
NUMTEMPS, % NUMBER OF TEMPORARY VARIABLES IN USE. 10178000 T 0064
CURFUNC, % INDEX OF FUNCTION CURRENTLY COMPILED. 10179000 T 0064
CURSY, % LAST SYMBOL READ BY SCANNER. 10180000 T 0064
CURTYPE, % TYPE OF ENTITY LAST COMPILED. 10181000 T 0064
CURMODE, % CURRENT EXPRESSION MODE. 10182000 T 0064
LASTREC; % LAST RECORD TABLE DEFINED. 10183000 T 0064
10184000 T 0064
LABEL ENDOFINPUT; 10185000 T 0064
10186000 T 0064
FORMAT NOERRORS ("NO ERRORS DETECTED."), 10187000 T 0064
START OF SEGMENT ********** 3
ERRORS (I5," ERRORS DETECTED"/), 10188000 T 0064
ALIST ("$ SET LIST SINGLE"), 10189000 T 0064
NOALIST ("$ RESET LIST"), 10190000 T 0064
LASTLINE ("; TERMINATE: END OF PASCAL PROGRAM."), 10191000 T 0064
TERMMESS ("**** END-OF-INPUT. COMPILATION TERMINATED."); 10192000 T 0064
3 IS 46 LONG, NEXT SEG 2
MONITOR EXPOVR:=REALOVERFLOW; 10193000 T 0064
10194000 T 0066
%*** SCANNER SYMBOLS *** 10195000 T 0066
DEFINE IDENTIFIER=1#, INTCONST=2#, REALCONST=3#, ALFACONST=4#, 10196000 T 0066
CHARCONST=5#, NOTSY=6#, ASTERISK=7#, SLASH=8#, 10197000 T 0066
ANDSY=9#, DIVSY=10#, MODSY=11#, PLUS=12#, 10198000 T 0066
MINUS=13#, ORSY=14#, LSSSY=15#, LEQSY=16#, 10199000 T 0066
GEQSY=17#, GTRSY=18#, NEQSY=19#, EQLSY=20#, 10200000 T 0066
INSY=21#, LPAR=22#, RPAR=23#, LBRACKET=24#, 10201000 T 0066
RBRACKET=25#, DOUBLEDOT=26#, COMMA=27#, SEMICOLON=28#, 10202000 T 0066
DOT=29#, ARROW=30#, COLON=31#, ASSIGNSY=32#, 10203000 T 0066
BEGINSY=33#, ENDSY=34#, IFSY=35#, THENSY=36#, 10204000 T 0066
ELSESY=37#, CASESY=38#, OFSY=39#, REPEATSY=40#, 10205000 T 0066
UNTILSY=41#, WHILESY=42#, DOSY=43#, FORSY=44#, 10206000 T 0066
TOSY=45#, DOWNTOSY=46#, GOTOSY=47#, NILSY=48#, 10207000 T 0066
TYPESY=49#, ARRAYSY=50#, RECORDSY=51#, FILESY=52#, 10208000 T 0066
SETSY=53#, CONSTSY=54#, VARSY=55#, LABELSY=56#, 10209000 T 0066
FUNCSY=57#, PROCSY=58#, WITHSY=59#, PROGRAMSY=60#, 10210000 T 0066
PACKEDSY=61#; 10211000 T 0066
10212000 T 0066
DEFINE INITIAL=0#, MIDDLE=1#, TERMINAL=2#; 10213000 T 0066
DEFINE NUMBER=0#, BITPATTERN=1#; 10214000 T 0066
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20001000 T 0066
% % 20002000 T 0066
% % 20003000 T 0066
% % 20004000 T 0066
% PART 2: COMPILER UTILITY ROUTINES. % 20005000 T 0066
% -------------------------- % 20006000 T 0066
% % 20007000 T 0066
% % 20008000 T 0066
% % 20009000 T 0066
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20010000 T 0066
20011000 T 0066
20012000 T 0066
PROCEDURE INSYMBOL; FORWARD; 20013000 T 0066
PROCEDURE WRITEALGOL; FORWARD; 20014000 T 0069
PROCEDURE NEWXREF(NAME1,NAME2,TABLE,DECL); 20015000 T 0069
VALUE NAME1, NAME2, TABLE, DECL; 20016000 T 0069
REAL NAME1, NAME2; 20017000 T 0069
INTEGER TABLE; 20018000 T 0069
BOOLEAN DECL; 20019000 T 0069
FORWARD; 20020000 T 0069
20021000 T 0069
DEFINE NDIGITS(N)= 20022000 T 0069
IF N{ 9 THEN 1 ELSE 20023000 T 0069
IF N{99 THEN 2 ELSE 3 DIGITS#; 20024000 T 0069
20025000 T 0069
DEFINE HEADING= 20026000 T 0069
BEGIN COMMENT *** PRINTS A HEADING ON TOP OF A NEW PAGE. ; 20027000 T 0069
PAGECNT:=PAGECNT+1; 20028000 T 0069
REPLACE POINTER(HEADTEXT[*])+85 BY PAGECNT FOR NDIGITS(PAGECNT); 20029000 T 0069
WRITE(LINES[PAGE]); 20030000 T 0069
WRITE(LINES[DBL],11,HEADTEXT[*]); 20031000 T 0069
LINECNT:=2; 20032000 T 0069
END OF HEADING#; 20033000 T 0069
20034000 T 0069
20035000 T 0069
DEFINE PRINTLINE= %*** PRINTS A SOURCE CODE LINE. 20036000 T 0069
BEGIN 20037000 T 0069
REPLACE LINEPNT-8 BY CARDCNT FOR 5 DIGITS; 20038000 T 0069
IF LINECNT}LINESPERPAGE THEN HEADING; 20039000 T 0069
IF RESWORDOPTION THEN 20040000 T 0069
BEGIN 20041000 T 0069
WRITE(LINES[NO],11,XLINE[*]); 20042000 T 0069
WRITE(LINES[NO],11,XLINE[*]); 20043000 T 0069
END; 20044000 T 0069
WRITE(LINES,17,LINE[*]); 20045000 T 0069
LINECNT:=LINECNT+1; 20046000 T 0069
END OF PRINTLINE#; 20047000 T 0069
20048000 T 0069
20049000 T 0069
DEFINE NEWCARD= %*** READS A NEW SOURCE CODE CARD. 20050000 T 0069
BEGIN 20051000 T 0069
IF LISTOPTION THEN PRINTLINE; 20052000 T 0069
IF ERRINX>0 THEN PRINTERRORS; 20053000 T 0069
READ(CARD,10,ICARD[*]) [ENDOFINPUT]; 20054000 T 0069
CARDPNT:=POINTER(ICARD[*]); 20055000 T 0069
REPLACE LINEPNT BY CARDPNT FOR 10 WORDS, " " FOR 6 WORDS; 20056000 T 0069
REPLACE XLINEPNT BY " " FOR 10 WORDS; 20057000 T 0069
CHARCNT:=CARDLENGTH; 20058000 T 0069
MARGINCNT:=85; 20059000 T 0069
CARDCNT:=CARDCNT+1; 20060000 T 0069
END#; 20061000 T 0069
20062000 T 0069
20063000 T 0069
DEFINE GEN(T,N,START)= %*** GENERATE A TEXT "T", CONSISTING OF 20064000 T 0069
BEGIN %*** "N" LETTERS, STARTING AT "START". 20065000 T 0069
IF ALGOLCNT<N THEN WRITEALGOL; 20066000 T 0069
TEXT[0]:=T; 20067000 T 0069
REPLACE ALGOLPNT:ALGOLPNT BY TEXTPNT0+START FOR N; 20068000 T 0069
ALGOLCNT:=ALGOLCNT-N; 20069000 T 0069
END#; 20070000 T 0069
20071000 T 0069
20072000 T 0069
DEFINE GENID(L,NUM,NDIG)= %*** GENERATE AN XALGOL IDENTIFIER. 20073000 T 0069
BEGIN 20074000 T 0069
IF ALGOLCNT{NDIG THEN WRITEALGOL; 20075000 T 0069
CH[0]:=L; 20076000 T 0069
REPLACE ALGOLPNT:ALGOLPNT BY CHARPNT FOR 1, NUM FOR NDIG DIGITS; 20077000 T 0069
ALGOLCNT:=ALGOLCNT-NDIG-1; 20078000 T 0069
END#; 20079000 T 0069
20080000 T 0069
20081000 T 0069
INTEGER NABS,NSIZE; 20082000 T 0069
20083000 T 0069
DEFINE GENINT(N)= 20084000 T 0069
BEGIN 20085000 T 0069
NABS:=ABS(N); IF N<0 THEN GEN("-",1,7); 20086000 T 0069
NSIZE:=IF NABS{ 9 THEN 1 ELSE 20087000 T 0069
IF NABS{ 999 THEN 3 ELSE 20088000 T 0069
IF NABS{ 99999 THEN 5 ELSE 20089000 T 0069
IF NABS{99999999 THEN 8 ELSE 12; 20090000 T 0069
IF ALGOLCNT<NSIZE THEN WRITEALGOL; 20091000 T 0069
IF NSIZE=12 THEN 20092000 T 0069
REPLACE ALGOLPNT:ALGOLPNT BY (NABS DIV 1000000) FOR 6 DIGITS, 20093000 T 0069
ENTIER(NABS MOD 1000000) FOR 6 DIGITS ELSE 20094000 T 0069
REPLACE ALGOLPNT:ALGOLPNT BY NABS FOR NSIZE DIGITS; 20095000 T 0069
ALGOLCNT:=ALGOLCNT-NSIZE; 20096000 T 0069
END OF GENINT#; 20097000 T 0069
20098000 T 0069
20099000 T 0069
PROCEDURE GENREAL(X); 20100000 T 0069
VALUE X; REAL X; 20101000 T 0069
BEGIN 20102000 T 0069
REAL ABSX; 20103000 T 0069
START OF SEGMENT ********** 4
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 0027
IF ABSX> 0 THEN 20117000 T 0028
BEGIN 20118000 T 0029
WHILE ABSX}1@7 DO BEGIN ABSX:=ABSX/10; POWER:=POWER+1; END; 20119000 T 0029
WHILE ABSX<1@6 DO BEGIN ABSX:=ABSX|10; POWER:=POWER-1; END; 20120000 T 0036
V1:=ENTIER(ABSX); 20121000 T 0042
V2:=ENTIER((ABSX-V1)|1000000); 20122000 T 0043
REPLACE ALGOLPNT:ALGOLPNT BY V1 FOR 7 DIGITS, ".", 20123000 T 0046
V2 FOR 6 DIGITS, "@"; 20124000 T 0053
ALGOLCNT:=ALGOLCNT-15; 20125000 T 0059
IF POWER<0 THEN GEN("-",1,7); 20126000 T 0060
POWER:=ABS(POWER); 20127000 T 0071
REPLACE ALGOLPNT:ALGOLPNT BY POWER FOR 2 DIGITS; 20128000 T 0072
ALGOLCNT:=ALGOLCNT-2; 20129000 T 0075
END ELSE GEN("0",1,7); 20130000 T 0076
IF X<0 THEN GEN(")",1,7); 20131000 T 0089
END; 20132000 T 0099
END OF GENREAL; 20133000 T 0099
4 IS 103 LONG, NEXT SEG 2
20134000 T 0069
20135000 T 0069
INTEGER TYPEINDEX; 20136000 T 0069
20137000 T 0069
DEFINE NEWTYPE= 20138000 T 0069
BEGIN 20139000 T 0069
IF NUMTYPES}MAXTYPES THEN BEGIN ERROR(45);NUMTYPES:=MAXTYPES-20 END; 20140000 T 0069
TYPEINDEX:=NUMTYPES:=NUMTYPES+1; 20141000 T 0069
END #; 20142000 T 0069
20143000 T 0069
20144000 T 0069
PROCEDURE WRITEALGOL; %*** WRITES A COMPLETED XALGOL CARD TO 20145000 T 0069
BEGIN %*** THE FILE. 20146000 T 0069
REPLACE POINTER(ALGOLCARD[9]) BY CARDCNT FOR 8 DIGITS; 20147000 T 0069
WRITE(PASCALGOL,10,ALGOLCARD[*]); 20148000 T 0074
IF DUMPOPTION THEN WRITE(LINES,10,ALGOLCARD[*]); 20149000 T 0079
ALGOLPNT:=POINTER(ALGOLCARD[*]); ALGOLCNT:=71; 20150000 T 0084
REPLACE ALGOLPNT BY " " FOR 9 WORDS; 20151000 T 0086
END OF WRITEALGOL; 20152000 T 0089
20153000 T 0090
20154000 T 0090
DEFINE MARGIN(LETTER,NUM)= 20155000 T 0090
BEGIN COMMENT *** PLACES INFORMATION IN THE MARGIN. ; 20156000 T 0090
IF MARGINCNT{118 THEN 20157000 T 0090
BEGIN TEXT[0]:=LETTER; 20158000 T 0090
REPLACE LINEPNT+MARGINCNT BY TEXTPNT+5 FOR 2, 20159000 T 0090
NUM FOR NDIGITS(NUM); 20160000 T 0090
MARGINCNT:=MARGINCNT+6; 20161000 T 0090
END; 20162000 T 0090
END OF MARGIN#; 20163000 T 0090
20164000 T 0090
20165000 T 0090
PROCEDURE SKIP(SYMBOL); %*** SKIP SYMBOLS TO RECOVER FROM ERROR 20166000 T 0090
VALUE SYMBOL; INTEGER SYMBOL; %*** CONDITION. 20167000 T 0090
BEGIN 20168000 T 0090
WHILE CURSY!SYMBOL AND SYMKIND[CURSY]=MIDDLE DO 20169000 T 0090
IF CURSY=RECORDSY THEN 20170000 T 0092
BEGIN DO BEGIN INSYMBOL; 20171000 T 0093
SKIP(99); 20172000 T 0094
END UNTIL CURSY!SEMICOLON AND CURSY!CASESY; 20173000 T 0095
END ELSE INSYMBOL; 20174000 T 0097
END OF SKIP; 20175000 T 0098
20176000 T 0099
20177000 T 0099
PROCEDURE ERROR(ERRNUM); 20178000 T 0099
VALUE ERRNUM; INTEGER ERRNUM; 20179000 T 0099
BEGIN COMMENT *** ARRANGE ERROR INDICATOR. ; 20180000 T 0099
NUMERRS:=NUMERRS+1; 20181000 T 0099
ERR[ERRNUM]:=TRUE; 20182000 T 0100
ERRINX:=MAX(ERRINX,CARDLENGTH-2-CHARCNT); 20183000 T 0101
IF ERRINX{115 THEN 20184000 T 0105
BEGIN REPLACE POINTER(ERRLINE[1])+ERRINX BY "|", 20185000 T 0106
ERRNUM FOR NDIGITS(ERRNUM); 20186000 T 0114
ERRINX:=ERRINX+(IF ERRNUM{ 9 THEN 2 ELSE 20187000 T 0121
IF ERRNUM{99 THEN 3 ELSE 4); 20188000 T 0123
END END OF ERROR; 20189000 T 0126
20190000 T 0126
20191000 T 0126
PROCEDURE PRINTERRORS; 20192000 T 0126
BEGIN COMMENT *** PRINT ERROR INDICATORS. ; 20193000 T 0126
IF NOT LISTOPTION THEN PRINTLINE; 20194000 T 0126
WRITE(LINES,17,ERRLINE[*]); 20195000 T 0170
LINECNT:=LINECNT+1; 20196000 T 0174
REPLACE POINTER(ERRLINE[1]) BY " " FOR 16 WORDS; 20197000 T 0175
ERRINX:=0; 20198000 T 0181
END OF PRINT ERRORS; 20199000 T 0182
20200000 T 0182
20201000 T 0182
DEFINE HASH(N) = (N).[35:36] MOD MAXNAMES#; 20202000 T 0182
20203000 T 0182
INTEGER THISLEVEL,THISTAB,THISINDEX; 20204000 T 0182
ALPHA THISID,TNAME; 20205000 T 0182
BOOLEAN FOUND; 20206000 T 0182
20207000 T 0182
DEFINE SEARCHTAB(TAB)= %*** SEARCH NAME TABLE "TAB" FOR THE 20208000 T 0182
BEGIN %*** IDENTIFIER JUST READ. 20209000 T 0182
THISINDEX:=HASH(CURNAME1); 20210000 T 0182
TNAME:=NAMETAB1[TAB,THISINDEX]; 20211000 T 0182
WHILE (IF TNAME=CURNAME1 THEN NAMETAB2[TAB,THISINDEX]!CURNAME2 20212000 T 0182
ELSE TNAME!0) DO 20213000 T 0182
BEGIN 20214000 T 0182
THISINDEX:=IF THISINDEX=0 THEN MAXNAMES ELSE THISINDEX-1; 20215000 T 0182
TNAME:=NAMETAB1[TAB,THISINDEX]; 20216000 T 0182
END; 20217000 T 0182
FOUND:=TNAME!0; 20218000 T 0182
IF XREFOPTION THEN 20219000 T 0182
IF FOUND THEN NEWXREF(CURNAME1,CURNAME2,TAB,FALSE); % 20220000 T 0182
END OF SEARCHTAB#; 20221000 T 0182
20222000 T 0182
DEFINE SEARCH= %*** SEARCH ALL TABLES CURRENTLY IN USE. 20223000 T 0182
BEGIN 20224000 T 0182
THISLEVEL:=TOPLEVEL+1; 20225000 T 0182
DO BEGIN 20226000 T 0182
THISLEVEL:=THISLEVEL-1; 20227000 T 0182
THISTAB:=IF THISLEVEL{CURLEVEL THEN THISLEVEL 20228000 T 0182
ELSE DISPLAY[THISLEVEL].NAMETAB; 20229000 T 0182
SEARCHTAB(THISTAB); 20230000 T 0182
END UNTIL FOUND OR THISLEVEL=0; 20231000 T 0182
THISID:=NAMETAB3[THISTAB,THISINDEX]; 20232000 T 0182
END OF SEARCH #; 20233000 T 0182
20234000 T 0182
20235000 T 0182
DEFINE NEWNAME(NAME1,NAME2,TAB) = 20236000 T 0182
BEGIN %*** ENTER A NEW NAME INTO THE NAME TABLE "TAB". 20237000 T 0182
THISINDEX:=HASH(NAME1); 20238000 T 0182
TNAME:=NAMETAB1[TAB,THISINDEX]; 20239000 T 0182
WHILE(IF TNAME=NAME1 THEN NAMETAB2[TAB,THISINDEX]!NAME2 20240000 T 0182
ELSE TNAME!0) DO 20241000 T 0182
BEGIN 20242000 T 0182
THISINDEX:=IF THISINDEX=0 THEN MAXNAMES ELSE THISINDEX-1; 20243000 T 0182
TNAME:=NAMETAB1[TAB,THISINDEX]; 20244000 T 0182
END; 20245000 T 0182
IF TNAME!0 THEN ERROR(2); 20246000 T 0182
NAMETAB1[TAB,THISINDEX]:=NAME1; 20247000 T 0182
NAMETAB2[TAB,THISINDEX]:=NAME2; 20248000 T 0182
IF XREFOPTION THEN NEWXREF(NAME1,NAME2,TAB,TRUE); 20249000 T 0182
END OF NEWNAME #; 20250000 T 0182
20251000 T 0182
20300000 T 0182
PROCEDURE INITIALIZE; %*** INITIALIZATION *** 20301000 T 0182
BEGIN %********************** 20302000 T 0182
INTEGER T1,T3; 20303000 T 0182
START OF SEGMENT ********** 5
ALPHA A; 20304000 T 0000
FILL SYMKIND[*] WITH 20305000 R 0000
MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE, 20305100 R 0000
START OF SEGMENT ********** 6
MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE, 20305200 R 0001
MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE,MIDDLE, 20305300 R 0001
MIDDLE,MIDDLE,MIDDLE,MIDDLE, 20305400 R 0001
TERMINAL,MIDDLE,MIDDLE,MIDDLE,MIDDLE,INITIAL,TERMINAL, 20305500 R 0001
INITIAL,MIDDLE,TERMINAL,INITIAL,MIDDLE,INITIAL,TERMINAL,INITIAL, 20306000 T 0001
MIDDLE,INITIAL,MIDDLE,MIDDLE,INITIAL,MIDDLE,INITIAL, 20307000 R 0001
MIDDLE,MIDDLE,MIDDLE,MIDDLE, 20307100 R 0001
INITIAL,INITIAL,INITIAL,INITIAL,INITIAL,INITIAL,INITIAL,MIDDLE; 20308000 R 0001
6 IS 62 LONG, NEXT SEG 5
20309000 T 0001
FILL SYMBOL[*] WITH 0,0,0,0,0,0,0,0,0,0,0, 20310000 R 0001
START OF SEGMENT ********** 7
ARROW,0,COLON,GTRSY,GEQSY,PLUS,0,0,0,0,0,0,0,0,0, 20310100 R 0003
DOT,LBRACKET,ANDSY,LPAR,LSSSY,ARROW, 20311000 R 0003
0,0,0,0,0,0,0,0,0,0,0,ASTERISK,MINUS, 20311100 R 0003
RPAR,SEMICOLON,LEQSY,0,SLASH, 20312000 R 0003
0,0,0,0,0,0,0,0,COMMA,0,NEQSY,EQLSY,RBRACKET,0,DOUBLEDOT; 20313000 R 0003
7 IS 65 LONG, NEXT SEG 5
20314000 T 0003
LINEPNT :=POINTER(LINE[1]); 20315000 T 0003
XLINEPNT:=POINTER(XLINE[1]); 20316000 T 0006
REPLACE LINEPNT-8 BY " => ", " " FOR 16 WORDS; 20317000 T 0009
REPLACE XLINEPNT-8 BY " " FOR 11 WORDS; 20318000 T 0018
REPLACE POINTER(ERRLINE[*]) BY "**** ", " " FOR 16 WORDS; 20319000 T 0023
ALGOLPNT:=POINTER(ALGOLCARD[*]); ALGOLCNT:=71; 20320000 T 0032
REPLACE ALGOLPNT BY " " FOR 9 WORDS; 20321000 T 0034
CHARPNT:=POINTER(CH[*])+7; 20322000 T 0038
TEXTPNT:=POINTER(TEXT[*])+1; TEXTPNT0:=TEXTPNT-1; 20323000 T 0041
REPLACE TEXTPNT BY " " FOR 15; 20324000 T 0047
STRINGPNT:=POINTER(STRING[*]); 20325000 T 0051
REPLACE POINTER(HEADTEXT[*]) BY " " FOR 10 WORDS, "PAGE "; 20326000 T 0052
REPLACE POINTER(HEADTEXT[*]) BY "PASCAL(", EDITION, ")/B-5700"; 20327000 T 0061
TEXT[0]:=TIME(5); 20328000 T 0072
REPLACE POINTER(HEADTEXT[*])+45 BY TEXTPNT+3 FOR 2, "/", 20329000 T 0073
TEXTPNT+1 FOR 2, "/", TEXTPNT+5 FOR 2; 20330000 T 0084
T1:=TIME(1)/3600; 20331000 T 0095
REPLACE POINTER(HEADTEXT[*])+57 BY (T1 DIV 60) FOR 2 DIGITS, ":", 20332000 T 0097
ENTIER(T1 MOD 60) FOR 2 DIGITS; 20333000 T 0107
HEADING; 20334000 T 0111
20335000 T 0132
%*** INITIALIZE INTRINSIC TYPES, CONSTANTS ETC. *** 20336000 T 0132
20337000 T 0132
INTTYPE:=T3:=1; %*** "INTEGER" *** 20338000 T 0132
T1:=NUMERIC; T1.SIZE:=1; T1.STRUCT:=0; 20339000 T 0133
TYPETAB1[1]:=T1; TYPETAB2[1]:=-MAXINT; TYPETAB3[1]:=MAXINT; 20340000 T 0137
NEWNAME("7INTEGE","R",0); T3.IDCLASS:=TYPES; 20341000 T 0141
NAMETAB3[0,THISINDEX]:=T3; 20342000 T 0172
REALTYPE:=T3:=2; %*** "REAL" *** 20343000 T 0174
T1.FORM:=FLOATING; TYPETAB1[2]:=T1; 20344000 T 0175
NEWNAME("400REAL",0,0); T3.IDCLASS:=TYPES; 20345000 T 0178
NAMETAB3[0,THISINDEX]:=T3; 20346000 T 0204
ALFATYPE:=T3:=3; %*** "ALFA" *** 20347000 T 0206
T1.FORM:=ALFA; TYPETAB1[3]:=T1; 20348000 T 0207
NEWNAME("400ALFA",0,0); T3.IDCLASS:=TYPES; 20349000 T 0210
NAMETAB3[0,THISINDEX]:=T3; 20350000 T 0236
BOOLTYPE:=T3:=4; %*** "BOOLEAN" *** 20351000 T 0238
T1.FORM:=SYMBOLIC; TYPETAB1[4]:=T1; TYPETAB3[4]:=1; 20352000 T 0239
NEWNAME("7BOOLEA","N",0); T3.IDCLASS:=TYPES; 20353000 T 0243
NAMETAB3[0,THISINDEX]:=T3; 20354000 T 0270
CHARTYPE:=T3:=5; %*** "CHAR" *** 20355000 T 0272
T1.FORM:=CHAR; TYPETAB1[5]:=T1; TYPETAB3[5]:=63; 20356000 T 0273
NEWNAME("400CHAR",0,0); T3.IDCLASS:=TYPES; 20357000 T 0277
NAMETAB3[0,THISINDEX]:=T3; 20358000 T 0304
T3:=BOOLTYPE; T3.IDCLASS:=CONST; %*** "FALSE" *** 20359000 T 0306
NEWNAME("50FALSE",0,0); NAMETAB3[0,THISINDEX]:=T3; 20360000 T 0308
T3.INFO:=1; %*** "TRUE" *** 20361000 T 0335
NEWNAME("400TRUE",0,0); NAMETAB3[0,THISINDEX]:=T3; 20362000 T 0337
NUMTYPES:=5; 20363000 T 0363
NILTYPE:=-1; %*** TYPE OF "NIL" *** 20364000 T 0364
EMPTYSET:=-2; %*** TYPE OF [] *** 20365000 T 0365
NEWNAME("6MAXINT",0,0); T3:=INTTYPE; %*** "MAXINT" *** 20366000 T 0366
T3.IDCLASS:=CONST; T3.INFO:=1024; 20367000 T 0391
NAMETAB3[0,THISINDEX]:=T3; 20368000 T 0394
NUMCONSTS:=1; CONSTTAB[1]:=MAXINT; 20369000 T 0396
20370000 T 0398
T3:=0; T3.IDCLASS:=PROC; %*** PROCEDURES *** 20371000 T 0398
FOR A:="3000GET", "3000NEW", "400PACK", "400PAGE", "3000PUT", 20372000 T 0401
"400READ", "6READLN", "50RESET", "6UNPACK", "50WRITE" DO 20373000 T 0411
BEGIN 20374000 T 0421
NEWNAME(A,0,0); NAMETAB3[0,THISINDEX]:=T3; 20375000 T 0421
END; 20376000 T 0459
NEWNAME("7DISPOS","E",0); NAMETAB3[0,THISINDEX]:=T3; 20377000 T 0459
NEWNAME("7REWRIT","E",0); NAMETAB3[0,THISINDEX]:=T3; 20378000 T 0485
NEWNAME("7WRITEL","N",0); NAMETAB3[0,THISINDEX]:=T3; 20379000 T 0511
20380000 T 0537
T3.IDCLASS:=FUNC; %*** FUNCTIONS *** 20381000 T 0537
FOR A:="3000ABS", "6ARCTAN", "3000CHR", "3000COS", "3000EOF", 20382000 T 0539
"400EOLN", "3000EXP", "20000LN", "3000ODD", "400PRED", 20383000 T 0549
"400SUCC", "50ROUND", "3000SIN", "3000SQR", "400SQRT", 20384000 T 0559
"50TRUNC", "6CONCAT", "400TIME", "400DATE", "6IOTIME", 20385000 T 0569
"400USER", "3000ORD" 20386000 T 0579
DO BEGIN 20387000 T 0582
NEWNAME(A,0,0); NAMETAB3[0,THISINDEX]:=T3; 20388000 T 0583
END; 20389000 T 0631
NEWNAME("7ELAPSE","D",0); NAMETAB3[0,THISINDEX]:=T3; 20390000 T 0631
NEWNAME("7WEEKDA","Y",0); NAMETAB3[0,THISINDEX]:=T3; 20391000 T 0657
20392000 T 0683
TEXTTYPE:=T3:=NUMTYPES:=NUMTYPES+1; %*** "TEXT" *** 20393000 T 0683
T1 := TEXTFILE; T1.STRUCT := 1; TYPETAB1[TEXTTYPE] := T1; % 20394000 T 0685
T3.IDCLASS := TYPES; % 20395000 T 0689
NEWNAME("400TEXT",0,0); NAMETAB3[0,THISINDEX]:=T3; 20396000 T 0691
T3:=TEXTTYPE; T3.IDCLASS:=VAR; %*** "INPUT" *** 20397000 T 0717
T3.EXTERNALFILE:=1; 20398000 T 0719
NEWNAME("50INPUT",0,0); INPUTFILE:=THISINDEX; 20399000 T 0721
NAMETAB3[0,THISINDEX]:=T3; 20400000 T 0747
NEWNAME("6OUTPUT",0,0); %*** "OUTPUT" *** 20401000 T 0749
NAMETAB3[0,THISINDEX]:=T3; OUTPUTFILE:=THISINDEX; 20402000 T 0773
END OF INTIALIZED; 20403000 T 0776
5 IS 781 LONG, NEXT SEG 2
20404000 T 0182
20500000 T 0182
20501000 T 0182
%*** XREF ROUTINES *** 20502000 T 0182
%********************** 20503000 T 0182
20504000 T 0182
DEFINE XREFCARD=[16:17]#, 20505000 T 0182
XREFBLOCK=[26:10]#; 20506000 T 0182
REAL A0,B0,A1,B1,LASTA0,LASTA1; 20507000 T 0182
INTEGER NL,LASTBLOCK,A2,AX; 20508000 T 0182
20509000 T 0182
PROCEDURE NEWXREF(NAME1,NAME2,TABLE,DECL); 20510000 T 0182
VALUE NAME1,NAME2,TABLE,DECL; 20511000 T 0182
REAL NAME1,NAME2; 20512000 T 0182
INTEGER TABLE; 20513000 T 0182
BOOLEAN DECL; 20514000 T 0182
BEGIN 20515000 T 0182
NL:=NAME1.NAMELENGTH; 20516000 T 0182
IF NL<7 THEN NAME1:=0&NAME1[41:41:6]&NAME1[35:6|NL-1:6|NL] 20517000 T 0184
ELSE NAME2:=0&NAME2[35:6|(NL-6)-1:6|(NL-6)]; 20518000 T 0191
AX:=CARDCNT; AX.XREFBLOCK:=BLOCKTAB[TABLE]; 20519000 T 0198
IF DECL THEN AX:=AX-100000000000; 20520000 T 0200
WRITE(XREFFILE,*,NAME1,NAME2,AX); 20521000 T 0202
END OF NEWXREF; 20522000 T 0214
20523000 T 0214
PROCEDURE XREFMAX(A); 20524000 T 0214
ARRAY A[0]; 20525000 T 0214
BEGIN 20526000 T 0214
A[0]:="AZZZZZZ"; A[1]:="ZZZZZZ"; A[2]:=9999999999; 20527000 T 0214
END OF XREFMAX; 20528000 T 0218
20529000 T 0222
20530000 T 0222
BOOLEAN PROCEDURE XREFCOMPARE(A,B); 20531000 T 0222
ARRAY A,B[0]; 20532000 T 0222
BEGIN 20533000 T 0222
A0:=A[0]; B0:=B[0]; A1:=A[1]; B1:=B[1]; 20534000 T 0222
XREFCOMPARE:= 20535000 T 0226
IF A0.[35:36]!B0.[35:36] THEN A0.[35:36]<B0.[35:36] ELSE 20536000 T 0226
IF A1!B1 THEN A1<B1 ELSE 20537000 T 0230
IF A0!B0 THEN A0.NAMELENGTH<B0.NAMELENGTH ELSE 20538000 T 0233
A[2] LEQ B[2]; 20539000 T 0236
END OF XREFCOMPARE; 20540000 T 0238
20541000 T 0241
20542000 T 0241
PROCEDURE PRINTXREF(FINIS,A); 20543000 T 0241
VALUE FINIS; BOOLEAN FINIS; 20544000 T 0241
ARRAY A[0]; 20545000 T 0241
BEGIN 20546000 T 0241
IF FINIS THEN 20547000 T 0241
BEGIN 20548000 T 0241
WRITE(LINES,17,XREFLINE[*]); 20549000 T 0241
CLOSE(LINES); 20550000 T 0246
CLOSE(XREFFILE); 20551000 T 0247
END 20552000 T 0249
ELSE 20553000 T 0249
BEGIN 20554000 T 0249
A0:=A[0]; A1:=A[1]; A2:=A[2]; 20555000 T 0250
IF A0=LASTA0 AND A1=LASTA1 AND A2.XREFBLOCK=LASTBLOCK THEN 20556000 T 0253
BEGIN 20557000 T 0256
IF NUMXREF=15 THEN 20558000 T 0256
BEGIN 20559000 T 0257
WRITE(LINES,17,XREFLINE[*]); LINECNT:=LINECNT+1; 20560000 T 0258
IF LINECNT>LINESPERPAGE THEN HEADING; 20561000 T 0263
XREFPNT:=POINTER(XREFLINE[*]); NUMXREF:=0; 20562000 T 0285
REPLACE XREFPNT BY " " FOR 17 WORDS; XREFPNT:=XREFPNT+24; 20563000 T 0287
END; 20564000 T 0293
REPLACE XREFPNT BY A2.XREFCARD FOR 5 DIGITS; 20565000 T 0293
XREFPNT:=XREFPNT+7; NUMXREF:=NUMXREF+1; 20566000 T 0297
END ELSE 20567000 T 0301
IF A2<0 THEN 20568000 T 0301
BEGIN 20569000 T 0303
A2:=A2+100000000000; 20570000 T 0303
WRITE(LINES,17,XREFLINE[*]); LINECNT:=LINECNT+1; 20571000 T 0304
IF LINECNT>LINESPERPAGE THEN HEADING; 20572000 T 0310
XREFPNT:=POINTER(XREFLINE[*]); NUMXREF:=0; 20573000 T 0332
REPLACE XREFPNT BY " " FOR 17 WORDS; 20574000 T 0334
TEXT[0]:=A0.[35:36]; LASTA0:=A0; 20575000 T 0337
REPLACE XREFPNT BY TEXTPNT+1 FOR A0.NAMELENGTH; 20576000 T 0340
TEXT[0]:=LASTA1:=A1; 20577000 T 0345
IF A0.NAMELENGTH>6 THEN 20578000 T 0347
REPLACE XREFPNT+6 BY TEXTPNT+1 FOR A0.NAMELENGTH-6; 20579000 T 0348
REPLACE XREFPNT+17 BY A2.XREFCARD FOR 5 DIGITS; 20580000 T 0356
XREFPNT:=XREFPNT+24; LASTBLOCK:=A2.XREFBLOCK; 20581000 T 0362
END; 20582000 T 0366
END; 20583000 T 0366
END OF PRINTXREF; 20584000 T 0366
20585000 T 0368
20800000 T 0368
20801000 T 0368
INTEGER TT1,TT2,F1,F2,LT,RT; 20802000 T 0368
20803000 T 0368
DEFINE CHECKTYPES(LEFTTYPE,RIGHTTYPE)= 20804000 T 0368
BEGIN 20805000 T 0368
IF LEFTTYPE>0 AND RIGHTTYPE>0 THEN 20806000 T 0368
IF LEFTTYPE!RIGHTTYPE THEN 20807000 T 0368
BEGIN 20808000 T 0368
LT:=LEFTTYPE; RT:=RIGHTTYPE; 20809000 T 0368
TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20810000 T 0368
F1:=TT1.FORM; F2:=TT2.FORM; 20811000 T 0368
IF LT!REALTYPE OR F2!NUMERIC THEN 20812000 T 0368
IF(F1!SET AND LT!EMPTYSET)OR(F2!SET AND RT!EMPTYSET)THEN 20813000 T 0368
IF(F1!POINTERS AND LT!NILTYPE)OR(F2!POINTERS AND RT!NILTYPE)THEN 20814000 T 0368
BEGIN 20815000 T 0368
IF F1=SET AND F2=SET THEN 20816000 T 0368
BEGIN 20817000 T 0368
LT:=TT1.SETTYPE; RT:=TT2.SETTYPE; 20818000 T 0368
TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20819000 T 0368
F1:=TT1.FORM; F2:=TT2.FORM; 20820000 T 0368
END; 20821000 T 0368
IF F1=POINTERS AND F2=POINTERS THEN 20822000 T 0368
BEGIN 20823000 T 0368
LT:=TT1.POINTTYPE; RT:=TT2.POINTTYPE; 20824000 T 0368
TT1:=TYPETAB1[LT]; TT2:=TYPETAB1[RT]; 20825000 T 0368
F1:=TT1.FORM; F2:=TT2.FORM; 20826000 T 0368
END; 20827000 T 0368
WHILE F1=SUBTYPE DO 20828000 T 0368
BEGIN LT:=TT1.MAINTYPE; TT1:=TYPETAB1[LT]; F1:=TT1.FORM END; 20829000 T 0368
WHILE F2=SUBTYPE DO 20830000 T 0368
BEGIN RT:=TT2.MAINTYPE; TT2:=TYPETAB1[RT]; F2:=TT2.FORM END; 20831000 T 0368
IF LT>0 AND RT>0 THEN 20832000 T 0368
IF LT!RT THEN 20833000 T 0368
IF F1!NUMERIC OR F2!NUMERIC THEN 20834000 T 0368
IF F1!CHAR OR F2!CHAR THEN ERROR(17); 20835000 T 0368
END; 20836000 T 0368
END; 20837000 T 0368
END OF CHECKTYPES#; 20838000 T 0368
20839000 T 0368
20840000 T 0368
INTEGER FILENAME; 20841000 T 0368
BOOLEAN LPARFOUND; 20842000 T 0368
20843000 T 0368
DEFINE FILEPARAM(DEFAULTFILE)=%*** CHECKS THE FIRST PARAMETER TO SEE 20844000 T 0368
BEGIN %*** IF IT IS A FILE. 20845000 T 0368
INSYMBOL; FILENAME:=CURTYPE:=0; 20846000 T 0368
LPARFOUND:=CURSY=LPAR; 20847000 T 0368
IF LPARFOUND THEN 20848000 T 0368
BEGIN 20849000 T 0368
INSYMBOL; 20850000 T 0368
IF CURSY=IDENTIFIER THEN 20851000 T 0368
BEGIN 20852000 T 0368
SEARCH; 20853000 T 0368
IF FOUND THEN 20854000 T 0368
BEGIN 20855000 T 0368
IF THISID.IDCLASS=VAR THEN 20856000 T 0368
BEGIN 20857000 T 0368
CURTYPE:=THISID.TYPE; 20858000 T 0368
IF TYPETAB1[CURTYPE].FORM}FILES THEN 20859000 T 0368
BEGIN 20860000 T 0368
FILENAME:=1000|THISLEVEL+THISINDEX; 20861000 T 0368
INSYMBOL; 20862000 T 0368
END END END END; 20863000 T 0368
IF SYMKIND[CURSY]=TERMINAL THEN ERROR(46); 20864000 T 0368
END; 20865000 T 0368
IF FILENAME=0 THEN FILENAME:=DEFAULTFILE; 20866000 T 0368
IF (FILENAME=INPUTFILE AND NOT INPUTDECL) OR 20867000 T 0368
(FILENAME=OUTPUTFILE AND NOT OUTPUTDECL) THEN ERROR(96); 20868000 T 0368
END OF FILEPARAM#; 20869000 T 0368
20870000 T 0368
20871000 T 0368
INTEGER TFORM; 20872000 T 0368
BOOLEAN SIGNED,NEGATIVE; 20873000 T 0368
20874000 T 0368
DEFINE CONSTANT(CVAL,CTYPE)= %*** <CONSTANT> *** 20875000 T 0368
BEGIN %****************** 20876000 T 0368
IF CURSY=MINUS OR CURSY=PLUS THEN 20877000 T 0368
BEGIN SIGNED:=TRUE; NEGATIVE:=CURSY=MINUS; 20878000 T 0368
INSYMBOL; 20879000 T 0368
END ELSE SIGNED:=NEGATIVE:=FALSE; 20880000 T 0368
IF CURSY=INTCONST THEN 20881000 T 0368
BEGIN CTYPE:=INTTYPE; 20882000 T 0368
CVAL:=IF NEGATIVE THEN -CURVAL ELSE CURVAL; 20883000 T 0368
END ELSE 20884000 T 0368
IF CURSY=CHARCONST THEN 20885000 T 0368
BEGIN IF SIGNED THEN ERROR(29); 20886000 T 0368
CTYPE:=CHARTYPE; CVAL:=CURVAL; 20887000 T 0368
END ELSE 20888000 T 0368
IF CURSY=REALCONST THEN 20889000 T 0368
BEGIN CTYPE:=REALTYPE; 20890000 T 0368
CVAL:=IF NEGATIVE THEN -CURVAL ELSE CURVAL; 20891000 T 0368
END ELSE 20892000 T 0368
IF CURSY=ALFACONST THEN 20893000 T 0368
BEGIN IF SIGNED THEN ERROR(29); 20894000 T 0368
IF CURLENGTH>7 THEN ERROR(41); 20895000 T 0368
CTYPE:=ALFATYPE; CVAL:=CURVAL; 20896000 T 0368
END ELSE 20897000 T 0368
IF CURSY=IDENTIFIER THEN 20898000 T 0368
BEGIN 20899000 T 0368
SEARCH; 20900000 T 0368
IF FOUND THEN 20901000 T 0368
BEGIN 20902000 T 0368
IF THISID.IDCLASS=CONST AND NOT BOOLEAN(THISID.FORMAL) THEN 20903000 T 0368
BEGIN 20904000 T 0368
IF TYPETAB1[THISID.TYPE].FORM{ALFA THEN 20905000 T 0368
BEGIN 20906000 T 0368
CVAL:=THISID.INFO; 20907000 T 0368
IF CVAL>1023 THEN CVAL:=CONSTTAB[CVAL-1023]; 20908000 T 0368
CTYPE:=THISID.TYPE; 20909000 T 0368
IF SIGNED THEN 20910000 T 0368
BEGIN 20911000 T 0368
TFORM:=TYPETAB1[THISID.TYPE].FORM; 20912000 T 0368
IF TFORM!NUMERIC AND TFORM!FLOATING THEN ERROR(29) ELSE 20913000 T 0368
IF NEGATIVE THEN CVAL:=-CVAL; 20914000 T 0368
END; 20915000 T 0368
END ELSE BEGIN ERROR(48); CVAL:=CTYPE:=0 END; 20916000 T 0368
END ELSE BEGIN ERROR(32); CVAL:=CTYPE:=0 END; 20917000 T 0368
END ELSE BEGIN ERROR(1); CVAL:=CTYPE:=0 END; 20918000 T 0368
END ELSE BEGIN ERROR(32); CVAL:=CTYPE:=0 END; 20919000 T 0368
INSYMBOL; 20920000 T 0368
END OF CONSTANT#; 20921000 T 0368
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 30001000 T 0368
% % 30002000 T 0368
% % 30003000 T 0368
% % 30004000 T 0368
% PART 3: THE SCANNER. % 30005000 T 0368
% ------------ % 30006000 T 0368
% % 30007000 T 0368
% % 30008000 T 0368
% % 30009000 T 0368
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 30010000 T 0368
30011000 T 0368
% INTERNAL INTERNAL SYMBOL 30012000 T 0368
% SYMBOL NUMBER NAME KIND 30013000 T 0368
% 30014000 T 0368
% IDENTIFIER 1 IDENTIFIER MIDDLE 30015000 T 0368
% 122 2 INTCONST MIDDLE 30016000 T 0368
% 2.5 3 REALCONST MIDDLE 30017000 T 0368
% "ABCD" 4 ALFACONST MIDDLE 30018000 T 0368
% "C" 5 CHARCONST MIDDLE 30019000 T 0368
% NOT 6 NOTSY MIDDLE 30020000 T 0368
% * 7 ASTERISK MIDDLE 30021000 T 0368
% / 8 SLASH MIDDLE 30022000 T 0368
% & AND 9 ANDSY MIDDLE 30023000 T 0368
% DIV 10 DIVSY MIDDLE 30024000 T 0368
% MOD 11 MODSY MIDDLE 30025000 T 0368
% + 12 PLUS MIDDLE 30026000 T 0368
% - 13 MINUS MIDDLE 30027000 T 0368
% OR 14 ORSY MIDDLE 30028000 T 0368
% < LSS 15 LSSSY MIDDLE 30029000 T 0368
% <= LEQ { 16 LEQSY MIDDLE 30030000 T 0368
% >= GEQ } 17 GEQSY MIDDLE 30031000 T 0368
% > GTR 18 GTRSY MIDDLE 30032000 T 0368
% <> NEQ ! 19 NEQSY MIDDLE 30033000 T 0368
% = EQL 30 EQLSY MIDDLE 30034000 T 0368
% IN 21 INSY MIDDLE 30035000 T 0368
% ( 22 LPAR MIDDLE 30036000 T 0368
% ) 23 RPAR MIDDLE 30037000 T 0368
% [ 24 LBRACKET MIDDLE 30038000 T 0368
% ] 25 RBRACKET MIDDLE 30039000 T 0368
% .. 26 DOUBLEDOT MIDDLE 30040000 T 0368
% , 27 COMMA MIDDLE 30041000 T 0368
% ; 28 SEMICOLON TERMINAL 30042000 T 0368
% . 29 DOT MIDDLE 30043000 T 0368
% ~ @ 30 ARROW MIDDLE 30044000 T 0368
% : 31 COLON MIDDLE 30045000 T 0368
% := 32 ASSIGNSY MIDDLE 30046000 T 0368
% BEGIN 33 BEGINSY INITIAL 30047000 T 0368
% END 34 ENDSY TERMINAL 30048000 T 0368
% IF 35 IFSY INITIAL 30049000 T 0368
% THEN 36 THENSY MIDDLE 30050000 T 0368
% ELSE 37 ELSESY TERMINAL 30051000 T 0368
% CASE 38 CASESY INITIAL 30052000 T 0368
% OF 39 OFSY MIDDLE 30053000 T 0368
% REPEAT 40 REPEATSY INITIAL 30054000 T 0368
% UNTIL 41 UNTILSY TERMINAL 30055000 T 0368
% WHILE 42 WHILESY INITIAL 30056000 T 0368
% DO 43 DOSY MIDDLE 30057000 T 0368
% FOR 44 FORSY INITIAL 30058000 T 0368
% TO 45 TOSY MIDDLE 30059000 T 0368
% DOWNTO 46 DOWNTOSY MIDDLE 30060000 T 0368
% GOTO 47 GOTOSY INITIAL 30061000 T 0368
% NIL 48 NILSY MIDDLE 30062000 T 0368
% TYPE 49 TYPESY INITIAL 30063000 T 0368
% ARRAY 50 ARRAYSY MIDDLE 30064000 T 0368
% RECORD 51 RECORDSY MIDDLE 30065000 T 0368
% FILE 52 FILESY MIDDLE 30066000 T 0368
% SET 53 SETSY MIDDLE 30067000 T 0368
% CONST 54 CONSTSY INITIAL 30068000 T 0368
% VAR 55 VARSY INITIAL 30069000 T 0368
% LABEL 56 LABELSY INITIAL 30070000 T 0368
% FUNCTION 57 FUNCSY INITIAL 30071000 T 0368
% PROCEDURE 58 PROCSY INITIAL 30072000 T 0368
% WITH 59 WITHSY INITIAL 30073000 T 0368
% PROGRAM 60 PROGRAMSY INITIAL 30074000 T 0368
% PACKED 61 PACKEDSY MIDDLE 30075000 T 0368
30076000 T 0368
30077000 T 0368
DEFINE BLANK=48#, EQUAL=61#, QUOTES=63#, DOLLAR=42#, 30078000 T 0368
LETTER(C)=(17{C AND C{25)OR(33{C AND C{41)OR(50{C AND C{57)#, 30079000 T 0368
ALFANUM(C)=(LETTER(C) OR C{9)#; 30080000 T 0368
30081000 T 0368
REAL CURVAL; 30082000 T 0368
ALPHA CURNAME1,CURNAME2,C,CX; 30083000 T 0368
INTEGER CURLENGTH,LASTCHARPOS; 30084000 T 0368
BOOLEAN FINIS; 30085000 T 0368
30086000 T 0368
DEFINE NEXTCHAR= 30087000 T 0368
BEGIN COMMENT *** READ NEXT CHARACTER. ***; 30088000 T 0368
IF CHARCNT=0 THEN C:=BLANK ELSE 30089000 T 0368
BEGIN 30090000 T 0368
REPLACE CHARPNT BY CARDPNT:CARDPNT FOR 1; 30091000 T 0368
C:=CH[0]; CHARCNT:=CHARCNT-1; 30092000 T 0368
END END #; 30093000 T 0368
30094000 T 0368
30095000 T 0368
30096000 T 0368
PROCEDURE INSYMBOL; 30097000 T 0368
BEGIN COMMENT *** READS THE NEXT SYMBOL. ***; 30098000 T 0368
INTEGER SCALE,EXP; 30099000 T 0368
START OF SEGMENT ********** 8
BOOLEAN NEGEXP; 30100000 T 0000
LABEL START,OVERFLOW; 30101000 T 0000
30102000 T 0000
START: 30103000 T 0000
IF C=BLANK THEN 30104000 T 0000
BEGIN SCAN CARDPNT:CARDPNT FOR CHARCNT:CHARCNT WHILE =" "; 30105000 T 0000
IF CHARCNT=0 THEN BEGIN NEWCARD; GO TO START END; 30106000 T 0003
NEXTCHAR; 30107000 T 0068
END; 30108000 T 0076
IF LETTER(C) THEN 30109000 T 0076
BEGIN 30110000 T 0081
CURLENGTH:=1; CURNAME1:=C; CURNAME2:=0; 30111000 T 0082
NEXTCHAR; 30112000 T 0084
WHILE ALFANUM(C) AND CURLENGTH<6 DO 30113000 T 0092
BEGIN CURNAME1:=C&CURNAME1[35:29:30]; 30114000 T 0100
CURLENGTH:=CURLENGTH+1; NEXTCHAR; 30115000 T 0102
END; 30116000 T 0110
IF CURLENGTH=6 THEN 30117000 T 0111
BEGIN 30118000 T 0112
WHILE ALFANUM(C) AND CURLENGTH<12 DO 30119000 T 0112
BEGIN CURNAME2:=C&CURNAME2[35:29:30]; 30120000 T 0120
CURLENGTH:=CURLENGTH+1; NEXTCHAR; 30121000 T 0122
END; 30122000 T 0131
WHILE ALFANUM(C) DO NEXTCHAR; 30123000 T 0131
END; 30124000 T 0147
CURNAME1.NAMELENGTH:=CURLENGTH; 30125000 T 0147
CASE CURLENGTH OF 30126000 T 0148
BEGIN ; 30127000 T 0149
CURSY:=IDENTIFIER; 30128000 T 0149
CURSY:=IF CURNAME1="20000IF" THEN IFSY ELSE 30129000 T 0150
IF CURNAME1="20000DO" THEN DOSY ELSE 30130000 T 0152
IF CURNAME1="20000TO" THEN TOSY ELSE 30131000 T 0154
IF CURNAME1="20000OR" THEN ORSY ELSE 30132000 T 0156
IF CURNAME1="20000OF" THEN OFSY ELSE 30133000 T 0158
IF CURNAME1="20000IN" THEN INSY ELSE IDENTIFIER; 30134000 T 0160
CURSY:=IF CURNAME1="3000END" THEN ENDSY ELSE 30135000 T 0164
IF CURNAME1="3000FOR" THEN FORSY ELSE 30136000 T 0166
IF CURNAME1="3000DIV" THEN DIVSY ELSE 30137000 T 0168
IF CURNAME1="3000MOD" THEN MODSY ELSE 30138000 T 0170
IF CURNAME1="3000NIL" THEN NILSY ELSE 30139000 T 0172
IF CURNAME1="3000AND" THEN ANDSY ELSE 30140000 T 0174
IF CURNAME1="3000NOT" THEN NOTSY ELSE 30141000 T 0176
IF CURNAME1="3000VAR" THEN VARSY ELSE 30142000 T 0178
IF CURNAME1="3000SET" THEN SETSY ELSE 30143000 T 0180
IF CURNAME1="3000LSS" THEN LSSSY ELSE 30144000 T 0182
IF CURNAME1="3000LEQ" THEN LEQSY ELSE 30145000 T 0184
IF CURNAME1="3000GEQ" THEN GEQSY ELSE 30146000 T 0186
IF CURNAME1="3000GTR" THEN GTRSY ELSE 30147000 T 0188
IF CURNAME1="3000NEQ" THEN NEQSY ELSE 30148000 T 0190
IF CURNAME1="3000EQL" THEN EQLSY ELSE IDENTIFIER; 30149000 T 0192
CURSY:=IF CURNAME1="400THEN" THEN THENSY ELSE 30150000 T 0195
IF CURNAME1="400ELSE" THEN ELSESY ELSE 30151000 T 0197
IF CURNAME1="400WITH" THEN WITHSY ELSE 30152000 T 0199
IF CURNAME1="400CASE" THEN CASESY ELSE 30153000 T 0201
IF CURNAME1="400GOTO" THEN GOTOSY ELSE 30154000 T 0203
IF CURNAME1="400TYPE" THEN TYPESY ELSE 30155000 T 0205
IF CURNAME1="400FILE" THEN FILESY ELSE IDENTIFIER; 30156000 T 0207
CURSY:=IF CURNAME1="50BEGIN" THEN BEGINSY ELSE 30157000 T 0210
IF CURNAME1="50WHILE" THEN WHILESY ELSE 30158000 T 0212
IF CURNAME1="50UNTIL" THEN UNTILSY ELSE 30159000 T 0214
IF CURNAME1="50ARRAY" THEN ARRAYSY ELSE 30160000 T 0216
IF CURNAME1="50CONST" THEN CONSTSY ELSE 30161000 T 0218
IF CURNAME1="50LABEL" THEN LABELSY ELSE IDENTIFIER; 30162000 T 0220
CURSY:=IF CURNAME1="6REPEAT" THEN REPEATSY ELSE 30163000 T 0223
IF CURNAME1="6DOWNTO" THEN DOWNTOSY ELSE 30164000 T 0225
IF CURNAME1="6RECORD" THEN RECORDSY ELSE 30165000 T 0227
IF CURNAME1="6PACKED" THEN PACKEDSY ELSE IDENTIFIER; 30166000 T 0229
CURSY:=IF CURNAME1="7PROGRA" AND CURNAME2="M" THEN PROGRAMSY 30167000 T 0233
ELSE IDENTIFIER; 30168000 T 0235
CURSY:=IF CURNAME1="8FUNCTI" AND CURNAME2="ON" THEN FUNCSY 30169000 T 0237
ELSE IDENTIFIER; 30170000 T 0239
CURSY:=IF CURNAME1="9PROCED" AND CURNAME2="URE" THEN PROCSY 30171000 T 0241
ELSE IDENTIFIER; 30172000 T 0244
CURSY:=IDENTIFIER; % 10 CHARACTERS. 30173000 T 0245
CURSY:=IDENTIFIER; % 11 CHARACTERS. 30174000 T 0247
CURSY:=IDENTIFIER; % 12 CHARACTERS. 30175000 T 0248
END OF CASE; 30176000 T 0249
START OF SEGMENT ********** 9
9 IS 13 LONG, NEXT SEG 8
IF RESWORDOPTION AND CURSY!IDENTIFIER THEN 30177000 T 0249
BEGIN T1:=CARDLENGTH-CHARCNT-CURLENGTH; 30178000 T 0250
IF CHARCNT=0 THEN CARDPNT:=CARDPNT+1 ELSE T1:=T1-1; 30179000 T 0296
REPLACE XLINEPNT+T1 BY CARDPNT-(CURLENGTH+1) 30180000 T 0302
FOR CURLENGTH; 30181000 T 0306
END; 30182000 T 0309
END OF LETTER ELSE 30183000 T 0309
IF C{9 THEN 30184000 T 0309
BEGIN 30185000 T 0311
CURVAL:=C; CURSY:=INTCONST; 30186000 T 0311
NEXTCHAR; 30187000 T 0313
WHILE C{9 DO BEGIN CURVAL:=10|CURVAL+C; NEXTCHAR END; 30188000 T 0320
IF C="." THEN 30189000 T 0331
BEGIN 30190000 T 0332
NEXTCHAR; 30191000 T 0332
IF C{9 THEN 30192000 T 0340
BEGIN CURSY:=REALCONST; 30193000 T 0341
DO BEGIN CURVAL:=10|CURVAL+C; 30194000 T 0342
SCALE:=SCALE-1; NEXTCHAR; 30195000 T 0344
END UNTIL C>9; 30196000 T 0352
END ELSE IF C="." THEN C:=64 % SPECIAL MARK FOR ".." 30197000 T 0354
ELSE ERROR(4); 30198000 T 0356
END; 30199000 T 0357
IF C="E" THEN 30200000 T 0357
BEGIN 30201000 T 0358
CURSY:=REALCONST; NEXTCHAR; 30202000 T 0359
IF C="+" OR C="-" THEN BEGIN NEGEXP:=C="-"; NEXTCHAR END; 30203000 T 0367
IF C{9 THEN 30204000 T 0378
BEGIN EXP:=C; NEXTCHAR; 30205000 T 0379
WHILE C{9 DO BEGIN EXP:=10|EXP+C; NEXTCHAR END; 30206000 T 0387
IF NEGEXP THEN EXP:=-EXP; 30207000 T 0398
END ELSE ERROR(4); 30208000 T 0400
SCALE:=SCALE+EXP; 30209000 T 0401
END; 30210000 T 0403
IF CURSY=REALCONST THEN 30211000 T 0403
BEGIN 30212000 T 0403
REALOVERFLOW:=OVERFLOW; 30213000 T 0404
CURVAL:=CURVAL|10*SCALE; 30214000 T 0406
REALOVERFLOW:=0; 30215000 T 0409
END ELSE 30216000 T 0410
IF CURVAL>MAXINT THEN 30217000 T 0410
BEGIN 30218000 T 0411
OVERFLOW: ERROR(14); CURVAL:=0; REALOVERFLOW:=0; 30219000 T 0411
END; 30220000 T 0414
END OF DIGIT ELSE 30221000 T 0414
IF C=QUOTES THEN 30222000 T 0414
BEGIN 30223000 T 0416
CURSY:=ALFACONST; CURLENGTH:=0; NEXTCHAR; 30224000 T 0417
FINIS:=FALSE; 30225000 T 0426
DO BEGIN 30226000 T 0427
IF C=QUOTES THEN BEGIN NEXTCHAR; FINIS:=C!QUOTES END ELSE 30227000 T 0427
IF CHARCNT=0 THEN BEGIN ERROR(6); FINIS:=TRUE END; 30228000 T 0437
IF NOT FINIS THEN 30229000 T 0440
BEGIN 30230000 T 0440
REPLACE STRINGPNT+CURLENGTH BY CHARPNT FOR 1; 30231000 T 0441
CURLENGTH:=CURLENGTH+1; 30232000 T 0446
NEXTCHAR; 30233000 T 0447
END END UNTIL FINIS; 30234000 T 0454
IF CURLENGTH=0 THEN ERROR(4) ELSE 30235000 T 0455
IF CURLENGTH=1 THEN 30236000 T 0457
BEGIN CURSY:=CHARCONST; 30237000 T 0458
REPLACE CHARPNT BY STRINGPNT FOR 1; CURVAL:=CH[0]; 30238000 T 0460
END ELSE 30239000 T 0463
IF CURLENGTH{7 THEN 30240000 T 0463
BEGIN TEXT[0]:=" "; 30241000 T 0465
REPLACE TEXTPNT BY STRINGPNT FOR CURLENGTH; 30242000 T 0466
CURVAL:=TEXT[0]; 30243000 T 0469
END; 30244000 T 0470
END OF STRINGS ELSE 30245000 T 0470
BEGIN 30246000 T 0470
CURSY:=SYMBOL[C]; NEXTCHAR; 30247000 T 0472
IF CURSY=COLON AND C=EQUAL THEN 30248000 T 0480
BEGIN CURSY:=ASSIGNSY; NEXTCHAR END ELSE 30249000 T 0482
IF CURSY=DOT AND C="." THEN 30250000 T 0491
BEGIN CURSY:=DOUBLEDOT; NEXTCHAR END ELSE 30251000 T 0493
IF CURSY=LSSSY AND C=EQUAL THEN 30252000 T 0502
BEGIN CURSY:=LEQSY; NEXTCHAR END ELSE 30253000 T 0504
IF CURSY=LSSSY AND C=">" THEN 30254000 T 0513
BEGIN CURSY:=NEQSY; NEXTCHAR END ELSE 30255000 T 0515
IF CURSY=GTRSY AND C=EQUAL THEN 30256000 T 0524
BEGIN CURSY:=GEQSY; NEXTCHAR END ELSE 30257000 T 0526
IF CURSY=LPAR AND C="*" THEN 30258000 T 0535
BEGIN % *** COMMENT *** 30259000 T 0537
NEXTCHAR; 30260000 T 0537
IF C=DOLLAR THEN % DOLLAR INDICATES COMPILER OPTIONS. 30261000 T 0545
DO BEGIN 30262000 T 0546
NEXTCHAR; CX:=C; NEXTCHAR; 30263000 T 0546
IF CX="L" THEN IF C=1 THEN HEADING 30264000 T 0562
ELSE LISTOPTION:=C="+" ELSE 30265000 T 0585
IF CX="R" THEN RESWORDOPTION:=C="+" ELSE 30266000 T 0587
IF CX="C" THEN CHECKOPTION:=C="+" ELSE 30267000 T 0590
IF CX="D" THEN DUMPOPTION:=C="+" ELSE 30268000 T 0593
IF CX="X" THEN XREFOPTION:=C="+" ELSE 30269000 T 0596
IF CX="A" THEN 30270000 T 0599
IF C="+" THEN WRITE(PASCALGOL,ALIST) 30271000 T 0600
ELSE WRITE(PASCALGOL,NOALIST) ELSE 30272000 T 0604
IF CX="T" THEN 30273000 T 0608
BEGIN LASTCHARPOS := CHARCNT - CARDLENGTH; 30274000 T 0609
CARDLENGTH:=10|C; 30275000 T 0611
NEXTCHAR; CARDLENGTH:=CARDLENGTH+C; 30276000 T 0612
IF CARDLENGTH{9 OR CARDLENGTH>80 THEN 30277000 T 0621
BEGIN ERROR(14); CARDLENGTH:=72 END; 30278000 T 0623
CHARCNT:=MAX(0,LASTCHARPOS+CARDLENGTH-1); 30279000 T 0625
END; 30280000 T 0629
NEXTCHAR; 30281000 T 0629
END UNTIL C!","; 30282000 T 0636
FINIS:=FALSE; 30283000 T 0638
DO BEGIN 30284000 T 0638
IF C!"*" THEN 30285000 T 0638
SCAN CARDPNT:CARDPNT FOR CHARCNT:CHARCNT UNTIL ="*"; 30286000 T 0639
IF CHARCNT=0 THEN NEWCARD ELSE 30287000 T 0642
BEGIN NEXTCHAR; 30288000 T 0706
WHILE C="*" DO NEXTCHAR; 30289000 T 0714
FINIS:=C=")"; 30290000 T 0724
END END UNTIL FINIS; 30291000 T 0725
NEXTCHAR; 30292000 T 0726
GO TO START; 30293000 T 0733
END OF COMMENT; 30294000 T 0734
END; 30295000 T 0734
END OF INSYMBOL; 30296000 T 0734
8 IS 739 LONG, NEXT SEG 2
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 40001000 T 0368
% % 40002000 T 0368
% % 40003000 T 0368
% % 40004000 T 0368
% PART 4: EXPRESSION PARSER. % 40005000 T 0368
% ------------------ % 40006000 T 0368
% % 40007000 T 0368
% % 40008000 T 0368
% % 40009000 T 0368
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 40010000 T 0368
40011000 T 0368
40012000 T 0368
PROCEDURE EXPRESSION; FORWARD; 40013000 T 0368
PROCEDURE CONCAT; FORWARD; 40014000 T 0368
40015000 T 0368
ALPHA TEMPSYM; 40016000 T 0368
REAL SX; 40017000 T 0368
INTEGER EXPRLEVEL,TX; 40018000 T 0368
40019000 T 0368
DEFINE PUTTEXT(T)= 40020000 T 0368
BEGIN 40021000 T 0368
IF NUMSYMS=MAXSYMS THEN 40022000 T 0368
BEGIN ERROR(71); 40023000 T 0368
NUMSYMS:=1; 40024000 T 0368
END ELSE NUMSYMS:=NUMSYMS+1; 40025000 T 0368
SYMTAB[NUMSYMS]:=T; 40026000 T 0368
END OF PUTTEXT #; 40027000 T 0368
40028000 T 0368
DEFINE PUTSYM(S)= 40029000 T 0368
BEGIN 40030000 T 0368
TEMPSYM:=(S)&1[41:5:6]; 40031000 T 0368
PUTTEXT(TEMPSYM); 40032000 T 0368
END OF PUTSYM #; 40033000 T 0368
40034000 T 0368
DEFINE PUTCONST(VAL)= 40035000 T 0368
BEGIN 40036000 T 0368
PUTTEXT("2000000"); 40037000 T 0368
PUTTEXT(VAL); 40038000 T 0368
END OF PUTCONST #; 40039000 T 0368
40040000 T 0368
DEFINE PUTDUMMY= 40041000 T 0368
BEGIN 40042000 T 0368
PUTTEXT("3000000"); 40043000 T 0368
END OF PUTDUMMY #; 40044000 T 0368
40045000 T 0368
DEFINE PUTID(L,NUM,NUMDIG)= 40046000 T 0368
BEGIN 40047000 T 0368
TEXT[0]:=" " & L [35:5:6]; 40048000 T 0368
REPLACE TEXTPNT+2 BY NUM FOR NUMDIG DIGITS; 40049000 T 0368
PUTTEXT(TEXT[0]); 40050000 T 0368
END OF PUTID#; 40051000 T 0368
40052000 T 0368
DEFINE WRITEEXPR= 40053000 T 0368
BEGIN 40054000 T 0368
FOR T1:=1 STEP 1 UNTIL NUMSYMS DO 40055000 T 0368
BEGIN 40056000 T 0368
SX:=SYMTAB[T1]; TX:=SX.[41:6]; 40057000 T 0368
IF TX=0 THEN GEN(SX,7,2) ELSE 40058000 T 0368
IF TX=3 THEN ELSE 40059000 T 0368
IF TX=1 THEN GEN(SX,1,7) ELSE 40060000 T 0368
BEGIN 40061000 T 0368
T1:=T1+1; SX:=SYMTAB[T1]; 40062000 T 0368
IF SX.[44:6]=0 THEN GENINT(SX) ELSE GENREAL(SX); 40063000 T 0368
END END; 40064000 T 0368
NUMSYMS:=0; 40065000 T 0368
END OF WRITEEXPR#; 40066000 T 0368
40067000 T 0368
40068000 T 0368
DEFINE CHECKEXPR(LLIM,ULIM)= 40069000 T 0368
BEGIN 40070000 T 0368
PUTTEXT("CHECK("); 40071000 T 0368
EXPRESSION; 40072000 T 0368
PUTSYM(","); PUTCONST(LLIM); 40073000 T 0368
PUTSYM(","); PUTCONST(ULIM); 40074000 T 0368
PUTSYM(","); PUTCONST(CARDCNT); 40075000 T 0368
PUTSYM(")"); 40076000 T 0368
END OF CHECKEXPR#; 40077000 T 0368
40078000 T 0368
40079000 T 0368
BOOLEAN SIMPLEVARIABLE,INSIDEBRACKETS; 40080000 T 0368
INTEGER NUMPOINTERS; 40081000 T 0368
40082000 T 0368
PROCEDURE VARIABLE; 40083000 T 0368
BEGIN 40084000 T 0368
INTEGER STARTSYM,LLIM,ULIM; 40085000 T 0368
START OF SEGMENT ********** 10
REAL T; 40086000 T 0000
BOOLEAN INBRACKET,INRECORD; 40087000 T 0000
LABEL ADDADDR; 40088000 T 0000
40089000 T 0000
STARTSYM:=NUMSYMS+1; 40090000 T 0000
IF THISLEVEL>CURLEVEL THEN % VARIABLE IN FIELD LIST OF 40091000 T 0001
BEGIN % RECORD USED IN WITH-STATEMENT. 40092000 T 0002
T:=DISPLAY[THISLEVEL]; 40093000 T 0002
T4:=T.FIRSTWITHSYM; T5:=T.LASTWITHSYM; 40094000 T 0003
FOR T3:=T4 STEP 1 UNTIL T5 DO PUTTEXT(WITHTAB[T3]); 40095000 T 0006
INRECORD:=TRUE; 40096000 T 0015
INBRACKET:=BOOLEAN(T.BRACKETSINWITH); 40097000 T 0016
NUMPOINTERS:=NUMPOINTERS+T.NUMPNTRSINWITH; 40098000 T 0017
SIMPLEVARIABLE:=FALSE; 40099000 T 0019
CURTYPE:=T.RECTYPE; T:=TYPETAB1[CURTYPE]; 40100000 T 0019
GO TO ADDADDR; 40101000 T 0022
END; 40102000 T 0022
IF THISLEVEL>1 AND THISLEVEL<CURLEVEL THEN ERROR(5); 40103000 T 0022
CURTYPE:=THISID.TYPE; SIMPLEVARIABLE:=TRUE; 40104000 T 0025
PUTID("V",1000|THISLEVEL+THISINDEX,5); 40105000 T 0027
INSYMBOL; 40106000 T 0043
IF CURSY=LBRACKET OR CURSY=DOT OR CURSY=ARROW THEN 40107000 T 0044
BEGIN 40108000 T 0047
SIMPLEVARIABLE:=FALSE; 40109000 T 0047
DO BEGIN 40110000 T 0048
IF CURSY=LBRACKET THEN 40111000 T 0048
BEGIN 40112000 T 0049
IF NOT(INBRACKET OR INRECORD) THEN 40113000 T 0049
BEGIN PUTSYM("["); INBRACKET:=TRUE END; 40114000 T 0050
DO BEGIN 40115000 T 0059
T:=TYPETAB1[CURTYPE]; 40116000 T 0059
LLIM:=TYPETAB2[CURTYPE]; ULIM:=TYPETAB3[CURTYPE]; 40117000 T 0060
IF T.FORM!ARRAYS THEN ERROR(12); 40118000 T 0062
IF INRECORD THEN PUTTEXT(" +("); 40119000 T 0064
INSYMBOL; 40120000 T 0071
IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 40121000 T 0071
CHECKTYPES(T.INXTYPE,CURTYPE); 40122000 T 0150
CURTYPE:=T.ARRTYPE; 40123000 T 0209
IF INRECORD THEN 40124000 T 0210
BEGIN 40125000 T 0211
IF LLIM<0 THEN BEGIN PUTSYM("+"); PUTCONST(-LLIM) END ELSE 40126000 T 0211
IF LLIM>0 THEN BEGIN PUTSYM("-"); PUTCONST( LLIM) END; 40127000 T 0233
PUTSYM(")"); 40128000 T 0255
IF TYPETAB1[CURTYPE].SIZE>1 THEN 40129000 T 0263
BEGIN PUTSYM("|"); PUTCONST(TYPETAB1[CURTYPE].SIZE) END; 40130000 T 0264
END ELSE IF TYPETAB1[CURTYPE].STRUCT>0 THEN PUTSYM(","); 40131000 T 0286
END UNTIL CURSY!COMMA; 40132000 T 0296
IF CURSY!RBRACKET THEN 40133000 T 0297
BEGIN ERROR(59); SKIP(RBRACKET); 40134000 T 0298
IF CURSY=RBRACKET THEN INSYMBOL; 40135000 T 0300
END ELSE INSYMBOL; 40136000 T 0302
END OF BRACKETS ELSE 40137000 T 0303
IF CURSY=DOT THEN 40138000 T 0303
BEGIN 40139000 T 0304
IF NOT(INBRACKET OR INRECORD) THEN 40140000 T 0304
BEGIN PUTSYM("["); INBRACKET:=TRUE END; 40141000 T 0305
T:=TYPETAB1[CURTYPE]; 40142000 T 0314
IF T.FORM!RECORD THEN ERROR(12); 40143000 T 0315
INSYMBOL; 40144000 T 0318
IF CURSY=IDENTIFIER THEN 40145000 T 0318
BEGIN 40146000 T 0319
SEARCHTAB(T.RECTAB); 40147000 T 0319
IF FOUND THEN 40148000 T 0339
BEGIN 40149000 T 0340
THISID:=NAMETAB3[T.RECTAB,THISINDEX]; 40150000 T 0340
ADDADDR: PUTSYM("+"); 40151000 T 0342
PUTCONST(THISID.INFO); CURTYPE:=THISID.TYPE; 40152000 T 0350
END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40153000 T 0365
END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40154000 T 0367
INRECORD:=TRUE; 40155000 T 0369
INSYMBOL; 40156000 T 0370
END OF DOT ELSE 40157000 T 0370
BEGIN % CURSY=ARROW 40158000 T 0370
T:=TYPETAB1[CURTYPE]; 40159000 T 0371
IF T.FORM=FILES THEN 40160000 T 0372
BEGIN 40161000 T 0373
CURTYPE:=T.FILETYPE; 40162000 T 0373
IF TYPETAB1[CURTYPE].STRUCT=0 THEN PUTTEXT(" [0]"); 40163000 T 0375
END ELSE 40164000 T 0382
IF T.FORM=TEXTFILE THEN 40165000 T 0382
BEGIN 40166000 T 0386
SYMTAB[NUMSYMS]:=SYMTAB[NUMSYMS] & "I" [35:5:6]; 40167000 T 0386
PUTSYM("."); PUTTEXT("LASTCH"); 40168000 T 0389
CURTYPE:=CHARTYPE; 40169000 T 0402
END ELSE 40170000 T 0403
IF T.FORM=POINTERS THEN 40171000 T 0403
BEGIN 40172000 T 0406
IF INBRACKET THEN PUTSYM("]"); 40173000 T 0406
INBRACKET:=FALSE; 40174000 T 0415
IF NUMSYMS+2{MAXSYMS THEN 40175000 T 0415
BEGIN 40176000 T 0417
FOR T1:=NUMSYMS STEP -1 UNTIL STARTSYM DO 40177000 T 0417
SYMTAB[T1+2]:=SYMTAB[T1]; 40178000 T 0419
SYMTAB[STARTSYM]:=" MEM["; 40179000 T 0423
SYMTAB[STARTSYM+1]:=" (T:="; 40180000 T 0424
NUMSYMS:=NUMSYMS+2; NUMPOINTERS:=NUMPOINTERS+1; 40181000 T 0426
INRECORD:=TRUE; 40182000 T 0428
END ELSE ERROR(63); 40183000 T 0429
CURTYPE:=T.POINTTYPE; 40184000 T 0432
END ELSE BEGIN ERROR(12); CURTYPE:=0 END; 40185000 T 0434
INSYMBOL; 40186000 T 0436
END OF ARROW; 40187000 T 0436
END UNTIL CURSY!LBRACKET AND CURSY!DOT AND CURSY!ARROW; 40188000 T 0436
IF TYPETAB1[CURTYPE].STRUCT=0 THEN 40189000 T 0439
BEGIN 40190000 T 0441
IF INBRACKET THEN PUTSYM("]"); 40191000 T 0441
WHILE NUMPOINTERS>0 DO 40192000 T 0451
BEGIN PUTTEXT("-1)DIV"); PUTTEXT(" 1022,"); 40193000 T 0452
PUTTEXT(" T MOD"); PUTTEXT(" 1022]"); 40194000 T 0465
NUMPOINTERS:=NUMPOINTERS-1; 40195000 T 0479
END; 40196000 T 0480
END; 40197000 T 0483
END; 40198000 T 0483
INSIDEBRACKETS:=INBRACKET; 40199000 T 0483
CURMODE:=NUMBER; 40200000 T 0483
END OF VARIABLE; 40201000 T 0484
10 IS 489 LONG, NEXT SEG 2
40202000 T 0368
40203000 T 0368
PROCEDURE PASSPARAMS; 40204000 T 0368
BEGIN 40205000 T 0368
INTEGER NPARS,PARAM,PTYPE,P,FIRSTSYM; 40206000 T 0368
START OF SEGMENT ********** 11
BOOLEAN FORMALPROC,CHECK; 40207000 T 0000
LABEL EXIT; 40208000 T 0000
40209000 T 0000
PUTID("V",1000|THISLEVEL+THISINDEX,5); 40210000 T 0000
P:=THISID.INFO; 40211000 T 0015
FORMALPROC:=BOOLEAN(THISID.FORMAL); 40212000 T 0017
NPARS:=PARAMTAB[P]; P:=P+1; 40213000 T 0018
IF FORMALPROC THEN NPARS:=9999; 40214000 T 0020
INSYMBOL; 40215000 T 0022
IF CURSY=LPAR THEN 40216000 T 0022
BEGIN 40217000 T 0023
PUTSYM("("); 40218000 T 0023
DO BEGIN 40219000 T 0032
INSYMBOL; 40220000 T 0032
IF NPARS=0 THEN BEGIN ERROR(3); SKIP(RPAR); GO TO EXIT END; 40221000 T 0033
PARAM:=PARAMTAB[P]; P:=P+1; 40222000 T 0036
PTYPE:=PARAM.PARAMTYPE; 40223000 T 0038
IF PARAM.PARAMKIND=CONST THEN 40224000 T 0039
BEGIN 40225000 T 0041
CHECK:=CHECKOPTION AND TYPETAB1[PTYPE].FORM LEQ CHAR; 40226000 T 0041
IF CHECK THEN PUTTEXT("CHECK("); 40227000 T 0044
PUTDUMMY; FIRSTSYM:=NUMSYMS; 40228000 T 0050
EXPRLEVEL:=EXPRLEVEL+1; 40229000 T 0058
EXPRESSION; EXPRLEVEL:=EXPRLEVEL-1; 40230000 T 0059
IF CURMODE=BITPATTERN THEN 40231000 T 0061
BEGIN SYMTAB[FIRSTSYM]:=" REAL("; PUTSYM(")"); END; 40232000 T 0062
IF CHECK THEN 40233000 T 0073
BEGIN 40234000 T 0073
PUTSYM(","); PUTCONST(TYPETAB2[PTYPE]); 40235000 T 0074
PUTSYM(","); PUTCONST(TYPETAB3[PTYPE]); 40236000 T 0094
PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); 40237000 T 0115
END; 40238000 T 0144
END ELSE 40239000 T 0144
IF PARAM.PARAMKIND=VAR THEN 40240000 T 0144
BEGIN 40241000 T 0145
IF CURSY=IDENTIFIER THEN 40242000 T 0146
BEGIN 40243000 T 0147
SEARCH; 40244000 T 0147
IF FOUND THEN 40245000 T 0175
BEGIN 40246000 T 0175
IF THISID.IDCLASS=VAR OR 40247000 T 0175
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 40248000 T 0177
BEGIN 40249000 T 0179
IF PARAM.PARAMFILE=1 THEN 40250000 T 0180
BEGIN 40251000 T 0181
CURTYPE:=THISID.TYPE; 40252000 T 0181
PUTID("V",1000|THISLEVEL+THISINDEX,5); PUTSYM(","); 40253000 T 0183
PUTID("F",1000|THISLEVEL+THISINDEX,5); PUTSYM(","); 40254000 T 0206
PUTID("I",1000|THISLEVEL+THISINDEX,5); 40255000 T 0230
INSYMBOL; 40256000 T 0246
END ELSE 40257000 T 0247
BEGIN 40258000 T 0247
VARIABLE; 40259000 T 0247
IF TYPETAB1[CURTYPE].STRUCT>0 THEN 40260000 T 0248
IF NOT SIMPLEVARIABLE THEN ERROR(92); 40261000 T 0249
END; 40262000 T 0252
END ELSE BEGIN ERROR(8); CURTYPE:=0 END; 40263000 T 0252
END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40264000 T 0254
END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40265000 T 0256
END ELSE 40266000 T 0258
BEGIN 40267000 T 0258
IF CURSY=IDENTIFIER THEN 40268000 T 0258
BEGIN 40269000 T 0259
SEARCH; 40270000 T 0259
IF FOUND THEN 40271000 T 0287
BEGIN 40272000 T 0287
IF THISID.IDCLASS!PARAM.PARAMKIND THEN ERROR(91); 40273000 T 0288
PUTID("V",1000|THISLEVEL+THISINDEX,5); 40274000 T 0291
CURTYPE:=IF THISID.IDCLASS=FUNC THEN THISID.TYPE ELSE 0; 40275000 T 0306
INSYMBOL; 40276000 T 0310
END ELSE BEGIN ERROR(1); CURTYPE:=0 END; 40277000 T 0311
END ELSE BEGIN ERROR(9); CURTYPE:=0 END; 40278000 T 0313
END; 40279000 T 0315
CHECKTYPES(PTYPE,CURTYPE); 40280000 T 0315
NPARS:=NPARS-1; 40281000 T 0373
IF CURSY=COMMA THEN PUTSYM(","); 40282000 T 0374
END UNTIL CURSY!COMMA; 40283000 T 0383
IF CURSY!RPAR THEN BEGIN ERROR(89); SKIP(RPAR) END; 40284000 T 0384
EXIT: PUTSYM(")"); 40285000 T 0387
IF CURSY=RPAR THEN INSYMBOL; 40286000 T 0395
END; 40287000 T 0397
IF NPARS>0 AND NOT FORMALPROC THEN ERROR(3); 40288000 T 0397
CURMODE:=NUMBER; 40289000 T 0400
END OF PASSPARAMS; 40290000 T 0401
11 IS 408 LONG, NEXT SEG 2
40291000 T 0368
40292000 T 0368
PROCEDURE FACTOR; %*** FACTOR *** 40293000 T 0368
BEGIN %************** 40294000 T 0368
INTEGER STARTSYM,STYPE,T; 40295000 T 0368
START OF SEGMENT ********** 12
BOOLEAN FIRST; 40296000 T 0000
REAL VAL; 40297000 T 0000
40298000 T 0000
DEFINE PARAMETER= %*** CHECK THAT THE FUNCTION HAS 1 PARAM. 40299000 T 0000
BEGIN 40300000 T 0000
INSYMBOL; 40301000 T 0000
IF CURSY=LPAR THEN 40302000 T 0000
BEGIN 40303000 T 0000
PUTSYM("("); INSYMBOL; EXPRESSION; 40304000 T 0000
IF TYPETAB1[CURTYPE].FORM=NUMERIC THEN CURTYPE:=INTTYPE; 40305000 T 0000
IF CURSY!RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; 40306000 T 0000
PUTSYM(")"); IF CURSY=RPAR THEN INSYMBOL; 40307000 T 0000
END ELSE ERROR(3); 40308000 T 0000
END OF PARAMETER#; 40309000 T 0000
40310000 T 0000
CURMODE:=NUMBER; 40311000 T 0000
IF CURSY=IDENTIFIER THEN 40312000 T 0000
BEGIN 40313000 T 0001
SEARCH; 40314000 T 0002
IF FOUND THEN 40315000 T 0029
BEGIN 40316000 T 0029
IF THISID.IDCLASS=VAR OR 40317000 T 0030
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) 40318000 T 0031
THEN VARIABLE ELSE 40319000 T 0032
IF THISID.IDCLASS=CONST THEN 40320000 T 0035
BEGIN 40321000 T 0036
IF THISID.INFO{1023 THEN PUTCONST(THISID.INFO) 40322000 T 0037
ELSE PUTCONST(CONSTTAB[THISID.INFO-1023]); 40323000 T 0038
CURTYPE:=THISID.TYPE; CURMODE:=NUMBER; 40324000 T 0066
INSYMBOL; 40325000 T 0068
END ELSE 40326000 T 0069
IF THISID.IDCLASS=FUNC THEN 40327000 T 0069
BEGIN 40328000 T 0071
IF THISTAB=0 THEN %*** INTRINSIC FUNCTION *** 40329000 T 0071
BEGIN 40330000 T 0072
INTEGER DUMMY; 40350000 T 0072
START OF SEGMENT ********** 13
IF CURNAME1="3000ABS" THEN % "ABS" 40351000 T 0000
BEGIN 40352000 T 0000
PUTTEXT(" ABS"); PARAMETER; 40353000 T 0001
IF CURTYPE!REALTYPE AND CURTYPE!INTTYPE THEN ERROR(67); 40354000 T 0036
END ELSE 40355000 T 0039
IF CURNAME1="3000CHR" THEN % "CHR" 40356000 T 0039
BEGIN 40357000 T 0040
INSYMBOL; 40358000 T 0041
IF CURSY=LPAR THEN 40359000 T 0041
BEGIN INSYMBOL; CHECKEXPR(0,63); 40360000 T 0042
IF TYPETAB1[CURTYPE].FORM!NUMERIC THEN ERROR(67); 40361000 T 0120
IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40362000 T 0122
IF CURSY=RPAR THEN INSYMBOL; 40363000 T 0125
END ELSE ERROR(58); 40364000 T 0127
CURTYPE:=CHARTYPE; 40365000 T 0128
END ELSE 40366000 T 0129
IF CURNAME1="3000EOF" OR % "EOF"/"EOLN" 40367000 T 0129
CURNAME1="400EOLN" THEN 40368000 T 0130
BEGIN 40369000 T 0131
FIRST:=CURNAME1="3000EOF"; 40370000 T 0132
FILEPARAM(INPUTFILE); 40371000 T 0133
PUTID("I",FILENAME,5); 40372000 T 0185
PUTTEXT(IF FIRST THEN " .EOF" ELSE " .EOLN"); 40373000 T 0200
IF LPARFOUND THEN 40374000 T 0208
BEGIN 40375000 T 0208
IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40376000 T 0208
IF CURSY=RPAR THEN INSYMBOL; 40377000 T 0211
END; 40378000 T 0213
CURTYPE:=BOOLTYPE; 40379000 T 0213
END ELSE 40380000 T 0214
IF CURNAME1="3000ODD" THEN % "ODD" 40381000 T 0214
BEGIN 40382000 T 0217
PUTTEXT(" ODD"); PARAMETER; 40383000 T 0218
IF CURTYPE!INTTYPE THEN ERROR(67); 40384000 T 0253
CURTYPE:=BOOLTYPE; CURMODE:=BITPATTERN; 40385000 T 0255
END ELSE 40386000 T 0257
IF CURNAME1="3000ORD" THEN % "ORD" 40387000 T 0257
BEGIN 40388000 T 0258
PUTSYM("("); INSYMBOL; 40389000 T 0258
IF CURSY=LPAR THEN 40390000 T 0268
BEGIN 40391000 T 0268
INSYMBOL; EXPRESSION; 40392000 T 0269
IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(67); 40393000 T 0270
IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40394000 T 0273
INSYMBOL; 40395000 T 0275
END ELSE ERROR(58); 40396000 T 0276
CURTYPE:=INTTYPE; PUTSYM(")"); 40397000 T 0277
END ELSE 40398000 T 0285
IF CURNAME1="400PRED" OR % "PRED"/"SUCC" 40399000 T 0285
CURNAME1="400SUCC" THEN 40400000 T 0287
BEGIN 40401000 T 0288
FIRST:=CURNAME1="400PRED"; 40402000 T 0288
PUTTEXT("CHECK("); INSYMBOL; 40403000 T 0289
IF CURSY=LPAR THEN 40404000 T 0298
BEGIN 40405000 T 0298
INSYMBOL; EXPRESSION; 40406000 T 0299
PUTSYM(IF FIRST THEN "-" ELSE "+"); PUTSYM("1"); 40407000 T 0300
IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(67); 40408000 T 0318
PUTSYM(","); PUTCONST(TYPETAB2[CURTYPE]); 40409000 T 0320
PUTSYM(","); PUTCONST(TYPETAB3[CURTYPE]); 40410000 T 0341
PUTSYM(","); PUTCONST(CARDCNT); 40411000 T 0362
PUTSYM(")"); 40412000 T 0383
IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40413000 T 0391
IF CURSY=RPAR THEN INSYMBOL; 40414000 T 0393
END ELSE BEGIN ERROR(58); CURTYPE:=0 END; 40415000 T 0395
END ELSE 40416000 T 0397
IF CURNAME1="50ROUND" THEN % "ROUND" 40417000 T 0397
BEGIN 40418000 T 0398
PUTTEXT(" ROUND"); PARAMETER; 40419000 T 0399
IF CURTYPE!REALTYPE THEN ERROR(67); 40420000 T 0434
NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40421000 T 0436
PUTCONST(CARDCNT); PUTSYM(")"); 40422000 T 0445
CURTYPE:=INTTYPE; 40423000 T 0466
END ELSE 40424000 T 0466
IF CURNAME1="3000SQR" THEN % "SQR" 40425000 T 0466
BEGIN 40426000 T 0468
PUTTEXT(" SQR"); PARAMETER; 40427000 T 0468
NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40428000 T 0503
PUTCONST(CARDCNT); PUTSYM(")"); 40429000 T 0512
IF CURTYPE!REALTYPE AND CURTYPE!INTTYPE THEN ERROR(67); 40430000 T 0533
END ELSE 40431000 T 0536
IF CURNAME1="50TRUNC" THEN % "TRUNC" 40432000 T 0536
BEGIN 40433000 T 0537
PUTTEXT(" TRUNC"); PARAMETER; 40434000 T 0537
NUMSYMS:=NUMSYMS-1; PUTSYM(","); 40435000 T 0572
PUTCONST(CARDCNT); PUTSYM(")"); 40436000 T 0581
IF CURTYPE!REALTYPE THEN ERROR(67); 40437000 T 0602
CURTYPE:=INTTYPE; 40438000 T 0604
END ELSE 40439000 T 0604
IF CURNAME1="6CONCAT" THEN % "CONCAT" 40440000 T 0604
CONCAT ELSE 40441000 T 0606
IF CURNAME1="400TIME" THEN % "TIME" 40442000 T 0607
BEGIN 40443000 T 0609
PUTTEXT("(TIME("); PUTTEXT("1)/60"); 40444000 T 0610
CURTYPE:=REALTYPE; INSYMBOL 40445000 T 0624
END ELSE 40446000 T 0625
IF CURNAME1="400DATE" THEN % "DATE" 40447000 T 0625
BEGIN 40448000 T 0628
PUTTEXT("CURDAT"); 40449000 T 0629
CURTYPE:=ALFATYPE; INSYMBOL; 40450000 T 0636
END ELSE 40451000 T 0637
IF CURNAME1="7ELAPSE" AND CURNAME2="D" THEN % "ELAPSED" 40452000 T 0637
BEGIN 40453000 T 0641
PUTTEXT("(TIME("); PUTTEXT("2)/60)"); 40454000 T 0642
CURTYPE:=REALTYPE; INSYMBOL; 40455000 T 0656
END ELSE 40456000 T 0657
IF CURNAME1="6IOTIME" THEN % "IOTIME" 40457000 T 0657
BEGIN 40458000 T 0660
PUTTEXT("(TIME("); PUTTEXT("3)/60)"); 40459000 T 0661
CURTYPE:=REALTYPE; INSYMBOL; 40460000 T 0675
END ELSE 40461000 T 0676
IF CURNAME1="7WEEKDA" AND CURNAME2="Y" THEN % "WEEKDAY" 40462000 T 0676
BEGIN 40463000 T 0680
PUTTEXT("WEEKDA"); 40464000 T 0681
CURTYPE:=ALFATYPE; INSYMBOL; 40465000 T 0688
END ELSE IF CURNAME1="400USER" THEN % "USER" 40466000 T 0689
BEGIN 40467000 T 0692
PUTTEXT(" TIME"); PUTTEXT(" (-1)"); 40468000 T 0693
CURTYPE:=ALFATYPE; INSYMBOL; 40469000 T 0707
END ELSE % "SIN","COS" ETC. 40470000 T 0708
BEGIN 40471000 T 0708
PUTTEXT(IF CURNAME1="3000SIN" THEN " SIN" ELSE 40472000 T 0711
IF CURNAME1="3000COS" THEN " COS" ELSE 40473000 T 0711
IF CURNAME1="6ARCTAN" THEN "ARCTAN" ELSE 40474000 T 0711
IF CURNAME1="400SQRT" THEN " SQRT" ELSE 40475000 T 0711
IF CURNAME1="3000EXP" THEN " EXP" ELSE 40476000 T 0711
" LN"); 40477000 T 0711
PARAMETER; 40478000 T 0726
IF CURTYPE!REALTYPE AND CURTYPE!INTTYPE THEN ERROR(67); 40479000 T 0764
CURTYPE:=REALTYPE; 40480000 T 0767
END; 40481000 T 0768
END OF INTRINSIC FUNCTIONS ELSE 40482000 T 0768
13 IS 783 LONG, NEXT SEG 12
BEGIN 40483000 T 0074
T:=THISID.TYPE; 40484000 T 0074
PASSPARAMS; 40485000 T 0075
CURTYPE:=T; 40486000 T 0076
END; 40487000 T 0077
END OF FUNCTIONS ELSE 40488000 T 0077
IF THISID.IDCLASS=PROC THEN 40489000 T 0077
BEGIN 40490000 T 0078
ERROR(68); PASSPARAMS; 40491000 T 0079
CURTYPE:=0; 40492000 T 0080
END ELSE BEGIN ERROR(69); CURTYPE:=0; INSYMBOL END; 40493000 T 0081
END ELSE BEGIN ERROR(1); CURTYPE:=0; INSYMBOL END; 40494000 T 0083
END OF IDENTIFIER ELSE 40495000 T 0086
IF CURSY{CHARCONST THEN 40496000 T 0086
BEGIN 40497000 T 0087
CONSTANT(VAL,CURTYPE); PUTCONST(VAL); 40498000 T 0088
END ELSE 40499000 T 0187
IF CURSY=NOTSY THEN 40500000 T 0187
BEGIN 40501000 T 0188
PUTTEXT(" NOT "); PUTDUMMY; STARTSYM:=NUMSYMS; 40502000 T 0189
INSYMBOL; FACTOR; 40503000 T 0203
IF CURTYPE>0 THEN 40504000 T 0204
IF CURTYPE!BOOLTYPE THEN BEGIN ERROR(17); CURTYPE:=0 END; 40505000 T 0205
IF CURMODE=NUMBER THEN 40506000 T 0208
BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")"); 40507000 T 0209
CURMODE:=BITPATTERN; 40508000 T 0220
END; 40509000 T 0221
END ELSE 40510000 T 0221
IF CURSY=NILSY THEN 40511000 T 0221
BEGIN 40512000 T 0222
PUTCONST(0); CURTYPE:=NILTYPE; 40513000 T 0223
INSYMBOL; 40514000 T 0236
END ELSE 40515000 T 0236
IF CURSY=LPAR THEN 40516000 T 0236
BEGIN 40517000 T 0238
PUTSYM("("); 40518000 T 0238
INSYMBOL; EXPRESSION; 40519000 T 0246
IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 40520000 T 0247
PUTSYM(")"); 40521000 T 0249
INSYMBOL; 40522000 T 0257
END ELSE 40523000 T 0257
IF CURSY=LBRACKET THEN %*** SET CONSTANT *** 40524000 T 0257
BEGIN 40525000 T 0259
INSYMBOL; 40526000 T 0259
IF CURSY=RBRACKET THEN 40527000 T 0260
BEGIN 40528000 T 0260
PUTCONST(0); CURTYPE:=EMPTYSET; CURMODE:=NUMBER; 40529000 T 0261
INSYMBOL; 40530000 T 0276
END ELSE 40531000 T 0276
BEGIN 40532000 T 0276
FIRST:=TRUE; 40533000 T 0277
DO BEGIN 40534000 T 0277
IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 40535000 T 0277
PUTTEXT(" BIT("); STARTSYM:=NUMSYMS; 40536000 T 0280
EXPRESSION; 40537000 T 0286
IF STYPE=0 THEN 40538000 T 0287
BEGIN STYPE:=CURTYPE; 40539000 T 0288
IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(72); 40540000 T 0289
END ELSE CHECKTYPES(STYPE,CURTYPE); 40541000 T 0292
IF CURSY=DOUBLEDOT THEN 40542000 T 0352
BEGIN 40543000 T 0352
PUTSYM(","); SYMTAB[STARTSYM]:=" BITS("; 40544000 T 0353
INSYMBOL; EXPRESSION; 40545000 T 0362
IF STYPE=0 THEN 40546000 T 0363
BEGIN STYPE:=CURTYPE; 40547000 T 0363
IF TYPETAB1[CURTYPE].FORM>CHAR THEN ERROR(72); 40548000 T 0365
END ELSE CHECKTYPES(STYPE,CURTYPE); 40549000 T 0367
END; 40550000 T 0428
PUTSYM(","); PUTCONST(CARDCNT); PUTSYM(")"); 40551000 T 0428
IF CURSY=COMMA THEN PUTTEXT(" OR"); 40552000 T 0456
END UNTIL CURSY!COMMA; 40553000 T 0463
IF CURSY!RBRACKET THEN 40554000 T 0464
BEGIN ERROR(59); SKIP(RBRACKET); 40555000 T 0465
IF CURSY=RBRACKET THEN INSYMBOL; 40556000 T 0467
END ELSE INSYMBOL; 40557000 T 0468
NEWTYPE; T1:=SET; T1.SIZE:=1; T1.STRUCT:=0; 40558000 T 0471
T1.SETTYPE:=STYPE; TYPETAB1[TYPEINDEX]:=T1; 40559000 T 0480
CURTYPE:=TYPEINDEX; 40560000 T 0483
CURMODE:=BITPATTERN; 40561000 T 0484
END; 40562000 T 0485
END OF SET CONSTANT ELSE BEGIN ERROR(99); INSYMBOL END; 40563000 T 0485
END OF FACTOR; 40564000 T 0487
12 IS 493 LONG, NEXT SEG 2
40565000 T 0368
40566000 T 0368
PROCEDURE TERM; %*** TERM *** 40567000 T 0368
BEGIN %************ 40568000 T 0368
INTEGER STARTSYM,MODE,TYPE1,MULOPTR,F; 40569000 T 0368
START OF SEGMENT ********** 14
PUTDUMMY; STARTSYM:=NUMSYMS; 40570000 T 0000
FACTOR; 40571000 T 0006
MODE:=CURMODE; 40572000 T 0007
WHILE CURSY}ASTERISK AND CURSY{MODSY DO % "*","/","DIV","MOD","AND" 40573000 T 0007
BEGIN 40574000 T 0010
TYPE1:=CURTYPE; MULOPTR:=CURSY; 40575000 T 0010
F:=TYPETAB1[TYPE1].FORM; 40576000 T 0011
IF F=NUMERIC OR F=FLOATING THEN 40577000 T 0013
BEGIN 40578000 T 0014
MODE:=NUMBER; 40579000 T 0015
IF CURSY=ASTERISK THEN PUTSYM("|") ELSE 40580000 T 0016
IF CURSY=SLASH THEN PUTSYM("/") ELSE 40581000 T 0026
IF CURSY=ANDSY THEN ERROR(64) ELSE 40582000 T 0035
BEGIN 40583000 T 0038
IF F=FLOATING THEN ERROR(64); 40584000 T 0038
IF CURSY=DIVSY THEN PUTTEXT(" DIV") ELSE PUTTEXT(" MOD"); 40585000 T 0040
END END ELSE 40586000 T 0055
IF CURTYPE=BOOLTYPE OR F=SET THEN 40587000 T 0055
BEGIN 40588000 T 0059
MODE:=BITPATTERN; 40589000 T 0060
IF CURMODE!MODE THEN 40590000 T 0061
BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40591000 T 0061
PUTTEXT(" AND "); 40592000 T 0072
IF CURSY!(IF F=SET THEN ASTERISK ELSE ANDSY) THEN ERROR(64); 40593000 T 0078
END ELSE ERROR(64); 40594000 T 0082
PUTDUMMY; STARTSYM:=NUMSYMS; 40595000 T 0084
INSYMBOL; FACTOR; 40596000 T 0091
IF CURTYPE>0 AND TYPE1>0 THEN 40597000 T 0092
BEGIN 40598000 T 0094
IF CURTYPE!TYPE1 THEN 40599000 T 0094
BEGIN 40600000 T 0095
IF TYPETAB1[TYPE1].FORM!NUMERIC OR CURTYPE!REALTYPE THEN 40601000 T 0095
CHECKTYPES(TYPE1,CURTYPE); 40602000 T 0098
IF TYPE1=REALTYPE THEN CURTYPE:=REALTYPE; 40603000 T 0158
END; 40604000 T 0160
IF CURTYPE=REALTYPE AND MULOPTR}DIVSY THEN ERROR(65); 40605000 T 0160
END; 40606000 T 0163
IF MULOPTR=SLASH THEN CURTYPE:=REALTYPE; 40607000 T 0163
IF CURTYPE=0 THEN CURTYPE:=TYPE1; 40608000 T 0165
END OF WHILE LOOP; 40609000 T 0167
IF MODE=BITPATTERN AND CURMODE!MODE THEN 40610000 T 0167
BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40611000 T 0169
CURMODE:=MODE; 40612000 T 0179
END OF TERM; 40613000 T 0180
14 IS 184 LONG, NEXT SEG 2
40614000 T 0368
40615000 T 0368
PROCEDURE SIMPLEEXPRESSION; %*** SIMPLE EXPRESSION *** 40616000 T 0368
BEGIN %************************* 40617000 T 0368
INTEGER STARTSYM,MODE,TYPE1,F; 40618000 T 0368
START OF SEGMENT ********** 15
BOOLEAN SIGNED; 40619000 T 0000
40620000 T 0000
PUTDUMMY; STARTSYM:=NUMSYMS; 40621000 T 0000
IF CURSY=PLUS OR CURSY=MINUS THEN 40622000 T 0006
BEGIN SIGNED:=TRUE; 40623000 T 0008
PUTSYM(IF CURSY=PLUS THEN"+" ELSE "-"); 40624000 T 0009
INSYMBOL; 40625000 T 0020
END; 40626000 T 0021
TERM; 40627000 T 0021
MODE:=CURMODE; 40628000 T 0021
IF SIGNED THEN 40629000 T 0022
BEGIN F:=TYPETAB1[CURTYPE].FORM; 40630000 T 0022
IF F!NUMERIC AND F!FLOATING THEN ERROR(29); 40631000 T 0024
END; 40632000 T 0027
WHILE CURSY}PLUS AND CURSY{ORSY DO % "+","-","OR" 40633000 T 0027
BEGIN 40634000 T 0029
TYPE1:=CURTYPE; F:=TYPETAB1[TYPE1].FORM; 40635000 T 0029
IF F=NUMERIC OR F=FLOATING THEN 40636000 T 0032
BEGIN MODE:=NUMBER; 40637000 T 0033
IF CURSY=PLUS THEN PUTSYM("+") ELSE 40638000 T 0035
IF CURSY=MINUS THEN PUTSYM("-") ELSE ERROR(64); 40639000 T 0043
END ELSE 40640000 T 0054
IF CURTYPE=BOOLTYPE THEN 40641000 T 0054
BEGIN 40642000 T 0055
MODE:=BITPATTERN; 40643000 T 0056
IF CURMODE!MODE THEN 40644000 T 0056
BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40645000 T 0057
IF CURSY=ORSY THEN PUTTEXT(" OR") ELSE ERROR(64); 40646000 T 0068
END ELSE 40647000 T 0077
IF F=SET THEN 40648000 T 0077
BEGIN 40649000 T 0079
MODE:=BITPATTERN; 40650000 T 0079
IF CURMODE!MODE THEN 40651000 T 0080
BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")"); END; 40652000 T 0081
IF CURSY=PLUS THEN PUTTEXT(" OR") ELSE 40653000 T 0091
IF CURSY=MINUS THEN BEGIN PUTTEXT(" AND");PUTTEXT(" NOT ")END 40654000 T 0098
ELSE ERROR(64); 40655000 T 0114
END ELSE ERROR(64); 40656000 T 0116
INSYMBOL; 40657000 T 0118
PUTDUMMY; STARTSYM:=NUMSYMS; 40658000 T 0118
TERM; 40659000 T 0125
IF CURTYPE>0 AND TYPE1>0 THEN 40660000 T 0125
BEGIN 40661000 T 0127
IF CURTYPE!TYPE1 THEN 40662000 T 0127
BEGIN 40663000 T 0128
IF TYPETAB1[TYPE1].FORM!NUMERIC OR CURTYPE!REALTYPE THEN 40664000 T 0129
CHECKTYPES(TYPE1,CURTYPE); 40665000 T 0131
IF TYPE1=REALTYPE THEN CURTYPE:=REALTYPE; 40666000 T 0191
END END; 40667000 T 0193
IF CURTYPE=0 THEN CURTYPE:=TYPE1; 40668000 T 0193
END OF WHILE LOOP; 40669000 T 0195
IF MODE=BITPATTERN AND CURMODE!BITPATTERN THEN 40670000 T 0195
BEGIN SYMTAB[STARTSYM]:=" B("; PUTSYM(")") END; 40671000 T 0197
CURMODE:=MODE; 40672000 T 0207
END OF SIMPLEEXPRESSION; 40673000 T 0208
15 IS 212 LONG, NEXT SEG 2
40674000 T 0368
40675000 T 0368
PROCEDURE EXPRESSION; %*** EXPRESSION *** 40676000 T 0368
BEGIN %****************** 40677000 T 0368
INTEGER STARTSYM,FIRSTSYM,TYPE1,RELOPTR,F; 40678000 T 0368
START OF SEGMENT ********** 16
BOOLEAN CALLGEN; 40679000 T 0000
40680000 T 0000
EXPRLEVEL:=EXPRLEVEL+1; 40681000 T 0000
IF EXPRLEVEL = 1 THEN 40682000 T 0001
BEGIN 40683000 T 0002
PUTDUMMY; 40684000 T 0002
FIRSTSYM := NUMSYMS; 40685000 T 0008
END; 40686000 T 0009
PUTDUMMY; STARTSYM:=NUMSYMS; 40687000 T 0009
PUTDUMMY; 40688000 T 0017
SIMPLEEXPRESSION; 40689000 T 0024
IF CURSY}LSSSY AND CURSY{INSY THEN % "<","{","}",">","=","!","IN" 40690000 T 0025
BEGIN 40691000 T 0026
TYPE1:=CURTYPE; F:=TYPETAB1[TYPE1].FORM; 40692000 T 0027
RELOPTR:=CURSY; 40693000 T 0029
IF F{ALFA THEN 40694000 T 0030
BEGIN 40695000 T 0031
IF CURMODE=BITPATTERN THEN 40696000 T 0031
BEGIN SYMTAB[STARTSYM]:=" REAL("; PUTSYM(")") END; 40697000 T 0032
IF CURSY=LSSSY THEN PUTSYM("<") ELSE 40698000 T 0043
IF CURSY=LEQSY THEN PUTSYM("{") ELSE 40699000 T 0052
IF CURSY=GEQSY THEN PUTSYM("}") ELSE 40700000 T 0061
IF CURSY=GTRSY THEN PUTSYM(">") ELSE 40701000 T 0070
IF CURSY=EQLSY THEN PUTSYM("=") ELSE 40702000 T 0080
IF CURSY=NEQSY THEN PUTSYM("!") ELSE 40703000 T 0089
BEGIN 40704000 T 0098
IF F}FLOATING THEN ERROR(64); 40705000 T 0099
SYMTAB[STARTSYM]:="INTST("; PUTSYM(","); CALLGEN:=TRUE; 40706000 T 0101
END; 40707000 T 0112
END ELSE 40708000 T 0112
IF F=SET THEN 40709000 T 0112
BEGIN 40710000 T 0113
IF CURMODE=BITPATTERN THEN 40711000 T 0114
BEGIN SYMTAB[STARTSYM+1]:=" REAL("; PUTSYM(")") END; 40712000 T 0114
IF CURSY=EQLSY OR CURSY=NEQSY THEN 40713000 T 0125
BEGIN PUTSYM(IF CURSY=EQLSY THEN "=" ELSE "!"); 40714000 T 0127
END ELSE 40715000 T 0137
BEGIN 40716000 T 0137
IF CURSY=LEQSY THEN SYMTAB[STARTSYM]:="INCL1(" ELSE 40717000 T 0137
IF CURSY=GEQSY THEN SYMTAB[STARTSYM]:="INCL2(" ELSE ERROR(64); 40718000 T 0140
PUTSYM(","); CALLGEN:=TRUE; 40719000 T 0146
END END ELSE 40720000 T 0155
IF F=POINTERS THEN 40721000 T 0155
BEGIN 40722000 T 0156
IF CURSY=EQLSY THEN PUTSYM("=") ELSE 40723000 T 0156
IF CURSY=NEQSY THEN PUTSYM("!") ELSE ERROR(64); 40724000 T 0165
END ELSE ERROR(64); 40725000 T 0176
INSYMBOL; 40726000 T 0177
PUTDUMMY; STARTSYM:=NUMSYMS; 40727000 T 0177
SIMPLEEXPRESSION; 40728000 T 0184
IF CURTYPE>0 AND TYPE1>0 THEN 40729000 T 0184
IF CURTYPE!TYPE1 THEN 40730000 T 0186
IF RELOPTR!INSY THEN 40731000 T 0187
BEGIN 40732000 T 0189
IF TYPETAB1[TYPE1].FORM!NUMERIC OR CURTYPE!REALTYPE THEN 40733000 T 0189
CHECKTYPES(TYPE1,CURTYPE); 40734000 T 0192
END ELSE 40735000 T 0252
IF TYPETAB1[CURTYPE].FORM!SET THEN ERROR(66) 40736000 T 0252
ELSE CHECKTYPES(TYPE1,TYPETAB1[CURTYPE].SETTYPE); 40737000 T 0254
IF CURMODE=BITPATTERN THEN 40738000 T 0316
BEGIN SYMTAB[STARTSYM]:=" REAL("; PUTSYM(")") END; 40739000 T 0316
IF CALLGEN THEN PUTSYM(")"); 40740000 T 0327
CURTYPE:=BOOLTYPE; CURMODE:=BITPATTERN; 40741000 T 0335
END; 40742000 T 0337
EXPRLEVEL:=EXPRLEVEL-1; 40743000 T 0337
IF EXPRLEVEL=0 THEN 40744000 T 0339
BEGIN 40745000 T 0340
IF CURMODE=BITPATTERN THEN 40746000 T 0340
BEGIN 40747000 T 0341
SYMTAB[FIRSTSYM] := " REAL("; 40748000 T 0341
PUTSYM(")"); 40749000 T 0343
END; 40750000 T 0351
WRITEEXPR; 40751000 T 0351
END; 40752000 T 0429
END OF EXPRESSION; 40753000 T 0429
16 IS 436 LONG, NEXT SEG 2
40754000 T 0368
40755000 T 0368
DEFINE BOOLEXPR= 40756000 T 0368
BEGIN 40757000 T 0368
PUTDUMMY; EXPRLEVEL:=1; EXPRESSION; 40758000 T 0368
IF CURTYPE>0 THEN IF CURTYPE!BOOLTYPE THEN ERROR(17); 40759000 T 0368
IF CURMODE!BITPATTERN THEN 40760000 T 0368
BEGIN SYMTAB[1]:=" B("; PUTSYM(")") END; 40761000 T 0368
EXPRLEVEL:=0; WRITEEXPR; 40762000 T 0368
END OF BOOLEAN#; 40763000 T 0368
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50001000 T 0368
% % 50002000 T 0368
% % 50003000 T 0368
% % 50004000 T 0368
% PART 5: INTRINSIC ROUTINES. % 50005000 T 0368
% ------------------- % 50006000 T 0368
% % 50007000 T 0368
% % 50008000 T 0368
% % 50009000 T 0368
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50010000 T 0368
50011000 T 0368
50012000 T 0368
PROCEDURE CONCAT; %*** "CONCAT" *** 50013000 T 0368
BEGIN %**************** 50014000 T 0368
DEFINE INTEXPR= 50015000 T 0368
START OF SEGMENT ********** 17
BEGIN INSYMBOL; EXPRESSION; 50016000 T 0000
IF CURTYPE>0 THEN 50017000 T 0000
IF TYPETAB1[CURTYPE].FORM!NUMERIC THEN ERROR(17); 50018000 T 0000
END #; 50019000 T 0000
50020000 T 0000
PUTTEXT("CONCAT"); PUTSYM("("); 50021000 T 0000
INSYMBOL; 50022000 T 0014
IF CURSY=LPAR THEN 50023000 T 0015
BEGIN 50024000 T 0015
INSYMBOL; EXPRESSION; 50025000 T 0016
IF CURTYPE>0 THEN 50026000 T 0017
IF TYPETAB1[CURTYPE].FORM>ALFA THEN ERROR(17); 50027000 T 0018
IF CURSY=COMMA THEN 50028000 T 0021
BEGIN 50029000 T 0022
PUTSYM(","); INSYMBOL; EXPRESSION; 50030000 T 0022
IF CURTYPE>0 THEN 50031000 T 0031
IF TYPETAB1[CURTYPE].FORM>ALFA THEN ERROR(17); 50032000 T 0031
IF CURSY=COMMA THEN 50033000 T 0035
BEGIN 50034000 T 0035
PUTSYM(","); INTEXPR; 50035000 T 0036
IF CURSY=COMMA THEN 50036000 T 0048
BEGIN 50037000 T 0049
PUTSYM(","); INTEXPR; 50038000 T 0050
IF CURSY=COMMA THEN 50039000 T 0062
BEGIN 50040000 T 0063
PUTSYM(","); INTEXPR; 50041000 T 0063
PUTSYM(","); PUTCONST(CARDCNT); 50042000 T 0076
PUTSYM(")"); 50043000 T 0096
IF CURSY!RPAR THEN BEGIN ERROR(3); SKIP(RPAR) END; 50044000 T 0104
END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50045000 T 0106
END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50046000 T 0108
END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50047000 T 0110
END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50048000 T 0112
END ELSE BEGIN ERROR(3); SKIP(RPAR) END; 50049000 T 0114
CURTYPE:=REALTYPE; 50050000 T 0116
IF CURSY=RPAR THEN INSYMBOL; 50051000 T 0117
END OF CONCAT; 50052000 T 0119
17 IS 120 LONG, NEXT SEG 2
50053000 T 0368
50054000 T 0368
PROCEDURE PREAD(CHANGELINE); 50055000 T 0368
VALUE CHANGELINE; BOOLEAN CHANGELINE; 50056000 T 0368
BEGIN 50057000 T 0368
INTEGER FILEID,F; 50058000 T 0368
START OF SEGMENT ********** 18
BOOLEAN CHECK; 50059000 T 0000
GEN(" BEGIN",7,2); 50060000 T 0000
FILEPARAM(INPUTFILE); FILEID:=FILENAME; 50061000 T 0009
IF TYPETAB1[CURTYPE].FORM=FILES THEN ERROR(85); 50062000 T 0061
IF SYMKIND[CURSY]!TERMINAL THEN 50063000 T 0064
BEGIN 50064000 T 0065
IF CURSY NEQ RPAR THEN 50065000 T 0065
DO BEGIN 50066000 T 0066
WHILE CURSY=COMMA DO INSYMBOL; 50067000 T 0066
IF CURSY=IDENTIFIER THEN 50068000 T 0069
BEGIN 50069000 T 0069
SEARCH; 50070000 T 0070
IF FOUND THEN 50071000 T 0097
BEGIN 50072000 T 0098
IF THISID.IDCLASS=VAR OR 50073000 T 0098
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 50074000 T 0099
BEGIN 50075000 T 0102
VARIABLE; F:=TYPETAB1[CURTYPE].FORM; 50076000 T 0102
IF F=NUMERIC OR F=FLOATING OR F=CHAR THEN 50077000 T 0104
BEGIN 50078000 T 0107
CHECK:=CHECKOPTION AND F!FLOATING; 50079000 T 0108
WRITEEXPR; GEN(":=",2,6); 50080000 T 0109
IF CHECK THEN GEN("CHECK(",6,2); 50081000 T 0196
GEN("PREAD(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 50082000 T 0205
GENID("V",FILEID,5); GEN(",",1,7); 50083000 T 0235
GENID("I",FILEID,5); GEN(",",1,7); 50084000 T 0255
IF F=NUMERIC THEN GENINT(2) ELSE 50085000 T 0276
IF F=FLOATING THEN GENINT(3) ELSE GENINT(1); 50086000 T 0322
GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50087000 T 0409
IF CHECK THEN 50088000 T 0469
BEGIN 50089000 T 0470
GEN(",",1,7); GENINT(TYPETAB2[CURTYPE]); GEN(",",1,7); 50090000 T 0470
GENINT(TYPETAB3[CURTYPE]); GEN(",",1,7); 50091000 T 0530
GENINT(CARDCNT); GEN(")",1,7); 50092000 T 0582
END; 50093000 T 0633
END ELSE BEGIN ERROR(82); INSYMBOL END; 50094000 T 0633
END ELSE BEGIN ERROR(8); INSYMBOL END; 50095000 T 0636
END ELSE BEGIN ERROR(1); INSYMBOL END; 50096000 T 0639
END ELSE ERROR(9); 50097000 T 0642
GEN(";",1,7); 50098000 T 0644
END UNTIL CURSY!COMMA; 50099000 T 0653
IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50100000 T 0655
IF CURSY=RPAR THEN INSYMBOL; 50101000 T 0657
END; 50102000 T 0659
IF CHANGELINE THEN 50103000 T 0659
BEGIN 50104000 T 0659
GEN("RLINE(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 50105000 T 0660
GENID("V",FILEID,5); GEN(",",1,7); 50106000 T 0689
GENID("I",FILEID,5); GEN(")",1,7); 50107000 T 0710
END; 50108000 T 0730
GEN("END",4,5); 50109000 T 0730
END OF PREAD; 50110000 T 0739
18 IS 756 LONG, NEXT SEG 2
50111000 T 0368
50112000 T 0368
PROCEDURE PWRITE(LINEFEED); 50113000 T 0368
VALUE LINEFEED; BOOLEAN LINEFEED; 50114000 T 0368
BEGIN 50115000 T 0368
INTEGER FILEID,F,I,LASTSY; 50116000 T 0368
START OF SEGMENT ********** 19
POINTER P; 50117000 T 0000
GEN(" BEGIN",7,2); 50118000 T 0000
FILEPARAM(OUTPUTFILE); FILEID:=FILENAME; 50119000 T 0009
IF TYPETAB1[CURTYPE].FORM=FILES THEN ERROR(85); 50120000 T 0061
IF SYMKIND[CURSY]!TERMINAL THEN 50121000 T 0064
BEGIN 50122000 T 0065
IF CURSY NEQ RPAR THEN 50123000 T 0065
DO BEGIN 50124000 T 0066
WHILE CURSY=COMMA DO INSYMBOL; 50125000 T 0066
IF CURSY=ALFACONST AND CURLENGTH>7 THEN 50126000 T 0069
BEGIN 50127000 T 0070
GEN("WALFA(",6,2); GENID("F",FILEID,5); GEN(",",1,7); 50128000 T 0071
GENID("V",FILEID,5); GEN(",",1,7); 50129000 T 0100
GENID("I",FILEID,5); GEN(",",1,7); 50130000 T 0121
P:=STRINGPNT; 50131000 T 0141
FOR I:=1 STEP 7 UNTIL 80 DO 50132000 T 0142
IF I{CURLENGTH THEN 50133000 T 0145
BEGIN 50134000 T 0145
IF ALGOLCNT<10 THEN WRITEALGOL; 50135000 T 0146
REPLACE ALGOLPNT:ALGOLPNT BY """, P:P FOR 7, """, ","; 50136000 T 0148
ALGOLCNT:=ALGOLCNT-10; 50137000 T 0159
END ELSE GEN("0,",2,6); 50138000 T 0161
GENINT(CURLENGTH); GEN(",",1,7); 50139000 T 0172
GENINT(CARDCNT); GEN(")",1,7); 50140000 T 0223
INSYMBOL; 50141000 T 0274
END OF ALFACONST ELSE 50142000 T 0275
BEGIN 50143000 T 0275
GEN("PWRITE(",7,1); GENID("F",FILEID,5); GEN(",",1,7); 50144000 T 0275
GENID("V",FILEID,5); GEN(",",1,7); 50145000 T 0305
GENID("I",FILEID,5); GEN(",",1,7); 50146000 T 0325
LASTSY:=CURSY; 50147000 T 0346
EXPRESSION; F:=TYPETAB1[CURTYPE].FORM; 50148000 T 0347
GEN(",",1,7); 50149000 T 0349
IF F=NUMERIC OR F=FLOATING OR F=CHAR OR F=ALFA OR 50150000 T 0358
CURTYPE=BOOLTYPE THEN 50151000 T 0361
BEGIN 50152000 T 0362
IF F=NUMERIC THEN GENINT(1) ELSE 50153000 T 0363
IF F=FLOATING THEN GENINT(2) ELSE 50154000 T 0407
IF F=ALFA THEN GENINT(5) ELSE 50155000 T 0451
IF F=CHAR THEN GENINT(4) ELSE GENINT(3); 50156000 T 0495
GEN(",",1,7); 50157000 T 0582
IF CURSY=COLON THEN 50158000 T 0591
BEGIN 50159000 T 0592
INSYMBOL; EXPRESSION; 50160000 T 0593
IF TYPETAB1[CURTYPE].FORM NEQ NUMERIC THEN ERROR(17); 50161000 T 0594
GEN(",",1,7); 50162000 T 0596
IF CURSY=COLON THEN 50163000 T 0605
BEGIN 50164000 T 0606
IF F!FLOATING THEN ERROR(4); 50165000 T 0607
INSYMBOL; EXPRESSION; 50166000 T 0609
IF TYPETAB1[CURTYPE].FORM NEQ NUMERIC THEN ERROR(17); 50167000 T 0610
GEN(",",1,7); 50168000 T 0612
END ELSE GEN("-1,",3,5); 50169000 T 0621
END ELSE 50170000 T 0631
BEGIN 50171000 T 0631
IF F=FLOATING THEN GENINT(16) ELSE 50172000 T 0633
IF F=ALFA AND LASTSY=ALFACONST THEN GENINT(CURLENGTH) ELSE 50173000 T 0676
IF F=ALFA THEN GENINT(7) ELSE 50174000 T 0721
IF F=CHAR THEN GENINT(1) ELSE GENINT(10); 50175000 T 0765
GEN(",-1,",4,4); 50176000 T 0852
END; 50177000 T 0861
END ELSE ERROR(17); 50178000 T 0861
GENINT(CARDCNT); GEN(")",1,7); 50179000 T 0864
END OF EXPRESSION; 50180000 T 0915
GEN(";",1,7); 50181000 T 0915
END UNTIL CURSY!COMMA; 50182000 T 0926
IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50183000 T 0927
IF CURSY=RPAR THEN INSYMBOL; 50184000 T 0930
END; 50185000 T 0931
FILENAME:=FILEID; 50186000 T 0931
IF LINEFEED THEN 50187000 T 0932
BEGIN 50188000 T 0932
INTEGER DUMMY; 50189000 T 0933
START OF SEGMENT ********** 20
GEN("WLINE(",6,2); GENID("F",FILENAME,5); GEN(",",1,7); 50190000 T 0000
GENID("V",FILENAME,5); GEN(",",1,7); 50191000 T 0029
GENID("I",FILENAME,5); GEN(")",1,7); 50192000 T 0050
END; 50193000 T 0070
20 IS 72 LONG, NEXT SEG 19
GEN("END",4,5); 50194000 T 0934
END OF PWRITE; 50195000 T 0943
19 IS 955 LONG, NEXT SEG 2
50196000 T 0368
50197000 T 0368
PROCEDURE FILEHANDLING(PROCNUM); %*** FILE HANDLING PROCEDURES: 50198000 T 0368
VALUE PROCNUM; INTEGER PROCNUM; %*** 50199000 T 0368
BEGIN %*** 1) PUT 50200000 T 0368
INTEGER F; %*** 2) GET 50201000 T 0368
START OF SEGMENT ********** 21
CASE PROCNUM OF %*** 3) RESET 50202000 T 0000
BEGIN ; %*** 4) REWRITE 50203000 T 0000
GEN("PUT",3,5); %*** 5) PAGE 50204000 T 0000
GEN("GET",3,5); % 50205000 T 0010
GEN("RESET",5,3); % 50206000 T 0019
GEN("REWRITE",7,1); % 50207000 T 0029
GEN("PAGE",4,4); % 50208000 T 0038
END; % 50209000 T 0048
START OF SEGMENT ********** 22
22 IS 6 LONG, NEXT SEG 21
GEN("(",1,7); FILEPARAM(0); % 50210000 T 0048
IF FILENAME=0 THEN ERROR(78); % 50211000 T 0112
F:=TYPETAB1[CURTYPE].FORM; 50212000 T 0114
IF F=FILES AND PROCNUM=5 THEN ERROR(80); 50213000 T 0116
GENID("F",FILENAME,5); GEN(",",1,7); 50214000 T 0119
GENID("V",FILENAME,5); GEN(",",1,7); 50215000 T 0139
GENID("I",FILENAME,5); GEN(",",1,7); 50216000 T 0160
GENINT(CARDCNT); GEN(")",1,7); 50217000 T 0180
IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50218000 T 0231
IF CURSY=RPAR THEN INSYMBOL; 50219000 T 0234
END OF FILEHANDLING; 50220000 T 0236
21 IS 239 LONG, NEXT SEG 2
50221000 T 0368
50222000 T 0368
PROCEDURE PACK; 50223000 T 0368
BEGIN 50224000 T 0368
INTEGER IT,T; 50225000 T 0368
START OF SEGMENT ********** 23
GEN("PACK(",5,3); 50226000 T 0000
INSYMBOL; 50227000 T 0009
IF CURSY=LPAR THEN 50228000 T 0009
BEGIN 50229000 T 0010
INSYMBOL; 50230000 T 0010
IF CURSY=IDENTIFIER THEN 50231000 T 0011
BEGIN 50232000 T 0012
SEARCH; 50233000 T 0012
IF FOUND THEN 50234000 T 0041
BEGIN 50235000 T 0042
IF THISID.IDCLASS=VAR THEN 50236000 T 0042
BEGIN 50237000 T 0043
T:=TYPETAB1[THISID.TYPE]; 50238000 T 0044
IF T.FORM=ARRAYS THEN 50239000 T 0045
BEGIN 50240000 T 0047
IT:=T.INXTYPE; 50241000 T 0047
IF TYPETAB1[T.ARRTYPE].FORM!CHAR THEN ERROR(88); 50242000 T 0048
GENID("V",1000|THISLEVEL+THISINDEX,5); 50243000 T 0052
IF THISLEVEL>1 AND THISLEVEL!CURLEVEL THEN ERROR(5); 50244000 T 0064
GEN(",",1,7); GENINT(TYPETAB2[THISID.TYPE]); 50245000 T 0067
GEN(",",1,7); GENINT(TYPETAB3[THISID.TYPE]); 50246000 T 0119
END ELSE ERROR(88); 50247000 T 0172
END ELSE ERROR(88); 50248000 T 0174
END ELSE ERROR(1); 50249000 T 0175
END ELSE ERROR(9); 50250000 T 0176
INSYMBOL; 50251000 T 0177
IF CURSY=COMMA THEN 50252000 T 0178
BEGIN 50253000 T 0179
GEN(",",1,7); 50254000 T 0179
INSYMBOL; EXPRESSION; CHECKTYPES(IT,CURTYPE); 50255000 T 0188
IF CURSY=COMMA THEN 50256000 T 0247
BEGIN 50257000 T 0248
GEN(",",1,7); 50258000 T 0248
INSYMBOL; 50259000 T 0257
IF CURSY=IDENTIFIER THEN 50260000 T 0258
BEGIN 50261000 T 0259
SEARCH; 50262000 T 0259
IF FOUND THEN 50263000 T 0287
BEGIN 50264000 T 0287
IF THISID.IDCLASS=VAR OR 50265000 T 0287
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 50266000 T 0289
BEGIN 50267000 T 0291
VARIABLE; WRITEEXPR; 50268000 T 0292
IF CURTYPE>0 THEN 50269000 T 0370
IF TYPETAB1[CURTYPE].FORM!ALFA THEN ERROR(12); 50270000 T 0370
END ELSE ERROR(8); 50271000 T 0374
END ELSE ERROR(1); 50272000 T 0375
END ELSE ERROR(9); 50273000 T 0376
END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50274000 T 0377
END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50275000 T 0379
IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50276000 T 0381
IF CURSY=RPAR THEN INSYMBOL; 50277000 T 0384
END ELSE BEGIN ERROR(3); INSYMBOL END; 50278000 T 0386
GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50279000 T 0389
END OF PACK; 50280000 T 0449
23 IS 455 LONG, NEXT SEG 2
50281000 T 0368
50282000 T 0368
PROCEDURE UNPACK; 50283000 T 0368
BEGIN 50284000 T 0368
INTEGER IT,T; 50285000 T 0368
START OF SEGMENT ********** 24
GEN("UNPACK(",7,1); INSYMBOL; 50286000 T 0000
IF CURSY=LPAR THEN 50287000 T 0009
BEGIN 50288000 T 0010
INSYMBOL; EXPRESSION; 50289000 T 0010
IF CURTYPE>0 THEN IF TYPETAB1[CURTYPE].FORM!ALFA THEN ERROR(17); 50290000 T 0011
IF CURSY=COMMA THEN 50291000 T 0015
BEGIN 50292000 T 0016
GEN(",",1,7); INSYMBOL; 50293000 T 0017
IF CURSY=IDENTIFIER THEN 50294000 T 0026
BEGIN 50295000 T 0027
SEARCH; 50296000 T 0027
IF FOUND THEN 50297000 T 0056
BEGIN 50298000 T 0057
IF THISID.IDCLASS=VAR THEN 50299000 T 0057
BEGIN 50300000 T 0058
T:=TYPETAB1[THISID.TYPE]; 50301000 T 0059
IF T.FORM=ARRAYS THEN 50302000 T 0060
BEGIN 50303000 T 0062
IT:=T.INXTYPE; 50304000 T 0062
IF TYPETAB1[T.ARRTYPE].FORM!CHAR THEN ERROR(88); 50305000 T 0063
IF THISLEVEL>1 AND THISLEVEL!CURLEVEL THEN ERROR(5); 50306000 T 0067
GENID("V",1000|THISLEVEL+THISINDEX,5); 50307000 T 0070
GEN(",",1,7); GENINT(TYPETAB2[THISID.TYPE]); 50308000 T 0082
GEN(",",1,7); GENINT(TYPETAB3[THISID.TYPE]); 50309000 T 0134
END ELSE ERROR(88); 50310000 T 0187
END ELSE ERROR(88); 50311000 T 0189
END ELSE ERROR(1); 50312000 T 0190
END ELSE ERROR(9); 50313000 T 0191
INSYMBOL; 50314000 T 0192
IF CURSY=COMMA THEN 50315000 T 0193
BEGIN 50316000 T 0194
GEN(",",1,7); 50317000 T 0194
INSYMBOL; EXPRESSION; CHECKTYPES(IT,CURTYPE); 50318000 T 0203
END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50319000 T 0262
END ELSE BEGIN ERROR(89); SKIP(RPAR) END; 50320000 T 0264
IF CURSY!RPAR THEN BEGIN ERROR(89); SKIP(RPAR) END; 50321000 T 0266
IF CURSY=RPAR THEN INSYMBOL; 50322000 T 0269
END ELSE BEGIN ERROR(3); INSYMBOL END; 50323000 T 0271
GEN(",",1,7); GENINT(CARDCNT); GEN(")",1,7); 50324000 T 0273
END OF UNPACK; 50325000 T 0333
24 IS 339 LONG, NEXT SEG 2
50326000 T 0368
50327000 T 0368
PROCEDURE NEWDISP; %*** "NEW","DISPOSE" 50328000 T 0368
BEGIN 50329000 T 0368
INTEGER T1; 50330000 T 0368
START OF SEGMENT ********** 25
IF CURNAME1="3000NEW" THEN GEN("NEW(",4,4) ELSE 50331000 T 0000
BEGIN GEN("DISPOSE",7,1); GEN("(",1,7) END; 50332000 T 0010
INSYMBOL; 50333000 T 0031
IF CURSY=LPAR THEN 50334000 T 0031
BEGIN 50335000 T 0032
INSYMBOL; 50336000 T 0032
IF CURSY=IDENTIFIER THEN 50337000 T 0033
BEGIN 50338000 T 0034
SEARCH; 50339000 T 0034
IF FOUND THEN 50340000 T 0063
BEGIN 50341000 T 0064
VARIABLE; 50342000 T 0064
IF CURTYPE>0 THEN IF TYPETAB1[CURTYPE].FORM=POINTERS THEN 50343000 T 0065
BEGIN 50344000 T 0067
WRITEEXPR; GEN(",",1,7); 50345000 T 0068
T1:=TYPETAB1[CURTYPE].POINTTYPE; 50346000 T 0154
T1:=TYPETAB1[T1].SIZE; 50347000 T 0155
IF T1>1023 THEN ERROR(86); 50348000 T 0157
GENINT(T1); GEN(")",1,7); 50349000 T 0159
END ELSE ERROR(81); 50350000 T 0209
END ELSE BEGIN ERROR(1); INSYMBOL END; 50351000 T 0211
END ELSE ERROR(9); 50352000 T 0212
WHILE CURSY=COMMA DO 50353000 T 0214
BEGIN INSYMBOL; 50354000 T 0215
IF CURSY NEQ IDENTIFIER THEN ERROR(9); 50355000 T 0215
IF CURSY NEQ RPAR THEN INSYMBOL; 50356000 T 0217
END; 50357000 T 0219
END ELSE BEGIN ERROR(58); SKIP(RPAR) END; 50358000 T 0220
IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 50359000 T 0222
IF CURSY=RPAR THEN INSYMBOL; 50360000 T 0224
END OF NEWDISP; 50361000 T 0226
25 IS 229 LONG, NEXT SEG 2
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 60001000 T 0368
% % 60002000 T 0368
% % 60003000 T 0368
% % 60004000 T 0368
% PART 6: THE STATEMENT PARSER. % 60005000 T 0368
% --------------------- % 60006000 T 0368
% % 60007000 T 0368
% % 60008000 T 0368
% % 60009000 T 0368
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 60010000 T 0368
60011000 T 0368
60012000 T 0368
60013000 T 0368
PROCEDURE STATEMENT; FORWARD; 60014000 T 0368
60015000 T 0368
PROCEDURE ASSIGNMENT; 60016000 T 0368
BEGIN 60017000 T 0368
INTEGER LEFTTYPE; 60018000 T 0368
START OF SEGMENT ********** 26
LABEL ASSIGN,EXIT; 60019000 T 0000
IF FOUND THEN 60050000 T 0000
BEGIN 60051000 T 0000
IF THISID.IDCLASS=VAR OR 60052000 T 0000
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 60053000 T 0002
BEGIN 60054000 T 0004
VARIABLE; LEFTTYPE:=CURTYPE; 60055000 T 0005
ASSIGN: IF CURSY!ASSIGNSY THEN 60056000 T 0006
BEGIN ERROR(28); SKIP(ASSIGNSY); 60057000 T 0007
IF SYMKIND[CURSY]=TERMINAL THEN GO TO EXIT; 60058000 T 0009
END; 60059000 T 0011
INSYMBOL; 60060000 T 0011
IF TYPETAB1[LEFTTYPE].STRUCT>0 THEN 60061000 T 0011
BEGIN 60062000 T 0013
ERROR(95); 60063000 T 0013
END ELSE 60080000 T 0014
BEGIN 60081000 T 0014
WRITEEXPR; GEN(":=",2,6); 60082000 T 0015
IF CHECKOPTION AND TYPETAB1[LEFTTYPE].FORM{CHAR THEN 60083000 T 0101
CHECKEXPR(TYPETAB2[LEFTTYPE],TYPETAB3[LEFTTYPE]) ELSE 60084000 T 0103
EXPRESSION; 60085000 T 0181
WRITEEXPR; 60086000 T 0182
CHECKTYPES(LEFTTYPE,CURTYPE); 60087000 T 0259
END; 60088000 T 0317
END ELSE 60089000 T 0317
BEGIN % FUNCTION ASSIGNMENT. 60090000 T 0317
IF THISLEVEL!CURLEVEL-1 OR THISINDEX!CURFUNC THEN ERROR(5); 60091000 T 0318
GENID("V",1000|THISLEVEL+THISINDEX,5); LEFTTYPE:=THISID.TYPE; 60092000 T 0321
INSYMBOL; GO TO ASSIGN; 60093000 T 0335
END; 60094000 T 0336
END ELSE 60095000 T 0336
BEGIN 60096000 T 0336
SKIP(ASSIGNSY); 60097000 T 0338
IF CURSY=ASSIGNSY THEN GO TO ASSIGN; 60098000 T 0338
END; 60099000 T 0340
EXIT: 60100000 T 0340
END OF ASSIGNMENT; 60101000 T 0340
26 IS 347 LONG, NEXT SEG 2
60102000 T 0368
60103000 T 0368
PROCEDURE COMPSTAT; 60104000 T 0368
BEGIN 60105000 T 0368
INTEGER BEGINNUM; 60106000 T 0368
START OF SEGMENT ********** 27
LABEL STATM; 60107000 T 0000
60108000 T 0000
BEGINNUM:=NUMBEGINS:=NUMBEGINS+1; MARGIN(" B",BEGINNUM); 60109000 T 0000
GEN("BEGIN",6,3); 60110000 T 0019
DO BEGIN 60111000 T 0028
IF CURSY=SEMICOLON OR CURSY=BEGINSY THEN INSYMBOL; 60112000 T 0028
STATM: STATEMENT; 60113000 T 0031
GEN(";",1,7); 60114000 T 0032
IF CURSY=ELSESY THEN BEGIN ERROR(20); INSYMBOL; GO STATM END; 60115000 T 0041
IF SYMKIND[CURSY]=INITIAL THEN BEGIN ERROR(21); GO STATM END; 60116000 T 0047
END UNTIL CURSY!SEMICOLON; 60117000 T 0049
IF CURSY!ENDSY THEN 60118000 T 0051
BEGIN ERROR(24); SKIP(ENDSY); 60119000 T 0051
IF CURSY!ENDSY THEN BEGIN INSYMBOL; GO TO STATM END; 60120000 T 0053
END; 60121000 T 0056
GEN(" END",5,4); MARGIN(" E",BEGINNUM); 60122000 T 0056
INSYMBOL; 60123000 T 0082
END OF COMPSTAT; 60124000 T 0083
27 IS 88 LONG, NEXT SEG 2
60125000 T 0368
60126000 T 0368
PROCEDURE IFSTAT; 60127000 T 0368
BEGIN 60128000 T 0368
LABEL EXIT; 60129000 T 0368
START OF SEGMENT ********** 28
GEN("IF",3,6); 60130000 T 0000
INSYMBOL; BOOLEXPR; 60131000 T 0009
IF CURSY!THENSY THEN 60132000 T 0111
BEGIN IF CURTYPE>0 THEN ERROR(27); 60133000 T 0111
SKIP(THENSY); 60134000 T 0114
IF CURSY!THENSY THEN 60135000 T 0115
BEGIN IF CURTYPE=0 THEN ERROR(27); 60136000 T 0115
IF SYMKIND[CURSY]=TERMINAL THEN GO TO EXIT; 60137000 T 0118
END; END; 60138000 T 0119
GEN(" THEN",6,3); 60139000 T 0119
INSYMBOL; STATEMENT; 60140000 T 0128
IF CURSY=ELSESY THEN 60141000 T 0129
BEGIN GEN(" ELSE",6,3); INSYMBOL; STATEMENT END; 60142000 T 0130
EXIT: 60143000 T 0141
END OF IFSTAT; 60144000 T 0141
28 IS 144 LONG, NEXT SEG 2
60145000 T 0368
60146000 T 0368
PROCEDURE CASESTAT; 60147000 T 0368
BEGIN 60148000 T 0368
DEFINE CASEHASH(N)=(N).[38:39] MOD MAXCASES#; 60149000 T 0368
START OF SEGMENT ********** 29
INTEGER ARRAY CASETAB[0:MAXCASES]; 60150000 T 0000
INTEGER CASENUM,CASETYPE,NCASELABS,TEMPVARNUM,CONVAL,CONTYPE,C,T; 60151000 T 0001
BOOLEAN ZEROLAB,FIRST; 60152000 T 0001
60153000 T 0001
CASENUM:=NUMCASES:=NUMCASES+1; MARGIN("CB",CASENUM); 60154000 T 0001
TEMPVARNUM:=NUMTEMPS:=NUMTEMPS+1; 60155000 T 0021
IF TEMPVARNUM>MAXTEMPS THEN ERROR(16); 60156000 T 0023
GEN("BEGIN",6,3); GENID("T",TEMPVARNUM,2); GEN(":=",2,6); 60157000 T 0025
INSYMBOL; EXPRESSION; 60158000 T 0054
GEN(";",1,7); CASETYPE:=CURTYPE; 60159000 T 0055
IF TYPETAB1[CASETYPE].FORM}FLOATING THEN 60160000 T 0065
BEGIN ERROR(17); CASETYPE:=0 END; 60161000 T 0066
IF CURSY!OFSY THEN 60162000 T 0068
BEGIN IF CASETYPE>0 THEN ERROR(18); 60163000 T 0069
SKIP(OFSY); 60164000 T 0072
IF CURSY=OFSY THEN INSYMBOL ELSE 60165000 T 0072
IF CASETYPE=0 THEN ERROR(18); 60166000 T 0074
END ELSE INSYMBOL; 60167000 T 0079
DO BEGIN 60168000 T 0080
WHILE CURSY=SEMICOLON DO INSYMBOL; 60169000 T 0080
FIRST:=TRUE; 60170000 T 0082
IF CURSY!ENDSY THEN 60171000 T 0083
BEGIN 60172000 T 0083
GEN("IF",3,6); 60173000 T 0084
DO BEGIN 60174000 T 0093
IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 60175000 T 0093
CONSTANT(CONVAL,CONTYPE); 60176000 T 0097
IF CONTYPE>0 THEN 60177000 T 0184
BEGIN 60178000 T 0185
IF CASETYPE=0 THEN CASETYPE:=CONTYPE ELSE 60179000 T 0185
CHECKTYPES(CASETYPE,CONTYPE); 60180000 T 0187
GENID("T",TEMPVARNUM,2); GEN("=",1,7); GENINT(CONVAL); 60181000 T 0246
NCASELABS:=NCASELABS+1; 60182000 T 0308
IF NCASELABS<MAXCASES THEN 60183000 T 0310
BEGIN 60184000 T 0310
IF CONVAL=0 THEN 60185000 T 0311
IF ZEROLAB THEN ERROR(31) ELSE ZEROLAB:=TRUE ELSE 60186000 T 0312
BEGIN 60187000 T 0315
T:=CASEHASH(CONVAL); 60188000 T 0315
FOR C:=CASETAB[T] WHILE C!CONVAL AND C!0 DO 60189000 T 0317
T:=IF T=0 THEN MAXCASES ELSE T-1; 60190000 T 0321
IF C!0 THEN ERROR(31) ELSE CASETAB[T]:=CONVAL; 60191000 T 0325
END; 60192000 T 0329
END ELSE IF NCASELABS=MAXCASES THEN ERROR(30); 60193000 T 0329
IF CURSY=COMMA THEN GEN(" OR",4,5); 60194000 T 0331
END; 60195000 T 0341
END UNTIL CURSY!COMMA; 60196000 T 0341
GEN(" THEN",6,3); 60197000 T 0343
IF CURSY!COLON THEN BEGIN ERROR(26); SKIP(COLON) END; 60198000 T 0352
IF CURSY=COLON THEN INSYMBOL; 60199000 T 0354
STATEMENT; 60200000 T 0356
IF CURSY!SEMICOLON AND CURSY!ENDSY THEN 60201000 T 0357
BEGIN ERROR(21); SKIP(SEMICOLON) END; 60202000 T 0358
END; 60203000 T 0360
IF CURSY=SEMICOLON THEN GEN(" ELSE",6,3); 60204000 T 0360
END UNTIL CURSY!SEMICOLON; 60205000 T 0371
IF CURSY!ENDSY THEN BEGIN ERROR(24); SKIP(ENDSY) END; 60206000 T 0372
GEN(" END",5,4); MARGIN("CE",CASENUM); 60207000 T 0375
NUMTEMPS:=NUMTEMPS-1; 60208000 T 0401
INSYMBOL; 60209000 T 0403
END OF CASESTAT; 60210000 T 0403
29 IS 418 LONG, NEXT SEG 2
60211000 T 0368
60212000 T 0368
PROCEDURE WHILESTAT; 60213000 T 0368
BEGIN 60214000 T 0368
LABEL STATM,EXIT; 60215000 T 0368
START OF SEGMENT ********** 30
GEN("WHILE",6,3); 60216000 T 0000
INSYMBOL; BOOLEXPR; 60217000 T 0009
IF CURSY!DOSY THEN 60218000 T 0111
BEGIN IF CURTYPE>0 THEN ERROR(19); 60219000 T 0111
SKIP(DOSY); 60220000 T 0114
IF CURSY!DOSY THEN 60221000 T 0115
BEGIN IF CURTYPE=0 THEN ERROR(19); 60222000 T 0115
GO TO IF SYMKIND[CURSY]=INITIAL THEN STATM ELSE EXIT; 60223000 T 0118
END; END; 60224000 T 0123
GEN(" DO",4,5); 60225000 T 0123
INSYMBOL; 60226000 T 0132
STATM: STATEMENT; 60227000 T 0133
EXIT: 60228000 T 0133
END OF WHILESTAT; 60229000 T 0134
30 IS 140 LONG, NEXT SEG 2
60230000 T 0368
60231000 T 0368
PROCEDURE REPEATSTAT; 60232000 T 0368
BEGIN 60233000 T 0368
INTEGER REPNUM; 60234000 T 0368
START OF SEGMENT ********** 31
LABEL NEWTRY; 60235000 T 0000
60236000 T 0000
REPNUM:=NUMREPS:=NUMREPS+1; 60237000 T 0000
MARGIN(" R",REPNUM); 60238000 T 0001
GEN("DO",3,6); GEN("BEGIN",6,3); 60239000 T 0019
DO BEGIN 60240000 T 0037
INSYMBOL; 60241000 T 0037
NEWTRY: STATEMENT; 60242000 T 0038
GEN(";",1,7); 60243000 T 0038
IF CURSY=ELSESY THEN BEGIN ERROR(20);INSYMBOL; GO NEWTRY END; 60244000 T 0047
IF SYMKIND[CURSY]=INITIAL THEN BEGIN ERROR(21); GO NEWTRY END; 60245000 T 0054
END UNTIL CURSY!SEMICOLON; 60246000 T 0056
IF CURSY!UNTILSY THEN 60247000 T 0058
BEGIN 60248000 T 0058
ERROR(22); 60249000 T 0059
WHILE CURSY!UNTILSY AND SYMKIND[CURSY]!INITIAL DO 60250000 T 0060
BEGIN INSYMBOL; SKIP(UNTILSY) END; 60251000 T 0062
IF CURSY!UNTILSY THEN GO TO NEWTRY; 60252000 T 0064
END; 60253000 T 0065
GEN(" END",5,4); GEN("UNTIL",6,3); MARGIN(" U",REPNUM); 60254000 T 0065
INSYMBOL; BOOLEXPR; 60255000 T 0101
END OF REPEATSTAT; 60256000 T 0205
31 IS 208 LONG, NEXT SEG 2
60257000 T 0368
60258000 T 0368
PROCEDURE FORSTAT; 60259000 T 0368
BEGIN 60260000 T 0368
INTEGER VARTYPE,VARNUM,LLIM,ULIM; 60261000 T 0368
START OF SEGMENT ********** 32
BOOLEAN DOWN; 60262000 T 0000
LABEL STATM; 60263000 T 0000
60264000 T 0000
GEN("BEGIN",6,3); 60265000 T 0000
INSYMBOL; 60266000 T 0009
IF CURSY=IDENTIFIER THEN 60267000 T 0009
BEGIN 60268000 T 0010
SEARCH; 60269000 T 0010
IF FOUND THEN 60270000 T 0039
BEGIN 60271000 T 0040
VARNUM:=1000|THISLEVEL+THISINDEX; 60272000 T 0040
IF THISID.IDCLASS=VAR OR 60273000 T 0042
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) THEN 60274000 T 0043
BEGIN 60275000 T 0046
IF THISLEVEL>1 AND THISLEVEL<CURLEVEL THEN ERROR(5); 60276000 T 0046
IF THISLEVEL>CURLEVEL THEN ERROR(83); 60277000 T 0049
VARTYPE:=THISID.TYPE; 60278000 T 0051
IF TYPETAB1[VARTYPE].FORM{CHAR THEN 60279000 T 0052
BEGIN 60280000 T 0054
LLIM:=TYPETAB2[VARTYPE]; ULIM:=TYPETAB3[VARTYPE]; 60281000 T 0054
END ELSE BEGIN ERROR(12); VARTYPE:=0 END; 60282000 T 0056
END ELSE ERROR(8); 60283000 T 0058
END ELSE ERROR(1); 60284000 T 0060
END ELSE ERROR(9); 60285000 T 0061
INSYMBOL; 60286000 T 0062
IF CURSY!ASSIGNSY THEN 60287000 T 0063
BEGIN ERROR(28); 60288000 T 0063
SKIP(ASSIGNSY); 60289000 T 0065
IF CURSY=ASSIGNSY THEN INSYMBOL ELSE 60290000 T 0065
IF SYMKIND[CURSY]=INITIAL THEN GO TO STATM; 60291000 T 0067
END ELSE INSYMBOL; 60292000 T 0069
GENID("V",VARNUM,5); GEN("~",1,7); 60293000 T 0070
IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 60294000 T 0091
WRITEEXPR; 60295000 T 0168
GEN(";",1,7); 60296000 T 0245
IF VARTYPE=0 THEN VARTYPE:=CURTYPE ELSE CHECKTYPES(VARTYPE,CURTYPE); 60297000 T 0254
NUMTEMPS:=NUMTEMPS+1; IF NUMTEMPS>MAXTEMPS THEN ERROR(16); 60298000 T 0314
IF CURSY=TOSY THEN INSYMBOL ELSE 60299000 T 0317
IF CURSY=DOWNTOSY THEN BEGIN DOWN:=TRUE; INSYMBOL END ELSE 60300000 T 0319
BEGIN IF CURTYPE>0 THEN ERROR(23); 60301000 T 0322
SKIP(TOSY); 60302000 T 0325
IF CURSY=TOSY THEN INSYMBOL ELSE 60303000 T 0325
BEGIN IF CURTYPE=0 THEN ERROR(23); 60304000 T 0327
IF SYMKIND[CURSY]=INITIAL THEN GO TO STATM; 60305000 T 0330
END; END; 60306000 T 0331
GENID("T",NUMTEMPS,2); GEN("~",1,7); 60307000 T 0331
IF CHECKOPTION THEN CHECKEXPR(LLIM,ULIM) ELSE EXPRESSION; 60308000 T 0352
WRITEEXPR; 60309000 T 0429
GEN(";",1,7); 60310000 T 0506
IF VARTYPE=0 THEN VARTYPE:=CURTYPE ELSE CHECKTYPES(VARTYPE,CURTYPE); 60311000 T 0515
IF CURSY!DOSY THEN 60312000 T 0575
BEGIN IF CURTYPE>0 THEN ERROR(19); 60313000 T 0576
SKIP(DOSY); 60314000 T 0578
IF CURSY=DOSY THEN INSYMBOL ELSE 60315000 T 0579
IF CURTYPE=0 THEN ERROR(19); 60316000 T 0581
END ELSE INSYMBOL; 60317000 T 0583
GEN("FOR",4,5); GENID("V",VARNUM,5); GEN("~",1,7); 60318000 T 0584
GENID("V",VARNUM,5); GEN(" ",1,7); 60319000 T 0614
IF DOWN THEN GEN("DOWNTO",7,2) ELSE GEN("UPTO",5,4); 60320000 T 0634
GENID("T",NUMTEMPS,2); GEN(" DO",4,5); 60321000 T 0656
STATM: STATEMENT; 60322000 T 0676
GEN(" END",5,4); 60323000 T 0677
NUMTEMPS:=NUMTEMPS-1; 60324000 T 0686
END OF FORSTAT; 60325000 T 0687
32 IS 694 LONG, NEXT SEG 2
60326000 T 0368
60327000 T 0368
PROCEDURE GOTOSTAT; 60328000 T 0368
BEGIN 60329000 T 0368
INTEGER I; 60330000 T 0368
START OF SEGMENT ********** 33
INSYMBOL; 60331000 T 0000
IF CURSY=INTCONST THEN 60332000 T 0000
BEGIN I:=NUMLABS; 60333000 T 0001
WHILE I}1 AND LABTAB[I].LABVAL!CURVAL DO I:=I-1; 60334000 T 0002
IF I=0 THEN ERROR(15); 60335000 T 0007
GEN("GO",3,6); GENID("L",CURVAL,4); 60336000 T 0009
INSYMBOL; 60337000 T 0029
END ELSE ERROR(10); 60338000 T 0030
END OF GOTOSTAT; 60339000 T 0032
33 IS 35 LONG, NEXT SEG 2
60340000 T 0368
60341000 T 0368
PROCEDURE WITHSTAT; 60342000 T 0368
BEGIN 60343000 T 0368
INTEGER STARTLEVEL,VERYFIRSTWITHSYM,I; 60344000 T 0368
START OF SEGMENT ********** 34
REAL D; 60345000 T 0000
STARTLEVEL:=TOPLEVEL; VERYFIRSTWITHSYM:=NWITHSYMS; 60346000 T 0000
DO BEGIN 60347000 T 0001
INSYMBOL; 60348000 T 0001
IF CURSY=IDENTIFIER THEN 60349000 T 0002
BEGIN 60350000 T 0002
SEARCH; 60351000 T 0003
IF FOUND THEN 60352000 T 0030
BEGIN 60353000 T 0031
IF THISID.IDCLASS=VAR THEN 60354000 T 0031
BEGIN 60355000 T 0032
VARIABLE; 60356000 T 0033
IF CURTYPE>0 THEN 60357000 T 0033
IF TYPETAB1[CURTYPE].FORM!RECORD THEN ERROR(98); 60358000 T 0034
IF SIMPLEVARIABLE THEN 60359000 T 0037
BEGIN PUTSYM("["); INSIDEBRACKETS:=TRUE END; 60360000 T 0038
IF TOPLEVEL<MAXLEVEL THEN 60361000 T 0046
BEGIN 60362000 T 0047
TOPLEVEL:=TOPLEVEL+1; 60363000 T 0048
D.NAMETAB:=TYPETAB1[CURTYPE].RECTAB; 60364000 T 0049
D.RECTYPE:=CURTYPE; 60365000 T 0051
D.NUMPNTRSINWITH:=NUMPOINTERS; 60366000 T 0053
D.FIRSTWITHSYM:=NWITHSYMS; 60367000 T 0055
D.BRACKETSINWITH:=REAL(INSIDEBRACKETS); 60368000 T 0057
IF NWITHSYMS+NUMSYMS>MAXWITHSYMS THEN ERROR(63) ELSE 60369000 T 0058
FOR I:=1 STEP 1 UNTIL NUMSYMS DO 60370000 T 0061
BEGIN 60371000 T 0063
WITHTAB[NWITHSYMS]:=SYMTAB[I]; 60372000 T 0063
NWITHSYMS:=NWITHSYMS+1; 60373000 T 0064
END; 60374000 T 0065
D.LASTWITHSYM:=NWITHSYMS-1; 60375000 T 0068
DISPLAY[TOPLEVEL]:=D; 60376000 T 0070
END ELSE ERROR(84); 60377000 T 0071
END ELSE BEGIN ERROR(8); INSYMBOL END; 60378000 T 0072
END ELSE BEGIN ERROR(1); INSYMBOL END; 60379000 T 0074
END ELSE BEGIN ERROR(9); INSYMBOL END; 60380000 T 0076
NUMSYMS:=0; 60381000 T 0078
NUMPOINTERS := 0; 60382000 T 0078
END UNTIL CURSY!COMMA; 60383000 T 0079
IF CURSY!DOSY THEN 60384000 T 0080
BEGIN ERROR(19); SKIP(DOSY); 60385000 T 0081
IF CURSY=DOSY THEN INSYMBOL; 60386000 T 0083
END ELSE INSYMBOL; 60387000 T 0085
STATEMENT; 60388000 T 0086
TOPLEVEL:=STARTLEVEL; NWITHSYMS:=VERYFIRSTWITHSYM; 60389000 T 0086
END OF WITHSTAT; 60390000 T 0088
34 IS 92 LONG, NEXT SEG 2
60391000 T 0368
60392000 T 0368
PROCEDURE STATEMENT; 60393000 T 0368
BEGIN 60394000 T 0368
INTEGER I; 60395000 T 0368
START OF SEGMENT ********** 35
LABEL LABFOUND; 60396000 T 0000
60397000 T 0000
IF CURSY=INTCONST THEN % *** LABELED STATEMENT *** 60398000 T 0000
BEGIN 60399000 T 0000
FOR I:=FIRSTLAB STEP 1 UNTIL NUMLABS DO 60400000 T 0001
IF LABTAB[I].LABVAL=CURVAL THEN 60401000 T 0002
BEGIN IF LABTAB[I].LABDEF=1 THEN ERROR(31); 60402000 T 0003
LABTAB[I].LABDEF:=1; 60403000 T 0006
GO TO LABFOUND; 60404000 T 0009
END; 60405000 T 0009
ERROR(15); 60406000 T 0012
LABFOUND: GENID("L",CURVAL,4); GEN(":",1,7); 60407000 T 0012
INSYMBOL; 60408000 T 0033
IF CURSY!COLON THEN 60409000 T 0034
BEGIN ERROR(26); 60410000 T 0034
SKIP(COLON); IF CURSY=COLON THEN INSYMBOL; 60411000 T 0036
END ELSE INSYMBOL; 60412000 T 0038
END; 60413000 T 0039
60414000 T 0039
COMMENT *** START OF STATEMENT *** ; 60415000 T 0039
60416000 T 0039
IF CURSY=IDENTIFIER THEN 60417000 T 0039
BEGIN 60418000 T 0040
SEARCH; 60419000 T 0040
IF FOUND THEN 60420000 T 0068
BEGIN 60421000 T 0068
IF THISID.IDCLASS=VAR OR 60422000 T 0069
THISID.IDCLASS=CONST AND BOOLEAN(THISID.FORMAL) OR 60423000 T 0070
THISID.IDCLASS=FUNC THEN ASSIGNMENT ELSE 60424000 T 0072
IF THISID.IDCLASS=PROC THEN 60425000 T 0075
BEGIN 60426000 T 0077
IF THISLEVEL=0 THEN % *** INTRINSIC PROCEDURE *** 60427000 T 0077
BEGIN 60428000 T 0078
IF CURNAME1="50WRITE" THEN PWRITE(FALSE) ELSE 60429000 T 0078
IF CURNAME1="7WRITEL" AND 60430000 T 0080
CURNAME2="000000N" THEN PWRITE(TRUE) ELSE 60431000 T 0083
IF CURNAME1="400READ" THEN PREAD(FALSE) ELSE 60432000 T 0086
IF CURNAME1="6READLN" THEN PREAD(TRUE) ELSE 60433000 T 0090
IF CURNAME1="400PAGE" THEN FILEHANDLING(5) ELSE 60434000 T 0094
IF CURNAME1="3000GET" THEN FILEHANDLING(2) ELSE 60435000 T 0098
IF CURNAME1="3000PUT" THEN FILEHANDLING(1) ELSE 60436000 T 0102
IF CURNAME1="50RESET" THEN FILEHANDLING(3) ELSE 60437000 T 0106
IF CURNAME1="7REWRIT" AND 60438000 T 0110
CURNAME2="000000E" THEN FILEHANDLING(4) ELSE 60439000 T 0112
IF CURNAME1="3000NEW" THEN NEWDISP ELSE 60440000 T 0115
IF CURNAME1="7DISPOS" AND 60441000 T 0118
CURNAME2="000000E" THEN NEWDISP ELSE 60442000 T 0121
IF CURNAME1="400PACK" THEN PACK ELSE 60443000 T 0123
IF CURNAME1="6UNPACK" THEN UNPACK ELSE ERROR(0); 60444000 T 0127
END ELSE PASSPARAMS; 60445000 T 0134
WRITEEXPR; 60446000 T 0135
END ELSE BEGIN ERROR(13); SKIP(99) END; 60447000 T 0213
END ELSE BEGIN ERROR(1); ASSIGNMENT END; 60448000 T 0215
END OF IDENTIFIER ELSE 60449000 T 0216
IF CURSY=BEGINSY THEN COMPSTAT ELSE 60450000 T 0216
IF CURSY=IFSY THEN IFSTAT ELSE 60451000 T 0219
IF CURSY=CASESY THEN CASESTAT ELSE 60452000 T 0221
IF CURSY=WHILESY THEN WHILESTAT ELSE 60453000 T 0223
IF CURSY=REPEATSY THEN REPEATSTAT ELSE 60454000 T 0225
IF CURSY=FORSY THEN FORSTAT ELSE 60455000 T 0228
IF CURSY=WITHSY THEN WITHSTAT ELSE 60456000 T 0230
IF CURSY=GOTOSY THEN GOTOSTAT ELSE 60457000 T 0232
IF SYMKIND[CURSY]!TERMINAL THEN 60458000 T 0234
BEGIN ERROR(13); INSYMBOL; SKIP(SEMICOLON) END; 60459000 T 0236
END OF STATEMENT; 60460000 T 0238
35 IS 241 LONG, NEXT SEG 2
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 70001000 T 0368
% % 70002000 T 0368
% % 70003000 T 0368
% % 70004000 T 0368
% PART 7: TYPE DECLARATIONS. % 70005000 T 0368
% ------------------ % 70006000 T 0368
% % 70007000 T 0368
% % 70008000 T 0368
% % 70009000 T 0368
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 70010000 T 0368
70011000 T 0368
70012000 T 0368
REAL VALX1,VALX2; 70013000 T 0368
INTEGER TYPEX1,TYPEX2; 70014000 T 0368
BOOLEAN PACKED; 70015000 T 0368
70016000 T 0368
PROCEDURE FIELDLIST(RECTAB,FIRSTADDR,LASTADDR); 70017000 T 0368
VALUE RECTAB,FIRSTADDR; 70018000 T 0368
INTEGER RECTAB,FIRSTADDR,LASTADDR; 70019000 T 0368
FORWARD; 70020000 T 0368
70021000 T 0368
DEFINE SUBRANGE= %*** SUBRANGE DECLARATION*** 70022000 T 0368
BEGIN %*************************** 70023000 T 0368
CONSTANT(VALX1,TYPEX1); 70024000 T 0368
IF TYPETAB1[TYPEX1].FORM>CHAR THEN ERROR(11); 70025000 T 0368
IF CURSY!DOUBLEDOT THEN ERROR(53); 70026000 T 0368
INSYMBOL; 70027000 T 0368
CONSTANT(VALX2,TYPEX2); 70028000 T 0368
IF TYPEX1>0 AND TYPEX2>0 THEN 70029000 T 0368
IF TYPEX1!TYPEX2 THEN ERROR(11) ELSE 70030000 T 0368
IF VALX1>VALX2 THEN ERROR(54); 70031000 T 0368
T1:=TYPETAB1[TYPEX1].FORM; IF T1=SYMBOLIC THEN T1:=SUBTYPE; 70032000 T 0368
NEWTYPE; TTYPE:=TYPEINDEX; 70033000 T 0368
T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; T1.MAINTYPE:=TYPEX1; 70034000 T 0368
TYPETAB1[TYPEINDEX]:=T1; 70035000 T 0368
TYPETAB2[TYPEINDEX]:=VALX1; TYPETAB3[TYPEINDEX]:=VALX2; 70036000 T 0368
END OF SUBRANGE#; 70037000 T 0368
70038000 T 0368
70039000 T 0368
PROCEDURE TYPEDECL(TTYPE,TSIZE); 70040000 T 0368
INTEGER TTYPE,TSIZE; 70041000 T 0368
BEGIN 70042000 T 0368
PROCEDURE TYPERR(ERRNUM,TTYPE,TSIZE); 70043000 T 0368
START OF SEGMENT ********** 36
VALUE ERRNUM; 70044000 T 0000
INTEGER ERRNUM,TTYPE,TSIZE; 70045000 T 0000
BEGIN ERROR(ERRNUM); 70046000 T 0000
TTYPE:=TSIZE:=0; 70047000 T 0000
END; 70048000 T 0002
70049000 T 0002
INTEGER RECINX,ARRSTRUCT,TX,SX,T1,T2,T3,T,N; 70050000 T 0002
BOOLEAN FIRST; 70051000 T 0002
70052000 T 0002
PACKED:=FALSE; 70080000 T 0002
IF CURSY=IDENTIFIER THEN %*** SIMPLE TYPE DECLARATION *** 70081000 T 0003
BEGIN %******************************* 70082000 T 0004
SEARCH; 70083000 T 0005
IF FOUND THEN 70084000 T 0032
BEGIN 70085000 T 0032
IF THISID.IDCLASS=TYPES THEN 70086000 T 0033
BEGIN 70087000 T 0034
TTYPE:=THISID.TYPE; TSIZE:=TYPETAB1[TTYPE].SIZE; 70088000 T 0035
INSYMBOL; 70089000 T 0038
END ELSE IF THISID.IDCLASS=CONST THEN SUBRANGE 70090000 T 0038
ELSE TYPERR(7,TTYPE,TSIZE); 70091000 T 0245
END ELSE BEGIN TYPERR(1,TTYPE,TSIZE); INSYMBOL END; 70092000 T 0248
END ELSE 70093000 T 0251
IF CURSY{CHARCONST OR CURSY=PLUS OR CURSY=MINUS THEN SUBRANGE ELSE 70094000 T 0251
IF CURSY=LPAR THEN 70095000 T 0460
BEGIN 70096000 T 0461
N:=0; 70097000 T 0462
NEWTYPE; T3.IDCLASS:=CONST; T3.TYPE:=TYPEINDEX; 70098000 T 0462
DO BEGIN 70099000 T 0471
INSYMBOL; 70100000 T 0471
IF CURSY=IDENTIFIER THEN 70101000 T 0471
BEGIN 70102000 T 0472
NEWNAME(CURNAME1,CURNAME2,CURLEVEL); 70103000 T 0473
T3.INFO:=N; NAMETAB3[CURLEVEL,THISINDEX]:=T3; 70104000 T 0495
N:=N+1; INSYMBOL; 70105000 T 0498
END ELSE ERROR(9); 70106000 T 0500
END UNTIL CURSY!COMMA; 70107000 T 0501
IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 70108000 T 0503
T1:=SYMBOLIC; T1.STRUCT:=0; 70109000 T 0505
T1.SIZE:=TSIZE:=1; TTYPE:=TYPEINDEX; 70110000 T 0508
TYPETAB1[TYPEINDEX]:=T1; 70111000 T 0511
TYPETAB2[TYPEINDEX]:=0; TYPETAB3[TYPEINDEX]:=N-1; 70112000 T 0513
IF CURSY=RPAR THEN INSYMBOL; 70113000 T 0516
END ELSE 70114000 T 0517
70115000 T 0517
IF CURSY=ARROW THEN %*** POINTER DECLARATION *** 70116000 T 0517
BEGIN %*************************** 70117000 T 0519
INSYMBOL; 70118000 T 0519
IF CURSY=IDENTIFIER THEN 70119000 T 0520
BEGIN 70120000 T 0520
NEWTYPE; TTYPE:=TYPEINDEX; T1:=POINTERS; 70121000 T 0521
T1.SIZE:=TSIZE:=1; T1.STRUCT:=0; 70122000 T 0528
TYPETAB1[TYPEINDEX]:=T1; 70123000 T 0532
SEARCH; 70124000 T 0533
IF FOUND THEN 70125000 T 0561
BEGIN 70126000 T 0561
IF THISID.IDCLASS=TYPES THEN 70127000 T 0561
TYPETAB1[TYPEINDEX].POINTTYPE:=THISID.TYPE ELSE 70128000 T 0563
TYPERR(7,TTYPE,TSIZE); 70129000 T 0566
END ELSE 70130000 T 0569
BEGIN 70131000 T 0569
IF NUMPNTRS<MAXPNTRS THEN NUMPNTRS:=NUMPNTRS+1 ELSE ERROR(52); 70132000 T 0569
PNTRTAB1[NUMPNTRS]:=CURNAME1; PNTRTAB2[NUMPNTRS]:=CURNAME2; 70133000 T 0573
PNTRTAB3[NUMPNTRS]:=TYPEINDEX; 70134000 T 0576
END; 70135000 T 0577
INSYMBOL; 70136000 T 0577
END ELSE TYPERR(9,TTYPE,TSIZE); 70137000 T 0577
END OF POINTER DECLARATION ELSE 70138000 T 0580
BEGIN 70139000 T 0580
IF CURSY=PACKEDSY THEN BEGIN PACKED:=TRUE; INSYMBOL END; 70140000 T 0581
70141000 T 0583
IF CURSY=ARRAYSY THEN %*** ARRAY DECLARATION *** 70142000 T 0583
BEGIN %************************* 70143000 T 0584
INSYMBOL; 70144000 T 0584
IF CURSY!LBRACKET THEN ERROR(47) ELSE INSYMBOL; 70145000 T 0585
T1:=0; FIRST:=TRUE; 70146000 T 0588
DO BEGIN 70147000 T 0589
IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 70148000 T 0589
TYPEDECL(TX,SX); 70149000 T 0592
IF TX>0 THEN 70150000 T 0593
BEGIN 70151000 T 0594
IF TYPETAB1[TX].FORM>CHAR THEN ERROR(48); 70152000 T 0594
T1:=ARRAYS; T1.INXTYPE:=TX; T1.ARRTYPE:=T; 70153000 T 0597
T2:=TYPETAB2[TX]; T3:=TYPETAB3[TX]; 70154000 T 0601
IF T3-T2>1022 THEN ERROR(61); 70155000 T 0603
T1.SIZE:=MIN(1023,T3-T2+1); 70156000 T 0606
NEWTYPE; 70157000 T 0611
TYPETAB1[TYPEINDEX]:=T1; 70158000 T 0616
TYPETAB2[TYPEINDEX]:=T2; TYPETAB3[TYPEINDEX]:=T3; 70159000 T 0617
T:=TYPEINDEX; 70160000 T 0619
END; 70161000 T 0620
END UNTIL CURSY!COMMA; 70162000 T 0620
IF CURSY!RBRACKET THEN ERROR(59) ELSE INSYMBOL; 70163000 T 0621
IF CURSY!OFSY THEN BEGIN ERROR(18); SKIP(OFSY) END; 70164000 T 0624
INSYMBOL; 70165000 T 0627
TYPEDECL(TX,SX); 70166000 T 0628
IF TYPETAB1[TX].FORM}FILES THEN ERROR(60); 70167000 T 0629
ARRSTRUCT:=TYPETAB1[TX].STRUCT; 70168000 T 0631
WHILE T>0 DO 70169000 T 0633
BEGIN 70170000 T 0634
T1:=TYPETAB1[T]; T3:=T1.ARRTYPE; 70171000 T 0634
T1.ARRTYPE:=TX; T1.STRUCT:=ARRSTRUCT:=ARRSTRUCT+1; 70172000 T 0636
T1.SIZE:=SX:=MIN(1024,SX|T1.SIZE); 70173000 T 0641
TYPETAB1[T]:=T1; TX:=T; T:=T3; 70174000 T 0646
END; 70175000 T 0649
TTYPE:=TX; TSIZE:=SX; 70176000 T 0651
END OF ARRAY DECLARATION ELSE 70177000 T 0653
70178000 T 0653
IF CURSY=FILESY THEN %*** FILE DECLARATION *** 70179000 T 0653
BEGIN %************************ 70180000 T 0654
INSYMBOL; 70181000 T 0654
IF CURSY!OFSY THEN 70182000 T 0655
BEGIN ERROR(18); 70183000 T 0656
IF CURSY!IDENTIFIER THEN INSYMBOL; 70184000 T 0657
END ELSE INSYMBOL; 70185000 T 0659
TYPEDECL(TX,SX); 70186000 T 0660
IF TX>0 THEN 70187000 T 0661
BEGIN T:=TYPETAB1[TX]; 70188000 T 0661
IF T.FORM}FILES THEN ERROR(50) ELSE 70189000 T 0663
IF T.STRUCT>1 THEN ERROR(49) 70190000 T 0665
END; 70191000 T 0668
NEWTYPE; TTYPE:=TYPEINDEX; 70192000 T 0668
T1:=IF T.FORM=CHAR THEN TEXTFILE ELSE FILES; 70193000 T 0674
T1.SIZE:=TSIZE:=SX; T1.FILETYPE:=TX; 70194000 T 0678
T1.STRUCT:=1; 70195000 T 0682
TYPETAB1[TYPEINDEX]:=T1; 70196000 T 0684
END OF FILE DECLARATION ELSE 70197000 T 0685
70198000 T 0685
IF CURSY=SETSY THEN %*** SET DECLARATION *** 70199000 T 0685
BEGIN %*********************** 70200000 T 0686
INSYMBOL; 70201000 T 0687
IF CURSY!OFSY THEN 70202000 T 0687
BEGIN ERROR(18); 70203000 T 0688
IF CURSY>CHARCONST THEN INSYMBOL; 70204000 T 0689
END ELSE INSYMBOL; 70205000 T 0691
TYPEDECL(TX,SX); 70206000 T 0692
IF TX>0 THEN 70207000 T 0693
BEGIN 70208000 T 0694
IF TYPETAB1[TX].FORM>CHAR THEN ERROR(48) ELSE 70209000 T 0694
IF TYPETAB2[TX]<0 OR TYPETAB3[TX]>38 THEN ERROR(51); 70210000 T 0697
END; 70211000 T 0701
NEWTYPE; TTYPE:=TYPEINDEX; 70212000 T 0701
T1:=SET; T1.SETTYPE:=TX; T1.STRUCT:=0; 70213000 T 0707
T1.SIZE:=TSIZE:=1; TYPETAB1[TYPEINDEX]:=T1; 70214000 T 0711
TYPETAB2[TYPEINDEX]:=TYPETAB2[TX]; 70215000 T 0715
TYPETAB3[TYPEINDEX]:=TYPETAB3[TX]; 70216000 T 0716
END OF SET DECLARATION ELSE 70217000 T 0718
70218000 T 0718
IF CURSY=RECORDSY THEN %*** RECORD DECLARATION *** 70219000 T 0718
BEGIN %************************** 70220000 T 0719
IF LASTREC-1>CURLEVEL THEN LASTREC:=LASTREC-1 ELSE ERROR(55); 70221000 T 0720
RECINX:=LASTREC; 70222000 T 0724
BLOCKTAB[RECINX]:=NUMBLOCKS:=NUMBLOCKS+1; 70223000 T 0725
INSYMBOL; 70224000 T 0727
FIELDLIST(RECINX,0,SX); 70225000 T 0727
IF SX>1022 THEN BEGIN ERROR(56); SX:=1022 END; 70226000 T 0729
NEWTYPE; TTYPE:=TYPEINDEX; 70227000 T 0731
T1:=RECORD; T1.RECTAB:=RECINX; T1.STRUCT:=1; 70228000 T 0737
T1.SIZE:=TSIZE:=SX; TYPETAB1[TYPEINDEX]:=T1; 70229000 T 0742
TYPETAB2[TYPEINDEX]:=0; TYPETAB3[TYPEINDEX]:=SX-1; 70230000 T 0745
IF CURSY!ENDSY THEN BEGIN ERROR(24); SKIP(ENDSY) END; 70231000 T 0748
IF CURSY=ENDSY THEN INSYMBOL; 70232000 T 0751
END ELSE BEGIN ERROR(4); SKIP(99) END; 70233000 T 0753
END; 70234000 T 0755
END OF TYPEDECL; 70235000 T 0755
36 IS 768 LONG, NEXT SEG 2
70236000 T 0368
70237000 T 0368
PROCEDURE FIELDLIST(RECTAB,FIRSTADDR,LASTADDR); 70238000 T 0368
VALUE RECTAB,FIRSTADDR; 70239000 T 0368
INTEGER RECTAB,FIRSTADDR,LASTADDR; 70240000 T 0368
BEGIN 70241000 T 0368
INTEGER ARRAY ILIST[0:LISTLENGTH]; 70242000 T 0368
START OF SEGMENT ********** 37
INTEGER LISTINX; 70243000 T 0001
INTEGER CASETYPE,ADDR,MAXADDR,INDEX,CTYPE,TX,SX,T1,T3,LLIM,ULIM,I; 70244000 T 0001
BOOLEAN FIRST; 70245000 T 0001
REAL CVAL; 70246000 T 0001
LABEL CASETYPEID,CASEPART,EXIT; 70247000 T 0001
70248000 T 0001
ADDR:=FIRSTADDR; 70249000 T 0001
DO BEGIN 70250000 T 0002
WHILE CURSY=SEMICOLON DO INSYMBOL; 70251000 T 0002
IF CURSY=CASESY THEN GO TO CASEPART; 70252000 T 0004
IF CURSY=IDENTIFIER THEN 70253000 T 0006
BEGIN 70254000 T 0006
LISTINX:=0; FIRST:=TRUE; 70255000 T 0007
DO BEGIN 70256000 T 0008
IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 70257000 T 0008
IF CURSY=IDENTIFIER THEN 70258000 T 0011
BEGIN 70259000 T 0012
IF LISTINX}LISTLENGTH THEN BEGIN ERROR(37); LISTINX:=0 END; 70260000 T 0012
LISTINX:=LISTINX+1; 70261000 T 0015
NEWNAME(CURNAME1,CURNAME2,RECTAB); 70262000 T 0016
ILIST[LISTINX]:=THISINDEX; 70263000 T 0038
INSYMBOL; 70264000 T 0039
END ELSE 70265000 T 0040
BEGIN ERROR(9); 70266000 T 0040
IF CURSY!COMMA THEN INSYMBOL; 70267000 T 0041
END; 70268000 T 0043
END UNTIL CURSY!COMMA; 70269000 T 0043
IF CURSY!COLON THEN BEGIN ERROR(26); SKIP(COLON) END; 70270000 T 0044
INSYMBOL; 70271000 T 0047
TYPEDECL(TX,SX); 70272000 T 0047
IF TX>0 THEN IF TYPETAB1[TX].FORM}FILES THEN ERROR(57); 70273000 T 0048
T3.IDCLASS:=VAR; T3.TYPE:=TX; 70274000 T 0052
FOR I:=1 STEP 1 UNTIL LISTINX DO 70275000 T 0056
BEGIN 70276000 T 0057
T3.INFO:=ADDR; ADDR:=MIN(ADDR+SX,1024); 70277000 T 0057
NAMETAB3[RECTAB,ILIST[I]]:=T3; 70278000 T 0062
END; 70279000 T 0064
END; 70280000 T 0066
END UNTIL CURSY!SEMICOLON; 70281000 T 0066
LASTADDR:=ADDR; 70282000 T 0068
GO TO EXIT; 70283000 T 0069
70284000 T 0071
CASEPART: 70285000 T 0071
LISTINX:=0; LASTADDR:=ADDR; INDEX:=-1; 70286000 T 0071
INSYMBOL; 70287000 T 0073
IF CURSY=IDENTIFIER THEN 70288000 T 0074
BEGIN 70289000 T 0075
SEARCH; 70290000 T 0075
IF FOUND AND THISID.IDCLASS=TYPES THEN GO TO CASETYPEID; 70291000 T 0103
NEWNAME(CURNAME1,CURNAME2,RECTAB); INDEX:=THISINDEX; 70292000 T 0105
INSYMBOL; 70293000 T 0128
IF CURSY!COLON THEN ERROR(26); 70294000 T 0128
INSYMBOL; 70295000 T 0130
IF CURSY=IDENTIFIER THEN 70296000 T 0131
BEGIN 70297000 T 0132
SEARCH; 70298000 T 0132
IF FOUND THEN 70299000 T 0160
BEGIN 70300000 T 0160
IF THISID.IDCLASS=TYPES THEN 70301000 T 0160
BEGIN 70302000 T 0162
CASETYPEID: CASETYPE:=THISID.TYPE; T1:=TYPETAB1[CASETYPE]; 70303000 T 0162
LLIM:=TYPETAB2[CASETYPE]; ULIM:=TYPETAB3[CASETYPE]; 70304000 T 0165
IF T1.FORM>CHAR THEN ERROR(48); 70305000 T 0167
IF INDEX}0 THEN 70306000 T 0169
BEGIN 70307000 T 0170
T3.IDCLASS:=VAR; T3.TYPE:=CASETYPE; T3.INFO:=ADDR; 70308000 T 0171
ADDR:=LASTADDR:=ADDR+1; NAMETAB3[RECTAB,INDEX]:=T3; 70309000 T 0176
END; 70310000 T 0180
INSYMBOL; 70311000 T 0180
END ELSE BEGIN ERROR(7); SKIP(OFSY) END; 70312000 T 0180
END ELSE BEGIN ERROR(1); SKIP(OFSY) END; 70313000 T 0182
END ELSE BEGIN ERROR(9); SKIP(OFSY) END; 70314000 T 0184
END ELSE BEGIN ERROR(9); SKIP(OFSY) END; 70315000 T 0186
IF CURSY!OFSY THEN BEGIN ERROR(18); SKIP(RPAR) END; 70316000 T 0188
IF CURSY=OFSY THEN INSYMBOL; 70317000 T 0191
IF CASETYPE=0 THEN BEGIN LLIM:=-MAXINT; ULIM:=MAXINT END; 70318000 T 0193
DO BEGIN 70319000 T 0196
WHILE CURSY=SEMICOLON DO INSYMBOL; 70320000 T 0196
IF CURSY{CHARCONST OR CURSY=PLUS OR CURSY=MINUS THEN 70321000 T 0200
BEGIN 70322000 T 0202
FIRST:=TRUE; 70323000 T 0203
DO BEGIN 70324000 T 0204
IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 70325000 T 0204
CONSTANT(CVAL,CTYPE); 70326000 T 0206
IF CTYPE>0 THEN 70327000 T 0293
BEGIN 70328000 T 0294
IF CASETYPE=0 THEN CASETYPE:=CTYPE ELSE 70329000 T 0294
IF CVAL<LLIM OR CVAL>ULIM THEN ERROR(14) ELSE 70330000 T 0296
CHECKTYPES(CASETYPE,CTYPE); 70331000 T 0300
IF LISTINX}LISTLENGTH THEN BEGIN ERROR(30); LISTINX:=0 END; 70332000 T 0358
LISTINX:=LISTINX+1; 70333000 T 0361
ILIST[LISTINX]:=CVAL; I:=1; 70334000 T 0362
WHILE ILIST[I]!CVAL DO I:=I+1; 70335000 T 0364
IF I<LISTINX THEN ERROR(31); 70336000 T 0367
END; 70337000 T 0369
END UNTIL CURSY!COMMA; 70338000 T 0369
IF CURSY!COLON THEN BEGIN ERROR(26); SKIP(LPAR) END; 70339000 T 0371
IF CURSY=COLON THEN INSYMBOL; 70340000 T 0373
IF CURSY=LPAR THEN 70341000 T 0375
BEGIN 70342000 T 0376
INSYMBOL; FIELDLIST(RECTAB,ADDR,MAXADDR); 70343000 T 0376
IF MAXADDR>LASTADDR THEN LASTADDR:=MAXADDR; 70344000 T 0378
IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(RPAR) END; 70345000 T 0380
INSYMBOL; 70346000 T 0383
END ELSE ERROR(58); 70347000 T 0384
END; 70348000 T 0385
END UNTIL CURSY NEQ SEMICOLON; % 70349000 T 0385
EXIT: 70350000 T 0386
END OF FIELDLIST; 70351000 T 0387
37 IS 395 LONG, NEXT SEG 2
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 80001000 T 0368
% % 80002000 T 0368
% % 80003000 T 0368
% % 80004000 T 0368
% PART 8: THE PROCEDURE BLOCK. % 80005000 T 0368
% -------------------- % 80006000 T 0368
% % 80007000 T 0368
% % 80008000 T 0368
% % 80009000 T 0368
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 80010000 T 0368
80011000 T 0368
80012000 T 0368
80013000 T 0368
PROCEDURE DECLAREVARS(PARAM,TAB,FIRST,LAST,LEVEL); 80014000 T 0368
VALUE PARAM,FIRST,LAST,LEVEL; 80015000 T 0368
INTEGER ARRAY TAB[0]; 80016000 T 0368
INTEGER FIRST,LAST,LEVEL; 80017000 T 0368
BOOLEAN PARAM; 80018000 T 0368
BEGIN 80019000 T 0368
INTEGER LEVEL1000,TYP,NAM,NAMTAB,T1,I,J,RECSIZE; 80020000 T 0368
START OF SEGMENT ********** 38
BOOLEAN REALVAR,ARRAYVAR,FIRSTDIM,EXTFILE; 80021000 T 0000
ALPHA FNAME; 80022000 T 0000
INTEGER FNLENGTH,FNSTART; % 80023000 T 0000
80024000 T 0000
LEVEL1000:=LEVEL|1000; 80025000 T 0000
FOR I:=FIRST STEP 1 UNTIL LAST DO 80026000 T 0001
BEGIN 80027000 T 0002
NAM:=TAB[I].[9:10]; NAMTAB:=NAMETAB3[LEVEL,NAM]; 80028000 T 0002
TYP:=NAMTAB.TYPE; T1:=TYPETAB1[TYP]; 80029000 T 0005
IF NAMTAB.IDCLASS GEQ FUNC THEN 80030000 T 0007
BEGIN 80031000 T 0008
IF REALVAR OR ARRAYVAR THEN 80032000 T 0009
BEGIN 80033000 T 0010
GEN(";",1,7); 80034000 T 0010
REALVAR:=ARRAYVAR:=FALSE; 80035000 T 0019
END; 80036000 T 0020
IF NAMTAB.IDCLASS=FUNC THEN GEN("REAL",5,4); 80037000 T 0020
GEN("PROCEDU",8,1); 80038000 T 0031
GENID("V",LEVEL1000+NAM,5); GEN(";",1,7); 80039000 T 0040
END ELSE 80040000 T 0061
IF T1.STRUCT=0 THEN %*** SIMPLE TYPE *** 80041000 T 0061
BEGIN 80042000 T 0065
IF ARRAYVAR THEN BEGIN GEN(";",1,7); ARRAYVAR:=FALSE END; 80043000 T 0065
IF REALVAR THEN GEN(",",1,7) ELSE 80044000 T 0076
BEGIN GEN("REAL",5,4); REALVAR:=TRUE END; 80045000 T 0086
GENID("V",LEVEL1000+NAM,5); 80046000 T 0096
END ELSE 80047000 T 0108
BEGIN 80048000 T 0108
IF REALVAR THEN BEGIN GEN(";",1,7); REALVAR:=FALSE END; 80049000 T 0110
IF T1.FORM<FILES THEN %*** ARRAY/RECORD *** 80050000 T 0120
BEGIN 80051000 T 0121
IF ARRAYVAR THEN GEN(",",1,7) ELSE 80052000 T 0122
BEGIN GEN("ARRAY",6,3); ARRAYVAR:=TRUE END; 80053000 T 0132
GENID("V",LEVEL1000+NAM,5); GEN("[",1,7); 80054000 T 0142
FIRSTDIM:=TRUE; 80055000 T 0163
DO BEGIN 80056000 T 0164
IF FIRSTDIM THEN FIRSTDIM:=FALSE ELSE GEN(",",1,7); 80057000 T 0164
GENINT(TYPETAB2[TYP]); 80058000 T 0176
IF NOT PARAM THEN 80059000 T 0218
BEGIN GEN(";",1,7); GENINT(TYPETAB3[TYP]) END; 80060000 T 0219
TYP:=IF T1.FORM=ARRAYS THEN T1.ARRTYPE ELSE REALTYPE; 80061000 T 0271
T1:=TYPETAB1[TYP]; 80062000 T 0275
END UNTIL T1.STRUCT=0; 80063000 T 0276
GEN("]",1,7); 80064000 T 0278
END ELSE 80065000 T 0287
BEGIN %*** FILE *** 80066000 T 0287
IF REALVAR OR ARRAYVAR THEN 80067000 T 0287
BEGIN GEN(";",1,7); REALVAR:=ARRAYVAR:=FALSE END; 80068000 T 0288
IF T1.FORM=TEXTFILE AND NOT PARAM THEN 80069000 T 0299
BEGIN 80070000 T 0301
IF NUMFILES}MAXFILES THEN ERROR(97) 80071000 T 0301
ELSE NUMFILES:=NUMFILES+1; 80072000 T 0303
FILETAB[NUMFILES]:=NAM; 80073000 T 0305
END; 80074000 T 0306
EXTFILE:=FALSE; 80075000 T 0306
FNAME:=NAMETAB1[LEVEL,NAM]; 80076000 T 0307
FNLENGTH := FNAME.NAMELENGTH; FNSTART := 8-FNLENGTH; % 80077000 T 0309
IF FNLENGTH LEQ 6 THEN % 80078000 T 0311
BEGIN 80079000 T 0312
FOR J:=1 STEP 1 UNTIL NUMEXTFILES DO 80080000 T 0313
IF FNAME=EXTFILETAB[J] THEN EXTFILE:=TRUE; 80081000 T 0314
END; 80082000 T 0318
IF EXTFILE AND NOT PARAM THEN 80083000 T 0318
BEGIN 80084000 T 0319
IF NUMFILES GEQ MAXFILES THEN ERROR(97) 80085000 T 0320
ELSE 80086000 T 0321
NUMFILES := NUMFILES + 1; 80087000 T 0322
FILETAB[NUMFILES] := -NAM - 1; 80088000 T 0323
GEN("DEFINE",7,2); GENID("F",LEVEL1000+NAM,5); 80089000 T 0325
GEN("=",1,7); 80090000 T 0346
GEN(FNAME,FNLENGTH,FNSTART); % 80091000 T 0355
GEN("#;",2,6); GEN("SAVE",5,4); GEN("FILE",5,4); 80092000 T 0364
GEN(FNAME,FNLENGTH,FNSTART); % 80093000 T 0391
END ELSE 80094000 T 0400
BEGIN 80095000 T 0400
GEN("FILE",5,4); GENID("F",LEVEL1000+NAM,5); 80096000 T 0405
END; 80097000 T 0426
IF NOT PARAM THEN 80098000 T 0426
BEGIN 80099000 T 0426
GEN(" DISK",6,3); GEN("SERIAL",7,2); 80100000 T 0427
IF EXTFILE THEN 80101000 T 0445
BEGIN 80102000 T 0445
IF ALGOLCNT LSS 13 THEN WRITEALGOL; 80103000 T 0445
GEN("[0:0]",5,3); 80104000 T 0447
GEN(""",1,7); 80105000 T 0456
GEN(FNAME,FNLENGTH,FNSTART); % 80106000 T 0465
GEN(""",1,7); GEN("/",1,7); 80107000 T 0474
IF ALGOLCNT<9 THEN WRITEALGOL; 80108000 T 0492
GEN(""",1,7); GEN(USER,7,1); GEN(""",1,7); 80109000 T 0494
END ELSE 80110000 T 0526
BEGIN 80111000 T 0526
GEN("[20:",4,4); GEN("300]",4,4); 80112000 T 0526
END; 80113000 T 0544
GEN("(1,",3,5); 80114000 T 0544
RECSIZE:=IF T1.FORM=TEXTFILE THEN 10 ELSE 80115000 T 0553
IF TYPETAB1[T1.FILETYPE].STRUCT=0 THEN 1 ELSE 80116000 T 0556
TYPETAB3[T1.FILETYPE]-TYPETAB2[T1.FILETYPE]+1; 80117000 T 0559
GENINT(RECSIZE); GEN(",",1,7); 80118000 T 0562
IF RECSIZE=1 OR RECSIZE=10 THEN GENINT(150) 80119000 T 0616
ELSE GENINT(RECSIZE); 80120000 T 0618
IF ALGOLCNT LSS 10 THEN WRITEALGOL; 80121000 T 0703
GEN(",SAVE",6,3); GEN("30",2,6); 80122000 T 0705
GEN(");",2,6); 80123000 T 0723
END ELSE GEN(";",1,7); 80124000 T 0732
GEN("ARRAY",6,3); GENID("V",LEVEL1000+NAM,5); 80125000 T 0744
GEN("[",1,7); 80126000 T 0765
IF TYPETAB1[T1.FILETYPE].STRUCT=0 THEN 80127000 T 0774
BEGIN 80128000 T 0776
IF PARAM THEN GEN("0",1,7) ELSE GEN("0:0",3,5); 80129000 T 0776
END ELSE 80130000 T 0797
BEGIN 80131000 T 0797
GENINT(TYPETAB2[T1.FILETYPE]); 80132000 T 0797
IF NOT PARAM THEN 80133000 T 0840
BEGIN GEN(":",1,7); GENINT(TYPETAB3[T1.FILETYPE]) END; 80134000 T 0841
END; 80135000 T 0894
GEN("];",2,6); 80136000 T 0894
GEN("INTEGER",8,1); GENID("I",LEVEL1000+NAM,5); 80137000 T 0903
GEN(";",1,7); 80138000 T 0924
END; 80139000 T 0933
END; 80140000 T 0933
END OF LOOP; 80141000 T 0933
IF REALVAR OR ARRAYVAR THEN GEN(";",1,7); 80142000 T 0936
END OF DECLAREVARS; 80143000 T 0946
38 IS 963 LONG, NEXT SEG 2
80144000 T 0368
80145000 T 0368
PROCEDURE PARAMETERLIST; 80146000 T 0368
BEGIN 80147000 T 0368
INTEGER FIRSTPARAM,CURKIND,P1,PX,I,T; 80148000 T 0368
START OF SEGMENT ********** 39
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 0006
IF CURSY=VARSY OR CURSY=FUNCSY OR CURSY=PROCSY THEN 80163000 T 0007
BEGIN 80164000 T 0009
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 0015
FIRST:=TRUE; P1:=NUMPARAMS+1; 80169000 T 0016
DO BEGIN 80170000 T 0018
IF FIRST THEN FIRST:=FALSE ELSE INSYMBOL; 80171000 T 0018
IF CURSY=IDENTIFIER THEN 80172000 T 0021
BEGIN 80173000 T 0022
NEWNAME(CURNAME1,CURNAME2,CURLEVEL+1); 80174000 T 0022
PX:=THISINDEX; PX.PARAMKIND:=CURKIND; 80175000 T 0047
PX.PARAMLEVEL:=CURLEVEL+1; 80176000 T 0050
NEWPARAM; PARAMTAB[NUMPARAMS]:=PX; 80177000 T 0052
END ELSE ERROR(9); 80178000 T 0058
INSYMBOL; 80179000 T 0059
END UNTIL CURSY!COMMA; 80180000 T 0059
IF CURSY=COLON THEN 80181000 T 0061
BEGIN 80182000 T 0061
IF CURKIND=PROC THEN ERROR(90); 80183000 T 0062
INSYMBOL; 80184000 T 0064
IF CURSY=IDENTIFIER THEN 80185000 T 0064
BEGIN 80186000 T 0065
SEARCH; 80187000 T 0066
IF FOUND THEN 80188000 T 0093
BEGIN 80189000 T 0093
IF THISID.IDCLASS=TYPES THEN 80190000 T 0094
BEGIN 80191000 T 0095
T3:=THISID.TYPE; 80192000 T 0096
FOR I:=P1 STEP 1 UNTIL NUMPARAMS DO 80193000 T 0097
PARAMTAB[I].PARAMTYPE:=T3; 80194000 T 0098
IF CURKIND=CONST OR CURKIND=VAR THEN 80195000 T 0102
BEGIN 80196000 T 0104
T:=TYPETAB1[T3]; 80197000 T 0105
IF T.FORM}FILES THEN 80198000 T 0106
FOR I:=P1 STEP 1 UNTIL NUMPARAMS DO 80199000 T 0107
PARAMTAB[I].PARAMFILE:=1; 80200000 T 0109
IF T.STRUCT>0 AND CURKIND=CONST THEN ERROR(94); 80201000 T 0113
END ELSE IF T.STRUCT>0 THEN ERROR(38); 80202000 T 0117
END ELSE BEGIN ERROR(7); T3:=0 END; 80203000 T 0120
END ELSE BEGIN ERROR(1); T3:=0 END; 80204000 T 0122
END ELSE BEGIN ERROR(9); T3:=0 END; 80205000 T 0124
INSYMBOL; 80206000 T 0126
END ELSE 80207000 T 0126
BEGIN 80208000 T 0126
IF CURKIND!PROC THEN ERROR(7); 80209000 T 0127
T3:=0; 80210000 T 0129
END; 80211000 T 0130
T3.IDCLASS:=CURKIND; T3.FORMAL:=1; 80212000 T 0130
FOR I:=P1 STEP 1 UNTIL NUMPARAMS DO 80213000 T 0133
NAMETAB3[CURLEVEL+1,PARAMTAB[I].PARAMNAME]:=T3; 80214000 T 0135
END UNTIL CURSY!SEMICOLON; 80215000 T 0140
IF CURSY!RPAR THEN 80216000 T 0141
BEGIN ERROR(49); SKIP(RPAR); 80217000 T 0142
IF CURSY=RPAR THEN INSYMBOL; 80218000 T 0144
END ELSE INSYMBOL; 80219000 T 0146
END; 80220000 T 0147
PARAMTAB[FIRSTPARAM]:=NUMPARAMS-FIRSTPARAM; 80221000 T 0147
END OF PARAMETERLIST; 80222000 T 0149
39 IS 154 LONG, NEXT SEG 2
80223000 T 0368
80400000 T 0368
PROCEDURE BLOCK; 80401000 T 0368
BEGIN 80402000 T 0368
INTEGER INDEX,CTYPE,NUMFORWARDS,T,T3,TX,I; 80403000 T 0368
START OF SEGMENT ********** 40
REAL CVAL; 80404000 T 0000
ALPHA C1,C2; 80405000 T 0000
BOOLEAN VALUEPARAMS,FUN; 80406000 T 0000
LABEL START; 80407000 T 0000
80408000 T 0000
INTEGER LABTABTOP,CONSTTABTOP,TYPETABTOP,PARAMTABTOP,TOPREC, 80409000 T 0000
FORMERFIRSTLAB,FIRSTFILE; 80410000 T 0000
80411000 T 0000
FORMERFIRSTLAB:=FIRSTLAB; 80412000 T 0000
LABTABTOP:=NUMLABS; FIRSTLAB:=LABTABTOP+1; 80413000 T 0000
CONSTTABTOP:=NUMCONSTS; 80414000 T 0002
TYPETABTOP:=NUMTYPES; 80415000 T 0003
PARAMTABTOP:=NUMPARAMS; 80416000 T 0004
TOPREC:=LASTREC; 80417000 T 0005
FIRSTFILE:=NUMFILES+1; 80418000 T 0005
80419000 T 0007
TOPLEVEL:=CURLEVEL; 80420000 T 0007
IF CURLEVEL>1 THEN GEN("BEGIN",6,3); 80421000 T 0007
START: 80422000 T 0018
IF CURSY=LABELSY THEN %*** LABEL DECLARATION *** 80423000 T 0018
BEGIN %************************* 80424000 T 0018
GEN("LABEL",6,3); 80425000 T 0019
DO BEGIN 80426000 T 0028
INSYMBOL; 80427000 T 0028
IF CURSY=INTCONST THEN 80428000 T 0028
BEGIN 80429000 T 0029
GENID("L",CURVAL,4); 80430000 T 0030
IF CURVAL>9999 THEN ERROR(33); 80431000 T 0041
FOR I:=FIRSTLAB STEP 1 UNTIL NUMLABS DO 80432000 T 0043
IF LABTAB[I].LABVAL=CURVAL THEN ERROR(31); 80433000 T 0048
IF NUMLABS}MAXLABS THEN BEGIN ERROR(34); NUMLABS:=0 END; 80434000 T 0053
NUMLABS:=NUMLABS+1; 80435000 T 0055
LABTAB[NUMLABS]:=CURVAL; 80436000 T 0057
INSYMBOL; 80437000 T 0058
END ELSE BEGIN ERROR(10); SKIP(COMMA) END; 80438000 T 0058
IF CURSY=COMMA THEN GEN(",",1,7); 80439000 T 0060
END UNTIL CURSY!COMMA; 80440000 T 0071
IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80441000 T 0072
GEN(";",1,7); 80442000 T 0075
IF SYMKIND[CURSY]!INITIAL THEN INSYMBOL; 80443000 T 0084
END OF LABEL DECLARATION; 80444000 T 0086
80445000 T 0086
IF CURSY=CONSTSY THEN %*** CONSTANT DECLARATION *** 80446000 T 0086
BEGIN %**************************** 80447000 T 0086
INSYMBOL; 80448000 T 0087
DO BEGIN 80449000 T 0087
IF CURSY=IDENTIFIER THEN 80450000 T 0087
BEGIN 80451000 T 0088
NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80452000 T 0089
INSYMBOL; 80453000 T 0111
IF CURSY=EQLSY THEN 80454000 T 0112
BEGIN 80455000 T 0113
INSYMBOL; CONSTANT(CVAL,CTYPE); 80456000 T 0113
T3:=CTYPE; T3.IDCLASS:=CONST; 80457000 T 0200
IF CVAL.[46:8]!0 OR CVAL>1023 THEN 80458000 T 0203
BEGIN 80459000 T 0205
IF NUMCONSTS}MAXCONSTS THEN 80460000 T 0206
BEGIN ERROR(35); NUMCONSTS:=0 END; 80461000 T 0206
NUMCONSTS:=NUMCONSTS+1; 80462000 T 0208
CONSTTAB[NUMCONSTS]:=CVAL; 80463000 T 0210
T3.INFO:=1023+NUMCONSTS; 80464000 T 0211
END ELSE T3.INFO:=CVAL; 80465000 T 0213
NAMETAB3[CURLEVEL,INDEX]:=T3; 80466000 T 0215
END ELSE BEGIN ERROR(36); SKIP(SEMICOLON) END; 80467000 T 0217
END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80468000 T 0219
IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80469000 T 0221
IF SYMKIND[CURSY]!INITIAL THEN INSYMBOL; 80470000 T 0224
END UNTIL CURSY!IDENTIFIER; 80471000 T 0226
END OF CONSTANT DECLARATION; 80472000 T 0227
80473000 T 0227
IF CURSY=TYPESY THEN %*** TYPE DECLARATION **** 80474000 T 0227
BEGIN %************************* 80475000 T 0228
INSYMBOL; 80476000 T 0229
DO BEGIN 80477000 T 0229
IF CURSY=IDENTIFIER THEN 80478000 T 0229
BEGIN 80479000 T 0230
NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80480000 T 0230
INSYMBOL; 80481000 T 0253
IF CURSY=EQLSY THEN 80482000 T 0254
BEGIN 80483000 T 0254
INSYMBOL; 80484000 T 0255
TYPEDECL(CTYPE,TX); 80485000 T 0255
T3:=CTYPE; T3.IDCLASS:=TYPES; 80486000 T 0256
NAMETAB3[CURLEVEL,INDEX]:=T3; 80487000 T 0259
END ELSE BEGIN ERROR(36); SKIP(SEMICOLON) END; 80488000 T 0261
END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80489000 T 0263
IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80490000 T 0265
IF SYMKIND[CURSY]!INITIAL THEN INSYMBOL; 80491000 T 0268
END UNTIL CURSY!IDENTIFIER; 80492000 T 0270
END OF TYPE DECLARATION; 80493000 T 0271
80494000 T 0271
IF CURSY=VARSY THEN %*** VARIABLE DECLARATION *** 80495000 T 0271
BEGIN %**************************** 80496000 T 0272
VARINDEX:=0; 80497000 T 0272
DO BEGIN 80498000 T 0273
FIRSTVAR:=VARINDEX+1; 80499000 T 0273
DO BEGIN 80500000 T 0274
IF CURSY=VARSY OR CURSY=COMMA THEN INSYMBOL; 80501000 T 0274
IF CURSY=IDENTIFIER THEN 80502000 T 0277
BEGIN 80503000 T 0278
IF VARINDEX}LISTLENGTH THEN 80504000 T 0278
BEGIN ERROR(37); VARINDEX:=0 END; 80505000 T 0279
VARINDEX:=VARINDEX+1; 80506000 T 0281
NEWNAME(CURNAME1,CURNAME2,CURLEVEL); 80507000 T 0282
VARLIST[VARINDEX]:=THISINDEX; 80508000 T 0304
INSYMBOL; 80509000 T 0305
END ELSE BEGIN ERROR(9); SKIP(COLON) END; 80510000 T 0306
END UNTIL CURSY!COMMA; 80511000 T 0308
IF CURSY!COLON THEN BEGIN ERROR(26); SKIP(COLON) END; 80512000 T 0309
IF CURSY=COLON THEN 80513000 T 0312
BEGIN 80514000 T 0313
INSYMBOL; 80515000 T 0313
TYPEDECL(CTYPE,TX); 80516000 T 0314
T3:=CTYPE; T3.IDCLASS:=VAR; 80517000 T 0315
FOR I:=FIRSTVAR STEP 1 UNTIL VARINDEX DO 80518000 T 0317
NAMETAB3[CURLEVEL,VARLIST[I]]:=T3; 80519000 T 0319
END ELSE BEGIN ERROR(26); SKIP(SEMICOLON) END; 80520000 T 0323
IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80521000 T 0325
IF SYMKIND[CURSY]!INITIAL THEN INSYMBOL; 80522000 T 0328
END UNTIL CURSY!IDENTIFIER; 80523000 T 0330
DECLAREVARS(FALSE,VARLIST,1,VARINDEX,CURLEVEL); 80524000 T 0331
END OF VARIABLE DECLARATIONS; 80525000 T 0333
80526000 T 0333
IF NUMPNTRS>0 THEN 80527000 T 0333
BEGIN 80528000 T 0334
C1:=CURNAME1; C2:=CURNAME2; 80529000 T 0335
FOR I:=1 STEP 1 UNTIL NUMPNTRS DO 80530000 T 0336
BEGIN 80531000 T 0338
CURNAME1:=PNTRTAB1[I]; CURNAME2:=PNTRTAB2[I]; 80532000 T 0338
SEARCHTAB(CURLEVEL); 80533000 T 0340
THISID:=NAMETAB3[CURLEVEL,THISINDEX]; 80534000 T 0358
IF FOUND AND THISID.IDCLASS=TYPES THEN 80535000 T 0359
TYPETAB1[PNTRTAB3[I]].POINTTYPE:=THISID.TYPE ELSE ERROR(62); 80536000 T 0361
END; 80537000 T 0366
CURNAME1:=C1; CURNAME2:=C2; NUMPNTRS:=0; 80538000 T 0368
END; 80539000 T 0371
80540000 T 0371
WHILE CURSY=FUNCSY OR CURSY=PROCSY DO %*** PROC/FUNC DECLARATION *** 80541000 T 0371
BEGIN %***************************** 80542000 T 0373
FUN:=CURSY=FUNCSY; INSYMBOL; 80543000 T 0373
IF CURSY=IDENTIFIER THEN 80544000 T 0375
BEGIN 80545000 T 0375
SEARCHTAB(CURLEVEL); 80546000 T 0376
THISID:=NAMETAB3[CURLEVEL,THISINDEX]; 80547000 T 0394
IF FOUND AND THISID.IDCLASS}PROC THEN 80548000 T 0396
BEGIN 80549000 T 0397
INDEX:=THISINDEX; 80550000 T 0398
IF THISID.FORWARDDEF=1 THEN 80551000 T 0399
BEGIN 80552000 T 0400
NAMETAB3[THISLEVEL,THISINDEX].FORWARDDEF:=0; 80553000 T 0400
NUMFORWARDS:=NUMFORWARDS-1; 80554000 T 0404
IF(THISID.IDCLASS=PROC AND FUN)OR 80555000 T 0405
(THISID.IDCLASS=FUNC AND NOT FUN) THEN ERROR(43); 80556000 T 0407
INSYMBOL; 80567000 T 0410
END ELSE BEGIN ERROR(2); SKIP(SEMICOLON) END; 80568000 T 0411
END ELSE 80569000 T 0413
BEGIN 80570000 T 0413
NEWNAME(CURNAME1,CURNAME2,CURLEVEL); INDEX:=THISINDEX; 80571000 T 0413
T3:=0; T3.INFO:=NUMPARAMS+1; 80572000 T 0436
T3.IDCLASS:=IF FUN THEN FUNC ELSE PROC; 80573000 T 0439
NAMETAB3[CURLEVEL,INDEX]:=T3; 80574000 T 0442
INSYMBOL; PARAMETERLIST; 80575000 T 0444
IF CURSY=COLON THEN 80576000 T 0445
BEGIN 80577000 T 0446
IF NOT FUN THEN ERROR(48); 80578000 T 0446
INSYMBOL; 80579000 T 0448
IF CURSY=IDENTIFIER THEN 80580000 T 0449
BEGIN 80581000 T 0449
SEARCH; 80582000 T 0450
IF FOUND THEN 80583000 T 0477
BEGIN 80584000 T 0478
IF THISID.IDCLASS=TYPES THEN 80585000 T 0478
BEGIN 80586000 T 0479
T:=TYPETAB1[THISID.TYPE]; 80587000 T 0480
IF T.FORM{ALFA OR T.FORM=POINTERS THEN 80588000 T 0481
BEGIN 80589000 T 0484
NAMETAB3[CURLEVEL,INDEX].TYPE:=THISID.TYPE; 80590000 T 0485
END ELSE ERROR(38); 80591000 T 0488
END ELSE ERROR(7); 80592000 T 0490
END ELSE ERROR(1); 80593000 T 0491
END ELSE ERROR(9); 80594000 T 0492
INSYMBOL; 80595000 T 0493
END ELSE IF FUN THEN 80596000 T 0494
BEGIN ERROR(26); SKIP(SEMICOLON) END; 80597000 T 0495
END; 80598000 T 0497
END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 80599000 T 0497
IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80600000 T 0499
IF FUN THEN GEN("FUNCTN",7,2) ELSE 80601000 T 0501
GEN("PROCEDU",8,1); GENID("V",1000|CURLEVEL+INDEX,5); 80602000 T 0511
T:=NAMETAB3[CURLEVEL,INDEX].INFO; TX:=T+PARAMTAB[T]; 80603000 T 0534
IF TX>T THEN 80604000 T 0538
BEGIN 80605000 T 0539
GEN("(",1,7); 80606000 T 0539
FOR I:=T+1 STEP 1 UNTIL TX DO 80607000 T 0548
BEGIN GENID("V",1000|(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80608000 T 0552
IF BOOLEAN(PARAMTAB[I].PARAMFILE) THEN 80609000 T 0566
BEGIN 80610000 T 0567
GEN(",",1,7); 80611000 T 0568
GENID("F",1000|(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80612000 T 0577
GEN(",",1,7); 80613000 T 0590
GENID("I",1000|(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80614000 T 0599
END; 80615000 T 0613
IF I LSS TX THEN GEN(",",1,7); 80616000 T 0613
END; 80617000 T 0625
GEN(");",2,6); 80618000 T 0626
VALUEPARAMS:=FALSE; 80619000 T 0635
FOR I:=T+1 STEP 1 UNTIL TX DO 80620000 T 0636
IF PARAMTAB[I].PARAMKIND=CONST THEN 80621000 T 0640
BEGIN 80622000 T 0641
IF NOT VALUEPARAMS THEN 80623000 T 0642
BEGIN GEN("VALUE",6,3); 80624000 T 0642
VALUEPARAMS:=TRUE; 80625000 T 0652
END ELSE GEN(",",1,7); 80626000 T 0653
GENID("V",1000|(CURLEVEL+1)+PARAMTAB[I].PARAMNAME,5); 80627000 T 0665
END; 80628000 T 0678
IF VALUEPARAMS THEN GEN(";",1,7); 80629000 T 0679
DECLAREVARS(TRUE,PARAMTAB,T+1,TX,CURLEVEL+1); 80630000 T 0689
END ELSE GEN(";",1,7); 80631000 T 0692
80632000 T 0701
INSYMBOL; 80633000 T 0701
IF CURNAME1="7FORWAR" AND CURNAME2="D" THEN 80634000 T 0702
BEGIN 80635000 T 0704
NAMETAB3[CURLEVEL,INDEX].FORWARDDEF:=1; 80636000 T 0704
NUMFORWARDS:=NUMFORWARDS+1; 80637000 T 0707
GEN("FORWARD",8,1); 80638000 T 0709
INSYMBOL; 80639000 T 0718
END ELSE 80640000 T 0718
BEGIN 80641000 T 0718
CURLEVEL:=CURLEVEL+1; 80642000 T 0721
IF CURLEVEL}LASTREC THEN ERROR(55); 80643000 T 0722
BLOCKTAB[CURLEVEL]:=NUMBLOCKS:=NUMBLOCKS+1; 80644000 T 0724
T:=CURFUNC; CURFUNC:=IF FUN THEN INDEX ELSE -1; 80645000 T 0726
BLOCK; %*** COMPILE PROCEDURE BODY *** 80646000 T 0729
REPLACE POINTER(NAMETAB1[CURLEVEL,*]) BY 0 80647000 T 0730
FOR MAXNAMES+1 WORDS; 80648000 T 0732
CURLEVEL:=CURLEVEL-1; CURFUNC:=T; 80649000 T 0735
TOPLEVEL:=CURLEVEL; 80650000 T 0737
END; 80651000 T 0738
IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 80652000 T 0738
GEN(";",1,7); 80653000 T 0741
IF SYMKIND[CURSY]!INITIAL THEN INSYMBOL; 80654000 T 0750
END OF PROCEDURE DECLARATION; 80655000 T 0752
80656000 T 0752
80657000 T 0752
IF NUMFORWARDS>0 THEN ERROR(44); 80658000 T 0752
GEN("INTEGER",8,1); 80659000 T 0756
FOR I:=1 STEP 1 UNTIL MAXTEMPS DO 80660000 T 0765
BEGIN GENID("T",I,2); 80661000 T 0767
IF I<MAXTEMPS THEN GEN(",",1,7) ELSE GEN(";",1,7); 80662000 T 0778
END; 80663000 T 0798
IF CURSY!BEGINSY THEN 80664000 T 0800
BEGIN ERROR(39); 80665000 T 0801
WHILE SYMKIND[CURSY]!INITIAL DO 80666000 T 0802
BEGIN INSYMBOL; SKIP(SEMICOLON) END; 80667000 T 0804
IF(CURSY=TYPESY)OR(CONSTSY{CURSY AND CURSY{PROCSY)THEN 80668000 T 0805
GO TO START; 80669000 T 0808
END; 80670000 T 0809
IF CURLEVEL=1 THEN 80671000 T 0809
BEGIN 80672000 T 0810
GEN("INIT(",5,3); 80673000 T 0810
IF INPUTDECL THEN GEN("TRUE",4,4) ELSE GEN("FALSE",5,3); 80674000 T 0819
GEN(");",2,6); 80675000 T 0841
END; 80676000 T 0850
FOR I:=FIRSTFILE STEP 1 UNTIL NUMFILES DO 80677000 T 0850
IF FILETAB[I] LSS 0 THEN 80678000 T 0853
BEGIN 80679000 T 0854
GEN("CHFIL(",6,2); 80680000 T 0854
GENID("F",1000|CURLEVEL-FILETAB[I]-1,5); 80681000 T 0863
GEN(");",2,6); 80682000 T 0876
END 80683000 T 0885
ELSE 80684000 T 0885
BEGIN 80685000 T 0885
GENID("I",1000|CURLEVEL+FILETAB[I],5); 80686000 T 0889
GEN(",",1,7); GEN("BUFSIZE",7,1); GEN(":=80;",5,3); 80687000 T 0901
END; 80688000 T 0928
NUMFILES:=FIRSTFILE-1; 80689000 T 0931
80690000 T 0932
COMPSTAT; %*** COMPILE STATEMENT PART *** 80691000 T 0932
80692000 T 0932
FOR I:=LASTREC STEP 1 UNTIL TOPREC-1 DO 80693000 T 0932
REPLACE POINTER(NAMETAB1[I,*]) BY 0 FOR MAXNAMES+1 WORDS; 80694000 T 0937
FOR I:=FIRSTLAB STEP 1 UNTIL NUMLABS DO 80695000 T 0945
IF LABTAB[I].LABDEF=0 THEN ERROR(93); 80696000 T 0946
LASTREC:=TOPREC; 80697000 T 0951
NUMLABS:=LABTABTOP; 80698000 T 0951
FIRSTLAB:=FORMERFIRSTLAB; 80699000 T 0952
NUMCONSTS:=CONSTTABTOP; 80700000 T 0953
NUMTYPES:=TYPETABTOP; 80701000 T 0954
NUMPARAMS:=PARAMTABTOP; 80702000 T 0954
IF CURLEVEL>1 THEN GEN("END",4,5); 80703000 T 0955
END OF BLOCK; 80704000 T 0965
40 IS 976 LONG, NEXT SEG 2
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90001000 T 0368
% % 90002000 T 0368
% % 90003000 T 0368
% % 90004000 T 0368
% PART 9: THE MAIN PROGRAM. % 90005000 T 0368
% ----------------- % 90006000 T 0368
% % 90007000 T 0368
% % 90008000 T 0368
% % 90009000 T 0368
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90010000 T 0368
90011000 T 0368
90012000 T 0368
INTEGER PROGNAMELENGTH; 90013000 T 0368
ALPHA PROGNAME,ALGOLNAME; 90014000 T 0368
90015000 T 0368
ALGOLNAME:="PASC000"&ENTIER(TIME(4) MOD 10)[17:5:6]; 90016000 T 0368
ALGOLNAME:=ALGOLNAME&ENTIER(TIME(4) DIV 7)[11:5:6]; 90017000 T 0371
ALGOLNAME:=ALGOLNAME&ENTIER(TIME(4) MOD 9)[5:5:6]; 90018000 T 0375
USER:=TIME(-1); 90019000 T 0379
FILL PASCALGOL WITH ALGOLNAME,USER; 90020000 T 0380
BEGIN 90021000 T 0384
FILE PASCRUN DISK SERIAL "PASCRUN"/"DISK" (2,10,150); 90022000 T 0384
START OF SEGMENT ********** 41
ARRAY BUF[0:9]; 90023000 T 0004
LABEL EOF; 90024000 T 0006
90025000 T 0006
WHILE TRUE DO 90026000 T 0006
BEGIN 90027000 T 0007
READ(PASCRUN,9,BUF[*]) [EOF]; 90028000 T 0007
WRITE(PASCALGOL,10,BUF[*]); 90029000 T 0012
END; 90030000 T 0017
EOF: 90031000 T 0017
END OF TRANSFER OF RUN TIME SYSTEM; 90032000 T 0018
41 IS 21 LONG, NEXT SEG 2
CARDLENGTH:=72; 90033000 T 0387
INITIALIZE; NEWCARD; 90034000 T 0387
LISTOPTION:=CHECKOPTION:=TRUE; 90035000 T 0451
C:=" "; INSYMBOL; 90036000 T 0453
IF CURSY=PROGRAMSY THEN 90037000 T 0454
BEGIN 90038000 T 0455
INSYMBOL; 90039000 T 0455
IF CURSY=IDENTIFIER THEN 90040000 T 0456
BEGIN 90041000 T 0456
PROGNAME:=CURNAME1.[35:36]; PROGNAMELENGTH:=MIN(6,CURLENGTH); 90042000 T 0457
INSYMBOL; 90043000 T 0461
IF CURSY=LPAR THEN 90044000 T 0462
BEGIN 90045000 T 0462
DO BEGIN 90046000 T 0463
INSYMBOL; 90047000 T 0463
IF CURSY=IDENTIFIER THEN 90048000 T 0463
BEGIN 90049000 T 0464
IF CURNAME1="50INPUT" THEN INPUTDECL:=TRUE ELSE 90050000 T 0465
IF CURNAME1="6OUTPUT" THEN OUTPUTDECL:=TRUE ELSE 90051000 T 0467
BEGIN 90052000 T 0471
IF CURLENGTH>6 THEN ERROR(77); 90053000 T 0473
NUMEXTFILES:=NUMEXTFILES+1; 90054000 T 0475
IF NUMEXTFILES{MAXEXTFILES THEN 90055000 T 0476
EXTFILETAB[NUMEXTFILES]:=CURNAME1 ELSE 90056000 T 0477
IF NUMEXTFILES=MAXEXTFILES+1 THEN ERROR(73); 90057000 T 0478
END; 90058000 T 0481
END ELSE ERROR(9); 90059000 T 0481
INSYMBOL; 90060000 T 0483
END UNTIL CURSY!COMMA; 90061000 T 0483
IF CURSY!RPAR THEN BEGIN ERROR(46); SKIP(SEMICOLON) END; 90062000 T 0484
IF CURSY=RPAR THEN INSYMBOL; 90063000 T 0487
IF CURSY!SEMICOLON THEN BEGIN ERROR(25); SKIP(SEMICOLON) END; 90064000 T 0489
END ELSE BEGIN ERROR(58); SKIP(SEMICOLON) END; 90065000 T 0492
END ELSE BEGIN ERROR(9); SKIP(SEMICOLON) END; 90066000 T 0494
END ELSE BEGIN ERROR(75); SKIP(SEMICOLON) END; 90067000 T 0496
INSYMBOL; 90068000 T 0498
CURLEVEL:=1; 90069000 T 0498
LASTREC:=MAXTABLES+1; 90070000 T 0499
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90071000 T 0500
% % 90072000 T 0500
BLOCK; % COMPILE USER PROGRAM. % 90073000 T 0500
% % 90074000 T 0501
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 90075000 T 0501
IF CURSY!DOT THEN 90076000 T 0501
BEGIN 90077000 T 0501
ERROR(76); 90078000 T 0502
DO BLOCK UNTIL CURSY=DOT; 90079000 T 0503
END; 90080000 T 0504
IF FALSE THEN 90081000 T 0504
BEGIN 90082000 T 0505
ENDOFINPUT: ERROR(87); CHARCNT:=-1; 90083000 T 0505
WRITE(LINES,TERMMESS); 90084000 T 0507
END; 90085000 T 0510
IF LISTOPTION AND CHARCNT}0 THEN PRINTLINE; 90086000 T 0510
IF ERRINX>0 THEN PRINTERRORS; 90087000 T 0554
WRITE(LINES[DBL]); 90088000 T 0556
WRITE(LINES[DBL]); 90089000 T 0560
IF NUMERRS=0 THEN 90090000 T 0564
BEGIN 90091000 T 0565
ARRAY ZIPARRAY[0:19], Z[0:0]; 90092000 T 0565
START OF SEGMENT ********** 42
POINTER ZIPPNT; 90093000 T 0005
90094000 T 0005
DEFINE ZIPTEXT(TEXT,L)= 90095000 T 0005
BEGIN 90096000 T 0005
Z[0]:=TEXT; 90097000 T 0005
REPLACE ZIPPNT:ZIPPNT BY POINTER(Z[*])+(8-L) FOR L; 90098000 T 0005
END#; 90099000 T 0005
90100000 T 0005
PROCEDURE ZIPNUM(N); % TRANSFERS A NUMBER TO THE ZIP BUFFER. 90101000 T 0005
VALUE N; INTEGER N; 90102000 T 0005
IF N{9 THEN ZIPTEXT(N,1) ELSE 90103000 T 0005
BEGIN ZIPNUM(N DIV 10); ZIPTEXT(ENTIER(N MOD 10),1) END; 90104000 T 0014
90105000 T 0027
WRITEALGOL; 90106000 T 0027
WRITE(PASCALGOL,LASTLINE); 90107000 T 0027
LOCK(PASCALGOL,SAVE); 90108000 T 0030
ZIPPNT:=POINTER(ZIPARRAY[*]); 90109000 T 0032
REPLACE ZIPPNT BY " " FOR 20 WORDS; 90110000 T 0033
WRITE(LINES,NOERRORS); 90111000 T 0037
ZIPTEXT("CC ",3); ZIPTEXT("COMPILE",7); 90112000 T 0040
ZIPTEXT(" ",1); ZIPTEXT(PROGNAME,PROGNAMELENGTH); 90113000 T 0054
ZIPTEXT("/",1); ZIPTEXT(USER,7); 90114000 T 0069
ZIPTEXT(" XALGOL",7); ZIPTEXT(" ",1); 90115000 T 0083
IF SAVEFACTOR>0 THEN ZIPTEXT("LIBRARY",7); 90116000 T 0098
IF SAVEFACTOR<0 THEN ZIPTEXT("SYNTAX",6); 90117000 T 0106
ZIPTEXT(";",1); 90118000 T 0115
ZIPTEXT("XALGOL",6); ZIPTEXT(" FILE",5); 90119000 T 0122
ZIPTEXT(" CARD=",6); ZIPTEXT(ALGOLNAME,7); 90120000 T 0137
ZIPTEXT("/",1); ZIPTEXT(USER,7); 90121000 T 0160
ZIPTEXT(" SERIAL",7); ZIPTEXT(";",1); 90122000 T 0174
IF SAVEFACTOR>0 THEN 90123000 T 0189
BEGIN 90124000 T 0190
ZIPTEXT("SAVE=",5); ZIPNUM(SAVEFACTOR); 90125000 T 0190
ZIPTEXT(";",1); 90126000 T 0198
END; 90127000 T 0205
ZIPTEXT("END.",4); 90128000 T 0205
ZIP WITH ZIPARRAY[*]; 90129000 T 0213
END OF COMPILER ZIP ELSE 90130000 T 0214
42 IS 221 LONG, NEXT SEG 2
BEGIN 91001000 T 0566
INTEGER I; 91002000 T 0566
START OF SEGMENT ********** 43
SWITCH FORMAT ERRORMESS1 := 91003000 T 0000
START OF SEGMENT ********** 44
(" 0 *** COMPILER ERROR *** CONTACT THE COMPUTER CENTRE."), 91004000 T 0000
(" 1 IDENTIFIER NOT DEFINED."), 91005000 T 0000
(" 2 IDENTIFIER ALREADY DEFINED."), 91006000 T 0000
(" 3 WRONG NUMBER OF PARAMETERS."), 91007000 T 0000
(" 4 SYNTAX ERROR."), 91008000 T 0000
(" 5 VARIABLE NOT ACCESSIBLE (HARDWARE RESTRICTION)."), 91009000 T 0000
(" 6 STRINGS MAY NOT BE CONTINUED FROM ONE CARD TO ANOTHER."), 91010000 T 0000
(" 7 A TYPE EXPECTED."), 91011000 T 0000
(" 8 VARIABLE EXPECTED."), 91012000 T 0000
(" 9 IDENTIFIER EXPECTED."), 91013000 T 0000
(" 10 INTEGER CONSTANT EXPECTED."), 91014000 T 0000
(" 11 CONSTANT OF OTHER TYPE THAN EXPECTED."), 91015000 T 0000
(" 12 VARIABLE OF ILLEGAL TYPE."), 91016000 T 0000
(" 13 UNRECOGNIZABLE STATEMENT."), 91017000 T 0000
(" 14 CONSTANT TOO BIG OR TO SMALL."), 91018000 T 0000
(" 15 UNDEFINED LABEL."), 91019000 T 0000
(" 16 FOR- AND CASE-STATEMENTS NESTED TOO DEEP."), 91020000 T 0000
(" 17 EXPRESSION IS OF WRONG TYPE."), 91021000 T 0000
(" 18 """OF""" EXPECTED."), 91022000 T 0000
(" 19 """DO""" EXPECTED."), 91023000 T 0000
(" 20 """ELSE""" WITHOUT CORRESPONDING """THEN"""."), 91024000 T 0000
(" 21 ILLEGAL TERMINATION OF STATEMENT."), 91025000 T 0000
(" 22 """UNTIL""" EXPECTED."), 91026000 T 0000
(" 23 """TO"""/"""DOWNTO""" EXPECTED."), 91027000 T 0000
(" 24 """END""" EXPECTED."), 91028000 T 0000
(" 25 """;""" EXPECTED."), 91029000 T 0000
(" 26 """:""" EXPECTED."), 91030000 T 0000
(" 27 """THEN""" EXPECTED."), 91031000 T 0000
(" 28 """:=""" EXPECTED."), 91032000 T 0000
(" 29 ONLY NUMBERS MAY BE SIGNED."), 91033000 T 0000
(" 30 TOO MANY CASES."), 91034000 T 0000
(" 31 LABEL USED MORE THAN ONCE."), 91035000 T 0000
(" 32 CONSTANT EXPECTED."), 91036000 T 0000
(" 33 LABEL NOT IN RANGE 0..9999."), 91037000 T 0000
(" 34 TOO MANY LABELS DECLARED."), 91038000 T 0000
(" 35 TOO MANY CONSTANTS DECLARED."), 91039000 T 0000
(" 36 """=""" EXPECTED."), 91040000 T 0000
(" 37 THE LIST IS TOO LONG."), 91041000 T 0000
(" 38 INVALID TYPE FOR A FUNCTION."), 91042000 T 0000
(" 39 """BEGIN""" EXPECTED."), 91043000 T 0000
(" 40 TOO MANY IDENTIFIERS DECLARED."), 91044000 T 0000
(" 41 ALFA CONSTANTS MAY NOT BE LONGER THAN 7 CHARACTERS."), 91045000 T 0000
(" 42 EXPRESSION IS NOT OF TYPE BOOLEAN."), 91046000 T 0000
(" 43 NOT PROPER FORWARD DECLARATION."), 91047000 T 0000
(" 44 UNSATISFIED FORWARD DECLARATION."), 91048000 T 0000
(" 45 TOO MANY DIFFERENT TYPES DECLARED."), 91049000 T 0000
(" 46 """)""" EXPECTED."), 91050000 T 0000
(" 47 """[""" EXPECTED."), 91051000 T 0000
(" 48 A SIMPLE TYPE EXPECTED."), 91052000 T 0000
(" 49 """ARRAY OF ARRAY""" AND """ARRAY OF RECORD""" ILLEGAL", 91053000 T 0000
" AS FILE TYPE."), 91054000 T 0000
(" 50 """FILE OF FILE""" IS ILLEGAL."), 91055000 T 0000
(" 51 SET BOUNDRY IS TOO BIG OR TOO SMALL."), 91056000 T 0000
(" 52 TOO MANY UNDECLARED POINTERS."), 91057000 T 0000
(" 53 """..""" EXPECTED."), 91058000 T 0000
(" 54 FIRST VALUE IS GREATER THAN SECOND VALUE."), 91059000 T 0000
(" 55 TOO MANY RECORDS DECLARED AT ONE TIME."), 91060000 T 0000
(" 56 THE RECORD CONTAINS MORE THEN 1023 WORDS."), 91061000 T 0000
(" 57 FILES NOT ALLOWED IN RECORDS."), 91062000 T 0000
(" 58 """(""" EXPECTED."), 91063000 T 0000
(" 59 """]""" EXPECTED."); 91064000 T 0000
44 IS 590 LONG, NEXT SEG 43
91065000 T 0000
SWITCH FORMAT ERRORMESS2 := 91066000 T 0000
START OF SEGMENT ********** 45
(" 60 """ARRAY OF FILE""" NOT ALLOWED."), 91067000 T 0000
(" 61 RANGE OF INDEX IS GREATER THAN 1023."), 91068000 T 0000
(" 62 UNSATISFIED POINTER DECLARATION."), 91069000 T 0000
(" 63 EXPRESSION IS TOO LONG."), 91070000 T 0000
(" 64 ILLEGAL OPERATOR FOR THIS TYPE OF EXPRESSION."), 91071000 T 0000
(" 65 INTEGER EXPRESSION EXPECTED."), 91072000 T 0000
(" 66 A SET EXPECTED."), 91073000 T 0000
(" 67 PARAMETER OF ILLEGAL TYPE."), 91074000 T 0000
(" 68 PROCEDURES NOT ALLOWED IN THIS CONTEXT."), 91075000 T 0000
(" 69 ILLEGAL USE OF THIS TYPE OF IDENTIFIER."), 91076000 T 0000
(" 70 TOO MANY PARAMETERS DECLARED IN THE PROGRAM."), 91077000 T 0000
(" 71 """ARRAY OF CHAR""" EXPECTED."), 91078000 T 0000
(" 72 WRONG TYPE OF SET EXPRESSION."), 91079000 T 0000
(" 73 TOO MANY EXTERNAL FILES."), 91080000 T 0000
(" 74 ILLEGAL IDENTIFIER FOR EXTERNAL FILE."), 91081000 T 0000
(" 75 """PROGRAM""" EXPECTED."), 91082000 T 0000
(" 76 """.""" EXPECTED AT END OF PROGRAM."), 91083000 T 0000
(" 77 EXTERNAL FILE IDENTIFIER MAY NOT EXCEED 6 CHARACTERS."), 91084000 T 0000
(" 78 ILLEGAL FILE PARAMETER."), 91085000 T 0000
(" 79 ILLEGAL USE OF FILE HANDLING PROCEDURE."), 91086000 T 0000
(" 80 TEXT-FILE EXPECTED."), 91087000 T 0000
(" 81 POINTER VARIABLE EXPECTED."), 91088000 T 0000
(" 82 ONLY VALUES OF TYPE REAL, INTEGER OR CHAR MAY BE READ."), 91089000 T 0000
(" 83 VARIABLES IN RECORDS ILLEGAL IN THIS CONTEXT."), 91090000 T 0000
(" 84 DISPLAY OVERFLOW."), 91091000 T 0000
(" 85 READ AND WRITE MAY ONLY BE USED ON TEXT-FILES."), 91092000 T 0000
(" 86 REFERENCED OBJECT IS TOO BIG."), 91093000 T 0000
(" 87 END-OF-INPUT DISCOVERED."), 91094000 T 0000
(" 88 CHARACTER ARRAY EXPECTED."), 91095000 T 0000
(" 89 """,""" EXPECTED."), 91096000 T 0000
(" 91 PROCEDURES MAY NOT HAVE ANY TYPE."), 91097000 T 0000
(" 91 PARAMETER OF WRONG KIND."), 91098000 T 0000
(" 92 ONLY COMPLETE ARRAYS AND RECORDS MAY BE TRANSMITTED."), 91099000 T 0000
(" 93 DECLARED LABEL NOT USED."), 91100000 T 0000
(" 94 PARAMETERS OF THIS TYPE SHOULD NOT BE VALUE PARAMETERS."), 91101000 T 0000
(" 95 ASSIGNMENT OF STRUCTURED VARIABLES NOT IMPLIMENTED."), 91102000 T 0000
(" 96 INPUT/OUPUT NOT DECLARED."), 91103000 T 0000
(" 97 TOO MANY FILES IN USE."), 91104000 T 0000
(" 98 RECORD IDENTIFIER EXPECTED."), 91105000 T 0000
(" 99 UNRECOGNIZED ITEM."), 91106000 T 0000
(); 91107000 T 0000
45 IS 428 LONG, NEXT SEG 43
91108000 T 0000
91109000 T 0000
WRITE(LINES,ERRORS,NUMERRS); 91110000 T 0000
FOR I:=0 STEP 1 UNTIL 59 DO IF ERR[I] THEN 91111000 T 0007
WRITE(LINES,ERRORMESS1[I]); 91112000 T 0008
FOR I:=60 STEP 1 UNTIL 119 DO IF ERR[I] THEN 91113000 T 0015
WRITE(LINES,ERRORMESS2[I-60]); 91114000 T 0016
END OF ERROR MESSAGES; 91115000 T 0023
43 IS 28 LONG, NEXT SEG 2
IF XREFOPTION THEN 92001000 T 0567
BEGIN 92002000 T 0567
REPLACE POINTER(XREFLINE[*]) BY " " FOR 17 WORDS; 92003000 T 0567
HEADING; 92004000 T 0572
SORT(PRINTXREF,XREFFILE,0,XREFMAX,XREFCOMPARE,3,1000,6000); 92005000 T 0592
END; 92006000 T 0612
END OF B5700 PASCAL COMPILER COMPILER................................... 99001000 T 0612
2 IS 618 LONG, NEXT SEG 1
START OF SEGMENT ********** 46
46 IS 4 LONG, NEXT SEG 1
1 IS 2 LONG, NEXT SEG 0
62 IS 69 LONG, NEXT SEG 0
NUMBER OF ERRORS DETECTED = 0. COMPILATION TIME = 311 SECONDS.
PRT SIZE = 280; TOTAL SEGMENT SIZE = 15629 WORDS; DISK SIZE = 720 SEGS; NO. PGM. SEGS = 62
ESTIMATED CORE STORAGE REQUIRED = 25989 WORDS.
ESTIMATED AUXILIARY MEMORY REQUIRED = 0 WORDS.
LABEL 0XALGOL 0COMPILE00186180?COMPILE PASCAL/DISK XALGOL LIBRARY XALGOL /PASCAL
Reference in New Issue View Git Blame Copy Permalink