github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-03-07 02:59:55 +00:00
Code Issues Releases Wiki Activity
Files
master
retro-software.B5500-software/CUBE-Library-13/Files/SNOBOL-L200010.alg
Paul Kimpel 2c72f7fd1d Commit CUBE Library version 13 of February 1972. 
1. Commit library tape images, directories, and extracted text files.
2. Commit additional utilities under Unisys-Emode-Tools.
2018-05-27 11:24:23 -07:00

7790 lines
616 KiB
Plaintext
Raw Permalink Blame History

% 00010000
% B5500 SNOBOL3 SYSTEM. 00020000
% 00030000
% WRITTEN BY: 00040000
% JOHN M. CHAMBERS 00050000
% DEPT. OF COMPUTER SCIENCES 00060000
% UNIVERSITY OF WISCONSIN 00070000
% 1210 W. DAYTON ST. 00080000
% MADISON, WISCONSIN 53706 00090000
% 00100000
% USERS MANUAL AVAILABLE FROM ABOVE ADDRESS. 00110000
% 00120000
% 00130000
% DATA REPRESENTATION: 00140000
% 00150000
% TO TAKE ADVANTAGE OF THE CHARACTER MODE STRING COMPARE AND MOVE 00160000
% INSTRUCTIONS, STRINGS ARE STORED AS CONSECUTIVE CHARS, PRECEDED BY A 00170000
% 3-CHAR BACK-POINTER TO THE SYMBOL TABLE. THIS POINTER CONSISTS OF AN00180000
% "ILLEGAL CHARACTER" FOLLOWED BY 2 CHARS (12 BITS) GIVING A SYMBOL 00190000
% TABLE LOCATION (SEE DESCRIPTION OF SYMBTABL). STRINGS ARE STORED IN 00200000
% ROWS OF THE ARRAY DATA[*,*]. 00210000
% 00220000
% 00230000
% DUE TO THE SIZE LIMITATION ON ALGOL ARRAYS, AND THE FACT THAT IT 00240000
% WAS FELT UNDESIRABLE TO BREAK UP A STRING, THERE IS A LIMITATION TO 00250000
% THE SIZE OF A STRING--8181 CHARS, TO BE EXACT. IF THIS LIMIT IS 00260000
% EXCEEDED, THE PROCEDURE STRING WILL PRINT A DIAGNOSTIC AND SET THE 00270000
% FLAG DEATH TO TRUE, TERMINATING THE PROGRAM. 00280000
% A STRING IS IDENTIFIED BY A 31-BIT "DESCRIPTOR"; IF D IS SUCH A 00290000
% DESCRIPTOR, THE FOLLOWING FIELDS LOCATE THE STRING (SEE DEFINE 00300000
% DECLARATIONS): 00310000
% D.S: SIZE OF STRING 00320000
% D.R: STRING IS IN DATA[D.R,*] 00330000
% D.CH: FIRST CHAR OF STRING, RELATIVE TO DATA[D.R,0] 00340000
% IN OTHER WORDS, THE STRING CONSISTS OF D.S CHARACTERS, STARTING D.C 00350000
% CHARS AFTER DATA[D.R,D.W]. 00360000
% NOTE THAT, SINCE ALL STRINGS ARE PRECEDED BY A 3-CHAR POINTER 00370000
% TO SYMBTABL, THE VALUE OF THE CH FIELD MUST BE } 3. THIS FACT 00380000
% IS USED TO DISTINGUISH CELLS WHICH HAVE "MISSING" VALUES (SUCH 00390000
% AS THE VALUE PARTS FOR STRINGS WHICH HAVE NOT BEEN ASSIGNED A 00400000
% VALUE). THUS, IF THE CH FIELD IS < 3, THERE IS NO STRING ATTACHED, 00410000
% AND THE VALUE IS CONSIDERED TO BE NULL. THE S FIELD SHOULD BE 0 00420000
% IN SUCH CASES. 00430000
% SEVERAL "BUGS" HAVE BEEN FOUND TO BE CAUSED BY NOT RECOGNIZING 00440000
% THAT A STRING DESCRIPTOR MAY NOT POINT TO A STRING--THIS CAN BE 00450000
% AVOIDED BY TESTING TO SEE IF THE CH FIELD IS } 3. IF SO, THE 00460000
% STRING EXISTS; IF NOT, THERE IS NO STRING, AND THE VALUE IS NULL. 00470000
% 00480000
% 00490000
% 00500000
% 00510000
%***********************************************************************00520000
BEGIN 00530000
INTEGER COMMON; % THESE BITS ARE CURRENTLY RELEVANT: 00540000
% [47:1] = 1 TURNS ON TRACING FOR ALL VARIABLES. 00550000
% [46:1] = 1 CAUSES A COMPLETE DUMP AT THE END OF RUN. 00560000
% [45:1] = 1 SAYS THAT MODE("INFORM") OR -INFORM IS TO TURN ON 00570000
% SYSTEM DEBUGGING AIDS. 00580000
DEFINE 00590000
C=[45:3]#, % CHAR WITH IN WORD OF STRING DESCRIPTOR 00600000
C1=[6:6]#, 00610000
C2=[12:6]#, 00620000
C3=[18:6]#, 00630000
C4=[24:6]#, 00640000
C5=[30:6]#, 00650000
C6=[36:6]#, 00660000
C7=[42:6]#, 00670000
CH=[35:13]#, % CHAR OF DATA[*,*] ROW OF STRING DESCRIPTOR 00680000
CQUOTE4="""[24:42:6]#, % MOVE QUOTE TO CHAR 4 00690000
CQUOTE5="""[30:42:6]#, % MOVE QUOTE TO CHAR 5 00700000
CONCR=[30:43:5]#, % MOVE TO R FIELD 00710000
CONCS=[17:35:13]#, % MOVE TO S FIELD 00720000
CONCW=[35:38:10]#, % MOVE TO W FIELD 00730000
CONTROLPOINT=INST[INSTRUCT],NEARPOINT#, 00740000
DATASIZE=31#, % UPPER BOUND ON FIRST SUBSCRIPT OF DATA[*,*] 00750000
DISKRECORD=RECORD#, 00760000
F= FALSE #, 00770000
FIRSTCHAR(FIRSTCHAR1)=DATA[(FIRSTCHAR1).R,(FIRSTCHAR1).W], 00780000
(FIRSTCHAR1).C#, 00790000
INTRINSMAX=17#, % MAX # INTRINSIC FCTS OF SAME SIZE 00800000
MAXLABELLIMIT=15#, % MAX NUMBER OF LABEL LIMITS FOR DEBUGGING 00810000
MAXLEVEL=100#, % MAXIMUM ALLOWED DEPTH OF FUNCTION CALLS 00820000
MAXSUSPENDREASON=3#, % NUMBER DIFFERENT REASONS FOR SUSPENDING. 00830000
MNEMMAX=20#, 00840000
NUMCONTROLCARDS=21#, % NUMBER OF CONTROL CARDS IMPLEMENTED; 00850000
% MUST BE CHANGED IF NEW CONTROL CARDS ARE 00860000
% TO BE IMPLEMENTED 00870000
R=[30:5]#, % DATA[*,*] ROW OF STRING DESCRIPTOR 00880000
RCH=[30:18]#, % R, W, AND C FIELDS 00890000
S=[17:13]#, % SIZE OF STRING 00900000
SEGMENT = LABEL DUMMY;#, % FOR FORCING NEW SEGMENT. 00910000
STACKSIZE=50#, % SIZE OF INTERPRETER STACK ARRAYS 00920000
STRINGLOC(STRINGLOC1)=(STRINGLOC1).S,FIRSTCHAR(STRINGLOC1)#, 00930000
T= TRUE #, 00940000
TEMP=AA#, % 00950000
TEMP1=AB#, % 00960000
TEMP2=AC#, % 00970000
TEMPCEL(TEMPCEL1) = TEMPCELL#, % PARAMETER NO LONGER IN USE 00980000
VERSION = 3.0#, % VERSION NUMBER: 00990000
% 2.0 IS THE REWRITTEN COMPILER. 01000000
% 2.1 INCLUDES FATAL ERROR SUSPENSIONS WHEN DEBUGGING. 01010000
% 2.2 HAS MOST SYSTEM DEBUGGING AIDS CHANGED TO COMMENTS. 01020000
% 3.0 HAS THE ARRAY USEDCELL[*] DELETED (CHANGES LIBRARY FILES). 01030000
W=[35:10]#; % WORD WITHIN DATA[*,*] ROW OF STRING DESCRIPTOR 01040000
DEFINE 01050000
ABORT = GO TO ABORTION;#, % FATAL SYSTEM ERROR. 01060000
SETLIMITFLAG = ALIMITEXISTS ~ 01070000
CPULIMITEXISTS OR 01080000
IOLIMITEXISTS OR 01090000
RULELIMITEXISTS OR 01100000
(DEBUGGING AND 01110000
(DEBUGRULELIMITEXISTS OR 01120000
NLABELLIMIT } 0 01130000
) 01140000
) 01150000
#; 01160000
BOOLEAN 01170000
ALIMITEXISTS, % THERE IS A LIMIT TO CHECK AT START OF INSTS. 01180000
B1, % TEMPORARY BOOLEAN "REGISTER" 01190000
CONVERTF, % DECK IS 026 CHAR SET 01200000
CONVERTSTRINGS, % CONVERT 3600 I/O STRINGS 01210000
CPULIMITEXISTS, % 01220000
DATACOMF, % DATA COM UNIT IN USE 01230000
DEATH, % FATAL ERROR HAS OCCURRED 01240000
DEBUGGING, % DEBUG MODE IN USE 01250000
DEBUGRULELIMITEXISTS, 01260000
DMPDATA, % EXECUTE WRITEDATA AT END OF RUN 01270000
DMPST, % EXECUTE WRITEST (DUMP SYMB TABLE) AT END OF RUN 01280000
DMPSTR, % EXECUTE STRINGDUMP AT END OF RUN 01290000
DUMPALL, % TRUE IF COMPLETE DUMP TO BE DONE AT EOJ 01300000
ERRDUMP, % DUMP IF FATAL PROGRAM ERROR 01310000
EXECUTE, % SET FALSE IF FATAL ERROR DURING COMPILATION 01320000
INFORM, % PRINT SYSTEM DEBUGGING MESSAGES 01330000
IOLIMITEXISTS, % 01340000
LOADF, % LOADER IS BEING EXECUTED 01350000
PRINTMESSAGES, % PRINT DIAGNOSTIC (WARNING) MESSAGES. 01360000
RESULT, % SUCCESS/FAIL FLAG FOR INTERPRETER 01370000
RULELIMITEXISTS,% 01380000
SYSTEMDEBUGGING,% TRUE IF COMMON.[45:1] = 1 01390000
SYSTEMERROR, % FATAL ERROR BY SNOBOL SYSTEM, NOT PROGRAM 01400000
TRACEALL; % TRACE EVERY VARIABLE WITHOUT I/O USE 01410000
BOOLEAN ARRAY 01420000
SUSPENDREASON[0:MAXSUSPENDREASON], % REASONS FOR SUSPENDING PROGRAM: 01430000
% 0: SUSPEND() WAS EXECUTED 01440000
% 1: RULE LIMIT WAS HIT 01450000
% 2: LABEL LIMIT WAS HIT 01460000
% 3: FATAL ERROR IN PROGRAM 01470000
USEDROW[0:DATASIZE]; % DATA[I,*] IS IN USE 01480000
INTEGER 01490000
ANCHORMODE, % 2: UNANCHORED, 3: ANCHORED 01500000
ANCHORSIZE, % FOR ANCHORED MODE, SIZE OF INITIAL SEGMENT 01510000
DCSIZE, % SIZE OF LAST INPUT FROM DCREAD 01520000
DEBUGRULELIMIT, 01530000
DIVIDEMODE, % 0: ROUND; 1: TRUNCATION; 2: INTEGER 01540000
GCS, % NUMBER OF GARBAGE COLLECTOR CALLS 01550000
I, 01560000
I1, I2, % TEMPORARY INTEGER "REGISTERS". 01570000
J, 01580000
LEVEL, % LEVEL (OR DEPTH) OF RECURSION OF THE INTERPRETER 01590000
LISTSPACES, % NUMBER OF BLANK LINES BETWEEN LINES OF LISTING 01600000
LOADERLEVEL, % LEVEL OF RECURSION IN LOADER 01610000
MAXINSTSIZE, % SIZE OF LARGEST PROGRAM SEGMENT (IN CHARS) 01620000
NLABELLIMIT, % NUMBER OF LABEL LIMITS SET AT LAST SUSPENSION 01630000
PARENCOUNT, % DEPTH IN PARENTHESIS NESTING (COMPILE AND SCAN) 01640000
RW, % NEW STRINGS COME FROM DATA[RW,*] (SEE STRING) 01650000
TEMPROW, % ROW OF SYMB TABLE GIVING TEMP CELLS 01660000
UNIT; % USED BY I/O ROUTINES--FILE NUMBER 01670000
INTEGER ARRAY 01680000
CONVERTVAL, % FOR CHAR SET CONVERSIONS 01690000
DOTTYPE, % PARTITIONS CHARS IN INTERNAL REP. OF ARITH, 01700000
OPLEVEL[0:63], % PRECEDENCE LEVEL OF ARITH OPS 01710000
DPNTR, % POINTER TO NEXT AVAILABLE CHAR IN DATA[I,*] 01720000
NOTMOVED[0:DATASIZE], % POINTS TO FIRST CHAR MOVED BY LAST CALL 01730000
% OF GARBAGE COLLECTOR. 01740000
MONTHS[1:12], % NUMBER OF DAYS IN EACH MONTH 01750000
RULES[0:MAXLEVEL]; % # RULES EXECUTED AT VARIOUS LEVELS 01760000
REAL 01770000
CPULIMIT, % LIMIT TO CPU TIME IN SECONDS. 01780000
GCTIMECP, % CPU TIME SPENT COLLECTING GARBAGE 01790000
GCTIMEIO, % I/O TIME SPENT COLLECTING GARBAGE 01800000
IOLIMIT, % LIMIT TO I/O TIME IN SECONDS. 01810000
RANDNO, % NUMBER FOR .RANF FUNCTION 01820000
RULELIMIT, % LIMIT TO NUMBER OF RULES EXECUTED. 01830000
TEENYNEG; % = OCT3777777777777777 01840000
ALPHA 01850000
AA,AB,AC, % TEMPORARY ALPHA "REGISTERS" 01860000
ARROW, % = "~" 01870000
BLANK, % = " " 01880000
BLANKS, % = " " (8 BLANKS) 01890000
COLON, % = ":" 01900000
COMMA, % = "," 01910000
CRLF, % = "{!~" 01920000
EQSIGN, % = "=" 01930000
QMARK, % ILLEGAL CHAR 01940000
QUOTE, % = """ 01950000
PRINTLOC, % SYMBOL TABLE LOCATION OF PRINT (SEE CODE 01960000
% FOR SYSPOT IN SNBLOUT.) 01970000
SLASH, % = "/" 01980000
STAR, % = "*" 01990000
STOPPER; % = BLANK & QUOTE & QMARK (FOR ENDING SCANS.) 02000000
ALPHA ARRAY 02010000
BUFFER[0:14], % USED BY COMPILER TO HOLD NEXT INPUT CARD 02020000
BUFOUT[0:16], % FOR BUILDING PRINTER OUTPUT MESSAGES. 02030000
CODE[0:1022], 02040000
CONTROLCARD[0:NUMCONTROLCARDS], % NAMES OF CONTROL CARDS 02050000
DATA[0:DATASIZE,0:1022], % STRING AND PROGRAM STORAGE AREA 02060000
INTRINSFCT[3:7,0:INTRINSMAX], % NAMES OF INTRINSIC FUNCTION. 02070000
INTRINSNDX[3:7,1:INTRINSMAX], % INDICES OF INTRINSIC FUNCTIONS. 02080000
LABELLIMIT[0:MAXLABELLIMIT], % SYMBOL TABLE LOCATIONS OF 02090000
% LABEL LIMITS DURING DEBUGGING 02100000
MNEMONIC[0:1,0:MNEMMAX], % VARIOUS MNEMONIC COMMANDS AND WORDS 02110000
NEXTRECORD[0:15,0:17], % HOLDS RECORDS FOR LOOK-TYPE STRINGS 02120000
SCRATCH[0:1022], % TEMPORARY STRING ARRAY 02130000
WORDS[0:30]; % VARIOUS ALPHANUMERIC STRINGS 02140000
MONITOR INTOVR, EXPOVR, INDEX, FLAG; 02150000
%********SYMBOL TABLE***************************************************02160000
% 02170000
% THE SYMBOL TABLE: 02180000
% 02190000
% 02200000
% EVERY DATA OBJECT (STRINGS, LITERAL, FUNCTION, LABEL) REQUIRES 02210000
% AN ENTRY IN THE SYMBOL TABLE. THIS TABLE CONSISTS OF THE FOLLOWING 02220000
% THREE ARRAYS AND ASSOCIATED MACROS: 02230000
% 02240000
DEFINE 02250000
NAME[NAME1] = NAMTABL[(NAME1).STR,(NAME1).STW] #, 02260000
VALU[VALU1] = VALTABL[(VALU1).STR,(VALU1).STW] #, 02270000
IO[IO1] = IOTABL[(IO1).STR,(IO1).STW] #, 02280000
STRMAX = 15 #, % MAX FIRST SUBSCRIPT TO SYMB TABLE. 02290000
STWMAX = 255 #; % MAX SECOND SUBSCRIPT TO SYMB TABLE. 02300000
ALPHA ARRAY 02310000
NAMTABL, 02320000
VALTABL, 02330000
IOTABL[0:STRMAX,0:STWMAX]; 02340000
% 02350000
% SOME MORE VARIABLES ASSOCIATED WITH THE SYMBOL TABLE ARE: 02360000
% 02370000
DEFINE 02380000
CCYCLE=[9:44:4]#, % MOVE TO CYCLE FIELD 02390000
CFILNO=[5:44:4]#, % MOVE TO FILNO FIELD 02400000
CINUSE=[3:47:1]#, % 02410000
CIOTYPE=[14:45:3]#, % MOVE TO IOTYPE FIELD 02420000
CIOUSE=[3:46:2]#, 02430000
CLINK=[5:36:12]#, % MOVE TO LINK FIELD 02440000
CONCSTR = [36:44:4] #, 02450000
COUTUSE=[4:47:1]#, % 02460000
CYCLE=[9:4]#, % NUMBER TIMES FILE LOCATION USED 02470000
FILNO=[5:4]#, % INDEX OF ASSOCIATED FILE 02480000
INUSE=[3:1]#, % = 1 IF INPUT STRING 02490000
IOTYPE=[14:3]#, % TYPE OF I/O USAGE: 02500000
% VALUE INPUT OUTPUT 02510000
% 0 ILLEGAL ILLEGAL 02520000
% 1 I/O I/O 02530000
% 2 LOOK TRACE 02540000
% 3 TELETYPE TELETYPE 02550000
% 4 ILLEGAL ILLEGAL 02560000
% 5 ILLEGAL SYSPOT 02570000
% 02580000
IOUSE=[3:2]#, % INUSE AND OUTUSE FIELDS COMBINED. 02590000
LINK=[5:12]#, % LIST LINKS IN SYMBOL TABLE. 02600000
LOC=[17:31]#, % S, R, W, AND C FIELDS (STRING LOC IN DATA[*,*]) 02610000
OUTUSE=[4:1]#, % = 1 IF OUTPUT STRING 02620000
OVFL=[13:1]#, % = 1 IF OVERFLOW ALLOWED ON OUTPUT 02630000
SCATTERSIZE=75#,% SIZE OF SCATTER AREAS IN SYMB TABLE. 02640000
STR = [36:4] #, 02650000
STW = [40:8] #, 02660000
TCYCLE=[9:9:4]#,% TRANSFER TO CYCLE FIELD 02670000
TFILNO=[5:5:4]#,% TRANSFER TO FILNO FIELD 02680000
TYPE=[1:2]#; % TYPE OF ENTRY: 02690000
% 0 = STRING 2 = FUNCTION 02700000
% 1 = LITERAL 3 = LABEL 02710000
BOOLEAN 02720000
SYMBTABLSETUP; % AVSLS SET UP IN SCATTER ROWS. 02730000
BOOLEAN ARRAY 02740000
USEDST[0:STRMAX]; % TRUE IF SYMB TABLE ROW IN USE. 02750000
INTEGER 02760000
SCATTERNO; % MAX ROW INDEX OF SCATTER AREAS. 02770000
ALPHA ARRAY 02780000
TEMPLIST[0:STRMAX]; % TEMP S.T. LOCS FOR INTERPRETER. 02790000
INTEGER ARRAY 02800000
NEXTCELL[0:STRMAX]; % HEADS OF AVAILABLE SPACE LISTS. 02810000
% 02820000
% 02830000
% A SYMBOL TABLE ENTRY CONSISTS OF THREE WORDS--ONE WORD 02840000
% FROM EACH OF THE THREE ARRAYS. A "SYMBOL TABLE ADDRESS" IS A 02850000
% 12-BIT INTEGER CONSISTING OF TWO FIELDS CALLED STR AND STW. 02860000
% THE THREE WORDS ASSOCIATED WITH AN ADDRESS P CAN BE REFERRED 02870000
% TO IN THE FOLLOWING WAYS: 02880000
% 02890000
% NAME[P] = NAMTABL[P.STR,P.STW] IS THE NAME OF THE OBJECT 02900000
% VALU[P] = VALTABL[P.STR,P.STW] IS THE VALUE OF THE OBJECT. 02910000
% IO[P] = IOTABL[P.STR,P.STW] IS THE I/O USE OF THE OBJECT 02920000
% 02930000
% NORMALLY, THE FIRST FORM GIVEN (SINGLY SUBSCRIPTED) IS USED; THE 02940000
% DOUBLY-SUBSCRIPTED FORMS ARE USED ONLY WHEN THE TWO SUBSCRIPTS 02950000
% HAVE BEEN CALCULATED SEPARATELY. 02960000
% 02970000
% THE SYMBOL TABLE IS A SCATTERED-ENTRY, LINKED-LIST TYPE OF TABLE. 02980000
% ENTRIES ARE SCATTERED INTO THE "SCATTER AREAS", WHICH ARE WORDS 0 TO 02990000
% SCATTERSIZE+15 OF ROWS 0 TO SCATTERNO. THAT IS, THE I,J WORDS 03000000
% OF THE SYMBOL TABLE (NAMTABL[I,J], VALTABL[I,J], IOTABLE[I,J]) 03010000
% ARE IN THE SCATTER AREA IF: 03020000
% 0 { I { SCATTERNO 03030000
% 0 { J { SCATTERSIZE+15 03040000
% WORD 0,0 IS NOT INCLUDED; IT IS A "NON-CELL" WHICH SHOULD ALWAYS 03050000
% BE FILLED WITH ZEROES. THE REASON FOR THE "+15" IS THAT THERE 03060000
% ARE REALLY TWO SCATTER AREAS--ONE FOR LITERALS AND ONE FOR ALL 03070000
% OTHER TYPES OF DATA OBJECTS. THIS IS TO KEEP THE LENGTH OF 03080000
% LISTS THAT MUST BE SCANNED AT RUN TIME (FOR INDIRECTION, CREATING 03090000
% NEW FUNCTIONS, ETC.) AS SMALL AS POSSIBLE. LITERALS ARE SCATTERED 03100000
% INTO THE [SCATTERSIZE,SCATTERSIZE+15] PART OF EACH ROW, AND THE 03110000
% [0,SCATTERSIZE) PART IS FOR OTHER TYPES OF OBJECTS. THE PART 03120000
% OF THE SYMBOL TABLE OUTSIDE OF THE SCATTER AREAS IS INITIALIZED 03130000
% AS AVAILABLE SPACE LISTS (ONE PER ROW, THE TOP ADDRESS GIVEN BY 03140000
% NEXTCELL[ROW]). WHEN SEVERAL ENTRIES SCATTER INTO THE SAME 03150000
% LOCATION, A LINKED LIST IS FORMED INTO THE PART OF THE ROW THAT 03160000
% IS OUTSIDE THE SCATTER AREA. LINKS THROUGH THESE LISTS ARE IN 03170000
% THE LINK FIELD OF THE NAME PART (NAME[P]). 03180000
% 03190000
% THE FOLLOWING FIELDS ARE USED IN A SYMBOL TABLE ENTRY: 03200000
% NAME[P].TYPE IS THE TYPE OF THE ENTRY: 03210000
% 0 = NAMED STRING OR TEMPORARY CELL. 03220000
% 1 = LITERAL 03230000
% 2 = FUNCTION 03240000
% 3 = LABEL (CODE SEGMENT) 03250000
% NAME[P] AND GARBAGE COLLECTOR.[3:1] IS USED BY CHECKSYMBTABL. 03260000
% NAME[P].[4:1] IS UNUSED. 03270000
% NAME[P].LINK IS THE LINK TO THE NEXT ENTRY THAT HAD THE SAME 03280000
% LOCATION IN THE SCATTER AREA. A ZERO LINK IS END-OF-LIST. 03290000
% FOR TEMPORARY CELLS, THE LINK SHOULD BE ZERO. 03300000
% NAME[P].LOC POINTS TO THE NAME OF THE OBJECT (IN DATA[*,*]). 03310000
% FOR LITERALS, THIS FIELD IS ZERO. 03320000
% VALU[P].[1:1] = 1 FOR PROGRAM-DEFINED FUNCTIONS, OTHERWISE 03330000
% IT SHOULD BE ZERO. 03340000
% VALU[P].[2:1] IS UNUSED. 03350000
% VALU[P].IOUSE INDICATES THE I/O USE, AND HAS TWO SUBFIELDS: 03360000
% VALU[P].INUSE = 1 FOR INPUT STRINGS AND FUNCTIONS WITH 03370000
% THE CALLS BEING TRACED. 03380000
% VALU[P].OUTUSE = 1 FOR OUTPUT STRINGS, LABELS BEING TRACED, 03390000
% AND FUNCTIONS WITH RETURNS BEING TRACED. 03400000
% VALU[P].LINK HAS SEVERAL USES, DEPENDING ON THE TYPE OF THE OBJECT: 03410000
% STRINGS: THE LINK FIELD GIVES THE NEXT CELL ON THE PUSH-DOWN 03420000
% STACK. IF ZERO, THERE IS NO PUSH-DOWN STACK. 03430000
% INTRINSIC FUNCTIONS: THE INDEX FOR THE CASE STATEMENT IN 03440000
% THE INTERPRETER THAT BRANCHES TO THE FUNCTION CODE. 03450000
% PROGRAM-DEFINED FUNCTIONS: THE SYMBOL TABLE LOCATION OF 03460000
% THE ENTRY POINT. 03470000
% LABELS: THE REFERENCE COUNT. IT IS BUMPED BY ONE EACH TIME 03480000
% THE LABEL IS ENCOUNTERED. 03490000
% VALU[P].LOC IS THE LOCATIONS OF: 03500000
% STRINGS: THE VALUE. 03510000
% LITERALS: DITTO. 03520000
% FUNCTIONS: (PROGRAM-DEFINED) A STRING OF 2-CHAR POINTERS TO 03530000
% THE SYMB TABLE LOCATIONS OF THE FORMAL PARAMETERS AND 03540000
% LOCAL VARIABLES. FOR INTRINSIC FUNCTIONS, THIS FIELD 03550000
% IS IGNORED. 03560000
% IO[P].[1:2] IS UNUSED. 03570000
% IO[P].IOUSE = VALU[P].IOUSE (REDUNDANT). 03580000
% IO[P].FILNO IS THE INDEX TO THE FILE ARRAYS FOR FILE I/O STRINGS. 03590000
% IO[P].CYCLE IS CURRENTLY NOT IN USE. 03600000
% IO[P].OVFL = 1 FOR OUTPUT STRINGS WHEN THE TAILS OF OUTPUT STRINGS 03610000
% TOO LONG FOR A RECORD ARE TO BE WRITTEN ON THE NEXT RECORD. 03620000
% NORMALLY = 0, WHICH CAUSES TRUNCATION OF LONG OUTPUT STRINGS. 03630000
% IO[P].IOTYPE IS THE TYPE OF I/O OPERATION, AS FOLLOWS: 03640000
% VALUE INPUT OUTPUT 03650000
% 0 ILLEGAL ILLEGAL 03660000
% 1 I/O I/O 03670000
% 2 LOOK TRACE 03680000
% 3 TELETYPE TELETYPE 03690000
% 4 ILLEGAL ILLEGAL 03700000
% 5 ILLEGAL SYSPOT 03710000
% IO[P].[17:31] IS UNUSED. 03720000
%********LOCAL VARIABLES FOR COMPILER***********************************03730000
BOOLEAN 03740000
BUFFERFULL, % BUFFER[*] CONTAINS A CARD. 03750000
DCLIST, % LIST PROG ON TELETYPE. 03760000
GT, % FALSE AT START OF COMPILE; TRUE WHEN GO-TO PART REACHED03770000
GTLAST, % LAST INST HAD A GO-TO PART 03780000
GTF, % FAILURE EXIT HAS BEEN FOUND 03790000
GTS, % SUCCESS EXIT HAS BEEN FOUND 03800000
LSTF, % LIST PROGRAM ON LINE PRINTER FILE PRINT 03810000
PCC, % LIST CONTROL CARDS, EVEN IF NOT LSTF 03820000
PROGRAMFROMREMOTE, % PROGRAM FROM TELETYPE, NOT FILE PROGRAM 03830000
PUNCHF; % PUNCH NEW PROGRAM DECK 03840000
INTEGER 03850000
ERRORS, % NUMBER OF SYNTAX ERRORS FOUND 03860000
FIELDSIZE, % NUMBER OF CHARS PER CARD THAT ARE INSTRUCTION 03870000
INSTNUM, % NUMBER OF INST BEING COMPILED 03880000
INSTSIZE, % SIZE OF INST BEING COMPILED 03890000
MARKER, % FIRST CHAR (QMARK) OF INST IN CODE[*] 03900000
MESSAGES, % NUMBER OF INFORMATIVE MESSAGES PRINTED 03910000
P, % POINT IN INST[*] BEING COMPILED 03920000
PTR; % NEXT CHAR IN CODE[*] 03930000
INTEGER ARRAY 03940000
BACKTRACK[0:50,0:5], 03950000
CHARTYPE[0:63]; 03960000
ALPHA 03970000
NEXTSEGMENT,% SYMBTABL LOC OF NEXT LABELED INSTRUCTION 03980000
SLASTLABEL; % SYMBTABL LOC OF LAST LABELED INSTRUCTION 03990000
%********LOCAL VARIABLES FOR COMPILER***********************************04000000
%********STACK ARRAYS***************************************************04010000
% THE FOLLOWING ARRAYS CONSTITUTE THE "STACK" USED BY THE 04020000
% COMPILER AND INTERPRETER. THE INDEX OF THE NEXT WORD AVAILABLE 04030000
% IS THE GLOBAL INTEGER SP. 04040000
BOOLEAN ARRAY 04050000
PNAME[0:STACKSIZE]; % TRUE FOR NAMED QUANTITIES 04060000
INTEGER ARRAY 04070000
PBACK, % LINK FOR BACK REFERENCE 04080000
PMINLEFT, % MIN SIZE OF REST OF PATTERN 04090000
PPOINT, % POINTER TO MATCHED SUBSTRING 04100000
PSIZE, % SIZE OF PATTERN ELEMENT 04110000
PTYPE[0:STACKSIZE]; % TYPE OF ELEMENT, AS FOLLOWS; 04120000
% 0: UNDEFINED 04130000
% 1: CONSTANT PATTERN ELEMENT 04140000
% 2: ARBITRARY STRING VARIABLE 04150000
% 3: FIXED-LENGTH VARIABLE 04160000
% 4: BALANCED VARIABLE 04170000
% 5: BACK REFERENCE 04180000
% 6: UNDEFINED 04190000
% 7: NUMERIC VALUE--IN PST[I] 04200000
ALPHA ARRAY 04210000
PLOC, % SCANNER ONLY: LOC OF VALUE OF ELEMENT 04220000
PST[0:STACKSIZE]; % SYMBOL TABLE ADDRESS OF ELEMENT 04230000
%********STACK ARRAYS***************************************************04240000
%********LOCAL VARIABLES FOR INTERPRETER********************************04250000
% WARNING: THE NUMBER OF VARIABLES IN THIS SECTION MUST BE THE SAME 04260000
% AS THE NUMBER OF VARIABLES COPIED IN THE DEFINED SECTION OF FUNCTION. 04270000
BOOLEAN % 04280000
BACKREFLAG, % 04290000
NOREPLACEMENT, % 04300000
NOBACKORBAL, 04310000
SELFREFLAG, % 04320000
SUCCESS, % 04330000
VARFLAG; % 04340000
INTEGER % 04350000
COUNT, 04360000
ENTRY, % ENTRY POINT & LAST LABEL TRANSFERED TO 04370000
FLOC, % POINTER TO FAILURE EXIT. 04380000
FRONTEND, 04390000
INCREASE, 04400000
INSTNO, 04410000
INSTRUCT, 04420000
MKS, % "MARK STACK" POINTER 04430000
NEARPOINT, 04440000
NEXTSOURCERECORD, % DISK ADDR OF NEXT AVAILABLE RECORD OF SOURCE. 04450000
NOPATTERNS, 04460000
NOREPLACES, 04470000
REAREND, 04480000
REFI, 04490000
REFJ, 04500000
REFLOC, 04510000
REFPT, 04520000
REFSTEP, 04530000
RELATIVEPOINTER, 04540000
RPR, 04550000
RSIZE, 04560000
SIZE, 04570000
SLOC, % POINTER TO SUCCESS EXIT. 04580000
SP; 04590000
ALPHA 04600000
TEMPREF; 04610000
%********LOCAL VARIABLES FOR INTERPRETER********************************04620000
%********FILE-HANDLING DECLARATIONS*************************************04630000
DEFINE FILMAX = 5 #; % MAX NUMBER OF FILES 04640000
BOOLEAN ARRAY 04650000
IOEOF, % EOF ON LAST I/O OPERATION. 04660000
IOFILEOPEN, % TRUE FOR OPEN FILES. 04670000
LOOKF[1:FILMAX];% NEXT RECORD IS IN NEXTRECORD[I,*]. 04680000
% USED WITH LOOK-TYPE INPUT STRINGS. 04690000
INTEGER ARRAY 04700000
IOSIZE, 04710000
IOSPACE, 04720000
RECORD[1:FILMAX]; 04730000
ALPHA ARRAY 04740000
IOUSAGE[1:FILMAX]; 04750000
FILE 04760000
CARD (1,10,30); 04770000
FILE IN 04780000
PROGRAM (1,10,30); 04790000
FILE OUT 04800000
PRINT 16 (1,17), 04810000
PUNCH 0 (1,10); 04820000
SAVE FILE OUT 04830000
NEWDISK DISK SERIAL [20:600] (1,10,30,SAVE 15); 04840000
SWITCH FILE IOFILE ~ 04850000
CARD, % 0--DUMMY ENTRY 04860000
CARD, % CARD-IMAGE INPUT AND OUTPUT FILE 04870000
PROGRAM, % PROGRAM FILE FOR BATCH JOBS; READ FILE 04880000
PRINT, % LINE PRINTER FILE 04890000
PUNCH, % CARD PUNCH FILE 04900000
NEWDISK; % FILE FOR CREATING NEW DISK FILES 04910000
%********FILE-HANDLING DECLARATIONS*************************************04920000
%********SWITCH FORMAT MESSAGE******************************************04930000
SWITCH FORMAT MESSAGE ~ ("**MISSING QUOTE."), %0004940000
(//"**IGNORE ANY OUTPUT AFTER THIS--IT MAY BE INCORRECT."//), %0104950000
("**UNRECOGNIZED CONSTRUCT IN STRING REFERENCE."), %0204960000
("**UNIDENTIFIABLE PUNCHED OBJECT."), %0304970000
("**DOUBLY DEFINED EXIT."), %0404980000
("**CHARACTER AFTER S OR F IN GO-TO NOT (."), %0504990000
("**STRING REFERENCE MISSING."), %0605000000
("**UNRECOGNIZED GO-TO CONSTRUCT."), %0705010000
("**ILLEGAL LABEL IN GO-TO PART."), %0805020000
("**ILLEGAL COMMA."), %0905030000
("**PARENTHESIS COUNT NON-ZERO AT START OF GO-TO PART."), %1005040000
("**THE ONLY UNARY OPERATOR IS ",""","-",""","."), %1105050000
("**EXTRA RIGHT PARENTHESIS."), %1205060000
("**EXTRA ARROW OR EQUAL SIGN."), %1305070000
("**STRANGE USE OF ",""","/",""","."), %1405080000
("**ATTEMPTED REPLACEMENT IN VALUE EXPRESSION."), %1505090000
("**IMPROPER ARITHMETIC OPERAND."), %1605100000
("**ERROR IN USE OF ARITHMETIC OPERATOR."), %1705110000
("**PARENTHESIS COUNT AT END OF INSTRUCTION NON-ZERO."), %1805120000
("**CONTROL PARAMETER NON-NUMERIC OR OUTSIDE ALLOWED RANGE."), %1905130000
(/"**DUMMY FMT--MESSAGE[20]"), %2005140000
("**TOO MANY ELEMENTS IN INSTRUCTION"), %2105150000
("**UNRECOGNIZED INSTRUCTION TYPE."), %2205160000
(/"**DUMMY FMT--MESSAGE[23]"), %2305170000
("**THIS LABEL HAS ALREADY BEEN USED; FORMER VALUE LOST."), %2405180000
(/"**NO END CARD."/), %2505190000
("**ENTRY POINT UNDEFINED."), %2605200000
("**MISSING RIGHT PARENTHESIS."), %2705210000
("**ILLEGAL USE OF LITERAL."), %2805220000
("**MISSING OPERAND TO ARITHMETIC"), %2905230000
(/"**DUMMY FMT--MESSAGE[30]"), %3005240000
(/"**DUMMY FMT--MESSAGE[31]"), %3105250000
("**DEFINE FAILURE--UNKNOWN ERROR IN FIRST ARGUMENT."), %3205260000
("**DEFINE FAILURE--UNKNOWN ERROR IN LOCAL VARIABLE LIST."), %3305270000
("**INVALID ARGUMENT FOR INDIRECTION."), %3405280000
("USEDROW[",I2,"] IS ",L5,"; DPNTR[",I2,"] = ",I5), %3505290000
(X16,"*",10(X4,"+",X4,"*")), %3605300000
("DATA[",I2,"] = "), %3705310000
("**MISSING STRING VARIABLE ASTERISK."), %3805320000
("**MISSING PARAMETER."), %3905330000
(///"**COMPILER SCREWED UP."///), %4005340000
(/"**DATA COMMUNICATIONS FILE IN USE**"/), %4105350000
("**PROGRAM SEGMENT TOO LONG--INSERT EXTRA LABEL ON PRECEDING" 05360000
" INSTRUCTION."), %4205370000
("**END OF FILE."), %4305380000
("**PARITY ERROR IN "), %4405390000
(/"**OUT OF SPACE IN STRING STORAGE AREA."), %4505400000
(/"**OUT OF SPACE IN SYMBOL TABLE."), %4605410000
("**ILLEGAL USE OF ARROW OR EQUAL SIGN."), %4705420000
("**NON-NUMERIC LITERAL IN ARITHMETIC."), %4805430000
("**THIS STATEMENT CAN NOT BE REACHED."), %4905440000
("**UNDEFINED LABEL: "), %5005450000
(//"**RETURN FROM FUNCTION NOT PRECEDED BY CALL; STATEMENT ", 05460000
"NUMBER ",I6), %5105470000
("**ILLEGAL NAME FOR STRING VARIABLE."), %5205480000
("**END FORMAT--MESSAGE."); 05490000
%********SWITCH FORMAT MESSAGE******************************************05500000
%********SWITCH FORMAT FTIME********************************************05510000
SWITCH FORMAT FTIME ~ 05520000
(/"CPU TIME = ",F10.1," SEC."/"I/O TIME = ",F10.1," SEC."), %0005530000
(X25,"B 5 5 0 0 S N O B O L 3 S Y S T E M"// 05540000
"VERSION ",F3.1/ 05550000
"THE DATE IS ",I*," ",A3," 19",A2,/ 05560000
"COMPILATION STARTED AT ",2(I2,":"),I2), %0105570000
(/"COMPILATION COMPLETED AT ",2(I2,":"),I2), %0205580000
(/"EXECUTION STARTED AT ",2(I2,":"),I2), %0305590000
(/"NORMAL EXIT AT ",2(I2,":"),I2,", AT LEVEL ",I*," IN STATEMENT ", 05600000
I*), %0405610000
(/"ABNORMAL EXIT AT ",2(I2,":"),I2,", AT LEVEL ",I*," IN STATEMENT ", 05620000
I*), %0505630000
(//"**END FORMAT--FTIME."//); 05640000
%********SWITCH FORMAT FTIME********************************************05650000
%***********************************************************************05660000
%********VARIOUS FORMATS************************************************05670000
FORMAT % NOT GENERALLY USED BY MOST PROGRAMS: 05680000
F80A1 (80A1), 05690000
FCLOSEDR ("**ATTEMPT TO READ FROM CLOSED FILE:"), 05700000
FCLOSEDW ("**ATTEMPT TO WRITE ON CLOSED FILE:"), 05710000
FCRLF ("{!~"), 05720000
FENDPROG ("**END OF PROGRAM FILE "), 05730000
FFIXVARSIZE ("**ILLEGAL SIZE ",""",X*,"""," FOR FIXED-LENGTH ", 05740000
"VARIABLE IN STATEMENT ",I6), 05750000
FGC (//"**GARBAGE COLLECTOR ",10("********")), 05760000
FGCRES (/"**GARBAGE COLLECTOR RESULTS:"/ 05770000
I5," ROWS COLLECTED"/ 05780000
I5," CHARS IN LONGEST ROW"/ 05790000
I5," CHARS TOTAL"/), 05800000
FGCS (/"GARBAGE COLLECTOR CALLED ",I*," TIMES; USED ",F*.1, 05810000
" SEC CPU TIME, ",F*.1," SEC I/O TIME."), 05820000
FNOFILE ("**FILE NOT AVAILABLE."), 05830000
FO (O), 05840000
FPARITY ("**IRRECOVERABLE PARITY ERROR ON"), 05850000
FRULES ("**NUMBER OF RULES EXECUTED = ",I8), 05860000
FSENDCOPY ("**SEND COPY OF PROGRAM TO SYSTEM AUTHORS."), 05870000
FTRACE ("*S",I5,X1,X*," = ","""), 05880000
FTRACEFCTCALL ("*C",I5,X1,X*,"("), 05890000
FTRACEFCTRET ("*R",I5,X1,X*,"() = ","""), 05900000
FTRACEL ("*L ",X*,I*,*(" FROM ",I*)), 05910000
FUNDEFFCT ("**UNDEFINED FUNCTION CALLED:"), 05920000
FUNDEFLABEL ("**ATTEMPTED TRANSFER TO UNDEFINED LABEL "); 05930000
FORMAT % FOR USE WITH CREATELIBRARY AND LOADLIBRARY. 05940000
FLIB0("SNOBOL LIBRARY FILE ",I1), 05950000
FLIB1 (I1,I4,3(L1,O)), 05960000
FLIB2 (A2,16L1,I6), 05970000
FLIB3 (16A2), 05980000
FLIB4 (6O), 05990000
FLIB5 (32L1), 06000000
FLIB6 (12I4), 06010000
FLIBOLDLP("**LIBRARY FILE INCOMPATIBLE WITH THIS VERSION OF SNOBOL"),06020000
FLIBOLDTT("{!LIBRARY FILE INCOMPATIBLE WITH THIS VERSION OF SNOBOL", 06030000
"{!~"); 06040000
FORMAT % USED DURING MOST RUNS: 06050000
FASTERISKS (/1023("********")), 06060000
FBL ((X8)), 06070000
FDBL (*(/)), 06080000
FERRS (I*," SYNTAX ERRORS DETECTED"), 06090000
FI7 (I7), 06100000
FI16 (I16), 06110000
FINT (*D,X*,I*), 06120000
FNUM (X*,I*); 06130000
FORMAT % USED WITH TELETYPES 06140000
FAGAIN ("{!TRY AGAIN{!~"), 06150000
FDKSEARCH (X*,"/",X*,":",3I1,4(":",I*)), 06160000
FEH ("{!EH",A1,"{!~"), 06170000
FFROMREMOTE ("{!DO YOU WANT TO TYPE A PROGRAM",A1,"{!~"), 06180000
FNOINPUT ("{!!WAITING TIME UP--DO YOU WISH TO CONTINUE",A1,"{!~"), 06190000
FSTAT (*("(",2(I*,"/",I*,":"),8I1,")")), 06200000
FTTADDR (I*,"/",I*), 06210000
FTTHELLO ("{!SNOBOL VERSION ",F3.1,"{!~"), 06220000
FYESORNO ("{!TYPE YES OR NO.{!~"), 06230000
FVCRLF (X*,"{!~"); 06240000
FORMAT % USED WITH DUMP PROCEDURES 06250000
FSTACKHEAD (/"**THE STACK IS:"/ 06260000
" WORD TYPE ST NAME ....LOC.... SIZE POINT MINLEFT BACK"), 06270000
FSTACKENTRY (I6,I4,X2,A2,X3,L1,X1,I4,X1,I2,X1,I4,I5,I6,I8,I5); 06280000
%***********************************************************************06290000
% **********************************************************************06300000
%========== BEGIN DATA COM GLOBAL DECLARATIONS =========================06310000
DEFINE 06320000
DCINCHAR =28#, 06330000
NBUFIN =4#, 06340000
BUFINSIZE =5#, 06350000
DCOUTCHAR =28#, 06360000
NBUFOUT =5#, 06370000
BUFOUTSIZE =5#, 06380000
MSGSIZE = 250 #, 06390000
ANSSIZE = 250 #, % MAX # OF CHARS IN OUTPUT STRING. 06400000
TTMAX = 15 #; % MAX # OF TELETYPES ALLOWED. 06410000
ALPHA ARRAY 06420000
DCREAD[0:(MSGSIZE-1).W], 06430000
DCWRITE[0:(ANSSIZE-1).W], 06440000
ID, % I. D. OF USER OF TELETYPE 06450000
STAT[0:TTMAX]; % STATUS OF TELETYPE 06460000
ALPHA FILE IN DCIN 14 ( NBUFIN, BUFINSIZE); 06470000
ALPHA FILE OUT DCOUT 14 (NBUFOUT,BUFOUTSIZE); 06480000
INTEGER 06490000
MAINUSER, % TELETYPE CURRENTLY IN CHARGE 06500000
NUMUSERS, % NUMBER OF TELETYPES ATTACHED. 06510000
USER; % TELETYPE CURRENTLY BEING TALKED TO 06520000
REAL 06530000
WAITTIME; 06540000
BOOLEAN BREAK; 06550000
%========== END DATA COM GLOBAL DECLARATIONS ===========================06560000
BEGIN % GLOBAL STREAM PROCEDURES 06570000
%********ABSADDR********************************************************06580000
INTEGER STREAM PROCEDURE ABSADDR(A); 06590000
BEGIN SI ~ A; ABSADDR ~ SI; END; 06600000
%********ABSADDR********************************************************06610000
%***********************************************************************06620000
COMMENT CHAR RETURNS THE PTH CHARACTER OF NAME, RIGHT JUSTIFIED; 06630000
INTEGER STREAM PROCEDURE CHAR(NAME,P); 06640000
VALUE P; 06650000
% 06660000
% 06670000
BEGIN SI ~ NAME; 06680000
SI ~ SI + P; 06690000
DI ~ LOC CHAR; DI ~ DI + 7; 06700000
DS ~ 1 CHR; 06710000
END; 06720000
%********************************************************************** 06730000
%********EQ*************************************************************06740000
BOOLEAN STREAM PROCEDURE EQ(N,L1,I1,L2,I2); 06750000
VALUE N, I1, I2; 06760000
BEGIN SI ~ L1; SI ~ SI + I1; 06770000
DI ~ L2; DI ~ DI + I2; 06780000
N(IF 1 SC ! DC THEN JUMP OUT); 06790000
IF TOGGLE THEN TALLY ~ 0 ELSE TALLY ~ 1; 06800000
EQ ~ TALLY; 06810000
END EQ; 06820000
%********EQ*************************************************************06830000
%********EQUAL**********************************************************06840000
% EQUAL RETURNS TRUE IF THE N CHARS STARTING AT THE I1TH CHAR AFTER L1 06850000
% ARE THE SAME AS THE N CHARS STARTING AT THE L2TH CHAR AFTER L2. I1 06860000
% AND I2 MUST BE } 0 AND { 63. 06870000
BOOLEAN STREAM PROCEDURE EQUAL(N,L1,I1,L2,I2); 06880000
VALUE N, I1, I2; 06890000
% 06900000
% 06910000
BEGIN LOCAL NA, NB; 06920000
LABEL L; 06930000
SI ~ LOC N; SI ~ SI + 5; 06940000
DI ~ LOC NA; DI ~ DI + 7; DS ~ 1 CHR; 06950000
DI ~ LOC NB; DI ~ DI + 7; DS ~ 1 CHR; 06960000
SI ~ L1; 06970000
SI ~ SI + I1; 06980000
DI ~ L2; 06990000
DI ~ DI + I2; 07000000
NA(16(32(IF 8 SC ! DC THEN JUMP OUT 3 TO L))); 07010000
NB(8(IF 8 SC ! DC THEN JUMP OUT 2 TO L)); 07020000
N(IF 1 SC ! DC THEN JUMP OUT); 07030000
L: IF TOGGLE THEN TALLY ~ 0 ELSE TALLY ~ 1; 07040000
EQUAL ~ TALLY; 07050000
END; 07060000
%********EQUAL**********************************************************07070000
BEGIN % MOVE STREAM PROCEDURES 07080000
%********MV*************************************************************07090000
STREAM PROCEDURE MV(N,L1,I1,L2,I2); 07100000
VALUE N, I1, I2; 07110000
BEGIN SI ~ L1; SI ~ SI + I1; 07120000
DI ~ L2; DI ~ DI + I2; 07130000
DS ~ N CHR; 07140000
END MV; 07150000
%********MV*************************************************************07160000
%********MOVE***********************************************************07170000
STREAM PROCEDURE MOVE(N,SOURCE,I1,DEST,I2); 07180000
% 07190000
VALUE N, I1, I2; 07200000
BEGIN LOCAL NA, NB; 07210000
SI ~ LOC N; SI ~ SI + 5; 07220000
DI ~ LOC NA; DI ~ DI + 7; DS ~ 1 CHR; 07230000
DI ~ LOC NB; DI ~ DI + 7; DS ~ 1 CHR; 07240000
SI ~ SOURCE; 07250000
SI ~ SI + I1; 07260000
DI ~ DEST; 07270000
DI ~ DI + I2; 07280000
NA(4(32(DS ~ 32 CHR))); 07290000
NB(2(DS ~ 32 CHR)); 07300000
DS ~ N CHR; 07310000
END MOVE; 07320000
%********MOVE***********************************************************07330000
%********MOVEWDS********************************************************07340000
STREAM PROCEDURE MOVEWDS(N,L1,L2); VALUE N; 07350000
BEGIN LOCAL NA; 07360000
SI ~ LOC N; SI ~ SI + 6; 07370000
DI ~ LOC NA; DI ~ DI + 7; DS ~ 1 CHR; 07380000
SI ~ L1; DI ~ L2; 07390000
NA(2(DS ~ 32 WDS)); N(DS ~ 1 WDS); 07400000
END MOVEWDS; 07410000
%********MOVEWDS********************************************************07420000
%********MOVEWORD*******************************************************07430000
STREAM PROCEDURE MOVEWORD(A,B); VALUE A, B; 07440000
BEGIN SI ~ A; DI ~ B; DS ~ 1 WDS; END; 07450000
%********MOVEWORD*******************************************************07460000
BEGIN % SCAN STREAM PROCEDURES 07470000
%********SCANCHAR*******************************************************07480000
% SCANCHAR RETURNS THE NUMBER OF CHARS FROM THE ITH CHAR AFTER L 07490000
% (0 { I { 63) TO THE FIRST OCCURRENCE OF EITHER C1 OR C2. 07500000
INTEGER STREAM PROCEDURE SCANCHAR(C1,C2,L,I); VALUE C1,C2,I; 07510000
BEGIN LOCAL P1, P2, P3, TEMP; 07520000
LABEL CHERCHE,TROUVE; 07530000
SI ~ L; SI ~ SI + I; 07540000
DI ~ LOC C1; DI ~ DI + 7; 07550000
CHERCHE: IF 1 SC = DC THEN GO TO TROUVE; 07560000
TEMP ~ DI; DI ~ LOC C2; 07570000
DI ~ DI + 7; SI ~ SI - 1; 07580000
IF 1 SC = DC THEN GO TO TROUVE; 07590000
DI ~ TEMP; 07600000
DI ~ DI - 1; 07610000
TALLY ~ TALLY + 1; 07620000
TEMP ~ SI; 07630000
P3 ~ TALLY; SI ~ LOC P3; SI ~ SI + 7; 07640000
IF SC ! "0" THEN 07650000
BEGIN SI ~ TEMP; GO TO CHERCHE; END; 07660000
TALLY ~ P2; TALLY ~ TALLY + 1; 07670000
P2 ~ TALLY; SI ~ LOC P2; SI ~ SI + 7; 07680000
IF SC ! "0" THEN 07690000
BEGIN TALLY ~ 0; 07700000
SI ~ TEMP; GO TO CHERCHE; 07710000
END; 07720000
TALLY ~ P1; TALLY ~ TALLY + 1; 07730000
P1 ~ TALLY; TALLY ~ 0; 07740000
SI ~ TEMP; 07750000
GO TO CHERCHE; 07760000
TROUVE: 07770000
DI ~ LOC SCANCHAR; DI ~ DI + 5; 07780000
SI ~ LOC P1; SI ~ SI + 7; DS ~ 1 CHR; 07790000
SI ~ LOC P2; SI ~ SI + 7; DS ~ 1 CHR; 07800000
SI ~ LOC P3; SI ~ SI + 7; DS ~ 1 CHR; 07810000
END SCANCHAR; 07820000
%********SCANCHAR*******************************************************07830000
%********SKIPCHAR*******************************************************07840000
INTEGER STREAM PROCEDURE SKIPCHAR(C,L,I); VALUE C,I; 07850000
% 07860000
BEGIN LOCAL P1, P2, P3, TEMP; 07870000
LABEL CHERCHE,TROUVE; 07880000
SI ~ L; SI ~ SI + I; 07890000
DI ~ LOC C; DI ~ DI + 7; 07900000
CHERCHE: IF 1 SC ! DC THEN GO TO TROUVE; 07910000
DI ~ DI - 1; 07920000
TALLY ~ TALLY + 1; 07930000
TEMP ~ SI; 07940000
P3 ~ TALLY; SI ~ LOC P3; SI ~ SI + 7; 07950000
IF SC ! "0" THEN 07960000
BEGIN SI ~ TEMP; GO TO CHERCHE; END; 07970000
TALLY ~ P2; TALLY ~ TALLY + 1; 07980000
P2 ~ TALLY; SI ~ LOC P2; SI ~ SI + 7; 07990000
IF SC ! "0" THEN 08000000
BEGIN TALLY ~ 0; 08010000
SI ~ TEMP; GO TO CHERCHE; 08020000
END; 08030000
TALLY ~ P1; TALLY ~ TALLY + 1; 08040000
P1 ~ TALLY; TALLY ~ 0; 08050000
SI ~ TEMP; 08060000
GO TO CHERCHE; 08070000
TROUVE: 08080000
DI ~ LOC SKIPCHAR; DI ~ DI + 5; 08090000
SI ~ LOC P1; SI ~ SI + 7; DS ~ 1 CHR; 08100000
SI ~ LOC P2; SI ~ SI + 7; DS ~ 1 CHR; 08110000
SI ~ LOC P3; SI ~ SI + 7; DS ~ 1 CHR; 08120000
END SKIPCHAR; 08130000
%********SKIPCHAR*******************************************************08140000
%***********************************************************************08150000
% CARDTYPE RETURNS A NUMBER IDENTIFYING THE TYPE OF INSTRUCTION 08160000
% BEING COMPILED--THE TYPES ARE: 08170000
% 1 COMMENT 08180000
% 2 CONTINUATION 08190000
% 3 CONTROL CARD 08200000
% 4 END 08210000
% 5 UNLABELED 08220000
% 6 LABELED 08230000
INTEGER STREAM PROCEDURE CARDTYPE(CARD); 08240000
BEGIN SI ~ CARD; 08250000
IF SC = "*" THEN TALLY ~ 1 ELSE 08260000
IF SC = "%" THEN TALLY ~ 1 ELSE 08270000
IF SC = "." THEN TALLY ~ 2 ELSE 08280000
IF SC = "-" THEN TALLY ~ 3 ELSE 08290000
IF SC = "E" THEN 08300000
BEGIN SI ~ SI + 1; 08310000
IF SC = "N" THEN 08320000
BEGIN SI ~ SI + 1; 08330000
IF SC = "D" THEN 08340000
BEGIN SI ~ SI + 1; 08350000
IF SC = " " THEN TALLY ~ 4 ELSE TALLY ~ 6; 08360000
END ELSE TALLY ~ 6; 08370000
END ELSE TALLY ~ 6; 08380000
END ELSE 08390000
IF SC = " " THEN TALLY ~ 5 ELSE TALLY ~ 6; 08400000
CARDTYPE ~ TALLY; 08410000
END TYPE; 08420000
%********CARDTYPE*******************************************************08430000
BEGIN % ALGOL PROCEDURES 08440000
%********FORWARD DECLARATIONS*******************************************08450000
PROCEDURE CLEAR(AR,N); 08460000
VALUE N; INTEGER N; 08470000
ALPHA ARRAY AR[0]; 08480000
FORWARD; 08490000
BOOLEAN PROCEDURE COMBINEARITHMETIC(I); 08500000
VALUE I; 08510000
INTEGER I; 08520000
FORWARD; 08530000
PROCEDURE COMBINEFUNCTION(MKS); 08540000
VALUE MKS; 08550000
INTEGER MKS; 08560000
FORWARD; 08570000
BOOLEAN PROCEDURE COMBINEGOTOPART(MKS); 08580000
VALUE MKS; 08590000
INTEGER MKS; 08600000
FORWARD; 08610000
BOOLEAN PROCEDURE COMBINEGROUP(MKS,CON); 08620000
VALUE MKS, CON; 08630000
INTEGER MKS; 08640000
BOOLEAN CON; 08650000
FORWARD; 08660000
BOOLEAN PROCEDURE COMBINEINDIRECTION(MKS); 08670000
VALUE MKS; 08680000
INTEGER MKS; 08690000
FORWARD; 08700000
BOOLEAN PROCEDURE COMBINESTRVARNAME(MKS); 08710000
VALUE MKS; 08720000
INTEGER MKS; 08730000
FORWARD; 08740000
PROCEDURE COMPILE(INST); 08750000
ALPHA ARRAY INST[0]; 08760000
FORWARD; 08770000
INTEGER PROCEDURE CONTROLPARAMETER(A,P); 08780000
ALPHA ARRAY A[0]; 08790000
INTEGER P; 08800000
FORWARD; 08810000
PROCEDURE CONVERT(A); 08820000
ALPHA ARRAY A[0]; 08830000
FORWARD; 08840000
ALPHA PROCEDURE DATE; 08850000
FORWARD; 08860000
PROCEDURE DEBUG(L); 08870000
VALUE L; 08880000
LABEL L; 08890000
FORWARD; 08900000
INTEGER PROCEDURE DIGITS(N); 08910000
VALUE N; 08920000
REAL N; 08930000
FORWARD; 08940000
ALPHA PROCEDURE ENTERST(N,L,P,X); 08950000
VALUE N, P, X; 08960000
INTEGER N, P; 08970000
ALPHA ARRAY L[0]; 08980000
ALPHA X; 08990000
FORWARD; 09000000
PROCEDURE FINDUSERS; 09010000
FORWARD; 09020000
PROCEDURE GARBAGECOLLECTOR; 09030000
FORWARD; 09040000
PROCEDURE INDIRECT(SP); 09050000
VALUE SP; 09060000
INTEGER SP; 09070000
FORWARD; 09080000
PROCEDURE INFORM0(I); 09090000
VALUE I; 09100000
INTEGER I; 09110000
FORWARD; 09120000
PROCEDURE INFORMA(I,P); 09130000
VALUE I, P; 09140000
INTEGER I; ALPHA P; 09150000
FORWARD; 09160000
PROCEDURE INFORMI(I,P); 09170000
VALUE I, P; 09180000
INTEGER I, P; 09190000
FORWARD; 09200000
PROCEDURE INFORMIA(I,P1,P2); 09210000
VALUE I, P1, P2; 09220000
INTEGER I, P1; 09230000
ALPHA P2; 09240000
FORWARD; 09250000
PROCEDURE INFORMII(I,P1,P2); 09260000
VALUE I, P1, P2; 09270000
INTEGER I, P1, P2; 09280000
FORWARD; 09290000
PROCEDURE INITIALIZESYMBTABL; 09300000
FORWARD; 09310000
BOOLEAN PROCEDURE INPUT; 09320000
FORWARD; 09330000
PROCEDURE INSERTSTRINGCONVERT(SP); 09340000
VALUE SP; 09350000
INTEGER SP; 09360000
FORWARD; 09370000
PROCEDURE INTERPRETER; 09380000
FORWARD; 09390000
INTEGER PROCEDURE INTRINSIC(L,P,S); 09400000
VALUE P, S; 09410000
ALPHA ARRAY L[0]; 09420000
INTEGER P, S; 09430000
FORWARD; 09440000
PROCEDURE LOADER(F); 09450000
FILE F; 09460000
FORWARD; 09470000
PROCEDURE LST(A); 09480000
ALPHA ARRAY A[0]; 09490000
FORWARD; 09500000
PROCEDURE MESSAGE0(I); 09510000
VALUE I; 09520000
INTEGER I; 09530000
FORWARD; 09540000
PROCEDURE MESSAGEAI(I,P1,P2); 09550000
VALUE I, P1, P2; 09560000
INTEGER I, P2; 09570000
ALPHA P1; 09580000
FORWARD; 09590000
PROCEDURE MESSAGEI(I,P); 09600000
VALUE I, P; 09610000
INTEGER I, P; 09620000
FORWARD; 09630000
PROCEDURE MESSAGETT0(I); 09640000
VALUE I; 09650000
INTEGER I; 09660000
FORWARD; 09670000
PROCEDURE MESSAGETTA(I,P1); 09680000
VALUE I, P1; 09690000
INTEGER I; 09700000
ALPHA P1; 09710000
FORWARD; 09720000
PROCEDURE MESSAGETTAI(I,P1,P2); 09730000
VALUE I, P1, P2; 09740000
INTEGER I, P2; 09750000
ALPHA P1; 09760000
FORWARD; 09770000
PROCEDURE MESSAGETTI(I,P); 09780000
VALUE I, P; 09790000
INTEGER I, P; 09800000
FORWARD; 09810000
INTEGER PROCEDURE MNEMNO(N,A,P); 09820000
VALUE N; 09830000
INTEGER N, P; 09840000
ARRAY A[0]; 09850000
FORWARD; 09860000
ALPHA PROCEDURE NEWCELL(I); 09870000
VALUE I; 09880000
INTEGER I; 09890000
FORWARD; 09900000
PROCEDURE NEWSTROW(I); 09910000
VALUE I; 09920000
INTEGER I; 09930000
FORWARD; 09940000
BOOLEAN PROCEDURE NULLARGS(N); 09950000
VALUE N; 09960000
INTEGER N; 09970000
FORWARD; 09980000
BOOLEAN PROCEDURE NUMVAL(ST,VAL); 09990000
VALUE ST; 10000000
ALPHA ST; 10010000
INTEGER VAL; 10020000
FORWARD; 10030000
BOOLEAN PROCEDURE OUTPUT; 10040000
FORWARD; 10050000
BOOLEAN PROCEDURE POP(STLOC); 10060000
VALUE STLOC; 10070000
ALPHA STLOC; 10080000
FORWARD; 10090000
PROCEDURE PROCESSCONTROLCARD(A); 10100000
ALPHA ARRAY A[0]; 10110000
FORWARD; 10120000
BOOLEAN PROCEDURE PUSH(S,T); 10130000
VALUE S, T; ALPHA S, T; 10140000
FORWARD; 10150000
PROCEDURE RETURNCELL(L); 10160000
VALUE L; ALPHA L; 10170000
FORWARD; 10180000
PROCEDURE RETURNTEMPS; 10190000
FORWARD; 10200000
ALPHA PROCEDURE SCATTER(SIZE,LOC,P,X); 10210000
VALUE SIZE, P, X; 10220000
INTEGER SIZE, P; 10230000
ALPHA ARRAY LOC[0]; 10240000
ALPHA X; 10250000
FORWARD; 10260000
ALPHA PROCEDURE SEARCHST(N,L,P,X); 10270000
VALUE N, P, X; 10280000
INTEGER N, P; 10290000
ALPHA ARRAY L[0]; 10300000
ALPHA X; 10310000
FORWARD; 10320000
BOOLEAN PROCEDURE SNBLDEFINE(ST1,ST2,ST3); 10330000
VALUE ST1, ST2, ST3; 10340000
ALPHA ST1, ST2, ST3; 10350000
FORWARD; 10360000
BOOLEAN PROCEDURE SNBLIN(ST); 10370000
VALUE ST; 10380000
ALPHA ST; 10390000
FORWARD; 10400000
BOOLEAN PROCEDURE SNBLOUT(ST); 10410000
VALUE ST; 10420000
ALPHA ST; 10430000
FORWARD; 10440000
PROCEDURE STORECHARS(N,L,I); 10450000
VALUE N, I; 10460000
INTEGER N, I; 10470000
ALPHA L; 10480000
FORWARD; 10490000
ALPHA PROCEDURE STRING(N,STLOC); 10500000
VALUE N, STLOC; 10510000
INTEGER N; ALPHA STLOC; 10520000
FORWARD; 10530000
PROCEDURE STRINGDUMP(N); 10540000
VALUE N; 10550000
INTEGER N; 10560000
FORWARD; 10570000
PROCEDURE SYNTAXERR(N,P); 10580000
VALUE N, P; 10590000
INTEGER N, P; 10600000
FORWARD; 10610000
ALPHA PROCEDURE TEMPCELL; 10620000
FORWARD; 10630000
ALPHA PROCEDURE TEMPVAL(I); 10640000
VALUE I; 10650000
INTEGER I; 10660000
FORWARD; 10670000
BOOLEAN PROCEDURE TRACEFCTCALL(F); 10680000
VALUE F; 10690000
INTEGER F; 10700000
FORWARD; 10710000
BOOLEAN PROCEDURE TRACEFCTRETURN(F,SUC); 10720000
VALUE F, SUC; 10730000
INTEGER F; 10740000
BOOLEAN SUC; 10750000
FORWARD; 10760000
INTEGER PROCEDURE TTINDEX(ST); 10770000
VALUE ST; 10780000
ALPHA ST; 10790000
FORWARD; 10800000
BOOLEAN PROCEDURE WRITEBUFF(BUFOUT,P,SIZE); 10810000
VALUE SIZE; 10820000
INTEGER P, SIZE; 10830000
ARRAY BUFOUT[0]; 10840000
FORWARD; 10850000
PROCEDURE WRITEDATA; 10860000
FORWARD; 10870000
PROCEDURE WRITEINST; 10880000
FORWARD; 10890000
PROCEDURE WRITEST; 10900000
FORWARD; 10910000
PROCEDURE WRITESTACK(N); 10920000
VALUE N; 10930000
INTEGER N; 10940000
FORWARD; 10950000
PROCEDURE WRITETIME(F,N); 10960000
VALUE F, N; 10970000
INTEGER F, N; 10980000
FORWARD; 10990000
LABEL 11000000
ABORTION, % FATAL SYSTEM ERROR 11010000
ENDOFRUN, % FINAL DUMPS, IF ANY 11020000
ENDTERPRET; % TRANSFERRED TO AT END OR FATAL ERROR 11030000
%********CHECKOUTUSE****************************************************11040000
BOOLEAN PROCEDURE CHECKOUTUSE(ST); 11050000
VALUE ST; ALPHA ST; 11060000
CHECKOUTUSE ~ IF BOOLEAN(VALTABL[ST.STR,ST.STW].OUTUSE) 11070000
THEN SNBLOUT(ST) ELSE TRUE; 11080000
%********CHECKOUTUSE****************************************************11090000
%********CHECKSYMBTABL**************************************************11100000
% CHECKSYMBTABL LOOKS FOR SYMBOL TABLE ENTRIES WHICH POINT TO STRINGS 11110000
% NOT PRECEDED BY A POINTER BACK TO THE SAME SYMBTABL LOCATION. IF 11120000
% ANY SUCH ENTRIES ARE FOUND, AN ERROR MESSAGE IS PRINTED AND 11130000
% THE JOB IS TERMINATED ABNORMALLY (WITH A COMPLETE DUMP). 11140000
PROCEDURE CHECKSYMBTABL; 11150000
BEGIN INTEGER I, J, K, RW, CHR, P; 11160000
BOOLEAN URK; 11170000
ALPHA AA; 11180000
FORMAT FF(/"**SYMBTABL LOCATION ",A2," IS NOT POINTED TO BY ITS STRING" 11190000
" AT DATA[",I2,",*] + ",I4," CHARS."), 11200000
FPUSH (//"**PUSH-DOWN STACK INTO AVAILABLE SPACE LIST AT ",A2), 11210000
FG (/"**SYMBTABL LOCATION ZERO HAS BEEN ALTERED."); 11220000
URK ~ FALSE; 11230000
IF NAMTABL[0,0]!0 OR VALTABL[0,0]!0 THEN 11240000
BEGIN WRITE(PRINT,FG); 11250000
URK ~ TRUE; 11260000
END; 11270000
FOR I ~ 0 STEP 1 WHILE I { STRMAX AND USEDST[I] DO 11280000
BEGIN J ~ NEXTCELL[I].STW; 11290000
IF J ! 0 THEN DO 11300000
BEGIN NAMTABL [I,J].[3:1] ~ 1; 11310000
J ~ (NAMTABL[I,J].LINK).STW; 11320000
END UNTIL J = 0 OR J } STWMAX; 11330000
FOR J ~ 0 STEP 1 UNTIL STWMAX DO 11340000
BEGIN 11350000
FOR AA ~ NAMTABL[I,J],VALTABL[I,J] DO IF AA.CH > 3 THEN 11360000
% CHECK STRINGS FOR BACK-POINTERS 11370000
BEGIN RW ~ TEMP.R; 11380000
CHR ~ TEMP.CH - 2; 11390000
MV(2,DATA[RW,CHR.W],CHR.C,P,6); 11400000
IF I ! P.STR OR J ! P.STW THEN 11410000
BEGIN WRITE(PRINT,FF,J&I CONCSTR,RW,CHR+2); 11420000
URK ~ TRUE; 11430000
END; 11440000
END; 11450000
IF NAMTABL[I,J].[1:2]=0 THEN % STRING--CHECK PUSH-DOWN STACK 11460000
BEGIN 11470000
AA ~ VALTABL[I,J].LINK; 11480000
WHILE AA ! 0 DO 11490000
BEGIN IF BOOLEAN(NAME[AA].[3:1]) THEN 11500000
BEGIN WRITE(PRINT,FPUSH,AA); 11510000
URK ~ TRUE; 11520000
END; 11530000
AA ~ VALU[AA].LINK; 11540000
END; 11550000
END; 11560000
END; 11570000
END; 11580000
IF URK THEN ABORT; 11590000
END CHECKSYMBTABL; 11600000
%********CHECKSYMBTABL**************************************************11610000
%********CLEAR**********************************************************11620000
PROCEDURE CLEAR(AR,N); VALUE N; ALPHA ARRAY AR[0]; INTEGER N; 11630000
FOR N ~ N - 1 WHILE N } 0 DO MOVE(8,BLANKS,0,AR[N],0); 11640000
%********CLEAR**********************************************************11650000
%********COMBINEARITHMETIC**********************************************11660000
BOOLEAN PROCEDURE COMBINEARITHMETIC(I); 11670000
VALUE I; 11680000
INTEGER I; 11690000
BEGIN 11700000
LABEL FAUT, FIN, UNARY; 11710000
INTEGER J, K, LEVOP, N; 11720000
% IF INFORM THEN INFORM0(20); 11730000
COMBINEARITHMETIC ~ FALSE; 11740000
IF I+1 } SP THEN 11750000
BEGIN SYNTAXERR(29,PLOC[I]); 11760000
GO TO FIN; 11770000
END; 11780000
IF I + 2 < SP THEN IF PTYPE[I+2] = 7 THEN 11790000
IF OPLEVEL[PST[I+2]] > LEVOP~OPLEVEL[PST[I]] THEN 11800000
IF NOT COMBINEARITHMETIC(I+2) THEN GO TO FIN; 11810000
J ~ I; 11820000
DO J ~ J-1 UNTIL IF J<PBACK[I] THEN TRUE ELSE PTYPE[J]!0; 11830000
IF J < PBACK[I] THEN GO TO UNARY; 11840000
FOR K ~ J, I+1 DO 11850000
CASE PTYPE[K] OF 11860000
BEGIN GO TO FAUT; 11870000
% 1: STRING NAME 11880000
; 11890000
% 2: FUNCTION NAME: 11900000
GO TO IF K=J THEN UNARY ELSE FAUT; 11910000
% 3: LITERAL 11920000
; 11930000
% 4: "(" OF GROUP 11940000
GO TO IF K=J THEN UNARY ELSE FAUT; 11950000
% 5: STRING VARIABLE 11960000
BEGIN SYNTAXERR(16,PLOC[K]); 11970000
GO TO FIN; 11980000
END; 11990000
% 6: INDIRECTION, UNCOMBINED 12000000
IF NOT COMBINEINDIRECTION(K) THEN GO TO FIN; 12010000
% 7: CONSECUTIVE ARITHMETIC OPERATORS 12020000
BEGIN SYNTAXERR(16,PLOC[K]); 12030000
GO TO FIN; 12040000
END; 12050000
% 8: "/" OF FIXED-LENGTH VAR 12060000
GO TO IF K=J THEN UNARY ELSE FAUT; 12070000
% 9: STR REF, PATTERN & REPLACEMENT 12080000
GO TO FAUT; 12090000
% 10: INDIRECTION COMBINED 12100000
; 12110000
% 11: NOT IN USE 12120000
GO TO FAUT; 12130000
% 12: NOT IN USE 12140000
GO TO FAUT; 12150000
% 13: "*" OF STR VAR 12160000
BEGIN SYNTAXERR(16,PLOC[K]); 12170000
GO TO FIN; 12180000
END; 12190000
% 14: LABEL IN GO-TO PART 12200000
GO TO FAUT; 12210000
% 15: EXPRESSION 12220000
; 12230000
% 16: ARITH EXPR 12240000
; 12250000
% 17: "*(" OF BAL VAR 12260000
GO TO FAUT; 12270000
% 18: STR REF & PATTERN 12280000
GO TO FAUT; 12290000
% 19: COMPLETE ARITH EXPR--REMOVE STRING CONVERT 12300000
PSIZE[K] ~ PSIZE[K] - 2; 12310000
% 20: "S(", "F(", OR "(" OF GO-TO PART 12320000
GO TO FAUT; 12330000
% 21: COMBINED GO-TO PART 12340000
GO TO FAUT; 12350000
END CASES; 12360000
N ~ 0; 12370000
FOR K ~ J, I+1, I DO 12380000
BEGIN MOVE(PSIZE[K],CODE[PPOINT[K].W],PPOINT[K].C,SCRATCH[N.W],N.C); 12390000
N ~ N + PSIZE[K]; 12400000
PTYPE[K] ~ 0; 12410000
END; 12420000
MOVE(N,SCRATCH[*],0,CODE[PPOINT[J].W],PPOINT[J].C); 12430000
PSIZE[J] ~ N; 12440000
PTYPE[J] ~ 16; % INCOMPLETE ARITH EXPR 12450000
COMBINEARITHMETIC ~ TRUE; 12460000
GO TO FIN; 12470000
FAUT: 12480000
WRITEINST; 12490000
SYNTAXERR(40,0); 12500000
WRITE(PRINT,17,CODE[*]); 12510000
WRITESTACK(SP); 12520000
SYSTEMERROR ~ TRUE; 12530000
GO TO FIN; 12540000
UNARY: 12550000
IF PST[I] = "-" THEN 12560000
BEGIN MOVE(K~PSIZE[I+1],CODE[(J~PPOINT[I+1]).W],J.C,SCRATCH[*],0);12570000
AA ~ ".N"; 12580000
MV(2,AA,6,SCRATCH[K.W],K.C); 12590000
MOVE(K+2,SCRATCH[*],0,CODE[(J~PPOINT[I]).W],J.C); 12600000
PTYPE[I+1] ~ 0; 12610000
PTYPE[I] ~ 16; % ARITH EXPR--NO STRING CONVERT 12620000
PSIZE[I] ~ K+2; 12630000
COMBINEARITHMETIC ~ TRUE; 12640000
GO TO FIN; 12650000
END ELSE 12660000
% CANT BE USED AS UNARY: 12670000
BEGIN SYNTAXERR(11,PLOC[I]); 12680000
GO TO FIN; 12690000
END; 12700000
FIN: 12710000
IF SYSTEMERROR THEN INFORM0(20); 12720000
% IF INFORM THEN WRITEINST; 12730000
END COMBINEARITHMETIC; 12740000
%********COMBINEARITHMETIC**********************************************12750000
%********COMBINEFUNCTION************************************************12760000
PROCEDURE COMBINEFUNCTION(MKS); 12770000
VALUE MKS; 12780000
INTEGER MKS; 12790000
BEGIN INTEGER I, J, N; 12800000
% IF INFORM THEN INFORM0(25); 12810000
N ~ J ~ 0; 12820000
FOR I ~ MKS+1 STEP 1 UNTIL SP-1 DO IF PTYPE[I] ! 0 THEN 12830000
BEGIN MOVE(PSIZE[I],CODE[PPOINT[I].W],PPOINT[I].C,SCRATCH[J.W],J.C); 12840000
I ~ I; 12850000
J ~ J + PSIZE[I]; 12860000
PTYPE[I] ~ 0; % WIPE OUT ELEMENT 12870000
N ~ N + 1; 12880000
END; 12890000
MV(3,CODE[(I~PPOINT[MKS]).W],I.C,SCRATCH[J.W],J.C); 12900000
MV(1,N,7,SCRATCH[J.W],J.C+3); 12910000
MOVE(J+4,SCRATCH[*],0,CODE[I.W],I.C); 12920000
PTYPE[MKS] ~ 15; % EXPRESSION 12930000
PNAME[MKS] ~ FALSE; 12940000
PTR ~ I + (PSIZE[MKS]~J+4); 12950000
% IF INFORM THEN WRITEINST; 12960000
END COMBINEFUNCTION; 12970000
%********COMBINEFUNCTION************************************************12980000
%********COMBINEGOTOPART************************************************12990000
BOOLEAN PROCEDURE COMBINEGOTOPART(MKS); 13000000
VALUE MKS; 13010000
INTEGER MKS; 13020000
BEGIN 13030000
LABEL FAIL, FAUT, FIN; 13040000
INTEGER I, M; 13050000
% IF INFORM THEN INFORM0(24); 13060000
IF PTYPE[MKS] ! 20 THEN GO TO FAUT; 13070000
M ~ MKS + 1; 13080000
IF PTYPE[M] = 6 THEN % INDIRECTION 13090000
BEGIN 13100000
% GET NUMBER OF INDIRECTIONS: 13110000
I ~ CHAR(CODE[PPOINT[M].W],PPOINT[M].C+1); 13120000
IF I > 1 THEN 13130000
BEGIN I ~ I - 1; 13140000
MV(1,I,7,CODE[PPOINT[M].W],PPOINT[M].C+1); % DECREASE BY 1 13150000
IF NOT COMBINEINDIRECTION(M) THEN GO TO FAIL; 13160000
END ELSE % MOVE BACK TO M: 13170000
BEGIN PTYPE[M+1] ~ 0; 13180000
PPOINT[M] ~ PPOINT[M+1]; 13190000
PLOC[M] ~ PLOC[M+1]; 13200000
PSIZE[M] ~ PSIZE[M+1]; 13210000
END; 13220000
PTR ~ PPOINT[M] + PSIZE[M]; 13230000
STORECHARS(1,"L",7); % LABEL INDIRECTION CODE 13240000
PSIZE[M] ~ PSIZE[M] + 1; 13250000
PTYPE[M] ~ 14; % LABEL EXPRESSION 13260000
END; 13270000
IF PTYPE[M] ! 14 THEN 13280000
BEGIN SYNTAXERR(8,PLOC[M]); % ILLEGAL LABEL 13290000
GO TO FAIL; 13300000
END; 13310000
FOR I ~ M+1 STEP 1 UNTIL SP-1 DO IF PTYPE[I] ! 0 THEN 13320000
BEGIN SYNTAXERR(8,PLOC[I]); % ILLEGAL LABEL 13330000
GO TO FAIL; 13340000
END; 13350000
PTR ~ PPOINT[M] + PSIZE[M]; 13360000
PSIZE[MKS] ~ PSIZE[M]; 13370000
PTYPE[MKS] ~ 21; % GO-TO PART COMBINED 13380000
PPOINT[MKS] ~ PPOINT[M]; 13390000
PLOC[MKS] ~ PLOC[M]; 13400000
COMBINEGOTOPART ~ TRUE; 13410000
GO TO FIN; 13420000
% 13430000
FAUT: 13440000
WRITEINST; 13450000
SYNTAXERR(40,0); 13460000
WRITESTACK(SP); 13470000
SYSTEMERROR ~ TRUE; 13480000
FAIL: 13490000
IF SYSTEMERROR THEN INFORM0(24); 13500000
COMBINEGOTOPART ~ FALSE; 13510000
FIN: 13520000
% IF INFORM THEN WRITEINST; 13530000
END COMBINEGOTOPART; 13540000
%********COMBINEGOTOPART************************************************13550000
%********COMBINEGROUP***************************************************13560000
BOOLEAN PROCEDURE COMBINEGROUP(MKS,CON); 13570000
VALUE MKS, CON; 13580000
INTEGER MKS; 13590000
BOOLEAN CON; 13600000
BEGIN 13610000
LABEL FAUT, FAIL, FIN; 13620000
BOOLEAN ARITH; % FOR DELETING PARENS AROUND ARITH EXPRS 13630000
INTEGER ERRNO, ERRPOINT, I, J, K, N; 13640000
% 13650000
% IF INFORM THEN INFORM0(21); 13660000
COMBINEGROUP ~ ARITH ~ FALSE; 13670000
FOR I ~ MKS STEP 1 UNTIL SP-1 DO IF PTYPE[I] ! 0 THEN 13680000
CASE PTYPE[I] OF 13690000
BEGIN; 13700000
% 1: STRING NAME 13710000
; 13720000
% 2: FUNCTION (INCOMPLETE) 13730000
GO TO FAUT; 13740000
% 3: LITERAL 13750000
; 13760000
% 4: START OF GROUP 13770000
GO TO FAUT; 13780000
% 5: NOT USED 13790000
GO TO FAUT; 13800000
% 6: $N--INDIRECTION, UNCOMBINED 13810000
IF NOT COMBINEINDIRECTION(I) THEN GO TO FIN; 13820000
% 7: ARITH OPERATOR: 13830000
BEGIN 13840000
IF NOT COMBINEARITHMETIC(I) THEN GO TO FIN; 13850000
WHILE I > 0 AND PTYPE[I]!16 DO I ~ I - 1; % FIND RESULT 13860000
IF PTYPE[I] ! 16 THEN GO TO FAUT; 13870000
INSERTSTRINGCONVERT(I); 13880000
ARITH ~ TRUE; 13890000
END; 13900000
% 8: FIXED-LENGTH "/" 13910000
GO TO FAUT; 13920000
% 9: STR REF, PATTERN & REPLACEMENT 13930000
GO TO FAUT; 13940000
% 10: INDIRECTION COMBINED 13950000
; 13960000
% 11: NOT USED 13970000
GO TO FAUT; 13980000
% 12: QMARK--ERROR 13990000
GO TO FAUT; 14000000
% 13: "*" STR VAR--ERROR 14010000
GO TO FAUT; 14020000
% 14: LABEL IN GO-TO PART 14030000
GO TO FAUT; 14040000
% 15: EXPRESSION 14050000
; 14060000
% 16: ARITH EXPR--NO STRING CONVERT 14070000
BEGIN 14080000
INSERTSTRINGCONVERT(I); 14090000
ARITH ~ TRUE; % MIGHT BE ARITH EXPR 14100000
END; 14110000
% 17: "*(" OF BAL VAR 14120000
GO TO FAUT; 14130000
% 18: STR REF & PATTERN 14140000
GO TO FAUT; 14150000
% 19: COMPLETE ARITH EXPR 14160000
ARITH ~ TRUE; 14170000
% 20: "S(", "F(", OR "(" OF GO-TO PART 14180000
GO TO FAUT; 14190000
% 21: COMBINED GO-TO PART 14200000
GO TO FAUT; 14210000
END CASES; 14220000
N ~ J ~ 0; 14230000
FOR I ~ MKS STEP 1 UNTIL SP-1 DO IF PTYPE[I] ! 0 THEN 14240000
BEGIN 14250000
N ~ N + 1; 14260000
MOVE(PSIZE[I],CODE[PPOINT[I].W],PPOINT[I].C,SCRATCH[J.W],J.C); 14270000
IF N { 1 AND NOT CON THEN 14280000
BEGIN PNAME[MKS] ~ PNAME[I]; 14290000
PTYPE[MKS] ~ PTYPE[I]; 14300000
END ELSE PTYPE[I] ~ 0; 14310000
J ~ J + PSIZE[I]; 14320000
END; 14330000
IF J = 0 THEN 14340000
BEGIN AA ~ "%00"; 14350000
MV(J~3,AA,5,SCRATCH[*],0); 14360000
PTYPE[MKS] ~ 1; % STRING NAME 14370000
PNAME[MKS] ~ TRUE; 14380000
END; 14390000
IF N > 1 THEN ARITH ~ FALSE; % NOT A SIMPLE ARITH EXPR. 14400000
IF ARITH THEN 14410000
BEGIN PTYPE[MKS] ~ 19; % COMPLETE ARITH EXPR 14420000
PNAME[MKS] ~ FALSE; 14430000
END ELSE 14440000
IF N > 1 OR CON THEN 14450000
BEGIN AA ~ N & "("[36:42:6]; 14460000
MV(2,AA,6,SCRATCH[J.W],J.C); 14470000
J ~ J + 2; 14480000
PNAME[MKS] ~ FALSE; 14490000
PTYPE[MKS] ~ 15; % EXPRESSION 14500000
END; 14510000
MOVE(J,SCRATCH[*],0,CODE[(I~PPOINT[MKS]).W],I.C); 14520000
PTR ~ I + (PSIZE[MKS]~J); 14530000
COMBINEGROUP ~ TRUE; 14540000
GO TO FIN; 14550000
% 14560000
FAUT: 14570000
WRITEINST; 14580000
SYNTAXERR(40,0); 14590000
WRITE(PRINT,17,CODE[*]); 14600000
WRITESTACK(SP); 14610000
SYSTEMERROR ~ TRUE; 14620000
GO TO FIN; 14630000
FAIL: 14640000
SYNTAXERR(ERRNO,ERRPOINT); 14650000
FIN: 14660000
IF SYSTEMERROR THEN INFORM0(21); 14670000
% IF INFORM THEN WRITEINST; 14680000
END COMBINEGROUP; 14690000
%********COMBINEGROUP***************************************************14700000
%********COMBINEINDIRECTION*********************************************14710000
BOOLEAN PROCEDURE COMBINEINDIRECTION(MKS); 14720000
VALUE MKS; 14730000
INTEGER MKS; 14740000
BEGIN INTEGER I, ERRNO, J, K; 14750000
LABEL FIN, FAIL, FAUT; 14760000
% 14770000
% IF INFORM THEN INFORM0(22); 14780000
FOR I ~ MKS STEP 1 UNTIL SP-2 DO IF PTYPE[I] = 6 THEN 14790000
BEGIN 14800000
CASE PTYPE[I+1] OF % CHECK FOR SYNTAX ERRORS 14810000
BEGIN GO TO FAUT; 14820000
% 1: STRING NAME 14830000
BEGIN J ~ "%"; % TO MARK AS NON-INPUT STRING NAME 14840000
MV(1,J,7,CODE[PPOINT[I+1].W],PPOINT[I+1].C); 14850000
END; 14860000
% 2: FUNCTION--INCOMPLETE 14870000
; % TO BECOME AN ERROR EVENTUALLY 14880000
% 3: LITERAL 14890000
; 14900000
% 4: GROUPING--INCOMPLETE 14910000
BEGIN ERRNO ~ 27; 14920000
GO TO FAIL; 14930000
END; 14940000
% 5: NOT USED 14950000
GO TO FAUT; 14960000
% 6: INDIRECTION--SHOULD NOT OCCUR 14970000
GO TO FAUT; 14980000
% 7: ARITHMETIC OPERATOR 14990000
BEGIN ERRNO ~ 34; 15000000
GO TO FAIL; 15010000
END; 15020000
% 8: FIXED-LENGTH "/" 15030000
BEGIN ERRNO ~ 34; 15040000
GO TO FAIL; 15050000
END; 15060000
% STR REF, PATTERN & REPLACEMENT 15070000
GO TO FAUT; 15080000
% 10: INDIRECTION COMBINED 15090000
GO TO FAUT; 15100000
% 11: "," 15110000
BEGIN ERRNO ~ 34; 15120000
GO TO FAIL; 15130000
END; 15140000
% 12: QMARK--ERROR 15150000
GO TO FAUT; 15160000
% 13: "*" STR VAR 15170000
BEGIN ERRNO ~ 34; 15180000
GO TO FAIL; 15190000
END; 15200000
% 14: LABEL IN GO-TO PART 15210000
GO TO FAUT; 15220000
% 15: EXPRESSION 15230000
; 15240000
% 16: INCOMPLETE ARITH EXPRESSION 15250000
INSERTSTRINGCONVERT(I); 15260000
% 17: "*(" OF BAL VAR 15270000
GO TO FAUT; 15280000
% 18: STR REF & PATTERN 15290000
GO TO FAUT; 15300000
% 19: COMPLETE ARITH EXPR 15310000
; 15320000
% 20: "S(", "F(", OR "(" OF GO-TO PART 15330000
GO TO FAUT; 15340000
% 21: COMBINED GO-TO PART 15350000
GO TO FAUT; 15360000
END CASES; 15370000
% INTERCHANGE ELEMENTS: 15380000
MOVE(K~PSIZE[I+1],CODE[(J~PPOINT[I+1]).W],J.C,SCRATCH[*],0); 15390000
MV(3,CODE[PPOINT[I].W],PPOINT[I].C,SCRATCH[K.W],K.C); 15400000
MOVE(K+3,SCRATCH[*],0,CODE[PPOINT[I].W],PPOINT[I].C); 15410000
PSIZE[I] ~ K + 3; 15420000
PTYPE[I] ~ 10; % INDIRECTION, COMBINED 15430000
PNAME[I] ~ TRUE; 15440000
PTYPE[I+1] ~ 0; % WIPE OUT NEXT ELEMENT 15450000
COMBINEINDIRECTION ~ TRUE; 15460000
GO TO FIN; 15470000
END; 15480000
% IF FALL THRU, NO ARGUMENT TO $: 15490000
ERRNO ~ 34; 15500000
GO TO FAIL; 15510000
FAUT: 15520000
WRITEINST; 15530000
SYNTAXERR(40,0); 15540000
WRITE(PRINT,17,CODE[*]); 15550000
WRITESTACK(SP); 15560000
SYSTEMERROR ~ TRUE; 15570000
GO TO FIN; 15580000
FAIL: 15590000
SYNTAXERR(ERRNO,PLOC[I+1]); 15600000
FIN: 15610000
IF SYSTEMERROR THEN INFORM0(22); 15620000
% IF INFORM THEN WRITEINST; 15630000
END COMBINEINDIRECTION; 15640000
%********COMBINEINDIRECTION*********************************************15650000
%********COMBINESTRVARNAME**********************************************15660000
BOOLEAN PROCEDURE COMBINESTRVARNAME(MKS); 15670000
VALUE MKS; 15680000
INTEGER MKS; 15690000
BEGIN LABEL FIN, SUCCEED; 15700000
INTEGER I; 15710000
% IF INFORM THEN INFORM0(23); 15720000
COMBINESTRVARNAME ~ FALSE; 15730000
IF I~PTYPE[MKS] ! 13 AND I ! 17 THEN 15740000
BEGIN WRITEINST; 15750000
SYNTAXERR(40,0); 15760000
WRITE(PRINT,17,CODE[*]); 15770000
WRITESTACK(SP); 15780000
SYSTEMERROR ~ TRUE; 15790000
GO TO FIN; 15800000
END; 15810000
PTYPE[MKS] ~ 0; 15820000
IF NOT COMBINEGROUP(MKS,FALSE) THEN GO TO FIN; 15830000
IF NOT PNAME[MKS] THEN 15840000
BEGIN SYNTAXERR(52,PLOC[MKS+1]); % INVALID NAME 15850000
GO TO SUCCEED; 15860000
END; 15870000
% MARK AS NON-INPUT 15880000
IF PTYPE[MKS] = 1 THEN % IDENTIFIER--CHANGE TO "%" TYPE 15890000
BEGIN I ~ "%"; 15900000
MV(1,I,7,CODE[PPOINT[MKS].W],PPOINT[MKS].C); 15910000
END ELSE 15920000
IF PTYPE[MKS] = 10 THEN % INDIRECTION--REMOVE "I" 15930000
BEGIN PTYPE[MKS] ~ 15; % EXPRESSION 15940000
PSIZE[MKS] ~ PSIZE[MKS] - 1; 15950000
END; 15960000
SUCCEED: 15970000
COMBINESTRVARNAME ~ TRUE; 15980000
FIN: 15990000
IF SYSTEMERROR THEN INFORM0(23); 16000000
% IF INFORM THEN WRITEINST; 16010000
END COMBINESTRVARNAME; 16020000
%********COMBINESTRVARNAME**********************************************16030000
%********COMPILE********************************************************16040000
% 16050000
% THE INTERNAL FORM OF A SNOBOL PROGRAM IS DESCRIBED HERE: 16060000
% THE PROGRAM IS "SEGMENTED", WITH A LABELED INSTRUCTION STARTING A 16070000
% SEGMENT, AND THE UNLABELED INSTRUCTIONS FOLLOWING IT ARE IN THE 16080000
% SAME SEGMENT. A SEGMENT IS A STRING, WHOSE "NAME" IS THE LABEL OF 16090000
% ITS FIRST INSTRUCTION, AND WHOSE "VALUE" IS THE INTERNAL CODED 16100000
% FORM OF THE INSTRUCTIONS IN THE SEGMENT. 16110000
% EACH SEGMENT STARTS WITH 2 CHARS GIVING THE LOC OF THE NEXT 16120000
% SEGMENT, FOR PATCHING PURPOSES. 16130000
% EACH INSTRUCTION STARTS WITH A 7-CHAR "INTRODUCTION" GIVING: 16140000
% 1 CHAR: THE ILLEGAL CHAR 16150000
% 2 CHARS: THE NUMBER OF THE INSTRUCTION, AS GIVEN IN THE LISTING16160000
% 2 CHARS: THE LOCATION OF THE SUCCESS EXIT, RELATIVE TO THE 16170000
% FIRST CHAR OF THE SEGMENT. 16180000
% 2 CHARS: THE SAME FOR THE FAILURE EXIT. 16190000
% IF EITHER EXIT ISNT SPECIFIED, AND THE NEXT INSTRUCTION IS 16200000
% UNLABELED, THE POINTER IS TO THE ILLEGAL CHAR AT THE START OF THE 16210000
% NEXT INSTRUCTION; IF THE NEXT INST IS LABELED, THE GO-TO PART IS 16220000
% "FILLED OUT" WITH A TRANSFER TO THIS LABEL. 16230000
% 16240000
% THE INTERNAL CODE IS: 16250000
% STRING NAMES AND LABELS IN THE GO-TO PARTS ARE REPRESENTED BY 16260000
% A QUOTE FOLLOWED BY A 12-BIT (2-CHARS) POINTER TO SYMBTABL. 16270000
% LITERALS ARE REPRESENTED BY "@" FOLLOWED BY A 2-CHAR POINTER 16280000
% TO SYMBTABL. 16290000
% PATTERN MATCHES ARE INDICATED BY "=" FOLLOWING THE CODE FOR 16300000
% THE PATTERN; REPLACEMENTS ARE INDICATED BY "~" FOLLOWING THE CODE 16310000
% FOR THE REPLACEMENT. (BOTH ARE POSTFIX OPERATORS.) 16320000
% THE RESERVED LABELS ARE REPRESENTED AS FOLLOWS: 16330000
% END: "-E" 16340000
% RETURN: "-R" 16350000
% FRETURN: "-F" 16360000
% SYNTAX ERRORS CAUSE THE CHARACTER "X" WHERE THE STRING REFERENCE 16370000
% SHOULD BE. 16380000
% FUNCTIONS ARE POSTFIX OPERATORS, WHICH USE 4 CHARACTERS: "#" 16390000
% TO INDICATE THE FUNCTION CALL, 2 CHARS FOR A POINTER TO THE 16400000
% SYMBOL TABLE ENTRY FOR THE FUNCTION, AND 1 CHAR TO GIVE THE NUMBER 16410000
% OF PARAMETERS. 16420000
% INDIRECTION IS A POSTFIX OPERATOR CONSISTING OF A "$" AND ONE 16430000
% CHARACTER GIVING THE NUMBER OF INDIRECTIONS. NOTE THAT THIS MEANS 16440000
% THAT THE SYSTEM CANT HANDLE MORE THAN 63 CONSECUTIVE DOLLAR SIGNS 16450000
% WITHOUT USING PARENTHESES TO CAUSE A GROUPING. THIS IS NOT 16460000
% EXPECTED TO CREATE ANY HARDSHIPS WITH ANY USERS. 16470000
% 16480000
% THE FOLLOWING STACK ARRAYS ARE USED BY THE COMPILER: 16490000
% 16500000
% PLOC[*] HOLDS POINTERS INTO INST[*], TO THE START OF THE ORIGINAL 16510000
% CODE FOR THE ELEMENT, FOR DIAGNOSTIC PURPOSES 16520000
% PPOINT[*] HOLDS POINTERS INTO CODE[*], TO THE START OF THE 16530000
% COMPILED CODE FOR THE ELEMENTS 16540000
% PSIZE[*] HOLDS THE SIZE OF THE COMPILED PIECE OF CODE 16550000
% PBACK[*] LINKS BACK TO THE START OF NEXTINGS OF GROUPINGS OR 16560000
% OF FUNCTION CALLS 16570000
% PST[*] HOLDS THE OPERATOR FOR ARITHMETIC OPERATORS 16580000
% PTYPE[*] IS THE TYPE OF ELEMENT, AS FOLLOWS: 16590000
% 0: IGNORE--COMBINED WITH EARLIER ELEMENTS 16600000
% 1: STRING NAME 16610000
% 2: START OF FUNCTION CALL (#---) 16620000
% 3: LITERAL 16630000
% 4: "(" AT START OF GROUPING 16640000
% 5: STRING VARIABLE--COMBINED INTO ONE ELEMENT 16650000
% 6: INDIRECTION, UNCOMBINED ($N) 16660000
% 7: ARITHMETIC OPERATOR 16670000
% 8: "/" OF FIXED-LENGTH VARIABLE 16680000
% 9: STR REF, PATTERN, & REPLACEMENT COMBINED 16690000
% 10: INDIRECTION, COMBINED (INCLUDES "I" FOR INPUT CHECK) 16700000
% 11: NOT IN USE 16710000
% 12: NOT IN USE 16720000
% 13: "*" AT START OF STRING VARIABLE 16730000
% 14: LABEL IN GO-TO PART 16740000
% 15: EXPRESSION (COMBINED) 16750000
% 16: ARITHMETIC EXPRESSION--NO STRING CONVERT ADDED 16760000
% 17: "*(" OF BALANCED STRING VARIABLE 16770000
% 18: STR REF & PATTERN TOGETHER. 16780000
% 19: COMPLETE ARITH EXPR (WITH STRING CONVERT) 16790000
% 20: "S(", "F(", OR "(" OF GO-TO PART 16800000
% 21: COMBINED GO-TO PART 16810000
% 16820000
% 16830000
PROCEDURE COMPILE(INST); ALPHA ARRAY INST[0]; 16840000
BEGIN LABEL 16850000
NEXT, ILLEGAL, 16860000
BL, LIT, STR, 16870000
NAME, NAME1, CMA, GOTO, GTPART, 16880000
CONDENSEPATTERN, 16890000
CONDENSEREPLACEMENT, 16900000
DLR, 16910000
ENDSTRVAR, 16920000
ERROR, 16930000
NOP, 16940000
OP, 16950000
PARENERR, 16960000
QMRK, RETURN, 16970000
MESFIL, 16980000
SEMICOLON, START, L1 16990000
; 17000000
%******** 17010000
BOOLEAN 17020000
ARITH, 17030000
ARF, 17040000
FIXEDLENGTH, 17050000
NF, 17060000
PATTERN, 17070000
REPLACEMENT, 17080000
SVF; 17090000
BOOLEAN ARRAY COMPILINGFCT[0:50]; 17100000
INTEGER 17110000
FIRSTCHAR, % FLAGS FOR FIRST OF INST. 17120000
I, 17130000
J, 17140000
T, 17150000
TEMP; 17160000
% 17170000
P ~ SCANCHAR(" "," ",INST[*],0); 17180000
START: 17190000
FOR I ~ 0 STEP 1 UNTIL 5 DO BACKTRACK[0,I] ~ 0; 17200000
FIRSTCHAR ~ MKS ~ PARENCOUNT ~ 0; 17210000
GTLAST ~ GT; 17220000
PATTERN ~ REPLACEMENT ~ GT ~ GTS ~ GTF ~ SYSTEMERROR ~ SVF ~ ARF ~ 17230000
FIXEDLENGTH ~ FALSE; 17240000
P ~ P + 1; 17250000
P ~ P + SKIPCHAR(" ",INST[P.W],P.C); 17260000
IF P } INSTSIZE THEN GO TO RETURN; 17270000
SP ~ -1; 17280000
IF DATACOMF THEN IF INSTNUM MOD 10 = 0 THEN 17290000
IF INSTNUM = 0 THEN % RETURN, LINE FEED. 17300000
BEGIN MV(3,CRLF,5,DCWRITE[*],0); 17310000
IF OUTPUT THEN; 17320000
END ELSE 17330000
% WRITE INST #: 17340000
MESSAGETTI(15,INSTNUM); % TYPE # ON TELETYPE. 17350000
NEXT: 17360000
IF (SP~SP+1) } STACKSIZE THEN 17370000
BEGIN SYNTAXERR(21,P); 17380000
GO TO RETURN; 17390000
END; 17400000
% IF INFORM THEN 17410000
% BEGIN MV(6,INST[P.W],P.C,AA,2); 17420000
% INFORMIA(2,SP,AA); 17430000
% END; 17440000
PPOINT[SP] ~ PTR; 17450000
PLOC[SP] ~ P; % SAVE FOR SYNTAX ERRORS 17460000
IF P } INSTSIZE THEN GO TO QMRK; 17470000
CASE CHARTYPE[CHAR(INST[P.W],P.C)] OF 17480000
BEGIN 17490000
% 0: ERROR 17500000
BEGIN SYNTAXERR(3,P); 17510000
GO TO RETURN; 17520000
END; 17530000
% 1: BLANK 17540000
BEGIN P ~ P + SKIPCHAR(" ",INST[P.W],P.C); 17550000
SP ~ SP - 1; 17560000
GO TO NEXT; 17570000
END; 17580000
% 2: "~" OR "=" 17590000
BEGIN 17600000
IF SP < 1 THEN 17610000
BEGIN SYNTAXERR(6,P); 17620000
GO TO RETURN; 17630000
END; 17640000
IF NOT (PNAME[0] OR PTYPE[0]=6) THEN 17650000
BEGIN SYNTAXERR(15,P); % REPLACEMENT IN VALUE EXPR 17660000
GO TO RETURN; 17670000
END; 17680000
IF ARF THEN 17690000
BEGIN SYNTAXERR(13,P); % EXTRA "~" OR "=" 17700000
GO TO RETURN; 17710000
END; 17720000
IF PARENCOUNT ! 0 THEN 17730000
BEGIN SYNTAXERR(27,P); % MISSING ")" 17740000
GO TO RETURN; 17750000
END; 17760000
IF SVF THEN 17770000
BEGIN SYNTAXERR(38,P); % MISSING "*" 17780000
GO TO RETURN; 17790000
END; 17800000
IF GT THEN 17810000
BEGIN SYNTAXERR(7,P); % UNRECOGNIZED GO-TO CONSTRUCT 17820000
GO TO RETURN; 17830000
END; 17840000
ARF ~ TRUE; 17850000
P ~ P + 1; 17860000
CONDENSEPATTERN: 17870000
% IF INFORM THEN INFORM0(27); 17880000
FOR I ~ 0 STEP 1 UNTIL SP-1 DO 17890000
CASE PTYPE[I] OF 17900000
BEGIN; % IF 0, IGNORE 17910000
%1: STRING NAME: 17920000
; 17930000
% 2: START OF FUNCTION CALL 17940000
GO TO ERROR; 17950000
% 3: LITERAL 17960000
; 17970000
% 4: "(" OF GROUPING 17980000
GO TO ERROR; 17990000
% 5: STR VAR 18000000
; 18010000
% 6: INDIRECTION 18020000
IF NOT COMBINEINDIRECTION(I) THEN GO TO RETURN; 18030000
% 7: ARITH OPERATOR 18040000
BEGIN IF NOT COMBINEARITHMETIC(I) THEN GO TO RETURN; 18050000
WHILE I > 0 AND PTYPE[I]!16 DO I ~ I - 1; % FIND RESULT 18060000
IF PTYPE[I] ! 16 THEN GO TO ERROR; 18070000
INSERTSTRINGCONVERT(I); 18080000
END; 18090000
% 8: "/" OF FIXED-LENGTH VAR 18100000
GO TO ERROR; 18110000
% 9: STR REF, PATTERN & REPL 18120000
GO TO ERROR; 18130000
% 10: INDIRECTION COMBINED 18140000
; 18150000
% 11: UNUSED 18160000
GO TO ERROR; 18170000
% 12: UNUSED 18180000
GO TO ERROR; 18190000
% 13: "*" OF STR VAR 18200000
GO TO ERROR; 18210000
% 14: LABEL IN GO-TO PART 18220000
GO TO ERROR; 18230000
% 15: EXPRESSION 18240000
; 18250000
% 16: ARITH EXPR--NO STRING CONVERT 18260000
INSERTSTRINGCONVERT(I); 18270000
% 17: "*(" OF BAL VAR 18280000
GO TO ERROR; 18290000
% 18: STR REF & PATTERN 18300000
GO TO ERROR; 18310000
% 19: COMPLETE ARITH EXPR 18320000
; 18330000
% 20: "S(", "F(", OR "(" OF GO-TO PART 18340000
GO TO ERROR; 18350000
% 21: COMBINED GO-TO PART 18360000
GO TO ERROR; 18370000
END CASES; 18380000
I1 ~ I2 ~ 0; 18390000
FOR I ~ 1 STEP 1 UNTIL SP-1 DO IF PTYPE[I] ! 0 THEN 18400000
BEGIN 18410000
MOVE(PSIZE[I],CODE[PPOINT[I].W],PPOINT[I].C,SCRATCH[I2.W],I2.C); 18420000
I2 ~ I2 + PSIZE[I]; 18430000
I1 ~ I1 + 1; 18440000
PTYPE[I] ~ 0; 18450000
END; 18460000
IF I1 } 1 THEN 18470000
BEGIN 18480000
IF PTYPE[0] = 1 THEN 18490000
BEGIN AA ~ "%"; 18500000
MV(1,AA,7,CODE[PPOINT[0].W],PPOINT[0].C); 18510000
END ELSE 18520000
IF PTYPE[0] = 10 THEN 18530000
BEGIN PTYPE[0] ~ 15; % EXPRESSION 18540000
PSIZE[0] ~ PSIZE[0] - 1; % DROP "I" 18550000
END; 18560000
PTR ~ PPOINT[0] + PSIZE[0]; 18570000
STORECHARS(1,"S",7); 18580000
STORECHARS(I2,SCRATCH[0],0); 18590000
STORECHARS(1,"=",7); 18600000
PSIZE[0] ~ PSIZE[0] + I2 + 2; 18610000
FIRSTCHAR.[43:2] ~ 3; % STR REF, PATTERN EXIST 18620000
PTYPE[0] ~ 18; % STR REF & PATTERN 18630000
END ELSE 18640000
FIRSTCHAR.[43:2] ~ 2; % STR REF, NO PATTERN 18650000
IF GT THEN % PUT IN "/" AS GO-TO DELIMITER 18660000
BEGIN STORECHARS(1,"/",7); 18670000
PSIZE[0] ~ PSIZE[0] + 1; 18680000
END; 18690000
PATTERN ~ TRUE; 18700000
SP ~ 0; 18710000
PBACK[MKS~1] ~ 0; 18720000
% IF INFORM THEN WRITEINST; 18730000
GO TO NEXT; 18740000
END; % CASE FOR "=" OR "~". 18750000
% 3: LETTER, DIGIT, OR PERIOD 18760000
GO TO NAME; 18770000
% 4: """ 18780000
GO TO LIT; 18790000
% 5: "(" 18800000
BEGIN 18810000
IF GT THEN IF PARENCOUNT = 0 THEN GO TO GTPART; 18820000
COMPILINGFCT[PARENCOUNT~PARENCOUNT+1] ~ FALSE; 18830000
P ~ P + 1; 18840000
PBACK[SP] ~ MKS; 18850000
MKS ~ SP; 18860000
PTYPE[SP] ~ 4; % "("--BEGIN GROUPING 18870000
PSIZE[SP] ~ 0; % NOTHING TO STORE IN CODE HERE 18880000
GO TO NEXT; 18890000
END; 18900000
% 6: ")" 18910000
BEGIN 18920000
IF PARENCOUNT { 0 THEN 18930000
BEGIN SYNTAXERR(12,P); % EXTRA RIGHT PAREN 18940000
GO TO RETURN; 18950000
END; 18960000
IF SVF AND NOT FIXEDLENGTH THEN IF PARENCOUNT = 1 THEN 18970000
IF PTYPE[MKS] = 17 THEN 18980000
BEGIN 18990000
IF CHAR(INST[P.W],P.C+1) ! "*" THEN 19000000
BEGIN SYNTAXERR(38,P+1); 19010000
GO TO RETURN; 19020000
END; 19030000
P ~ P + 1; % SKIP ")" 19040000
PARENCOUNT ~ 0; 19050000
GO TO ENDSTRVAR; 19060000
END BALANCED VARIABLE ELEMENT; 19070000
IF GT AND PARENCOUNT=1 THEN % END OF A PIECE OF THE GO-TO PART 19080000
BEGIN 19090000
IF NOT COMBINEGOTOPART(MKS) THEN GO TO RETURN; 19100000
END ELSE 19110000
IF COMPILINGFCT[PARENCOUNT] THEN 19120000
BEGIN 19130000
IF NOT COMBINEGROUP(MKS+1,FALSE) THEN GO TO RETURN; 19140000
COMBINEFUNCTION(IF PTYPE[MKS]=2 THEN MKS ELSE (MKS~PBACK[MKS])); 19150000
END ELSE 19160000
BEGIN PTYPE[MKS] ~ 0; % WIPE OUT "(" ENTRY 19170000
IF NOT COMBINEGROUP(MKS,TRUE) THEN GO TO RETURN; 19180000
END; 19190000
PARENCOUNT ~ PARENCOUNT - 1; 19200000
P ~ P + 1; 19210000
IF PTYPE[SP~MKS]!2 THEN MKS ~ PBACK[MKS]; 19220000
GO TO NEXT; 19230000
END; 19240000
% 7: "*" 19250000
GO TO STR; 19260000
% 8: "$" 19270000
GO TO DLR; 19280000
% 9: ":" GO-TO PART 19290000
GOTO: 19300000
BEGIN 19310000
IF SVF THEN % UNMATCHED STR VAR * BEFORE GO-TO. 19320000
BEGIN SYNTAXERR(38,PPOINT[SP-1]); 19330000
GO TO RETURN; 19340000
END; 19350000
IF GT THEN 19360000
BEGIN SYNTAXERR(7,P); % UNRECOGNIZED CONSTRUCT 19370000
GO TO RETURN; 19380000
END; 19390000
IF PARENCOUNT ! 0 THEN 19400000
BEGIN SYNTAXERR(10,P); % PAREN COUNT NON-ZERO 19410000
GO TO RETURN; 19420000
END; 19430000
GT ~ TRUE; 19440000
P ~ P + 1; 19450000
PSIZE[SP] ~ PTYPE[SP] ~ 0; 19460000
IF NOT ARF THEN 19470000
BEGIN FIRSTCHAR.[45:1] ~ 0; % NO REPLACEMENT 19480000
GO TO CONDENSEPATTERN; 19490000
END; 19500000
% REPLACEMENT TO BE CONDENSED 19510000
CONDENSEREPLACEMENT: 19520000
% IF INFORM THEN INFORM0(28); 19530000
FOR I ~ 0 STEP 1 UNTIL SP-1 DO 19540000
CASE PTYPE[I] OF 19550000
BEGIN 19560000
% 0: IGNORE 19570000
; 19580000
% 1: STRING NAME 19590000
; 19600000
% 2: FUNCTION CALL 19610000
GO TO ERROR; 19620000
% 3: LITERAL 19630000
; 19640000
% 4: "(" OF GROUPING 19650000
GO TO ERROR; 19660000
% 5: STR VAR COMBINED 19670000
GO TO ERROR; 19680000
% 6: INDIRECTION 19690000
IF NOT COMBINEINDIRECTION(I) THEN GO TO RETURN; 19700000
% 7: ARITH OPERATOR 19710000
BEGIN 19720000
IF NOT COMBINEARITHMETIC(I) THEN GO TO RETURN; 19730000
WHILE I > 0 AND PTYPE[I]!16 DO I ~ I-1; % FIND RESULT 19740000
IF PTYPE[I] ! 16 THEN GO TO ERROR; 19750000
INSERTSTRINGCONVERT(I); 19760000
END; 19770000
% 8: "/" OF FIXED-LENGTH VAR 19780000
GO TO ERROR; 19790000
% 9: STR REF, PATTERN & REPLACEMENT 19800000
GO TO ERROR; 19810000
% 10: INDIRECTION COMBINED 19820000
; 19830000
% 11: UNUSED 19840000
GO TO ERROR; 19850000
% 12: UNUSED 19860000
GO TO ERROR; 19870000
% 13: "*" OF STR VAR 19880000
GO TO ERROR; 19890000
% 14: GO-TO LABEL 19900000
GO TO ERROR; 19910000
% 15: EXPRESSION 19920000
; 19930000
% 16: ARITH EXPR--NO STR CONVERT 19940000
INSERTSTRINGCONVERT(I); 19950000
% 17: "*(" OF BAL VAR 19960000
GO TO ERROR; 19970000
% 18: STR REF & PATTERN 19980000
IF I ! 0 THEN GO TO ERROR; 19990000
% 19: COMPLETE ARITH EXPR 20000000
; 20010000
% 20: "S(", "F(", OR "(" OF GO-TO PART 20020000
GO TO ERROR; 20030000
% 21: COMBINED GO-TO PART 20040000
GO TO ERROR; 20050000
END CASES; 20060000
IF PTYPE[0] = 1 THEN % MARK AS NON-INPUT 20070000
BEGIN AA ~ "%"; 20080000
MV(1,AA,7,CODE[PPOINT[0].W],PPOINT[0].C); 20090000
END ELSE 20100000
IF PTYPE[0] = 10 THEN 20110000
BEGIN PTYPE[0] ~ 15; % EXPRESSION 20120000
PSIZE[0] ~ PSIZE[0] - 1; % DROP "I" 20130000
END; 20140000
I1 ~ I2 ~ 0; 20150000
FOR I ~ 1 STEP 1 UNTIL SP-1 DO IF PTYPE[I]!0 THEN 20160000
BEGIN 20170000
MOVE(PSIZE[I],CODE[PPOINT[I].W],PPOINT[I].C,SCRATCH[I2.W],I2.C); 20180000
I2 ~ I2 + PSIZE[I]; 20190000
I1 ~ I1 + 1; 20200000
PTYPE[I] ~ 0; 20210000
END; 20220000
PTR ~ PPOINT[0] + PSIZE[0]; 20230000
FIRSTCHAR.[45:1] ~ 1; % REPLACEMENT EXISTS 20240000
STORECHARS(I2,SCRATCH[0],0); 20250000
STORECHARS(1,"~",7); 20260000
PSIZE[0] ~ PSIZE[0] + I2 + 1; 20270000
PTYPE[0] ~ 9; % STR REF, PATTERN & REPLACEMENT 20280000
REPLACEMENT ~ TRUE; 20290000
SP ~ 0; 20300000
PBACK[MKS~1] ~ 0; 20310000
% IF INFORM THEN WRITEINST; 20320000
GO TO NEXT; 20330000
END; % CASE FOR GO-TO ":" OR " /" 20340000
% 10: "-","+",OR "|" 20350000
GO TO OP; 20360000
% 11: "," 20370000
BEGIN 20380000
IF NOT COMPILINGFCT[PARENCOUNT] THEN 20390000
BEGIN SYNTAXERR(9,P); % ILLEGAL COMMA 20400000
GO TO RETURN; 20410000
END; 20420000
IF NOT COMBINEGROUP(MKS+1,FALSE) THEN GO TO RETURN; 20430000
PBACK[MKS+1] ~ (IF PTYPE[MKS]=2 THEN MKS ELSE PBACK[MKS]); 20440000
MKS ~ SP ~ MKS+1; 20450000
P ~ P + 1; 20460000
GO TO NEXT; 20470000
END; 20480000
% 12: "/" 20490000
BEGIN IF SVF AND PARENCOUNT = 0 AND NOT FIXEDLENGTH THEN 20500000
BEGIN % FIXED-LENGTH VARIABLE SLASH 20510000
IF PTYPE[MKS] ! 13 THEN 20520000
BEGIN SYNTAXERR(14,P); 20530000
GO TO RETURN; 20540000
END; 20550000
IF NOT COMBINESTRVARNAME(MKS) THEN GO TO RETURN; 20560000
PTYPE[SP~MKS+1] ~ 8; % FIXED-LENGTH "/" 20570000
PPOINT[SP] ~ PTR; 20580000
PSIZE[SP] ~ 0; 20590000
P ~ P + 1; 20600000
FIXEDLENGTH ~ TRUE; 20610000
PBACK[SP] ~ PBACK[MKS]; 20620000
MKS ~ SP; 20630000
GO TO NEXT; 20640000
END; 20650000
IF PARENCOUNT = 0 THEN 20660000
IF CHAR(INST[(P-1).W],(P-1).C) = " " THEN 20670000
IF I~CHAR(INST[P.W],P.C+1) = "S" OR I = "F" OR I = "(" 20680000
THEN GO TO GOTO; 20690000
GO TO OP; 20700000
END; % CASE FOR "/" 20710000
% 13: QMARK 20720000
IF P } INSTSIZE THEN GO TO QMRK; 20730000
% 14: ";" 20740000
GO TO SEMICOLON; 20750000
END CASES; 20760000
ILLEGAL: 20770000
SYNTAXERR(3,P); 20780000
GO TO RETURN; 20790000
LIT: 20800000
IF GT THEN IF PARENCOUNT { 1 THEN 20810000
BEGIN SYNTAXERR(28,P); GO TO RETURN; END; 20820000
BEGIN 20830000
PSIZE[SP] ~ 3; PTYPE[SP] ~ 3; % LITERAL 20840000
T ~ P; 20850000
P ~ P + SCANCHAR(""",""",INST[P.W],P.C+1) + 1; 20860000
IF P } INSTSIZE THEN 20870000
BEGIN SYNTAXERR(0,T); 20880000
GO TO RETURN; 20890000
END; 20900000
T ~ ENTERST(P-T-1,INST[*],T+1,"LIT") & "@"[30:42:6]; 20910000
STORECHARS(3,T,5); 20920000
P ~ P + 1; 20930000
GO TO NEXT; 20940000
END; 20950000
NAME: 20960000
IF GT THEN IF PARENCOUNT = 0 OR PTYPE[SP-1] = 20 THEN GO TO GTPART; 20970000
PSIZE[SP] ~ 3; 20980000
T ~ P; 20990000
DO P ~ P + 1 UNTIL CHARTYPE[CHAR(INST[P.W],P.C)] ! 3; 21000000
T ~ IF CHAR(INST[P.W],P.C) = "(" 21010000
THEN ENTERST(P-T,INST[*],T,"FCT") & "#"[30:42:6] 21020000
ELSE ENTERST(P-T,INST[*],T,"SYMB") & """[30:42:6]; 21030000
STORECHARS(3,T,5); 21040000
IF CHAR(INST[P.W],P.C) = "(" THEN 21050000
BEGIN 21060000
COMPILINGFCT[PARENCOUNT~PARENCOUNT+1] ~ TRUE; 21070000
PTR ~ PTR + 1; % MAKE ROOM FOR CHAR GIVING # OF PARAMS 21080000
P ~ P + 1; 21090000
PBACK[SP] ~ MKS; 21100000
MKS ~ SP; 21110000
PTYPE[SP] ~ 2; % FUNCTION CALL 21120000
PSIZE[SP] ~ 3; % #-- 21130000
GO TO NEXT; 21140000
END ELSE 21150000
BEGIN PTYPE[SP] ~ 1; % STRING NAME 21160000
PNAME[SP] ~ TRUE; 21170000
END; 21180000
GO TO NEXT; 21190000
GTPART: 21200000
IF PARENCOUNT = 0 THEN 21210000
BEGIN 21220000
IF (TEMP ~ CHAR(INST[P.W],P.C)) = "S" OR TEMP = "F" THEN 21230000
IF CHAR(INST[P.W],P.C+1) = "(" THEN 21240000
BEGIN 21250000
IF (IF TEMP="S" THEN GTS ELSE GTF) THEN 21260000
BEGIN SYNTAXERR(4,P); 21270000
GO TO RETURN; 21280000
END; 21290000
P ~ P + 2; 21300000
PARENCOUNT ~ 1; COMPILINGFCT[1] ~ FALSE; 21310000
IF TEMP = "S" THEN GTS ~ TRUE ELSE GTF ~ TRUE; 21320000
PTYPE[SP] ~ 20; % "S(", "F(", OR "(" OF GO-TO PART 21330000
PBACK[SP] ~ MKS; MKS ~ SP; 21340000
PST[SP] ~ TEMP; 21350000
GO TO NEXT; 21360000
END ELSE 21370000
BEGIN SYNTAXERR(5,P+1); 21380000
COMMENT CHAR AFTER S OR F NOT "("; 21390000
GO TO RETURN; 21400000
END ELSE 21410000
IF TEMP = "(" THEN 21420000
BEGIN 21430000
IF GTS AND GTF THEN 21440000
BEGIN SYNTAXERR(4,P); 21450000
GO TO RETURN; 21460000
END; 21470000
P ~ P + 1; 21480000
PARENCOUNT ~ 1; COMPILINGFCT[1] ~ FALSE; 21490000
GTS ~ GTF ~ TRUE; 21500000
PTYPE[SP] ~ 20; % "S(", "F(", OR "(" OF GO-TO PART 21510000
PBACK[SP] ~ MKS; MKS ~ SP; 21520000
PST[SP] ~ "("; 21530000
GO TO NEXT; 21540000
END ELSE 21550000
BEGIN SYNTAXERR(7,P); 21560000
GO TO RETURN; 21570000
END; 21580000
END ELSE 21590000
IF PARENCOUNT = 1 THEN 21600000
BEGIN 21610000
T ~ P; P ~ P + 1; 21620000
P ~ P + MIN(SCANCHAR(" ","(",INST[P.W],P.C), 21630000
SCANCHAR(" ",")",INST[P.W],P.C)); 21640000
IF CHAR(INST[P.W],P.C) = "(" THEN 21650000
BEGIN SYNTAXERR(8,P); 21660000
GO TO RETURN; 21670000
END; 21680000
IF CHAR(INST[P.W],P.C) = " " THEN 21690000
BEGIN TEMP ~ P; 21700000
WHILE CHAR(INST[P.W],P.C) = " " DO P ~ P + 1; 21710000
IF P } INSTSIZE THEN 21720000
BEGIN SYNTAXERR(18,0); 21730000
GO TO RETURN; 21740000
END; 21750000
IF CHAR(INST[P.W],P.C) ! ")" THEN 21760000
BEGIN SYNTAXERR(8,P); 21770000
GO TO RETURN; 21780000
END; 21790000
END ELSE TEMP ~ P; 21800000
IF EQ(3,WORDS[6],2,INST[T.W],T.C) THEN 21810000
IF T+3 = TEMP THEN 21820000
BEGIN STORECHARS(2,"-E",6); 21830000
PSIZE[SP] ~ 2; 21840000
GO TO L1; 21850000
END ELSE 21860000
ELSE 21870000
IF EQ(6,WORDS[6],6,INST[T.W],T.C) THEN 21880000
IF T+6 = TEMP THEN 21890000
BEGIN STORECHARS(2,"-R",6); 21900000
PSIZE[SP] ~ 2; 21910000
GO TO L1; 21920000
END ELSE 21930000
ELSE 21940000
IF EQ(7,WORDS[6],5,INST[T.W],T.C) THEN 21950000
IF T+7 = TEMP THEN 21960000
BEGIN STORECHARS(2,"-F",6); 21970000
PSIZE[SP] ~ 2; 21980000
GO TO L1; 21990000
END; 22000000
T ~ ENTERST(TEMP-T,INST[*],T,"INST") & ":"[30:42:6]; 22010000
STORECHARS(3,T,5); 22020000
PSIZE[SP] ~ 3; 22030000
L1: PTYPE[SP] ~ 14; % IDENTIFIER--LABEL 22040000
GO TO NEXT; 22050000
END; 22060000
GO TO ERROR; 22070000
STR: % "*" ENCOUNTERED--TEST FOR STRING VARIABLE OR MULTIPLY. 22080000
% AN ASTERISK IS A STRING VARIABLE ASTERISK IFF IT IS IN THE 22090000
% PATTERN PART AND OUTSIDE OF PARENTHESES. 22100000
BEGIN 22110000
DEFINE DUMMY=#; 22120000
IF SP < 1 THEN 22130000
BEGIN SYNTAXERR(2,P); % UNRECOGNIZED CONSTRUCT IN STR REF 22140000
GO TO RETURN; 22150000
END; 22160000
IF PARENCOUNT > 0 THEN GO TO OP; 22170000
IF ARF AND NOT GT THEN GO TO OP; 22180000
IF SVF THEN GO TO ENDSTRVAR; 22190000
IF GT THEN 22200000
BEGIN SYNTAXERR(3,P); 22210000
GO TO RETURN; 22220000
END; 22230000
IF CHAR(INST[P.W],P.C+1) = "(" THEN 22240000
BEGIN PTYPE[SP] ~ 17; % "*(" OF BAL STR VAR 22250000
PARENCOUNT ~ 1; 22260000
P ~ P + 2; 22270000
END ELSE 22280000
BEGIN PTYPE[SP] ~ 13; % "*" OF ARB OR F/L STR VAR 22290000
P ~ P + 1; 22300000
END; 22310000
PSIZE[SP] ~ 0; 22320000
PTR ~ PTR + 2; % FOR *N 22330000
PBACK[SP] ~ MKS; 22340000
MKS ~ SP; 22350000
SVF ~ TRUE; 22360000
GO TO NEXT; 22370000
END; 22380000
ENDSTRVAR: 22390000
BEGIN 22400000
IF I~PTYPE[MKS] = 13 THEN % SIMPLE STR VAR 22410000
BEGIN 22420000
IF NOT COMBINESTRVARNAME(MKS) THEN GO TO RETURN; 22430000
AA ~ "*1"; 22440000
END ELSE 22450000
IF I = 17 THEN % BALANCED STR VAR 22460000
BEGIN 22470000
IF NOT COMBINESTRVARNAME(MKS) THEN GO TO RETURN; 22480000
AA ~ "*2"; 22490000
END ELSE 22500000
IF I = 8 THEN % FIXED-LENGTH VAR 22510000
BEGIN PTYPE[MKS] ~ 0; 22520000
IF NOT COMBINEGROUP(MKS,FALSE) THEN GO TO RETURN; 22530000
AA ~ "*3"; 22540000
END ELSE 22550000
% ERROR--MKS DOESNT POINT TO VALID ELEMENT 22560000
GO TO ERROR; 22570000
PTR ~ PPOINT[MKS] + PSIZE[MKS]; 22580000
STORECHARS(2,AA,6); 22590000
PSIZE[SP~MKS] ~ PSIZE[MKS] + 2; 22600000
PTYPE[SP] ~ 5; % STR VAR--COMBINED 22610000
P ~ P + 1; % SKIP "*" 22620000
SVF ~ FIXEDLENGTH ~ FALSE; 22630000
GO TO NEXT; 22640000
END; 22650000
OP: 22660000
I ~ CHAR(INST[P.W],P.C); 22670000
IF I = "*" THEN 22680000
IF CHAR(INST[P.W],P.C+1) = "*" 22690000
THEN P ~ P + 1 % TWO START--EXPONENTIATION 22700000
ELSE I ~ "|"; % ONE STAR--MULTIPLICATION 22710000
PST[SP] ~ I; % FOR COMBINEARITHMETIC 22720000
I.C6 ~ "."; 22730000
PTYPE[SP] ~ 7; 22740000
PBACK[SP] ~ MKS; 22750000
PSIZE[SP] ~ 2; 22760000
STORECHARS(2,I,6); 22770000
PTR ~ PTR + 2; % MAKE ROOM FOR STRING CONVERT (2 CHARS). 22780000
P ~ P + 1; 22790000
GO TO NEXT; 22800000
PARENERR: 22810000
SYNTAXERR(12,P); 22820000
GO TO RETURN; 22830000
ERROR: 22840000
WRITEINST; 22850000
SYNTAXERR(40,0); 22860000
WRITESTACK(SP); 22870000
GO TO RETURN; 22880000
DLR: 22890000
I ~ 1; 22900000
DO BEGIN P ~ P + 1; 22910000
IF J ~ CHAR(INST[P.W],P.C) = "$" THEN I ~ I + 1; 22920000
END UNTIL J ! "$" AND J ! " "; 22930000
AA ~ "$-I" & I[36:42:6]; 22940000
STORECHARS(3,AA,5); % "$", NO. OF INDIRECTIONS, "I" 22950000
PTYPE[SP] ~ 6; % INDIRECTION 22960000
PSIZE[SP] ~ 2; 22970000
GO TO NEXT; 22980000
MESFIL: 22990000
SYNTAXERR(38,0); 23000000
COMMENT MISSING STR VAR ASTERISK; 23010000
GO TO RETURN; 23020000
SEMICOLON: 23030000
BEGIN 23040000
% IF INFORM THEN INFORM0(29); 23050000
IF SP > 1 THEN GO TO QMRK; 23060000
IF ARF THEN IF NOT GT THEN IF SP=1 THEN IF PTYPE[0]!9 23070000
THEN STORECHARS(1,"~",7); % STMT OF FORM <STRREF> ~ 23080000
IF NOT GTS THEN SLOC ~ PTR; 23090000
IF NOT GTF THEN FLOC ~ PTR; 23100000
TEMP ~ FLOC & SLOC[24:36:12]; 23110000
MOVE(4,TEMP,4,CODE[MARKER.W],MARKER.C+3); 23120000
INSTNUM ~ INSTNUM + 1; 23130000
MARKER ~ PTR; 23140000
AA ~ 0 & INSTNUM[12:36:12] & QMARK[6:42:6]; 23150000
STORECHARS(7,AA,1); 23160000
PTR ~ PTR + 1; 23170000
GO TO START; 23180000
END; 23190000
QMRK: 23200000
IF PARENCOUNT ! 0 THEN 23210000
BEGIN SYNTAXERR(18,0); 23220000
COMMENT PARENCOUNT NON-ZERO AT END OF INSTRUCTION; 23230000
GO TO RETURN; 23240000
END; 23250000
IF SVF THEN GO TO MESFIL; 23260000
PTYPE[SP] ~ PSIZE[SP] ~ 0; 23270000
IF NOT GT THEN 23280000
BEGIN 23290000
IF NOT ARF THEN IF PTYPE[0]!18 THEN IF SP>1 23300000
THEN GO TO CONDENSEPATTERN; 23310000
IF ARF THEN IF NOT GT THEN IF PTYPE[0] ! 9 23320000
THEN GO TO CONDENSEREPLACEMENT; 23330000
END; 23340000
I1 ~ 0; 23350000
PTR ~ PPOINT[0]; 23360000
SLOC ~ FLOC ~ 0; 23370000
FOR I ~ 0 STEP 1 UNTIL SP DO IF PTYPE[I] ! 0 THEN 23380000
BEGIN 23390000
MOVE(PSIZE[I],CODE[PPOINT[I].W],PPOINT[I].C,SCRATCH[I1.W],I1.C); 23400000
IF PTYPE[I] = 21 THEN % GO-TO PART--CHECK LOCS 23410000
IF I2~PST[I] = "S" THEN SLOC ~ PTR+I1 ELSE 23420000
IF I2 = "F" THEN FLOC ~ PTR+I1 ELSE 23430000
IF I2 = "(" THEN 23440000
BEGIN 23450000
IF SLOC = 0 THEN SLOC ~ PTR + I1; 23460000
IF FLOC = 0 THEN FLOC ~ PTR + I1; 23470000
END ELSE GO TO ERROR; 23480000
I1 ~ I1 + PSIZE[I]; 23490000
PTYPE[I] ~ 0; 23500000
END; 23510000
STORECHARS(I1,SCRATCH[0],0); 23520000
PSIZE[0] ~ I1; 23530000
IF P < INSTSIZE THEN 23540000
BEGIN SP ~ 1; 23550000
GO TO SEMICOLON; 23560000
END; 23570000
IF NOT GTS THEN SLOC ~ PTR; 23580000
IF NOT GTF THEN FLOC ~ PTR; 23590000
RETURN: 23600000
MV(2,SLOC,6,CODE[MARKER.W],MARKER.C+3); 23610000
MV(2,FLOC,6,CODE[MARKER.W],MARKER.C+5); 23620000
MV(1,FIRSTCHAR,7,CODE[MARKER.W],MARKER.C+7); 23630000
IF INFORM THEN WRITEINST; 23640000
END COMPILE; 23650000
%********COMPILE********************************************************23660000
%********CONTROLPARAMETER***********************************************23670000
INTEGER PROCEDURE CONTROLPARAMETER(A,P); 23680000
ALPHA ARRAY A[*]; 23690000
INTEGER P; 23700000
BEGIN DEFINE DUMMY =#; 23710000
I1 ~ P; 23720000
WHILE CHAR(A[*],I1) > 9 AND I1 < 64 DO I1 ~ I1 + 1; 23730000
P ~ I1; 23740000
WHILE CHAR(A[*],P) { 9 AND P < 64 DO P ~ P + 1; 23750000
IF I1 } P THEN I1 ~ -1 ELSE 23760000
READ(A[*],FNUM,I1,P-I1,I1); 23770000
CONTROLPARAMETER ~ I1; 23780000
END CONTROLPARAMETER; 23790000
%********CONTROLPARAMETER***********************************************23800000
%********CONVERT********************************************************23810000
% THIS ROUTINE DOES A CHARACTER-SET CONVERT, AND (IF CONVERTSTRINGS 23820000
% IS TRUE) A CONVERSION OF I/O STRING NAMES. IT IS CURRENTLY SET 23830000
% TO CONVERT FROM CDC 3600 SNOBOL (AS IMPLEMENTED AT THE UNIV. OF 23840000
% WISCONSIN) TO B5500 SNOBOL. USERS AT OTHER INSTALLATIONS WILL 23850000
% PROBABLY WANT TO WRITE THEIR OWN ROUTINE, TO CONVERT FROM A 23860000
% LOCAL VERSION OF SNOBOL TO B5500 SNOBOL. 23870000
PROCEDURE CONVERT(A); 23880000
ALPHA ARRAY A[0]; 23890000
BEGIN INTEGER I; 23900000
ALPHA ARRAY C[0:79]; 23910000
DEFINE D = C[I]#, D1 = C[I+1]#, D2 = C[I+2]#, 23920000
D3 = C[I+3]#, D4 = C[I+4]#, D5 = C[I+5]#; 23930000
READ(A[*],F80A1,FOR I ~ 0 STEP 1 UNTIL 79 DO C[I]); 23940000
IF CONVERTSTRINGS THEN 23950000
FOR I ~ 1 STEP 1 UNTIL FIELDSIZE-6 DO 23960000
IF D = "S" AND D1 = "Y" AND D2 = "S" THEN 23970000
IF D3 = "L" AND D4 = "O" AND D5 = "K" THEN % SYSLOK : LOOK 23980000
BEGIN D ~ "L"; D1 ~ "O"; D2 ~ "O"; D3 ~ "K"; D4 ~ D5 ~ " "; 23990000
END ELSE IF D3 = "P" AND D5 = "T" THEN 24000000
IF D4 = "I" THEN % SYSPIT : READ 24010000
BEGIN D ~ "R"; D1 ~ "E"; D2 ~ "A"; D3 ~ "D"; D4 ~ D5 ~ " "; 24020000
END ELSE IF D4 = "P" THEN % SYSPPT : PUNCH 24030000
BEGIN D ~ "P"; D1 ~ "U"; D2 ~ "N"; D3 ~ "C"; D4 ~ "H"; D5 ~ " "; 24040000
END; 24050000
FOR I ~ 0 STEP 1 UNTIL 79 DO 24060000
C[I] ~ CONVERTVAL[C[I]]; 24070000
WRITE(A[*],F80A1,FOR I~0 STEP 1 UNTIL 79 DO C[I]); 24080000
END CONVERT; 24090000
%********CONVERT********************************************************24100000
%********CREATELIBRARY**************************************************24110000
PROCEDURE CREATELIBRARY(MFID,FID); 24120000
VALUE MFID, FID; 24130000
ALPHA MFID, FID; 24140000
BEGIN INTEGER I, J; 24150000
ALPHA ARRAY X[0:5]; 24160000
SAVE FILE LIBE DISK SERIAL [20:200] (15,6,60,SAVE 15); 24170000
% 24180000
FILL LIBE WITH MFID, FID; 24190000
WRITE(LIBE,FLIB0,ENTIER(VERSION)); 24200000
WRITE(LIBE,FLIB1,SCATTERNO,MAXINSTSIZE, 24210000
CPULIMITEXISTS,CPULIMIT, 24220000
IOLIMITEXISTS,IOLIMIT, 24230000
RULELIMITEXISTS,RULELIMIT); 24240000
WRITE(LIBE,FLIB2,ENTRY,FOR I~0 STEP 1 UNTIL 15 DO USEDST[I],INSTNUM); 24250000
WRITE(LIBE,FLIB3,FOR I~0 STEP 1 UNTIL 15 DO NEXTCELL[I]); 24260000
FOR I ~ 0 STEP 1 UNTIL 15 DO 24270000
IF USEDST[I] THEN 24280000
FOR J ~ 0 STEP 2 UNTIL 254 DO 24290000
WRITE(LIBE,FLIB4,NAMTABL[I,J],VALTABL[I,J],IOTABL[I,J], 24300000
NAMTABL[I,J+1],VALTABL[I,J+1],IOTABL[I,J+1]); 24310000
WRITE(LIBE,FLIB5,FOR I~0 STEP 1 UNTIL 31 DO USEDROW[I]); 24320000
WRITE(LIBE,FLIB6,FOR I~0 STEP 1 UNTIL 31 DO DPNTR[I]); 24330000
FOR I ~ 0 STEP 1 WHILE USEDROW[I] DO 24340000
FOR J ~ 0 STEP 6 UNTIL DPNTR[I].W DO 24350000
BEGIN MOVEWDS(6,DATA[I,J],X[*]); 24360000
WRITE(LIBE,6,X[*]); 24370000
END; 24380000
LOCK(LIBE,SAVE); 24390000
END CREATELIBRARY; 24400000
%********CREATELIBRARY**************************************************24410000
%********DATE***********************************************************24420000
ALPHA PROCEDURE DATE; 24430000
BEGIN % PRODUCES DATE IN FORM: 24440000
% MM/DD/YY 24450000
ALPHA X; 24460000
INTEGER D, M, Y; 24470000
STREAM PROCEDURE ALPHADATE(D,M,Y,W); 24480000
VALUE D, M, Y; 24490000
BEGIN DI ~ W; 24500000
SI ~ LOC M; DS ~ 2 DEC; DS ~ 1 LIT "/"; 24510000
SI ~ LOC D; DS ~ 2 DEC; DS ~ 1 LIT "/"; 24520000
SI ~ LOC Y; DS ~ 2 DEC; 24530000
END ALPHADATE; 24540000
% 24550000
X ~ TIME(0); 24560000
Y ~ 10 | X.[18:6] + X.[24:6]; 24570000
X ~ 100 | X.[30:6] + 10 | X.[36:6] + X.[42:6]; 24580000
M ~ 0; 24590000
WHILE X > 0 DO 24600000
BEGIN M ~ M + 1; 24610000
X ~ X - MONTHS[M]; 24620000
END; 24630000
D ~ X + MONTHS[M]; 24640000
ALPHADATE(D,M,Y,X); 24650000
DATE ~ X; 24660000
END DATE; 24670000
%********DATE***********************************************************24680000
%********DEBUG**********************************************************24690000
% THIS IS THE CENTRAL CONTROL ROUTINE FOR THE INTERACTIVE 24700000
% DEBUGGING TOOL. 24710000
PROCEDURE DEBUG(RETURNLABEL); 24720000
VALUE RETURNLABEL; 24730000
LABEL RETURNLABEL; 24740000
BEGIN INTEGER I, J, K, L, SAVEUSER; 24750000
BOOLEAN NEWINST; 24760000
DEFINE NUMCOMMANDS= 7 #; 24770000
ALPHA ARRAY COMMAND[0:NUMCOMMANDS]; 24780000
SWITCH FORMAT FDBUG ~ 24790000
("{!STATEMENT ",I*,"~"), %0024800000
("{!",I*," STATEMENTS EXECUTED~"), %0124810000
("{!LAST LABEL: ",X*,"~"), %0224820000
("{!AT LABEL: ",X*,"~"), %0324830000
("{!TYPE REQUESTS...{!~"), %0424840000
("{!LEVEL = ",I*,"{!~"), %0524850000
("{!",X*," NOT DEFINED{!~"), %0624860000
("{!",X*," NOT IN USE{!~"), %0724870000
("{!UNRECOGNIZED COMMAND{!~"), %0824880000
("{!OK{!~"), %0924890000
("{!",X*," EXECUTED ",I*," TIMES{!~"), %1024900000
("{!",X*," = ","""), %1124910000
("{!TOO MANY LABELS.{!~"), %1224920000
("{!SUSPENDED{!~"), %1324930000
("{!!END FORMAT--FDBUG{!!~",(O)); 24940000
SWITCH FORMAT FSUSPENDREASON ~ 24950000
("{!SUSPEND CALLED{!~"), %0024960000
("{!RULE LIMIT HIT{!~"), %0124970000
("{!LABEL LIMIT HIT{!~"), %0224980000
("{!FATAL ERROR{!~"), %0324990000
("{!END FMT--FSUSRSN{!~"); 25000000
LABEL 25010000
GETCOMMAND, 25020000
GET1, 25030000
FAIL, 25040000
ILLEGAL, 25050000
RESUME, 25060000
RUNLOOP; 25070000
% 25080000
SAVEUSER ~ USER; 25090000
USER ~ MAINUSER; 25100000
NEWINST ~ FALSE; 25110000
DEBUGGING ~ TRUE; 25120000
FILL COMMAND[*] WITH 25130000
"END", 25140000
"TYPE", 25150000
"SET", 25160000
"RUN", 25170000
"LABEL", 25180000
"ABORT", 25190000
"WHERE", 25200000
"WHY", 25210000
0; 25220000
WRITE(DCWRITE[*],FDBUG[13]); 25230000
IF OUTPUT THEN; 25240000
GETCOMMAND: 25250000
IF NOT INPUT THEN GO TO FAIL; 25260000
GET1: 25270000
MV(1,ARROW,7,DCREAD[DCSIZE.W],DCSIZE.C); 25280000
% IF INFORM THEN WRITE(PRINT,10,DCREAD[*]); 25290000
IF CHAR(DCREAD[*],0) = "-" THEN % CONTROL CARD: 25300000
BEGIN INSTSIZE ~ DCSIZE; 25310000
MV(3,STOPPER,5,DCREAD[DCSIZE.W],DCSIZE.C); 25320000
PROCESSCONTROLCARD(DCREAD[*]); 25330000
MV(3,CRLF,5,DCWRITE[*],0); 25340000
IF OUTPUT THEN; 25350000
GO TO GETCOMMAND; 25360000
END; 25370000
I ~ SKIPCHAR(" ",DCREAD[*],0); 25380000
% EDIT ROUTINES GO HERE SOMETIME... 25390000
J ~ I + SCANCHAR(" ","~",DCREAD[*],I); 25400000
AA ~ 0; 25410000
IF J-I > 5 THEN GO TO ILLEGAL; 25420000
MV(J-I,DCREAD[*],I,AA,8-J+I); 25430000
FOR I ~ NUMCOMMANDS STEP -1 UNTIL 0 DO 25440000
IF AA = COMMAND[I] THEN CASE I OF 25450000
BEGIN % CODE FOR VARIOUS COMMANDS: 25460000
%*************************************** 25470000
% 0: END~ 25480000
BEGIN RESULT ~ TRUE; 25490000
GO TO ENDTERPRET; 25500000
END; 25510000
% 1: TYPE <NAME>~ 25520000
BEGIN 25530000
IF (AA~SEARCHST(I~(DCSIZE-J-1),DCREAD[*],J+1,"SYMB")) { 0 THEN 25540000
BEGIN WRITE(DCWRITE[*],FDBUG[7],I~MIN(I,63)); 25550000
MV(I,DCREAD[*],J+1,DCWRITE[*],2); 25560000
IF OUTPUT THEN; 25570000
GO TO GETCOMMAND; 25580000
END; 25590000
AB ~ NAME[AA]; 25600000
AC ~ VALU[AA]; 25610000
WRITE(DCWRITE[*],FDBUG[11],I~MIN(I,63)); 25620000
MV(I,DCREAD[*],J+1,DCWRITE[*],2); 25630000
I ~ I + 6; K ~ AC.CH; 25640000
MV(J~MIN(70-I,L~AC.S),FIRSTCHAR(AC),DCWRITE[I.W],I.C); 25650000
MV(1,ARROW,7,DCWRITE[(I+J).W],(I+J).C); 25660000
WHILE I + J } 70 DO 25670000
BEGIN IF NOT OUTPUT THEN GO TO GETCOMMAND; 25680000
K ~ K + J; 25690000
L ~ L - J; 25700000
MV(I~2,CRLF,5,DCWRITE[*],0); 25710000
MOVE(J~MIN(70-I,L),DATA[AC.R,K.W],K.C,DCWRITE[*],2); 25720000
END; 25730000
MV(1,QUOTE,7,DCWRITE[(I~I+J).W],I.C); 25740000
MV(3,CRLF,5,DCWRITE[I.W],I.C+1); 25750000
IF OUTPUT THEN; 25760000
GO TO GETCOMMAND; 25770000
END TYPE; 25780000
% 2: SET <NAME>~ <VALUE>~ 25790000
BEGIN 25800000
AA ~ ENTERST(DCSIZE-J-1,DCREAD[*],J+1,"SYMB"); 25810000
MV(3,CRLF,5,DCWRITE[*],0); IF OUTPUT THEN; 25820000
IF NOT INPUT THEN GO TO FAIL; 25830000
AB ~ STRING(DCSIZE,AA); 25840000
IF DEATH THEN GO TO ENDTERPRET; 25850000
MOVE(DCSIZE,DCREAD[*],0,FIRSTCHAR(AB)); 25860000
VALU[AA].LOC ~ AB; 25870000
MV(3,CRLF,5,DCWRITE[*],0); IF OUTPUT THEN; 25880000
GO TO GETCOMMAND; 25890000
END SET; 25900000
% 3: RUN <LIMIT> FROM <LABEL> TO <LABEL> <LABEL> <LABEL> ...~ 25910000
BEGIN 25920000
I1 ~ NLABELLIMIT; % SAVE IN CASE OF "TO~". 25930000
NLABELLIMIT ~ -1; % -1 MEANS NO TO-PART FOUND YET. 25940000
DEBUGRULELIMITEXISTS ~ NEWINST ~ FALSE; 25950000
RUNLOOP: 25960000
J ~ J + SKIPCHAR(" ",DCREAD[J.W],J.C); 25970000
IF I2 ~ CHAR(DCREAD[J.W],J.C) = "~" THEN GO TO RESUME; 25980000
IF I2 { 9 THEN % <INTEGER> 25990000
BEGIN 26000000
IF DEBUGRULELIMITEXISTS THEN % TWO OF THEM--ERROR 26010000
BEGIN WRITE(DCWRITE[*],FEH,QMARK); 26020000
IF OUTPUT THEN; 26030000
GO TO GETCOMMAND; 26040000
END; 26050000
I ~ 0; % FOR BUILDING LIMIT 26060000
DO BEGIN I ~ I|10 + I2; 26070000
J ~ J + 1; 26080000
END UNTIL I2~CHAR(DCREAD[J.W],J.C) > 9; 26090000
DEBUGRULELIMITEXISTS ~ TRUE; 26100000
DEBUGRULELIMIT ~ RULES[0] + I; 26110000
GO TO RUNLOOP; 26120000
END; 26130000
IF (I~MNEMNO(1,DCREAD[*],J)) = 1 THEN 26140000
BEGIN % FROM <LABEL> 26150000
IF NEWINST THEN % TWO OF THEM--ERROR 26160000
BEGIN WRITE(DCWRITE[*],FEH,QMARK); 26170000
IF OUTPUT THEN; 26180000
GO TO GETCOMMAND; 26190000
END; 26200000
J ~ J + SKIPCHAR(" ",DCREAD[J.W],J.C); 26210000
I ~ SCANCHAR(" ","~",DCREAD[J.W],J.C); 26220000
IF I { 0 THEN GO TO ILLEGAL; 26230000
AA ~ SEARCHST(I,DCREAD[*],J,"INST"); 26240000
IF (AB~VALU[AA]).S { 9 THEN % NO SUCH LABEL: 26250000
BEGIN WRITE(DCWRITE[*],FDBUG[6],K~MIN(63,I)); 26260000
MV(K,DCREAD[J.W],J.C,DCWRITE[*],2); 26270000
IF OUTPUT THEN; 26280000
GO TO GETCOMMAND; 26290000
END; 26300000
NEWINST ~ TRUE; 26310000
PST[0] ~ AA; 26320000
J ~ J + I; 26330000
GO TO RUNLOOP; 26340000
END; 26350000
IF I = 2 THEN 26360000
BEGIN % TO <LABEL> <LABEL> <LABEL> ...~ 26370000
J ~ J + SKIPCHAR(" ",DCREAD[J.W],J.C); 26380000
IF CHAR(DCREAD[J.W],J.C) = "~" THEN 26390000
BEGIN % TO~ (SAME LIMITS AS LAST TIME) 26400000
NLABELLIMIT ~ I1; 26410000
GO TO RESUME; 26420000
END; 26430000
DO BEGIN % FIND LABELS: 26440000
I ~ SCANCHAR(" ","~",DCREAD[J.W],J.C); 26450000
IF I > 0 THEN % LABEL FOUND 26460000
BEGIN 26470000
IF (NLABELLIMIT~NLABELLIMIT+1) > MAXLABELLIMIT THEN 26480000
BEGIN % TOO MANY LABELS: 26490000
WRITE(DCWRITE[*],FDBUG[12]); 26500000
IF OUTPUT THEN; 26510000
GO TO GETCOMMAND; 26520000
END; 26530000
IF LABELLIMIT[NLABELLIMIT]~SEARCHST(I,DCREAD[*],J,"INST") 26540000
{ 0 THEN % NO SUCH LABEL: 26550000
BEGIN WRITE(DCWRITE[*],FDBUG[6],K~MIN(63,I)); 26560000
MV(K,DCREAD[J.W],J.C,DCWRITE[*],2); 26570000
IF OUTPUT THEN; 26580000
GO TO GETCOMMAND; 26590000
END; 26600000
J ~ J + I + SKIPCHAR(" ",DCREAD[(J+I).W],(J+I).C); 26610000
END; 26620000
END UNTIL CHAR(DCREAD[J.W],J.C) = "~"; 26630000
GO TO RESUME; 26640000
END; 26650000
% FALL THROUGH: INVALID DELIMITER: 26660000
GO TO ILLEGAL; 26670000
END RUN; 26680000
% 4: LABEL <LABEL>~ 26690000
BEGIN 26700000
IF (AA~SEARCHST(I~(DCSIZE-J-1),DCREAD[*],J+1,"INST")) { 0 26710000
THEN WRITE(DCWRITE[*],FDBUG[6],I~MIN(I,63)) 26720000
ELSE WRITE(DCWRITE[*],FDBUG[10],I~MIN(I,63), 26730000
DIGITS(K~VALU[AA].LINK),K); 26740000
MV(I,DCREAD[*],J+1,DCWRITE[*],2); 26750000
IF OUTPUT THEN; 26760000
GO TO GETCOMMAND; 26770000
END LABEL; 26780000
% 5: ABORT ~ 26790000
BEGIN RESULT ~ FALSE; 26800000
GO TO ENDTERPRET; 26810000
END ABORT; 26820000
% 6: WHERE~ GIVES PLACE OF SUSPENSION. 26830000
BEGIN 26840000
% TYPE STATEMENT NUMBER: 26850000
WRITE(DCWRITE[*],FDBUG[0],DIGITS(INSTNO),INSTNO); 26860000
IF NOT OUTPUT THEN GO TO GETCOMMAND; 26870000
% TYPE NUMBER OF RULES EXECUTED. 26880000
WRITE(DCWRITE[*],FDBUG[1],DIGITS(RULES[0]),RULES[0]); 26890000
IF NOT OUTPUT THEN GO TO GETCOMMAND; 26900000
% LAST LABEL: 26910000
AA ~ NAME[ENTRY]; 26920000
J ~ MIN(AA.S,63); 26930000
IF INSTRUCT > 0 OR NEARPOINT > 9 THEN 26940000
BEGIN WRITE(DCWRITE[*],FDBUG[2],J); 26950000
I ~ 14; 26960000
END ELSE 26970000
BEGIN WRITE(DCWRITE[*],FDBUG[3],J); 26980000
I ~ 12; 26990000
END; 27000000
MV(J,FIRSTCHAR(AA),DCWRITE[*],I); 27010000
IF NOT OUTPUT THEN GO TO GETCOMMAND; 27020000
% TYPE LEVEL: 27030000
WRITE(DCWRITE[*],FDBUG[5],DIGITS(LEVEL),LEVEL); 27040000
IF OUTPUT THEN; 27050000
GO TO GETCOMMAND; 27060000
END; 27070000
% 7: WHY~ GIVES REASONS FOR SUSPENSION. 27080000
BEGIN 27090000
FOR I ~ 0 STEP 1 UNTIL MAXSUSPENDREASON DO 27100000
IF SUSPENDREASON[I] THEN 27110000
BEGIN WRITE(DCWRITE[*],FSUSPENDREASON[I]); 27120000
IF NOT OUTPUT THEN GO TO GETCOMMAND; 27130000
END; 27140000
GO TO GETCOMMAND; 27150000
END; 27160000
%************************************** 27170000
END COMMAND CASES; 27180000
ILLEGAL: 27190000
WRITE(DCWRITE[*],FDBUG[8]); 27200000
IF OUTPUT THEN; 27210000
GO TO GETCOMMAND; 27220000
FAIL: 27230000
IF INPUT THEN GO TO GET1; 27240000
DEBUGRULELIMITEXISTS ~ FALSE; 27250000
RESUME: 27260000
WRITE(DCWRITE[*],FDBUG[9]); 27270000
IF OUTPUT THEN; 27280000
SETLIMITFLAG; 27290000
USER ~ SAVEUSER; 27300000
FOR I ~ 0 STEP 1 UNTIL MAXSUSPENDREASON DO SUSPENDREASON[I] ~ FALSE; 27310000
IF NEWINST THEN GO TO RETURNLABEL; 27320000
AA ~ PST[0]; 27330000
% AA CONTAINS THE SYMBOL TABLE ADDRESS OF THE NEXT INST. 27340000
END DEBUG; 27350000
%********DEBUG**********************************************************27360000
%********DIGITS*********************************************************27370000
INTEGER PROCEDURE DIGITS(N); 27380000
VALUE N; 27390000
REAL N; 27400000
BEGIN INTEGER D; 27410000
D ~ IF N > 0 THEN 0 ELSE 1; 27420000
N ~ ENTIER(ABS(N)); 27430000
WHILE N > 0 DO 27440000
BEGIN D ~ D + 1; 27450000
N ~ ENTIER(N DIV 10); 27460000
END; 27470000
DIGITS ~ D; 27480000
END DIGITS; 27490000
%********DIGITS*********************************************************27500000
%********ENTERST********************************************************27510000
% ENTERST(N,L,P,X) SEARCHES THE SYMBOL TABLE FOR THE OBJECT OF 27520000
% TYPE X (SEE BELOW); IF THE OBJECT IS NOT PRESENT, A NEW ENTRY 27530000
% IS CREATED FOR IT. THE RETURN VALUE IS THE SYMB TABLE ADDRESS 27540000
% OF THE OBJECT. THE NAME CONSISTS OF THE N CHARS STARTING FROM 27550000
% L[P.W],P.C--N CAN BE ANY (NON-NEGATIVE) NUMBER. 27560000
% IF THE SYMBOL TABLE IS FULL AND A NEW ENTRY MUST BE CREATED, 27570000
% MESSAGES ARE PRINTED (LP AND TT), AND -1 IS RETURNED. ALSO, 27580000
% THE PROCEDURE NEWCELL WILL HAVE SET THE DEATH FLAG TRUE. 27590000
ALPHA PROCEDURE ENTERST(N,L,P,X); 27600000
VALUE N, P, X; 27610000
INTEGER N, P; 27620000
ALPHA ARRAY L[0]; 27630000
ALPHA X; 27640000
BEGIN ALPHA J, K; 27650000
INTEGER I, Y, M, XTEST; 27660000
LABEL FOUND, FAIL, RETURN, CREATE; 27670000
DEFINE STWORD = (IF BOOLEAN(Y) THEN VALU[I] ELSE NAME[I])#; 27680000
% 27690000
XTEST ~ IF X = "SYMB" THEN 0 ELSE 27700000
IF X = "LIT" THEN 1 ELSE 27710000
IF X = "FCT" THEN 2 ELSE 27720000
IF X = "INST" THEN 3 ELSE 0; 27730000
Y ~ IF X = "LIT" THEN 1 ELSE 0; 27740000
I ~ SCATTER(N,L,P,X); 27750000
WHILE TRUE DO 27760000
% IF YOU DONT UNDERSTAND THIS, YOU ARENT NECESSARILY STUPID: 27770000
BEGIN IF (IF N ! (K ~ STWORD).S 27780000
THEN FALSE 27790000
ELSE EQUAL(N,L[P.W],P.C,FIRSTCHAR(K))) 27800000
THEN IF (IF N = 0 THEN (K.LOC ! 0) ELSE TRUE) 27810000
THEN IF (IF X = "LIT" 27820000
THEN NAME[I] 27830000
ELSE K).TYPE = XTEST 27840000
THEN GO TO FOUND; 27850000
IF X = "LIT" THEN K ~ NAME[I]; 27860000
IF K.LINK = 0 THEN GO TO CREATE; 27870000
I ~ K.LINK; 27880000
END; 27890000
CREATE: 27900000
BEGIN DEFINE DUMMY=#; 27910000
J ~ STRING(N,0); 27920000
MOVE(N,L[P.W],P.C,FIRSTCHAR(J)); 27930000
IF STWORD.LOC ! 0 THEN 27940000
BEGIN M ~ NEWCELL(I.STR); 27950000
IF DEATH THEN GO TO FAIL; 27960000
NAME[I].LINK ~ I ~ M; 27970000
END; 27980000
NAME[I] ~ IF BOOLEAN(Y) THEN 1 ELSE J; 27990000
VALU[I] ~ IF BOOLEAN(Y) THEN J ELSE 1; 28000000
M ~ J.CH - 2; 28010000
MV(2,I,6,DATA[J.R,M.W],M.C); 28020000
NAME[I].TYPE ~ XTEST; 28030000
IF X = "FCT" THEN 28040000
BEGIN 28050000
K ~ INTRINSIC(L,P,N); 28060000
IF K ! 0 THEN VALU[I] ~ 1 & K CLINK; 28070000
END; 28080000
IF TRACEALL THEN 28090000
BEGIN VALU[I].IOUSE ~ (IF X="FCT" THEN 3 ELSE 1); 28100000
IO[I] ~ 0 & 2 CIOTYPE & 3 CFILNO 28110000
& (IF X="FCT" THEN 3 ELSE 1) CIOUSE; 28120000
END; 28130000
GO TO FOUND; 28140000
END; 28150000
FAIL: 28160000
MESSAGE0(14); 28170000
MESSAGETT0(14); 28180000
I ~ -1; 28190000
FOUND: ENTERST ~ I; 28200000
RETURN: 28210000
END ENTERST; 28220000
%********ENTERST********************************************************28230000
%********FINDUSERS******************************************************28240000
PROCEDURE FINDUSERS; 28250000
BEGIN INTEGER I, J; 28260000
ALPHA ARRAY X[0:2|TTMAX]; 28270000
ALPHA ST1, ST2; 28280000
% 28290000
ST1 ~ STAT[USER].[9:9]; 28300000
ST2 ~ STAT[MAINUSER].[9:9]; 28310000
NUMUSERS ~ STATUS(X[*]) / 2; 28320000
FOR I ~ NUMUSERS-1 STEP -1 UNTIL 0 DO 28330000
BEGIN J ~ I | 2; 28340000
STAT[I] ~ X[J]; 28350000
ID[I] ~ X[J+1]; 28360000
END; 28370000
IF ST2 ! STAT[MAINUSER].[9:9] THEN 28380000
BEGIN MAINUSER ~ 0; 28390000
FOR I ~ NUMUSERS-1 STEP -1 UNTIL 0 DO 28400000
IF STAT[I].[9:9] = ST2 THEN MAINUSER ~ I; 28410000
END; 28420000
IF ST1 ! STAT[USER].[9:9] THEN 28430000
BEGIN USER ~ -1; 28440000
FOR I ~ 0 STEP 1 WHILE USER < 0 AND I < NUMUSERS DO 28450000
IF ST1 = STAT[I].[9:9] THEN USER ~ I; 28460000
IF USER < 0 THEN USER ~ MAINUSER; 28470000
END; 28480000
DATACOMF ~ NUMUSERS > 0; 28490000
END FINDUSERS; 28500000
%********FINDUSERS******************************************************28510000
%********GARBAGE COLLECTOR**********************************************28520000
PROCEDURE GARBAGECOLLECTOR; 28530000
% 28540000
BEGIN INTEGER I,K,M,MAX,P,ROWS,ST,TOTAL; 28550000
REAL TIMECP, TIMEIO; 28560000
ALPHA J; 28570000
INTEGER ARRAY NEWPNTR[0:DATASIZE]; 28580000
LABEL L; 28590000
% 28600000
TIMECP ~ TIME(2); TIMEIO ~ TIME(3); 28610000
IF INFORM THEN 28620000
BEGIN 28630000
WRITE(PRINT,FGC); 28640000
WRITETIME(0,0); 28650000
CHECKSYMBTABL; 28660000
END; 28670000
% FREE STRINGS ATTACHED TO CELLS ON AVAILABLE SPACE LISTS: 28680000
FOR I ~ 0 STEP 1 UNTIL STRMAX DO IF USEDST[I] THEN 28690000
BEGIN K ~ NEXTCELL[I]; 28700000
WHILE K ! 0 DO 28710000
BEGIN NAME[K].LOC ~ VALU[K] ~ 0; 28720000
K ~ NAME[K].LINK; 28730000
END; 28740000
END; 28750000
% CHECK FOR CELLS HELD A LONG TIME, THEN DISCARDED: 28760000
IF GCS.C = 0 THEN 28770000
FILL NOTMOVED[*] WITH 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 28780000
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0; 28790000
MAX ~ TOTAL ~ ROWS ~ 0; 28800000
IF NOT DEATH THEN 28810000
FOR I ~ 0 STEP 1 UNTIL DATASIZE DO 28820000
IF USEDROW[I] THEN 28830000
BEGIN 28840000
ROWS ~ ROWS + 1; 28850000
MV(1,QMARK,7,DATA[I,DPNTR[I].W],DPNTR[I].C); 28860000
P ~ NEWPNTR[I] ~ NOTMOVED[I]; 28870000
L: P ~ P + SCANCHAR(QMARK,QMARK,DATA[I,P.W],P.C); 28880000
IF P < DPNTR[I] THEN 28890000
BEGIN MV(2,DATA[I,P.W],P.C+1,ST,6); 28900000
FOR K ~ 1,0 DO 28910000
BEGIN 28920000
J ~ IF BOOLEAN(K) THEN VALU[ST] ELSE NAME[ST]; 28930000
IF J.CH = P+3 THEN 28940000
IF J.R = I THEN IF J.CH-3 > NEWPNTR[I] THEN 28950000
BEGIN M ~ J.CH - 3; 28960000
MOVE(J.S+3,DATA[I,M.W],M.C, 28970000
DATA[I,NEWPNTR[I].W],NEWPNTR[I].C); 28980000
IF BOOLEAN(K) 28990000
THEN VALU[ST].CH ~ NEWPNTR[I] + 3 29000000
ELSE NAME[ST].CH ~ NEWPNTR[I] + 3; 29010000
NEWPNTR[I] ~ NEWPNTR[I] + J.S + 3; 29020000
P ~ P + J.S + 3; 29030000
GO TO L; 29040000
END ELSE 29050000
BEGIN P ~ P + J.S + 3; 29060000
NOTMOVED[I] ~ NEWPNTR[I] ~ P; 29070000
GO TO L; 29080000
END; 29090000
END; 29100000
P ~ P + 1; GO TO L; 29110000
END; 29120000
IF 8184 - (DPNTR[I] ~ NEWPNTR[I]) > MAX THEN 29130000
MAX ~ 8184 - DPNTR[I]; 29140000
TOTAL ~ TOTAL + 8184 - DPNTR[I]; 29150000
END; 29160000
IF MAX < 1000 OR TOTAL < 2000 THEN 29170000
BEGIN I ~ 0; 29180000
WHILE USEDROW[I] AND I < DATASIZE DO I ~ I + 1; 29190000
USEDROW[I] ~ TRUE; 29200000
END; 29210000
CHECKSYMBTABL; 29220000
IF INFORM THEN 29230000
BEGIN 29240000
WRITETIME(0,0); 29250000
WRITE(PRINT,FGCRES,ROWS,MAX,TOTAL); 29260000
END; 29270000
GCS ~ GCS + 1; 29280000
GCTIMECP ~ GCTIMECP + (TIME(2)-TIMECP)/60; 29290000
GCTIMEIO ~ GCTIMEIO + (TIME(3)-TIMEIO)/60; 29300000
END GARBAGECOLLECTOR; 29310000
%********GARBAGE COLLECTOR**********************************************29320000
%********INDIRECT*******************************************************29330000
% INDIRECT(SP) INDIRECTS ON THE STRING NAMED BY STACK[I], AND 29340000
% LEAVES THE RESULT IN THE SAME STACK LOCATION. THIS ROUTINE IS 29350000
% CALLED BY VARIOUS INTRINSIC FUNCTIONS THAT NEED TO INTERPRET 29360000
% THEIR PARAMETERS AS STRING NAMES. 29370000
PROCEDURE INDIRECT(SP); 29380000
VALUE SP; INTEGER SP; 29390000
BEGIN ALPHA AA, AB; 29400000
% IF INFORM THEN INFORM0(19); 29410000
AA ~ PST[SP]; 29420000
AB ~ VALU[AA]; 29430000
PST[SP] ~ ENTERST(AB.S,DATA[AB.R,*],AB.CH,"SYMB"); 29440000
PNAME[SP] ~ TRUE; 29450000
END INDIRECT; 29460000
%********INDIRECT*******************************************************29470000
%********INFORM*********************************************************29480000
% THE FOLLOWING PROCEDURES ARE CALLED ONLY TO OUTPUT CERTAIN 29490000
% INFORMATIVE MESSAGES. THE PROCEDURE NAMES CONSIST OF "INFORM" 29500000
% FOLLOWED BY A STRING OF "I"-S OR "A"-S, TELLING WHAT SORT OF 29510000
% FORMAT THE PARAMETERS WILL BE WRITTEN OUT AS. THE FIRST PARAMETER 29520000
% GIVES THE SUBSCRIPT TO A SWITCH FORMAT. 29530000
% 29540000
PROCEDURE INFORM0(I); 29550000
VALUE I; INTEGER I; 29560000
BEGIN SWITCH FORMAT NFRM0 ~ 29570000
(X80,"SCANSUCCESS"), %0029580000
(X80,"ASSIGNMENT OF STRING VARIABLES"), %0129590000
(X80,"DELETE PATTERN"), %0229600000
(X80,"RRETURN"), %0329610000
(X80,"INSTRUCTION FAILED"), %0429620000
(X80,"START OF DEFINE SEGMENT"), %0529630000
(X80,"END OF DEFINE SEGMENT"), %0629640000
(X80,"RETURNTEMPS"), %0729650000
(X80,"SCAN FAILED"), %0829660000
(/"**ILLEGAL ARGUMENT TO .S"), %0929670000
(//"**DUMMY FORMAT--NFRM0[10]",I10), %1029680000
(///"**SEND COPY OF PROGRAM TO SYSTEM AUTHORS."//), %1129690000
(X90,"SCAN--CONSTANT"), %1229700000
(X90,"SCAN--DROPBACK"), %1329710000
(X80,"FUNCTION"), %1429720000
(X80,"GROUP"), %1529730000
(X80,"INDIRECTION"), %1629740000
(X80,"DOTFCT"), %1729750000
(X80,"ELEMENT"), %1829760000
(X80,"INDIRECT"), %1929770000
(X80,"**COMBINEARITHMETIC."), %2029780000
(X80,"**COMBINEGROUP."), %2129790000
(X80,"**COMBINEINDIRECTION."), %2229800000
(X80,"**COMBINESTRVARNAME."), %2329810000
(X80,"**COMBINEGOTOPART."), %2429820000
(X80,"**COMBINEFUNCTION."), %2529830000
(X80,"GO-TO PART"), %2629840000
(X80,"**CONDENSEPATTERN"), %2729850000
(X80,"**CONDENSEREPLACEMENT"), %2829860000
(X80,"**SEMICOLON"), %2929870000
(X80,"**INSERT STRING CONVERT"), %3029880000
(/"**END FORMAT--NFRM0"); 29890000
WRITE(PRINT,NFRM0[I]); 29900000
END INFORM0; 29910000
PROCEDURE INFORMA(I,P); 29920000
VALUE I, P; INTEGER I; ALPHA P; 29930000
BEGIN SWITCH FORMAT NFRMA ~ 29940000
(/"**ENTRY = ",A2), %0029950000
(X80,"PUSH(",A2,")"), %0129960000
(X80,"POP(",A2,")"), %0229970000
(X80,"RETURNCELL(",A2,")"), %0329980000
(X80,"PROGRAM SEGMENT = ",A6), %0429990000
(//"**ILLEGAL I/O DESCRIPTOR AT WORD ",A2), %0530000000
(/"**END FORMAT--NFRMA",A6); 30010000
IF I > 5 OR I < 0 THEN I ~ 5; 30020000
WRITE(PRINT,NFRMA[I],P); 30030000
END INFORMA; 30040000
PROCEDURE INFORMI(I,P); 30050000
VALUE I, P; INTEGER I, P; 30060000
BEGIN SWITCH FORMAT NFRMI ~ 30070000
(X80,"FIXED LENGTH = ",I4), %0030080000
(//"INVALID TYPE ",I5," IN GROUPING."), %0130090000
(//"ERROR IN DOTFCT IN STATEMENT ",I6/), %0230100000
(//"ERROR IN GROUPING IN STATEMENT ",I6/), %0330110000
(//"INTERPRETER STACK OVERFLOW IN STATEMENT ",I6//), %0430120000
(//"**PATTERN ERROR IN STATEMENT ",I6), %0530130000
(X80,"INPUT FROM FILE ",I2), %0630140000
(X80,"TEMPCELL(",I2,") CALLED."), %0730150000
(X80,"INSTNO = ",I6), %0830160000
(X80,"INTERPRETER CALLED--LEVEL = ",I3), %0930170000
(X80,"END INTERPRETER--LEVEL ",I3), %1030180000
(X80,"INTRINSIC ",I2), %1130190000
(X80,"NUMVAL = ",I12), %1230200000
(X80,"OUTPUT TO FILE ",I2), %1330210000
(/"**END FORMAT--NFRMI",I10); 30220000
WRITE(PRINT,NFRMI[I],P); 30230000
END INFORMI; 30240000
PROCEDURE INFORMIA(I,P1,P2); 30250000
VALUE I, P1, P2; INTEGER I, P1; ALPHA P2; 30260000
BEGIN SWITCH FORMAT NFRMIA ~ 30270000
(X80,"TEMPCEL(",I2,") = ",A2), %0030280000
(X80,"NEWCELL(",I2,") = ",A2), %0130290000
(X80,"SP = ",I3,"; CODE = ",A6), %0230300000
(/"**END FORMAT--NFRMIA",I10,A6); 30310000
WRITE(PRINT,NFRMIA[I],P1,P2); 30320000
END INFORMIA; 30330000
PROCEDURE INFORMII(I,P1,P2); 30340000
VALUE I, P1, P2; 30350000
INTEGER I, P1, P2; 30360000
BEGIN SWITCH FORMAT NFRMII ~ 30370000
("DUMMY FORMAT--NFRMII[0]",2I10), %0030380000
("DUMMY FORMAT--NFRMII[1]",2I10), %0130390000
(X80,"**DUMMY FORMAT--NFRMII[2]"), %0230400000
(//"**FATAL ERROR IN SCANNER IN STATEMENT ",I6,"; SP = ",I4), %0330410000
(X80,"TT IN FROM ",I2,"/",I2), %0430420000
(X80,"TT OUT TO ",I2,"/",I2), %0530430000
(X85,"SCAN--SP = ",I3,", POINT = ",I4), %0630440000
(/"**END FORMAT--NFRMII",2I10); 30450000
WRITE(PRINT,NFRMII[I],P1,P2); 30460000
END INFORMII; 30470000
%********INFORM*********************************************************30480000
%********INITIALIZESYMBTABL*********************************************30490000
PROCEDURE INITIALIZESYMBTABL; 30500000
BEGIN DEFINE DUMMY=#; 30510000
FOR I ~ 0 STEP 1 UNTIL SCATTERNO DO 30520000
BEGIN 30530000
FOR J ~ SCATTERSIZE+16 STEP 1 WHILE J < STWMAX DO 30540000
NAMTABL[I,J].LINK ~ (J+1) & I CONCSTR; 30550000
NEXTCELL[I] ~ (SCATTERSIZE+16) & I CONCSTR; 30560000
USEDST[I] ~ TRUE; 30570000
END; 30580000
SYMBTABLSETUP ~ TRUE; 30590000
END INITIALIZESYMBTABL; 30600000
%********INITIALIZESYMBTABL*********************************************30610000
%********INPUT**********************************************************30620000
% TELETYPE INPUT PROCEDURE: 30630000
BOOLEAN PROCEDURE INPUT; 30640000
BEGIN 30650000
SWITCH FORMAT FLAGS ~ ("{!FLAGS[0]{!~"), 30660000
("!{ MESSAGE WAS TOO LONG...PLEASE REENTER!{~"), 30670000
("!{ MESSAGE WAS PARTLY LOST...PLEASE REENTER!{~"); 30680000
ARRAY SINK[0:BUFINSIZE-1]; 30690000
INTEGER SIZ, TIMEX, FL, Q, R; 30700000
LABEL LOOP, NOGO, ABNORM, CHECKIT, EXIT, FAIL; 30710000
ALPHA S; 30720000
INTEGER STREAM PROCEDURE SIZE(A); 30730000
BEGIN SI ~ A; TALLY ~ 0; 30740000
DCINCHAR(IF SC="~" THEN JUMP OUT; SI~SI+1; TALLY~TALLY+1); 30750000
SIZE ~ TALLY 30760000
END SIZE; 30770000
STREAM PROCEDURE MOVE(A,B,C,D); VALUE C, D; 30780000
BEGIN SI~A; DI~B; DI~DI+D; DS~C CHR END MOVE; 30790000
% 30800000
% IF INFORM THEN INFORMII(4,STAT[USER].[9:4],STAT[USER].[14:4]); 30810000
IF NOT DATACOMF THEN GO TO FAIL; 30820000
INPUT ~ TRUE; 30830000
BREAK ~ FALSE; 30840000
FL ~ DCSIZE ~ 0; 30850000
TIMEX ~ TIME(1); 30860000
LOOP: Q ~ DCSIZE DIV 8; R ~ DCSIZE MOD 8; 30870000
IF DATACOMF 30880000
THEN READ(DCIN(STAT[USER],0),BUFINSIZE,SINK[*]) [NOGO:ABNORM] 30890000
ELSE GO TO FAIL; 30900000
IF BOOLEAN((S~STATUS(STAT[USER],0)).[28:1]) THEN 30910000
BEGIN % BUFFER OVERFLOW 30920000
FL ~ 2; 30930000
GO TO LOOP; 30940000
END; 30950000
TIMEX ~ TIME(1); 30960000
IF BOOLEAN(SINK[0].[25:1]) 30970000
THEN SIZ ~ DCINCHAR 30980000
ELSE SIZ ~ SIZE(SINK[1]); 30990000
IF DCSIZE ~ DCSIZE + SIZ > MSGSIZE 31000000
THEN FL ~ 1 31010000
ELSE MOVE(SINK[1],DCREAD[Q],SIZ,R); 31020000
IF BOOLEAN(SINK[0].[25:1]) 31030000
THEN GO TO LOOP; 31040000
CHECKIT: % CHECK FOR OVERFLOW AND TRANSMISSION ERROR 31050000
IF FL > 0 THEN 31060000
BEGIN WRITE(DCWRITE[*],FLAGS[FL]); 31070000
IF NOT OUTPUT THEN GO TO FAIL; 31080000
IF INPUT THEN GO TO EXIT; 31090000
END ELSE GO TO EXIT; 31100000
ABNORM: S ~ STATUS(STAT[USER],0); 31110000
% [28:1] = 1 IF BUFFER OVERFLOW 31120000
IF BOOLEAN(S.[28:1]) THEN FL ~ 2; 31130000
% [23:1] = 1 IF ABNORMAL CONDITION 31140000
% [24:1] = 1 IF BUFFER IS READ READY 31150000
% [30:1] = 1 IF UNIT NOT READY 31160000
IF S.[23:2]=3 OR BOOLEAN(S.[30:1]) THEN GO TO FAIL; 31170000
READ(DCIN(STAT[USER],0),BUFINSIZE,SINK[*]) [NOGO:NOGO]; 31180000
NOGO: 31190000
IF TIME(1) - TIMEX < WAITTIME THEN 31200000
BEGIN WHEN(1); GO TO LOOP; END; 31210000
S ~ STATUS(STAT[USER],1); 31220000
IF BOOLEAN(S.[30:1]) THEN GO TO FAIL; 31230000
IF BOOLEAN(S.[28:1]) THEN 31240000
BEGIN FL ~ 2; GO TO LOOP; END; 31250000
FAIL: 31260000
INPUT ~ FALSE; 31270000
FINDUSERS; 31280000
EXIT: END INPUT; 31290000
%========== END DATA COM INPUT PROCEDURE ===============================31300000
%********INSERTSTRINGCONVERT********************************************31310000
PROCEDURE INSERTSTRINGCONVERT(SP); 31320000
VALUE SP; 31330000
INTEGER SP; 31340000
BEGIN INTEGER I; 31350000
% IF INFORM THEN INFORM0(30); 31360000
I ~ PPOINT[SP] + PSIZE[SP]; 31370000
AA ~ ".S"; 31380000
MV(2,AA,6,CODE[I.W],I.C); 31390000
PSIZE[SP] ~ PSIZE[SP] + 2; 31400000
PNAME[SP] ~ FALSE; 31410000
PTYPE[SP] ~ 19; % COMBINED ARITHMETIC EXPRESSION 31420000
END INSERTSTRINGCONVERT; 31430000
%********INSERTSTRINGCONVERT********************************************31440000
%********INTERPRETER****************************************************31450000
% THIS IS THE CENTRAL CONTROL ROUTINE FOR THE INTERPRETER. IT IS 31460000
% SEVERAL THOUSAND CARDS LONG. 31470000
PROCEDURE INTERPRETER; 31480000
BEGIN 31490000
%****************** 31500000
INTEGER STREAM PROCEDURE CHAR(L,I); 31510000
VALUE I; 31520000
BEGIN SI ~ L; SI ~ SI + I; 31530000
DI ~ LOC CHAR; DI ~ DI + 7; 31540000
DS ~ 1 CHR; 31550000
END CHAR; 31560000
%****************** 31570000
BOOLEAN STREAM PROCEDURE EQ(N,L1,I1,L2,I2); 31580000
VALUE N, I1, I2; 31590000
BEGIN SI ~ L1; SI ~ SI + I1; 31600000
DI ~ L2; DI ~ DI + I2; 31610000
N(IF SC ! DC THEN JUMP OUT); 31620000
IF TOGGLE THEN TALLY ~ 0 ELSE TALLY ~ 1; 31630000
EQ ~ TALLY; 31640000
END EQ; 31650000
%****************** 31660000
STREAM PROCEDURE MV(N,L1,I1,L2,I2); 31670000
VALUE N, I1, I2; 31680000
BEGIN SI ~ L1; SI ~ SI + I1; 31690000
DI ~ L2; DI ~ DI + I2; 31700000
DS ~ N CHR; 31710000
END MOVE; 31720000
%****************** 31730000
ALPHA 31740000
FCT, 31750000
FCTN, 31760000
FCTV, 31770000
RETURNVAL; 31780000
ALPHA ARRAY 31790000
INST[0:MAXINSTSIZE.W]; 31800000
DEFINE 31810000
DIE = GO TO DEAD #, 31820000
FAIL=GO TO FAILED#; 31830000
BOOLEAN INGOTOPART; 31840000
ALPHA FIRSTCH; 31850000
LABEL 31860000
ARITHOVFL, % INTEGER OVERFLOW IN ARITHMETIC 31870000
BRANCH, % INTRINSIC FCT CASE STMT 31880000
DEAD, % FATAL ERROR LABEL 31890000
DEFINEDFCT, % PROGRAM-DEFINED FUNCTION 31900000
FCTFAIL, % FAILURE OF FUNCTION CALLS 31910000
DVDZERO, % DIVIDE-BY-ZERO IN ARITHMETIC 31920000
FAILED, % STATEMENT FAILURE LABEL 31930000
FIXERR, 31940000
GOTO, 31950000
INTERPRET, 31960000
LIMITHIT, 31970000
MINLEF, 31980000
NONNUMERIC, % NON-NUM ARITH OPERAND 31990000
PERROR, 32000000
PFIX, 32010000
PSCAN, 32020000
REFSET, 32030000
RETURN, 32040000
SCANFAILURE, 32050000
SETGO, 32060000
SUCCEED, % FUNCTION SUCCESS LABEL 32070000
UNDEFFCT, % CALL OF UNDEFINED FUNCTION 32080000
UNDEFINED; % UNDEFINED LABEL 32090000
LABEL % LOCAL TO SCANNER: 32100000
BALANCE, 32110000
DROPBACK, 32120000
NEWPOINT, 32130000
NEXTPATTERN, 32140000
SCANERR, 32150000
SCANSUCCESS, 32160000
SIZEFAILURE; 32170000
% 32180000
NEARPOINT ~ 9; 32190000
LEVEL ~ LEVEL + 1; 32200000
AA ~ ENTRY; 32210000
ENTRY ~ RULES[LEVEL] ~ 0; 32220000
% IF INFORM THEN INFORMI(9,LEVEL); 32230000
GO TO SETGO; 32240000
% 32250000
INTERPRET: 32260000
% START OF A SINGLE INSTRUCTION 32270000
IF DEATH THEN DIE; 32280000
% IF INFORM THEN 32290000
% BEGIN WRITE(PRINT,FBL); 32300000
% WRITE(PRINT,17,INST[*]); 32310000
% INFORMI(8,INSTNO); 32320000
% WRITETIME(0,0); 32330000
% END; 32340000
IF ALIMITEXISTS THEN 32350000
BEGIN 32360000
IF RULELIMITEXISTS THEN 32370000
IF RULES[0] > RULELIMIT THEN GO TO LIMITHIT; 32380000
IF CPULIMITEXISTS THEN 32390000
IF TIME(2) > CPULIMIT THEN GO TO LIMITHIT; 32400000
IF IOLIMITEXISTS THEN 32410000
IF TIME(3) > IOLIMIT THEN GO TO LIMITHIT; 32420000
IF DEBUGGING THEN 32430000
IF DEBUGRULELIMITEXISTS THEN 32440000
IF DEBUGRULELIMIT { RULES[0] THEN 32450000
BEGIN SUSPENDREASON[1] ~ TRUE; 32460000
DEBUG(SETGO); 32470000
END; 32480000
END; 32490000
RULES[0] ~ RULES[0] + 1; % INCR GLOBAL RULE COUNT. 32500000
RULES[LEVEL] ~ RULES[LEVEL] + 1; % INCR LOCAL RULE COUNT. 32510000
SP ~ RSIZE ~ FRONTEND ~ REAREND ~ 0; 32520000
INGOTOPART ~ SELFREFLAG ~ NOREPLACEMENT ~ VARFLAG ~ FALSE; 32530000
SUCCESS ~ TRUE; 32540000
RELATIVEPOINTER ~ 1; 32550000
% CONTROLPOINT SHOULD BE AT THE 1ST CHAR OF THE INSTRUCTION. 32560000
% FIRST CHAR NO LONGER IN USE BY INTERPRETER. 32570000
PSCAN: % NEXT PATTERN ELEMENT 32580000
IF (NEARPOINT~NEARPOINT+RELATIVEPOINTER) } 63 THEN 32590000
BEGIN INSTRUCT ~ INSTRUCT + NEARPOINT.W; 32600000
NEARPOINT ~ NEARPOINT.C; 32610000
END; 32620000
RELATIVEPOINTER ~ 0; 32630000
% CONTROLPOINT SHOULD NOW POINT TO THE NEXT PATTERN ELEMENT. 32640000
MV(3,CONTROLPOINT,AA,2); % GET NEXT PIECE OF CODE. 32650000
% IF INFORM THEN INFORMA(4,AA); 32660000
CASE AA.C2 OF 32670000
BEGIN 32680000
%*************************************** 32690000
%********OP CODES*********************** 32700000
% 0-9: ERRORS 32710000
;;;;;;;;;; 32720000
%*************************************** 32730000
%********FUNCTION CALL****************** 32740000
% 10: "#" FUNCTION CALL 32750000
% 2-CHAR POINTER TO SYMB TABLE LOC OF FCT 32760000
% 1 CHAR GIVING THE NUMBER OF PARAMETERS. 32770000
BEGIN 32780000
% IF INFORM THEN INFORM0(14); 32790000
MKS ~ SP - CHAR(CONTROLPOINT+3); % FIND FIRST PARAM. 32800000
RETURNVAL ~ 0; % HOLDS ST LOC OF RETURN VALUE. 32810000
FCT ~ AA.[18:12]; 32820000
PTYPE[MKS] ~ 1; 32830000
FCTV ~ VALU[FCT]; 32840000
BRANCH: 32850000
IF BOOLEAN(FCTV.INUSE) THEN 32860000
IF NOT TRACEFCTCALL(FCT) THEN GO TO FCTFAIL; 32870000
IF BOOLEAN(FCTV.[1:1]) THEN GO TO DEFINEDFCT; 32880000
% IF INFORM THEN INFORMI(11,FCTV.LINK); 32890000
CASE FCTV.LINK OF 32900000
%*************************************** 32910000
%********INTRINSIC FUNCTIONS************ 32920000
% THE INTRINSIC FUNCTIONS ARE ARRANGED IN THE FOLLOWING ORDER: 32930000
% 1 ANCHOR 32940000
% 2 CALLF 32950000
% 3 CLOSE 32960000
% 4 DATE 32970000
% 5 DEFINE 32980000
% 6 DETACH 32990000
% 7 DUMP 33000000
% 8 EOF 33010000
% 9 .EQ 33020000
% 10 EQUALS 33030000
% 11 EXECUTE 33040000
% 12 FILE 33050000
% 13 FILL 33060000
% 14 .GE 33070000
% 15 .GT 33080000
% 16 .LE 33090000
% 17 LEVEL 33100000
% 18 LOOK 33110000
% 19 .LT 33120000
% 20 MODE 33130000
% 21 .NE 33140000
% 22 .NUM 33150000
% 23 OPSYN 33160000
% 24 PAGE 33170000
% 25 POP 33180000
% 26 PUSH 33190000
% 27 .REMDR 33200000
% 28 REWIND 33210000
% 29 RULES 33220000
% 30 SIZE 33230000
% 31 SPACE 33240000
% 32 TIME 33250000
% 33 TRACES 33260000
% 34 TRACEF 33270000
% 35 TRACEL 33280000
% 36 TRIM 33290000
% 37 UNANCH 33300000
% 38 UNEQL 33310000
% 39 WAIT 33320000
% 40 SUSPEND 33330000
% 41 STATUS 33340000
% 42 USER 33350000
% 43 SEEK 33360000
% 44 RELEASE 33370000
% 45 RECORD 33380000
% 46 TRACE 33390000
% 47 ASSIGN 33400000
% 48 COPY 33410000
% 49 SEARCH 33420000
% 50 .RANF 33430000
% 33440000
BEGIN % CODE FOR INTRINSIC FUNCTIONS FOLLOWS: 33450000
% 0: UNDEFINED 33460000
GO TO UNDEFFCT; 33470000
% 1: ANCHOR 33480000
BEGIN PTYPE[0] ~ 3; 33490000
IF SP > MKS THEN 33500000
BEGIN IF NOT NUMVAL(PST[MKS],I1) OR I1 < 0 33510000
THEN GO TO FCTFAIL; 33520000
PSIZE[0] ~ I1; 33530000
END ELSE PSIZE[0] ~ ANCHORSIZE; 33540000
GO TO SUCCEED; 33550000
END ANCHOR; 33560000
% 2: CALLF(F,P1,P2,...,PN) CALLS THE FUNCTION NAMED BY F, WITH THE 33570000
% PARAMETERS P1, P2, ..., PN. 33580000
BEGIN SEGMENT 33590000
AA ~ PST[MKS]; 33600000
AB ~ VALU[AA]; 33610000
FCT ~ ENTERST(AB.S,DATA[AB.R,*],AB.CH,"FCT"); 33620000
FCTV ~ VALU[FCT]; 33630000
SP ~ SP - 1; 33640000
FOR I ~ MKS STEP 1 UNTIL SP DO 33650000
BEGIN PST[I] ~ PST[I+1]; 33660000
PNAME[I] ~ PNAME[I+1]; 33670000
END; 33680000
GO TO BRANCH; 33690000
END CALLF; 33700000
% 3: CLOSE(F,P) 33710000
% CLOSE(F,P) CLOSES THE FILE ASSOCIATED WITH $F, IN THE MANNER 33720000
% SPECIFIED BY P. THE VALUES OF P ARE: 33730000
% "*" ONLY FOR TAPE FILES. THE TAPE IS POSITIONED JUST BEYOND 33740000
% THE END-OF-FILE FOR THE CURRENT FILE. IF LAST I/O 33750000
% OPERATION HAD EOF, NO ACTION IS TAKEN. 33760000
% "LOCK" CLOSES THE FILE AND SAVES THE UNIT FOR THE PROGRAM. 33770000
% NEW DISK FILES ARE SAVED FOR THE TIME GIVEN IN THEIR DECLAR-33780000
% ATIONS; TAPE FILES ARE REWOUND AND THE OPERATOR IS TOLD 33790000
% TO REMOVE THE TAPE AND SAVE IT. 33800000
% "RELEASE" RELEASES I/O UNIT TO THE SYSTEM. TAPE FILES ARE 33810000
% REWOUND AND DISK FILES ARE DESTROYED IF CREATED BY 33820000
% THE PROGRAM. 33830000
% "PURGE" THE FILE IS CLOSED, PURGED, AND RELEASED TO THE 33840000
% SYSTEM. 33850000
BEGIN SEGMENT 33860000
IF SP { MKS THEN GO TO FCTFAIL; 33870000
IF SP-MKS = 1 THEN IF NOT NULLARGS(1) THEN GO TO FCTFAIL; 33880000
INDIRECT(MKS); 33890000
AA ~ PST[MKS]; 33900000
AB ~ PST[MKS+1]; 33910000
AA ~ IO[AA]; 33920000
IF AA.IOUSE=0 OR I1~AA.FILNO=0 THEN GO TO FCTFAIL; 33930000
AB ~ VALU[AB]; 33940000
IF (I2~AB.S) > 7 THEN GO TO FCTFAIL; 33950000
AC ~ 0; 33960000
IF I2 = 0 33970000
THEN AC ~ 0 33980000
ELSE MV(I2,FIRSTCHAR(AB),AC,8-I2); 33990000
AC ~ AC; 34000000
IF AC = 0 THEN CLOSE(IOFILE[I1]) ELSE 34010000
IF AC = "LOCK" THEN LOCK(IOFILE[I1],SAVE) ELSE 34020000
IF AC = "SAVE" THEN CLOSE(IOFILE[I1],SAVE) ELSE 34030000
IF AC = "PURGE" THEN CLOSE(IOFILE[I1],PURGE) ELSE 34040000
IF AC = "RELEASE" THEN 34050000
BEGIN IOFILEOPEN[I1] ~ FALSE; 34060000
CLOSE(IOFILE[I1],RELEASE); 34070000
END ELSE 34080000
IF AC = "*" THEN CLOSE(IOFILE[I1],*) ELSE 34090000
BEGIN IF PRINTMESSAGES THEN 34100000
BEGIN MESSAGEI(8,INSTNO); 34110000
MESSAGETTI(8,INSTNO); 34120000
END; 34130000
GO TO FCTFAIL; 34140000
END; 34150000
GO TO SUCCEED; 34160000
END INTRINSIC FUNCTION CLOSE; 34170000
% 4: DATE() RETURNS THE CURRENT DATE IN THE FORM: 34180000
% MM/DD/YY 34190000
BEGIN SEGMENT 34200000
AA ~ DATE; 34210000
AB ~ TEMPCELL; 34220000
AC ~ STRING(8,AB); 34230000
MV(8,AA,0,FIRSTCHAR(AC)); 34240000
VALU[AB] ~ AC; 34250000
RETURNVAL ~ AB; 34260000
GO TO SUCCEED; 34270000
END LDATE; 34280000
% 5: DEFINE(A,B,C) CREATES A SNOBOL FUNCTION. THE VALUES OF THE 34290000
% PARAMETERS ARE OF THE FORMS: 34300000
% A ::= <FCT NAME> ( <PARAMS> ) 34310000
% B ::= <LABEL> 34320000
% C ::= <LOC VARS> 34330000
% <FCT NAME> IS A LEGAL SNOBOL IDENTIFIER. 34340000
% <LABEL> IS A LABEL THAT OCCURS IN THE PROGRAM, OR IS NULL. IF 34350000
% B IS NULL, THE ENTRY POINT IS TAKEN TO BE SPELLED THE SAME 34360000
% AS <FCT NAME>. 34370000
% <PARAMS> AND <LOC VARS> ARE THE FORMAL PARAMETERS AND LOCAL 34380000
% VARIABLES. THEY CAN BE NULL, OR CAN CONSIST OF A LIST OF 34390000
% IDENTIFIERS SEPARATED BY COMMAS. SEE ALSO THE PROCEDURE 34400000
% SNBLDEFINE AND THE DEFINE PART OF PROCESSCONTROLCARD. 34410000
BEGIN SEGMENT 34420000
IF SP - MKS < 3 THEN 34430000
IF NOT NULLARGS(3-SP+MKS) THEN GO TO FCTFAIL; 34440000
IF SNBLDEFINE(PST[MKS],PST[MKS+1],PST[MKS+2]) 34450000
THEN GO TO SUCCEED; 34460000
MESSAGEI(9,INSTNO); 34470000
MESSAGETTI(9,INSTNO); 34480000
GO TO FCTFAIL; 34490000
END LDEFINE; 34500000
% 6: DETACH(F,V) TERMINATES ANY I/O USE OF THE QUANTITY NAMED BY F. 34510000
% THE TYPE OF THIS QUANTITY IS DETERMINED BY THE FIRST CHARACTER 34520000
% OF V, AS FOLLOWS: 34530000
% "S" OR NULL = STRING NAME 34540000
% "F" = FUNCTION NAME 34550000
% "L" = LABEL 34560000
BEGIN SEGMENT 34570000
IF SP { MKS THEN GO TO FCTFAIL; 34580000
IF SP - MKS > 1 THEN 34590000
BEGIN AA ~ PST[MKS+1]; 34600000
AB ~ VALU[AA]; 34610000
AC ~ CHAR(FIRSTCHAR(AB)); 34620000
IF AB.S = 0 OR AC = "S" THEN AC ~ "SYMB" ELSE 34630000
IF AC = "F" THEN AC ~ "FCT" ELSE 34640000
IF AC = "L" THEN AC ~ "INST" ELSE GO TO FCTFAIL; 34650000
END ELSE AC ~ "SYMB"; 34660000
AA ~ PST[MKS]; 34670000
AB ~ VALU[AA]; 34680000
AA ~ ENTERST(AB.S,DATA[AB.R,*],AB.CH,AC); 34690000
VALU[AA].IOUSE ~ IO[AA] ~ 0; 34700000
GO TO SUCCEED; 34710000
END LDETACH; 34720000
% 7: DUMP() 34730000
BEGIN SEGMENT 34740000
MESSAGEI(10,INSTNO); % DUMP REQUESTED... 34750000
IF INFORM THEN BEGIN WRITEST; WRITEDATA; END; 34760000
STRINGDUMP(INSTNO); 34770000
GO TO SUCCEED; 34780000
END DUMP; 34790000
% 8: EOF(F) SUCCEEDS IF THE LAST I/O OPERATION ON THE FILE ASSOCIATED 34800000
% WITH $F FAILED DUE TO END-OF-FILE. IF NOT, OR IF $F IS NOT AN 34810000
% I/O STRING, THEN EOF(F) FAILS. 34820000
BEGIN SEGMENT 34830000
IF SP { MKS THEN GO TO FCTFAIL; 34840000
INDIRECT(MKS); 34850000
AA ~ VALU[PST[MKS]]; 34860000
IF AA.IOUSE = 0 THEN GO TO FCTFAIL; 34870000
GO TO IF IOEOF[AA.FILNO] THEN SUCCEED ELSE FCTFAIL; 34880000
END EOF; 34890000
% 9: .EQ(A,B) SUCCEEDS IFF BOTH A AND B ARE NUMERIC, AND A = B. 34900000
BEGIN SEGMENT 34910000
IF SP - MKS < 2 THEN 34920000
IF NOT NULLARGS(2-SP+MKS) THEN GO TO FCTFAIL; 34930000
IF NUMVAL(PST[MKS],AA) AND NUMVAL(PST[MKS+1],AB) 34940000
THEN GO TO IF AA = AB THEN SUCCEED ELSE FCTFAIL; 34950000
IF PRINTMESSAGES THEN 34960000
BEGIN MESSAGEAI(0,"EQ",INSTNO); 34970000
MESSAGETTAI(0,"EQ",INSTNO); 34980000
END; 34990000
GO TO FCTFAIL; 35000000
END; % .EQ(A,B) 35010000
% 10: EQUALS(A,B) SUCCEEDS IFF A AND B HAVE THE SAME STRINGS AS VALUES. 35020000
BEGIN 35030000
IF SP - MKS < 2 THEN 35040000
IF NOT NULLARGS(2-SP+MKS) THEN GO TO FCTFAIL; 35050000
AB ~ PST[MKS]; 35060000
AC ~ PST[MKS+1]; 35070000
AB ~ VALU[AB]; 35080000
AC ~ VALU[AC]; 35090000
GO TO IF AB.S ! AC.S 35100000
THEN FCTFAIL 35110000
ELSE IF EQUAL(AB.S,FIRSTCHAR(AB),FIRSTCHAR(AC)) 35120000
THEN SUCCEED 35130000
ELSE FCTFAIL; 35140000
END LEQUALS; 35150000
% 11: EXECUTE(S) CURRENTLY WORKS IF THE FIRST CHAR OF S IS QMARK, IN 35160000
% WHICH CASE THE ALGOL "ZIP WITH <ARRAY ROW>" IS EXECUTED ON S; 35170000
% OR IF S IS AN INPUT STRING, IN WHICH CASE THE ALGOL "ZIP WITH 35180000
% <FILE PART>" IS EXECUTED ON THE FILE BELONGING TO S, OR IF S 35190000
% STARTS WITH "-", WHICH IS A SNOBOL CONTROL CARD. 35200000
BEGIN SEGMENT 35210000
IF MKS } SP THEN GO TO FCTFAIL; 35220000
AA ~ PST[MKS]; 35230000
AB ~ VALU[AA]; 35240000
IF BOOLEAN(AB.INUSE) THEN % ZIP WITH FILE 35250000
BEGIN 35260000
IF BOOLEAN(AB.INUSE) AND AB.FILNO > 0 THEN 35270000
BEGIN 35280000
ZIP WITH IOFILE[AB.FILNO]; 35290000
GO TO SUCCEED; 35300000
END; 35310000
GO TO FCTFAIL; 35320000
END; 35330000
IF (I1~CHAR(FIRSTCHAR(AB))) = QMARK THEN % MCP CONTROL CARD 35340000
BEGIN ALPHA ARRAY Z[0:AB.[17:10]]; 35350000
MOVE(STRINGLOC(AB),Z[*],0); 35360000
ZIP WITH Z[*]; 35370000
GO TO SUCCEED; 35380000
END; 35390000
IF I1 = "-" THEN % SNOBOL CONTROL CARD 35400000
BEGIN ALPHA ARRAY SCRATCH[0:(AB.S).W]; 35410000
INSTSIZE ~ AB.S; 35420000
MOVE(INSTSIZE,FIRSTCHAR(AB),SCRATCH[0],0); 35430000
SCRATCH[INSTSIZE.W] ~ STOPPER; 35440000
PROCESSCONTROLCARD(SCRATCH); 35450000
GO TO SUCCEED; 35460000
END; 35470000
GO TO FCTFAIL; 35480000
END LEXECUTE; 35490000
%12: FILE(NAME,I.O,BUFFERS,REC.SIZE,BUFF.SIZE,SAVE.FACT,DSK.AREAS,SIZE) 35500000
% FILE(...) OPENS A FILE, AS DESCRIBED BY THE PARAMETERS: 35510000
% NAME CONTAINS THE NAME OF THE PRIMARY I/O STRING 35520000
% I.O STARTS WITH "I" FOR INPUT FILES, "O" FOR OUTPUT FILES, AND 35530000
% IS NULL FOR FILES WITH BOTH INPUT AND OUTPUT USE. 35540000
% BUFFERS IS THE NUMBER OF BUFFER AREAS TO BE USED. 35550000
% REC.SIZE IS THE SIZE (IN CHARACTERS) OF AN I/O RECORD 35560000
% BUFF.SIZE IS THE SIZE (IN CHARACTERS) OF A BUFFER (PHYSICAL RECORD)35570000
% SAVE.FACT IS THE SAVE FACTOR FOR FILES CREATED BY THE PROGRAM 35580000
% DSK.AREAS IS THE NUMBER OF DISK AREAS FOR NEW DISK FILES ({20) 35590000
% SIZE IS THE SIZE OF ONE OF THESE DISK AREAS, IN LOGICAL RECORDS. 35600000
BEGIN 35610000
INTEGER 35620000
AREAS, 35630000
ASIZE, 35640000
BLOCKCOUNT, 35650000
BUFFERS, 35660000
BUFSIZE, 35670000
CYC, 35680000
RECSIZE, 35690000
SAVEFACTOR, 35700000
TYPEA, % "ALGOL" TYPE: 9, 10, OR 11 35710000
TYPES, % "SNOBOL" TYPE: 1, 2, OR 3 35720000
UNIT; 35730000
MONITOR PRINT (AREAS,ASIZE,BLOCKCOUNT,BUFFERS,BUFSIZE,CYC,RECSIZE, 35740000
IOSIZE,VALTABL,IOUSAGE, 35750000
SAVEFACTOR,TYPEA,TYPES,UNIT,AA,AB,AC,I1,I2); 35760000
% 35770000
GO TO UNDEFFCT; % UNTIL A WAY IS FOUND TO IMPLEMENT FILE DECLARATIONS35780000
UNIT ~ 0; 35790000
CYC ~ 16; 35800000
FOR I ~ 1 STEP 1 UNTIL FILMAX DO 35810000
IF NOT IOFILEOPEN[I] THEN 35820000
IF IOUSAGE[I].CYCLE < CYC THEN 35830000
BEGIN UNIT ~ I; CYC ~ IOUSAGE[I].CYCLE; END; 35840000
IF UNIT = 0 THEN 35850000
BEGIN MESSAGEI(14,INSTNO); % NO FILE AVAILABLE 35860000
GO TO FCTFAIL; 35870000
END; 35880000
IF SP - MKS < 3 THEN GO TO FCTFAIL; 35890000
% 35900000
AA ~ PST[MKS+1]; 35910000
AB ~ VALU[AA]; 35920000
IF AB.S = 0 THEN 35930000
BEGIN TYPEA ~ 11; 35940000
TYPES ~ 3; 35950000
END ELSE 35960000
IF (I1~CHAR(DATA[AB.R,AB.W],AB.C)) = "I" THEN 35970000
BEGIN TYPEA ~ 9; 35980000
TYPES ~ 2; 35990000
END ELSE 36000000
IF I1 = "O" THEN 36010000
BEGIN TYPEA ~ 10; 36020000
TYPES ~ 1; 36030000
END ELSE 36040000
BEGIN % ERROR: INVALID I/O TYPE 36050000
MESSAGEI(15,INSTNO); 36060000
GO TO FCTFAIL; 36070000
END; 36080000
IF NOT NUMVAL(PST[MKS+2],BUFFERS) OR BUFFERS < 1 THEN 36090000
BEGIN % ERROR: INVALID BUFFER NUMBER 36100000
MESSAGEI(16,INSTNO); 36110000
GO TO FCTFAIL; 36120000
END; 36130000
IF SP - MKS { 3 THEN RECSIZE ~ 0 ELSE 36140000
IF NOT NUMVAL(PST[MKS+3],RECSIZE) OR RECSIZE < 0 36150000
OR RECSIZE > 8182 THEN 36160000
BEGIN % ERROR: INVALID RECORD SIZE 36170000
GO TO FCTFAIL; 36180000
END; 36190000
IOSIZE[UNIT] ~ RECSIZE; 36200000
RECSIZE ~ (RECSIZE+7).W; 36210000
IF SP - MKS { 4 THEN BUFSIZE ~ 0 ELSE 36220000
IF NOT NUMVAL(PST[MKS+4],BUFSIZE) OR BUFSIZE < 0 36230000
OR BUFSIZE > 8182 THEN 36240000
BEGIN % ERROR: INVALID BUFFER SIZE 36250000
GO TO FCTFAIL; 36260000
END; 36270000
BUFSIZE ~ (BUFSIZE+7).W; 36280000
IF SP - MKS { 5 THEN SAVEFACTOR ~ 0 ELSE 36290000
IF NOT NUMVAL(PST[MKS+5],SAVEFACTOR) OR SAVEFACTOR { 0 THEN 36300000
BEGIN % ERROR: INVALID SAVEFACTOR 36310000
GO TO FCTFAIL; 36320000
END; 36330000
IF SP - MKS { 6 THEN AREAS ~ 0 ELSE 36340000
IF NOT NUMVAL(PST[MKS+6],AREAS) OR AREAS < 0 36350000
OR AREAS > 20 THEN 36360000
BEGIN % ERROR: INVALID NUMBER OF DISK AREAS 36370000
GO TO FCTFAIL; 36380000
END; 36390000
IF SP - MKS { 7 THEN ASIZE ~ 0 ELSE 36400000
IF NOT NUMVAL(PST[MKS+7],ASIZE) OR ASIZE < 0 THEN 36410000
BEGIN % ERROR: INVALID DISK AREA SIZE 36420000
GO TO FCTFAIL; 36430000
END; 36440000
CYC ~ IOUSAGE[UNIT].CYCLE; 36450000
CYC ~ CYC + 1; 36460000
% CREATE NEW FILE HERE. 36470000
GO TO SUCCEED; 36480000
END INTRINSIC FILE; 36490000
% 13: FILL(NAME,MFID,FID,MEDIA,DATE,REEL,CYCLE) FILLS THE FILE 36500000
% $NAME WITH A DESCRIPTION OF AN ACTUAL FILE, AS DESCRIBED BY 36510000
% THE PARAMETERS AS FOLLOWS: 36520000
% MFID/FID IS THE EXTERNAL NAME OF THE FILE. IF EITHER 36530000
% MFID OR FID CONTAIN MORE THAN 7 CHARS, ONLY THE FIRST 7 36540000
% WILL BE USED. IF EITHER IS NULL, "0000000" WILL BE USED. 36550000
% MEDIA IS ONE OF THE MEDIA DIGITS LISTED IN THE ALGOL MANUAL. 36560000
% DATE IS THE DATE THAT SHOULD BE USED WITH OUTPUT FILES, 36570000
% USUALLY THE CURRENT DATE. IT CAN BE IN THE FORM MM/DD/YY 36580000
% OR THE FORM YYDDD (WHICH IS HOW IT IS STORED IN THE 36590000
% STANDARD FILE LABEL). 36600000
% REEL IS THE REEL NUMBER, FOR MULTI-REEL TAPES 36610000
% CYCLE IS THE CYCLE NUMBER, ALSO FOR TAPES MAINLY. 36620000
% IF ANY OF THE PARAMETERS IS MISSING, IT WILL NOT BE ASSIGNED; 36630000
% THUS, MULTIPLE CALLS OF FILL() CAN FILL IN DIFFERENT PIECES OF 36640000
% INFORMATION. IF FILE() IS TO BE EFFECTIVE, IT MUST BE USED 36650000
% BEFORE ANY I/O IS DONE ON THE FILE. 36660000
BEGIN ALPHA ST, SIO, MFID, FID, D, M, Y; 36670000
INTEGER MED, REEL, CYC; 36680000
IF SP { MKS THEN GO TO FCTFAIL; 36690000
IF SP - MKS < 3 THEN 36700000
IF NOT NULLARGS(3-SP+MKS) THEN GO TO FCTFAIL; 36710000
INDIRECT(MKS); 36720000
ST ~ PST[MKS]; 36730000
IF VALU[ST].IOUSE = 0 THEN GO TO FCTFAIL; 36740000
SIO ~ IO[ST]; 36750000
% GET MFID: 36760000
AA ~ PST[MKS+1]; 36770000
AB ~ VALU[AA]; 36780000
IF AB.S = 0 THEN MFID ~ -1 ELSE 36790000
BEGIN MV(7,BLANKS,1,MFID,1); 36800000
MV(MIN(7,AB.S),FIRSTCHAR(AB),MFID,1); 36810000
END; 36820000
MFID ~ MFID; 36830000
% GET FID: 36840000
AA ~ PST[MKS+2]; 36850000
AB ~ VALU[AA]; 36860000
IF AB.S = 0 THEN FID ~ -1 ELSE 36870000
BEGIN MV(7,BLANKS,1,FID,1); 36880000
MV(MIN(7,AB.S),FIRSTCHAR(AB),FID,1); 36890000
END; 36900000
FID ~ FID; 36910000
% GET MEDIA DIGIT: 36920000
IF SP-MKS{3 OR VALTABL[(AA~PST[MKS+3]).STR,AA.STW].S = 0 36930000
THEN MED ~ -1 ELSE 36940000
IF NOT NUMVAL(AA,MED) THEN GO TO FCTFAIL; 36950000
MED ~ MED; 36960000
% GET DATE: 36970000
IF SP-MKS { 4 OR VALTABL[(AA~PST[MKS+4]).STR,AA.STW].S = 0 36980000
THEN D ~ -1 ELSE 36990000
BEGIN AA ~ PST[MKS+4]; 37000000
AB ~ VALU[AA]; 37010000
IF AB.S = 0 THEN D ~ -1 ELSE 37020000
IF AB.S = 5 THEN 37030000
MV(5,FIRSTCHAR(AB),D,3) ELSE 37040000
IF AB.S = 8 THEN 37050000
BEGIN MV(8,FIRSTCHAR(AB),D,0); 37060000
IF CHAR(D,0) > 1 THEN GO TO FCTFAIL; 37070000
IF D.[12:8] ! "/" OR D.[30:6] ! "/" THEN GO TO FCTFAIL; 37080000
Y ~ D.[36:12]; 37090000
M ~ D.[1:5] | 10 + D.[6:6]; 37100000
IF M > 12 THEN GO TO FCTFAIL; 37110000
D ~ D.[18:6] | 10 + D.[24:6]; 37120000
IF D > 31 THEN GO TO FCTFAIL; 37130000
FOR I ~ 1 STEP 1 UNTIL M DO D ~ D + MONTHS[I]; 37140000
D ~ ENTIER(D MOD 10) & Y[18:36:12] & 37150000
ENTIER(D DIV 100)[30:42:6] & 37160000
ENTIER((D MOD 100) DIV 10)[36:42:6]; 37170000
END; 37180000
END; 37190000
% FIND REEL NUMBER: 37200000
IF (IF SP-MKS{5 THEN T ELSE VALTABL[(AA~PST[MKS+5]).STR,AA.STW].S=0) 37210000
THEN REEL ~ -1 ELSE 37220000
IF NOT NUMVAL(AA,REEL) THEN GO TO FCTFAIL; 37230000
% FIND CYCLE NUMBER: 37240000
IF (IF SP-MKS{6 THEN T ELSE VALTABL[(AA~PST[MKS+6]).STR,AA.STW].S=0) 37250000
THEN CYC ~ -1 37260000
ELSE IF NOT NUMVAL(AA,CYC) THEN GO TO FCTFAIL; 37270000
% FOUND PARAMETERS; FILL FILE: 37280000
% NOTE THAT A FILL ELEMENT OF -1 MEANS "NO CHANGE". 37290000
FILL IOFILE[SIO.FILNO] WITH MFID, FID, REEL, D, CYC, MED; 37300000
GO TO SUCCEED; 37310000
END FILL; 37320000
% 14: .GE(A,B) SUCCEEDS IFF A AND B ARE NUMERIC AND A } B. 37330000
BEGIN SEGMENT 37340000
IF SP - MKS < 2 THEN 37350000
IF NOT NULLARGS(2-SP+MKS) THEN GO TO FCTFAIL; 37360000
IF NUMVAL(PST[MKS],AA) AND NUMVAL(PST[MKS+1],AB) 37370000
THEN GO TO IF AA } AB THEN SUCCEED ELSE FCTFAIL; 37380000
IF PRINTMESSAGES THEN 37390000
BEGIN MESSAGEAI(0,"GE",INSTNO); 37400000
MESSAGETTAI(0,"GE",INSTNO); 37410000
END; 37420000
GO TO FCTFAIL; 37430000
END LGE; 37440000
% 15: .GT(A,B) 37450000
% .GT(A,B) SUCCEEDS IFF A AND B ARE BOTH NUMERIC AND A > B. 37460000
BEGIN SEGMENT 37470000
IF SP - MKS < 2 THEN 37480000
IF NOT NULLARGS(2-SP+MKS) THEN GO TO FCTFAIL; 37490000
IF NUMVAL(PST[MKS],AA) AND NUMVAL(PST[MKS+1],AB) 37500000
THEN GO TO IF AA > AB THEN SUCCEED ELSE FCTFAIL; 37510000
IF PRINTMESSAGES THEN 37520000
BEGIN MESSAGEAI(0,"GT",INSTNO); 37530000
MESSAGETTAI(0,"GT",INSTNO); 37540000
END; 37550000
GO TO FCTFAIL; 37560000
END LGT; 37570000
% 16: .LE(A,B) 37580000
% .LE(A,B) SUCCEEDS IFF A AND B ARE BOTH NUMERIC AND A { B. 37590000
BEGIN SEGMENT 37600000
IF SP - MKS < 2 THEN IF NOT NULLARGS(2-SP+MKS) THEN GO TO FCTFAIL; 37610000
IF NUMVAL(PST[MKS],AA) AND NUMVAL(PST[MKS+1],AB) 37620000
THEN GO TO IF AA { AB THEN SUCCEED ELSE FCTFAIL; 37630000
IF PRINTMESSAGES THEN 37640000
BEGIN MESSAGEAI(0,"LE",INSTNO); 37650000
MESSAGETTAI(0,"LE",INSTNO); 37660000
END; 37670000
GO TO FCTFAIL; 37680000
END LLE; 37690000
% 17: LEVEL() 37700000
% LEVEL() RETURNS THE LEVEL AT WHICH THE PROGRAM IS CURRENTLY 37710000
% OPERATING. THE LEVEL IS DEFINED AS FOLLOWS: IT IS 1 AT THE 37720000
% START OF THE PROGRAM; IT INCREASES BY 1 WITH EACH CALL ON A 37730000
% PROGRAMMER-DEFINED FUNCTION; AND IT DECREASES BY 1 AT EACH 37740000
% RETURN (OR FRETURN). 37750000
BEGIN SEGMENT 37760000
RETURNVAL ~ TEMPVAL(LEVEL); 37770000
GO TO SUCCEED; 37780000
END; % LEVEL() 37790000
% 18: LOOK(S,F) 37800000
% LOOK(S,F) TURNS THE STRING $S INTO A NON-READINT I/O STRING FOR 37810000
% THE INPUT FILE BELONGING TO THE STRING $F. IF $F IS NOT AN INPUT 37820000
% STRING (NOT DATACOMM), LOOK FCTFAILS. 37830000
BEGIN SEGMENT 37840000
IF SP - MKS < 2 THEN GO TO FCTFAIL; 37850000
INDIRECT(MKS); 37860000
AA ~ PST[MKS]; 37870000
INDIRECT(MKS+1); 37880000
AB ~ PST[MKS+1]; 37890000
AC ~ IOTABL[AB.STR,AB.STW]; 37900000
IF NOT BOOLEAN(AC.INUSE) OR AC.FILNO=0 THEN GO TO FCTFAIL; 37910000
VALU[AA].IOUSE ~ 2; 37920000
IO[AA] ~ 0 & 2 CIOUSE & 2 CIOTYPE & AC TFILNO; 37930000
GO TO SUCCEED; 37940000
END; 37950000
% 19: .LT(A,B) 37960000
% .LT(A,B) SUCCEEDS IFF A AND B ARE BOTH NUMERIC AND A < B. 37970000
BEGIN SEGMENT 37980000
IF SP-MKS < 2 THEN IF NOT NULLARGS(2-SP+MKS) THEN GO TO FCTFAIL; 37990000
IF NUMVAL(PST[MKS],AA) AND NUMVAL(PST[MKS+1],AB) 38000000
THEN GO TO IF AA < AB THEN SUCCEED ELSE FCTFAIL; 38010000
IF PRINTMESSAGES THEN 38020000
BEGIN MESSAGEAI(0,"LT",INSTNO); 38030000
MESSAGETTAI(0,"LT",INSTNO); 38040000
END; 38050000
GO TO FCTFAIL; 38060000
END LT; 38070000
% 20: MODE(V) 38080000
% MODE(V) SETS SYSTEM VARIABLE, DEPENDING ON THE CONTENTS OF V. 38090000
% THE VALUES CURRENTLY RECOGNIZED FOR V ARE: 38100000
% "DUMP" EXECUTE DUMP() AT END-OF-JOB. 38110000
% "ROUND" ROUND QUOTIENTS OF DIVISIONS (STANDARD). 38120000
% "INTEGER" DIVISION FCTFAILS IF REMAINDER ! 0. 38130000
% "TRUNCATION" TRUNCATE QUOTIENTS. 38140000
% "ANCHOR" ALL SCANS ARE ANCHORED UNLESS UNANCH() IS USED. 38150000
% "UNANCH" ALL SCANS ARE UNANCHORED, UNLESS ANCHOR() IS USED 38160000
% "UNANCHOR" SAME AS "UNANCH" (STANDARD). 38170000
% "INFORM" TURN ON SYSTEM DEBUGGING OUTPUT. 38180000
% "SILENCE" TURN OFF DEBUGGING OUTPUT (STANDARD). 38190000
BEGIN ALPHA ARRAY WORD[0:1]; 38200000
IF SP { MKS THEN GO TO FCTFAIL; 38210000
AA ~ PST[MKS]; 38220000
AB ~ VALU[AA]; 38230000
IF (I1~AB.S) < 3 OR I1 > 10 THEN GO TO FCTFAIL; 38240000
MV(I1,FIRSTCHAR(AB),WORD[*],0); 38250000
CASE I1 OF 38260000
BEGIN ;;; % NONE OF SIZE 0, 1, OR 2. 38270000
IF EQ(3,WORD[*],0,WORDS[13],5) THEN 38280000
BEGIN DEBUGGING ~ FALSE; % RUN 38290000
SETLIMITFLAG; 38300000
GO TO SUCCEED; 38310000
END; 38320000
IF EQUAL(4,WORD[*],0,WORDS[1],3) THEN 38330000
BEGIN DMPSTR ~ TRUE; % DUMP 38340000
GO TO SUCCEED; 38350000
END; 38360000
IF EQUAL(5,WORD[*],0,WORDS[0],7) THEN 38370000
BEGIN DIVIDEMODE ~ 0; % ROUND 38380000
GO TO SUCCEED; 38390000
END ELSE 38400000
IF EQ(5,WORD[*],0,WORDS[13],0) THEN 38410000
BEGIN DEBUGGING ~ TRUE; % DEBUG 38420000
SETLIMITFLAG; 38430000
GO TO SUCCEED; 38440000
END; 38450000
IF EQUAL(6,WORD[*],0,WORDS[0],2) THEN 38460000
BEGIN IF SP - MKS > 1 THEN % ANCHOR 38470000
BEGIN IF NOT NUMVAL(PST[MKS+1],I2) OR I2 < 0 OR I2 > 8191 38480000
THEN GO TO FCTFAIL; 38490000
ANCHORSIZE ~ I2; 38500000
END; 38510000
ANCHORMODE ~ 3; 38520000
GO TO SUCCEED; 38530000
END ELSE 38540000
IF EQUAL(6,WORD[*],0,WORDS[0],0) THEN 38550000
BEGIN ANCHORMODE ~ 2; % UNANCH 38560000
ANCHORSIZE ~ 0; 38570000
GO TO SUCCEED; 38580000
END ELSE 38590000
IF EQUAL(6,WORD[*],0,WORDS[4],6) THEN 38600000
BEGIN PRINTMESSAGES ~ TRUE; % INFORM 38610000
INFORM ~ SYSTEMDEBUGGING; 38620000
GO TO SUCCEED; 38630000
END; 38640000
IF EQUAL(7,WORD[*],0,WORDS[2],0) THEN 38650000
BEGIN DIVIDEMODE ~ 2; % INTEGER 38660000
GO TO SUCCEED; 38670000
END ELSE 38680000
IF EQUAL(7,WORD[*],0,WORDS[5],4) THEN 38690000
BEGIN % SILENCE 38700000
PRINTMESSAGES ~ INFORM ~ FALSE; 38710000
GO TO SUCCEED; 38720000
END ELSE 38730000
IF EQ(7,WORD[*],0,WORDS[14],0) THEN 38740000
BEGIN ERRDUMP ~ TRUE; % ERRDUMP 38750000
GO TO SUCCEED; 38760000
END; 38770000
IF EQUAL(8,WORD[*],0,WORDS[0],0) THEN 38780000
BEGIN ANCHORMODE ~ 2; % UNANCHOR 38790000
ANCHORSIZE ~ 0; 38800000
GO TO SUCCEED; 38810000
END ELSE 38820000
IF EQ(8,WORD[*],0,WORDS[14],7) THEN % TRUNCATE, FILE 38830000
BEGIN IF SP < MKS+2 THEN GO TO FCTFAIL; 38840000
INDIRECT(MKS+2); 38850000
AA ~ PST[MKS+1]; 38860000
AB ~ IO[AA]; 38870000
IF BOOLEAN(AB.OUTUSE) THEN IF AB.FILNO ! 0 THEN 38880000
BEGIN IO[AA].OVFL ~ 0; 38890000
GO TO SUCCEED; 38900000
END; 38910000
GO TO FCTFAIL; 38920000
END ELSE 38930000
IF EQ(8,WORD[*],0,WORDS[15],7) THEN % OVERFLOW, FILE 38940000
BEGIN IF SP < MKS+2 THEN GO TO FCTFAIL; 38950000
INDIRECT(MKS+1); 38960000
AA ~ PST[MKS+1]; 38970000
AB ~ IO[AA]; 38980000
IF BOOLEAN(AB.OUTUSE) THEN IF AB.FILNO ! 0 THEN 38990000
BEGIN IO[AA].OVFL ~ 1; 39000000
GO TO SUCCEED; 39010000
END; 39020000
GO TO FCTFAIL; 39030000
END; 39040000
; % NONE WITH 9 CHARS 39050000
IF EQUAL(10,WORD[*],0,WORDS[2],7) THEN 39060000
BEGIN DIVIDEMODE ~ 1; % TRUNCATION 39070000
GO TO SUCCEED; 39080000
END; 39090000
END; 39100000
GO TO FCTFAIL; 39110000
END; % MODE(V) 39120000
% 21: .NE(A,B) 39130000
% .NE(A,B) SUCCEEDS IFF A AND B ARE BOTH NUMERIC AND A ! B. 39140000
BEGIN SEGMENT 39150000
IF SP-MKS < 2 THEN IF NOT NULLARGS(2-SP+MKS) THEN GO TO FCTFAIL; 39160000
IF NUMVAL(PST[MKS],AA) AND NUMVAL(PST[MKS+1],AB) 39170000
THEN GO TO IF AA ! AB THEN SUCCEED ELSE FCTFAIL; 39180000
IF PRINTMESSAGES THEN 39190000
BEGIN MESSAGEAI(0,"NE",INSTNO); 39200000
MESSAGETTAI(0,"NE",INSTNO); 39210000
END; 39220000
GO TO FCTFAIL; 39230000
END LNE; 39240000
% 22: .NUM(A) 39250000
% .NUM(A) SUCCEEDS IF A IS NUMERIC; THAT IS, IF A IS NULL, OR 39260000
% A IS NOT NULL AND THE FIRST CHAR OF A IS "-" OR A DIGIT AND 39270000
% THE OTHER CHARS OF A ARE ALL DIGITS. 39280000
BEGIN SEGMENT 39290000
IF MKS = SP THEN GO TO SUCCEED; 39300000
GO TO IF NUMVAL(PST[MKS],AA) THEN SUCCEED ELSE FCTFAIL; 39310000
END LNUM; 39320000
% 23: OPSYN(S1,S2,T) 39330000
% OPSYN(S1,S2,T) CAUSES THE ALTERING OF THE SYMBOL TABLE ENTRY 39340000
% DESCRIBED BY S1 AND T; THE QUANTITY NAMED BY S1 IS SET TO BE 39350000
% IDENTICAL TO THE QUANTITY NAMED BY S2. THE TYPES OF THE QUANTITIES39360000
% ARE DETERMINED BY T AS FOLLOWS: 39370000
% T IS NULL: S1 AND S2 NAME FUNCTIONS. 39380000
% T STARTS WITH "F": S1 AND S2 NAME FUNCTIONS. 39390000
% T STARTS WITH "S": S1 AND S2 NAME STRINGS. 39400000
% T STARTS WITH "L": S1 AND S2 NAME LABELS. 39410000
% NOT ONLY THE VALUE OF THE QUANTITY NAMED BY S2 IS COPIED, BUT 39420000
% ALSO ANY I/O USE IT MAY HAVE. THUS, OPSYN("A","B","S") CREATES 39430000
% A STRING NAMED "A" (IF ONE DOES NOT ALREADY EXIST), AND ASSIGNS 39440000
% TO A THE VALUE AND I/O USE OF B. OPSYN("F","ARGH","F") CREATES 39450000
% A FUNCTION NAMED "F", WHICH IS IDENTICAL TO THE FUNCTION ARGH. 39460000
% ANY FORMER FUNCTION NAMED "F" IS LOST. SIMILARLY, OPSYN("L1", 39470000
% ,"L2","L") CREATES A LABEL NAMED L1, WHICH IS THE SAME STATEMENT 39480000
% AS L2. ANY TRANSFER TO L1 WILL THEN RESULT IN A TRANSFER TO 39490000
% A STATEMENT THAT IS THE SAME AS L2. 39500000
BEGIN ALPHA I, TYPE; 39510000
IF SP-MKS < 3 THEN IF NOT NULLARGS(3-SP+MKS) THEN GO TO FCTFAIL; 39520000
AA ~ PST[MKS+2]; 39530000
AA ~ VALU[AA]; 39540000
IF AA.S = 0 THEN TYPE ~ "FCT" ELSE 39550000
BEGIN AA ~ CHAR(FIRSTCHAR(AA)); 39560000
TYPE ~ IF AA = "S" THEN "SYMB" ELSE % "S" STRING NAME 39570000
IF AA = "F" THEN "FCT" ELSE % "F" FUNCTION 39580000
IF AA = "L" THEN "INST" ELSE 0; % "L" LABEL 39590000
IF TYPE = 0 THEN GO TO FCTFAIL; 39600000
END; 39610000
AA ~ PST[MKS]; 39620000
AB ~ VALU[AA]; 39630000
AB ~ ENTERST(AB.S,DATA[AB.R,*],AB.CH,TYPE); 39640000
AA ~ PST[MKS + 1]; 39650000
AC ~ VALU[AA]; 39660000
AC ~ ENTERST(AC.S,DATA[AC.R,*],AC.CH,TYPE); 39670000
AA ~ VALU[AC]; 39680000
I ~ STRING(AA.S,AB); 39690000
MOVE(I.S,FIRSTCHAR(AA),FIRSTCHAR(I)); 39700000
VALU[AB] ~ I & AA[1:1:16]; 39710000
IO[AB] ~ IO[AC]; 39720000
GO TO SUCCEED; 39730000
END LOPSYN; 39740000
% 24: PAGE(N) 39750000
% PAGE(N) EJECTS THE LINE PRINTER FILE PRINT TO CHANNEL N. IF N < 0 39760000
% OR N > 11, PAGE FAILS. IF N = 0, CHANNEL 1 ( THE TOP OF THE NEXT 39770000
% PAGE) IS USED. 39780000
BEGIN SEGMENT 39790000
IF SP > MKS+1 THEN % OUTPUT FILE AS 2ND PARAMETER 39800000
BEGIN INDIRECT(MKS+1); 39810000
AB ~ PST[MKS+1]; 39820000
IF VALU[AB].IOUSE = 0 THEN GO TO FCTFAIL ELSE 39830000
IF I2~IO[AB].FILNO=0 THEN GO TO FCTFAIL; 39840000
END ELSE I2 ~ 3; % ASSUME PRINT. 39850000
IF SP = MKS THEN I1 ~ 1 ELSE 39860000
BEGIN AA ~ PST[MKS]; 39870000
IF NOT NUMVAL(AA,I1) OR I1<0 OR I1>11 THEN GO TO FCTFAIL; 39880000
IF I1 = 0 THEN I1 ~ 1; 39890000
END; 39900000
RECORD[I2] ~ I1; 39910000
GO TO SUCCEED; 39920000
END LPAGE; 39930000
% 25: POP(S) 39940000
% POP(S) POPS THE VARIABLE S--I. E., THE TOP VALUE ON THE PUSH-DOWN 39950000
% STACK OF S IS REMOVED. IF S IN NOT A NAMED STRING OR IF S CANT 39960000
% BE POPPED (ONLY ONE VALUE IN ITS STACK), POP FAILS. IF S IS AN 39970000
% OUTPUT STRING, OUTPUT OCCURS. 39980000
BEGIN SEGMENT 39990000
IF SP { MKS THEN GO TO FCTFAIL; 40000000
IF NOT PNAME[MKS] THEN GO TO FCTFAIL; 40010000
GO TO IF POP(AA~PST[MKS]) 40020000
THEN IF BOOLEAN(VALU[AA].OUTUSE) 40030000
THEN IF SNBLOUT(AA) 40040000
THEN SUCCEED 40050000
ELSE FCTFAIL 40060000
ELSE SUCCEED 40070000
ELSE FCTFAIL; 40080000
END LPOP; 40090000
% 26: PUSH(S,V) 40100000
% PUSH(S,V) PUSHES THE VALUE OF V ONTO THE TOP OF THE PUSH-DOWN 40110000
% STACK OF THE VARIABLE S. IF POP(S) IS THEN EXECUTED, S RETURNS 40120000
% TO ITS FORMER VALUE. PUSH FAILS IF S IS NOT A NAMED STRING, OR 40130000
% IF THE SYMBOL TABLE IS FULL (A FATAL ERROR). IF S IS AN OUTPUT 40140000
% STRING, OUTPUT OCCURS. 40150000
BEGIN SEGMENT 40160000
IF SP { MKS THEN GO TO FCTFAIL; 40170000
IF NOT PNAME[MKS] THEN GO TO FCTFAIL; 40180000
GO TO IF PUSH(AA~PST[MKS],IF SP-MKS { 1 THEN 0 ELSE PST[MKS+1]) 40190000
THEN IF BOOLEAN(VALU[AA].OUTUSE) 40200000
THEN IF SNBLOUT(AA) 40210000
THEN SUCCEED 40220000
ELSE FCTFAIL 40230000
ELSE SUCCEED 40240000
ELSE FCTFAIL; 40250000
END LPUSH; 40260000
% 27: .REMDR(A,B) 40270000
% .REMDR(A,B) RETURNS THE QUOTIENT OF A / B. IF EITHER A OR B 40280000
% IS NONNUMERIC, OR B = 0, .REMDR FAILS. 40290000
BEGIN SEGMENT 40300000
IF SP-MKS < 2 THEN GO TO FCTFAIL; 40310000
AA ~ PST[MKS]; 40320000
AB ~ PST[MKS+1]; 40330000
IF NOT(NUMVAL(AA,AA) AND NUMVAL(AB,AB)) THEN GO TO FCTFAIL; 40340000
IF AB = 0 THEN GO TO FCTFAIL; 40350000
RETURNVAL ~ TEMPVAL(AA - (AA DIV AB) | AB); 40360000
GO TO SUCCEED; 40370000
END LREMDR; 40380000
% 28: REWIND(F) 40390000
% REWIND(F) CAUSES THE FILE ASSOCIATED WITH $F TO BE REWOUND. 40400000
% IF $F ISNT AN I/O STRING, REWIND FAILS. 40410000
BEGIN SEGMENT 40420000
IF SP { MKS THEN GO TO FCTFAIL; 40430000
INDIRECT(MKS); 40440000
AB ~ IO[PST[MKS]]; 40450000
IF AB.IOUSE = 0 OR AB.IOTYPE ! 1 THEN GO TO FCTFAIL; 40460000
REWIND(IOFILE[AB.FILNO]); 40470000
GO TO SUCCEED; 40480000
END INTRINSIC FUNCTION REWIND; 40490000
%29: RULES(L) 40500000
% RULES(L) RETURNS THE NUMBER OF RULES EXECUTED AT LEVEL L S1E 40510000
% THE LAST TIME LEVEL L WAS REACHED. IF L = 0 (OR IS NULL), THE 40520000
% TOTAL FOR THE PROGRAM IS RETURNED. IF L { LEVEL(), THE CURRENT 40530000
% RULE BEING EXECUTED IS INCLUDED IN THE TOTAL. RULES WILL FAIL IF 40540000
% L < 0 OR L > MAXLEVEL. NOTE THAT IF RULES(L) = "0", THEN THE 40550000
% LEVEL L HAS NEVER BEEN REACHED. 40560000
BEGIN SEGMENT 40570000
AA ~ IF SP > MKS THEN PST[MKS] ELSE 0; 40580000
IF AA = 0 40590000
THEN I1 ~ 0 40600000
ELSE IF NOT NUMVAL(AA,I1) THEN GO TO FCTFAIL; 40610000
IF I1 < 0 THEN GO TO FCTFAIL; 40620000
RETURNVAL ~ TEMPVAL(IF I1 > MAXLEVEL THEN 0 ELSE RULES[I]); 40630000
GO TO SUCCEED; 40640000
END LRULES; 40650000
% 30: SIZE(S) 40660000
% SIZE(S) RETURNS THE NUMBER OF CHARACTERS IN S. 40670000
BEGIN 40680000
RETURNVAL ~ TEMPVAL(IF SP { MKS THEN 0 ELSE VALU[PST[MKS]].S); 40690000
GO TO SUCCEED; 40700000
END LSIZE; 40710000
% 31: SPACE(F,N) SETS A COUNTER FOR THE I/O FILE BELONGING TO $F, 40720000
% SO THAT ANY FURTHER I/O OPERATIONS ON THIS FILE WILL BE 40730000
% PRECEDED BY A SKIPPING OF N RECORDS. SPACE FAILS IN THE 40740000
% FOLLOWING SITUATIONS: 40750000
% N NON-NUMERIC. 40760000
% $F NOT AN I/O STRING. 40770000
% $F A DATACOMM I/O STRING. 40780000
% NOTE THAT FOR MOST FILES, N < 0 IS MEANINGLESS. ALSO, N = 0 40790000
% FOR LINE PRINTER FILES CAUSES OVERPRINTING. 40800000
BEGIN SEGMENT 40810000
IF SP { MKS+1 THEN IF NOT NULLARGS(2) THEN GO TO FCTFAIL; 40820000
INDIRECT(MKS); 40830000
AB ~ PST[MKS]; 40840000
AB ~ IO[AB]; 40850000
IF AB.IOUSE = 0 OR AB.FILNO = 0 THEN GO TO FCTFAIL; 40860000
IF NOT NUMVAL(PST[MKS+1],I1) THEN GO TO FCTFAIL; 40870000
IOSPACE[AB.FILNO] ~ I1; 40880000
GO TO SUCCEED; 40890000
END LSPACE; 40900000
% 32: TIME(N) 40910000
BEGIN ALPHA ARRAY NUM[0:1]; 40920000
STREAM PROCEDURE TEMPS(TH,TM,TS,W); 40930000
VALUE TH,TM,TS; 40940000
BEGIN DI ~ W; DS ~ 8 LIT " "; 40950000
SI ~ LOC TH; DS ~ 2 DEC; DS ~ 1 LIT ":"; 40960000
SI ~ LOC TM; DS ~ 2 DEC; DS ~ 1 LIT ":"; 40970000
SI ~ LOC TS; DS ~ 2 DEC; 40980000
END TEMPS; 40990000
INTEGER TH,TM,TS; 41000000
IF SP = MKS THEN 41010000
IF NOT NULLARGS(1) THEN GO TO FCTFAIL; 41020000
AB ~ PST[MKS]; 41030000
IF NOT NUMVAL(AB,AA) THEN GO TO FCTFAIL; 41040000
IF AA < 0 OR AA > 4 THEN GO TO FCTFAIL; 41050000
IF AA = 0 THEN 41060000
BEGIN 41070000
AA ~ TIME(1) / 60; 41080000
TH ~ ENTIER(TEMP/3600); 41090000
TM ~ ENTIER((TEMP-TH|3600)/60); 41100000
TS ~ AA - TH|3600 - TM|60; 41110000
TEMPS(TH,TM,TS,NUM[*]); 41120000
END ELSE 41130000
IF AA = 4 THEN 41140000
BEGIN CLEAR(NUM,2); 41150000
I1 ~ TIME(4); 41160000
MV(1,I1,7,NUM[*],15); 41170000
END ELSE 41180000
BEGIN RETURNVAL ~ TEMPVAL(TIME(AA)); 41190000
GO TO SUCCEED; 41200000
END; 41210000
AA ~ 16 - SKIPCHAR(" ",NUM[*],0); 41220000
RETURNVAL ~ TEMPCELL; 41230000
AC ~ STRING(AA,RETURNVAL); 41240000
MOVE(AA,NUM[*],16-AA,FIRSTCHAR(AC)); 41250000
VALU[RETURNVAL] ~ AC; 41260000
GO TO SUCCEED; 41270000
END LTIME; 41280000
% 33: TRACES(S1,S2,S3,...) TURNS ON TRACING FOR THE STRINGS 41290000
% NAMED BY S1, S2, S3, ETC. ALL OUTPUT IS TO THE STANDARD 41300000
% OUTPUT FILE, PRINT. WHENEVER ANY OF THE STRINGS IS ALTERED, 41310000
% OUTPUT OCCURS GIVING THE STATEMENT NUMBER, THE STRING NAME, AND 41320000
% THE NEW VALUE. 41330000
BEGIN SEGMENT 41340000
FOR I ~ MKS STEP 1 UNTIL SP-1 DO 41350000
BEGIN INDIRECT(I); 41360000
AA ~ PST[I]; 41370000
VALU[AA].IOUSE ~ 1; 41380000
IO[AA] ~ 0 & 3 CFILNO & 2 CIOTYPE & 1 CIOUSE; 41390000
END; 41400000
GO TO SUCCEED; 41410000
END TRACES; 41420000
% 34: TRACEF(F1,F2,F3,...) TURNS ON TRACING FOR THE FUNCTIONS 41430000
% WHOSE NAMES ARE CONTAINED IN F1, F2, F3, ETC. AFTER THIS, 41440000
% UNLESS DETACH() IS USED, EACH CALL OF ANY OF THESE FUNCTIONS 41450000
% WILL PRODUCE OUTPUT ON THE STANDARD OUTPUT FILE, PRINT, GIVING 41460000
% THE INSTRUCTION NUMBER, THE FUNCTION NAME, AND THE VALUES OF 41470000
% ALL THE PARAMETERS. 41480000
BEGIN SEGMENT 41490000
FOR I ~ MKS STEP 1 UNTIL SP-1 DO 41500000
BEGIN AA ~ PST[I]; 41510000
AB ~ VALU[AA]; 41520000
AC ~ ENTERST(AB.S,DATA[AB.R,*],AB.CH,"FCT"); 41530000
VALU[AC].IOUSE ~ 3; 41540000
IO[AC] ~ 0 & 2 CIOTYPE & 3 CFILNO & 3 CIOUSE; 41550000
END; 41560000
GO TO IF DEATH THEN FCTFAIL ELSE SUCCEED; 41570000
END TRACEF; 41580000
% 35: TRACEL(L1,L2,L3,...) TURNS ON TRACING FOR THE LABELS WHOSE 41590000
% NAMES ARE CONTAINED IN L1, L2, L3, ETC. AFTER THIS, UNLESS 41600000
% DETACH() IS USED, EACH TIME ANY OF THESE LABELS IS ENCOUNTERED, 41610000
% OUTPUT ON THE STANDARD OUTPUT FILE, PRINT, WILL OCCUR, GIVING 41620000
% THE LABEL AND THE NUMBER OF TIMES IS HAS BEEN ENCOUNTERED SO 41630000
% FAR DURING THE PROGRAM"S EXECUTION. 41640000
BEGIN SEGMENT 41650000
FOR I ~ MKS STEP 1 UNTIL SP-1 DO 41660000
BEGIN AA ~ PST[I]; 41670000
AB ~ VALU[AA]; 41680000
AC ~ ENTERST(AB.S,DATA[AB.R,*],AB.CH,"INST"); 41690000
VALU[AC].OUTUSE ~ 1; 41700000
IO[AC] ~ 0 & 2 CIOTYPE & 3 CFILNO & 1 CIOUSE; 41710000
END; 41720000
GO TO IF DEATH THEN FCTFAIL ELSE SUCCEED; 41730000
END TRACEL; 41740000
% 36: TRIM(S) RETURNS THE VALUE OF S WITH ALL TRAILING BLANKS DELETED. 41750000
BEGIN STREAM PROCEDURE TRIM(L,INC,SIZE); VALUE INC; 41760000
BEGIN LOCAL S5, S6, S7, TEMP; 41770000
LABEL TEST, RETURN; 41780000
SI ~ SIZE; SI ~ SI + 5; 41790000
DI ~ LOC S5; DI ~ DI + 7; DS ~ 1 CHR; 41800000
DI ~ LOC S6; DI ~ DI + 7; DS ~ 1 CHR; 41810000
DI ~ LOC S7; DI ~ DI + 7; DS ~ 1 CHR; 41820000
SI ~ L; SI ~ SI + INC; 41830000
S5(4(32(SI ~ SI + 32))); 41840000
S6(2(SI ~ SI + 32)); 41850000
SI ~ SI + S7; 41860000
TEST: SI ~ SI - 1; 41870000
IF SC ! " " THEN GO TO RETURN; 41880000
TEMP ~ SI; 41890000
SI ~ LOC S7; SI ~ SI + 7; 41900000
IF SC = "0" THEN 41910000
BEGIN 41920000
SI ~ LOC S6; SI ~ SI + 7; 41930000
IF SC = "0" THEN 41940000
BEGIN 41950000
SI ~ LOC S5; SI ~ SI + 7; 41960000
IF SC = "0" THEN GO TO RETURN; 41970000
TALLY ~ S5; TALLY ~ TALLY + 63; S5 ~ TALLY; 41980000
END; 41990000
TALLY ~ S6; TALLY ~ TALLY + 63; S6 ~ TALLY; 42000000
END; 42010000
TALLY ~ S7; TALLY ~ TALLY + 63; S7 ~ TALLY; 42020000
SI ~ TEMP; GO TO TEST; 42030000
RETURN: DI ~ SIZE; DI ~ DI + 5; 42040000
SI ~ LOC S5; SI ~ SI + 7; DS ~ 1 CHR; 42050000
SI ~ LOC S6; SI ~ SI + 7; DS ~ 1 CHR; 42060000
SI ~ LOC S7; SI ~ SI + 7; DS ~ 1 CHR; 42070000
END TRIM; 42080000
IF SP { MKS THEN GO TO SUCCEED; 42090000
AC ~ PST[MKS]; 42100000
AA ~ VALU[AC]; 42110000
AB ~ AA.S; 42120000
TRIM(FIRSTCHAR(AA),AB); 42130000
AC ~ TEMPCELL; 42140000
AB ~ STRING(AB,AC); 42150000
VALU[AC] ~ AB; 42160000
MOVE(AB.S,FIRSTCHAR(AA),FIRSTCHAR(AB)); 42170000
RETURNVAL ~ AC; 42180000
GO TO SUCCEED; 42190000
END LTRIM; 42200000
% 37: UNANCH() 42210000
BEGIN PTYPE[0] ~ 2; 42220000
PSIZE[0] ~ 0; 42230000
GO TO SUCCEED; 42240000
END UNANCH; 42250000
% 38: UNEQL(A,B) 42260000
BEGIN SEGMENT 42270000
IF SP-MKS < 2 THEN IF NOT NULLARGS(2-SP+MKS) THEN GO TO FCTFAIL; 42280000
AB ~ PST[MKS]; 42290000
AC ~ PST[MKS+1]; 42300000
AB ~ VALU[AB]; 42310000
AC ~ VALU[AC]; 42320000
GO TO IF AB.S ! AC.S 42330000
THEN SUCCEED 42340000
ELSE IF EQUAL(AB.S,FIRSTCHAR(AB),FIRSTCHAR(AC)) 42350000
THEN FCTFAIL 42360000
ELSE SUCCEED; 42370000
END LUNEQL; 42380000
% 39: WAIT(T) SETS THE WAITING TIME FOR TELETYPE I/O TO T SECONDS. 42390000
% IF T IS NON-NUMERIC OR < 0, WAIT(T) FAILS. 42400000
BEGIN SEGMENT 42410000
RETURNVAL ~ TEMPVAL(WAITTIME/60); % RETURN PREVIOUS WAITTIME. 42420000
IF SP > MKS THEN IF VALU[PST[MKS]].S > 0 THEN % GET NEW WAITTIME 42430000
BEGIN IF NOT NUMVAL(PST[MKS],AB) OR AB < 0 THEN GO TO FCTFAIL; 42440000
WAITTIME ~ AB | 60; 42450000
END; 42460000
GO TO SUCCEED; 42470000
END WAIT; 42480000
% 40: SUSPEND(T) SUSPENDS THE PROGRAM FOR T SECONDS. IF T IS MISSING, 42490000
% AND THERE IS A TELETYPE ATTACHED, DEBUG IS CALLED. 42500000
BEGIN LABEL NEWINST; 42510000
IF SP > MKS THEN 42520000
BEGIN IF NOT NUMVAL(PST[MKS],AA) THEN GO TO FCTFAIL; 42530000
IF AA < 0 THEN GO TO FCTFAIL; 42540000
IF AA > 0 THEN 42550000
BEGIN WHEN(AA); 42560000
GO TO SUCCEED; 42570000
END; 42580000
END; 42590000
IF NOT DATACOMF THEN FINDUSERS; 42600000
IF DATACOMF THEN 42610000
BEGIN SUSPENDREASON[0] ~ TRUE; 42620000
DEBUG(NEWINST); 42630000
END; 42640000
GO TO IF DEATH THEN FCTFAIL ELSE SUCCEED; 42650000
NEWINST: 42660000
INST[0] ~ AA & ":"[30:42:6]; % BUILD GO-TO PART 42670000
FLOC ~ 5; 42680000
ENTRY ~ 0; % SINCE INST[*] HAS BEEN ALTERED. 42690000
GO TO FCTFAIL; % TERMINATE CURRENT INSTRUCTION 42700000
END SUSPEND; 42710000
% 41: STATUS(A,I) RETURNS THE STATUS OF ATTACHED TELETYPES, AS 42720000
% GIVEN BY A, WHICH IS EITHER NULL OR A TELETYPE ADDRESS. I IS THE 42730000
% INTEGER IN THE ALGOL STATUS(S,I) FUNCTION. IF A IS NULL, THE 42740000
% STATUS OF ALL ATTACHED TELETYPES IS RETURNED. 42750000
% THE FORM OF THE STATUS FOR ONE TELETYPE IS: 42760000
% <STATUS> ::= ( <PROJ#> / <USER#> : <TU> / <BA> : <CONDITIONS> )42770000
% WHERE <PROJ#>/<USER#> IS THE USER I. D., <TU>/<BA> IS THE ADDRESS 42780000
% OF THE TELETYPE, AND <CONDITIONS> IS A STRING OF 8 0-S OR 1-S 42790000
% WITH THE FOLLOWING MEANINGS: 42800000
% 1ST = 1 IF UNIT IS READY 42810000
% 2ND = 1 IF UNIT IS READ READY 42820000
% 3RD = 1 IF UNIT IS WRITE READY 42830000
% 4TH = 1 IF WRITE IS IN PROGRESS 42840000
% 5TH = 1 IF BREAK KEY USED DURING LAST OUTPUT 42850000
% 6TH = 1 IF ABNORMAL CONDITION SENSED 42860000
% 7TH = 1 IF UNIT IS BUSY 42870000
% 8TH = 1 IF SEEK IN EFFECT ON STATION 42880000
% WHEN THE STATUS OF ALL TELETYPES IS RETURNED, THE FORM OF 42890000
% THE VALUE IS: 42900000
% <STATUS> <STATUS> <STATUS> ... <STATUS> 42910000
% I. E., THERE IS ONE <STATUS> FOR EACH ATTACHED TELETYPE. 42920000
% STATUS() FAILS IF: 42930000
% A IS NOT NULL, AND IS NOT THE ADDRESS OF AN ATTACHED TELETYPE 42940000
% A IS NULL, AND TO TELETYPES ARE ATTACHED 42950000
BEGIN 42960000
ALPHA ARRAY STTS[0:4|TTMAX]; % FOR BUILDING STATUS STRING 42970000
INTEGER ARRAY SIZE[0:TTMAX,0:3]; % HOLDS SIZES OF STATUS NUMBERS 42980000
INTEGER HIGH, LOW, N, STYPE, U; 42990000
BOOLEAN ALL; 43000000
% 43010000
FINDUSERS; 43020000
IF SP { MKS THEN ALL ~ TRUE ELSE 43030000
BEGIN % FIND UNIT OR UNITS: 43040000
AA ~ PST[MKS]; 43050000
IF VALU[AA].S = 0 THEN ALL ~ TRUE ELSE 43060000
BEGIN ALL ~ FALSE; % ONLY ONE UNIT. 43070000
IF U~TTINDEX(AA) < 0 THEN GO TO FCTFAIL; 43080000
END; 43090000
END FINDING UNITS; 43100000
IF SP { MKS+1 THEN STYPE ~ 0 ELSE 43110000
IF NOT NUMVAL(PST[MKS+1],STYPE) OR STYPE < 0 OR STYPE > 1 43120000
THEN GO TO FCTFAIL; 43130000
IF N~NUMUSERS-1 < 0 THEN GO TO FCTFAIL; 43140000
LOW ~ -1; 43150000
IF ALL THEN 43160000
BEGIN LOW ~ 0; 43170000
HIGH ~ N; 43180000
END ELSE HIGH ~ LOW ~ U; 43190000
% UPDATE STATUS WORDS IF NECESSARY: 43200000
IF STYPE > 0 THEN 43210000
FOR I ~ LOW STEP 1 UNTIL HIGH DO 43220000
STAT[I] ~ STATUS(STAT[I],STYPE); 43230000
% 43240000
% OTHER INSTALLATIONS WILL WANT TO RE-DO THE I.D. PART OF THIS FCT 43250000
% 43260000
% WRITE STATUS STRING: 43270000
WRITE(STTS[*],FSTAT,HIGH-LOW+1,FOR I ~ LOW STEP 1 UNTIL HIGH DO 43280000
[SIZE[I,0]~DIGITS(ID[I].[12:18]), % I.D. PART 43290000
ID[I].[12:18], % PROJ # % I.D. PART 43300000
SIZE[I,1]~DIGITS(ID[I].[30:18]), % I.D. PART 43310000
ID[I].[30:18], % USER # % I.D. PART 43320000
SIZE[I,2]~DIGITS(STAT[I].[9:4]), 43330000
STAT[I].[9:4], % TERMINAL UNIT 43340000
SIZE[I,3]~DIGITS(STAT[I].[14:4]), 43350000
STAT[I].[14:4], % BUFFER ADDRESS 43360000
1-STAT[I].[30:1], % READY 43370000
STAT[I].[24:1], % READ READY 43380000
STAT[I].[27:1], % WRITE READY 43390000
STAT[I].[29:1], % WRITE IN PROGRESS 43400000
STAT[I].[26:1], % BREAK KEY ON LAST INPUT 43410000
STAT[I].[23:1], % ABNORMAL CONDITION SENSED 43420000
STAT[I].[22:1], % STATION BUSY 43430000
STAT[I].[38:1]]); % SEEK IN EFFECT 43440000
% CALCULATE SIZE OF STRING: 43450000
I1 ~ 0; 43460000
FOR I ~ LOW STEP 1 UNTIL HIGH DO % CALCULATE SIZE OF STRING 43470000
BEGIN I1 ~ I1 + 14; % FOR "(/:/:)" & CONDITIONS 43480000
FOR J ~ 0 STEP 1 UNTIL 3 DO 43490000
I1 ~ I1 + SIZE[I,J]; 43500000
END; 43510000
% SET UP STRING FOR RETURN VALUE: 43520000
RETURNVAL ~ TEMPCELL; 43530000
AA ~ STRING(I1,RETURNVAL); 43540000
IF DEATH THEN GO TO FCTFAIL; 43550000
MOVE(I1,STTS[*],0,FIRSTCHAR(AA)); 43560000
VALU[RETURNVAL] ~ AA; 43570000
GO TO SUCCEED; 43580000
END STATUS; 43590000
% 42: USER(A) OR USER() HAS TWO USES. IF USED WITHOUT PARAMETER, 43600000
% IT RETURNS THE ADDRESS OF THE TELETYPE ON WHICH THE LAST TELETYPE 43610000
% I/O TOOK PLACE. IF IT HAS A PARAMETER, IT MUST BE THE ADDRESS OF 43620000
% AN ATTACHED TELETYPE; FURTHER OUTPUT WILL BE TO THIS TELETYPE, 43630000
% AND THE VALUE RETURNED WILL BE A. 43640000
BEGIN INTEGER TU, BA; 43650000
ALPHA ARRAY ADDR[0:1]; 43660000
FINDUSERS; 43670000
IF NOT DATACOMF THEN GO TO FCTFAIL; 43680000
IF SP > MKS THEN 43690000
BEGIN I1 ~ PST[MKS]; 43700000
IF VALU[I1].S ! 0 THEN 43710000
BEGIN IF I1 ~ TTINDEX(I1) < 0 THEN GO TO FCTFAIL; 43720000
USER ~ I1; 43730000
END; 43740000
END; 43750000
I2 ~ STAT[USER].[9:9]; 43760000
WRITE(ADDR[*],FTTADDR,I~DIGITS(I2.[39:4]),I2.[39:4], 43770000
J~DIGITS(I2.[44:4]),I2.[44:4]); 43780000
I ~ I + J + 1; 43790000
RETURNVAL ~ TEMPCELL; 43800000
AB ~ STRING(I,RETURNVAL); 43810000
MV(I,ADDR[*],0,FIRSTCHAR(AB)); 43820000
VALU[RETURNVAL] ~ AB; 43830000
GO TO IF DEATH THEN FCTFAIL ELSE SUCCEED; 43840000
END USER; 43850000
% 43: SEEK(U) DOES A READ SEEK ON TERMINAL UNIT U. 43860000
BEGIN SEGMENT 43870000
IF SP { MKS THEN GO TO FCTFAIL; 43880000
FINDUSERS; 43890000
IF I~TTINDEX(PST[MKS]) < 0 THEN GO TO FCTFAIL; 43900000
AA ~ STAT[I]; 43910000
SEEK(DCIN(AA)); 43920000
GO TO SUCCEED; 43930000
END SEEK; 43940000
% 44: RELEASE(A) ELIMINATES TELETYPE A FROM THE LIST OF USERS. 43950000
BEGIN SEGMENT 43960000
IF SP { MKS THEN GO TO FCTFAIL; 43970000
IF I~TTINDEX(PST[MKS]) < 0 THEN GO TO FCTFAIL; 43980000
RELEASE(STAT[I]); 43990000
FINDUSERS; 44000000
GO TO SUCCEED; 44010000
END RELEASE; 44020000
% 45: RECORD(FILE,N) SETS THE RECORD POINTER FOR THE NEXT I/O 44030000
% OPERATION ON THE FILE $FILE. FAILURE OCCURS IF: 44040000
% N NON-NUMERIC OR < 0 44050000
% $FILE NOT AN I/O STRING (NOT TELETYPE) 44060000
BEGIN SEGMENT 44070000
IF SP < MKS+2 THEN IF NOT NULLARGS(2) THEN GO TO FCTFAIL; 44080000
IF NOT NUMVAL(PST[MKS+1],I1) OR I1 < 0 THEN GO TO FCTFAIL; 44090000
INDIRECT(MKS); 44100000
AA ~ PST[MKS]; 44110000
AB ~ IO[AA]; 44120000
IF AB.IOUSE = 0 OR AB.FILNO = 0 THEN GO TO FCTFAIL; 44130000
RECORD[AB.FILNO] ~ I1; 44140000
GO TO SUCCEED; 44150000
END RECORD; 44160000
% 46: TRACE(NAME,TYPE,FILE,FCT) 44170000
GO TO UNDEFFCT; 44180000
% 47: ASSIGN(S,V) ASSIGNS THE VALUE OF V TO S. THE VALUE OF V IS 44190000
% WIPED OUT, S1E A STRICT TRANSFER OF POINTERS IS THE METHOD 44200000
% USED. LITERALS SHOULD NEVER BE USED AS PARAMETERS TO ASSIGN(). 44210000
BEGIN 44220000
IF SP{MKS OR AA~PST[MKS]=0 THEN GO TO FCTFAIL; 44230000
IF SP = MKS+1 THEN 44240000
VALU[AA].LOC ~ 1 ELSE 44250000
BEGIN 44260000
AB ~ PST[MKS+1]; 44270000
AC ~ VALU[AB]; 44280000
I ~ AC.CH - 2; 44290000
MV(2,AA,6,DATA[AC.R,I.W],I.C); 44300000
VALU[AA].LOC ~ AC; 44310000
VALU[AB].LOC ~ 1; % NECESSARY DUE TO CHECKSYMBTABL 44320000
END; 44330000
GO TO SUCCEED; 44340000
END ASSIGN; 44350000
% 48: COPY(S,N) PRODUCES N COPIES OF S. IF N IS NOT } 0, COPY FAILS. 44360000
BEGIN SEGMENT 44370000
IF SP-MKS < 2 THEN IF NOT NULLARGS(2-SP+MKS) THEN GO TO FCTFAIL; 44380000
AA ~ VALU[PST[MKS]]; 44390000
IF NOT NUMVAL(PST[MKS+1],I1) OR I1<0 THEN GO TO FCTFAIL; 44400000
RETURNVAL ~ TEMPCELL; 44410000
AC ~ STRING(I1|(J~AA.S),RETURNVAL); 44420000
IF DEATH THEN GO TO FCTFAIL; 44430000
I2 ~ AC.CH; 44440000
FOR I ~ 1 STEP 1 UNTIL I1 DO 44450000
BEGIN MOVE(J,FIRSTCHAR(AA),DATA[AC.R,I2.W],I2.C); 44460000
I2 ~ I2 + J; 44470000
END; 44480000
VALU[RETURNVAL] ~ AC; 44490000
GO TO SUCCEED; 44500000
END COPY; 44510000
% 49: SEARCH(FILE) DOES A DISK SEARCH FOR $FILE, IF $FILE IS AN I/O 44520000
% STRING TO A FILE; OTHERWISE SEARCH FAILS. FAILURE ALSO OCCURS 44530000
% IF THE FILE IS NOT PRESENT. IF IT IS PRESENT, THE VALUE IS OF 44540000
% THE FOLLOWING FORM: 44550000
% <MFID> / <FID> : <SECURITY> : <REC SIZE> : <BLCK SIZE> : 44560000
% <EOF ADDR> : <OPEN CNT> 44570000
% WHERE THE SECURITY STATUS, <SECURITY>, IS DEFINED BY: 44580000
% <SECURITY> ::= <S> <R> <W> 44590000
% <S> ::= "1" IF USER CAN ALTER SECURITY STATUS 44600000
% <R> ::= "1" IF CAN READ 44610000
% <W> ::= "1" IF CAN WRITE 44620000
BEGIN 44630000
ALPHA ARRAY ST[0:6]; 44640000
INTEGER ARRAY SIZE[1:6]; 44650000
IF SP { MKS THEN GO TO FCTFAIL; 44660000
INDIRECT(MKS); 44670000
AA ~ PST[MKS]; 44680000
IF VALU[AA].IOUSE=0 OR I~IO[AA].FILNO=0 THEN GO TO FCTFAIL; 44690000
SEARCH(IOFILE[I],ST[*]); 44700000
IF ST[0] < 0 THEN GO TO FCTFAIL; 44710000
FOR J ~ 1,2 DO 44720000
BEGIN I1 ~ SCANCHAR(" ",0,ST[J],1); 44730000
SIZE[J] ~ IF I1 > 7 THEN 7 ELSE I1; 44740000
END; 44750000
FOR J ~ 3,4 DO ST[J] ~ ST[J] | 8; % CONVERT TO CHARACTERS 44760000
FOR J ~ 3,4,5,6 DO SIZE[J] ~ DIGITS(ST[J]); 44770000
WRITE(BUFOUT[*],FDKSEARCH, 44780000
SIZE[1], SIZE[2], 44790000
ST[0].[45:1],ST[0].[46:1],ST[0].[47:1], 44800000
FOR J ~ 3,4,5,6 DO [SIZE[J],ST[J]]); 44810000
MV(SIZE[1],ST[1],1,BUFOUT[*],0); % <MFID> 44820000
MV(SIZE[2],ST[2],1,BUFOUT[*],SIZE[1]+1); % <FID> 44830000
I1 ~ 9; 44840000
FOR J ~ 1 STEP 1 UNTIL 6 DO I1 ~ I1+SIZE[J]; 44850000
RETURNVAL ~ TEMPCELL; 44860000
AA ~ STRING(I1,RETURNVAL); 44870000
MOVE(I1,BUFOUT[*],0,FIRSTCHAR(AA)); 44880000
VALU[RETURNVAL] ~ AA; 44890000
GO TO SUCCEED; 44900000
END SEARCH; 44910000
% 50: .RANF(N) PRODUCES A "RANDOM" NUMBER; 1 { .RANF(N) { N. 44920000
BEGIN DEFINE K=7557#, C=1#; 44930000
IF SP { MKS THEN GO TO FCTFAIL; 44940000
IF NOT NUMVAL(PST[MKS],I1) OR I1 { 0 THEN GO TO FCTFAIL; 44950000
RANDNO ~ REAL(BOOLEAN(RANDNO~RANDNO|K+C) AND BOOLEAN(33554431)); 44960000
RETURNVAL ~ TEMPVAL(I1|(RANDNO/33554432)+0.5); 44970000
GO TO SUCCEED; 44980000
END RANDOM FUNCTION; 44990000
% 51: CLEAR() SETS ALL VARIABLES TO NULL, AT THEIR TOP LEVEL ONLY. 45000000
BEGIN ALPHA K; 45010000
INTEGER I, J; 45020000
FOR I ~ 0 STEP 1 UNTIL SCATTERNO DO 45030000
FOR J ~ 0 STEP 1 WHILE J < SCATTERSIZE DO 45040000
BEGIN 45050000
K ~ J & I CONCSTR; 45060000
DO IF NAME[K].TYPE = 0 THEN VALU[K].LOC ~ 0 45070000
UNTIL K~NAME[K].LINK = 0; 45080000
END; 45090000
GO TO SUCCEED; 45100000
END CLEAR; 45110000
END FUNCTION CASES; 45120000
%********INTRINSIC FUNCTIONS*********** 45130000
%************************************** 45140000
GO TO UNDEFFCT; 45150000
DEFINEDFCT: % PROGRAM-DEFINED FUNCTION 45160000
BEGIN 45170000
LABEL TOODEEP, RET; 45180000
BOOLEAN FCTFAILURE; 45190000
ALPHA ARRAY 45200000
PRESERVE[0:5,0:STACKSIZE], 45210000
LVS[0:7]; 45220000
ALPHA LV, K; 45230000
% IF INFORM THEN INFORM0(5); 45240000
FCTFAILURE ~ FALSE; 45250000
MOVEWDS(30,BACKREFLAG,PRESERVE[0,16]); % INTERPRETER VARIABLES 45260000
MOVEWDS(SP,PNAME[*],PRESERVE[1,*]); 45270000
MOVEWDS(SP,PPOINT[*],PRESERVE[2,*]); 45280000
MOVEWDS(SP,PSIZE[*],PRESERVE[3,*]); 45290000
MOVEWDS(SP,PTYPE[*],PRESERVE[4,*]); 45300000
MOVEWDS(SP,PST[*],PRESERVE[5,*]); 45310000
MV(J~FCTV.S,DATA[FCTV.R,FCTV.W],FCTV.C,LVS[*],0); 45320000
% ASSIGN TO TEMPORARY LOCS: 45330000
FOR I ~ SP - 1 STEP -1 UNTIL MKS DO IF PNAME[I] THEN 45340000
BEGIN 45350000
K ~ PST[I]; 45360000
AA ~ TEMPCELL; 45370000
AB ~ STRING(VALU[K].S,AA); 45380000
K ~ VALU[K]; 45390000
VALU[AA] ~ AB; 45400000
MOVE(STRINGLOC(K),FIRSTCHAR(AB)); 45410000
PST[I] ~ AA; 45420000
END; 45430000
% PUSH PARAMS & LOC VARS AND ASSIGN VALUES: 45440000
MV(2,LVS[*],0,LV,6); 45450000
IF NOT PUSH(LV,0) THEN GO TO FCTFAIL; 45460000
IF NOT CHECKOUTUSE(LV) THEN FCTFAILURE ~ TRUE; 45470000
K ~ 2; I ~ MKS ; 45480000
J ~ J - 2; 45490000
FOR K ~ 2 STEP 2 UNTIL J DO 45500000
BEGIN 45510000
MV(2,LVS[*],K,LV,6); 45520000
IF NOT PUSH(LV,IF I<SP THEN PST[I] ELSE 0) THEN GO TO FCTFAIL; 45530000
IF NOT CHECKOUTUSE(LV) THEN FCTFAILURE ~ TRUE; 45540000
I ~ I + 1; 45550000
END; 45560000
IF FCTFAILURE THEN GO TO RET; 45570000
IF DEATH THEN DIE; 45580000
FOR I ~ 0 STEP 1 UNTIL 15 DO IF USEDST[I] THEN 45590000
BEGIN PRESERVE[0,I] ~ TEMPLIST[I]; 45600000
TEMPLIST[I] ~ 0; 45610000
END; 45620000
ENTRY ~ FCTV.LINK; 45630000
IF ENTRY = 0 THEN GO TO UNDEFFCT; 45640000
% 45650000
INTERPRETER; % CALL FUNCTION 45660000
% 45670000
MOVEWDS(30,PRESERVE[0,16],BACKREFLAG); % INTERPRETER VARIABLES 45680000
MOVEWDS(SP,PRESERVE[1,*],PNAME[*]); 45690000
MOVEWDS(SP,PRESERVE[2,*],PPOINT[*]); 45700000
MOVEWDS(SP,PRESERVE[3,*],PSIZE[*]); 45710000
MOVEWDS(SP,PRESERVE[4,*],PTYPE[*]); 45720000
MOVEWDS(SP,PRESERVE[5,*],PST[*]); 45730000
FOR I ~ 0 STEP 1 WHILE I { 15 AND USEDST[I] DO 45740000
TEMPLIST[I] ~ PRESERVE[0,I]; 45750000
MV(2,LVS[*],0,LV,6); 45760000
RETURNVAL ~ TEMPCELL; % TO SAVE VALUE RETURNED. 45770000
IF DEATH THEN GO TO FCTFAIL; 45780000
AB ~ VALTABL[LV.STR,LV.STW]; 45790000
IF AB.CH } 3 THEN % MOVE POINTER 45800000
BEGIN I ~ AB.CH - 2; 45810000
MV(2,RETURNVAL,6,DATA[AB.R,I.W],I.C); 45820000
END; 45830000
VALU[RETURNVAL] ~ AB.LOC; 45840000
% THE VALUE IS NOW IN THE TEMPORARY LOCATION; THE SYMBTABL LOC 45850000
% LV (WITH SAME NAME AS FCT) IS INVALID, BUT WILL SOON BE WIPED 45860000
% OUT BY THE CALL OF POP(LV). 45870000
RET: J ~ FCTV.S - 2; 45880000
FOR K ~ 0 STEP 2 UNTIL J DO 45890000
BEGIN MV(2,LVS[*],K,LV,6); 45900000
IF NOT POP(LV) THEN 45910000
IF PRINTMESSAGES THEN 45920000
BEGIN MESSAGEI(20,INSTNO); 45930000
MESSAGETTI(20,INSTNO); 45940000
END; 45950000
IF NOT CHECKOUTUSE(LV) THEN FCTFAILURE ~ TRUE; 45960000
END; 45970000
% IF INFORM THEN INFORM0(6); 45980000
PTYPE[MKS] ~ 1; 45990000
GO TO IF FCTFAILURE THEN FCTFAIL ELSE 46000000
IF RESULT THEN SUCCEED ELSE FCTFAIL; 46010000
TOODEEP: % FUNCTION DEPTH > MAXLEVEL 46020000
MESSAGEI(11,INSTNO); 46030000
MESSAGETTI(11,INSTNO); 46040000
DIE; 46050000
END DEFINED; 46060000
UNDEFFCT: % UNDEFINED FUNCTION CALLED 46070000
BEGIN SEGMENT 46080000
WRITE(PRINT[DBL],FBL); 46090000
WRITE(BUFOUT[*],FUNDEFFCT); 46100000
AA ~ NAME[FCT]; 46110000
MOVE(I~MIN(AA.S,100),FIRSTCHAR(AA),BUFOUT[*],29); 46120000
WRITE(PRINT[DBL],17,BUFOUT[*]); 46130000
IF DATACOMF THEN % WRITE ON TELETYPE: 46140000
BEGIN I ~ I + 29; 46150000
MV(2,CRLF,5,DCWRITE[*],0); % "{!" 46160000
MOVE(I,BUFOUT[*],2,DCWRITE[*],2); % MESSAGE 46170000
MV(3,CRLF,5,DCWRITE[I.W],I.C+2); % "{!~" 46180000
IF OUTPUT THEN; 46190000
IF DEBUGGING THEN % SUSPEND 46200000
BEGIN SUSPENDREASON[3] ~ TRUE; 46210000
DEBUG(SETGO); 46220000
FCTV ~ VALU[FCT]; % RETREIVE NEW DEF., IF ANY. 46230000
GO TO BRANCH; % TRY TO EXECUTE. 46240000
END; 46250000
END; 46260000
DIE; 46270000
END; 46280000
FCTFAIL: % FAILURE EXIT FOR FUNCTIONS 46290000
IF BOOLEAN(VALU[FCT].OUTUSE) THEN 46300000
IF TRACEFCTRETURN(FCT,FALSE) THEN; 46310000
FAIL; 46320000
SUCCEED: 46330000
PST[MKS] ~ RETURNVAL; 46340000
IF BOOLEAN(VALU[FCT].OUTUSE) THEN 46350000
IF NOT TRACEFCTRETURN(FCT,TRUE) THEN FAIL; 46360000
PNAME[MKS] ~ FALSE; 46370000
SP ~ MKS + 1; 46380000
RELATIVEPOINTER ~ 4; 46390000
GO TO PSCAN; 46400000
END FUNCTION; 46410000
%********FUNCTION*******************************************************46420000
%********LITERAL************************ 46430000
% 11: "#" LITERAL: 46440000
% 2-CHAR POINTER TO SYMB TABLE LOC. 46450000
BEGIN PTYPE[SP] ~ 1; 46460000
PST[SP] ~ TEMP.[18:12]; 46470000
PNAME[SP] ~ FALSE; 46480000
SP ~ SP + 1; 46490000
RELATIVEPOINTER ~ 3; 46500000
GO TO PSCAN; 46510000
END; 46520000
%********LITERAL************************ 46530000
%********QMARK************************* 46540000
% 12: QMARK END INST, NO GO-TO PART 46550000
BEGIN 46560000
MV(6,CONTROLPOINT+1,AA,2); 46570000
INSTNO ~ AA.[12:12]; 46580000
SLOC ~ AA.[24:12]; 46590000
FLOC ~ AA.[36:12]; 46600000
INSTRUCT ~ (NEARPOINT~NEARPOINT+7).W + INSTRUCT; 46610000
NEARPOINT ~ NEARPOINT.C; 46620000
% IF INFORM THEN CHECKSYMBTABL; 46630000
IF RULES[LEVEL].C = 7 THEN RETURNTEMPS; 46640000
GO TO INTERPRET; 46650000
END; 46660000
%********QMARK************************** 46670000
%********GO-TO************************** 46680000
% 13: ":" GO-TO 46690000
BEGIN 46700000
AA ~ AA.[18:12]; 46710000
SETGO: 46720000
% AA MUST CONTAIN THE SYMBOL TABLE ADDRESS OF THE NEXT INST. 46730000
VALU[AA].LINK ~ (AB~VALU[AA]).LINK + 1; % BUMP REFERENCE COUNT. 46740000
IF BOOLEAN(AB.OUTUSE) THEN % LABEL IS BEING TRACED: 46750000
BEGIN SEGMENT 46760000
AC ~ NAME[AA]; 46770000
I1 ~ MIN(AC.S,63); 46780000
I2 ~ I1 + 3 - I1.[46:2]; 46790000
I ~ AB.LINK + 1; 46800000
WRITE(BUFOUT[*],FTRACEL,I2,DIGITS(I),I,1,DIGITS(INSTNO),INSTNO); 46810000
MV(I1,FIRSTCHAR(AC),BUFOUT[*],3); 46820000
WRITE(PRINT,FBL); 46830000
WRITE(PRINT[NO],17,BUFOUT[*]); 46840000
END LABEL TRACING OUTPUT; 46850000
IF ENTRY ! AA THEN 46860000
BEGIN 46870000
ENTRY ~ AA; 46880000
IF I ~ AB.S < 7 THEN GO TO UNDEFINED; 46890000
IF I { 63 THEN 46900000
MV(I,FIRSTCHAR(AB),INST[*],0) ELSE 46910000
MOVE(I,FIRSTCHAR(AB),INST[*],0); 46920000
END; 46930000
MV(6,INST[*],3,AA,2); 46940000
INSTNO ~ AA.[12:12]; 46950000
SLOC ~ AA.[24:12]; 46960000
FLOC ~ AA.[36:12]; 46970000
INSTRUCT ~ RELATIVEPOINTER ~ 0; 46980000
NEARPOINT ~ 9; 46990000
% IF INFORM THEN CHECKSYMBTABL; 47000000
IF RULES[LEVEL].C = 7 THEN RETURNTEMPS; 47010000
IF DEBUGGING THEN % CHECK LABEL LIMITS 47020000
FOR I ~ 0 STEP 1 UNTIL NLABELLIMIT DO 47030000
IF ENTRY = LABELLIMIT[I] THEN 47040000
BEGIN SUSPENDREASON[2] ~ TRUE; 47050000
DEBUG(SETGO); 47060000
GO TO INTERPRET; 47070000
END; 47080000
GO TO INTERPRET; 47090000
END; 47100000
%********GO-TO************************** 47110000
;;;;;;;;;;; 47120000
%********INPUT CHECK******************** 47130000
% 25: "I" CHECK INPUT USE OF LAST ELEMENT 47140000
BEGIN AA ~ PST[SP-1]; 47150000
IF BOOLEAN(VALU[AA].INUSE) THEN IF NOT SNBLIN(AA) THEN FAIL; 47160000
RELATIVEPOINTER ~ 1; 47170000
GO TO PSCAN; 47180000
END; 47190000
%********INPUT CHECK******************** 47200000
%********ARITHMETIC********************* 47210000
% 26: "." ARITHMETIC OPERATOR 47220000
BEGIN 47230000
INTOVR ~ ARITHOVFL; 47240000
EXPOVR ~ ARITHOVFL; 47250000
CASE DOTTYPE[AA.C3] OF 47260000
BEGIN 47270000
% 0: ERROR 47280000
GO TO PERROR; 47290000
% 1: ".N" NEGATION: 47300000
BEGIN 47310000
IF (MKS~SP-1) < 0 THEN GO TO PERROR; 47320000
IF PTYPE[MKS] = -1 47330000
THEN AB ~ PST[MKS] 47340000
ELSE IF NOT NUMVAL(PST[MKS],AB) THEN GO TO NONNUMERIC; 47350000
PST[MKS] ~ -AB; 47360000
PTYPE[MKS] ~ -1; 47370000
END; 47380000
% 2: ARITHMETIC OPERATOR: 47390000
BEGIN 47400000
IF (MKS~SP-2) < 0 THEN GO TO PERROR; 47410000
IF PTYPE[MKS] = -1 47420000
THEN AB ~ PST[MKS] 47430000
ELSE IF NOT NUMVAL(PST[MKS],AB) THEN GO TO NONNUMERIC; 47440000
IF PTYPE[MKS+1] = -1 47450000
THEN AC ~ PST[MKS+1] 47460000
ELSE IF NOT NUMVAL(PST[MKS+1],AC) THEN GO TO NONNUMERIC; 47470000
IF I~AA.C3 = "+" THEN I1 ~ AB + AC ELSE 47480000
IF I = "-" THEN I1 ~ AB - AC ELSE 47490000
IF I = "|" THEN I1 ~ AB | AC ELSE 47500000
IF I = "/" THEN IF AC=0 THEN GO TO DVDZERO ELSE 47510000
CASE DIVIDEMODE OF 47520000
BEGIN 47530000
% 0: ROUND 47540000
I1 ~ AB/AC; 47550000
% 1: TRUNCATION 47560000
I1 ~ ENTIER(AB/AC); 47570000
% 2: INTEGER 47580000
IF (I1~AA~AB/AC) ! ENTIER(AA) THEN FAIL 47590000
END DIVIDE CASES ELSE 47600000
IF I = "*" THEN 47610000
IF AC = 0 THEN I1 ~ 1 ELSE 47620000
BEGIN 47630000
IF AC < 0 THEN 47640000
BEGIN AC ~ -AC; 47650000
AA ~ 1/AB; 47660000
END ELSE AA ~ AB; 47670000
FOR I ~ 1 STEP 1 UNTIL AC DO AA ~ AA | AB; 47680000
I1 ~ AA; 47690000
END ELSE 47700000
GO TO PERROR; % INVALID CHAR AFTER "." 47710000
PST[MKS] ~ I1; 47720000
PTYPE[MKS] ~ -1; 47730000
END; 47740000
% 3: ".S" CONVERT TO STRING 47750000
BEGIN 47760000
IF MKS~SP-1 < 0 OR PTYPE[MKS] ! -1 THEN 47770000
BEGIN INFORM0(9); 47780000
GO TO PERROR; 47790000
END; 47800000
PST[MKS] ~ TEMPVAL(PST[MKS]); 47810000
PTYPE[MKS] ~ 1; 47820000
PNAME[MKS] ~ FALSE; 47830000
END 47840000
END ARITH CASES; 47850000
% 47860000
SP ~ MKS + 1; 47870000
RELATIVEPOINTER ~ 2; 47880000
INTOVR ~ 0; 47890000
GO TO PSCAN; 47900000
ARITHOVFL: % INTEGER OVERFLOW IN ARITHMETIC: 47910000
IF PRINTMESSAGES THEN 47920000
BEGIN MESSAGEI(0,INSTNO); 47930000
MESSAGETTI(0,INSTNO); 47940000
END; 47950000
FAIL; 47960000
NONNUMERIC: % NON-NUMERIC ARGUMENT TO ARITHMETIC: 47970000
IF PRINTMESSAGES THEN 47980000
BEGIN MESSAGEI(17,INSTNO); 47990000
MESSAGETTI(17,INSTNO); 48000000
END; 48010000
FAIL; 48020000
DVDZERO: % DIVIDE-BY-ZERO IN ARITHMETIC 48030000
IF PRINTMESSAGES THEN 48040000
BEGIN MESSAGEI(18,INSTNO); 48050000
MESSAGETTI(18,INSTNO); 48060000
END; 48070000
FAIL; 48080000
END ARITHMETIC; 48090000
%********ARITHMETIC********************* 48100000
;; 48110000
%********GROUPING*********************** 48120000
% 29: "(" GROUPING 48130000
BEGIN 48140000
MKS ~ SP - AA.C3; 48150000
I1 ~ 0; % TO KEEP SIZE IN 48160000
FOR I ~ MKS STEP 1 UNTIL SP-1 DO 48170000
BEGIN 48180000
I ~ I; 48190000
IF PTYPE[I] ! 1 THEN 48200000
BEGIN INFORMI(1,PTYPE[I]); 48210000
SYSTEMERROR ~ TRUE; 48220000
GO TO DEAD; 48230000
END; 48240000
AA ~ PST[I]; 48250000
I1 ~ I1 + VALU[AA].S; 48260000
END; 48270000
AC ~ TEMPCELL; 48280000
VALU[AC] ~ AB ~ STRING(I1,AC); 48290000
I1 ~ AB.CH; 48300000
I2 ~ AB.R; 48310000
FOR I ~ MKS STEP 1 WHILE I<SP DO 48320000
BEGIN 48330000
I ~ I; 48340000
AA ~ PST[I]; 48350000
AA ~ VALU[AA]; 48360000
IF J~AA.S > 0 THEN 48370000
BEGIN 48380000
IF J { 63 THEN 48390000
MV(J,FIRSTCHAR(AA),DATA[I2,I1.W],I1.C) ELSE 48400000
MOVE(J,FIRSTCHAR(AA),DATA[I2,I1.W],I1.C); 48410000
I1 ~ I1 + J; 48420000
END; 48430000
END; 48440000
PST[MKS] ~ AC; 48450000
SP ~ MKS + 1; 48460000
PNAME[MKS] ~ FALSE; 48470000
RELATIVEPOINTER ~ 2; 48480000
GO TO PSCAN; 48490000
END; % GROUPING 48500000
%********GROUPING*********************** 48510000
; 48520000
%********REPLACEMENT******************** 48530000
% 31: "~" REPLACEMENT OR ASSIGNMENT 48540000
BEGIN RELATIVEPOINTER ~ 1; 48550000
IF SELFREFLAG THEN % STR REF USED AS STR VAR 48560000
BEGIN 48570000
IF PRINTMESSAGES THEN 48580000
BEGIN MESSAGEI(3,INSTNO); 48590000
MESSAGETTI(3,INSTNO); 48600000
END; 48610000
GO TO GOTO; 48620000
END; 48630000
% IF INFORM THEN INFORM0(3); 48640000
SIZE ~ (AB~VALTABL[REFI~PST[0].STR,REFJ~PST[0].STW]).S; 48650000
NOREPLACES ~ SP - 1; 48660000
% CALCULATE SIZE OF NEW STR REF: 48670000
FOR SP ~ 1 STEP 1 UNTIL NOREPLACES DO 48680000
BEGIN AA ~ PST[SP]; 48690000
I1 ~ VALU[AA].S; 48700000
RSIZE ~ RSIZE + I1; 48710000
END; 48720000
% IF NEW STR REF IS NOT LARGER THAN THE OLD, THE SAME STRING 48730000
% CAN BE USED. AB STILL POINTS TO THE STR REF. 48740000
IF RSIZE > SIZE THEN 48750000
BEGIN B1 ~ TRUE; % STR REF IN NEW STRING 48760000
AA ~ STRING(RSIZE,PST[0]); 48770000
AB ~ VALTABL[REFI,REFJ]; 48780000
END ELSE 48790000
BEGIN B1 ~ FALSE; % USE SAME STRING FOR STR REF. 48800000
IF RSIZE < SIZE THEN VALTABL[REFI,REFJ].S ~ RSIZE; 48810000
AA ~ AB; 48820000
END; 48830000
% AA POINTS TO NEW VALUE. 48840000
% AB POINTS TO OLD VALUE. 48850000
I ~ AA.R; 48860000
J ~ AB.R; 48870000
IF B1 THEN IF FRONTEND > 0 THEN 48880000
IF FRONTEND { 63 THEN 48890000
MV(FRONTEND,DATA[J,AB.W],AB.C,DATA[I,AA.W],AA.C) ELSE 48900000
MOVE(FRONTEND,DATA[J,AB.W],AB.C,DATA[I,AA.W],AA.C); 48910000
I1 ~ FRONTEND + AA.CH; % POINTER TO NEXT CHAR TO BE OVERWRITTEN. 48920000
% REWRITE MATCHED PORTION: 48930000
FOR SP ~ 1 STEP 1 UNTIL NOREPLACES DO 48940000
BEGIN AC ~ PST[SP]; 48950000
AC ~ VALU[AC]; 48960000
IF (I2~AC.S) > 0 THEN 48970000
BEGIN IF I2 { 63 THEN 48980000
MV(I2,DATA[AC.R,AC.W],AC.C,DATA[I,I1.W],I1.C) ELSE 48990000
MOVE(I2,DATA[AC.R,AC.W],AC.C,DATA[I,I1.W],I1.C); 49000000
I1 ~ I1 + I2; 49010000
END; 49020000
END; 49030000
IF REAREND > 0 THEN IF B1 OR RSIZE ! SIZE THEN 49040000
BEGIN I2 ~ AB.CH + SIZE - REAREND; 49050000
IF REAREND > 0 THEN IF REAREND { 63 THEN 49060000
MV(REAREND,DATA[J,I2.W],I2.C,DATA[I,I1.W],I1.C) ELSE 49070000
MOVE(REAREND,DATA[J,I2.W],I2.C,DATA[I,I1.W],I1.C); 49080000
END; 49090000
IF B1 THEN VALTABL[REFI,REFJ].LOC ~ AA; 49100000
IF BOOLEAN(AB.OUTUSE) THEN 49110000
IF NOT SNBLOUT(PST[0]) THEN GO TO FAILED; 49120000
GO TO GOTO; 49130000
END; 49140000
%********REPLACEMENT******************** 49150000
;;; 49160000
%********LABEL INDIRECTION************** 49170000
% 35: "L" INDIRECT TO PRODUCE LABEL 49180000
BEGIN 49190000
IF SP ! 1 THEN GO TO PERROR; 49200000
AA ~ VALU[PST[0]]; 49210000
AA ~ ENTERST (AA.S,DATA[AA.R,*],AA.CH,"INST"); 49220000
GO TO SETGO; 49230000
END; 49240000
%********LABEL INDIRECTION************** 49250000
;;;;;; 49260000
%********INDIRECTION******************** 49270000
% 42: "$" INDIRECTION 49280000
BEGIN 49290000
% IF INFORM THEN INFORM0(16); 49300000
IF (SP~SP-1) < 0 THEN 49310000
BEGIN INFORMI(23,INSTNO); 49320000
SYSTEMERROR ~ INFORM ~ TRUE; 49330000
GO TO DEAD; 49340000
END; 49350000
AB ~ PST[SP]; 49360000
FOR I ~ AA.C3 STEP -1 UNTIL 1 DO 49370000
BEGIN 49380000
AC ~ VALU[AB]; 49390000
IF BOOLEAN(AC.INUSE) THEN 49400000
BEGIN IF NOT SNBLIN(AB) THEN GO TO FAILED; 49410000
AC ~ VALU[AB]; % INPUT MAY MOVE VALUE 49420000
END; 49430000
IF PRINTMESSAGES THEN IF AC.S = 0 THEN 49440000
BEGIN MESSAGEI(19,INSTNO); 49450000
MESSAGETTI(19,INSTNO); 49460000
END; 49470000
AB ~ ENTERST(AC.S,DATA[AC.R,*],AC.CH,"SYMB"); 49480000
IF DEATH THEN GO TO DEAD; 49490000
END; 49500000
PST[SP] ~ AB; 49510000
PNAME[SP] ~ TRUE; 49520000
SP ~ SP + 1; 49530000
RELATIVEPOINTER ~ 2; 49540000
GO TO PSCAN; 49550000
END; 49560000
%********INDIRECTION******************** 49570000
%********STR VAR************************ 49580000
% 43: "*" STRING VARIABLE 49590000
BEGIN 49600000
RELATIVEPOINTER ~ 2; 49610000
VARFLAG ~ TRUE; 49620000
SP ~ SP - 1; 49630000
CASE AA.C3 OF 49640000
BEGIN 49650000
% ERROR 49660000
GO TO PERROR; 49670000
% 1: ARB VAR 49680000
BEGIN PTYPE[SP] ~ 2; 49690000
PSIZE[SP] ~ 0; 49700000
END; 49710000
% 2: BAL VAR 49720000
BEGIN PTYPE[SP] ~ 4; 49730000
PSIZE[SP] ~ 1; 49740000
END; 49750000
% 3: FIXED-LENGTH 49760000
BEGIN 49770000
% IF SIZE < 0 THEN RULE FAILS. 49780000
IF (IF PTYPE[SP] = 7 49790000
THEN I1~PST[SP] < 0 49800000
ELSE NOT NUMVAL(PST[SP],I1) OR I1<0) 49810000
THEN GO TO FIXERR; 49820000
PSIZE[SP~SP-1] ~ I1; 49830000
PTYPE[SP] ~ 3; 49840000
END 49850000
END VAR CASES; 49860000
SP ~ SP + 1; 49870000
GO TO PSCAN; 49880000
END; 49890000
%********STR VAR************************ 49900000
%********RESERVED LABEL***************** 49910000
% 44: "-" RESERVED LABEL 49920000
IF I~AA.C3 = "R" THEN 49930000
BEGIN RESULT ~ TRUE; 49940000
GO TO RETURN; 49950000
END ELSE 49960000
IF I = "F" THEN 49970000
BEGIN RESULT ~ FALSE; 49980000
GO TO RETURN; 49990000
END ELSE 50000000
IF I = "E" THEN 50010000
BEGIN RESULT ~ TRUE; 50020000
GO TO ENDTERPRET; 50030000
END; 50040000
%********RESERVED LABEL***************** 50050000
;;;; 50060000
%********GO-TO PART********************* 50070000
% 49: "/" GO-TO PART DELIMITER AFTER PATTERN 50080000
GOTO: 50090000
BEGIN 50100000
% IF INFORM THEN INFORM0(26); 50110000
NEARPOINT ~ IF SUCCESS THEN SLOC ELSE FLOC; 50120000
INSTRUCT ~ NEARPOINT.W; 50130000
NEARPOINT ~ NEARPOINT.C; 50140000
RELATIVEPOINTER ~ SP ~ 0; 50150000
INGOTOPART ~ TRUE; 50160000
GO TO PSCAN; 50170000
END; 50180000
%********GO-TO PART********************* 50190000
%********END STR REF******************** 50200000
% 50: "S" END OF STRING REFERENCE, BEFORE PATTERN 50210000
BEGIN 50220000
IF BOOLEAN(VALU[PST[0]].INUSE) THEN 50230000
IF NOT SNBLIN(PST[0]) THEN FAIL; 50240000
PTYPE[0] ~ ANCHORMODE; 50250000
PSIZE[0] ~ ANCHORSIZE; 50260000
PPOINT[0] ~ 0; 50270000
RELATIVEPOINTER ~ 1; 50280000
GO TO PSCAN; 50290000
END; 50300000
%********END STR REF******************** 50310000
;;;; 50320000
%********SYNTAX ERROR****************** 50330000
% 55: "X" SYNTAX ERROR IN ORIGINAL CODE 50340000
BEGIN MESSAGEI(1,INSTNO); 50350000
MESSAGETTI(1,INSTNO); 50360000
GO TO DEAD; 50370000
END; 50380000
%********SYNTAX ERROR******************* 50390000
;;; 50400000
%********NON-INPUT STRING*************** 50410000
% 59: "%" NON-INPUT STRING NAME 50420000
BEGIN PTYPE[SP] ~ 1; 50430000
PST[SP] ~ AA.[18:12]; 50440000
PNAME[SP] ~ TRUE; 50450000
SP ~ SP + 1; 50460000
RELATIVEPOINTER ~ 3; 50470000
GO TO PSCAN; 50480000
END; 50490000
%********NON-INPUT STRING*************** 50500000
; 50510000
%********PATTERN MATCH***************** 50520000
% 61: "=" PATERN MATCH 50530000
BEGIN 50540000
% IF SP { 1 THEN GO TO PERROR; 50550000
RELATIVEPOINTER ~ 1; 50560000
PMINLEFT[SP] ~ PTYPE[SP] ~ 0; % TO END SCAN. 50570000
NOPATTERNS ~ SP - 1; 50580000
BACKREFLAG ~ FALSE; 50590000
FOR I ~ NOPATTERNS STEP -1 UNTIL 1 DO 50600000
BEGIN 50610000
IF I1 ~ PTYPE[I] = 1 THEN 50620000
FOR J ~ I-1 STEP -1 UNTIL 0 DO 50630000
BEGIN 50640000
IF PST[I] = PST[J] 50650000
THEN IF PTYPE[J] ! 1 50660000
THEN BEGIN 50670000
PTYPE[I] ~ I1 ~ 5; 50680000
PBACK[I] ~ J; 50690000
PSIZE[I] ~ PSIZE[J]; 50700000
BACKREFLAG ~ TRUE; 50710000
GO TO MINLEF; 50720000
END; 50730000
END ELSE IF I1 { 4 THEN 50740000
IF PST[I] = PST[0] 50750000
THEN SELFREFLAG ~ TRUE; 50760000
IF I1 = 1 THEN % SET PLENGTH & LLOC FIELDS 50770000
BEGIN AB ~ PST[I]; 50780000
PSIZE[I] ~ (PLOC[I] ~ VALU[AB]).S; 50790000
END; 50800000
MINLEF: % THE MINLEFT WORD HOLDS THE MINIMUM SIZE OF THE 50810000
% REMAINDER OF THE PATTERN. 50820000
PMINLEFT[I] ~ PMINLEFT[I+1] + PSIZE[I]; 50830000
END; 50840000
REFLOC ~ (AA~VALTABL[REFI~PST[0].STR,REFJ~PST[0].STW]).CH; 50850000
SIZE ~ AA.S; 50860000
RPR ~ AA.R; 50870000
SP ~ 0; 50880000
NOBACKORBAL ~ TRUE; 50890000
NEWPOINT: 50900000
PPOINT[SP+1] ~ PPOINT[SP] + PSIZE[SP]; 50910000
NEXTPATTERN: 50920000
SP ~ SP + 1; 50930000
IF PMINLEFT[SP] + PPOINT[SP] > SIZE THEN GO TO SIZEFAILURE; 50940000
CASE PTYPE[SP] OF 50950000
BEGIN 50960000
% 0: END OF SCAN, IF AFTER LAST PATTERN ELEMENT: 50970000
GO TO IF SP > NOPATTERNS THEN SCANSUCCESS ELSE SCANERR; 50980000
% 1: CONSTANT PATTERN ELEMENT 50990000
BEGIN 51000000
AA ~ PLOC[SP]; 51010000
REFPT ~ REFLOC + PPOINT[SP]; 51020000
GO TO IF (IF (I~AA.S) { 63 THEN 51030000
EQ(I,FIRSTCHAR(AA),DATA[RPR,REFPT.W],REFPT.C) ELSE 51040000
EQUAL(I,FIRSTCHAR(AA),DATA[RPR,REFPT.W],REFPT.C)) 51050000
THEN NEWPOINT 51060000
ELSE DROPBACK; 51070000
END; 51080000
% 2: ARBITRARY STRING VARIABLE 51090000
BEGIN PPOINT[SP+1] ~ PPOINT[SP]; 51100000
GO TO NEXTPATTERN; 51110000
END; 51120000
% 3: FIXED-LENGTH STRING VARIABLE 51130000
GO TO NEWPOINT; 51140000
% 4: BALANCED STRING VARIABLE 51150000
BEGIN NOBACKORBAL ~ FALSE; 51160000
INCREASE ~ 0; 51170000
REFPT ~ REFLOC + PPOINT[SP]; 51180000
BALANCE: 51190000
COUNT ~ 0; 51200000
DO BEGIN 51210000
IF PPOINT[SP] + INCREASE~INCREASE+1 > SIZE THEN GO TO DROPBACK;51220000
IF AA~CHAR(DATA[RPR,REFPT.W],REFPT.C) = "(" THEN 51230000
COUNT ~ COUNT + 1 ELSE 51240000
IF AA = ")" THEN 51250000
COUNT ~ COUNT - 1; 51260000
REFPT ~ REFPT + 1; 51270000
END UNTIL COUNT { 0; 51280000
IF COUNT < 0 THEN GO TO DROPBACK; 51290000
PPOINT[SP+1] ~ PPOINT[SP] + PSIZE[SP]~INCREASE; 51300000
GO TO NEXTPATTERN; 51310000
END; 51320000
% 5: BACK REFERENCE: 51330000
BEGIN NOBACKORBAL ~ FALSE; 51340000
INCREASE ~ PPOINT[PBACK[SP]+1] - I1~PPOINT[PBACK[SP]]; 51350000
IF PPOINT[SP] + INCREASE > SIZE THEN GO TO SIZEFAILURE; 51360000
I1 ~ REFLOC + I1; 51370000
REFPT ~ REFLOC + PPOINT[SP]; 51380000
IF NOT EQUAL(INCREASE,DATA[RPR,I1.W],I1.C, 51390000
DATA[RPR,REFPT.W],REFPT.C) THEN GO TO DROPBACK; 51400000
PPOINT[SP+1] ~ PPOINT[SP] + INCREASE; 51410000
GO TO NEXTPATTERN; 51420000
END 51430000
END CASES; 51440000
GO TO SCANERR; 51450000
SIZEFAILURE: 51460000
IF NOBACKORBAL THEN GO TO SCANFAILURE; 51470000
DROPBACK: 51480000
DO IF (SP~SP-1) < 0 THEN GO TO SCANFAILURE 51490000
UNTIL NOT BOOLEAN(PTYPE[SP]); 51500000
% NON-EXTENDABLE IF CONSTANT, FIXED-LENGTH OR BACK-REFERENCE 51510000
% CAN ONLY BE EXTENDED FOR SIMPLE & BALANCED VARIABLES. 51520000
IF PTYPE[SP] = 2 THEN % ARBITRARY VARIABLE: 51530000
BEGIN 51540000
GO TO IF PMINLEFT[SP+1] + PPOINT[SP+1]~PPOINT[SP+1]+1 { SIZE 51550000
THEN NEXTPATTERN 51560000
ELSE SIZEFAILURE; 51570000
END ELSE % BALANCED VARIABLE: 51580000
BEGIN 51590000
REFPT ~ REFLOC + PPOINT[SP] + INCREASE~PSIZE[SP]; 51600000
GO TO BALANCE; 51610000
END; 51620000
SCANERR: 51630000
BEGIN SEGMENT 51640000
INFORMII(3,INSTNO,SP); 51650000
WRITESTACK(NOPATTERNS+1); 51660000
ABORT; 51670000
END; 51680000
SCANSUCCESS: 51690000
% IF INFORM THEN WRITESTACK(NOPATTERNS+1); 51700000
IF PTYPE[SP-1] = 2 THEN PPOINT[SP] ~ SIZE; 51710000
% ASSIGNMENT OF STRING VARIABLES: 51720000
% IF INFORM THEN INFORM0(0); 51730000
FRONTEND ~ PPOINT[1]; 51740000
REAREND ~ SIZE - PPOINT[NOPATTERNS+1]; 51750000
RSIZE ~ FRONTEND + REAREND; 51760000
IF VARFLAG THEN 51770000
BEGIN 51780000
IF SELFREFLAG THEN 51790000
BEGIN % MAKE COPY OF STR REF VALUE: 51800000
TEMPREF ~ TEMPCELL; 51810000
AA ~ STRING(SIZE,TEMPREF); 51820000
IF DEATH THEN DIE; 51830000
AB ~ VALTABL[REFI,REFJ]; 51840000
MOVE(SIZE,FIRSTCHAR(AB),FIRSTCHAR(AA)); 51850000
VALU[TEMPREF] ~ AB ~ AA; 51860000
END ELSE 51870000
BEGIN TEMPREF ~ PST[0]; 51880000
AB ~ VALU[TEMPREF]; 51890000
END; 51900000
FOR SP ~ 1 STEP 1 UNTIL NOPATTERNS DO 51910000
IF PTYPE[SP]>1 THEN IF PTYPE[SP]<5 THEN IF AC~PST[SP]!0 THEN 51920000
BEGIN 51930000
% STRING VARIABLE ASSIGNMENT: 51940000
IF (J~PPOINT[SP+1]-PPOINT[SP]) = 0 THEN 51950000
VALU[AC].S ~ 0 ELSE 51960000
BEGIN 51970000
IF (AA~VALU[AC]).S < J THEN 51980000
% NEED NEW STRING--NEW VALUE LARGER THAN OLD. 51990000
BEGIN AA ~ STRING(J,AC); 52000000
AB ~ VALU[TEMPREF]; 52010000
VALU[AC].LOC ~ AA; 52020000
END ELSE 52030000
% CAN USE OLD VALUE--NEW VALUE SHORT ENOUGH 52040000
VALU[AC].S ~ J; 52050000
I1 ~ AB.CH + PPOINT[SP]; 52060000
IF J { 63 THEN 52070000
MV(J,DATA[AB.R,I1.W],I1.C,FIRSTCHAR(AA)) ELSE 52080000
MOVE(J,DATA[AB.R,I1.W],I1.C,FIRSTCHAR(AA)); 52090000
END; 52100000
IF BOOLEAN(VALU[AC].OUTUSE) THEN IF NOT SNBLOUT(AC) THEN FAIL; 52110000
END; 52120000
END ASSIGNMENT OF STR VARS; 52130000
SP ~ 1; 52140000
GO TO PSCAN; 52150000
END; 52160000
%********PATTERN MATCH***************** 52170000
; 52180000
%********STRING NAME******************** 52190000
% 63: """ STRING NAME, WITH INPUT CHECK 52200000
BEGIN PTYPE[SP] ~ 1; 52210000
PST[SP] ~ I ~ AA.[18:12]; 52220000
IF BOOLEAN(VALU[I].INUSE) THEN IF NOT SNBLIN(I) THEN FAIL; 52230000
PNAME[SP] ~ TRUE; 52240000
SP ~ SP + 1; 52250000
RELATIVEPOINTER ~ 3; 52260000
GO TO PSCAN; 52270000
END 52280000
%********STRING NAME******************** 52290000
END PSCAN CASES; 52300000
PERROR: 52310000
BEGIN SEGMENT 52320000
INFORMI(5,INSTNO); 52330000
WRITE(PRINT,17,INST[*]); 52340000
CLEAR(BUFOUT,17); 52350000
IF INSTRUCT | 8 + NEARPOINT < 132 THEN 52360000
MV(1,QMARK,7,BUFOUT[INSTRUCT],NEARPOINT); 52370000
WRITE(PRINT,17,BUFOUT[*]); 52380000
RESULT ~ FALSE; 52390000
ABORT; 52400000
END; 52410000
FIXERR: 52420000
IF PRINTMESSAGES THEN 52430000
BEGIN SEGMENT 52440000
WRITE(PRINT,FBL); 52450000
AA ~ VALU[PST[SP]]; 52460000
WRITE(BUFOUT[*],FFIXVARSIZE,AA.S,INSTNO); 52470000
MOVE(MIN(AA.S,116),FIRSTCHAR(AA),BUFOUT[*],16); 52480000
WRITE(PRINT,17,BUFOUT[*]); 52490000
IF INFORM THEN WRITESTACK(SP); 52500000
FAIL; 52510000
END; 52520000
SCANFAILURE: 52530000
% IF INFORM THEN 52540000
% BEGIN INFORM0(8); 52550000
% WRITESTACK(NOPATTERNS+1); 52560000
% END; 52570000
FAILED: 52580000
% IF INFORM THEN INFORM0(4); 52590000
IF INGOTOPART THEN % GO-TO PART HAS FAILED--FATAL ERROR 52600000
BEGIN 52610000
MESSAGEI(2,INSTNO); 52620000
MESSAGETTI(2,INSTNO); 52630000
DIE; 52640000
END; 52650000
IF DEATH THEN DIE; 52660000
SUCCESS ~ FALSE; 52670000
GO TO GOTO; 52680000
DEAD: % FATAL ERROR HAS OCCURRED--TERMINATE PROGRAM. 52690000
% ERROR MESSAGE SHOULD ALREADY HAVE BEEN PRINTED. 52700000
BEGIN SEGMENT 52710000
IF SYSTEMERROR THEN ABORT; 52720000
IF DEBUGGING THEN % SUSPEND: 52730000
BEGIN SUSPENDREASON[3] ~ TRUE; 52740000
DEATH ~ FALSE; 52750000
DEBUG(SETGO); 52760000
END; 52770000
MESSAGETTI(13,INSTNO); 52780000
RESULT ~ FALSE; 52790000
GO TO ENDTERPRET; 52800000
END; 52810000
LIMITHIT: % SYSTEM LIMIT OF SOME SORT PASSED--PRINT ALL LIMITS. 52820000
BEGIN SEGMENT 52830000
DMPSTR ~ TRUE; 52840000
MESSAGEI(4,INSTNO); 52850000
MESSAGETTI(4,INSTNO); 52860000
IF CPULIMITEXISTS THEN 52870000
BEGIN MESSAGEI(5,CPULIMIT/60); 52880000
MESSAGETTI(5,CPULIMIT/60); 52890000
END; 52900000
IF IOLIMITEXISTS THEN 52910000
BEGIN MESSAGEI(6,IOLIMIT/60); 52920000
MESSAGETTI(6,IOLIMIT/60); 52930000
END; 52940000
IF RULELIMITEXISTS THEN 52950000
BEGIN MESSAGEI(7,RULELIMIT); 52960000
MESSAGETTI(7,RULELIMIT); 52970000
END; 52980000
RESULT ~ FALSE; 52990000
DIE; 53000000
END LIMITHIT; 53010000
UNDEFINED: % ATTEMPTED TRANSFER TO UNDEFINED LABEL. 53020000
% AA MUST CONTAIN SYMB TABLE ADDRESS OF LABEL. 53030000
BEGIN ALPHA AC, AB; 53040000
DMPSTR ~ TRUE; 53050000
WRITE(PRINT,FBL); 53060000
AB ~ NAME[AA]; 53070000
WRITE(BUFOUT[*],FUNDEFLABEL); 53080000
MOVE(I~MIN(90,AB.S),FIRSTCHAR(AB),BUFOUT[*],40); 53090000
WRITE(PRINT,17,BUFOUT[*]); 53100000
IF DATACOMF THEN % WRITE MESSAGE ON TELETYPE: 53110000
BEGIN MV(2,CRLF,5,DCWRITE[*],0); 53120000
MOVE(I~I+38,BUFOUT[*],2,DCWRITE[*],2); 53130000
MV(3,CRLF,5,DCWRITE[I.W],I.C+2); 53140000
IF OUTPUT THEN; 53150000
IF DEBUGGING THEN % SUSPEND 53160000
BEGIN SUSPENDREASON[3] ~ TRUE; 53170000
AC ~ AA; 53180000
DEBUG(SETGO); 53190000
% SEE IF LABEL DEFINED NOW: 53200000
GO TO IF VALU[AA~AC].S } 10 THEN SETGO ELSE UNDEFINED; 53210000
END; 53220000
END; 53230000
RESULT ~ FALSE; 53240000
DIE; 53250000
END; 53260000
RETURN: 53270000
% IF INFORM THEN INFORMI(10,LEVEL); % END OF THIS LEVEL. 53280000
RETURNTEMPS; 53290000
IF LEVEL~LEVEL-1 { 0 THEN % RETURN, NO FUNCTION CALLED 53300000
BEGIN MESSAGE0(22); 53310000
MESSAGETTI(14,INSTNO); 53320000
DIE; 53330000
END; 53340000
END INTERPRETER; 53350000
%********INTERPRETER****************************************************53360000
%********INTRINSIC******************************************************53370000
% GIVEN A FUNCTION NAME (S CHARS--STARTING P CHARS PAST L[0]), 53380000
% INTRINSIC RETURNS THE INDEX FOR THE BRANCH TO INTRINSIC FCTS IN THE 53390000
% INTERPRETER. IF THE FUNCTION IS NOT AN INTRINSIC, 0 IS RETURNED. 53400000
INTEGER PROCEDURE INTRINSIC(L,P,S); 53410000
VALUE P, S; 53420000
ALPHA ARRAY L[0]; 53430000
INTEGER P, S; 53440000
BEGIN LABEL FIN, NON; 53450000
ALPHA F; 53460000
INTEGER I; 53470000
BOOLEAN FX; 53480000
% 53490000
IF S > 7 OR S < 3 THEN GO TO NON; 53500000
F ~ 0; 53510000
MV(S,L[P.W],P.C,F,8-S); 53520000
FX ~ NOT BOOLEAN(F); 53530000
FOR I ~ INTRINSFCT[S,0] STEP -1 UNTIL 1 DO 53540000
IF REAL(NOT(BOOLEAN(INTRINSFCT[S,I]) EQV FX)) = TEENYNEG THEN 53550000
BEGIN INTRINSIC ~ INTRINSNDX[S,I]; 53560000
I ~ INTRINSNDX[S,I]; % FOR TRACING 53570000
GO TO FIN; 53580000
END; 53590000
NON: INTRINSIC ~ 0; 53600000
FIN: 53610000
END INTRINSIC; 53620000
%********INTRINSIC******************************************************53630000
%********LOADER*********************************************************53640000
% LOADER READS THE PROGRAM MATERIAL IN THE FILE PROGRAM, AND 53650000
% CAUSES THE PROGRAM TO BE COMPILED. INSTRUCTIONS ARE PUT INTO A 53660000
% SINGLE ARRAY ROW AND PASSED TO COMPILE. CONTROL CARDS ARE 53670000
% SIMILARLY PASSED TO PROCESSCONTROLCARD. WHEN AN END CARD IS FOUND, 53680000
% THE WORK ON THE FILE IS TERMINATED. IF THIS WAS THE GLOBAL FILE, 53690000
% COMPILATION IS COMPLETED BY INITIALIZING VARIOUS GLOBAL ITEMS, 53700000
% AND THE LOADER RETURNS TO THE CONTROL CODE AT THE END OF THE 53710000
% DECK, CAUSING THE INTERPRETER TO BE CALLED. NOTE THAT THE HIGHEST 53720000
% LEVEL OF RECURSIVE CALLS OF LOADER MAY BE USING THE TELETYPE (IF 53730000
% PROGRAMFROMREMOTE IS TRUE), IN WHICH CASE THE PROGRAM FILE IS NOT 53740000
% USED. 53750000
PROCEDURE LOADER(PROGRAM); FILE PROGRAM; 53760000
% 53770000
% 53780000
BEGIN 53790000
INTEGER 53800000
I, 53810000
J; 53820000
ALPHA ARRAY 53830000
INST[0:1022]; 53840000
LABEL 53850000
A, 53860000
CONT, 53870000
CONTROL, 53880000
EN, 53890000
EOF, 53900000
FIN, 53910000
GOTINST, 53920000
INITIALIZE, 53930000
LABELED, 53940000
LOAD, 53950000
RD, 53960000
TTLOST, 53970000
UNLABELED; 53980000
SWITCH INSTBR ~ 53990000
RD, 54000000
CONT, 54010000
CONTROL, 54020000
EN, 54030000
UNLABELED, 54040000
LABELED; 54050000
% 54060000
RD: IF DEATH THEN GO TO FIN; 54070000
INSTSIZE ~ 0; 54080000
IF PROGRAMFROMREMOTE THEN 54090000
BEGIN WRITE(DCWRITE[*],FCRLF); IF OUTPUT THEN; 54100000
IF INPUT THEN 54110000
BEGIN CLEAR(BUFOUT,10); 54120000
WHILE CHAR(DCREAD[(I1~DCSIZE-1).W],I1.C) = "#" DO 54130000
BEGIN 54140000
WRITE(DCWRITE[*],FAGAIN); 54150000
IF NOT OUTPUT THEN GO TO EOF; 54160000
IF NOT INPUT THEN GO TO EOF; 54170000
END; 54180000
MOVE(DCSIZE,DCREAD[*],0,INST[*],0); 54190000
MOVE(80-DCSIZE,BUFOUT[*],0,INST[DCSIZE.W],DCSIZE.C); 54200000
INSTSIZE ~ DCSIZE; 54210000
I ~ MAX(80,INSTSIZE); 54220000
MV(3,STOPPER,5,INST[I.W],I.C); 54230000
LST(INST); 54240000
END ELSE GO TO EOF 54250000
END DATACOMM INPUT ELSE 54260000
BEGIN 54270000
IF NOT BUFFERFULL THEN 54280000
BEGIN READ(PROGRAM,10,BUFFER[*]) [EOF]; 54290000
BUFFERFULL ~ TRUE; 54300000
END; 54310000
IF CONVERTF THEN CONVERT(BUFFER); 54320000
LST(BUFFER); 54330000
MOVE(FIELDSIZE,BUFFER[*],0,INST[*],0); 54340000
BUFFERFULL ~ FALSE; 54350000
INSTSIZE ~ FIELDSIZE; 54360000
READ(PROGRAM,10,BUFFER[*]) [EOF]; 54370000
BUFFERFULL ~ TRUE; 54380000
WHILE CHAR(BUFFER[*],0) = "." DO 54390000
BEGIN IF CONVERTF THEN CONVERT(BUFFER); 54400000
LST(BUFFER); 54410000
MV(1,BLANK,7,BUFFER[*],0); 54420000
MOVE(FIELDSIZE,BUFFER[*],0,INST[INSTSIZE.W],INSTSIZE.C); 54430000
BUFFERFULL ~ FALSE; 54440000
INSTSIZE ~ INSTSIZE + FIELDSIZE; 54450000
READ(PROGRAM,10,BUFFER[*]) [EOF]; 54460000
BUFFERFULL ~ TRUE; 54470000
END; 54480000
MV(3,STOPPER,5,INST[INSTSIZE.W],INSTSIZE.C); 54490000
END; 54500000
GOTINST: 54510000
IF SLASTLABEL = 0 THEN IF CARDTYPE(INST[*]) } 5 THEN 54520000
BEGIN 54530000
IF NOT SYMBTABLSETUP THEN INITIALIZESYMBTABL; 54540000
SLASTLABEL ~ ENTERST(SCANCHAR(" "," ",INST[*],0), 54550000
INST[*],0,"INST"); 54560000
IF INSTNUM = 0 THEN ENTRY ~ SLASTLABEL; 54570000
PTR ~ 2; 54580000
GO TO LOAD; 54590000
END; 54600000
GO TO INSTBR[CARDTYPE(INST[*])]; 54610000
SYNTAXERR(22,0); 54620000
COMMENT UNRECOGNIZED INSTRUCTION TYPE; 54630000
GO TO RD; 54640000
CONTROL: 54650000
PROCESSCONTROLCARD(INST); 54660000
GO TO RD; 54670000
CONT: 54680000
MESSAGE0(15); 54690000
MESSAGETT0(15); 54700000
COMMENT ILLEGAL CONTINUATION--IGNORED; 54710000
GO TO RD; 54720000
LABELED: 54730000
I ~ ENTERST(SCANCHAR(" "," ",INST[*],0),INST[*],0,"INST"); 54740000
IF NEXTSEGMENT = 0 THEN NEXTSEGMENT ~ I; 54750000
IF GTF AND GTS THEN GO TO A; 54760000
AA ~ NEXTSEGMENT & "/:"[24:36:12]; 54770000
J ~ IF GT THEN 3 ELSE 4; 54780000
STORECHARS(J,AA,8-J); 54790000
IF NOT GTS THEN 54800000
BEGIN SLOC ~ PTR - 3; 54810000
MV(2,SLOC,6,CODE[MARKER.W],MARKER.C+3); 54820000
END; 54830000
IF NOT GTF THEN 54840000
BEGIN FLOC ~ PTR - 3; 54850000
MV(2,FLOC,6,CODE[MARKER.W],MARKER.C+5); 54860000
END; 54870000
GT ~ GTS ~ GTF ~ TRUE; 54880000
A: AB ~ STRING(PTR,SLASTLABEL); 54890000
MV(2,NEXTSEGMENT,6,CODE[0],0); % FILL IN LOC OF NEXT SEGMENT. 54900000
NEXTSEGMENT ~ 0; % RESET FOR NEXT SEGMENT 54910000
MOVE(PTR,CODE[*],0,FIRSTCHAR(AB)); 54920000
VALU[SLASTLABEL].LOC ~ AB; 54930000
IF PTR > MAXINSTSIZE THEN MAXINSTSIZE ~ PTR; 54940000
% CHECK WHETHER LABEL HAS OCCURRED BEFORE: 54950000
IF (AA~VALU[I]).CH } 3 THEN 54960000
BEGIN MESSAGE0(16); 54970000
MESSAGETTI(22,INSTNUM); 54980000
MV(2,FIRSTCHAR(AA),NEXTSEGMENT,6); 54990000
MV(2,NEXTSEGMENT,6,CODE[0],0); 55000000
END ELSE CODE[0] ~ NEXTSEGMENT ~ 0; 55010000
PTR ~ 2; 55020000
SLASTLABEL ~ I; 55030000
GO TO LOAD; 55040000
UNLABELED: 55050000
IF GTS AND GTF THEN 55060000
BEGIN MESSAGE0(17); 55070000
MESSAGETTI(16,INSTNUM); 55080000
MESSAGES ~ MESSAGES + 1; 55090000
END; 55100000
LOAD: 55110000
MARKER ~ PTR; 55120000
AA ~ INSTNUM & QMARK[30:42:6]; 55130000
STORECHARS(3,AA,5); 55140000
SLOC ~ FLOC ~ 0; 55150000
STORECHARS(5,0,3); 55160000
COMPILE(INST); 55170000
INSTNUM ~ INSTNUM + 1; 55180000
GO TO RD; 55190000
EOF: 55200000
% EITHER EOF ON PROGRAM FILE OR NO INPUT FROM TELETYPE: 55210000
IF PROGRAMFROMREMOTE THEN % NO INPUT FROM TELETYPE: 55220000
BEGIN 55230000
WRITE(DCWRITE[*],FNOINPUT,QMARK); 55240000
IF NOT OUTPUT THEN GO TO TTLOST; 55250000
IF NOT INPUT THEN GO TO TTLOST; 55260000
WHILE J~CHAR(DCREAD[*],SKIPCHAR(" ",DCREAD[*],0)) = "Y" 55270000
AND J ! "N" DO 55280000
BEGIN WRITE(DCWRITE[*],FYESORNO); 55290000
IF NOT OUTPUT THEN GO TO TTLOST; 55300000
IF NOT INPUT THEN GO TO TTLOST; 55310000
END; 55320000
GO TO IF J = "Y" THEN RD ELSE TTLOST; 55330000
END; 55340000
IF LOADERLEVEL > 0 THEN % EOF FOR SUB-PROGRAM FILE 55350000
BEGIN 55360000
IF INSTSIZE > 0 THEN GO TO GOTINST; 55370000
% LAST CARD HAS BEEN COMPILED: 55380000
GO TO FIN; 55390000
END; 55400000
% EOF AT LEVEL 0: 55410000
IF INSTSIZE > 0 THEN GO TO GOTINST; 55420000
% NO CARD IN INST[*]--END CARD MISSING. 55430000
WRITE(PRINT,MESSAGE[25]); 55440000
EXECUTE ~ FALSE; 55450000
GO TO FIN; 55460000
TTLOST: 55470000
MESSAGE0(9); 55480000
EXECUTE ~ FALSE; 55490000
GO TO FIN; 55500000
EN: % END CARD ENCOUNTERED: 55510000
IF SLASTLABEL ! 0 THEN % FINISH UP LAST INSTRUCTION: 55520000
BEGIN DEFINE DUMMY=#; 55530000
IF NOT (GTF AND GTS) THEN 55540000
BEGIN I ~ IF GT THEN 3 ELSE 4; 55550000
IF NEXTSEGMENT = 0 THEN 55560000
BEGIN AA ~ "/-E"; 55570000
I ~ IF GT THEN 2 ELSE 3; 55580000
J ~ 2; 55590000
END ELSE 55600000
% PATCH--TIE TO NEXT SEGMENT 55610000
BEGIN I ~ IF GT THEN 3 ELSE 4; 55620000
AA ~ NEXTSEGMENT & "/:"[24:36:12]; 55630000
J ~ 3; 55640000
END; 55650000
STORECHARS(I,AA,8-I); 55660000
IF NOT GTS THEN 55670000
BEGIN SLOC ~ PTR - J; 55680000
MOVE(2,SLOC,6,CODE[MARKER.W],MARKER.C+3); 55690000
END; 55700000
IF NOT GTF THEN 55710000
BEGIN FLOC ~ PTR - J; 55720000
MOVE(2,FLOC,6,CODE[MARKER.W],MARKER.C+5); 55730000
END; 55740000
END; 55750000
TEMP ~ STRING(PTR,SLASTLABEL); 55760000
MOVE(PTR,CODE[*],0,FIRSTCHAR(AA)); 55770000
VALU[SLASTLABEL].LOC ~ AA; 55780000
SLASTLABEL ~ 0; 55790000
IF PTR > MAXINSTSIZE THEN MAXINSTSIZE ~ PTR; 55800000
END; 55810000
% FIND ENTRY POINT, IF ANY: 55820000
P ~ 4 + SKIPCHAR(" ",INST[*],4); 55830000
IF P < INSTSIZE THEN 55840000
BEGIN TEMP ~ P; 55850000
P ~ P + SCANCHAR(" ",QMARK,INST[P.W],P.C); 55860000
IF P > INSTSIZE THEN P ~ INSTSIZE; 55870000
ENTRY ~ ENTERST(P-TEMP,INST[*],TEMP,"INST"); 55880000
END; 55890000
INITIALIZE: IF LOADERLEVEL = 0 THEN % FINISH UP LOADING: 55900000
BEGIN ALPHA ARRAY SPECIALINST[0:1]; 55910000
IF NOT(IOEOF[2] OR PROGRAMFROMREMOTE) THEN 55920000
BEGIN MOVE(80,BUFFER[*],0,NEXTRECORD[2,*],0); 55930000
LOOKF[2] ~ TRUE; 55940000
END; 55950000
% CHECK FOR NON-EXISTENT LABELS: 55960000
IF PRINTMESSAGES THEN 55970000
FOR I ~ 0 STEP 1 UNTIL STRMAX DO 55980000
FOR J ~ 0 STEP 1 UNTIL STWMAX DO 55990000
IF (AA~NAMTABL[I,J]).[1:2] = 3 THEN 56000000
IF VALTABL[I,J].S < 9 THEN 56010000
BEGIN WRITE(BUFOUT[*],MESSAGE[50]); 56020000
MOVE(MIN(AA.S,115),FIRSTCHAR(AA),BUFOUT[*],19); 56030000
WRITE(PRINT,17,BUFOUT[*]); 56040000
END; 56050000
IF INFORM THEN INFORMA(0,ENTRY); 56060000
IF VALU[ENTRY].S { 10 THEN 56070000
BEGIN MESSAGE0(18); MESSAGETT0(18); 56080000
EXECUTE ~ FALSE; 56090000
GO TO FIN; 56100000
END CHECKING ENTRY POINT; 56110000
% 56120000
% INITIALIZATION OF SPECIAL SNOBOL IDENTIFIERS: 56130000
% 56140000
% RETURN INSTRUCTION: 56150000
I ~ ENTERST(6,WORDS[*],54,"INST"); 56160000
IF VALU[I].S = 0 THEN 56170000
BEGIN FILL SPECIALINST[*] WITH OCT0000140000000000,"0.R00000"; 56180000
SPECIALINST[0].[18:12] ~ INSTNUM; 56190000
AA ~ STRING(11,I); 56200000
MV(11,SPECIALINST[*],0,FIRSTCHAR(AA)); 56210000
VALU[I].LOC ~ AA; 56220000
END; 56230000
% 56240000
% FRETURN INSTRUCTION: 56250000
% 56260000
I ~ ENTERST(7,WORDS[*],53,"INST"); 56270000
IF VALU[I].S = 0 THEN 56280000
BEGIN FILL SPECIALINST[*] WITH OCT0000140000000000,"0.F00000"; 56290000
SPECIALINST[0].[18:12] ~ INSTNUM; 56300000
AA ~ STRING(11,I); 56310000
MV(11,SPECIALINST[*],0,FIRSTCHAR(AA)); 56320000
VALU[I].LOC ~ AA; 56330000
END; 56340000
% 56350000
% INITIALIZE QUOTE TO """ 56360000
% 56370000
I ~ ENTERST(5,WORDS[*],135,"SYMB"); 56380000
VALU[I].LOC ~ AA ~ STRING(1,I); 56390000
MOVE(1,QUOTE,7,FIRSTCHAR(AA)); 56400000
% 56410000
% INITIALIZE QMARK TO ILLEGAL CHAR 56420000
% 56430000
I ~ ENTERST(5,WORDS[*],140,"SYMB"); 56440000
VALU[I].LOC ~ AA ~ STRING(1,I); 56450000
MOVE(1,QMARK,7,FIRSTCHAR(AA)); 56460000
% 56470000
% INITIALIZE ARROW TO "~" 56480000
% 56490000
I ~ ENTERST(5,WORDS[*],145,"SYMB"); 56500000
VALU[I].LOC ~ AA ~ STRING(1,I); 56510000
MOVE(1,ARROW,7,FIRSTCHAR(AA)); 56520000
% 56530000
% THE INPUT STRING READ GIVES THE REST OF THE FILE PROGRAM. 56540000
% 56550000
I ~ ENTERST(4,WORDS[*],150,"SYMB"); 56560000
VALU[I].IOUSE ~ 2; 56570000
IO[I] ~ 0 & 2 CFILNO & 1 CIOTYPE & 2 CIOUSE; 56580000
IOUSAGE[2] ~ I & 2 CIOUSE & 1 CIOTYPE; 56590000
% 56600000
% INPUT STRING CARD IS FROM THE CARD-IMAGE FILE NAMED CARD. 56610000
% 56620000
I ~ ENTERST(4,WORDS[*],174,"SYMB"); 56630000
VALU[I].IOUSE ~ 3; 56640000
IO[I] ~ 0 & 1 CFILNO & 1 CIOTYPE & 3 CIOUSE; 56650000
IOUSAGE[1] ~ I & 3 CIOUSE & 1 CIOTYPE; 56660000
% 56670000
% PRINT IS OUTPUT TO THE LINE PRINTER FILE PRINT 56680000
% 56690000
I ~ ENTERST(5,WORDS[*],154,"SYMB"); 56700000
PRINTLOC ~ I; % SAVE VALUE FOR TRACE FUNCTION 56710000
IOSPACE[3] ~ 1; 56720000
VALU[I].IOUSE ~ 1; 56730000
IO[I] ~ 0 & 3 CFILNO & 1 CIOTYPE & 1 CIOUSE; 56740000
IOUSAGE[3] ~ I & 1 CIOUSE & 1 CIOTYPE; 56750000
% 56760000
% PUNCH IS OUTPUT TO THE CARD PUNCH 56770000
% 56780000
I ~ ENTERST(5,WORDS[*],159,"SYMB"); 56790000
VALU[I].IOUSE ~ 1; 56800000
IO[I] ~ 0 & 4 CFILNO & 1 CIOTYPE & 1 CIOUSE; 56810000
IOUSAGE[4] ~ I & 1 CIOUSE & 1 CIOTYPE; 56820000
% 56830000
% LOOK IS NON-READING INPUT FROM THE REST OF PROGRAM. 56840000
% 56850000
I ~ ENTERST(4,WORDS[*],164,"SYMB"); 56860000
VALU[I].IOUSE ~ 2; 56870000
IO[I] ~ 0 & 2 CFILNO & 2 CIOTYPE & 2 CIOUSE; 56880000
% 56890000
% SYSPOT--SEE CDC 3600 SNOBOL 56900000
% 56910000
I ~ ENTERST(6,WORDS[*],168,"SYMB"); 56920000
VALU[I].IOUSE ~ 1; 56930000
IO[I] ~ 0 & 3 CFILNO & 5 CIOTYPE & 1 CIOUSE; 56940000
% 56950000
% NEWDISK IS OUTPUT TO THE NEW DISK FILE NEWDISK 56960000
I ~ ENTERST(7,WORDS[*],178,"SYMB"); 56970000
VALU[I].IOUSE ~ 3; 56980000
IO[I] ~ 0 & 5 CFILNO & 1 CIOTYPE & 3 CIOUSE; 56990000
IOUSAGE[5] ~ I & 3 CIOUSE & 1 CIOTYPE; 57000000
% 57010000
% INITIALIZE TELETYPE I/O STRING: 57020000
% I/O ON TELETYPES IS THROUGH THE STRING TELETYPE, WHICH 57030000
% FAILS ON INPUT IF THE WAITING TIME IS EXCEEDED, AND FAILS 57040000
% ON OUTPUT IF THE WAITING TIME IS EXCEEDED OR IF THE 57050000
% BREAK KEY IS USED. 57060000
I ~ ENTERST(8,WORDS[*],96,"SYMB"); 57070000
VALU[I].IOUSE ~ 3; 57080000
IO[I] ~ 0 & 0 CFILNO & 3 CIOTYPE & 3 CIOUSE; 57090000
% 57100000
FILL IOSIZE[*] WITH 80,80,132,80,80; 57110000
FILL RECORD[*] WITH -1,-1,-1,-1,-1,-1,-1,-1,-1; 57120000
END; 57130000
FIN: 57140000
IF DEATH THEN EXECUTE ~ FALSE; 57150000
END LOADER; 57160000
%********LOADER*********************************************************57170000
%********LOADLIBRARY****************************************************57180000
% THIS PROCEDURE LOADS A LIBRARY ("OBJECT") FILE CREATED BY A -LIBRARY 57190000
% CARD DURING AN EARLIER RUN. 57200000
PROCEDURE LOADLIBRARY(MFID,FID); 57210000
VALUE MFID, FID; 57220000
ALPHA MFID, FID; 57230000
BEGIN INTEGER I, J; 57240000
REAL L1, L2, L3; 57250000
BOOLEAN B1, B2, B3; 57260000
ALPHA ARRAY X[0:7]; 57270000
MONITOR INDEX; 57280000
LABEL FAIL, FIN; 57290000
FILE IN LIB DISK SERIAL (15,6,60); 57300000
% 57310000
INDEX ~ FAIL; 57320000
FILL LIB WITH MFID, FID; 57330000
SEARCH(LIB,X[*]); 57340000
IF X[0] { 0 THEN 57350000
BEGIN MESSAGE0(11); 57360000
MESSAGETT0(11); 57370000
GO TO FIN; 57380000
END; 57390000
READ(LIB,4,BUFOUT[*]) [FAIL:FAIL]; 57400000
WRITE(X[*],FLIB0,ENTIER(VERSION)); 57410000
% TEST VALIDITY OF FILE--SHOULD MATCH FLIB0: 57420000
IF NOT EQ(32,BUFOUT[*],0,X[*],0) THEN % NOT A VALID LIBE FILE 57430000
BEGIN IF EQ(20,BUFOUT[*],0,X[*],0) THEN % CREATED BY EARLIER VERSION57440000
BEGIN WRITE(PRINT,FLIBOLDLP); 57450000
WRITE(DCWRITE[*],FLIBOLDTT); 57460000
IF DATACOMF THEN IF OUTPUT THEN; 57470000
END; 57480000
GO TO FIN; 57490000
END; 57500000
READ(LIB,FLIB1,SCATTERNO,MAXINSTSIZE,B1,L1,B2,L2,B3,L3) [FAIL:FAIL]; 57510000
IF SCATTERNO > 15 OR MAXINSTSIZE > 8181 THEN GO TO FAIL; 57520000
IF B1 THEN BEGIN CPULIMITEXISTS~TRUE; CPULIMIT~L1; END; 57530000
IF B2 THEN BEGIN IOLIMITEXISTS~TRUE; IOLIMIT~L2; END; 57540000
IF B3 THEN BEGIN RULELIMITEXISTS~TRUE; RULELIMIT~L3; END; 57550000
READ(LIB,FLIB2,ENTRY,FOR I~0 STEP 1 UNTIL 15 DO USEDST[I],INSTNUM) 57560000
[FAIL:FAIL]; 57570000
IF ENTRY > 4095 THEN GO TO FAIL; 57580000
READ(LIB,FLIB3,FOR I~0 STEP 1 UNTIL 15 DO NEXTCELL[I])[FAIL:FAIL]; 57590000
FOR I ~ 0 STEP 1 UNTIL 15 DO 57600000
IF USEDST[I] THEN 57610000
FOR J ~ 0 STEP 2 UNTIL 254 DO 57620000
READ(LIB,FLIB4,NAMTABL[I,J],VALTABL[I,J],IOTABL[I,J], 57630000
NAMTABL[I,J+1],VALTABL[I,J+1],IOTABL[I,J+1])[FAIL:FAIL]; 57640000
READ(LIB,FLIB5,FOR I~0 STEP 1 UNTIL 31 DO USEDROW[I])[FAIL:FAIL]; 57650000
READ(LIB,FLIB6,FOR I~0 STEP 1 UNTIL 31 DO DPNTR[I])[FAIL:FAIL]; 57660000
FOR I ~ 0 STEP 1 UNTIL 31 DO IF DPNTR[I] > 8183 THEN GO TO FAIL; 57670000
FOR I ~ 0 STEP 1 WHILE USEDROW[I] DO 57680000
FOR J ~ 0 STEP 6 UNTIL DPNTR[I].W DO 57690000
BEGIN READ(LIB,6,X[*])[FAIL:FAIL]; 57700000
IF J < 1020 57710000
THEN MOVEWDS(6,X[*],DATA[I,J]) 57720000
ELSE MOVEWDS(3,X[*],DATA[I,J]); 57730000
END; 57740000
SYMBTABLSETUP ~ TRUE; 57750000
CHECKSYMBTABL; 57760000
GO TO FIN; 57770000
% 57780000
FAIL: MESSAGE0(5); 57790000
MESSAGETT0(5); 57800000
DEATH ~ TRUE; 57810000
FIN: 57820000
END LOADLIBRARY; 57830000
%********LOADLIBRARY****************************************************57840000
%********LST************************************************************57850000
% LST LISTS THE CARD-IMAGE IN A[*]. 57860000
PROCEDURE LST(A); 57870000
ALPHA ARRAY A[0]; 57880000
BEGIN 57890000
INTEGER I; 57900000
% 57910000
IF CARDTYPE(A[*]) } 4 57920000
THEN WRITE(BUFOUT[*],FI7,INSTNUM) 57930000
ELSE WRITE(BUFOUT[*],FBL); 57940000
FOR I ~ LISTSPACES STEP -1 UNTIL 1 DO WRITE(PRINT,FBL); 57950000
MOVE(80,A[*],0,BUFOUT[*],8); 57960000
IF LSTF THEN WRITE(PRINT,12,BUFOUT[*]); 57970000
IF PUNCHF THEN WRITE(PUNCH,10,A[*]); 57980000
IF DCLIST THEN IF DATACOMF THEN 57990000
BEGIN FOR I ~ 8 STEP -1 WHILE I } 0 AND 58000000
EQUAL(8,BLANKS,0,BUFOUT[I],0) DO; 58010000
WRITE(DCWRITE[*],FVCRLF,8|I+1); 58020000
MOVE(8|I,BUFOUT[*],0,DCWRITE[*],0); 58030000
IF OUTPUT THEN; 58040000
END; 58050000
END LST; 58060000
%********LST************************************************************58070000
%********MESSAGE PROCEDURES*********************************************58080000
PROCEDURE MESSAGE0(I); 58090000
VALUE I; INTEGER I; 58100000
BEGIN SWITCH FORMAT MSG0 ~ 58110000
("**PROGRAM SEGMENT TOO LONG--INSERT DUMMY LABEL AFTER LAST ", 58120000
"LABEL AND BEFORE THIS INSTRUCTION."), %0058130000
(//"**DEFINE FAILURE--ERROR IN LOCAL VARIABLE LIST"), %0158140000
(//"**DEFINE FAILURE--ERROR IN FIRST ARGUMENT"), %0258150000
(//"**DEFINE FAILURE--NO ( IN FIRST ARGUMENT"), %0358160000
(//"**DEFINE FAILURE--NO FIRST ARGUMENT"), %0458170000
(//"**UNABLE TO READ LIBRARY FILE"), %0558180000
(/"THE NAMES IN USE ARE:"/), %0658190000
(/"THE LABELS ARE:"/), %0758200000
(/"**DUMMY FMT--MSG0[8]"), 58210000
(//"**TELETYPE LOST--QUITTING."), %0958220000
(//"**INVALID PARAMETER."), %1058230000
("**FILE NOT AVAILABLE"), %1158240000
(/"**DUMMY FORMAT MSG0[12]"//), %1258250000
("**FUNCTION ALREADY DEFINED--FORMER VALUE LOST"), %1358260000
(//"**SYMBOL TABLE FULL"), %1458270000
("**ILLEGAL CONTINUATION CARD"), %1558280000
("**LABEL ALREADY DEFINED--FORMER VALUE LOST"), %1658290000
("**THIS STATEMENT CAN NOT BE REACHED"), %1758300000
(///"**ENTRY POINT UNDEFINED."///), %1858310000
("**MISSING QUOTE"), %1958320000
("**UNRECOGNIZED CONTROL CARD"), %2058330000
("**MISSING PARAMETER"), %2158340000
("**ATTEMPTED RETURN WITH NO FUNCTION CALLED"), %2258350000
(/"**END FORMAT--MSG0"); 58360000
WRITE(PRINT,MSG0[I]); 58370000
END MESSAGE0; 58380000
%*************************************** 58390000
PROCEDURE MESSAGEAI(I,P1,P2); 58400000
VALUE I, P1, P2; 58410000
INTEGER I, P2; 58420000
ALPHA P1; 58430000
BEGIN SWITCH FORMAT MSGAI ~ 58440000
(//"**NON-NUMERIC ARGUMENT TO .",A2,"() IN STATEMENT ",I4), 58450000
(//"**END FORMAT--MSGAI",A6,I10); 58460000
WRITE(PRINT,MSGAI[I],P1,P2); 58470000
END MESSAGEAI; 58480000
%*************************************** 58490000
PROCEDURE MESSAGEI(I,P); 58500000
VALUE I, P; 58510000
INTEGER I, P; 58520000
BEGIN SWITCH FORMAT MSGI ~ 58530000
(//"**INTEGER OVERFLOW IN STATEMENT ",I6), %0058540000
(//"**ATTEMPTED EXECUTION OF INSTRUCTION WITH SYNTAX ERROR--", 58550000
"STATEMENT ",I6), %0158560000
(//"**FAILURE OF GO-TO PART IN STATEMENT ",I6), %0258570000
(//"**ATTEMPTED REPLACEMENT WITH STRING REFERENCE USED IN STRING" 58580000
" VARIABLE--STATEMENT ",I6/X10,"REPLACEMENT NOT ATTEMPTED."//),%0358590000
(//"**PROGRAM LIMIT REACHED IN STATEMENT ",I6), %0458600000
("**CPU TIME LIMIT = ",I12," SECONDS."), %0558610000
("**I/O TIME LIMIT = ",I12," SECONDS."), %0658620000
("**RULE LIMIT = ",I12), %0758630000
(//"**ILLEGAL SECOND PARAMETER TO CLOSE IN STATEMENT ",I6), %0858640000
(//"**DEFINE FAILURE IN STATEMENT ",I6), %0958650000
(//"**DUMP REQUESTED IN STATEMENT ",I6," :"), %1058660000
(//"**FUNCTION DEPTH BEYOND SYSTEM CAPACITY IN STATEMENT ",I6), %1158670000
(//"**OUT OF SPACE IN STRING STORAGE AREA--UNABLE TO FIND ROOM FOR" 58680000
" A STRING OF ",I6," CHARACTERS."//), %1258690000
(//"**PROGRAM DIED IN STATEMENT ",I6/), %1358700000
(//"**UNABLE TO OPEN FILE IN STATEMENT ",I6,"--TOO MANY FILES ", 58710000
"ALREADY IN USE."/), %1458720000
(//"**FILE() ERROR IN STATEMENT ",I6,"--I/O TYPE (2ND PARAMETER)", 58730000
" MUST BE NULL OR START WITH ",""","I","""," OR ",""","O","""),%1558740000
(//"**FILE() ERROR IN STATEMENT ",I6,"--NUMBER OF BUFFERS (3RD ", 58750000
"PARAMETER) MUST BE NUMERIC AND } 1"), %1658760000
(//"**NON-NUMERIC ARITHMETIC OPERAND IN STATEMENT ",I6), %1758770000
(//"**DIVIDE BY ZERO IN STATEMENT ",I6), %1858780000
(//"**INDIRECT ON NULL STRING IN STATEMENT ",I6), %1958790000
(//"**PUSH-DOWN STACK OVERPOPPED AT FUNCTION RETURN IN STATEMENT ", 58800000
I6), %2058810000
(/"**FUNCTION REDEFINED IN STATEMENT ",I6), %2158820000
(/"**MAX NUMBER OF PARAMS & LOCAL VARIABLES IS ",I3), %2258830000
(//"**END FORMAT--MSGI",I10); 58840000
WRITE(PRINT,MSGI[I],P); 58850000
END MESSAGEI; 58860000
%*************************************** 58870000
PROCEDURE MESSAGETT0(I); 58880000
VALUE I; 58890000
INTEGER I; 58900000
BEGIN SWITCH FORMAT MSGT0 ~ 58910000
("{!**PROGRAM SEGMENT TOO LONG~"), %0058920000
("{!**DEFINE FAILURE--ERROR IN LOCAL VARIABLE LIST~"), %0158930000
("{!**DEFINE FAILURE--ERROR IN FIRST ARGUMENT~"), %0258940000
("{!**DEFINE FAILURE--NO ( IN FIRST ARG~"), %0358950000
("{!**DEFINE FAILURE--NO FIRST ARGUMENT~"), %0458960000
("{!BAD LIBRARY FILE{!~"), %0558970000
("{!DUMP() CALLED{!~"), %0658980000
("{!!SNOBOL WIPED OUT--SORRY{!!~"), %0758990000
("{!INTERPRETER STACK OVERFLOW--STATEMENT TOO COMPLEX{!~"), %0859000000
("{!DUMMY FMT--MSGT0[9]{!!~"), %0959010000
("{!**INVALID PARAMETER~"), %1059020000
("{!FILE NOT AVAILABLE{!~"), %1159030000
("{!DUMMY FMT MSGT0[12]--SHOW TO SYSTEM AUTHORS.{!!"), %1259040000
("{!**FUNCTION ALREADY DEFINED--FORMER VALUE LOST~"), %1359050000
("{!SYMBOL TABLE FULL{!~"), %1459060000
("{!ILLEGAL CONTINUATION CARD{!~"), %1559070000
("{!DUMMY FMT--MSGT0[16]{!!~"), %1659080000
("{!DUMMY FMT--MSGT0[17]{!!~"), %1759090000
("{!!ENTRY POINT UNDEFINED{!~"), %1859100000
("{!MISSING QUOTE{!~"), %1959110000
("{!ILLEGAL CONTROL CARD{!~"), %2059120000
("{!MISSING PARAMETER{!~"), %2159130000
("{!!END FMT MSGT0{!!~"); 59140000
IF DATACOMF THEN 59150000
BEGIN WRITE(DCWRITE[*],MSGT0[I]); 59160000
IF OUTPUT THEN; 59170000
END; 59180000
END MESSAGETT0; 59190000
%*************************************** 59200000
PROCEDURE MESSAGETTA(I,P); 59210000
VALUE I, P; 59220000
INTEGER I; 59230000
ALPHA P; 59240000
BEGIN SWITCH FORMAT MSGTA ~ 59250000
("{!EH",A1,"{!~"), %0059260000
("{!END FMT MSGTA ",A6,"{!!~"); 59270000
IF DATACOMF THEN 59280000
BEGIN WRITE(DCWRITE[*],MSGTA[I]); 59290000
IF OUTPUT THEN; 59300000
END; 59310000
END; 59320000
%*************************************** 59330000
PROCEDURE MESSAGETTAI(I,P1,P2); 59340000
VALUE I, P1, P2; 59350000
INTEGER I, P2; 59360000
ALPHA P1; 59370000
BEGIN SWITCH FORMAT MSGTAI ~ 59380000
("{!NON-NUMERIC ARGUMENT TO .",A2,"() IN STMT ",I*,"{!~"), %0059390000
("{!!END FMT MSGTAI ",I*,A6,"{!!~"); 59400000
IF DATACOMF THEN 59410000
BEGIN WRITE(DCWRITE[*],MSGTAI[I],P1,DIGITS(P2),P2); 59420000
IF OUTPUT THEN; 59430000
END; 59440000
END; 59450000
%*************************************** 59460000
PROCEDURE MESSAGETTI(I,P); 59470000
VALUE I, P; 59480000
INTEGER I, P; 59490000
BEGIN SWITCH FORMAT MSGTI ~ 59500000
("{!**INTEGER OVERFLOW IN STMT ",I*,"{!~"), %0059510000
("{!!**ATTEMPTED EXECUTION OF STMT WITH SYNTAX ERROR--", 59520000
"STMT ",I*,"{!~"), %0159530000
("{!!**GO-TO PART IN STMT ",I*," FAILED{!~"), %0259540000
("{!**ATTEMPTED REPLACEMENT WITH STRING REFERENCE USED IN STRING ", 59550000
"VARIABLE, IN STMT ",I*,"{!**REPLACEMENT NOT ATTEMPTED{!~"), %0359560000
("{!**PROGRAM LIMIT REACHED IN STATEMENT ",I*,"{!~"), %0459570000
("CPU TIME LIMIT = ",I*," SECONDS{!~"), %0559580000
("I/O TIME LIMIT = ",I*," SECONDS{!~"), %0659590000
("RULE LIMIT = ",I*,"{!~"), %0759600000
("{!ILLEGAL 2ND PARAM TO CLOSE IN STMT ",I*,"{!~"), %0859610000
("{!DEFINE FAILURE IN STATEMENT ",I*,"{!~"), %0959620000
("{!!FATAL ERROR IN STATEMENT ",I*,"{!~"), %1059630000
("{!!**FUNCTION DEPTH BEYOND SYSTEM CAPACITY IN STMT ",I*,"{!~"), %1159640000
("{!**OUT OF SPACE--UNABLE TO FIND ROOM FOR STRING OF ",I*, 59650000
" CHARACTERS{!~"), %1259660000
("{!**PROGRAM DIED IN STATEMENT ",I*,"{!!~"), %1359670000
("{!**ATTEMPTED RETURN WITH NO FUNCTION CALLED--STMT ",I*,"{!~"), %1459680000
("# ",I*,"{!~"), %1559690000
("{!STMT. ",I*," CANT BE REACHED.{!~"), %1659700000
("{!NON-NUMERIC ARITHMETIC OPERAND IN STATEMENT ",I*,"{!~"), %1759710000
("{!DIVIDE BY ZERO IN STATEMENT ",I*,"{!~"), %1859720000
("{!INDIRECT ON NULL STRING IN STMT ",I*,"{!~"), %1959730000
("{!PUSH-DOWN STACK OVERPOPPED AT FCT RETURN IN STMT ",I*,"{!~"), %2059740000
("{!**FUNCTION RE-DEFINED IN STATEMENT ",I*,"{!~"), %2159750000
("{!**LABEL RE-DEFINED IN STATEMENT ",I*,"{!~"), %2259760000
("{!!**NORMAL TERMINATION IN STATEMENT ",I*,".{!!~"), %2359770000
("{!MAX # OF PARAMS & LOC VARS IS ",I*,"{!~"), %24 59780000
("{!!END FMT MSGTI ",I*,"{!!~"); 59790000
IF DATACOMF THEN 59800000
BEGIN WRITE(DCWRITE[*],MSGTI[I],DIGITS(P),P); 59810000
IF OUTPUT THEN; 59820000
END; 59830000
END; 59840000
%********MESSAGE PROCEDURES*********************************************59850000
%********MIN************************************************************59860000
INTEGER PROCEDURE MIN(A,B); VALUE A,B; INTEGER A,B; 59870000
MIN ~ IF A { B THEN A ELSE B; 59880000
%********MIN************************************************************59890000
%********MNEMNO*********************************************************59900000
% THE STRING BETWEEN A[P.W],P.C AND THE NEXT BLANK IS SEARCHED FOR 59910000
% IN THE N-TH LIST OF MNEMONICS, AND THE APPROPRIATE INDEX IS RETURNED. 59920000
INTEGER PROCEDURE MNEMNO(N,A,P); 59930000
VALUE N; 59940000
INTEGER N, P; 59950000
ARRAY A[0]; 59960000
BEGIN LABEL FIN; 59970000
INTEGER I, J; 59980000
ALPHA AA; 59990000
IF I~SCANCHAR(" ","~",A[P.W],P.C) > 6 60000000
THEN MNEMNO ~ 0 ELSE 60010000
BEGIN AA ~ 0; 60020000
MV(I,A[P.W],P.C,AA,8-I); 60030000
AA ~ AA; 60040000
FOR J~MNEMONIC[N,0] STEP -1 UNTIL 1 DO 60050000
IF AA = MNEMONIC[N,J] THEN 60060000
BEGIN MNEMNO ~ J; 60070000
P ~ P + I; 60080000
GO TO FIN; 60090000
END; 60100000
MNEMNO ~ 0; 60110000
END; 60120000
FIN: 60130000
END MNEMNO; 60140000
%********MNEMNO*********************************************************60150000
%********NEWCELL********************************************************60160000
% NEWCELL RETURNS THE ADDRESS OF AN AVAILABLE SYMBOL TABLE CELL--USING 60170000
% ROW I IF POSSIBLE. CELLS GIVEN BY NEWCELL ARE "PERMANENT" IN THE 60180000
% SENSE THAT RETURNCELL IS NEEDED TO RETURN THEM TO AVAILABLE SPACE. 60190000
% COMPARE TEMPCELL, WHICH RETURNS A CELL THAT WILL ONLY LAST UNTIL 60200000
% THE END OF THE INSTRUCTION 60210000
ALPHA PROCEDURE NEWCELL(I); 60220000
VALUE I; INTEGER I; 60230000
BEGIN LABEL ROWFULL, RETURN; 60240000
INTEGER C; 60250000
IF NEXTCELL[I] = 0 THEN GO TO ROWFULL; 60260000
C ~ NEXTCELL[I]; 60270000
NEXTCELL[I] ~ NAME[C].LINK; 60280000
GO TO RETURN; 60290000
ROWFULL: FOR I ~ 0 STEP 1 WHILE I { 15 AND USEDST[I] DO 60300000
IF NEXTCELL[I] ! 0 THEN 60310000
BEGIN C ~ NEXTCELL[I]; 60320000
NEXTCELL[I] ~ NAME[C].LINK; 60330000
GO TO RETURN; 60340000
END; 60350000
IF I { 15 THEN 60360000
BEGIN NEWSTROW(I); 60370000
C ~ 0 & I CONCSTR; 60380000
GO TO RETURN; 60390000
END; 60400000
MESSAGE0(14); 60410000
MESSAGETT0(14); 60420000
DEATH ~ TRUE; 60430000
C ~ 0; 60440000
RETURN: 60450000
% IF NEXTCELL[I] > USEDCELL[I] THEN USEDCELL[I] ~ NEXTCELL[I]; 60460000
NAME[C] ~ 0; 60470000
VALU[C] ~ 0; 60480000
NEWCELL ~ C; 60490000
% IF INFORM THEN INFORMIA(1,I,C); 60500000
END NEWCELL; 60510000
%********NEWCELL********************************************************60520000
%********NEWSTROW*******************************************************60530000
% NEWSTROW OPENS UP ROW I OF THE SYMBOL TABLE, AND INITIALIZES AN 60540000
% AVAILABLE SPACE LIST IN THIS ROW. 60550000
PROCEDURE NEWSTROW(I); VALUE I; INTEGER I; 60560000
BEGIN INTEGER J; 60570000
NAMTABL[I,0].LINK ~ 1 & I CONCSTR; 60580000
FOR J ~ 1 STEP 1 WHILE J < STWMAX DO 60590000
NAMTABL[I,J].LINK ~ (J+1) & I CONCSTR; 60600000
USEDST[I] ~ TRUE; 60610000
NEXTCELL[I] ~ 1 & I CONCSTR; 60620000
END NEWSTROW; 60630000
%********NEWSTROW*******************************************************60640000
%********NULLARGS*******************************************************60650000
% INTERPRETER PROCEDURE: 60660000
% NULLARGS(N) PUTS N NULL STRINGS ON TOP OF THE STACK. 60670000
BOOLEAN PROCEDURE NULLARGS(N); VALUE N; INTEGER N; 60680000
BEGIN LABEL RETURN; 60690000
INTEGER I; 60700000
IF SP + N } STACKSIZE THEN 60710000
BEGIN 60720000
INFORMI(4,INSTNO); 60730000
NULLARGS ~ FALSE; 60740000
GO TO RETURN; 60750000
END; 60760000
FOR I ~ SP+N-1 STEP -1 UNTIL SP DO 60770000
PST[I] ~ PTYPE[I] ~ PSIZE[I] ~ 0; 60780000
SP ~ SP + N; 60790000
NULLARGS ~ TRUE; 60800000
RETURN: 60810000
END NULLARGS; 60820000
%********NULLARGS*******************************************************60830000
%********NUMVAL*********************************************************60840000
% INTERPRETER PROCEDURE: 60850000
% IF THE STRING VALUE OF SYMB TABLE ENTRY ST IS NON-NUMERIC, 60860000
% FALSE IS RETURNED AND VAL IS UNALTERED. IF THE STRING IS NUMERIC, 60870000
% THE VALUE OF THE STRING IS ASSIGNED TO VAL, AND TRUE IS RETURNED. 60880000
BOOLEAN PROCEDURE NUMVAL(ST,VAL); 60890000
VALUE ST; ALPHA ST; INTEGER VAL; 60900000
BEGIN BOOLEAN STREAM PROCEDURE NUMERIC(S,L,I); VALUE S,I; 60910000
BEGIN LABEL RETURN; 60920000
TALLY ~ 0; 60930000
SI ~ LOC S; SI ~ SI + 7; 60940000
IF SC = "0" THEN 60950000
BEGIN TALLY ~ 1; GO TO RETURN; END; 60960000
SI ~ L; SI ~ SI + I; 60970000
IF SC = "-" THEN 60980000
BEGIN SI ~ SI + 1; TALLY ~ S; 60990000
TALLY ~ TALLY + 63; S ~ TALLY; TALLY ~ 0; 61000000
END; 61010000
S(IF SC < "0" THEN JUMP OUT TO RETURN; 61020000
IF SC > "9" THEN JUMP OUT TO RETURN; 61030000
SI ~ SI + 1); 61040000
TALLY ~ 1; 61050000
RETURN: NUMERIC ~ TALLY; 61060000
END NUMERIC; 61070000
% 61080000
ST ~ VALU[ST]; 61090000
IF NUMERIC(STRINGLOC(ST)) THEN 61100000
BEGIN IF ST.CH < 4096 61110000
THEN READ(DATA[ST.R,*],FNUM,ST.CH,ST.S,VAL) 61120000
ELSE READ(DATA[ST.R,*],FINT,ST.W,ST.C,ST.S,VAL); 61130000
% THIS DISTINCTION IS NECESSARY BECAUSE WHEN AN "X*" FORMAT 61140000
% (AS IN FNUM) IS USED, ONLY THE LAST 12 BITS OF THE NUMBER 61150000
% ARE USED, AND A CH FIELD CONTAINS 13 BITS. ON THE OTHER 61160000
% HAND, IF "*D" IS USED (AS IN FINT), AND THE NUMBER GIVEN 61170000
% IS ZERO, AN INFINITE LOOP OCCURS, SINCE 0 IS TAKEN TO MEAN 61180000
% "REPEAT INDEFINITELY", AND THE REST OF THE FORMAT WILL NEVER 61190000
% BE REACHED. THUS, TWO CASES ARE NECESSARY. 61200000
NUMVAL ~ TRUE; 61210000
END ELSE NUMVAL ~ FALSE; 61220000
% IF INFORM THEN INFORMI(12,VAL); 61230000
END NUMVAL; 61240000
%********NUMVAL*********************************************************61250000
%********OUTPUT*********************************************************61260000
% TELETYPE OUTPUT PROCEDURE: 61270000
BOOLEAN PROCEDURE OUTPUT; 61280000
BEGIN 61290000
LABEL LOOP, NOGO, BROKE, BADNEWS, EXIT; 61300000
INTEGER CNT, Q, R, TIMEX; 61310000
BOOLEAN GPMK; 61320000
REAL S; 61330000
ARRAY TANK[0:BUFOUTSIZE-1]; 61340000
STREAM PROCEDURE STOPPER(A); 61350000
BEGIN DI~A; DI~DI+7; DS~LIT "~" END STOPPER; 61360000
BOOLEAN STREAM PROCEDURE MOVE(A,B,C); VALUE C; 61370000
BEGIN SI~A; SI~SI+C; DI~B; TALLY~0; 61380000
DCOUTCHAR(IF SC="~" THEN TALLY~1; DS~CHR); 61390000
MOVE~TALLY 61400000
END MOVE; 61410000
% IF INFORM THEN INFORMII(5,STAT[USER].[9:4],STAT[USER].[14:4]); 61420000
IF NOT DATACOMF THEN GO TO EXIT; 61430000
OUTPUT ~ TRUE; 61440000
IF BREAK THEN 61450000
BEGIN IF (BREAK~BOOLEAN(STATUS(STAT[USER],1).[26:1])) THEN 61460000
BEGIN WHEN(5); 61470000
BREAK ~ BOOLEAN(STATUS(STAT[USER],1).[26:1]); 61480000
END; 61490000
IF BREAK THEN GO TO BADNEWS; 61500000
END; 61510000
STOPPER(DCWRITE[(ANSSIZE-1).W]); 61520000
TIMEX ~ TIME(1); 61530000
LOOP: Q~CNT DIV 8; R~CNT MOD 8; 61540000
GPMK ~ MOVE(DCWRITE[Q],TANK[1],R); 61550000
MV(1,ARROW,7,TANK[4],4); 61560000
WRITE(DCOUT(STAT[USER],0),BUFOUTSIZE,TANK[*]) [NOGO:BROKE]; 61570000
IF BOOLEAN(STATUS(STAT[USER],1).[26:1]) THEN GO TO BROKE; 61580000
IF GPMK THEN GO TO EXIT; 61590000
CNT ~ CNT + DCOUTCHAR; 61600000
GO TO LOOP; 61610000
BROKE: 61620000
BREAK ~ TRUE; 61630000
OUTPUT ~ FALSE; 61640000
GO TO EXIT; 61650000
NOGO: 61660000
% SOME FIELDS IN THE STATUS WORD ARE: 61670000
% [23:1] = 1 IF ABNORMAL CONDITION SENSED BY ADAPTER. 61680000
% [24:1] = 1 IF READ READY. 61690000
% [28:1] = 1 IF BUFFER OVERFLOW (ON INPUT). 61700000
% [30:1] = 1 IF NOT READY. 61710000
S ~ STATUS(STAT[USER],0); 61720000
IF BOOLEAN(S.[30:1]) THEN GO TO BADNEWS; 61730000
IF TIME(1) - TIMEX > WAITTIME THEN GO TO BADNEWS; 61740000
IF S.[23:2]!0 OR BOOLEAN(S.[28:1]) THEN WHEN(5); 61750000
% WAIT 5 SECS IF WRITE DID NOT TIME OUT 61760000
GO TO LOOP; 61770000
BADNEWS: 61780000
OUTPUT ~ FALSE; 61790000
FINDUSERS; 61800000
EXIT: END OUTPUT; 61810000
%========== END DATA COM OUTPUT PROCEDURE ==============================61820000
%********POP************************************************************61830000
BOOLEAN PROCEDURE POP(STLOC); VALUE STLOC; ALPHA STLOC; 61840000
BEGIN ALPHA T, ST; 61850000
INTEGER I; 61860000
% IF INFORM THEN INFORMA(2,STLOC); 61870000
ST ~ VALU[STLOC].LINK; 61880000
IF ST = 0 THEN POP ~ FALSE ELSE 61890000
BEGIN VALU[STLOC] ~ T ~ VALU[ST]; 61900000
IF T.CH } 3 THEN % RESET BACK-POINTER TO SYMB TABLE. 61910000
BEGIN I ~ T.CH - 2; 61920000
MV(2,STLOC,6,DATA[T.R,I.W],I.C); 61930000
END; 61940000
VALU[STLOC].LINK ~ VALU[ST].LINK; % LINK TO NEXT CELL ON STACK. 61950000
RETURNCELL(ST); % PUT BACK ON AVSL. 61960000
POP ~ TRUE; 61970000
END; 61980000
END POP; 61990000
%********POP************************************************************62000000
%********PROCESSCONTROLCARD*********************************************62010000
% PROCESSCONTROLCARD USES CHAR, MOVECHARS, CONTROLPARAMETER. 62020000
PROCEDURE PROCESSCONTROLCARD(A); 62030000
ALPHA ARRAY A[0]; 62040000
BEGIN INTEGER I, P; 62050000
LABEL 62060000
E, % END OF PROCEDURE 62070000
ILLEGAL, % ILLEGAL CONTROL CARD 62080000
NOFILE, % FILE REFERENCED WHICH CANT BE READ 62090000
PARAMERR, % ERROR IN PARAMETER TO CONTROL CARD 62100000
PARAMMISSING; % CANT FIND A NEEDED PARAMETER TO CONTROL CARD 62110000
% 62120000
P ~ I ~ 1 + SKIPCHAR(" ",A[*],1); 62130000
DO P ~ P + 1 UNTIL P - I > 7 OR CHARTYPE[CHAR(A[*],P)] ! 3; 62140000
IF P - I > 7 THEN GO TO ILLEGAL; 62150000
AA ~ 0; 62160000
MV(P-I,A[*],I,AA,8-P+I); 62170000
FOR I ~ NUMCONTROLCARDS STEP -1 UNTIL 0 DO 62180000
IF AA = CONTROLCARD[I] THEN 62190000
BEGIN CASE I OF 62200000
%********CONTROL CARDS***************** 62210000
BEGIN GO TO ILLEGAL; 62220000
% 1: -DEBUG TURNS ON DEBUG MODE 62230000
BEGIN DEBUGGING ~ TRUE; 62240000
IF NEXTSOURCERECORD = 0 THEN NEXTSOURCERECORD ~ 1; 62250000
DEBUGRULELIMITEXISTS ~ ALIMITEXISTS ~ TRUE; 62260000
% THIS WILL CAUSE SUSPENSION AT THE FIRST INSTRUCTION. 62270000
END; 62280000
% 2: -PCC CAUSES ALL CONTROL CARDS TO BE PRINTED 62290000
PCC ~ TRUE; 62300000
% 3: -LIST CAUSES THE PROGRAM TO BE LISTED. 62310000
BEGIN IF LISTSPACES~CONTROLPARAMETER(A,P) < 0 THEN LISTSPACES ~ 0; 62320000
LSTF ~ TRUE; 62330000
END; 62340000
% 4: -UNLIST CAUSES THE LISTING TO STOP 62350000
LSTF ~ FALSE; 62360000
% 5: -PUNCH CAUSES THE PROGRAM DECK TO BE PUNCHED 62370000
PUNCHF ~ TRUE; 62380000
% 6: -EJECT EJECTS THE LINE PRINTER TO THE NEXT PAGE 62390000
BEGIN I ~ CONTROLPARAMETER(A,P); 62400000
IF I < -1 OR I > 11 THEN GO TO PARAMERR; 62410000
IF I < 1 THEN I ~ 1; 62420000
IF LSTF THEN WRITE(PRINT[I]); 62430000
END; 62440000
% 7: -SPACE <INTEGER> PRODUCES <INTEGER> BLANK LINES IN THE LISTING 62450000
BEGIN 62460000
I ~ CONTROLPARAMETER(A,P); 62470000
FOR I ~ I-1 WHILE I } 0 DO WRITE(PRINT,FBL); 62480000
END; 62490000
% 8: -WIDTH <INTEGER> SETS THE NUMBER OF CHARS IN EACH CARD IMAGE 62500000
% TO BE CONSIDERED PART OF AN INSTRUCTION; ALL CHARS AFTER THE NTH 62510000
% ARE TO BE IGNORED BY THE COMPILER. 62520000
% IF THIS CARD ISNT USED, THEN FIELDSIZE IS ASSUMED TO BE 72. 62530000
BEGIN 62540000
IF I ~ CONTROLPARAMETER(A,P) > 80 OR I < 0 62550000
THEN GO TO PARAMERR; 62560000
FIELDSIZE ~ I; 62570000
END; 62580000
% 9: -26 TURNS ON CHARACTER SET CONVERSION FROM THE 026 KEYPUNCH 62590000
BEGIN CONVERTF ~ TRUE; 62600000
CONVERTSTRINGS ~ FALSE; 62610000
END; 62620000
% 10: -3600 CAUSES CHAR SET CONVERSION AND TRANSLATION OF I/O 62630000
% STRINGS FROM CDC 3600 SNOBOL. 62640000
CONVERTF ~ CONVERTSTRINGS ~ TRUE; 62650000
% 11: -B5500 CANCELS THE EFFECT OF PREVIOUS -26 AND -3600 CARDS. 62660000
CONVERTF ~ CONVERTSTRINGS ~ FALSE; 62670000
% 12: -DEFINE A,B,C ACTS LIKE THE INTRINSIC FUNCTION DEFINE, 62680000
% BUT SETS UP THE FUNCTION AT COMPILE TIME. THIS SAVES THE SPACE 62690000
% THAT A RUN-TIME DEFINITION WOULD TAKE FOR LITERALS AND INSTRUC- 62700000
% TION CODE, PLUS THE TIME NEEDED FOR COMPILATION. 62710000
% A, B, AND C MUST BE LITERALS. 62720000
BEGIN INTEGER ARRAY ST[1:3]; 62730000
INTEGER J; 62740000
LABEL DEF1, DEFERR; 62750000
% 62760000
IF NOT SYMBTABLSETUP THEN INITIALIZESYMBTABL; 62770000
FOR J ~ 1,2,3 DO ST[J] ~ 0; 62780000
FOR J ~ 1,2,3 DO 62790000
BEGIN P ~ P + SCANCHAR(""",",",A[P.W],P.C); 62800000
IF P } INSTSIZE THEN GO TO DEF1; 62810000
IF CHAR(A[P.W],P.C) = "," THEN 62820000
BEGIN ST[J] ~ 0; 62830000
P ~ P + 1; 62840000
END ELSE 62850000
BEGIN P ~ P + 1; 62860000
I ~ P + SCANCHAR(""",QMARK,A[P.W],P.C); 62870000
IF I } INSTSIZE THEN GO TO DEFERR; 62880000
ST[J] ~ NEWCELL(0); 62890000
AA ~ STRING(I-P,ST[J]); 62900000
MOVE(I-P,A[P.W],P.C,DATA[AA.R,AA.W],AA.C); 62910000
VALU[ST[J]] ~ AA; 62920000
P ~ I + SCANCHAR(",",""",A[I.W],I.C+1) + 1; 62930000
IF CHAR(A[P.W],P.C) = "," THEN P ~ P + 1; 62940000
IF P } INSTSIZE THEN GO TO DEF1; 62950000
END; 62960000
END; 62970000
DEF1: IF NOT SNBLDEFINE(ST[1],ST[2],ST[3]) THEN GO TO PARAMERR; 62980000
FOR J ~ 1,2,3 DO IF ST[J] ! 0 THEN RETURNCELL(ST[J]); 62990000
GO TO E; 63000000
DEFERR: MESSAGE0(19); % MISSING QUOTE 63010000
MESSAGETT0(19); 63020000
END DEFINE; 63030000
% 13: -WAIT <N> SETS THE WAITING TIME FOR REMOTE I/O TO N SECONDS. 63040000
% IF N IS NOT > 0, THEN STANDARDWAITTIME IS USED. 63050000
BEGIN AA ~ CONTROLPARAMETER(A,P); 63060000
IF AA < 0 THEN GO TO PARAMERR; 63070000
WAITTIME ~ AA | 60; 63080000
END; 63090000
% 14 -LIMIT <I> LSINTEGER> PUTS A LIMIT OF <INTEGER> TO THE 63100000
% QUANTITY <I>; THIS LIMIT IS CHECKED AT THE START OF THE EXECUTION 63110000
% OF EACH INSTRUCTION. THE CURRENT VALUES OF <I> ARE: 63120000
% RULES PUTS A LIMIT TO THE NUMBER OF STATEMENTS EXECUTED. 63130000
% PROCESS PUTS A LIMIT (IN SECONDS) TO CPU TIME 63140000
% IO PUTS A LIMIT (IN SECONDS) TO I/O TIME 63150000
BEGIN LABEL LOOP; 63160000
LOOP: P ~ P + 1; 63170000
P ~ P + SKIPCHAR(" ",A[*],P); 63180000
IF P > INSTSIZE THEN GO TO PARAMERR; 63190000
I ~ SCANCHAR(" ","=",A[*],P); 63200000
IF I > INSTSIZE THEN GO TO PARAMERR; 63210000
IF I = 2 THEN 63220000
BEGIN IF EQ(2,WORDS[8],3,A[*],P) 63230000
THEN I ~ 0 ELSE GO TO LOOP; 63240000
END ELSE 63250000
IF I = 5 THEN 63260000
BEGIN IF EQ(5,WORDS[8],5,A[*],P) 63270000
THEN I ~ 1 ELSE GO TO LOOP; 63280000
END ELSE 63290000
IF I = 7 THEN 63300000
BEGIN IF EQ(7,WORDS[9],2,A[*],P) 63310000
THEN I ~ 2 ELSE GO TO LOOP; 63320000
END ELSE 63330000
GO TO LOOP; 63340000
IF (P~CONTROLPARAMETER(A,P)) < 0 THEN GO TO PARAMERR; 63350000
CASE I OF 63360000
BEGIN 63370000
BEGIN IOLIMIT ~ P | 60; 63380000
IOLIMITEXISTS ~ TRUE; 63390000
END; 63400000
BEGIN RULELIMIT ~ P; 63410000
RULELIMITEXISTS ~ TRUE; 63420000
END; 63430000
BEGIN CPULIMIT ~ P | 60; 63440000
CPULIMITEXISTS ~ TRUE; 63450000
END 63460000
END CASES; 63470000
ALIMITEXISTS ~ TRUE; 63480000
END LMT; 63490000
% 15: -SIZE <N> TELLS THE COMPILER HOW MANY SCATTER AREAS TO SET 63500000
% ASIDE IN SYMBTABL. THIS CONTROL CARD MUST APPEAR BEFORE ANY SNOBOL63510000
% INSTRUCTIONS; THE VALUE OF <N> SHOULD BE APPROXIMATELY THE NUMBER 63520000
% OF INSTRUCTIONS IN THE PROGRAM 63530000
BEGIN DEFINE DUMMY=#; 63540000
IF SYMBTABLSETUP THEN GO TO ILLEGAL; 63550000
I ~ CONTROLPARAMETER(A,P); 63560000
IF I < 0 THEN GO TO PARAMERR; 63570000
IF I < 150 THEN BEGIN SCATTERNO ~ 0; GO TO E; END; 63580000
IF I < 300 THEN BEGIN SCATTERNO ~ 1; GO TO E; END; 63590000
IF I < 475 THEN BEGIN SCATTERNO ~ 2; GO TO E; END; 63600000
IF I < 600 THEN BEGIN SCATTERNO ~ 3; GO TO E; END; 63610000
IF I < 800 THEN BEGIN SCATTERNO ~ 4; GO TO E; END; 63620000
SCATTERNO ~ 5; 63630000
END; 63640000
% 16: -SET <NAME> <LITERAL> SETS THE VARIABLE <NAME> TO 63650000
% HAVE THE INITIAL VALUE OF <LITERAL>. 63660000
BEGIN INTEGER P1, P2; 63670000
IF NOT SYMBTABLSETUP THEN INITIALIZESYMBTABL; 63680000
% FIND NAME: 63690000
I ~ P ~ P + SKIPCHAR(" ",A[*],P); 63700000
WHILE CHARTYPE[CHAR(A[P.W],P.C)] = 3 DO P ~ P + 1; 63710000
IF P } INSTSIZE OR P = I THEN GO TO PARAMMISSING; 63720000
AA ~ ENTERST(P-I,A[*],I,"SYMB"); 63730000
% FIND VALUE: 63740000
P1 ~ P + SCANCHAR(""",""",A[P.W],P.C); 63750000
IF P1 } INSTSIZE THEN GO TO PARAMMISSING; 63760000
P ~ P1 ~ P1 + 1; 63770000
WHILE P < INSTSIZE DO 63780000
BEGIN P2 ~ P + SCANCHAR(""",""",A[P.W],P.C); 63790000
IF P2 } INSTSIZE THEN % MISSING QUOTE: 63800000
BEGIN MESSAGE0(19); 63810000
MESSAGETT0(19); 63820000
GO TO E; 63830000
END; 63840000
P ~ P2 + SCANCHAR(""",""",A[P2.W],P2.C+1) + 1; 63850000
IF P < INSTSIZE THEN % SQUEEZE INSTRUCTION: 63860000
BEGIN MOVE(INSTSIZE-P-1,A[P.W],P.C+1,A[P2.W],P2.C); 63870000
INSTSIZE ~ INSTSIZE - (P - P2 + 1); 63880000
P ~ P2 + 1; 63890000
END; 63900000
END; 63910000
% P1, P2 NOW DELIMIT THE VALUE. 63920000
AB ~ STRING(P2-P1,AA); 63930000
MOVE(P2-P1,A[P1.W],P1.C,FIRSTCHAR(AB)); 63940000
VALTABL[AA.STR,AA.STW] ~ AB; 63950000
END SET; 63960000
% 17: -LIBRARY <FID>/<MFID> CREATES A LIBRARY COPY OF THE 63970000
% SNOBOL PROGRAM BEING COMPILED, WITH THE NAME <MFID>/<FID>. 63980000
% THIS LIBRARY FILE CAN BE LOADED FOR A LATER RUN WITH THE CONTROL 63990000
% CARD -LOAD <MFID>/<FID>. 64000000
BEGIN DEFINE DUMMY =#; 64010000
IF ENTRY = 0 THEN GO TO ILLEGAL; 64020000
IF LOADF THEN IF SLASTLABEL ! 0 THEN 64030000
BEGIN I ~ PTR; 64040000
IF NOT (GTS AND GTF) THEN 64050000
BEGIN 64060000
STORECHARS(IF GT THEN 2 ELSE 3,"/-E",IF GT THEN 6 ELSE 5); 64070000
IF NOT GT THEN I ~ I + 1; 64080000
IF NOT GTS THEN 64090000
BEGIN SLOC ~ I; 64100000
MV(2,SLOC,6,CODE[MARKER.W],MARKER.C+3); 64110000
END; 64120000
IF NOT GTF THEN 64130000
BEGIN FLOC ~ I; 64140000
MV(2,FLOC,6,CODE[MARKER.W],MARKER.C+5); 64150000
END; 64160000
END; 64170000
AA ~ STRING(PTR,SLASTLABEL); 64180000
MOVE(PTR,CODE[*],0,FIRSTCHAR(AA)); 64190000
VALU[SLASTLABEL].LOC ~ AA; 64200000
IF PTR > MAXINSTSIZE THEN MAXINSTSIZE ~ PTR; 64210000
PTR ~ I; 64220000
END; 64230000
P ~ P + SKIPCHAR(" ",A[*],P); 64240000
I ~ P + SCANCHAR("/"," ",A[*],P); 64250000
IF I } FIELDSIZE OR CHAR(A[I.W],I.C) ! "/" THEN GO TO PARAMERR; 64260000
AA ~ 0; 64270000
MV(7,BLANKS,1,AA,1); 64280000
AB ~ AA; 64290000
MV(MIN(7,I-P),A[P.W],P.C,AA,1); 64300000
P ~ I + 1; 64310000
I ~ P + SCANCHAR(" ",QMARK,A[P.W],P.C); 64320000
IF I { P OR I > INSTSIZE THEN GO TO PARAMERR; 64330000
MV(MIN(7,I-P),A[P.W],P.C,AB,1); 64340000
CREATELIBRARY(AA,AB); 64350000
END LIBRARY; 64360000
% 18: -LOAD <A>/<B> CAUSES THE DISK FILE <A>/<B> TO BE 64370000
% CONSIDERED A COMPILED SNOBOL PROGRAM, AND LOADED. THIS CARD 64380000
% IS ILLEGAL IF INSTRUCTIONS, -DEFINE OR -SET CARDS HAVE BEEN 64390000
% ALREADY ENCOUNTERED. IN ADDITION, ONLY ONE -LOAD CARD IS 64400000
% ACCEPTED PER JOB. 64410000
BEGIN DEFINE DUMMY=#; 64420000
IF SYMBTABLSETUP THEN GO TO ILLEGAL; 64430000
P ~ P + SKIPCHAR(" ",A[*],P); 64440000
I ~ P + SCANCHAR("/"," ",A[*],P); 64450000
IF I } INSTSIZE OR CHAR(A[I.W],I.C) ! "/" THEN GO TO PARAMERR; 64460000
AA ~ 0; 64470000
MV(7,BLANKS,1,AA,1); 64480000
AB ~ AA; 64490000
MV(MIN(7,I-P),A[P.W],P.C,AA,1); 64500000
P ~ I + 1; 64510000
I ~ P + SCANCHAR(" ",QMARK,A[P.W],P.C); 64520000
IF I { P OR I > INSTSIZE THEN GO TO PARAMERR; 64530000
MV(MIN(7,I-P),A[P.W],P.C,AB,1); 64540000
LOADLIBRARY(AA,AB); 64550000
IF DEATH THEN GO TO ENDTERPRET; 64560000
END LOAD; 64570000
% 19: -COMPILE <A>/<B> TELLS THE LOADER TO COMPILE THE DISK FILE 64580000
% <A>/<B> INTO THE PROGRAM AT THE POINT WHERE THIS CARD APPEARS. 64590000
BEGIN FILE IN PROG DISK SERIAL (1,10,30); 64600000
BOOLEAN RMT, BUFFULL; 64610000
ALPHA ARRAY BUF[0:10], X[0:6]; 64620000
INTEGER S1, S2; 64630000
ALPHA AA, AB; 64640000
% 64650000
P ~ P + SKIPCHAR(" ",A[*],P); 64660000
I ~ P + SCANCHAR("/"," ",A[*],P); 64670000
IF I } INSTSIZE OR CHAR(A[I.W],I.C) ! "/" THEN GO TO PARAMERR; 64680000
AA ~ 0; 64690000
MV(7,BLANKS,1,AA,1); 64700000
AB ~ AA; 64710000
MV(S1~MIN(7,I-P),A[P.W],P.C,AA,1); 64720000
P ~ I + 1; 64730000
I ~ P + SCANCHAR(" ",QMARK,A[P.W],P.C); 64740000
IF I { P OR I > INSTSIZE THEN GO TO PARAMERR; 64750000
MV(S2~MIN(7,I-P),A[P.W],P.C,AB,1); 64760000
FILL PROG WITH AA,AB; 64770000
SEARCH(PROG,X[*]); 64780000
IF X[0] { 0 THEN GO TO NOFILE; 64790000
IF BUFFULL~BUFFERFULL THEN MOVEWDS(10,BUFFER[0],BUF[0]); 64800000
READ(PROG,10,BUFFER[*]) [NOFILE:NOFILE]; 64810000
BUFFERFULL ~ TRUE; 64820000
LOADERLEVEL ~ LOADERLEVEL + 1; 64830000
RMT ~ PROGRAMFROMREMOTE; PROGRAMFROMREMOTE ~ FALSE; 64840000
LOADER(PROG); 64850000
WRITE(BUFOUT[*],FENDPROG); 64860000
MV(S1,AA,1,BUFOUT[*],22); 64870000
MV(1,SLASH,7,BUFOUT[*],22+S1); 64880000
MV(S2,AB,1,BUFOUT[*],23+S1); 64890000
WRITE(PRINT,5,BUFOUT[*]); 64900000
IF DATACOMF THEN 64910000
BEGIN MV(2,CRLF,5,DCWRITE[*],0); 64920000
MV(21+S1+S2,BUFOUT[*],2,DCWRITE[*],2); 64930000
MV(3,CRLF,5,DCWRITE[*],23+S1+S2); 64940000
IF OUTPUT THEN; 64950000
END; 64960000
IF BUFFERFULL~BUFFULL THEN MOVEWDS(10,BUF[0],BUFFER[0]); 64970000
LOADERLEVEL ~ LOADERLEVEL - 1; 64980000
PROGRAMFROMREMOTE ~ RMT; 64990000
END COMPILE CARD; 65000000
% 20: -INFORM TURNS ON INFORMATIVE DIAGNOSTICS. IF THE SYSTEM- 65010000
% DEBUGGING FLAG IS TRUE, THEN THE SYSTEM DEBUGGING AIDS 65020000
% ARE ENABLED. 65030000
BEGIN INFORM ~ SYSTEMDEBUGGING; 65040000
PRINTMESSAGES ~ TRUE; 65050000
END; 65060000
% 21: -SILENCE TURNS OFF DIAGNOSTIC MESSAGES TURNED ON BY -INFORM 65070000
INFORM ~ PRINTMESSAGES ~ FALSE; 65080000
END CONTROL CARDS CASE STATEMENT; 65090000
%********CONTROL CARDS***************** 65100000
GO TO E; 65110000
END; 65120000
ILLEGAL: 65130000
MESSAGE0(20); 65140000
MESSAGETT0(20); 65150000
MESSAGES ~ MESSAGES + 1; 65160000
GO TO E; 65170000
PARAMMISSING: 65180000
MESSAGE0(21); 65190000
MESSAGETT0(21); 65200000
MESSAGES ~ MESSAGES + 1; 65210000
GO TO E; 65220000
NOFILE: 65230000
MESSAGE0(11); 65240000
MESSAGETT0(11); 65250000
GO TO E; 65260000
PARAMERR: 65270000
MESSAGE0(10); 65280000
MESSAGETT0(10); 65290000
MESSAGES ~ MESSAGES + 1; 65300000
E: END PROCESSCONTROLCARD; 65310000
%********PROCESSCONTROLCARD*********************************************65320000
%********PUSH***********************************************************65330000
BOOLEAN PROCEDURE PUSH(STLOC,NEWVAL); 65340000
VALUE STLOC, NEWVAL; ALPHA STLOC, NEWVAL; 65350000
BEGIN ALPHA ST, T, T1; 65360000
INTEGER I; 65370000
LABEL RETURN; 65380000
% IF INFORM THEN INFORMA(1,STLOC); 65390000
ST ~ NEWCELL(STLOC.STR); 65400000
IF DEATH THEN 65410000
BEGIN PUSH ~ FALSE; GO TO RETURN; END; 65420000
VALU[ST] ~ T1 ~ VALU[STLOC]; 65430000
IF T1.CH } 3 THEN % IF < 3 THERE IS NO STRING BEING POINTED TO. 65440000
BEGIN I ~ T1.CH - 2; 65450000
MV(2,ST,6,DATA[T1.R,I.W],I.C); 65460000
END; 65470000
VALU[ST].LINK ~ VALU[STLOC].LINK; 65480000
VALU[STLOC] ~ 0 & T1 [1:1:4] & ST CLINK; 65490000
IF NEWVAL ! 0 THEN % ASSIGN NEW VALUE 65500000
BEGIN IF STLOC = NEWVAL % PUSH(N,N) CALLED. 65510000
THEN NEWVAL ~ ST; % RE-ASSIGN OLD VALUE. 65520000
ST ~ VALU[NEWVAL].S; 65530000
T ~ STRING(ST,STLOC); 65540000
IF DEATH THEN 65550000
BEGIN PUSH ~ FALSE; GO TO RETURN; END; 65560000
NEWVAL ~ VALU[NEWVAL]; 65570000
MOVE(ST,FIRSTCHAR(NEWVAL),FIRSTCHAR(T)); 65580000
VALU[STLOC].LOC ~ T; 65590000
END; 65600000
PUSH ~ TRUE; 65610000
RETURN: 65620000
END PUSH; 65630000
%********PUSH***********************************************************65640000
%********RETURNCELL*****************************************************65650000
PROCEDURE RETURNCELL(N); VALUE N; ALPHA N; 65660000
BEGIN DEFINE DUMMY=#; 65670000
% IF INFORM THEN INFORMA(3,N); 65680000
NAME[N] ~ 0 & NEXTCELL[N.STR] CLINK; 65690000
VALU[N] ~ 0; 65700000
NEXTCELL[N.STR] ~ N; 65710000
END RETURNCELL; 65720000
%********RETURNCELL*****************************************************65730000
%********RETURNTEMP*****************************************************65740000
PROCEDURE RETURNTEMPS; 65750000
BEGIN INTEGER I; ALPHA ST,P; 65760000
% IF INFORM THEN INFORM0(7); 65770000
FOR I ~ 0 STEP 1 UNTIL 15 DO IF USEDST[I] THEN 65780000
IF TEMPLIST[I] ! 0 THEN 65790000
BEGIN ST ~ TEMPLIST[I]; 65800000
P ~ NEXTCELL[I]; 65810000
TEMPLIST[I] ~ 0; 65820000
NEXTCELL[I] ~ NAME[ST].LINK; 65830000
NAME[ST] ~ 0 & P CLINK; 65840000
END; 65850000
END RETURNTEMPS; 65860000
%********RETURNTEMP*****************************************************65870000
%********SCATTER********************************************************65880000
ALPHA PROCEDURE SCATTER(SIZE,LOC,P,X); 65890000
VALUE SIZE, P, X; 65900000
INTEGER SIZE, P; 65910000
ALPHA ARRAY LOC[0]; 65920000
ALPHA X; 65930000
BEGIN ALPHA I, J, K; 65940000
J ~ IF SIZE = 0 THEN 1/X ELSE SIZE/X; 65950000
FOR I ~ 1 STEP 1 UNTIL SIZE DO 65960000
J ~ J + X / (I + CHAR(LOC[(K~P+I-1).W],K.C)); 65970000
K ~ J.[8:30]; 65980000
I.STR ~ ENTIER(K MOD (SCATTERNO+1)); 65990000
J.[1:9] ~ 0; 66000000
% LITERALS ARE SCATTERED INTO A DIFFERENT AREA THAN OTHER QUANTITIES: 66010000
I.STW ~ IF X = "LIT" 66020000
THEN SCATTERSIZE + ENTIER(J MOD 16) 66030000
ELSE ENTIER(J MOD SCATTERSIZE); 66040000
IF I = 0 THEN I ~ 1; 66050000
SCATTER ~ I; 66060000
END SCATTER; 66070000
%********SCATTER********************************************************66080000
%********SEARCHST*******************************************************66090000
ALPHA PROCEDURE SEARCHST(N,L,P,X); 66100000
VALUE N, P, X; 66110000
INTEGER N, P; 66120000
ALPHA ARRAY L[0]; 66130000
ALPHA X; 66140000
BEGIN ALPHA J, K; 66150000
INTEGER I, XTEST; 66160000
LABEL FOUND, FAIL; 66170000
% 66180000
XTEST ~ IF X = "SYMB" THEN 0 ELSE 66190000
IF X = "FCT" THEN 2 ELSE 66200000
IF X = "INST" THEN 3 ELSE 0; 66210000
I ~ SCATTER(N,L,P,X); 66220000
WHILE I ! 0 DO 66230000
BEGIN IF (IF N ! (K~NAME[I]).S 66240000
THEN FALSE 66250000
ELSE EQUAL(N,L,P,FIRSTCHAR(K))) 66260000
THEN IF (IF N = 0 THEN K.LOC ! 0 ELSE TRUE) 66270000
THEN IF K.TYPE = XTEST 66280000
THEN GO TO FOUND; 66290000
I ~ K.LINK; 66300000
END; 66310000
FAIL: 66320000
I ~ -1; 66330000
FOUND: 66340000
SEARCHST ~ I; 66350000
END SEARCHST; 66360000
%********SEARCHST*******************************************************66370000
%********SNBLDEFINE*****************************************************66380000
% SNBLDEFINE SETS UP PROGRAM-DEFINED FUNCTIONS. THE THREE PARAMETERS 66390000
% SHOULD BE THE SYMBOL TABLE LOCATIONS OF THE THREE PARAMETERS FOR 66400000
% THE SNOBOL DEFINE. 66410000
% SNBLDEFINE USES CHAR, SCANCHAR, ENTERST, MIN, STRING, MOVECHARS. 66420000
BOOLEAN PROCEDURE SNBLDEFINE(ST1,ST2,ST3); 66430000
VALUE ST1, ST2, ST3; 66440000
ALPHA ST1, ST2, ST3; 66450000
% 66460000
BEGIN 66470000
DEFINE PARAMMAX = 30 #; % MAX NUMBER OF PARAMS & LOC VARS ALLOWED. 66480000
INTEGER I, P1, P2, LVNO; 66490000
ALPHA PROT, ENT, LVARS, STLOC; 66500000
INTEGER ARRAY LV[0:PARAMMAX]; 66510000
LABEL PROTERR, LVERR, RENVOI, TOOMANY; 66520000
IF ST1 = 0 THEN 66530000
BEGIN % NO FIRST PARAM (PROTOTYPE). 66540000
MESSAGE0(4); 66550000
MESSAGETT0(4); 66560000
GO TO RENVOI; 66570000
END; 66580000
PROT ~ VALU[ST1]; 66590000
ENT ~ IF ST2.STW = 0 THEN 0 ELSE VALU[ST2]; 66600000
LVARS~ IF ST3.STW = 0 THEN 0 ELSE VALU[ST3]; 66610000
% 66620000
% FIND NAME: 66630000
P1 ~ PROT.CH + SKIPCHAR(" ",DATA[PROT.R,PROT.W],PROT.C); 66640000
P2 ~ P1 + SCANCHAR("(",QMARK,DATA[PROT.R,P1.W],P1.C); 66650000
IF P2 - P1 > PROT.S THEN 66660000
BEGIN MESSAGE0(3); 66670000
MESSAGETT0(3); 66680000
GO TO RENVOI; 66690000
END; 66700000
STLOC ~ ENTERST(P2-P1,DATA[PROT.R,*],P1,"FCT"); 66710000
LV[LVNO~0] ~ ENTERST(P2-P1,DATA[PROT.R,*],P1,"SYMB"); 66720000
IF PRINTMESSAGES THEN % CHECK WHETHER ALREADY DEFINED: 66730000
IF VALU[STLOC].LINK ! 0 THEN 66740000
IF LOADF THEN 66750000
BEGIN MESSAGE0(13); MESSAGETT0(13); END ELSE 66760000
BEGIN MESSAGEI(21,INSTNO); MESSAGETTI(21,INSTNO); END; 66770000
% 66780000
% FIND ENTRY POINT: 66790000
ENT ~ IF ENT.S = 0 66800000
THEN ENTERST(P2-P1,DATA[PROT.R,*],P1,"INST") 66810000
ELSE ENTERST(ENT.S,DATA[ENT.R,*],ENT.CH,"INST"); 66820000
% 66830000
% PROCESS FORMAL PARAMETERS: 66840000
I ~ PROT.CH + SCANCHAR(")",QMARK,DATA[PROT.R,PROT.W],PROT.C); 66850000
IF I < P2 - PROT.CH THEN GO TO PROTERR; 66860000
P1 ~ P2 + 1; 66870000
WHILE P1 < I DO 66880000
BEGIN P1 ~ P1 + SKIPCHAR(" ",DATA[PROT.R,P1.W],P1.C); 66890000
P2 ~ P1 + MIN( 66900000
SCANCHAR(",",")",DATA[PROT.R,P1.W],P1.C), 66910000
SCANCHAR(" ",QMARK,DATA[PROT.R,P1.W],P1.C)); 66920000
IF P2 > I THEN P2 ~ I; 66930000
IF P1 = P2 THEN GO TO PROTERR; 66940000
IF LVNO ~ LVNO+1 > PARAMMAX THEN GO TO TOOMANY; 66950000
LV[LVNO] ~ ENTERST(P2-P1,DATA[PROT.R,*],P1,"SYMB"); 66960000
P2 ~ P2 + SKIPCHAR(" ",DATA[PROT.R,P2.W],P2.C); 66970000
IF P2 < I AND CHAR(DATA[PROT.R,P2.W],P2.C) ! "," THEN GO TO PROTERR; 66980000
P1 ~ P2 + 1; 66990000
END; 67000000
% 67010000
% PROCESS LOCAL VARIABLES: 67020000
I ~ LVARS.CH + LVARS.S; 67030000
P1 ~ LVARS.CH; 67040000
I ~ P1 + LVARS.S; 67050000
WHILE P1 < I DO 67060000
BEGIN P1 ~ P1 + SKIPCHAR(" ",DATA[LVARS.R,P1.W],P1.C); 67070000
P2 ~ P1 + MIN( 67080000
SCANCHAR(",",")",DATA[LVARS.R,P1.W],P1.C), 67090000
SCANCHAR(" ",QMARK,DATA[LVARS.R,P1.W],P1.C)); 67100000
IF P2 > I THEN P2 ~ I; 67110000
IF LVNO~LVNO+1 > PARAMMAX THEN GO TO TOOMANY; 67120000
LV[LVNO] ~ ENTERST(P2-P1,DATA[LVARS.R,*],P1,"SYMB"); 67130000
P2 ~ P2 + SKIPCHAR(" ",DATA[LVARS.R,P2.W],P2.C); 67140000
IF P2 < I AND CHAR(DATA[LVARS.R,P2.W],P2.C) ! "," THEN GO TO LVERR; 67150000
P1 ~ P2 + 1; 67160000
END; 67170000
% FINISH SYMBOL TABLE ENTRY: 67180000
I ~ STRING((LVNO+1)|2,STLOC); 67190000
VALU[STLOC] ~ I & 1[1:47:1] & ENT CLINK; 67200000
FOR P1 ~ 0 STEP 1 UNTIL LVNO DO 67210000
MOVE(2,LV[P1],6,DATA[I.R,(I+2|P1).W],(I+2|P1).C); 67220000
IF TRACEALL THEN 67230000
BEGIN VALU[STLOC].IOUSE ~ 3; 67240000
IO[STLOC] ~ 0 & 3 CFILNO & 3 CIOUSE & 2 CIOTYPE; 67250000
END; 67260000
SNBLDEFINE ~ TRUE; 67270000
GO TO RENVOI; 67280000
TOOMANY: 67290000
SNBLDEFINE ~ FALSE; 67300000
MESSAGEI(22,PARAMMAX); 67310000
MESSAGETTI(24,PARAMMAX); 67320000
GO TO RENVOI; 67330000
PROTERR: 67340000
SNBLDEFINE ~ FALSE; 67350000
MESSAGETT0(2); 67360000
MESSAGE0(2); GO TO RENVOI; 67370000
LVERR: 67380000
SNBLDEFINE ~ FALSE; 67390000
MESSAGE0(1); 67400000
MESSAGETT0(1); 67410000
RENVOI: 67420000
END SNBLDEFINE; 67430000
%********SNBLDEFINE*****************************************************67440000
%********SNBLIN*********************************************************67450000
BOOLEAN PROCEDURE SNBLIN(ST); 67460000
VALUE ST; ALPHA ST; 67470000
BEGIN LABEL RETURN, FAIL, EOF, PAR, NOFILE, 67480000
DATACOMM, INREAD, LOOK, ILLEGAL; 67490000
ALPHA STN, STV, SIO; 67500000
INTEGER SIZE, TYPE, T, UNIT; 67510000
SWITCH READSW ~ 67520000
INREAD, 67530000
LOOK, 67540000
DATACOMM; 67550000
% 67560000
STV ~ VALU[ST]; 67570000
SIO ~ IO[ST]; 67580000
IF NOT BOOLEAN(STV.INUSE) THEN GO TO ILLEGAL; 67590000
TYPE ~ SIO.IOTYPE; 67600000
UNIT ~ SIO.FILNO; 67610000
% IF INFORM THEN IF UNIT > 0 THEN INFORMI(6,UNIT); 67620000
GO TO READSW[TYPE]; 67630000
GO TO ILLEGAL; 67640000
% 67650000
DATACOMM: 67660000
BEGIN % INPUT FROM TELETYPE: 67670000
IF NOT DATACOMF THEN 67680000
BEGIN FINDUSERS; 67690000
IF NOT DATACOMF THEN GO TO NOFILE; 67700000
END; 67710000
IF NOT INPUT THEN GO TO FAIL; 67720000
VALU[ST].LOC ~ T ~ IF STV.S } DCSIZE 67730000
THEN STV.LOC & DCSIZE CONCS % USE OLD STRING 67740000
ELSE STRING(DCSIZE,ST); % NEED BIGGER STRING 67750000
MOVE(DCSIZE,DCREAD[*],0,FIRSTCHAR(T)); 67760000
SNBLIN ~ TRUE; 67770000
BREAK ~ FALSE; 67780000
GO TO RETURN; 67790000
END; 67800000
INREAD: 67810000
BEGIN COMMENT INPUT FROM IO[UNIT]; 67820000
IOEOF[UNIT] ~ FALSE; 67830000
SIZE ~ IOSIZE[UNIT]; 67840000
IF LOOKF[UNIT] THEN 67850000
BEGIN LOOKF[UNIT] ~ FALSE; 67860000
MOVE(SIZE,NEXTRECORD[UNIT,*],0,BUFFER[*],0); 67870000
END ELSE 67880000
% READ NEXT RECORD: 67890000
IF RECORD[UNIT] } 0 THEN 67900000
BEGIN 67910000
READ(IOFILE[UNIT][RECORD[UNIT]],1023,BUFFER[*])[EOF:PAR]; 67920000
RECORD[UNIT] ~ -1; 67930000
END ELSE 67940000
BEGIN SPACE(IOFILE[UNIT],IOSPACE[UNIT])[EOF:PAR]; 67950000
READ(IOFILE[UNIT],1023,BUFFER[*])[EOF:PAR]; 67960000
END; 67970000
VALU[ST].LOC ~ T ~ 67980000
IF STV.S < SIZE 67990000
THEN STRING(SIZE,ST) 68000000
ELSE STV.LOC & SIZE CONCS; 68010000
MOVE(SIZE,BUFFER[*],0,FIRSTCHAR(T)); 68020000
SNBLIN ~ TRUE; 68030000
GO TO RETURN; 68040000
END; 68050000
LOOK: 68060000
BEGIN % NON-READING INPUT (LOOK) FROM IOFILE[UNIT]; 68070000
SIZE ~ IOSIZE[UNIT]; 68080000
IF NOT LOOKF[UNIT] THEN 68090000
BEGIN IF RECORD[UNIT] } 0 THEN 68100000
READ(IOFILE[UNIT][RECORD[UNIT]],1023,NEXTRECORD[UNIT,*]) 68110000
[EOF:PAR] ELSE 68120000
BEGIN SPACE(IOFILE[UNIT],IOSPACE[UNIT])[EOF:PAR]; 68130000
READ(IOFILE[UNIT],1023,NEXTRECORD[UNIT,*])[EOF:PAR]; 68140000
END; 68150000
IOEOF[UNIT] ~ FALSE; 68160000
LOOKF[UNIT] ~ TRUE; 68170000
END; 68180000
VALU[ST].LOC ~ T ~ 68190000
IF STV.S < SIZE 68200000
THEN STRING(SIZE,ST) 68210000
ELSE STV.LOC & SIZE CONCS; 68220000
MOVE(SIZE,NEXTRECORD[UNIT,*],0,FIRSTCHAR(T)); 68230000
SNBLIN ~ TRUE; 68240000
GO TO RETURN; 68250000
END; 68260000
PAR: 68270000
BEGIN DEFINE DUMMY=#; 68280000
WRITE(BUFOUT[*],FPARITY); 68290000
STN ~ NAME[ST]; 68300000
MOVE(STRINGLOC(STN),BUFOUT[*],32); 68310000
WRITE(PRINT,FBL); 68320000
WRITE(PRINT,17,BUFOUT[*]); 68330000
GO TO FAIL; 68340000
END; 68350000
ILLEGAL: 68360000
INFORMA(5,ST); 68370000
DEATH ~ SYSTEMERROR ~ INFORM ~ TRUE; 68380000
GO TO ENDTERPRET; 68390000
NOFILE: 68400000
IF PRINTMESSAGES THEN 68410000
BEGIN DEFINE DUMMY=#; 68420000
STN ~ NAME[ST]; 68430000
WRITE(BUFOUT[*],FCLOSEDR); 68440000
MOVE(STN.S,FIRSTCHAR(STN),BUFOUT[*],36); 68450000
WRITE(PRINT,FBL); 68460000
WRITE(PRINT,17,BUFOUT[*]); 68470000
END; 68480000
GO TO FAIL; 68490000
EOF: 68500000
IOEOF[UNIT] ~ TRUE; 68510000
FAIL: 68520000
SNBLIN ~ FALSE; 68530000
RETURN: 68540000
END SNBLIN; 68550000
%********SNBLIN*********************************************************68560000
%********SNBLOUT********************************************************68570000
BOOLEAN PROCEDURE SNBLOUT(ST); VALUE ST; ALPHA ST; 68580000
BEGIN 68590000
LABEL RETURN, FAIL, EOF, PAR, NOFILE, SYSPOT, 68600000
DATACOMM, IOWRITE, TRACE, ILLEGAL; 68610000
SWITCH WRITESW ~ 68620000
IOWRITE, 68630000
TRACE, 68640000
DATACOMM, 68650000
ILLEGAL, 68660000
SYSPOT; 68670000
ALPHA STN, STV, SIO, AA, AB; 68680000
INTEGER SIZE, TYPE, UNIT, IS, ICH, IR, T, I1, I2; 68690000
% 68700000
STV ~ VALU[ST]; 68710000
SIO ~ IO[ST]; 68720000
IF NOT BOOLEAN(STV.OUTUSE) THEN GO TO ILLEGAL; 68730000
TYPE ~ SIO.IOTYPE; 68740000
UNIT ~ SIO.FILNO; 68750000
IS ~ STV.S; 68760000
ICH ~ STV.CH; 68770000
IR ~ STV.R; 68780000
% IF INFORM THEN IF UNIT>0 THEN INFORMI(13,UNIT); 68790000
% 68800000
GO TO WRITESW[TYPE]; 68810000
GO TO ILLEGAL; 68820000
% 68830000
DATACOMM: 68840000
BEGIN COMMENT OUTPUT TO DATACOMM UNIT; 68850000
IF NOT DATACOMF THEN 68860000
BEGIN FINDUSERS; 68870000
IF NOT DATACOMF THEN GO TO NOFILE; 68880000
END; 68890000
WHILE IS } 100 DO 68900000
BEGIN MOVE(100,DATA[IR,ICH.W],ICH.C,DCWRITE[*],0); 68910000
MV(1,ARROW,7,DCWRITE[12],5); 68920000
IF NOT OUTPUT THEN GO TO FAIL; 68930000
IS ~ IS - 100; 68940000
ICH ~ ICH + 100; 68950000
END; 68960000
IF IS > 0 THEN 68970000
BEGIN MOVE(IS,DATA[IR,ICH.W],ICH.C,DCWRITE[*],0); 68980000
MV(1,ARROW,7,DCWRITE[IS.W],IS.C); 68990000
IF NOT OUTPUT THEN GO TO FAIL; 69000000
END; 69010000
SNBLOUT ~ TRUE; 69020000
GO TO RETURN; 69030000
END; 69040000
IOWRITE: 69050000
BEGIN % OUTPUT TO FILE # UNIT. 69060000
IOEOF[UNIT] ~ FALSE; 69070000
T ~ (IOSIZE[UNIT]-1).W + 1; 69080000
SIZE ~ IOSIZE[UNIT]; 69090000
FOR I1~IOSPACE[UNIT] STEP -1 UNTIL 1 DO WRITE(IOFILE[UNIT]); 69100000
IF IS > SIZE THEN IF BOOLEAN(SIO.OVFL) THEN 69110000
BEGIN % WRITE AS MANY FULL RECORDS AS POSSIBLE: 69120000
MOVEWDS(1,BLANKS,BUFOUT[*]); 69130000
DO BEGIN 69140000
MOVE(SIZE,DATA[IR,ICH.W],ICH.C,BUFOUT[*],0); 69150000
IF RECORD[UNIT] } 0 69160000
THEN WRITE(IOFILE[UNIT][RECORD[UNIT]],T,BUFOUT[*])[EOF:PAR] 69170000
ELSE WRITE(IOFILE[UNIT],T,BUFOUT[*])[EOF:PAR]; 69180000
RECORD[UNIT] ~ -1; 69190000
ICH ~ ICH + SIZE; 69200000
IS ~ IS - SIZE; 69210000
END UNTIL IS { SIZE; 69220000
END ELSE IS ~ SIZE; 69230000
CLEAR(BUFOUT,T); 69240000
MOVE(IS,DATA[IR,ICH.W],ICH.C,BUFOUT[*],0); 69250000
IF RECORD[UNIT] } 0 69260000
THEN WRITE(IOFILE[UNIT][RECORD[UNIT]],T,BUFOUT[*])[EOF:PAR] 69270000
ELSE WRITE(IOFILE[UNIT][NO],T,BUFOUT[*])[EOF:PAR]; 69280000
RECORD[UNIT] ~ -1; 69290000
SNBLOUT ~ TRUE; 69300000
GO TO RETURN; 69310000
END; 69320000
TRACE: 69330000
BEGIN DEFINE DUMMY=#; 69340000
T ~ (IOSIZE[UNIT]-1).W + 1; 69350000
SIZE ~ IOSIZE[UNIT]; 69360000
STN ~ NAME[ST]; 69370000
WRITE(IOFILE[UNIT],FBL); 69380000
I1 ~ MIN(STN.S,63); % SIZE OF NAME 69390000
I2 ~ I1 + 3 - I1.[46:2]; % SIZE OF FIELD FOR NAME. 69400000
WRITE(BUFOUT[*],FTRACE,INSTNO,I2); 69410000
MOVE(I1,FIRSTCHAR(STN),BUFOUT[*],8); 69420000
IF SIZE - I2 - 12 > STV.S THEN 69430000
BEGIN MOVE(STRINGLOC(STV),BUFOUT[*],I2+12); 69440000
MV(1,QUOTE,7,BUFOUT[(I1~STV.S+I2+12).W],I1.C); 69450000
WRITE(IOFILE[UNIT][NO],T,BUFOUT[*]) [EOF:PAR]; 69460000
END ELSE 69470000
BEGIN 69480000
MOVE(SIZE-I2-12,FIRSTCHAR(STV),BUFOUT[*],12+I2); 69490000
WRITE(IOFILE[UNIT][NO],T,BUFOUT[*]) [EOF:PAR]; 69500000
STV.S ~ STV.S - SIZE + I2 + 12; 69510000
STV.CH ~ STV.CH + SIZE - I2 - 12; 69520000
WHILE STV.S } SIZE DO 69530000
BEGIN MOVE(SIZE,FIRSTCHAR(STV),BUFOUT[*],0); 69540000
WRITE(IOFILE[UNIT],FBL); 69550000
WRITE(IOFILE[UNIT][NO],T,BUFOUT[*])[EOF:PAR]; 69560000
STV.S ~ STV.S - SIZE; 69570000
STV.CH ~ STV.CH + SIZE; 69580000
END; 69590000
CLEAR(BUFOUT,T); 69600000
MOVE(STV.S,FIRSTCHAR(STV),BUFOUT[*],0); 69610000
MV(1,QUOTE,7,BUFOUT[(STV.S).W],(STV.S).C); 69620000
WRITE(IOFILE[UNIT],FBL); 69630000
WRITE(IOFILE[UNIT][NO],T,BUFOUT[*]) [EOF:PAR]; 69640000
END; 69650000
SNBLOUT ~ TRUE; 69660000
GO TO RETURN; 69670000
END; 69680000
SYSPOT: 69690000
BEGIN DEFINE DUMMY =#; 69700000
IF STV.S = 0 THEN GO TO RETURN; 69710000
AA ~ CHAR(DATA[STV.R,STV.W],STV.C); 69720000
IF AA = "+" THEN IOSPACE[3] ~ 0 ELSE 69730000
IF AA = " " THEN IOSPACE[3] ~ 1 ELSE 69740000
IF AA = "0" THEN IOSPACE[3] ~ 2 ELSE 69750000
IF AA = "1" THEN 69760000
BEGIN 69770000
WRITE(PRINT[PAGE]); 69780000
IOSPACE[3] ~ 1; 69790000
END ELSE 69800000
IF AA = "*" THEN % NO SKIP AT END OF PAGE 69810000
BEGIN RECORD[3] ~ 6; 69820000
IOSPACE[3] ~ 1; 69830000
END; 69840000
STN ~ TEMPCELL; 69850000
AB ~ STRING(STV.S-1,STN); 69860000
MOVE(AB.S,FIRSTCHAR(STV)+1,FIRSTCHAR(AB)); 69870000
AA ~ VALU[PRINTLOC]; 69880000
AA.LOC ~ AB; 69890000
VALU[STN] ~ AA; 69900000
IO[STN] ~ IO[PRINTLOC]; 69910000
IF SNBLOUT(STN) THEN 69920000
BEGIN 69930000
IOSPACE[3] ~ 1; 69940000
SNBLOUT ~ TRUE; 69950000
GO TO RETURN; 69960000
END ELSE 69970000
BEGIN 69980000
IOSPACE[3] ~ 1; 69990000
GO TO FAIL; 70000000
END; 70010000
END; 70020000
ILLEGAL: 70030000
INFORMA(5,ST); 70040000
DEATH ~ SYSTEMERROR ~ INFORM ~ TRUE; 70050000
GO TO ENDTERPRET; 70060000
NOFILE: 70070000
IF PRINTMESSAGES THEN 70080000
BEGIN DEFINE DUMMY=#; 70090000
STN ~ NAME[ST]; 70100000
WRITE(BUFOUT[*],FCLOSEDW); 70110000
MOVE(STN.S,FIRSTCHAR(STN),BUFOUT[*],35); 70120000
WRITE(PRINT,FBL); 70130000
WRITE(PRINT,17,BUFOUT[*]); 70140000
END; 70150000
GO TO FAIL; 70160000
PAR: 70170000
IF PRINTMESSAGES THEN 70180000
BEGIN DEFINE DUMMY=#; 70190000
STN ~ NAME[ST]; 70200000
WRITE(BUFOUT[*],FPARITY); 70210000
MOVE(STN.S,FIRSTCHAR(STN),BUFOUT[*],32); 70220000
WRITE(PRINT,FBL); 70230000
WRITE(PRINT,17,BUFOUT[*]); 70240000
END; 70250000
GO TO FAIL; 70260000
EOF: 70270000
IOEOF[UNIT] ~ TRUE; 70280000
FAIL: 70290000
SNBLOUT ~ FALSE; 70300000
RETURN: 70310000
END SNBLOUT; 70320000
%********SNBLOUT********************************************************70330000
%********STORECHARS*****************************************************70340000
PROCEDURE STORECHARS(N,LOC,INC); 70350000
VALUE N, INC; INTEGER N, INC; ALPHA LOC; 70360000
BEGIN DEFINE DUMMY =#; 70370000
IF PTR + N > 8180 THEN 70380000
BEGIN 70390000
SYNTAXERR(42,0); 70400000
END ELSE 70410000
BEGIN 70420000
IF N { 63 70430000
THEN MV(N,LOC,INC,CODE[PTR.W],PTR.C) 70440000
ELSE MOVE(N,LOC,INC,CODE[PTR.W],PTR.C); 70450000
PTR ~ PTR + N; 70460000
END; 70470000
END STORECHARS; 70480000
%********STORECHARS*****************************************************70490000
%********STRING*********************************************************70500000
% STRING RETURNS THE LOCATION OF AN UNUSED STRING OF SIZE N. 70510000
% IF NECESSARY, THE GARBAGE COLLECTOR IS CALLED, OR NEW ROWS ARE 70520000
% MADE AVAILABLE. 70530000
ALPHA PROCEDURE STRING(N,STLOC); 70540000
VALUE N, STLOC; 70550000
INTEGER N; ALPHA STLOC; 70560000
% 70570000
BEGIN LABEL L, E, FAIL; 70580000
INTEGER I; 70590000
IF DPNTR[RW] + N } 8181 THEN 70600000
BEGIN INTEGER J; J ~ 8181 - N; 70610000
FOR I ~ 0 STEP 1 UNTIL DATASIZE DO 70620000
IF DPNTR[I] < J AND USEDROW[I] THEN 70630000
BEGIN RW ~ I; J ~ DPNTR[I] END; 70640000
IF DPNTR[RW] + N } 8181 THEN 70650000
BEGIN GARBAGECOLLECTOR; 70660000
FOR I ~ 0 STEP 1 UNTIL DATASIZE DO 70670000
IF DPNTR[I] < J AND USEDROW[I] THEN 70680000
BEGIN RW ~ I; J ~ DPNTR[I] END; 70690000
IF DPNTR[RW] + N } 8181 THEN 70700000
BEGIN 70710000
IF N } 8181 THEN GO TO FAIL ELSE 70720000
FOR I ~ 0 STEP 1 UNTIL DATASIZE DO 70730000
IF NOT USEDROW[I] THEN 70740000
BEGIN USEDROW[I] ~ TRUE; 70750000
RW ~ I; GO TO L; 70760000
END; 70770000
END ELSE GO TO L; 70780000
GO TO FAIL; 70790000
END; 70800000
END; 70810000
L: STLOC.[30:6] ~ QMARK; 70820000
MV(3,STLOC,5,DATA[RW,(I~DPNTR[RW]).W],I.C); 70830000
STRING ~ (I+3) & RW CONCR & N CONCS; 70840000
DPNTR[RW] ~ I + N + 3; 70850000
GO TO E; 70860000
FAIL: 70870000
MESSAGEI(12,N); 70880000
MESSAGETTI(12,N); 70890000
COMMENT OUT OF SPACE IN DATA[*,*]; 70900000
WRITE(PRINT,MESSAGE[1]); 70910000
DEATH ~ TRUE; 70920000
E: 70930000
END STRING; 70940000
%********STRING*********************************************************70950000
%********STRINGDUMP*****************************************************70960000
PROCEDURE STRINGDUMP(INSTNO); VALUE INSTNO; INTEGER INSTNO; 70970000
BEGIN 70980000
INTEGER I, J, T, SN; 70990000
ALPHA STN, STV; 71000000
WRITETIME(0,0); 71010000
MESSAGE0(6); 71020000
IF PRINTMESSAGES THEN MESSAGETT0(6); 71030000
FOR I ~ 0 STEP 1 WHILE I { STRMAX AND USEDST[I] DO 71040000
FOR J ~ 0 STEP 1 UNTIL STWMAX DO 71050000
IF (STN~NAMTABL[I,J]).[1:2] = 0 THEN IF STN.LOC > 1 THEN 71060000
BEGIN 71070000
SN ~ MIN(STN.S,63); 71080000
T ~ MAX(SN+3-SN.[46:2],8); 71090000
STV ~ VALTABL[I,J]; 71100000
WRITE(BUFOUT[*],FTRACE,INSTNO,T); 71110000
MOVE(SN,FIRSTCHAR(STN),BUFOUT[*],8); 71120000
IF 120 - T > STV.S THEN 71130000
BEGIN MOVE(STV.S,FIRSTCHAR(STV), 71140000
BUFOUT[T.W],12+T.C); 71150000
MV(1,QUOTE,7,BUFOUT[(I1~STV.S+T+12).W],I1.C); 71160000
WRITE(PRINT,17,BUFOUT[*]); 71170000
END ELSE 71180000
BEGIN 71190000
MOVE(120-T,FIRSTCHAR(STV), 71200000
BUFOUT[*],12+T); 71210000
WRITE(PRINT,17,BUFOUT[*]); 71220000
STV.S ~ STV.S - 120 + T; 71230000
STV.CH ~ STV.CH + 120 - T; 71240000
WHILE STV.S } 132 DO 71250000
BEGIN MOVE(132,FIRSTCHAR(STV), 71260000
BUFOUT[*],0); 71270000
WRITE(PRINT,17,BUFOUT[*]); 71280000
STV.S ~ STV.S-132; 71290000
STV.CH ~ STV.CH + 132; 71300000
END; 71310000
CLEAR(BUFOUT,17); 71320000
MOVE(STV.S,FIRSTCHAR(STV),BUFOUT[*],0); 71330000
MV(1,QUOTE,7,BUFOUT[(STV.S).W],(STV.S).C); 71340000
WRITE(PRINT,17,BUFOUT[*]); 71350000
END; 71360000
END; 71370000
MESSAGE0(7); 71380000
FOR I ~ 0 STEP 1 WHILE I { STRMAX AND USEDST[I] DO 71390000
FOR J ~ 0 STEP 1 UNTIL STWMAX DO 71400000
IF (STN ~ NAMTABL[I,J]).[1:2] = 3 THEN 71410000
BEGIN SN ~ MIN(STN.S,63); 71420000
T ~ MAX(SN+3-SN.[46:2],8); 71430000
I1 ~ VALTABL[I,J].LINK; 71440000
WRITE(BUFOUT[*],FTRACEL,T,DIGITS(I1),I1); 71450000
MV(SN,FIRSTCHAR(STN),BUFOUT[*],3); 71460000
WRITE(PRINT,17,BUFOUT[*]); 71470000
END; 71480000
WRITETIME(0,0); 71490000
END STRINGDUMP; 71500000
%********STRINGDUMP*****************************************************71510000
%********SYNTAXERR******************************************************71520000
PROCEDURE SYNTAXERR(N,P); VALUE N,P; INTEGER N,P; 71530000
BEGIN 71540000
DEFINE DUMMY = #; 71550000
P ~ P MOD FIELDSIZE; 71560000
IF P > 0 THEN 71570000
BEGIN 71580000
CLEAR(BUFOUT,17); 71590000
MOVE(1,QMARK,7,BUFOUT[P.W],P.C+8); 71600000
WRITE(PRINT,17,BUFOUT[*]); 71610000
END; 71620000
WRITE(PRINT,MESSAGE[N]); 71630000
PTR ~ MARKER + 8; 71640000
STORECHARS(1,"X",7); 71650000
MESSAGES ~ MESSAGES + 1; 71660000
ERRORS ~ ERRORS + 1; 71670000
END SYNTAXERR; 71680000
%********SYNTAXERR******************************************************71690000
%********TEMPCEL********************************************************71700000
% TEMPCELL PRODUCES A TEMPORARY CELL IN THE SYMBOL TABLE. 71710000
% THIS CELL CAN GENERALLY BE ASSUMED TO BE GONE AFTER THE END OF AN 71720000
% INSTRUCTION. (THIS IS ACTUALLY NOT ALWAYS TRUE, BUT IT IS RATHER 71730000
% DIFFICULT TO PREDICT WHEN A CELL WILL STAY AROUND LONGER.) SEE ALSO 71740000
% THE PROCEDURE NEWCELL FOR GETTING PERMANENT CELLS. 71750000
ALPHA PROCEDURE TEMPCELL; 71760000
BEGIN INTEGER ST, I, J; 71770000
LABEL FAIL, RETURN; 71780000
DEFINE ROW=TEMPROW#; 71790000
% 71800000
% IF INFORM THEN INFORMI(7,ROW); 71810000
ST ~ NEXTCELL[ROW]; 71820000
IF ST = 0 THEN 71830000
BEGIN 71840000
FOR ROW ~ 0 STEP 1 WHILE ST = 0 DO 71850000
IF ROW > 15 THEN GO TO FAIL ELSE 71860000
IF USEDST[ROW] 71870000
THEN ST ~ NEXTCELL[ROW] 71880000
ELSE BEGIN NEWSTROW(ROW); 71890000
ST ~ 0 & ROW CONCSTR; 71900000
END; 71910000
ROW ~ ROW - 1; % THE "STEP" WAS EXECUTED ONE TIME TOO MANY. 71920000
END; 71930000
NEXTCELL[ROW] ~ NAME[ST].LINK; 71940000
IF (I~TEMPLIST[ROW]) = 0 THEN 71950000
BEGIN TEMPLIST[ROW] ~ ST; 71960000
NAME[ST] ~ 0 & ST CLINK; 71970000
END ELSE 71980000
BEGIN J ~ NAME[I].LINK; 71990000
NAME[I].LINK ~ ST; 72000000
NAME[ST] ~ 0 & J CLINK; 72010000
END; 72020000
VALU[ST] ~ 0; 72030000
TEMPCELL ~ ST; 72040000
% IF USEDCELL[ROW] < ST THEN USEDCELL[ROW] ~ ST; 72050000
GO TO RETURN; 72060000
FAIL: 72070000
MESSAGE0(14); 72080000
MESSAGETT0(14); 72090000
WRITE(PRINT,MESSAGE[1]); 72100000
DEATH ~ TRUE; 72110000
RETURN: 72120000
% IF INFORM THEN INFORMIA(0,ROW,ST); 72130000
END TEMPCEL; 72140000
%********TEMPCEL********************************************************72150000
%********TEMPVAL********************************************************72160000
% TEMPVAL PRODUCES A TEMPORARY SYMB TABLE CELL WHOSE VALUE IS THE 72170000
% STRING REPRESENTATION OF THE INTEGER I. 72180000
ALPHA PROCEDURE TEMPVAL(I); 72190000
VALUE I; INTEGER I; 72200000
BEGIN ALPHA ARRAY NUM[0:1]; 72210000
ALPHA AA, AB; INTEGER J; 72220000
% 72230000
WRITE(NUM[*],FI16,I); 72240000
J ~ 16 - SKIPCHAR(" ",NUM[0],0); 72250000
TEMPVAL ~ AA ~ TEMPCELL; 72260000
AB ~ STRING(J,AA); 72270000
MV(J,NUM[0],16-J,DATA[AB.R,AB.W],AB.C); 72280000
VALTABL[AA.STR,AA.STW] ~ AB; 72290000
END TEMPVAL; 72300000
%********TEMPVAL********************************************************72310000
%********TRACEFCTCALL***************************************************72320000
BOOLEAN PROCEDURE TRACEFCTCALL(F); 72330000
VALUE F; 72340000
INTEGER F; % SYMBOL TABLE LOC OF FUNCTION 72350000
BEGIN 72360000
LABEL FAIL, FIN; 72370000
ALPHA FCTN, FIO, PV; 72380000
INTEGER I, J, SIZE, P, PS, PC, PR; 72390000
DEFINE WRITERECORD = IF WRITEBUFF(BUFOUT,P,SIZE) THEN GO TO FAIL #; 72400000
% 72410000
FCTN ~ NAME[F]; 72420000
FIO ~ IO[F]; 72430000
IF FIO.IOTYPE = 2 THEN % OUTPUT TO FILE. 72440000
BEGIN 72450000
UNIT ~ FIO.FILNO; 72460000
SIZE ~ IOSIZE[UNIT]; 72470000
I ~ MIN(63,FCTN.S); 72480000
WRITE(BUFOUT[*],FTRACEFCTCALL,INSTNO,I); 72490000
MV(I,FIRSTCHAR(FCTN),BUFOUT[*],8); 72500000
P ~ I + 8; 72510000
IF SP { MKS THEN P ~ P + 1 ELSE 72520000
FOR I ~ MKS STEP 1 WHILE I < SP DO 72530000
BEGIN % MOVE PARAM INTO BUFOUT[*]: 72540000
IF P~P+1 } SIZE THEN WRITERECORD; 72550000
MV(1,QUOTE,7,BUFOUT[P.W],P.C); 72560000
P ~ P + 1; 72570000
PV ~ VALU[PST[I]]; 72580000
PR ~ PV.R; 72590000
PS ~ PV.S; 72600000
PC ~ PV.CH; 72610000
WHILE PS+P } SIZE DO 72620000
BEGIN % MOVE IN PART OF PARAM, AND WRITE: 72630000
IF P < SIZE THEN 72640000
BEGIN 72650000
MOVE(SIZE-P,DATA[PR,PC.W],PC.C,BUFOUT[P.W],P.C); 72660000
PS ~ PS - SIZE + P; 72670000
PC ~ PC + SIZE - P; 72680000
END; 72690000
WRITERECORD; 72700000
END; 72710000
MOVE(PS,DATA[PR,PC.W],PC.C,BUFOUT[P.W],P.C); 72720000
P ~ P + PS; 72730000
IF P+1 } SIZE THEN WRITERECORD; 72740000
MV(1,QUOTE,7,BUFOUT[P.W],P.C); 72750000
IF (P~P+1)+1 } SIZE THEN WRITERECORD; 72760000
MV(1,COMMA,7,BUFOUT[P.W],P.C); 72770000
END; 72780000
% CHANGE LAST "," TO ")": 72790000
AA ~ ")"; 72800000
MV(1,AA,7,BUFOUT[P.W],P.C); 72810000
WRITERECORD; 72820000
TRACEFCTCALL ~ TRUE; 72830000
GO TO FIN; 72840000
END FILE OUTPUT ELSE 72850000
% CALL TRACING FUNCTION: 72860000
; % NOT YET IMPLEMENTED. 72870000
FAIL: 72880000
TRACEFCTCALL ~ FALSE; 72890000
FIN: 72900000
END TRACEFCTCALL; 72910000
%********TRACEFCTCALL***************************************************72920000
%********TRACEFCTRETURN*************************************************72930000
BOOLEAN PROCEDURE TRACEFCTRETURN(F,SUC); 72940000
VALUE F, SUC; 72950000
INTEGER F; % SYMBOL TABLE LOC OF FUNCTION 72960000
BOOLEAN SUC; % TRUE IF SUCCEEDED. 72970000
BEGIN 72980000
LABEL FAIL, FIN, FAUT; 72990000
INTEGER I, P, SV, CV, RV, SIZE; 73000000
ALPHA FCTN, FIO; 73010000
DEFINE WRITERECORD = IF WRITEBUFF(BUFOUT,P,SIZE) THEN GO TO FAIL #; 73020000
% 73030000
FCTN ~ NAME[F]; 73040000
FIO ~ IO[F]; 73050000
IF FIO.IOTYPE = 2 THEN % OUTPUT TO FILE 73060000
BEGIN 73070000
UNIT ~ FIO.FILNO; 73080000
SIZE ~ IOSIZE[UNIT]; 73090000
I ~ MIN(63,FCTN.S); 73100000
WRITE(BUFOUT[*],FTRACEFCTRET,INSTNO,I); 73110000
MV(I,FIRSTCHAR(FCTN),BUFOUT[*],8); 73120000
P ~ I + 8; 73130000
WRITE(IOFILE[UNIT],FBL) [FAIL:FAIL]; 73140000
IF SUC THEN 73150000
BEGIN % WRITE OUT VALUE: 73160000
P ~ P + 6; 73170000
AA ~ VALU[PST[MKS]]; % = VALUE. 73180000
SV ~ AA.S; 73190000
CV ~ AA.CH; 73200000
RV ~ AA.R; 73210000
WHILE SV+P } SIZE DO 73220000
BEGIN 73230000
MOVE(SIZE-P,DATA[RV,CV.W],CV.C,BUFOUT[P.W],P.C); 73240000
CV ~ CV + SIZE - P; 73250000
SV ~ SV - SIZE + P; 73260000
WRITERECORD; 73270000
END; 73280000
IF SV > 0 THEN 73290000
MOVE(SV,DATA[RV,CV.W],CV.C,BUFOUT[P.W],P.C); 73300000
IF P~P+SV < SIZE THEN % ROOM FOR QUOTE 73310000
BEGIN MV(1,QUOTE,7,BUFOUT[P.W],P.C); 73320000
WRITE(IOFILE[UNIT][NO],1023,BUFOUT[*]) [FAIL:FAIL]; 73330000
END ELSE 73340000
% PUT QUOTE ON NEXT LINE: 73350000
BEGIN WRITE(IOFILE[UNIT],1023,BUFOUT[*])[FAIL:FAIL]; 73360000
MV(1,QUOTE,7,BUFOUT[*],0); 73370000
MV(7,BLANKS,0,BUFOUT[*],1); 73380000
WRITE(IOFILE[UNIT][NO],1,BUFOUT[*])[FAIL:FAIL]; 73390000
END; 73400000
END SUCCESS CASE ELSE 73410000
% WRITE "FAILED.": 73420000
BEGIN AA ~ "FAILED."; 73430000
MV(7,AA,1,BUFOUT[P.W],P.C+3); 73440000
WRITE(IOFILE[UNIT][NO],1023,BUFOUT[*])[FAIL:FAIL]; 73450000
END; 73460000
TRACEFCTRETURN ~ TRUE; 73470000
GO TO FIN; 73480000
END FILE OUTPUT ELSE 73490000
% CALL TRACING FUNCTION: 73500000
; % NOT YET IMPLEMENTED. 73510000
FAUT: 73520000
FAIL: 73530000
TRACEFCTRETURN ~ FALSE; 73540000
FIN: 73550000
END TRACEFCTRETURN; 73560000
%********TRACEFCTRETURN*************************************************73570000
%********TTINDEX********************************************************73580000
% ST SHOULD BE A SYMBOL TABLE CELL POINTING TO A TELETYPE ADDRESS IN 73590000
% THE STANDARD FORM <T.U.>/<B.A.>. THE VALUE RETURNED IS THE SUBSCRIPT 73600000
% TO USE WITH ID[*] AND STAT[*] FOR THIS TELETYPE. 73610000
% IF THE TELETYPE ISNT ATTACHED, -1 IS RETURNED. 73620000
INTEGER PROCEDURE TTINDEX(ST); 73630000
VALUE ST; 73640000
ALPHA ST; 73650000
BEGIN LABEL FAIL, FIN; 73660000
INTEGER BA, TU, I, J, K, N, IR, IC; 73670000
FINDUSERS; 73680000
ST ~ VALU[ST]; 73690000
IR ~ ST.R; IC ~ ST.CH; 73700000
TU ~ BA ~ 0; 73710000
N ~ ST.S; 73720000
I ~ SCANCHAR("/",QMARK,DATA[IR,IC.W],IC.C); 73730000
IF I } N OR CHAR(DATA[IR,IC.W],IC.C+I) ! "/" THEN GO TO FAIL; 73740000
FOR J ~ 0 STEP 1 WHILE J < I DO 73750000
IF K ~ CHAR(DATA[IR,IC.W],IC.C+J) > 9 73760000
THEN GO TO FAIL 73770000
ELSE TU ~ TU|10 + K; 73780000
IF TU = 0 OR TU > 15 THEN GO TO FAIL; 73790000
FOR J ~ I+1 STEP 1 WHILE J < N DO 73800000
IF K ~ CHAR(DATA[IR,IC.W],IC.C+J) > 9 73810000
THEN GO TO FAIL 73820000
ELSE BA ~ BA|10 + K; 73830000
IF BA > 15 THEN GO TO FAIL; 73840000
BA ~ BA & TU[39:44:4]; 73850000
I ~ -1; 73860000
FOR J ~ 0 STEP 1 WHILE J < NUMUSERS AND I < 0 DO 73870000
IF BA = STAT[J].[9:9] THEN I ~ J; 73880000
IF I } 0 THEN 73890000
BEGIN TTINDEX ~ I; 73900000
GO TO FIN; 73910000
END; 73920000
FAIL: 73930000
TTINDEX ~ -1; 73940000
FIN: 73950000
END TTINDEX; 73960000
%********TTINDEX********************************************************73970000
%********WRITEBUFF******************************************************73980000
BOOLEAN PROCEDURE WRITEBUFF(BUFOUT,P,SIZE); 73990000
VALUE SIZE; 74000000
INTEGER P, SIZE; 74010000
ARRAY BUFOUT[0]; 74020000
BEGIN LABEL FAIL, FIN; 74030000
WRITE(IOFILE[UNIT],FBL); 74040000
WRITE(IOFILE[UNIT][NO],1023,BUFOUT[*]) [FAIL:FAIL]; 74050000
P ~ 0; 74060000
CLEAR(BUFOUT,SIZE.W); 74070000
WRITEBUFF ~ FALSE; 74080000
GO TO FIN; 74090000
FAIL: 74100000
WRITEBUFF ~ TRUE; % TRUE IF OUTPUT FAILS 74110000
FIN: 74120000
END WRITEBUFF; 74130000
%********WRITEBUFF******************************************************74140000
%********WRITEDATA******************************************************74150000
% DUMP OF PROGRAM/DATA AREAS: 74160000
PROCEDURE WRITEDATA; 74170000
BEGIN INTEGER I; 74180000
PROCEDURE WRITEDATAROW(I); VALUE I; INTEGER I; 74190000
BEGIN INTEGER J; INTEGER ARRAY BUFFER[0:14]; 74200000
J ~ 0; 74210000
WRITE(BUFFER[*],MESSAGE[37],I); 74220000
MOVE(100,DATA[I,*],0,BUFFER[*],16); 74230000
MOVE(4,BLANKS,0,BUFFER[14],4); 74240000
WRITE(PRINT,MESSAGE[36]); 74250000
WRITE(PRINT,15,BUFFER[*]); 74260000
FILL BUFFER[*] WITH " "," "; 74270000
FOR J ~ J + 100 WHILE J < 8084 DO 74280000
BEGIN MOVE(100,DATA[I,J.W],J.C,BUFFER[*],16); 74290000
WRITE(PRINT,15,BUFFER[*]); 74300000
END; 74310000
MOVE(84,DATA[I,1012],4,BUFFER[*],16); 74320000
FOR J ~ 100,108 DO MOVE(8,BLANKS,0,BUFFER[J.W],J.C); 74330000
WRITE(PRINT,15,BUFFER[*]); 74340000
WRITE(PRINT,MESSAGE[36]); 74350000
END WRITEDATAROW; 74360000
WRITETIME(0,0); 74370000
WRITE(PRINT [PAGE]); 74380000
FOR I ~ 0 STEP 1 UNTIL 31 DO 74390000
BEGIN WRITE(PRINT,MESSAGE[35],I,USEDROW[I],I,DPNTR[I]); 74400000
IF USEDROW[I] THEN WRITEDATAROW(I); 74410000
END; 74420000
WRITETIME(0,0); 74430000
END WRITEDATA; 74440000
%********WRITEDATA******************************************************74450000
%********WRITEINST******************************************************74460000
% WRITEINST PRINTS OUT THE CODE THAT HAS BEEN PRODUCED SO FAR 74470000
% BY THE COMPILER. 74480000
PROCEDURE WRITEINST; 74490000
BEGIN DEFINE DUMMY=#; 74500000
CLEAR(BUFOUT,17); 74510000
MOVE(MIN(PTR-MARKER,132),CODE[MARKER.W],MARKER.C,BUFOUT[*],0); 74520000
WRITE(PRINT,17,BUFOUT[*]); 74530000
END WRITEINST; 74540000
%********WRITEINST******************************************************74550000
%********WRITEST********************************************************74560000
% SYMBOL TABLE DUMP ROUTINE: 74570000
PROCEDURE WRITEST; 74580000
BEGIN 74590000
FORMAT F(X5,A2,X1,I4," * ",2(4I1,X1,I2,X1,I3,X1,I4,X1,I2,X1, 74600000
I4," "),A2,X12,I1,X4,I3,X3,I3,X4,L1,X4,I2), 74610000
F1(7("*"),X10,"NAMTABL[",I2,",*]",X16,"VALTABL[",I2,",*]",X27, 74620000
"IOUSE FILNO CYCLE OVFL IOTYPE"), 74630000
F2("NEXTCELL[",I2,"] = ",A2,"; TEMPLIST[",I2,"] = ",A2); 74640000
INTEGER I, J, K; 74650000
ALPHA L; 74660000
WRITE(PRINT[1]); 74670000
WRITETIME(0,0); 74680000
FOR I ~ 0 STEP 1 UNTIL STRMAX DO IF USEDST[I] THEN 74690000
BEGIN 74700000
WRITE(PRINT,F2,I,NEXTCELL[I],I,TEMPLIST[I]); 74710000
WRITE(PRINT,F1,I,I); 74720000
FOR K ~ 0 STEP 1 UNTIL STWMAX DO 74730000
WRITE(PRINT,F,(K&I CONCSTR),K,FOR L ~ 74740000
NAMTABL[I,K],VALTABL[I,K] DO 74750000
[L.[1:1], 74760000
L.[2:1], 74770000
L.[3:1], 74780000
L.[4:1], 74790000
L.[5:4], 74800000
L.[9:8], 74810000
L.S, 74820000
L.R, 74830000
L.CH], 74840000
(K&I CONCSTR), 74850000
FOR L ~ IOTABL[I,K] DO 74860000
[L.IOUSE, 74870000
L.FILNO, 74880000
L.CYCLE, 74890000
L.OVFL, 74900000
L.IOTYPE]); 74910000
END; 74920000
WRITETIME(0,0); 74930000
END WRITEST; 74940000
%********WRITEST********************************************************74950000
%********WRITESTACK*****************************************************74960000
% WRITESTACK(N) PRINTS OUT THE CONTENTS OF THE STACK, FROM WORD 0 74970000
% TO WORD N. N SHOULD BE { STACKSIZE. 74980000
PROCEDURE WRITESTACK(N); 74990000
VALUE N; 75000000
INTEGER N; 75010000
BEGIN INTEGER I; 75020000
WRITE(PRINT,FSTACKHEAD); 75030000
FOR I ~ 0 STEP 1 UNTIL N DO 75040000
WRITE(PRINT,FSTACKENTRY, 75050000
I, 75060000
PTYPE[I], 75070000
PST[I], 75080000
PNAME[I], 75090000
PLOC[I].S, PLOC[I].R, PLOC[I].CH, 75100000
PSIZE[I], 75110000
PPOINT[I], 75120000
PMINLEFT[I], 75130000
PBACK[I]); 75140000
END WRITESTACK; 75150000
%********WRITESTACK*****************************************************75160000
%********WRITETIME******************************************************75170000
% F IS NO LONGER IN USE HERE. 75180000
PROCEDURE WRITETIME(F,N); VALUE F,N; INTEGER F,N; 75190000
BEGIN REAL T, TS; 75200000
INTEGER TH, TM; 75210000
T ~ TIME(1) / 60; 75220000
TH ~ ENTIER(T / 3600); 75230000
TM ~ ENTIER((T - TH | 3600) / 60); 75240000
TS ~ T - TH | 3600 - TM | 60; 75250000
IF N { 0 THEN 75260000
WRITE(PRINT,FTIME[0],TIME(2)/60,TIME(3)/60) ELSE 75270000
IF N { 1 THEN 75280000
BEGIN ALPHA D, M, Y, X; ALPHA ARRAY MM[1:12]; 75290000
X ~ DATE; 75300000
M ~ X.[1:5] | 10 + X.[6:6]; 75310000
D ~ X.[18:6] | 10 + X.[24:6]; 75320000
Y ~ X.[36:12]; 75330000
FILL MM[*] WITH 75340000
"JAN","FEB","MAR","APR","MAY","JUN", 75350000
"JUL","AUG","SEP","OCT","NOV","DEC"; 75360000
WRITE(PRINT,FTIME[1],VERSION,DIGITS(D),D,MM[M],Y,TH,TM,TS); 75370000
END ELSE 75380000
IF N { 3 THEN 75390000
WRITE(PRINT,FTIME[N],TH,TM,TS) ELSE 75400000
IF N { 5 THEN 75410000
WRITE(PRINT,FTIME[N],TH,TM,TS,DIGITS(LEVEL),LEVEL, 75420000
DIGITS(INSTNO),INSTNO); 75430000
END WRITETIME; 75440000
%********WRITETIME******************************************************75450000
%***********************************************************************75460000
% END OF PROCEDURE DECLARATIONS 75470000
BEGIN COMMENT INITIALIZATION; 75480000
ALPHA ARRAY USERS[0:31]; 75490000
% 75500000
% B5500 CHARACTER SET: 75510000
% 0 1 2 3 4 5 6 7 8 9 75520000
% # @ QMARK : > } + A B C 75530000
% D E F G H I . [ & ( 75540000
% < ~ | J K L M N O P 75550000
% Q R $ * - ) ; { BLANK / 75560000
% S T U V W X Y Z , % 75570000
% ! = ] " 75580000
% 75590000
FILL CONVERTVAL[*] WITH 75600000
"0","1","2","3","4","5","6","7","8","9", 75610000
"=",""",":","{","%","[","<","A","B","C", 75620000
"D","E","F","G","H","I",".",")","+","}", 75630000
12, ";",12, "J","K","L","M","N","O","P", 75640000
"Q","R","$","*","-",12, 12, ">"," ","/", 75650000
"S","T","U","V","W","X","Y","Z",",","(", 75660000
"]",12, 12, "&"; 75670000
% 75680000
% 75690000
FILL CHARTYPE[*] WITH 75700000
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 75710000
0, 0, 13, 9, 0, 0, 10, 3, 3, 3, 75720000
3, 3, 3, 3, 3, 3, 3, 0, 0, 5, 75730000
0, 2, 10, 3, 3, 3, 3, 3, 3, 3, 75740000
3, 3, 8, 7, 10, 6, 14, 0, 1, 12, 75750000
3, 3, 3, 3, 3, 3, 3, 3, 11, 0, 75760000
0, 2, 0, 4; 75770000
% 75780000
FILL DOTTYPE[*] WITH 75790000
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 75800000
0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 75810000
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 75820000
0, 0, 2, 0, 0, 0, 0, 1, 0, 0, 75830000
0, 0, 0, 2, 2, 0, 0, 0, 0, 2, 75840000
3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 75850000
0, 0, 0, 0; 75860000
% VALUES FOR DOTTYPE: 75870000
% 0 ERROR 75880000
% 1 .N 75890000
% 2 .+, .-, .|, ./, .* 75900000
% 3 .S 75910000
% 75920000
FILL OPLEVEL[*] WITH 75930000
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 75940000
0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 75950000
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 75960000
0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 75970000
0, 0, 0, 4, 2, 0, 0, 0, 0, 3, 75980000
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 75990000
0, 0, 0, 0; 76000000
FILL WORDS[*] WITH 76010000
"UNANCHOR","OUNDUMP ","INTEGERT","RUNCATIO","NDISK IN", 76020000
"FORMSILE","NCENDFRE","TURNDATA","COMIORUL","ESPROCES", 76030000
"SAVERELE","ASEPURGE","TELETYPE","DEBUGRUN","ERRDUMPT", 76040000
"RUNCATEO","VERFLOWQ","UOTEQMAR","KARROWRE","ADPRINTP", 76050000
"UNCHLOOK","SYSPOTCA","RDNEWDIS","K "; 76060000
FILL MNEMONIC[0,*] WITH 76070000
6, 76080000
"ON","TO","BY","AT","IN","OFF"; 76090000
FILL MNEMONIC[1,*] WITH 76100000
2, 76110000
"FROM","TO"; 76120000
FILL CONTROLCARD[*] WITH 0, 76130000
"DEBUG", 76140000
"PCC", 76150000
"LIST", 76160000
"UNLIST", 76170000
"PUNCH", 76180000
"EJECT", 76190000
"SPACE", 76200000
"WIDTH", 76210000
"26", 76220000
"3600", 76230000
"B5500", 76240000
"DEFINE", 76250000
"WAIT", 76260000
"LIMIT", 76270000
"SIZE", 76280000
"SET", 76290000
"LIBRARY", 76300000
"LOAD", 76310000
"COMPILE", 76320000
"INFORM", 76330000
"SILENCE"; 76340000
FILL INTRINSFCT[3,*] WITH 76350000
8,".EQ",".NE",".LT",".LE",".GT",".GE","POP","EOF"; 76360000
FILL INTRINSNDX[3,*] WITH 76370000
9, 21, 19, 16, 15, 14, 25, 8; 76380000
FILL INTRINSFCT[4,*] WITH 76390000
17, 76400000
".NUM","PUSH","PAGE","SIZE","MODE", 76410000
"DUMP","DATE","TRIM","TIME", 76420000
"FILE","LOOK","WAIT","FILL","USER", 76430000
"SEEK","COPY"; 76440000
FILL INTRINSNDX[4,*] WITH 76450000
22, 26, 24, 30, 20, 7, 4, 36, 32, 76460000
12, 18, 39, 13, 42, 43, 48; 76470000
FILL INTRINSFCT[5,*] WITH 76480000
10, 76490000
"SPACE","UNEQL","TRACE","CLOSE","RULES", 76500000
"LEVEL","OPSYN","CALLF",".RANF","CLEAR"; 76510000
FILL INTRINSNDX[5,*] WITH 76520000
31, 38, 46, 3, 29, 17, 23, 2, 50, 51; 76530000
FILL INTRINSFCT[6,*] WITH 76540000
14, 76550000
".REMDR","ANCHOR","UNANCH","EQUALS","DEFINE", 76560000
"DETACH","TRACEF","REWIND","TRACEL","STATUS", 76570000
"TRACES","RECORD","ASSIGN","SEARCH"; 76580000
FILL INTRINSNDX[6,*] WITH 76590000
27, 1, 37, 10, 5, 6, 34, 28, 35, 41, 76600000
33, 45, 47, 49; 76610000
FILL INTRINSFCT[7,*] WITH 76620000
4,"EXECUTE","COMPILE","SUSPEND","RELEASE"; 76630000
FILL INTRINSNDX[7,*] WITH 76640000
11, 0, 40, 44; 76650000
FILL MONTHS[*] WITH 31,28,31,30,31,30,31,31,30,31,30,31; 76660000
IF ((TEMP~TIME(0)).[24:6] + TEMP.[18:6] | 10) MOD 4 = 0 THEN 76670000
MONTHS[2] ~ 29; 76680000
% 76690000
% 76700000
% 76710000
RANDNO ~ 8388607; % INITIALIZE RANDOM NUMBER GENERATOR 76720000
CRLF ~ "{!~"; 76730000
ARROW ~ "~"; SLASH ~ "/"; 76740000
EQSIGN ~ "="; 76750000
QMARK ~ 12; QUOTE ~ """; BLANK ~ " "; COLON ~ ":"; 76760000
STAR ~ "*"; COMMA ~ ","; 76770000
STOPPER ~ QUOTE & QMARK[36:42:6] & BLANK[30:42:6]; 76780000
BLANKS ~ " "; MOVE(4,BLANKS,4,BLANKS,0); 76790000
TEENYNEG ~ REAL(NOT FALSE); 76800000
ANCHORMODE ~ 2; 76810000
TRACEALL ~ BOOLEAN(COMMON.[47:1]); 76820000
DUMPALL ~ BOOLEAN(COMMON.[46:1]); 76830000
SYSTEMDEBUGGING ~ BOOLEAN(COMMON.[45:1]); 76840000
USEDROW[0] ~ TRUE; 76850000
EXECUTE ~ TRUE; 76860000
FIELDSIZE ~ 72; 76870000
WAITTIME ~ 18000; % 5 MINUTES 76880000
FINDUSERS; % LOCATE ATTACHED TELETYPES 76890000
IF DATACOMF THEN 76900000
BEGIN 76910000
IF NUMUSERS = 1 THEN PROGRAMFROMREMOTE ~ TRUE; 76920000
FOR USER ~ 0 STEP 1 UNTIL NUMUSERS-1 DO 76930000
BEGIN 76940000
WRITE(DCWRITE[*],FTTHELLO,VERSION); 76950000
IF OUTPUT THEN; 76960000
IF NOT PROGRAMFROMREMOTE THEN 76970000
BEGIN WRITE(DCWRITE[*],FFROMREMOTE,12); 76980000
IF OUTPUT THEN IF INPUT THEN 76990000
BEGIN 77000000
WHILE J~CHAR(DCREAD[*],SKIPCHAR(" ",DCREAD[*],0))!"Y" 77010000
AND J ! "N" DO 77020000
BEGIN WRITE(DCWRITE[*],FYESORNO); 77030000
IF OUTPUT THEN; 77040000
IF INPUT THEN; 77050000
END; 77060000
IF J = "Y" THEN 77070000
BEGIN PROGRAMFROMREMOTE ~ TRUE; 77080000
MAINUSER ~ USER; 77090000
END ELSE 77100000
BEGIN MV(3,CRLF,5,DCWRITE[*],0); 77110000
IF OUTPUT THEN; 77120000
END; 77130000
END; 77140000
END; 77150000
END; 77160000
USER ~ MAINUSER; 77170000
END; 77180000
IF NOT PROGRAMFROMREMOTE THEN 77190000
BEGIN READ(PROGRAM,10,BUFFER[*]); 77200000
BUFFERFULL ~ TRUE; 77210000
END; 77220000
WRITETIME(0,1); 77230000
LOADF ~ TRUE; 77240000
LOADER(PROGRAM); 77250000
LOADF ~ FALSE; 77260000
IF PUNCHF THEN CLOSE(PUNCH); 77270000
% 77280000
WRITE(PRINT,FERRS,DIGITS(ERRORS),ERRORS); 77290000
WRITETIME(0,2); 77300000
WRITETIME(0,0); 77310000
IF INFORM THEN 77320000
BEGIN WRITEST; 77330000
WRITEDATA; 77340000
END; 77350000
% 77360000
% 77370000
IF EXECUTE THEN 77380000
BEGIN WRITETIME(0,3); 77390000
WRITE(PRINT,FASTERISKS); 77400000
% 77410000
INTERPRETER; 77420000
% 77430000
MESSAGE0(22); 77440000
MESSAGETTI(14,INSTNO); 77450000
RESULT ~ FALSE; 77460000
WRITE(PRINT,FASTERISKS); 77470000
WRITETIME(0,5); 77480000
END; 77490000
GO TO ENDOFRUN; 77500000
% 77510000
% 77520000
END INITIALIZATION; 77530000
% 77540000
ABORTION: % FATAL SYSTEM ERROR. 77550000
MESSAGETT0(7); 77560000
RESULT ~ FALSE; 77570000
SYSTEMERROR ~ TRUE; 77580000
% 77590000
ENDTERPRET: 77600000
WRITE(PRINT,FASTERISKS); 77610000
WRITETIME(0,IF RESULT THEN 4 ELSE 5); 77620000
IF RESULT THEN MESSAGETTI(23,INSTNO); 77630000
ENDOFRUN: 77640000
BEGIN DEFINE DUMMY=#; 77650000
IF NOT RESULT THEN MESSAGETTI(10,INSTNO); 77660000
IF TRACEALL THEN INFORM ~ TRUE; 77670000
WRITETIME(0,0); 77680000
WRITE(PRINT,FRULES,RULES[0]); 77690000
IF DUMPALL THEN DMPST ~ DMPDATA ~ DMPSTR ~ TRUE; 77700000
IF SYSTEMERROR THEN 77710000
BEGIN WRITE(PRINT[DBL],FBL); 77720000
FOR I ~ 0,1,2,3 DO WRITE(PRINT[NO],FSENDCOPY); 77730000
INFORM ~ TRUE; 77740000
WRITE(PRINT[DBL],FBL); 77750000
END; 77760000
WRITE(PRINT,FGCS,DIGITS(GCS),GCS,DIGITS(GCTIMECP)+2,GCTIMECP, 77770000
DIGITS(GCTIMEIO)+2,GCTIMEIO); 77780000
IF INFORM OR DMPST THEN WRITESTACK(STACKSIZE); 77790000
IF INFORM OR DMPST THEN WRITEST; 77800000
IF INFORM OR DMPDATA THEN WRITEDATA; 77810000
IF INFORM OR DMPSTR OR (ERRDUMP AND NOT RESULT) 77820000
THEN STRINGDUMP(INSTNO); 77830000
END ENDOFRUN SEGMENT; 77840000
END ALGOL PROCEDURES; 77850000
END END END GLOBAL STREAM PROCEDURES; 77860000
%***********************************************************************77870000
END PROGRAM. 77880000
END;END. LAST CARD ON 0CRDING TAPE 99999999
Reference in New Issue View Git Blame Copy Permalink