% 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 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 ~ 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 ~ 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 ~ ~ 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 FROM