Directory of image this file is from
This file as a plain text file
/4 OS/8 FORTRAN (PASS ONE) / / VERSION 4A PT 16-MAY-77 / / OS/8 FORTRAN COMPILER - PASS 1 / / BY: HANK MAURER / UPDATED BY: R.LARY + M. HURLEY / / /COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION / / / / / / / / / / /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT /CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY /FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. / /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. / /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY /DIGITAL. / / / VERSON=4
/CHANGES FOR MAINTENANCE RELEASE (S.R.): /1. BUMPED VERSION NUMBER TO 304 /2. INCLUDED PATCH SEQ #4 (OCT DSN) FOR SF ERROR FIX /3. INCLUDED PATCH SEQ #6 (TEMP VARS IN ASF) /4. FIXED PROBLEM IN DATA STATEMENT /5. STOPPED HALT AFTER OT ERROR BY CONVERTING LOGICAL / VARS TO INTEGER IN ARITHMETIC IF STATEMENT /6. FIXED BUG RE /A AND .RA EXTENSION /LAST MINUTE CHANGES: /7. ALLOWED PARITY INPUT /8. IGNORE NULLS ON INPUT /9. FIXED BUG RE IGNORING LAST LINE IF IN ERROR / OR IN FACT IGNORING ANY LAST LINE IF NO END STATEMENT /10. ALLOW MULTIPLE INPUT FILES / / /CHANGES FOR OS/8 V3D AND OS/78 BY P.T. / .PATCH LEVEL NOW CONTAINED IN LOCATION 1130
*7 LINENO, 1 /2.01/ LINE NUMBER X10, 0 /AUTO INDEX REGISTERS X11, 0 X12, 0 NEXT, FREE-1 /FREE SPACE POINTER STACK, STACKS-1 /STACK POINTER CHRPTR, 0 /INPUT BUFFER POINTER X16, 0 X17, 0 STKLVL, STACKS-1 /STACK BASE LEVEL BUCKET, 0 /FIRST CHAR OF NAME WORD1, 0 /SIX WORD LITERAL BUFFER WORD2, 0 WORD3, 0 WORD4, 0 WORD5, 0 WORD6, 0 ACO, 0 /FLOATING AC OVERFLOW WORD OP1, 0 /SEVEN WORD OPERAND FOR "NUMBER" OP2, 0 OP3, 0 OP4, 0 OP5, 0 OP6, 0 OPO, 0 CHAR, 0 /ICHAR PUTS CHARACTER HERE NOCODE, 0 /IS 1 IF CODE GENERATION OFF NCHARS, 0 /SIZE OF INPUT LINE NUMELM, 0 /NUMBER OF VARS IN TYPED LIST TEMP, 0 TEMP2, 0 DECPT, 0 /SET 1 IF NUMBER CONTAINED . ESWIT, 0 /1 FOR E 0 FOR D NDIGIT, 0 /NUMBER OF DIGITS TO RIGHT OF . HCHAR, HCOUNT /HOLLERITH GETTER ROUTINE SNUM, 0 /POINTER TO ST ENTRY FOR STMT NUMBER IFSWIT, 0 /=1 IF INSIDE LOGICAL IF EXPON, 0 /HOLDS EXPONENT FOR CONVERSION TMPFIL, 0617;2224;2216;2415 /PASS1 OUTPUT FILE 0;0;0;0 /PASS2 OUTPUT FILE DOEND, 0 /SET 1 IF THIS STMT WAS A IF, /GOTO, RETURN, PAUSE, OR STOP THSNUM, 0 /CURRENT STATEMENT NUMBER DIMNUM, 0 /LINEARIZED SS FOR EQ DPRDCT, 0 /HOLDS DIMENSION PRODUCT EQTEMP, 0 /TEMP FOR EQUIVALENCE MQ, 0 /MQ FOR 12 BIT MULTIPLY MASTER, 0 /POINTER TO MASTER IN EQUIV GROUP MNUM, 0 /LINEARIZED SS FOR MASTER NSLAVE, 0 /NUMBER OF SLAVES IN GROUP PASS2O, 0 /START OF PASS 2 OVERLAY SECTION OUFILE, 0 /START OF PASS1 OUTPUT FILE DSERES, 0 /MAGIC NUMBER PROGNM, MAIN /POINTER TO PROG NAME ARGLST, 0 /POINTER TO ARG LIST FUNCTN, 0 /0=MAIN, 1=FUNCTION, -2=SUBROUTINE SETBIT, 0 /TEMPS FOR DECLARATION SCANNER BADBIT, 0 DOINDX, 0 /POINTER TO DO INDEX FOR DO LOOPS TLTEMP, 0 /TEMP FOR TYPE ROUTINE OWTEMP, 0 /TEMP FOR OUTWRD CNT72, -102 /72 COLUMN COUNTER DPUSED, 0 /=1 IF DOUBLE HARDWARE USED VERS, VERSON /VERSION NUMBER M211, -211 P211, 211 P240, 240 IXLNP5, LINE+5 /** IXLINE, LINE IXLINM, LINE-1 STMJMP, 0 /FOR DEFINE FILE
/ OPCODES AND EQUS MAXHOL=100 /MAXIMUM HOLLERITH LITERAL COMREG=4600 /INTER-PASS COMMUNICATION REGION STACKS=4700 /STACK AREA NAME1=6200 /NAME AND HOLLERITH BUFFER (WAS 6400)** LINE=6300 /LINE BUFFER (WAS 6500)** INBUF=6600 /INPUT BUFFER (FIELD 1) OUBUF=7200 /OUTPUT BUFFER (DITTO) INDEVH=7200 /INPUT DEVICE HANDLER (WAS 7400)** PAUSOP=22 DPUSH=PAUSOP+1 BINRD1=DPUSH+1 /OPCODE DEFINITIONS FMTRD1=BINRD1+1 RCLOSE=FMTRD1+1 DARD1=RCLOSE+1 BINWR1=DARD1+1 FMTWR1=BINWR1+1 WCLOSE=FMTWR1+1 DAWR1=WCLOSE+1 DEFFIL=DAWR1+1 ASFDEF=DEFFIL+1 ARGSOP=ASFDEF+1 EOLCOD=ARGSOP+1 ERRCOD=EOLCOD+1 RETOPR=ERRCOD+1 REWOPR=RETOPR+1 STOROP=REWOPR+1 ENDOPR=STOROP+1 DEFLBL=ENDOPR+1 DOFINI=DEFLBL+1 ARTHIF=DOFINI+1 LIFBGN=ARTHIF+1 DOBEGN=LIFBGN+1 ENDFOP=DOBEGN+1 STOPOP=ENDFOP+1 ASNOPR=STOPOP+1 BAKOPR=ASNOPR+1 FMTOPR=BAKOPR+1 GO2OPR=FMTOPR+1 CGO2OP=GO2OPR+1 AGO2OP=CGO2OP+1 IOLMNT=AGO2OP+1 DATELM=IOLMNT+1 DREPTC=DATELM+1 DATAST=DREPTC+1 ENDELM=DATAST+1 PRGSTK=ENDELM+1 DOSTOR=PRGSTK+1 / ASSEMBLE STATEMENT PAGE RDLOOP, CIF 10 /FOR OS/8 2 PG HANDLERS** JMS I [ICHAR /GET CHAR FROM INPUT FILE JMP ENDLIN /END LINE OR CR TAD M211 /CHECK FOR TAB** SNA TAD (240-211 /CONVERT TO BLANK TAD P211 /** DCA I CHRPTR /SAVE CHAR ISZ CNT72 /PAST COLUMN 72 ? SKP JMP SKPLIN /SKIP 73 TO 80 TAD CHRPTR CIA CLL TAD (LINE+670 SZL CLA /TEST FOR TOO MANY CONTINUATIONS JMP RDLOOP JMS I [ERMSG /LINE TOO LONG 1424 SKPCOM, TAD X16 /RESTORE CHRPTR DCA CHRPTR SKPLIN, CIF 10 /** JMS I [ICHAR /SKIP REST OF LINE JMP ENDLIN CLA JMP SKPLIN ENDLIN, TAD CHRPTR /SAVE CHAR POSITION DCA X16 TAD CHRPTR DCA X10 /SAVE POSITION FOR COMMENT CHECK TAD (-102 /SET COLUMN COUNT DCA CNT72 TAD M6 DCA NCHARS GET6, CIF 10 /** JMS I [ICHAR /GET FIRST 6 CHARS JMP SHORTL /IGNORE SHORT LINES TAD M211 /IS CHAR A TAB ? ** SZA CLA JMP NOTAB /NO TAD P240 /TREAT FIRST TAB AS SIX BLANKS DCA I CHRPTR ISZ NCHARS JMP .-3 TAD P240 /FAKE CONTINUATION CHECK DCA CHAR JMP CCHECK /GO TO COMMENT CHECK SHORTL, TAD X16 /RESET CHAR POINTER DCA CHRPTR /TO IGNORE SHORT LINES JMP ENDLIN NOTAB, TAD CHAR DCA I CHRPTR ISZ NCHARS JMP GET6 /LOOP CCHECK, TAD I X10 /IS IT A COMMENT ? TAD (-303 SNA CLA JMP SKPCOM /COMMENT, SKIP REST NOCMNT, TAD CHAR /WAS SIXTH CHAR A BLANK ? TAD MMM240 SNA CLA JMP GOTLIN /YES, NO MORE CONTINUATIONS CCARD, TAD X16 /IGNORE THESE SIX CHARACTERS DCA CHRPTR JMP RDLOOP /CONTINUE WITH THIS LINE GOTLIN, TAD CHRPTR /COMPUTE -NCHARS-1 CIA TAD (LINE+4 DCA NCHARS TAD [LINE-1 /RESET CHAR POINTER DCA CHRPTR JMS I [CKCTLC /CHECK FOR CONTROL C LINE1, DCA THSNUM /ZERO CURRENT STMT NUMBER CLL CML RAR /SET LABEL DEFINE BIT JMS I [STMNUM /GO LOOK FOR LABEL JMP COMPIL /NONE THERE TAD SNUM /SAVE STATEMENT NUMBER DCA THSNUM TAD (DEFLBL /OUTPUT DEFINITION FOR THIS LABEL JMS I [OUTWRD TAD SNUM JMS I [OUTWRD /FOLLOWED BY THE LABEL ADDRESS COMPIL, JMS I [SAVECP ISZ LINENO /2.01/ PUT LINE NUMBER TAD LINENO /2.01/ INTO MQ 7421 /2.01/ CLA IAC DCA NOCODE /SET NOCODE SWITCH JMS I [ERMSG /SET UP DEFAULT ERROR MESSAGE 1513 JMS I [LEXPR /IS IT ARITHMETIC ? JMP NOTAR /NO JMS I [GETC /LOOK FOR = JMP NOTAR /NOT ARITHMETIC TAD MMM275 /= SNA CLA JMS I [EXPR /SCAN LEFT PART JMP NOTAR JMS I [ERMSG /SET MESSAGE TO ILLEGAL OPERATOR 1720 ISZ NCHARS /SHOULD BE NOTHING LEFT JMP NOTAR /IF THERE IS, ITS NOT ARITHMETIC ITSAR, JMS I [RESTCP /RESTORE TO START OF LINE DCA NOCODE /ALLON CODE JMS I [LEXPR /GET LEFT SIDE M6, -6 /V3C MUST BE HERE JMS I [GETC /SKIP = MMM240, -240 /SHOULD NEVER GET HERE CLA JMS I [EXPR /GET RIGHT SIDE MMM275, -275 /SHOULD NEVER GET HERE TAD (STOROP /OUTPUT STORE JMS I [OUTWRD JMP I [NEXTST /DO NEXT LINE NOTAR, JMS I [RESTCP /RESTART LINE DCA NOCODE JMS I [SAVECP /RESAVE CHAR POSITION TAD (CMDLST-1 DCA X10 JMP I (CMDLUP /GO SEARCH FOR KEYWORD
/ KEYWORD SEARCH PAGE CMDLUP, CDF 10 /TABLE IN FIELD ONE TAD I X10 /GET NEXT 2 CHARS OF KEYWORD SZA JMP CMDLP2 /NOT DONE YET CLL CMA RAL /REMOVE CHAR POS FROM STACK TAD STACK DCA STACK TAD I X10 /GET ROUTINE ADDRESS CDF DCA STMJMP JMP I STMJMP /JUMP TO THE ROUTINE CMDLP2, DCA TEMP /SAVE THE TWO CHARS CDF JMS I [GET2C /GET TWO CHARS FROM THE INPUT JMP .+4 /NOT ENOUGH CHARS, CAN'T BE THIS ONE TAD TEMP /COMPARE SNA CLA JMP CMDLUP /MATCHES, KEEP GOING JMS I [RESTCP /RESTORE CHAR POS ISZ STACK ISZ STACK /AND SAVE IT AGAIN CDF 10 TAD I X10 /FIND END OF THIS COMMAND SZA CLA JMP .-2 ISZ X10 /SKIP ROUTINE ADDRESS TAD I X10 /IS THE LIST EXHAUSTED ? SZA JMP CMDLP2 /NO, GO AGAIN BADCMD, JMS I [ERMSG /TREAT AS BAD ARITHMETIC STMT ERCODE, 0
/ END OF STMT PROC NEXTLN, NEXTST, DOENDR, TAD STKLVL /RESET STACK POINTER DCA STACK JMS I [POP /LOOK FOR DO END CIA TAD THSNUM /DOES THIS LINE END A DO LOOP ? SZA CLA JMP NODOND /NO, REPLACE STACK AND COMPILE STMT TAD (DOFINI JMS I [OUTWRD /OUTPUT DO END COMMAND JMS I [POP /GET INDEX VARIABLE JMS I [OUTWRD TAD STACK /RESET STACK BASE LEVEL DCA STKLVL TAD DOEND /WAS THIS A LEGAL ENDING STMT ? SZA CLA JMS I [ERMSG 0504 /DO END ERROR DCA DOEND /KILL SWITCH JMP DOENDR NODOND, ISZ STACK /REPLACE STACK ENTRY DCA DOEND /KILL SWITCH TAD (EOLCOD /OUTPUT EOL CODE JMS I [OUTWRD DCA ERCODE /RESET ERROR CODE DCA IFSWIT /KILL IF SWITCH TAD (-6 /MOVE FIRST 6 CHARS DCA NCHARS TAD [LINE-1 /INTO START OF BUFFER DCA CHRPTR TAD I X16 DCA I CHRPTR ISZ NCHARS JMP .-3 JMP I (RDLOOP
/ GOTO'S GOTO, ISZ DOEND /DO END ILLEGAL JMS I [STMNUM /IS IT A SIMPLE GOTO ? JMP CMPGO2 /NO, SEE IF ITS A COMPUTED ONE TAD (GO2OPR /OUTPUT GOTO OPERATOR JMS I [OUTWRD TAD SNUM /FOLLOWED BY STMT NUMBER JMS I [OUTWRD JMP I [NEXTST CMPGO2, JMS I [GETC /LOOK FOR ( JMP BADGO2 /BAD GOTO TAD (-250 SZA CLA JMP ASNGO2 /NOT ( , MAYBE ITS AN ASSIGNED GOTO TAD STACK /SAVE STACK POSITION DCA X12 DCA TEMP /ZERO BRANCH COUNTER GO2LUP, JMS I [STMNUM /GET NEXT STMT NUMBER JMP BADGO2 /MUST BE THERE TAD SNUM JMS I [PUSH /SAVE IT TEMPORARILY ISZ TEMP /BUMP BRANCH COUNT JMS I [COMARP /LOOK FOR COMMA OR RIGHT PAREN JMP BADGO2 /NEITHER JMP GO2LUP /COMMA, GO GET NEXT LABEL JMS I [GETC /SKIP NEXT CHAR (ITS A COMMA) JMP BADGO2 CLA TAD TEMP /SAVE COUNT JMS I [PUSH /ON STACK JMS I [EXPR /COMPILE INDEX EXPR JMP I [NEXTST TAD (CGO2OP /OUTPUT COMPUTED GOTO OPERATOR JMS I [OUTWRD JMS I [POP /GET COUNT CIA DCA TEMP /SAVE COMPLEMENT TAD TEMP CIA JMS I [OUTWRD /OUTPUT COUNT TAD X12 /RESTORE STACK POINTER DCA STACK TAD I X12 /MOVE STMT NUMBERS TO OUTPUT JMS I [OUTWRD ISZ TEMP JMP .-3 JMP I [NEXTST ASNGO2, JMS I [BACK1 /PUT BACK NON ( JMS I [LEXPR /GET ASSIGN VAR JMP BADGO2 TAD (AGO2OP /OUTPUT GOTO OPERATOR JMS I [OUTWRD JMP I [NEXTST BADGO2, JMS I [ERMSG 0724 JMP I [NEXTST
/ I/O STATEMENTS PAGE RDWR, 0 /SUBR FOR IO STATEMENTS JMS I [CHECKC /LOOK FOR ( M250, -250 JMP BADRD JMS I [EXPR /COMPILE UNIT JMP I [BADCMD JMS I [COMARP JMP DAQUOT /LOOK FOR ' (DIRECT ACCESS I/O) JMP RDFMT /, TAD (BINRD1 /FORMATLESS READ/WRITE IOSTRT, TAD I RDWR /ADD ADJUSTOR JMS I [OUTWRD /OUTPUT BINARY READ IOLIST, JMS I [PUSH /MARK STACK JMS I [GETC /IS IT AN IMPLIED DO ? JMP ENDIOL /NO, END OF LIST TAD M250 SZA CLA JMP TRYIOE /NO, LOOK FOR IO ELEMENT JMS I [SAVECP /SAVE CHAR POS AT START OF IDO DCA IDOPAR /ZERO PAREN COUNTER FINDND, JMS I [GETNAM /GET A NAME IF THERE IS ONE XPURGE, PRGSTK /DON'T WORRY ITS A NOP JMS I [GETC /GET A CHAR JMP ENDIOL TAD M251 /IS IT A ) ? SNA JMP RPIOL /YES IAC /IS IT ( ? SNA JMP LPIOL /YES TAD (250-275 /IS IT = ? SZA CLA JMP FINDND /NONE OF THESE TAD IDOPAR /IS PAREN COUNT 0 ? SZA CLA JMP FINDND /NO, ITS FROM AN INNER LOOP JMS I [LOOKUP /THIS ELEMENT IS THE DO INDEX DCA DOINDX JMS I (DOSTUF /COMPILE THE LOOP JMP BADIOL /ERROR IN DO PARMS JMS I [CHECKC /MUST HAVE ) -251 JMP BADIOL TAD CHRPTR /SAVE CHAR POSITION DCA TEMP TAD NCHARS DCA TEMP2 JMS I [RESTCP /RESTORE TO START OF IMPLIED LOOP TAD TEMP2 /NOW SAVE POS AFTER LOOP JMS I [PUSH TAD TEMP JMS I [PUSH TAD DOINDX /AND DO INDEX JMP IOLIST LPIOL, ISZ IDOPAR /( INCREASES COUNT JMP FINDND RPIOL, CMA /) DECREASES COUNT TAD IDOPAR SMA JMP FINDND-1 CLA BADIOL, BADRD, JMS I [ERMSG /BAD IO STMT 2227 JMP I [NEXTST TRYIOE, JMS I [BACK1 /PUT BACK NON ( JMS I [LEXPR /GET IOLIST ELEMENT JMP BADRD /NOT THERE, ERROR JMS I [GETC /LOOK FOR A COMMA JMP .+4 /EOL TAD (-254 SZA JMP NOTIOL /NOT AN ELEMENT TAD (IOLMNT /OUTPUT OPCODE JMS I [OUTWRD JMP IOLIST+1 NOTIOL, TAD (254-275 /IS IT AN = (END OF IDO) SZA CLA JMP BADIOL /NO, BAD JMS I [POP /GET STUFF FROM THE STACK SNA JMP BADIOL /ZERO IS BAD DCA DOINDX /THIS IS THE INDEX JMS I [RESTCP /GET THE CHAR POSITION TAD XPURGE /OUTPUT PURGE OPERATOR JMS I [OUTWRD /BECAUSE AN EXTRA IS ON THE STK TAD (DOFINI /END LOOP JMS I [OUTWRD TAD DOINDX JMS I [OUTWRD JMS I [GETC /END OF LIST ? JMP ENDIOL TAD (-254 SZA CLA JMP BADIOL /MUST BE A COMMA JMP IOLIST+1 IDOPAR, 0 ENDIOL, JMS I [POP /IS THE MARK THERE ? SZA CLA JMP BADRD /NO, ERROR TAD I RDWR TAD (RCLOSE /END OF IO OPERATION JMS I [OUTWRD JMP I [NEXTST RDFMT, JMS I [STMNUM /LOOK FOR FMT LINE NUMBER JMP RTFMT JMS I [OUTWRD /OUTPUT PUSH COMMAND TAD SNUM /OUTPUT STMT NUMBER OF FORMAT JMS I [OUTWRD RDLIST, TAD (FMTRD1 /START OF FORMATTED READ TAD I RDWR /ADD ADJUSTOR JMS I [OUTWRD JMS I [CHECKC /LOOK FOR ) M251, -251 JMP BADRD JMP IOLIST /GO GET IO LIST RTFMT, JMS I [LEXPR /GET R.T. FORMAT JMP BADRD JMP RDLIST /GET LIST
/DIRECT ACCESS I/O PAGE DAQUOT, JMS I [BACK1 JMS I [CHECKC /LOOK FOR ' -247 JMP BADRD /SYNTAX IS NO GOOD JMS I [EXPR /GET RECORD NUMBER EXPR JMP BADRD JMS I [CHECKC /LOOK FOR ) -251 JMP BADRD TAD (DARD1 /DIRECT ACCESS OPEN JMP IOSTRT FIND, JMP I [NEXTST /COOL ISN'T IT ? DFINFL, JMS I [EXPR /COMPILE UNIT JMP BADDEF /BAD DEFINE STMT DCA STMJMP /PERMIT VARIABLE FOR LOG UNIT JMS I [CHECKC /( -250 JMP BADDEF JMS I [EXPR /NUMBER OF RECORDS JMP BADDEF JMS I [CHECKC /, -254 JMP BADDEF JMS I [EXPR /RECORD SIZE JMP BADDEF JMS I [CHECKC /, -254 JMP BADDEF JMS I [CHECKC /U -325 JMP BADDEF JMS I [CHECKC /, MCOMA, -254 JMP BADDEF JMS I [GETNAM /GET INDEX VARIABLE JMP BADDEF JMS I [OUTWRD JMS I [LOOKUP JMS I [OUTWRD /OUTPUT INDEX VAR TAD (DEFFIL /OUTPUT DEFINE OPERATOR JMS I [OUTWRD JMS I [CHECKC /) -251 JMP BADDEF JMS I [GETC /ANOTHER DEFINE ? JMP I [NEXTST TAD MCOMA /, ? SNA CLA JMP DFINFL /YES, ANOTHER FILE BADDEF, JMS I [ERMSG /BAD DEFINE FILE STMT 0406 JMP I [NEXTST RESTCP, 0 /RESTORE CHAR POSITION FROM STACK JMS I [POP DCA CHRPTR JMS I [POP DCA NCHARS JMP I RESTCP INTEGE, JMS I [CHECKC /INTEGER STMT -322 JMP I [BADCMD JMS I [TYPLST 0101 0100 NOP JMP I [NEXTST PAUZE, JMS I [CHECKC /LOOK FOR E -305 JMP I [BADCMD JMS I [GETC /ANY EXPR ? JMP NOARGP /MAKE IT PAUSE 1 JMS I [BACK1 /PUT IT BACK JMS I [EXPR /GET PAUSE NUMBER XPAUZ, PAUSOP OPAUZ, TAD XPAUZ /OUTPUT PAUSE OPERATOR JMS I [OUTWRD JMP I [NEXTST NOARGP, JMS I [OUTWRD /PUSH 1.0 TAD [ONE JMS I [OUTWRD JMP OPAUZ /GO PUT OPERATOR READ, JMS I (RDWR /COMPILE READ STMT 0 WRITE, JMS I [CHECKC /LOOK FOR E -305 JMP I [BADCMD JMS I (RDWR /COMPILE WRITE BINWR1-BINRD1 CKCTLC, 6401 /CHECK FOR CONTROL C TAD (7600 KRS TAD (-7603 /^C SNA CLA KSF JMP I CKCTLC JMP I (7600 XOCTAL, DCA WORD1 /** DCA WORD2 DCA WORD3 /STATEMENT NUM LEFT THERE** DCA WORD5 DCA WORD6 XCTAL1, DCA WORD4 JMS I [DIGIT /GET NEXT DIGIT JMP ENDOXT /NO DIGITS LEFT AND [7 /THROW AWAY SOME BITS DCA TEMP JMS I (AL1 /MOVE WORD LEFT THREE JMS I (AL1 JMS I (AL1 TAD WORD4 /ADD DIGIT TO WORD4 TAD TEMP JMP XCTAL1 /LOOP ENDOXT, TAD WORD2 /PUT WORDS INTO THE LEFT PLACE DCA WORD1 TAD WORD3 DCA WORD2 TAD WORD4 DCA WORD3 JMP DATAFP /GO STUFF IT AWAY
/ DIMENSION, COMMON, REAL PAGE DIMENS, JMS I [IFCHEK JMS I [CHECKC /CHECK FOR "N" -316 JMP I [BADCMD /NO GOOD JMS I [TYPLST /PROCESS LIST 0000 /DIMENSION IS THE SIMPLEST CASE 0000 NOP /ERROR RETURN JMP I [NEXTST REAL, JMS I [IFCHEK /CHECK FOR INSIDE IF JMS I [TYPLST /PROCESS LIST 0102 /TYPE-REAL 0100 NOP JMP I [NEXTST COMPLE, JMS I [CHECKC /CHECK FOR "X" -330 JMP I [BADCMD JMS I [IFCHEK JMS I [TYPLST /PROCESS COMPLEX LIST 0103 0100 NOP CLA IAC /SET DP SWITCH DCA DPUSED JMP I [NEXTST COMMON, JMS I [IFCHEK /BAD INSIDE LOGICAL IF JMS I [GETC /CHECK FOR SLASH JMP I [BADCMD TAD M257 SZA CLA JMP BLANKC /MUST BE BLANK COMMON JMS I [GETNAM /GET NAME OF COMMON JMP DBLSLS /MIGHT BE // JMS I [CHECKC /LOOK FOR / M257, -257 JMP BADCOM JMS I [LOOKUP /LOOKUP COMMON NAME IAC DCA COMNAM /SAVE ADDR OF TYPE WORD CDF 10 TAD I COMNAM /LOOK AT TYPE SZA TAD (-111 /MUST BE COMMON OR UNDEF. SZA CLA JMP BADCOM TAD (111 /SET CORRECT BITS DCA I COMNAM CDF DOCOMN, JMS I [TYPLST /HANDLE LIST 4000 5460 JMP I [NEXTST TAD X12 DCA STACK /RESET STACK CDF 10 ISZ COMNAM /POINTER TO COMMON INFO DCA I NEXT /ZERO NEXT PTR WORD TAD I COMNAM /LOOK FOR END OF LIST SNA JMP EOCL /THIS IS IT DCA COMNAM /PROCEED DOWN LIST JMP .-4 EOCL, TAD NEXT /HOOK IN NEXT PART DCA I COMNAM TAD NUMELM DCA I NEXT /NUMBER IN THIS PART TAD NUMELM CIA DCA NUMELM CDF TAD I X12 /MOVE VARIABLE PTRS CDF 10 DCA I NEXT ISZ NUMELM JMP .-5 CDF JMS I [GETC /ANOTHER BLOCK ? JMP I [NEXTST /NO JMP COMMON+3 /MAYBE DBLSLS, JMS I [CHECKC /LOOK FOR SECOND SLASH -257 JMP BADCOM SKP BLANKC, JMS I [BACK1 /PUT BACK NON SLASH TAD (BLNKCN /USE BLANK COMMON DCA COMNAM JMP DOCOMN BADCOM, JMS I [ERMSG /ERROR IN COMMON STMT 0317 JMP I [NEXTST COMNAM, 0
/ EXTERNAL, FORMAT, BACKSPACE EXTERN, JMS I [TYPLST /PROCESS LIST 1000 6660 NOP JMP I [NEXTST FORMAT, TAD (FMTOPR /OUTPUT FORMAT OPERATOR JMS I [OUTWRD TAD NCHARS /GET NUMBER OF WORDS CIA CLL RAR /NWORDS=(NCHARS+1)/2 FMTLUP, JMS I [OUTWRD /OUTPUT IT JMS I [GETCWB /GET THE CHARS JMP I [NEXTST /NO MORE AND [77 CLL RTL /SHIFT LEFT 6 RTL RTL DCA TEMP JMS I [GETCWB /GET OTHER HALF NOP /IGNORE END OF LINE AND [77 TAD TEMP /PUT THEM TOGETHER JMP FMTLUP /LOOP /NOTE : THE ENTIRE FORMAT INCLUDING PARENTHESIS () / IS PASSED TO THE CODE BACKSP, JMS I [CHECKC /CHECK FOR "E" -305 JMP I [BADCMD JMS I [EXPR /COMPILE UNIT EXPR JMP I [BADCMD TAD (BAKOPR /OUTPUT BACKSPACE OPERATOR JMS I [OUTWRD JMP I [NEXTST
/ OUTPUT ROUTINE PAGE OUPTR, OUBUF OCOUNT, -401 OUTWRD, 0 /OUTPUT ROUTINE DCA OWTEMP /SAVE WORD TAD NOCODE SZA CLA JMP I OUTWRD /COOL IT IF NOCODE ISZ OCOUNT /TEST FOR BUFFER FULL JMP NOWRIT /STILL SOME ROOM JMS OUDUMP /DUMP THE BUFFER TAD OUBLOK-1 /RESET BUFFER PARAMETERS DCA OUPTR TAD (-400 DCA OCOUNT NOWRIT, TAD OWTEMP /PUT WORD CDF 10 DCA I OUPTR /INTO BUFFER CDF ISZ OUPTR /MOVE POINTER JMP I OUTWRD OULEN, 0 /NUMBER OF BLOCKS LEFT IN HOLE OUDUMP, 0 /DUMP OUT BUFFER TAD OULEN /ANY ROOM LEFT ? SNA JMP OUERR IAC DCA OULEN JMS I (7607 /CALL SYSTEM HANDLER 4210 OUBUF OUBLOK, 0 JMP OUERR ISZ OUBLOK /INCREMENT BLOCK NUMBER ISZ FILSIZ /ALSO SIZE OF FILE JMP I OUDUMP OUERR, JMS I [MESSAG /ERROR IN WRITING OR OPENING FILE 317 306
/ END PASS ONE XEND, JMS I [CHECKC /LOOK FOR "D" -304 JMP I [BADCMD JMS I [GETC /END MUST BE ALL JMP ENDX L7700, SMA CLA /NEVER SKIPS JMP I [BADCMD ENDX, CDF 0 TAD (ENDOPR /OUTPUT END OF FILE JMS I [OUTWRD JMS OUDUMP /DUMP BUFFER CIF 10 JMS I L7700 /LOCK MONITOR IN 10 CIF 10 CLA IAC JMS I L200 /CLOSE TEMP FILE 4 TMPFIL FILSIZ, 0 JMP OUERR CIF 10 CLA IAC JMS I L200 /OPEN PASS 2 OUTPUT FILE L3, 3 OBLK, TMPFIL+4 /STARTING BLOCK 0 /SIZE JMP OUERR /ERROR TAD (COMREG-1 /SAVE IMPORTANT STUFF DCA X10 TAD NEXT /ADDR OF FREE SPACE DCA I X10 TAD STKLVL /STACK LEVEL DCA I X10 TAD OUFILE /START OF PASS1 OUTPUT FILE DCA I X10 TAD FILSIZ /ALSO THE SIZE DCA I X10 TAD PASS2O /START OF PASS2 OVERLAY DCA I X10 TAD OBLK /START OF PASS2 OUTPUT FILE DCA I X10 TAD OBLK+1 /AND MAX SIZE DCA I X10 TAD PROGNM /POINTER TO PROG NAME DCA I X10 TAD ARGLST /AND ARG LIST DCA I X10 TAD FUNCTN /AND PROG SWITCH DCA I X10 TAD DPUSED /STORE THE DP SWITCH DCA I X10 TAD VERS /AND THE VERSION NUMBER DCA I X10 CIF 10 JMS I L200 /CHAIN TO PASS TWO 6 PASS2B, 0 /FILLED BY ONCE ONLY CODE FOR PASS 1 RETURN, TAD (RETOPR /OUTPUT RETURN CODE JMS I [OUTWRD ISZ DOEND /DO END ILLEGAL HERE JMP I [NEXTST COMARP, 0 /LOOK FOR COMMA OR RIGHT PAREN JMS I [GETC JMP I COMARP TAD [-254 /COMMA ? SNA JMP .+5 TAD L3 /RIGHT PAREN ? SZA CLA JMP I COMARP ISZ COMARP ISZ COMARP /COMMA INCR ONCE JMP I COMARP LOGICA, JMS I [CHECKC /LOOK FOR L -314 JMP I [BADCMD /NO GOOD JMS I [TYPLST /PROCESS LIST 0105 0100 L200, 0200 /NOP JMP I [NEXTST
/ EQUIVALENCE (UGH!) PAGE EQUIV, JMS I [IFCHEK /BAD WITH IF JMS I [CHECKC /LOOK FOR "E" -305 JMP I [BADCMD EQVLUP, JMS I [CHECKC /LOOK FOR ( -250 JMP BADEQU TAD STACK /SAVE STACK POS DCA X17 DCA NSLAVE /NUMBER OF SLAVES = 0 JMS I [GETSS /GET THE MASTER JMP BADEQU SVMSTR, CDF 10 /1.03/ CHECK FOR ALREADY EQUIVALENCED TAD I TEMP2 /1.03/ CDF /1.03/ AND (200 /1.03/ (AS A SLAVE) SZA CLA /1.03/ JMP DOFUNY /3.01/BACK UP TO ITS MASTER TAD TEMP2 /SAVE THE MASTER TYPE ADDRESS DCA MASTER DCA SFUDGE /3.01/CLEAR OFFSET FUDGE TAD DIMNUM /SAVE THE MASTER SUBSCRIPT DCA MNUM GETSLV, JMS I [COMARP /LOOK FOR , OR ) JMP BADEQU JMP DOSLAV /, TAD NSLAVE /COMPLEMENT THE NUMBER OF SLAVES SNA JMP ENDGRP /NO SLAVES CIA DCA NSLAVE TAD X17 /RESTACK THE STORE DCA STACK EQLOOP, TAD I X17 /GET NEXT SUBSCRIPT NUMBER DCA TEMP TAD I X17 /AND NEXT TYPE WORD ADDRESS DCA TEMP2 CDF 10 TAD I TEMP2 /LOOK AT TYPE WORD TAD (200 /SET EQUIVALENCE BIT DCA I TEMP2 ISZ TEMP2 /MOVE TO EQUIVALENCE/DIMENSION PTR TAD I TEMP2 /PROPAGATE DIMENSION POINTER DCA I NEXT /TO EQUIVALENCE INFO BLOCK TAD NEXT /NOW STORE EQ INFO BLK ADDRESS DCA I TEMP2 /INTO EQ-DIM POINTER WORD CLA CMA TAD MASTER /STORE S.T. ADDR OF MASTER DCA I NEXT /INTO THE EQUIVALENCE BLOCK TAD MNUM /OUTPUT NUMBERS DCA I NEXT TAD TEMP DCA I NEXT CDF ISZ NSLAVE /ANY MORE SLAVES ? JMP EQLOOP /YES, EQUIVALENCE NOT YET ATTAINED ENDGRP, JMS I [GETC /FINI, ALL VARIABLES ARE CREATED JMP I [NEXTST /EQUIVALENCED TAD (-254 /IS NEXT CHAR A COMMA ? SNA CLA JMP EQVLUP /IF YES, DO NEXT GROUP BADEQU, JMS I [ERMSG /SYNTAX ERROR IN EQUIVALENCE 2123 JMP I [NEXTST EQUCOM, JMS I [ERMSG /MULTIPLE LEVELS OF EQUIVALENCE OR 2114 /MORE THAN ONE COMMON VARIABLE JMP I [NEXTST DOSLAV, ISZ NSLAVE /ANOTHER SLAVE VARIABLE JMS I [GETSS /GET THE GOODS JMP BADEQU CDF 10 TAD I TEMP2 /LOOK AT THE TYPE SMA CLA JMP SVSLAV /IT ISN'T IN COMMON TAD I MASTER /LOOK AT THE MASTERS TYPE SPA CLA JMP EQUCOM /MASTER IS IN COMMON TOO .. BAD CDF TAD MNUM /SAVE THE MAGIC NUMBER JMS I [PUSH TAD MASTER JMS I [PUSH /AND THE S.T. ADDRESS JMP SVMSTR /NOW GO MAKE THE NEW ONE MASTER SVSLAV, TAD I TEMP2 /1.03/ PREVIOUSLY EQUIVALENCED ? AND (200 /1.03/ SZA CLA /1.03/ JMP EQUCOM /1.03/ YES, ERROR TAD DIMNUM /SAVE THE NEW SLAVE TAD SFUDGE /3.01/ADD OFFSET FUDGE CDF JMS I [PUSH TAD TEMP2 JMS I [PUSH JMP GETSLV /AND GO GET THE NEXT SLAVE SFUDGE, 0
/ROUTINE TO HANDLE TRIVIAL CASES OF EQUIVALENCE CHAINING /THIS WHOLE PAGE IS 3.01 DOFUNY, CLA IAC TAD TEMP2 DCA MASTER /GET POINTER TO EQUIVALENCE BLOCK CDF 10 TAD I MASTER DCA X12 CLA IAC TAD I X12 /GET ADDRESS OF "REAL" MASTER'S DCA MASTER /TYPE WORD TAD I X12 TAD DIMNUM DCA MNUM /OFFSETS ARE ADDITIVE TAD I X12 DCA SFUDGE /SAVE OTHER HALF OF OFFSET TO ADD CDF /TO SLAVES JMP GETSLV / (PRAY) PAGE
/ EQUIVALENCE (UGH!) O1420, 1420 /1.03/ MUST BE FIRST ON PAGE GETSS, 0 /GET THE LINEARIZED SUBSCRIPT DCA DIMNUM JMS I [GETNAM /GET THE VARIABLE JMP I GETSS JMS I [LOOKUP IAC /ADDRESS OF TYPE WORD DCA TEMP2 CDF 10 TAD I TEMP2 CDF O200, AND O1420 /1.03/ EXT, STMTFUN, SUBARG ? SZA CLA JMP I GETSS TAD STACK DCA X12 /SAVE STACK POSITION DCA TEMP /ZERO NUMBER OF DIMENSIONS TAD TEMP2 IAC DCA EQTEMP /ADDRESS OF EQ-DIM POINTER JMS I [GETC JMP I GETSS TAD (-250 /LOOK FOR ( SNA CLA JMP DIMGET-1 /OK JMS I [BACK1 JMP RGETSS DCA DIMNUM /DATA CALLS GETSS WITH AC = 7777 DIMGET, JMS I (SMLNUM /GET A SUBSCRIPT CLA CMA TAD EXPON /SS-1 JMS I [PUSH /SAVE SS ISZ TEMP /BUMP COUNT OF SS JMS I [COMARP /LOOK FOR , OR ) JMP I GETSS JMP DIMGET /, CLA IAC /) DCA DPRDCT /SET DIMENSION PRODUCT TO 1 TAD X12 /RESTORE STACK POSITION DCA STACK TAD TEMP /COMPLEMENT NUMBER OF SS CIA DCA TEMP CDF 10 CLL CML RTR /2000 AND I TEMP2 /HAS VARIABLE BEEN DIMENSIONED ? SNA CLA JMP I GETSS /NO, THATS BAD TAD I EQTEMP /GET ADDRESS OF DIMENSION BLOCK DCA EQTEMP TAD I EQTEMP /IS NUMBER OF DIMENSIONS TAD TEMP /EQUAL TO NUMBER OF SUBSCRIPTS ? SZA CLA JMP TRY1SS /1.03/ SEE IF ITS ONE SUBSCRIPT CLA CLL IAC /+1 V3C TAD I EQTEMP /+ NUMBER OF DIMENSIONS TAD EQTEMP /+ ADDRESS OF COUNT WORD DCA EQTEMP /GIVES ADDRESS OF NEXT TO LAST DIMENSION LINEAR, CDF TAD I X12 /GET NEXT SS - 1 DCA MQ TAD DPRDCT /MULTIPLY BY THE DIMENSION PRODUCT JMS MUL12 /WHERE D.P. = 1,D1,D1D2,D1D2D3,... TAD DIMNUM /ACCUMULATE THE SUM DCA DIMNUM CDF 10 TAD I EQTEMP /ADDR OF LITERAL IAC DCA X11 /WORKING POINTER TO VALUE TAD I X11 /GET DIMENSION INTO FAC DCA WORD1 TAD I X11 DCA WORD2 TAD I X11 DCA WORD3 CDF JMS I [FIXNUM /GO FIX IT DCA MQ TAD DPRDCT /OF THE D.P. SERIES (ABOVE) JMS MUL12 DCA DPRDCT CLA IAC /V3C BUMP POSITION POINTER TAD EQTEMP DCA EQTEMP ISZ TEMP /ANY MORE SS ? JMP LINEAR /YES RGETSS, ISZ GETSS JMP I GETSS TRY1SS, CLA IAC /1.03/ TAD TEMP /1.03/ ONLY ONE SS ? SZA CLA /1.03/ JMP I GETSS /1.03/ MORE, THATS NO GOOD CDF /1.03/ TAD I X12 /1.03/ GET THE SUBSCRIPT DCA DIMNUM /1.03/ AND RETURN IT JMP RGETSS /1.03/ MUL12, 0 /12 BIT UNSIGNED MULTIPLY DCA OP2 /SAVE OPERAND TAD (-15 /SET SHIFT COUNT DCA SC JMP STMUL M12LUP, TAD AC SNL JMP .+3 CLL TAD OP2 RAR STMUL, DCA AC TAD MQ RAR DCA MQ ISZ SC JMP M12LUP TAD MQ /RETURN VALUE JMP I MUL12 AC=OP3 SC=OP4
/ IF STATEMENTS PAGE IF, JMS I [EXPR /COMPILE CONDITION EXPRESSION JMP I [BADCMD JMS I [STMNUM /IS IT ARITHMETIC IF ? JMP LOGIF TAD (ARTHIF /START IF COMMAND JMS I [OUTWRD CLL CMA RTL DCA TEMP ISZ DOEND /DO END ILLEGAL HERE JMP IFLABL /GET IF LABELS IFLOOP, JMS I [CHECKC /LOOK FOR , -254 JMP I [NEXTST JMS I [STMNUM /GET NEXT STMT NUMBER JMP BADIF IFLABL, TAD SNUM /OUTPUT LABEL JMS I [OUTWRD ISZ TEMP JMP IFLOOP JMP I [NEXTST LOGIF, JMS IFCHEK /IF()IF()... NOT LEGAL ISZ IFSWIT /CLEAR IF SWITCH TAD (LIFBGN /START LOGICAL IF JMS I [OUTWRD JMP I (COMPIL /COMPILE THE STATEMENT DOSWT, IFCHEK, 0 /CHECK IF SWITCH TAD IFSWIT SNA CLA JMP I IFCHEK BADIF, JMS I [ERMSG 1111 JMP I [NEXTST
/ CALL STMT CALL, JMS I [SAVECP /SAVE CHAR POS JMS I [GETNAM /GET SUBROUTINE NAME JMP BADCAL /NO NAME HERE IS BAD JMS I [LOOKUP /GET ADDRESS OF TYPE WORD IAC DCA TEMP CDF 10 TAD I TEMP /LOOK AT TYPE AND (6640 /ANYTHING BUT EXT OR ARG ? SZA CLA JMP BADCAL /YES, BAD TAD I TEMP /SET EXT BIT AND (137 /LEAVE TYPE AND ARG BITS TAD (1000 DCA I TEMP CDF JMS I [RESTCP /RESTORE CHAR POS CLA IAC /SIGNAL THAT THIS IS A CALL JMS I [LEXPR /COMPILE IT XSTORE, DOSTOR /DON'T WORRY VIRGINIA, ITS A NOP TAD OWTEMP /WHAT WAS THE LAST THING OUT ? CLL TAD (-63 /IF LESS THAN 63 SNL CLA JMP I [NEXTST /IT WAS AN ARG COUNT TAD [ARGSOP /OTHERWISE IT WAS AN ARG LESS CALL JMS I [OUTWRD /SO TELL PASS 2 ABOUT IT JMS I [OUTWRD JMP I [NEXTST BADCAL, JMS I [ERMSG 2316 JMP I [NEXTST
/ DO DAH, DO DAH DO, JMS I [IFCHEK /IF(...)DO IS ILLEGAL JMS I [STMNUM /LOOK FOR ENDING STMT NUMBER JMP I [BADCMD JMS I [GETNAM /LOOKUP INDEX VARIABLE JMP I [BADCMD JMS I [LOOKUP DCA DOINDX JMS I [CHECKC /LOOK FOR = -275 JMP I [BADCMD ISZ DOEND /CAN'T END DO LOOP ON A DO JMS DOSTUF /GET DO PARAMETERS JMP BADDO TAD DOINDX /PUSH DO INDEX JMS I [PUSH TAD SNUM /PUSH ENDING STMT NUMBER JMS I [PUSH TAD STACK DCA STKLVL /SAVE NEW STACK BASE JMP I [NEXTST DOSTUF, 0 /SUBR FOR DO LOOP STUFF JMS I [OUTWRD /OUTPUT DO INDEX TAD DOINDX JMS I [OUTWRD JMS I [EXPR /GET EXPR FOR INITIAL VALUE JMP I DOSTUF TAD XSTORE /YES JMS I [OUTWRD JMS I [CHECKC /LOOK FOR COMMA N254, -254 JMP I DOSTUF JMS I [EXPR /GET EXPR FOR FINAL VALUE JMP I DOSTUF JMS I [GETC /LOOK FOR A COMMA JMP STEP1 /USE STEP OF 1 TAD N254 SZA CLA JMP STEP1-1 JMS I [EXPR /GET EXPR FOR STEP JMP I DOSTUF DORET, ISZ DOSTUF TAD (DOBEGN /DO BEGIN OPERATOR JMS I [OUTWRD JMP I DOSTUF JMS I [BACK1 /PUT BACK NON , (OFFICER BELOW LT.) STEP1, JMS I [OUTWRD /OUTPUT A PUSH 1.0 TAD (ONE JMS I [OUTWRD JMP DORET /FINISH DO STUFF BADDO, JMS I [ERMSG /BAD DO COMMAND 0417 JMP I [NEXTST BDERR, JMS I [ERMSG /ILLEGAL IN BLOCK DATA 0223 JMP I [NEXTST
/ TYPE STATEMENT SUBROUTINE PAGE TYPLST, 0 /HANDLE LIST FOR TYPE DELL TAD STACK DCA X12 /SAVE STACK POINTER DCA NUMELM TAD I TYPLST /GET SET BITS DCA SETBIT ISZ TYPLST TAD I TYPLST /AND ILLEGAL BITS DCA BADBIT ISZ TYPLST LSTLUP, JMS I [GETNAM /GET VARIABLE JMP BADLST JMS I [LOOKUP /S.T. SEARCH DCA TLTEMP /SAVE VAR ADDRESS TAD TLTEMP /PUT IT ON THE STACK ISZ TLTEMP /NOW POINT TO TYPE WORD JMS I [PUSH /INCREMENT NUMBER ISZ NUMELM /INCREMENT NUMBER CDF 10 TAD I TLTEMP /COMPARE TYPES AND BADBIT /CHECK FOR ILLEGAL BITS SZA CLA JMP TYPAGN /ATTEMPT TO RE-TYPE TAD SETBIT /GET SET BITS CMA /GENERATE MASK AND I TLTEMP TAD SETBIT /DO THE SET DCA I TLTEMP /BUT NOT DIMENSION BIT CDF GETDIM, JMS I [GETC JMP EOL TAD (-250 /LOOK FOR ( SZA JMP NOTDIM /NOT DIMENSIONED CLA IAC /INITIALIZE MAGIC NUMBER DCA DSERES CLA IAC DCA DPRDCT /AND DIMENSION PRODUCT TAD STACK DCA X17 /SAVE STACK POINTER DCA TEMP2 /DIMENSION COUNT=0 JMP I (DIMLUP /GET DIMENSIONS PUTDIM, TAD X17 DCA STACK /RESTORE STACK CDF 10 TAD (3400 /DIM, EXT, SF ? AND I TLTEMP SZA CLA JMP DIMAGN /ATTEMPT TP RE-DIMENSION CLL CML RTR TAD I TLTEMP /SET DIMENSION BIT DCA I TLTEMP ISZ TLTEMP TAD TEMP2 /NUMBER OF DIMS. DCA I NEXT TAD I TLTEMP /GET EQUIVALENCE POINTER SZA DCA TLTEMP TAD NEXT /STORE POINTER TO DCA I TLTEMP /DIMENSION INFORMATION TAD DPRDCT /SAVE DIM PRODUCT DCA I NEXT TAD DSERES /AND MAGIC NUMBER DCA I NEXT DCA I NEXT /ZERO MAGIC LITERAL POINTER TAD TEMP2 CIA DCA TEMP2 /LEAVE LAST DIM CDF MOVDIM, TAD I X17 /1.03/ GET THE DIMENSION CDF 10 /1.03/ DCA I NEXT /1.03/ INTO THE DIMENSION INFO BLOCK CDF /1.03/ ISZ TEMP2 /1.03/ JMP MOVDIM /1.03/ NEXTEL, JMS I [GETC /LOOK FOR , JMP TLRETN TAD (-254 SNA CLA JMP LSTLUP /OK, GET NEXT MEMBER ENDLST, JMS I [BACK1 ISZ TYPLST JMP I TYPLST BADDIM, JMS I [ERMSG /DIMENSION ERROR 0204 JMP I TYPLST BADLST, JMS I [ERMSG /ERROR IN LIST 2404 JMP I TYPLST TYPAGN, JMS I [ERMSG 2224 /RE-TYPE JMP GETDIM DIMAGN, JMS I [ERMSG /ATTEMPT TO RE DIMENSION 2204 JMP NEXTEL NOTDIM, TAD (250-254 /IS IT A COMMA? SZA CLA JMP ENDLST JMP LSTLUP /GET NEXT ELEMENT EOL, TLRETN, ISZ TYPLST JMP I TYPLST /TAKE OK EXIT ENDFIL, JMS I [CHECKC /LOOK FOR "E" -305 JMP I [BADCMD JMS I [EXPR /COMPILE UNIT JMP I [BADCMD TAD (ENDFOP /OUTPUT ENDFILE OPERATOR JMS I [OUTWRD JMP I [NEXTST DOUBLE, JMS I [CHECKC /LOOK FOR N -316 JMP I [BADCMD JMS I [IFCHEK /NOT ON AN IF JMS I [TYPLST /PROCESS LIST 0104 0100 NOP CLA IAC /SET THE DP SWITCH DCA DPUSED JMP I [NEXTST
/ SYMBOL TABLE LOOKERUPPER PAGE LOOKUP, 0 /SYMBOL TABLE LOOKUP FOR VARIABLE ENTRY TAD NOCODE /IS THIS IN NOCODE MODE ? SZA CLA JMP I LOOKUP /YES, DO NOTHING TAD BUCKET TAD (ALIST-1 /GET START OF CORRECT BUCKET CDF 10 LOOK, DCA OLDN3 /SAVE ADDR OF PREVIOUS ENTRY TAD I OLDN3 /GET ADDR OF NEXT ENTRY SNA JMP HOOKIN /NO NEXT ENTRY, ATTACH NEW ENTRY TAD (2 /SKIP OVER TYPE AND DIM POINTER DCA X10 TAD (NAME1 DCA PNAME /SETUP POINTER TO NAME CDF CHKNAM, TAD I PNAME /GET WORD NAME CIA CLL CDF 10 TAD I X10 /COMPARE WITH THIS ENTRY SZA CLA JMP NOTSAM /DIFFERENT CDF TAD I PNAME AND [77 /WAS THIS THE END OF NAME? ISZ PNAME SZA CLA JMP CHKNAM /NO, KEEP COMPARING CDF 10 RLOOKU, TAD I OLDN3 /GET ADDR OF START OF ENTRY CDF /AND RETURN IT IN THE AC JMP I LOOKUP /RETURN ADDR OF SYMBOL NOTSAM, SZL JMP HOOKIN /NEW SYMBOL <CURRENT ONE TAD I OLDN3 JMP LOOK /CONTINUE SEARCH HOOKIN, TAD I OLDN3 /HOOK NEW ENTRY INTO LIST DCA I NEXT TAD NEXT DCA I OLDN3 DCA I NEXT /ZERO TYPE WORD DCA I NEXT /ZERO EQUIVALENCE/DIMENSION POINTER TAD (NAME1 /PREPARE TO STICK IN THE NAME DCA PNAME CDF ENTERN, TAD I PNAME /MOVE NAME INTO S.T. CDF 10 DCA I NEXT CDF TAD I PNAME ISZ PNAME /END OF NAME? AND [77 SZA CLA JMP ENTERN /NO, KEEP GOING CDF 10 STCHEK, TAD NEXT /CHECK FOR S.T. OVERFLOW CIA CLL TAD (4740 /5000 STARTS PASS2 SKELETON TABLES SZL CLA JMP RLOOKU CDF JMS I [ERMSG /S.T. FULL 2324 JMP I (ENDX /TREAT AS END OF INPUT OLDN3, 0 /ADDR OF PREVIOUS ENTRY N3SIZE, 0 /SIZE OF ENTRY LTEMP, PNAME, /POINTER TO NAME BUFFER LUKUP2, 0 /LOOKUP FOR FIXED LENGTH SYMBOLS TAD I LUKUP2 /GET THE BUCKET START DCA OLDN3 /SAVE IT AS THE PREVIOUS ENTRY ISZ LUKUP2 TAD I LUKUP2 /GET THE ENTRY SIZE ISZ LUKUP2 DCA N3SIZE TAD LUKUP2 /SAVE RETURN ADDR DCA LOOKUP TAD NOCODE /IS CODE GENERATION OFF ? SZA CLA JMP I LOOKUP /YES, JUST RETURN CDF 10 LOOK2, TAD I OLDN3 /GET ADDR OF NEXT ENTRY SNA JMP HOKIN2 /IF 0 ITS END OF LIST IAC DCA X10 /START OF VALUE INFO TAD (WORD1-1 /SETUP POINTER TO PROTOTYPE DCA X11 TAD N3SIZE /AND TEMP OF ENTRY SIZE DCA LTEMP CHKVAL, CDF TAD I X11 CIA CLL /COMPARE THIS WORD OF THE VALUE CDF 10 TAD I X10 SZA CLA JMP NOTSM2 /NOT THIS ONE ISZ LTEMP /INCR SIZE COUNT JMP CHKVAL /MORE STUFF JMP RLOOKU /RETURN WITH THE GOODS NOTSM2, SZL JMP HOKIN2 /NEW SYMBOL < CURRENT ONE TAD I OLDN3 /CONTINUE SEARCH DCA OLDN3 JMP LOOK2 HOKIN2, TAD I OLDN3 /HOOK NEW ENTRY INTO LIST DCA I NEXT TAD NEXT DCA I OLDN3 TAD (WORD1-1 /PREPARE TO STICK IN THE VALUE DCA X11 DCA I NEXT /ZERO TYPE WORD CDF ENTERV, TAD I X11 /MOVE VALUE INTO S.T. CDF 10 DCA I NEXT ISZ N3SIZE /INCR SIZE COUNT JMP ENTERV-1 JMP STCHEK /STORE TYPE AND CHECK FOR OVERFLOW STOP, TAD (STOPOP /OUTPUT STOP OPERATOR JMS I [OUTWRD ISZ DOEND /DO ILLEGAL ON STOP JMP I [NEXTST
/ EXPRESSION ANALYZER PAGE EXPR, 0 /POLISHIZE EXPRESSION TAD EXPR JMS I [PUSH /SAVE RETURN ADDR JMS I [PUSH /MARK STACK UNOPR, JMS I [GETC /LOOK FOR UNARY OPERATOR JMP MISARG /THERE HAS TO BE AN OPERAND TAD (-253 /UNARY+(NOP) SNA JMP UNOPR TAD (253-255 /UNARY- SNA JMP UMINUS TAD (255-256 /.NOT. SZA CLA JMP OPRAND DCA BUCKET /FOR CKNOT JMS I (TRUFAL /.TRUE. OR .FALSE. ? JMP CKNOT /NEITHER, IS IT >.NOT. JMP .+3 /.TRUE. TAD (NOTOPR /FALSE=.NOT.TRUE JMS I [PUSH JMS I [OUTWRD TAD (TRUE JMS I [OUTWRD JMP I (NOSS CKNOT, TAD BUCKET TAD (-16 SZA CLA JMP OPRAND /MIGHT BE LITERAL .XXXXXX TAD (NOTOPR /PUSH .NOT. OPERATOR JMS I [PUSH JMP UNOPR UMINUS, TAD (UMOPR /PUSH UNARY MINUS JMS I [PUSH JMP UNOPR OPRAND, JMS I [BACK1 /PUT BACK NON UNARY OPERATOR JMS I [GETNAM /LOOK FOR VARIABLE REFERENCE JMP NOTVAR /NOPE. JMS I [LOOKUP /SYMBOL TABLE SEARCH JMP I [OPR8R /GO OUTPUT PUSH-VAR NOTVAR, JMS I [NUMBER /LOOK FOR A LITERAL JMP NOTNUM /NO KIND OF NUMBER JMP HOLCHK /INTEGER JMP DPLIT /DOUBLE PRECISION FPLIT, JMS I [LUKUP2 /FLOATING, ENTER INTO TABLE FPLIST -3 JMP I [OPR8RL /PUSH VARIABLE, NO SUBSCRIPTS DPLIT, JMS I [LUKUP2 /DOUBLE-PREC., ENTER IN TABLE DPLIST -6 JMP I [OPR8RL HOLCHK, JMS I [GETC /IS THIS HOLLERITH? JMP .+5 TAD (-310 SNA CLA JMP I (HFIELD /YES JMS I [BACK1 JMS I [LUKUP2 /FIND THE ENTRY INTLST -3 JMP I [OPR8RL NOTNUM, JMS I [GETC /LOOK FOR COMPLEX LITERAL JMP MISARG /MISSING OPERAND TAD (-250 /OPEN PAREN? SZA JMP QUOTE /GO LOOK FOR A STRING JMS I [SAVECP /SAVE CHAR POSITION JMS I [NUMBER /GET REAL PART JMP I (NCMPLX /NO NUMBER SKP /INTEGER-OK JMP I (NCMPLX /DOUBLE-NOT LEGAL FOR COMPLEX JMS I [CHECKC /LOOK FOR , -254 JMP I (NCMPLX /NO, CAN'T BE COMPLEX LIT. TAD WORD1 /SAVE REAL PART DCA TEMP TAD WORD2 DCA TEMP2 TAD WORD3 DCA CHAR JMS I [NUMBER /GET IMAGINARY PART JMP BADCL /NOT THERE, BAD SKP /I JMP BADCL /D-BAD JMS I [CHECKC /LOOK FOR ) -251 JMP BADCL /NO ) BAD TAD WORD1 /PUT IMAGINARY PART DCA WORD4 TAD WORD2 /INTO SECOND AHLF DCA WORD5 TAD WORD3 /OF COMPLEX LITERAL DCA WORD6 TAD TEMP /NOW RESTORE REAL PART DCA WORD1 TAD TEMP2 DCA WORD2 TAD CHAR DCA WORD3 CLL CMA RAL /REMOVE CHAR POS FROM STACK TAD STACK /SINCE OTHERWISE IT GOES OUT DCA STACK /AS CODE JMS I [LUKUP2 /WHICH WE WILL NOW SEARCH CMPLST /USE COMPLEX LIST -6 JMP I [OPR8RL BADCL, JMS I [ERMSG /BAD COMPLEX LITERAL 0314 JMP I [BADEXP MISARG, JMS I [ERMSG /MISSING OPERAND 1517 JMP I [BADEXP
/ EXPRESSION ANALYZER PAGE HQUOTE, 0 /SUBR FOR QUOTE STRINGS JMS I [GETCWB /GET CHAR JMP BADH TAD [-247 /IS IT ' SZA JMP NOTQ2 /NO JMS I [GETCWB JMP LUHOL TAD [-247 /LOOK FOR '' SNA CLA JMP NOTQ2 /REPLACE '' BY ' JMS I [BACK1 /ITS END OF STRING JMP LUHOL NOTQ2, TAD [247 /RESTORE CHAR AND [77 JMP I HQUOTE HFIELD, JMS I [FIXNUM /INTEGERIZE NUMBER SNA JMP BADH /ZERO IS BAD CMA CLL DCA TEMP TAD (HCOUNT /SET SUBR POINTER DOHOL, DCA HCHAR TAD (-MAXHOL /SET COUNTER FOR MAX DCA HOLCTR TAD (NAME1 /SET UP NAME POINTER DCA TEMP2 PAKHOL, DCA I TEMP2 /PACK HOLLERITH STRING JMS I HCHAR CLL RTL RTL RTL DCA I TEMP2 JMS I HCHAR TAD I TEMP2 DCA I TEMP2 ISZ TEMP2 ISZ HOLCTR /CHECK FOR TOO MANY JMP PAKHOL BADH, JMS I [ERMSG /BAD OR TOO BIG HOLLERITH FIELD 1017 JMP I [BADEXP LUHOL, TAD (33 /LOOK UP THIS LITERAL DCA BUCKET JMS I [LOOKUP JMP I [OPR8RL HCOUNT, 0 ISZ TEMP /CHECK COUNT SKP JMP LUHOL /EXPIRED JMS I [GETCWB /GET CHAR JMP BADH AND [77 /6-BIT IZE IT JMP I HCOUNT HOLCTR, 0 /COUNTER FOR HOLLERITH FIELDS NCMPLX, JMS I [RESTCP /NOT COMPLEX LITERAL JMS I [EXPR /MUST BE SUB EXPRESSION JMP BADEXP JMS I [GETC /LOOK FOR ) JMP PARMM TAD (-251 SNA CLA JMP I (NOSS /NO SUBSCRIPT LEGAL AFTER SUB EXPR PARMM, JMS I [ERMSG /MISSING ) 1515 BADEXP, JMS I [POP /BAD EXPRESSION, SZA CLA JMP BADEXP /LOOK FOR STACK MARKER JMS I [POP DCA TEMP /RETURN ADDR. JMP I TEMP JMS I [BACK1 /PUT BACK TEMINAL CHAR ENDEXP, JMS I [POP /GET NEXT THING FROM STACK SNA JMP EXPDUN /IF ZERO, FINISH IAC /GET ADDR OF OPERATION NUMBER DCA TEMP TAD I TEMP /GET OPERATOR VALUE JMS I [OUTWRD /OUTPUT OPERATOR XXXXXX JMP ENDEXP /LOOP EXPDUN, JMS I [POP /GET RETURN ADDR IAC DCA TEMP JMP I TEMP LETTER, 0 /GET A LETTER JMS I [GETC JMP I LETTER TAD (-301 SPA JMP NLETR TAD (301-333 SMA JMP NLETR TAD (33 ISZ LETTER JMP I LETTER NLETR, JMS I [BACK1 JMP I LETTER QUOTE, TAD (250-247 /IS IT ' SZA JMP MISARG /NO, OPERAND IS MISSING TAD (HQUOTE /SET SUBR POINTER JMP DOHOL CHECKC, 0 /CHECK FOR A SINGLE CHAR TAD I CHECKC /GET THE CHAR DCA CCTEMP ISZ CHECKC /SKIP PAST THE CHAR JMS I [GETC /GET CHAR FROM INPUT JMP I CHECKC /DIDN'T MAKE IT TAD CCTEMP /IS THIS IT ? SNA CLA ISZ CHECKC /YES JMP I CHECKC CCTEMP, 0
/ EXPRESSION ANALYZER PAGE BADFSS, JMS I [ERMSG 2323 JMP I [BADEXP OPR8R, DCA TEMP JMS I [OUTWRD /PUSH TAD TEMP JMS I [OUTWRD /OUTPUT OPERAND PTR JMS I [GETC JMP I [ENDEXP TAD (-250 /IS IT S.S. OR FUNCTION SZA JMP NOTFSS TAD STMJMP TAD (-DFINFL SNA CLA /FOR D.F.,PERMIT VARPARENS JMP NOTFSS ISZ TEMP /LOOK AT TYPE CDF 10 TAD (3420 /DIM, EXT, SF, OR ARG ? AND I TEMP SZA CLA JMP NOTFUN /NOT A FUNCTION REFERENCE TAD I TEMP TAD (1000 /SET EXT BIT DCA I TEMP NOTFUN, CDF SKP JMS I [POP /PUT COUNT INTO AC SSFUN, IAC /INCREMENT ARG COUNT JMS I [PUSH /SAVE IT ON THE STACK JMS I [EXPR /GET ARG (OR S.S.) JMP I [BADEXP JMS I [COMARP /LOOK FOR , OR ) JMP BADFSS /NEITHER JMP SSFUN-1 /, GET NEXT ARG (SUBSCRIPT?) TAD (ARGSOP /YES, OUTPUT ARGLIST OPER JMS I [OUTWRD JMS I [POP /AND THE COUNT JMS I [OUTWRD NOSS, JMS I [GETC /GET NEXT CHAR JMP I [ENDEXP TAD (-253 /PREPARE IT JMP NOTFSS+1 OPR8RL, DCA TEMP /SAVE ADDR OF LITERAL JMS I [OUTWRD TAD TEMP JMS I [OUTWRD JMP NOSS
/ TYPLST PART TWO DIMLUP, JMS I [NUMBER /GET DIMENSION JMP VARDIM /MAYBE ITS VAR DIM ? JMP .+3 /OK, INTEGER JMP BADDIM JMP BADDIM /DP AND FP ARE BAD JMS I [FIXNUM /FIX IT FOR SOME STUFF DCA MQ TAD DPRDCT /GET NEW DIMENSION PRODUCT JMS I [MUL12 DCA DPRDCT ISZ TEMP2 /INCREMENT DIM COUNT TAD WORD2 /IF WORD2 OR AC NON ZERO TAD AC /DIM IS TOO BIG SZA CLA /1.03/ JMP BADDIM /1.03/ JMS I (ANORM /1.03/ RENORMALIZE THE NUMBER JMS I [LUKUP2 /1.03/ ENTER IT INTO LITERAL LIST INTLST /1.03/ -3 /1.03/ PSHDIM, JMS I [PUSH /1.03/ AND SAVE ON THE STACK JMS I [COMARP /LOOK FOR , OR ) JMP BADDIM SKP /COMMA MEANS ANOTHER DIM FOLLOWS JMP PUTDIM /) MEANS END OF DIMS TAD DSERES /FORM NEXT VALUE OF MAGIC NUMBER TAD DPRDCT DCA DSERES JMP DIMLUP /NOW LOOP FOR NEXT DIM VDTEMP, 0 VARDIM, CDF 10 /IS ARRAY AN ARG ? TAD I TLTEMP CDF AND (20 SNA CLA JMP BADDIM /NO, BAD DIMENSION JMS I [GETNAM /OK, GET DIMENSION JMP BADDIM JMS I [LOOKUP IAC DCA VDTEMP /ADDR OF TYPE WORD CDF 10 /IS THA VARIABLE AN ARG ? TAD I VDTEMP AND (20 CDF SNA CLA JMP BADDIM /NO, THATS BAD DCA DPRDCT /3.02 ZERO DIM PRODUCT ISZ TEMP2 /INCREMENT DIM COUNT CMA /1.03/ TAD VDTEMP /1.03/ SAVE DIMENSION VARIABLE JMP PSHDIM /3.02 SAVE DIM ON STACK MESSAG, 0 /PRINT PASS1 IMMEDIATE ERROR TAD I MESSAG /GET CHAR ONE ISZ MESSAG JMS I (TTYOUT TAD I MESSAG /GET CHAR TWO JMS I (TTYOUT TAD (215 /CR JMS I (TTYOUT TAD (212 /LF JMS I (TTYOUT JMP I (7605 /EXIT TO MONITOR
/ EXPRESSION ANALYZER REVISITED PAGE NOTFSS, TAD (250-253 /IS IT + SZA JMP .+3 TAD (ADDOPR /YES JMP GOTOPR TAD (253-255 /IS IT - SZA JMP .+3 TAD (SUBOPR /YES JMP GOTOPR TAD (255-252 /IS IT * SZA JMP NOTMUL /NO JMS I [GETC JMP NOTEXP TAD (-252 /IS IT ** SZA CLA JMP .+3 TAD (EXPOPR /YES JMP GOTOPR JMS I [BACK1 NOTEXP, TAD (MULOPR /IT WAS * JMP GOTOPR NOTMUL, TAD (252-257 /IS IT / SZA JMP .+3 TAD (DIVOPR /YES JMP GOTOPR IAC /IS IT . SZA CLA JMP I (ENDEXP-1 /NO, END OF EXPR JMS CKEOPR /LOOK FOR EXTENDED OPERATOR JMP BADOPR /NONE THERE JMS I [CHECKC /CHECK FOR CLOSING . -256 JMP BADOPR /NOT THERE CDF 10 /3.01/ TAD I X10 /GET OPERATOR POINTER CDF JMP GOTOPR CKEOPR, 0 /CHECK FOR EXTENDED OPERATOR JMS I [GETNAM /GET NAME JMP I CKEOPR /NONE TAD (OPRLST-1 /PTR TO LIST DCA X10 OPRLUP, CDF 10 /3.01/ TAD I X10 /COMPARE FIRST CHAR CDF 0 SNA JMP I CKEOPR /END OF LIST TAD BUCKET SZA CLA JMP NOTHIS /NOT THIS ONE CDF 10 /3.01/ TAD I X10 CDF TAD I (NAME1 /COMPARE 2ND AND 3RD SZA CLA JMP NOTHIS+1 /NOT THIS ONE ISZ CKEOPR /BUMP RETURN JMP I CKEOPR NOTHIS, ISZ X10 /BUMP LIST PTR ISZ X10 /AGAIN JMP OPRLUP /KEEP GOING BADOPR, JMS I [ERMSG /NOT LEGAL EXT. OPER. 1720 JMP I [BADEXP GOTOPR, DCA NEWOP /SAVE NEWEST OPER. JMS I [POP /GET STACK TOP SNA JMP PUSH2 /EMPTY DCA OLDOP TAD I OLDOP /COMPARE PREC. CIA TAD I NEWOP /NEW-OLD SPA SNA CLA JMP OUTOLD /OLD>NEW TAD OLDOP PUSH2, JMS I [PUSH /OLD < NEW TAD NEWOP /GO PUSH BOTH JMS I [PUSH JMP I (UNOPR /GO LOOK FOR NEXT OPERAND OUTOLD, ISZ OLDOP /OUTPUT OPERATOR TAD I OLDOP JMS I [OUTWRD JMP GOTOPR+1 /TRY NEXT STACK ELEMENT NEWOP=WORD1 OLDOP=WORD2
/ UTILITIES GETCWB, 0 /GET A CHARACTER (PRESERVE BLANKS) ISZ NCHARS JMP .+4 CLA CMA DCA NCHARS /RESET NCHARS JMP I GETCWB ISZ GETCWB TAD I CHRPTR /GET THE CHAR JMP I GETCWB SAVECP, 0 /SAVE CHAR POSITION TAD NCHARS JMS I [PUSH TAD CHRPTR JMS I [PUSH JMP I SAVECP FIXNUM, 0 /FIX FAC (I'M MOVING IT AGAIN) TAD WORD1 /IS IT FIXED ? TAD (-27 SNA JMP RETFN /YES, EXPONENT IS 23 SMA CLA JMP I FIXNUM /BAD IF EXP IS >23 JMS I (AR1 /RIGHT SHIFT ONE JMP FIXNUM+1 /TEST AGAIN RETFN, TAD WORD3 /RETURN LOWEST 12 BITS JMP I FIXNUM
/ UTILITIES PAGE GETC, 0 /GET A CHARACTER (IGNORING BLANKS) ISZ NCHARS JMP .+4 CLA CMA DCA NCHARS JMP I GETC TAD I CHRPTR TAD (-240 /IS IT A BLANK SNA JMP GETC+1 /YES IGNORE IT TAD (240 /FIX CHAR ISZ GETC JMP I GETC ERMSG, 0 /ERROR MESSAGE HANDLER CDF TAD NOCODE /IS CODE GENERATION ON ? SZA CLA JMP NOTOUT /NO TAD (ERRCOD /ERROR CODE TO OUTPUT FILE JMS I [OUTWRD TAD I ERMSG ISZ ERMSG JMS I [OUTWRD JMP I ERMSG /RETURN NOTOUT, TAD I ERMSG /SAVE THE ERROR CODE ISZ ERMSG DCA ERCODE JMP I ERMSG POP, 0 /PUT TOP OF STACK INTO AC TAD STACK DCA ERMSG CLA CMA TAD STACK DCA STACK /DECREMENT STACK POINTER TAD I ERMSG JMP I POP TRUFAL, 0 /CHECK FOR LOGICAL LITERALS JMS I [GETNAM JMP I TRUFAL JMS I [CHECKC /LOOK FOR TERMINAL . -256 JMP I TRUFAL TAD BUCKET /LOOK AT FIRST CHAR TAD (-24 SNA JMP .+5 /ITS "T" TAD (24-6 SZA CLA JMP I TRUFAL /ITS NEITHER ISZ TRUFAL /ITS "F" ISZ TRUFAL JMP I TRUFAL
/ LEFT HALF EXPRESSION ANALYZER LEXPR, 0 /GET LEFT HAND EXPRESSION DCA LETEMP /SAVE CALL SWITCH JMS I [GETNAM /LOOK FOR VAR NAME JMP MSNGOP /MUST BE THERE JMS I [OUTWRD /OUTPUT A ZERO (PUSH) JMS I [LOOKUP /SEEK OUT ENTRY FOR THIS VAR DCA TEMP TAD TEMP JMS I [OUTWRD JMS I [GETC /LOOK FOR DIMENSIONS JMP LEXPOK /NO ( TAD (-250 SZA CLA JMP LEXPOK-1 /NO ( ISZ TEMP /LOOK AT TYPE CDF 10 CLL CML RTR /DIMENSIONED ? AND I TEMP TAD LETEMP /OR A CALL ? TAD NOCODE /OR CODE OFF ? SZA CLA JMP NOTSF /YES, NOT AN ARITHMETIC S.F. TAD I TEMP AND (1420 /EXT, SF, OR ARG ? SNA CLA /V3C TAD [-M6 /SEE IF CALLED FROM SPECIAL PLACE TAD LEXPR /V3C COMPARE WITH ENTRY PT SZA CLA JMP ASFERR /THIS IS BAD IF SO TAD I TEMP TAD (400 DCA I TEMP /SET A.S.F. BIT CDF TAD (ASFDEF /DEFINE ASF JMS I [OUTWRD NOTSF, CDF SKP JMS I [POP /ARG COUNT TO AC SSLOOP, IAC /INCREMENT SS COUNT JMS I [PUSH /SAVE ON THE STACK JMS I [EXPR /COMPILE SUBSCRIPT JMP FSSBAD+2 /ERROR WITHIN SS JMS I [COMARP /LOOK FOR , OR ) JMP FSSBAD /NEITHER (THERE WAS A BUG HERE) JMP SSLOOP-1 /, GET NEXT ARG/SS TAD (ARGSOP /OUTPUT SS OPERATOR JMS I [OUTWRD JMS I [POP /THEN COUNT JMS I [OUTWRD SKP JMS I [BACK1 /PUT BACK A CHARACTER LEXPOK, ISZ LEXPR JMP I LEXPR /RETURN MSNGOP, JMS I [ERMSG /MISSING OPERAND 1517 JMP I LEXPR FSSBAD, JMS I [ERMSG /MISSING COMMA OR CLOSE PARENTHESIS 2323 JMS I [POP /GET ARG COUNT OFF STACK CLA JMP I LEXPR ASFERR, JMS I [ERMSG /BAD ARITHMETIC STMT FUNCTION 2306 JMP NOTSF /DO THE REST OF THE ASF DEF LETEMP, 0
/UTILITIES PAGE G2CTMP, PUSH, 0 /PUT AC ONTO STACK DCA I STACK /STORE TAD (STACKS+100 /CHECK FOR STACK OVERFLOW CIA CLL TAD STACK SNL CLA JMP I PUSH /OK, RETURN DCA NOCODE /SET CODE GENERATION ON JMS I [ERMSG 2004 JMP I [NEXTST GET2C, 0 /GET 2 SIX BIT CHARS INTO ONE WPRD JMS I [GETC /GET FIRST CHAR JMP I GET2C AND [77 CLL RTL RTL RTL DCA G2CTMP JMS I [GETC /GET SECOND CHAR JMP I GET2C ISZ GET2C /FIX RETURN ADDR AND [77 TAD G2CTMP JMP I GET2C STMNUM, 0 /PICK UP STATEMENT NUMBER DCA WORD4 /SAVE DEFINED BIT (IF ANY) DCA WORD2 /ZERO SOME STUFF DCA WORD3 JMS DIGIT /GET A DIGIT JMP I STMNUM /NONE THERE, NO STMT NUMBER TAD (-60 /IS IT A LEADING 0 ? SNA JMP .-4 /YES, IGNORE IT TAD (60 CLL RTL RTL RTL DCA WORD1 JMS DIGIT /GET SECOND DIGIT JMP ENDNUM /END OF NUMBER TAD WORD1 DCA WORD1 /COMBINE FIRST AND SECOND JMS DIGIT JMP ENDNUM CLL RTL RTL RTL DCA WORD2 JMS DIGIT JMP ENDNUM /COMBINE THIRD AND FOURTH TAD WORD2 DCA WORD2 JMS DIGIT /GET FIFTH DIGIT JMP ENDNUM CLL RTL RTL RTL DCA WORD3 ENDNUM, JMS I [LUKUP2 /LOOK UP IN S.T. SNLIST /STMT NUMBER LIST -3 ISZ STMNUM DCA SNUM /SAVE S.T. ADDRESS OF LABEL CDF 10 /SET TYPE WORD TAD SNUM /GET ADDR OF TYPE IAC DCA SNTEMP TAD I SNTEMP /GET TYPE WORD CLL TAD WORD4 /PUT IN THE DEFINITION BIT SNL DCA I SNTEMP /RESTORE IT IF NOT MULTIPLE DEFN CDF SNL CLA JMP I STMNUM JMS I [ERMSG 1514 JMP I STMNUM SNTEMP, DIGIT, 0 /GET A DIGIT JMS I [GETC /GET A CHAR JMP I DIGIT TAD (-272 /IS IT > 271 (9) SMA JMP NODIGT /YES, ITS GREATER TAD (272-260 /IS IT < 260 (0) SPA JMP NODIGT /YES, ITS LESS TAD (60 ISZ DIGIT JMP I DIGIT /TAKE SUCCESSFUL RETURN NODIGT, JMS I [BACK1 /RESTORE NON DIGIT JMP I DIGIT ASSIGN, JMS I [STMNUM /GET STMT NUMBER JMP BADASN JMS I [GET2C /LOOK FOR "TO" JMP BADASN TAD (-2417 SNA CLA JMS I [LEXPR /GET ASSIGN VARIABLE JMP BADASN TAD (ASNOPR /OUTPUT ASSIGN OPERATOR JMS I [OUTWRD TAD SNUM /NOW STMT NUMBER JMS I [OUTWRD JMP I [NEXTST BADASN, JMS I [ERMSG 0123 JMP I [NEXTST TTYOUT, 0 /TTY OUTPUT ROUTINE TLS TSF JMP .-1 CLA JMP I TTYOUT
/ PRECEDENCE TABLE PAGE ADDOPR, 100 1 SUBOPR, 100 2 MULOPR, 200 3 DIVOPR, 200 4 EXPOPR, 500 5 NOTOPR, 30 6 UMOPR, 400 7 EQOPR, 40 16 NEOPR, 40 17 GEOPR, 40 10 GTOPR, 40 11 LEOPR, 40 12 LTOPR, 40 13 ANDOPR, 20 14 OROPR, 10 15 XOROPR, 7 20 EQVOPR, 7 21
/ UTILITY ROUTINES BACK1, 0 /BACK UP ONE CHAR CLA CMA TAD NCHARS DCA NCHARS CLA CMA TAD CHRPTR DCA CHRPTR JMP I BACK1 OADD, 0 /ADD OPERAND TO FAC CLL TAD OPO TAD ACO DCA ACO RAL TAD OP6 TAD WORD6 DCA WORD6 RAL TAD OP5 TAD WORD5 DCA WORD5 RAL TAD OP4 TAD WORD4 DCA WORD4 RAL TAD OP3 TAD WORD3 DCA WORD3 RAL TAD OP2 TAD WORD2 DCA WORD2 JMP I OADD
/ FLOATING POINT DIVIDE ROUTINE PAGE FPDIV, 0 JMS I DAR1 /UNNORMALIZE AC BY ONE TAD OP1 /COMPUTE FINAL EXPONENT CIA TAD WORD1 DCA OP1 /AND SAVE IT TAD DM74 /SET ITERATION COUNTER DCA DITCNT TAD WORD2 RAL /INITIALIZE LINK FPDVLP, CLA RAR /COMPARE SIGNS TAD OP2 SPA CLA JMP .+3 TAD OPMAC /NEGATE OPERAND JMS I DFNEG JMS I DOADD /ADD OPERAND AND FAC TAD D6 /RIGHT SHIFT QUOTIENT RAL /PRESERVING ADD OVERFLOW BIT DCA D6 TAD D5 RAL DCA D5 TAD D4 RAL DCA D4 TAD D3 RAL DCA D3 TAD D2 RAL DCA D2 JMS I DAL1 /LEFT SHIFT FAC ONE ISZ DITCNT /TEST ITERATION COUNT JMP FPDVLP TAD OP1 /PUT QUOTIENT INTO FAC DCA WORD1 TAD D2 DCA WORD2 TAD D3 DCA WORD3 TAD D4 DCA WORD4 TAD D5 DCA WORD5 TAD D6 DCA WORD6 DCA ACO JMS I DNORM /NORMALIZE JMP I FPDIV D2, 0 D3, 0 D4, 0 D5, 0 D6, 0 DITCNT, 0 DAR1, AR1 DAL1, AL1 DM74, -74 OPMAC, OPO-ACO DFNEG, NEGFAC DOADD, OADD DNORM, ANORM *STACKS-1 -1 /TO PREVENT SPURIOUS DO ENDS
/ NUMERIC CONVERSION ROUTINE PAGE NUMBER, 0 /GENERAL NUMBER CONVERSION ROUTINE DCA ESWIT /ZERO E/D SWITCH DCA DECPT /ZERO DECIMAL POINT SWITCH DCA WORD1 /ZERO FAC DCA WORD2 DCA WORD3 DCA WORD4 DCA WORD5 DCA WORD6 DCA ACO DCA SIGN /CLEAR SIGN SWITCH JMS I [GETC /GET A CHAR JMP I NUMBER /NO CHAR IS NO NUMBER JMS CHKSGN /CHECK FOR SIGN SIGN, 0 /THIS SWITCH GETS SET DCA NDIGIT /ZERO DIGIT COUNT CONVLP, JMS I [DIGIT /GET A DIGIT JMP TRYDEC /IS THERE A DECIMAL POINT ? AND [17 DCA NXTDGT /SAVE THE DIGIT ISZ NDIGIT /INCR NUMBER OF DIGITS TAD WORD2 /PREPARE TO MULT BY 10 DCA OP2 TAD WORD3 DCA OP3 TAD WORD4 DCA OP4 TAD WORD5 DCA OP5 TAD WORD6 DCA OP6 TAD ACO DCA OPO JMS I (AL1 /DOUBLE FAC JMS I (AL1 /DOUBLE AGAIN JMS I (OADD /TIMES FIVE JMS I (AL1 /ONE MORE DOUBLING IS TIMES 10 DCA OP2 DCA OP3 /PUT NEWEST DIGIT INTO OPERAND DCA OP4 DCA OP5 DCA OP6 TAD NXTDGT DCA OPO JMS I (OADD /ADD IN NEWEST DIGIT JMP CONVLP TRYDEC, TAD DECPT /DECIMAL ALREADY ? SZA CLA JMP TRYE2 /YES, LOOK FOR EXPONENT JMS I [GETC /LOOK FOR . JMP DIGTST /SEE IF THERE WAS ANYTHING TAD (-256 SZA JMP TRYE1 /TRY FOR E JMS I [SAVECP /SAVE CHAR POS JMS I (CKEOPR /CHECK FOR SPECIAL CASE OF LIT.RE. JMP NOLDRE /NOT LIT.RE. JMS I [RESTCP JMS I [BACK1 /PUT BACK . IT BELONGS TO RELATIONAL DIGTST, TAD NDIGIT /ANY DIGITS ? SNA CLA JMP I NUMBER /NO, NO NUMBER JMP INTEGR /TAKE INTEGER EXIT NOLDRE, ISZ DECPT /SET DECIMAL POINT SW JMS I [RESTCP /RESTORE CHAR POS JMP CONVLP-1 /LOOP FOR OTHER DIGITS TRYE1, JMS I [BACK1 /PUT BACK NON . TAD NDIGIT /ANY DIGITS YET ? SNA CLA JMP I NUMBER /NO, NO NUMBER JMS EORD /LOOK OR E OR D JMP INTEGR TRYE2, JMS EORD /LOOK FOR E OR D FPNUM, ISZ NUMBER ISZ NUMBER DCA EXPON /ZERO EXPONENT JMS I (DODEC /HANDLE DIGITS RIGHT OF . JMP DOSIGN-1 /GO DO SIGN INTEGR, TAD (107 /PUT IN EXPONNT DCA WORD1 JMS I (ANORM /NORMALIZE ISZ NUMBER /BUMP RETURN DOSIGN, TAD SIGN /CHECK THE SIGN SZA CLA JMS I (NEGFAC /NEGATE IF NEGATIVE JMP I NUMBER /RETURN CHKSGN, 0 /CHECK FOR SIGN TAD (-255 /IS IT - ? SNA ISZ I CHKSGN /YES, SET SWITCH SZA TAD (255-253 /IS IT + ? SZA CLA JMS I [BACK1 /RETURN CHAR OTHERWISE JMP I CHKSGN EORD, 0 /LOOK FOR E OR D JMS I [GETC /LOOK FOR E OR D JMP I EORD TAD (-304 CLL RAR SZA CLA /E OR D? JMP NOEORD /NO SZL ISZ ESWIT /SET SWITCH IF E SNL ISZ DPUSED /SET D.P. SWITCH IF D JMP I (GETEXP /OK, GET EXPONENT NOEORD, JMS I [BACK1 /PUT IT BACK CAUSE ITS NOT OURS JMP I EORD NXTDGT, 0 REWIND, JMS I [EXPR /COMPILE UNIT JMP I [NEXTST TAD (REWOPR /OUTPUT REWIND OPERATOR JMS I [OUTWRD JMP I [NEXTST
/ NUMERIC CONVERSION ROUTINE PAGE SMLNUM, 0 /INPUT A NUMBER <= 4095 EXPLUP, DCA EXPON /ZERO THE EXPONENT JMS I [DIGIT /GET THE NEXT DIGIT JMP I SMLNUM /NUMBER DONE AND [17 DCA OPO /SAVE THE DIGIT TAD EXPON /MULT BY 10 CLL RAL CLL RAL TAD EXPON CLL RAL TAD OPO /ADD IN DIGIT JMP EXPLUP /STORE BACK INTO EXPONENT GETEXP, DCA ESIGN /ZERO EXPONENT SIGN SWITCH JMS I [GETC /GET A CHAR JMP I (FPNUM+1 JMS I (CHKSGN /IS IT A SIGN FPRTNE, ESIGN, 0 /THIS IS THE SWITCH TO SET JMS SMLNUM /GO GET THE EXPONENT FIXEXP, TAD ESIGN /CHECK EXPONENT SIGN SNA CLA JMP .+4 TAD EXPON /COMPLEMENT EXPONENT CIA DCA EXPON JMS DODEC /GO HANLE EXPONENT CLL CML RTL /BUMP RETURN BY TWO (DP) OR 3 (FP) TAD ESWIT /DEPENDING ON E/D SWITCH TAD I [NUMBER DCA I [NUMBER JMP I (DOSIGN /CHECK THE SIGN DODEC, 0 TAD DO107 /NORMALIZE THE NUMBER DCA WORD1 JMS I (ANORM TAD DECPT /WAS THERE A DECIMAL POINT ? SZA CLA TAD NDIGIT /HOW MANY DIGITS TO THE RIGHT ? CIA TAD EXPON /SUBTRACT THAT NUMBER FROM EXP SMA JMP POSEXP /EXPONENT IS POSITIVE CIA DCA EXPON /ONLY NEED ABS VALUE TAD (FPDIV /DO DIVIDES JMP .+3 POSEXP, DCA EXPON TAD (FPMUL /DO MULTIPLIES DCA FPRTNE /MULTIPLY/DIVIDE ROUTINE TAD (PETABL-1 /POWERS OF TEN TABLE DCA X17 EXPMUL, TAD EXPON /LOOK AT THE EXPONENT SNA JMP I DODEC /IF 0 ITS THRU CLL RAR DCA EXPON /PUT LOWEST BIT INTO LINK SNL JMP SKPEXP /THIS ONE DOESN'T COUNT CDF 10 /3.01/ TAD I X17 /MOVE FACTOR INTO OPERAND DCA OP1 TAD I X17 DCA OP2 TAD I X17 DCA OP3 TAD I X17 DCA OP4 TAD I X17 DCA OP5 TAD I X17 DCA OP6 DCA OPO CDF JMS I FPRTNE /MULTIPLY OR DIVIDE BY THIS FACTOR JMP EXPMUL /CHECK NEXT BIT SKPEXP, TAD X17 /SKIP OVER THIS FACTOR TAD (6 JMP EXPMUL-1 AR1, 0 /SHIFT FAC RIGHT ONE TAD WORD2 CLL RAR DCA WORD2 TAD WORD3 RAR DCA WORD3 TAD WORD4 RAR DCA WORD4 TAD WORD5 RAR DCA WORD5 TAD WORD6 RAR DCA WORD6 TAD ACO RAR DCA ACO ISZ WORD1 DO107, 107 JMP I AR1 AL1, 0 /SHIFT FAC LEFT ONE TAD ACO CLL RAL DCA ACO TAD WORD6 RAL DCA WORD6 TAD WORD5 RAL DCA WORD5 TAD WORD4 RAL DCA WORD4 TAD WORD3 RAL DCA WORD3 TAD WORD2 RAL DCA WORD2 JMP I AL1
/ NUMERIC CONVERSION ROUTINE PAGE FPMUL, 0 /FLOATING MULTIPLY ROUTINE TAD WORD1 /COMPUTE NEW EXPONENT TAD OP1 DCA OP1 TAD WORD2 /SAVE AC MANTISSA DCA TW2 TAD WORD3 DCA TW3 TAD WORD4 DCA TW4 TAD WORD5 DCA TW5 TAD WORD6 DCA TW6 TAD (-74 /SET ITERATION COUNTER DCA ITRCNT DCA WORD2 /ZERO FAC MANTISSA DCA WORD3 DCA WORD4 DCA WORD5 DCA WORD6 DCA ACO MULLUP, JMS I (AR1 /SHIFT FAC RIGHT ONE TAD TW2 /SHIFT MULTIPLIER RIGHT CLL RAR DCA TW2 TAD TW3 RAR DCA TW3 TAD TW4 RAR DCA TW4 TAD TW5 RAR DCA TW5 TAD TW6 RAR DCA TW6 SZL JMS I (OADD /ADD IF LINK IS ONE ISZ ITRCNT /BUMP COUNT JMP MULLUP /LOOP TAD OP1 /PUT IN CORRECT EXPONENT DCA WORD1 JMS I (ANORM /NORMALIZE THE RESULT JMP I FPMUL TW2, 0 TW3, 0 TW4, 0 TW5, 0 TW6, 0 ANORM, 0 /NORMALIZE FAC TAD WORD2 /IS MANTISSA 0 ? SNA TAD WORD3 SNA TAD WORD4 SNA TAD WORD5 SNA TAD WORD6 SNA TAD ACO SNA CLA JMP ZEXP /YES, ZERO EXPONENT NORMLP, CLA CLL CML RTR /IS HIGH ORDER MANTISSA = 6000 TAD WORD2 SZA JMP NO6000 /NO, SKIP THIS STUFF TAD WORD3 /YES, IS THE REST 0 ? SNA TAD WORD4 SNA TAD WORD5 SNA TAD WORD6 SNA TAD ACO SZA CLA /SKIP IF 600000 ... 0000 NO6000, SPA CLA JMP I ANORM /NORM IS DONE WHEN BITS DIFFER JMS I (AL1 /SHIFT LEFT ONE CLA CMA /DECREMENT EXPONENT TAD WORD1 DCA WORD1 JMP NORMLP /LOOP ZEXP, DCA WORD1 JMP I ANORM NEGFAC, 0 /NEGATE FAC TAD (ACO /GET POINTER TO OPERAND DCA NFPTR TAD (-6 /SIX WORD NEGATE DCA NFCNT CLL NFLOOP, RAL TAD I NFPTR /GET NEXT WORD CLL CML CIA DCA I NFPTR /RESTORE AFTER COMPLEMENTING CML CLA CMA /LINK GETS COMPLEMENTED ONCE HERE TAD NFPTR /AND ONCE AGAIN HERE DCA NFPTR /RESTORE DECREMENTED POINTER ISZ NFCNT JMP NFLOOP JMP I NEGFAC NFPTR, 0 NFCNT, 0 ITRCNT, DHLRTH, 0 /HOLLERITH IN DATA SUBR ISZ TEMP SKP JMP I DHLRTH ISZ DHLRTH JMS I [GETCWB JMP DHOLER JMP I DHLRTH
/ VARIABLE SCANNER PAGE GETNAM, 0 /GET VARIABLE NAME JMS LETTER /FIRST CHAR MUST BE ALPHABETIC JMP I GETNAM /NO VARIABLE DCA BUCKET /FIRST ONE IS THE BUCKET TAD (NAME1 DCA NPTR /POINTER TO NAME BUFFER CLL CMA RTL /SIX CHARS MAX (3 WORDS) DCA NCNT PAKLUP, JMS LETTER /GET A LETTER SKP JMP .+3 /WE GOT IT JMS I [DIGIT /NO LETTER, IS IT A DIGIT ? JMP NDONE /NO, NAMES OVER CLL RTL RTL RTL /MOVE CHAR TO A HIGHER PLACE DCA I NPTR /STORE IT ISZ NCNT /BUMP COUNTER JMP MORNAM /MORE TO COME SKP NDONE, DCA I NPTR /ZERO NEXT WORD ISZ GETNAM /FIX RETURN ADDR JMP I GETNAM MORNAM, JMS LETTER /GET NEXT CHAR SKP JMP .+3 /ITS A LETTER JMS I [DIGIT JMP NDONE+1 /NO GOOD, NAMES OVER TAD I NPTR DCA I NPTR /COMBINE TWO CHARS ISZ NPTR JMP PAKLUP NPTR, 0 NCNT=OADD
/ DATA STATEMENT DATA, JMS I [IFCHEK /IF(..)DATA ???? TAD (DATAST /START DATA STATEMENT JMS I [OUTWRD DATLUP, CLA CMA /SET DIMNUM = -1 IF NO SUBSCRIPTS JMS I [GETSS /GET LIST ELEMENT JMP DATAER TAD (DPUSH /OUTPUT DPUSH OPERATOR JMS I [OUTWRD CMA TAD TEMP2 /FOLLOWED BY POINTER JMS I [OUTWRD TAD DIMNUM /FOLLOWED BY NUMBER JMS I [OUTWRD CDF 10 TAD I TEMP2 /LOOK AT TYE TYPE AND (20 /IS IT AN ARG ? CDF SZA CLA JMP DATAER /YES, THATS BAD JMS I [GETC /, ? JMP DATAER TAD (-254 SNA JMP DATLUP /LOOK FOR MORE TAD (254-257 // ? SZA CLA JMP DATAER JMP DLOOP2 /GO LOOK FOR ELEMENT DATA3, TAD (WORD1-1 DCA X10 /POINTER TO THE GOODS TAD I X10 /THEN STUFF JMS I [OUTWRD ISZ TEMP JMP .-3 NXTDE, TAD (ENDELM /OUTPUT END OF ELEMENT JMS I [OUTWRD JMS I [GETC /LOOK FOR COMMA JMP DATAER TAD (-254 SNA JMP DLOOP2 /YES, GET MORE DATA TAD (254-257 /SLASH ? SZA CLA JMP DATAER /NO, ERROR JMS I [GETC /ANOTHER DATA GROUP ? JMP I [NEXTST /NO TAD (-254 /COMMA ? SNA CLA JMP DATA+1 /START A NEW DATA STMT DATAER, JMS I [ERMSG 0401 /OK WHEN THIS IS AN AND JMP I [NEXTST DHOLER, JMS I [ERMSG 0410 /HOLLERITH DATA ERROR JMP I [NEXTST DQUOTE, 0 /GET CHAR FOR QUOTED DATA JMS I [GETCWB JMP DHOLER TAD [-247 SZA JMP DNOTQ2 JMS I [GETCWB JMP I DQUOTE TAD [-247 SNA CLA JMP DNOTQ2 /REPLACE '' BY ' JMS I [BACK1 JMP I DQUOTE DNOTQ2, TAD [247 /FIX CHAR ISZ DQUOTE JMP I DQUOTE OUT3WD, 0 /2.02/ OUTPUT 3 WORDS TAD [DATELM /2.02/ OUTPUT ELEMENT HEAD JMS I [OUTWRD /2.02/ TAD (3 /2.02/ AND SIZE JMS I [OUTWRD /2.02/ TAD WORD1 /2.02/ NOW THREE WORDS JMS I [OUTWRD /2.02/ TAD WORD2 /2.02/ JMS I [OUTWRD /2.02/ TAD WORD3 /2.02/ JMS I [OUTWRD /2.02/ JMP I OUT3WD /2.02/
/ DATA STATEMENT PAGE DLOOP2, JMS I [GETC JMP DATAER TAD (-250 /IS CHAR ( ? SZA JMP NOCMPD /NO, NOT COMPLEX DATA JMS I [NUMBER /GET REAL PART JMP DATAER SKP JMP DATAER /DP IS NG WITH COMPLEX JMS OUT3WD /2.02/ OUTPUT 3 WORDS JMS I [CHECKC /LOOK FOR COMMA -254 JMP DATAER /BAD IF NOT THERE JMS I [NUMBER /GET IMAGINARY PART JMP DATAER SKP JMP DATAER JMS I [CHECKC /LOOK FOR ) -251 JMP DATAER /NOT THERE JMP DATAFP /GO MOVE IMAGINARY PART NOCMPD, IAC /IS IT QUOTED STRING ? SZA JMP NQUOTD /NO TAD (DQUOTE /GET SUBR ADDRESS JMP HOLDAT /GO HANDLE IT NQUOTD, TAD (247-317 /IS IT AN O (OCTAL) SNA JMP I (XOCTAL /YES TAD (317-256 /IS IT . SNA CLA JMS I (TRUFAL /CHECK FOR TRUE OR FALSE JMP NOTF /NO TRUE-FALSE, TRY NUMBER CLL CML RTR /2000 DCA WORD2 TAD WORD2 SZA CLA IAC DCA WORD1 /TRUE=1.0 FALSE=0.0 DCA WORD3 JMP DATAFP /GO PUT IT NOTF, JMS I [BACK1 /PUT BACK CHAR JMS I [NUMBER /TRY FOR A NUMBER JMP DATAER /ELEMENT MISSING JMP TRYHOS /IF INTEGER, TRY FOR H OR * TAD (-3 DATAFP, TAD (-3 /FP DATA DCA TEMP /SIZE OF ITEM TAD [DATELM /DATA ELEMENT SIGNAL JMS I [OUTWRD TAD TEMP /THEN SIZE CIA /ALWAYS POSITIVE JMS I [OUTWRD JMP DATA3 /GO OUTPUT THE DATA TRYHOS, JMS I [GETC /LOOK FOR H JMP DATAER TAD (-310 SZA JMP TRYSTR /NOT H, MAYBE ITS * JMS I [FIXNUM /INTEGERIZE IT SNA JMP DHOLER /HOLLERITH DATA ERROR CMA DCA TEMP /SAVE COUNT TAD (DHLRTH /GET SUBR POINTER HOLDAT, DCA HCHAR CLL CMA RTL /2.02/ COUNT DCA TEMP2 /2.02/ BY THREES TAD (WORD1-1 /2.02/ DCA X10 /2.02/ POINTER HDLOOP, JMS I HCHAR /GET A CHAR JMP EOHD /2.02/ AND [77 /6 BITIZE IT CLL RTL RTL RTL /UPPER-PART-OF-WORDIZE DCA WORD3 /2.02/ STORAGIZE IT JMS I HCHAR /GET ANOTHER JMP LASTHD /LAST HALF WORD MUST GO OUT AND [77 TAD WORD3 /2.02/ COMBINIZE THE TWO HALVES DCA I X10 /2.02/ STORE IT ISZ TEMP2 /2.02/ THREE AT A TIME JMP HDLOOP /2.02/ JMS OUT3WD /2.02/ OUTPUT THREE JMP HOLDAT+1 /2.02/ GO DO NEXT THREE WDS EOHD, CLL CML RTL /2.02/ ANY CHARS IN THIS SET ? TAD TEMP2 /2.02/ SPA CLA /2.02/ JMP NXTDE /2.02/ NO, DO NEXT ELEMENT JMP .+4 /2.02/ YES, FILL IT OUT LASTHD, TAD WORD3 /2.02/ FILL OUT LOWER CHAR TAD (40 /2.02/ WITH A BLANK DCA I X10 /2.02/ TAD (4040 /2.02/ THEN FILL REST DCA I X10 /2.02/ WITH BLANKS TAD (4040 /2.02/ DCA I X10 /2.02/ JMP DATAFP /2.02/ GO OUTPUT IT TRYSTR, TAD (310-252 /* SNA CLA JMP .+3 JMS I [BACK1 /PUT BACK THAT CHAR JMP DATAFP /ITS JUST AN INTEGER TAD (DREPTC /REPETITION COUNT JMS I [OUTWRD JMS I [FIXNUM JMS I [OUTWRD /OUTPUT COUNT JMP DLOOP2 /LOOP
/ INITIALIZE READ IN *6400 INITLN, TAD IX7772 /READ FIRST SIX CHARS DCA TEMP TAD IXLINM DCA CHRPTR INITLP, CIF 10 JMS I [ICHAR /READ A CHAR JMP INITLN TAD IXM211 /TAB ? SZA CLA JMP NIXTAB /NO THIS ONE TAD IX0240 DCA I CHRPTR ISZ TEMP JMP .-3 JMP CHKCOM /DO COMMENT CHECK NIXTAB, TAD CHAR DCA I CHRPTR /STORE THE CHAR ISZ TEMP JMP INITLP CHKCOM, TAD I IXLINE /COMMENT ? TAD IXM303 SNA CLA JMP IGNORE /IGNORE IT TAD I IXLNP5 /CONTINUATION ? TAD IXM240 SZA CLA JMP IGNORE TAD IX7700 /FIX CALL CDF 10 /SEE WHAT HAPPENS WHEN YOU MOVE A ROUTINE** DCA I IXINCL CDF /** CIF 10 JMS I IX200 /REMOVE MONITOR 11 CDF 10 /FIX FIELD ONE STUFF TAD I MOV1 DCA I MOV2 ISZ MOV1 ISZ MOV2 ISZ MOVCNT JMP .-5 CDF JMP I IXRDFS /LOOK FOR PROG HEADER MOV1, 2020 MOV2, 20 MOVCNT, -160 IGNORE, CIF 10 /** JMS I [ICHAR /SKIP TILL CARRIAGE RETURN JMP INITLN CLA JMP IGNORE IXRDFS, RDFRST IXINCL, INCALL IXM240, -240 IXM303, -303 IX0240, 0240 IX200, 200 IX7600, 7600 IX7772, 7772 IXM211, -211 IX7700, 7700 /V3C
/ SEARCH FOR PROGRAM HEADER PAGE RDFRST, CIF 10 /** JMS I [ICHAR /THIS IS A DUPLICATE OF THE CODE JMP ENDLNF /AT LABEL 'RDLOOP' , ONLY THE TAD (-211 SNA TAD (240-211 TAD (211 DCA I CHRPTR /NAMES HAVE BEEN CHANGED TO ISZ CNT72 SKP JMP SKPFL2 TAD CHRPTR /PROTECT THE ASSEMBLY CIA CLL /(IT GETS THE FIRST LINE TAD (LINE+270 /WHICH MAY BE SUBROUTINE OR /FUNCTION. 1ST LINE SHORTER THAN REST BEC OF BUFFER OVERWRITES** SZL CLA /OR SOMETHING ELSE, IN WHICH CASE JMP RDFRST /ITS THE MAIN PROGRAM) JMS I [ERMSG /LINE TOO LONG 1424 JMP SKPFL /SKIP REST SKPFL2, CIF 10 /** JMS I [ICHAR JMP ENDLNF CLA JMP SKPFL2 SKPCMF, TAD X16 /BY ORDER OF THE EMPEROR DCA CHRPTR /MARIO DE NOBILI ENDLNF, TAD CHRPTR DCA X16 TAD CHRPTR DCA X10 TAD (-102 DCA CNT72 TAD (-6 DCA NCHARS GET6F, CIF 10 /** JMS I [ICHAR JMP SKPCMF TAD (-211 SZA CLA JMP NOTABF TAD (240 DCA I CHRPTR ISZ NCHARS JMP .-3 TAD (240 DCA CHAR JMP CCHEKF NOTABF, TAD CHAR DCA I CHRPTR ISZ NCHARS JMP GET6F CCHEKF, TAD I X10 TAD (-303 SZA CLA JMP NOCMTF SKPFL, CIF 10 /** JMS I [ICHAR JMP SKPCMF CLA JMP SKPFL NOCMTF, TAD CHAR TAD (-240 SNA CLA JMP GOTFST CCARDF, TAD X16 DCA CHRPTR JMP RDFRST GOTFST, TAD CHRPTR CIA TAD (LINE+4 DCA NCHARS TAD [LINE-1 DCA CHRPTR JMS I [SAVECP TAD (HDRLST-1 DCA X10 /PREPARE TO SEARCH THE LIST CLOOP1, CDF 10 /(FNC NAMES UP IN FLD 1)** TAD I X10 /OF LEGAL HEADER LINES CDF SZA /CODE IS AS UNDER 'CMDLUP' JMP CLOOP2 CLA CMA RAL TAD STACK DCA STACK CDF 10 /** TAD I X10 CDF DCA TEMP JMP I TEMP CLOOP2, DCA TEMP JMS I [GET2C JMP BADCMF CIA TAD TEMP SNA CLA JMP CLOOP1 SEARCH, CDF 10 /** TAD I X10 CDF SZA CLA JMP SEARCH ISZ X10 JMS I [RESTCP ISZ STACK ISZ STACK CDF 10 /** TAD I X10 CDF SZA JMP CLOOP2 BADCMF, JMS I [RESTCP /NOT A FUNCTION OR SUBROUTINE JMP I (LINE1 /SO GO TO MAIN PART OF COMPILER BADDIE, JMS I [MESSAG /SOMETHING MISSING FROM SYS 323 /S 331 /Y
/ ANALYZE PROGRAM HEADER PAGE SUBRTN, CLA CMA /SET TO -1 FOR SUBR JMP XXXFUN+1 REAFUN, TAD (102 /SET TYPE TO REAL DCA TYPE JMP XXXFUN LOGFUN, IAC /SET TYPE OF FUN DBLFUN, IAC /WITH DOUBLEMINT GUM ! CMPFUN, IAC IAC INTFUN, TAD (101 DCA TYPE JMS I [CHECKC /LOOK FOR 'N' -316 JMP BADBGN XXXFUN, CLA IAC DCA FUNCTN /SET SWITCH CDF 10 /1.05/ KILL ENTRY FOR 'MAIN' DCA I (ALIST+14 /1.05/ BUT DO IT BEFORE THE M BUCKET CDF /1.05/ CONTAINS ANYTHING USEFULL JMS I [GETNAM /GET FUNC/SUBR NAME JMP BADBGN JMS I [LOOKUP /PUT INTO SYMBOL TABLE DCA PROGNM TAD PROGNM /SET UP TYPE IAC DCA TEMP TAD STACK DCA X12 /SAVE POINTER DCA TEMP2 /ZERO ARG COUNTER CDF 10 TAD TYPE /PUT IN THE TYPE BITS TAD (1000 DCA I TEMP CDF JMS I [CHECKC /LOOK OFR ( -250 JMP ISITFN /IS IT A FUNCTION ? ARGLUP, JMS I [GETNAM /GET THE ARG JMP BADBGN JMS I [LOOKUP IAC DCA TEMP /ADDR OF TYPE WORD CDF 10 TAD I TEMP SZA CLA JMP BADBGN /ALREADY AN ARG TAD (20 DCA I TEMP CDF CMA TAD TEMP /OUTPUT ADDR OF ARG JMS I [PUSH ISZ TEMP2 /KEEP COUNT JMS I [COMARP /LOOK FOR , OR ) JMP BADBGN /NEITHER JMP ARGLUP /, TAD TEMP2 /) HOW MANY ARGS ? CDF 10 DCA I NEXT /INTO ARG LIST TAD TEMP2 CIA DCA TEMP2 TAD NEXT /SAVE ADDR OF ARG LIST DCA ARGLST CDF TAD X12 /RESTORE THE STACK DCA STACK MOVARG, TAD I X12 /PUT ARGS INTO ARG LIST CDF 10 DCA I NEXT CDF ISZ TEMP2 JMP MOVARG JMP I [NEXTST /DO NEXT LINE TYPE=WORD6 ISITFN, TAD FUNCTN /IS IT A FUNCTION SPA SNA CLA /WITH NO ARGS ? JMP I [NEXTST /NO, WE'RE OK BADBGN, JMS I [ERMSG 2010 JMP I [NEXTST BDATA, JMS I [CHECKC /LOOK FOR A -301 JMP BADBGN CLL CMA RAL /SET FUNCTION SWITCH DCA FUNCTN /2.02/ STORE IT DUMMY!! TAD (BDLIST-1 /POINTER TO LIST OF PATCHES DCA X10 BDLOOP, CDF 10 TAD I X10 /GET PATCH LOCATION CDF SNA JMP I [NEXTST /NO MORE PATCHES DCA TEMP /SAVE PATCH ADDRESS TAD BADJMP /GET ERROR JUMP DCA I TEMP /STORE IT JMP BDLOOP /LOOP BADJMP, JMP I [BDERR
/ INITIAL SYMBOL TABLE FIELD 1 *2020 NOPUNC *20 ENPUNC 0 BLNKCN, 111;0 /BLANK COMMON SLOT ALIST, 0;0;0;0;0;0;0;0;0;0;0;0;MAIN;0;0;0;0;0;0;0;0;0;0;0;0;0 HOLIST, 0 FPLIST, 0 DPLIST, 0 INTLST, ONE CMPLST, 0 SNLIST, 0 ONE, THREE;0;1;2000;0 THREE, SIX;0;2;3000;0 SIX, 0;0;3;3000;0 TRUE, 0;0145;0 MAIN, 0;1000;0;0111;1600 FREE, 0
/ BLOCK DATA PATCH LIST BDLIST, IF /BLOCK DATA PATCH LIST DOUBLE DO GOTO CALL READ REWIND ENDFIL FORMAT WRITE BACKSP ASSIGN STOP PAUZE DFINFL FIND ITSAR 0
/ INITIALIZATION *2200 START, SKP /NON-CHAINED ENTRY POINT JMP .+5 /CCL ENTRY CIF CDF 10 /START HERE JMS I (200 /COMMAND DECODE 5 0624 /DEFAULT EXT IS .FT TAD I L7600 /IS AN OUTPUT FILE GIVEN ? SNA CLA JMP MYFILE /NO, USE FORTRN.TM MOVOFN, TAD I OFNAME /MOVE NAME INTO PAGE 0 CDF DCA I NAMEOF CDF 10 ISZ NAMEOF ISZ OFNAME ISZ OFNSIZ JMP MOVOFN EXTEST, TAD I (7604 /SET DEFAULT EXTENSIONS SZA JMP EXTSET TAD I (7643 SPA JMP GETRA /A WAS SET.USE RA AND L41 /CHECK FOR L+G SNA CLA TAD (0610 /USE RL TAD (1404 /USE LD EXTSET, DCA I (7604 TAD I (7604 CDF 0 DCA I NAMF CDF 10 TAD I (7611 SNA TAD (1423 /.LS FOR LISTING DCA I (7611 TAD I (7616 SNA TAD (1520 /.MP FOR LOAD MAP DCA I (7616 EFILE, CLA IAC /OPEN PASS1 OUTPUT FILE JMS I (200 3 OBLOK, TMPFL2 OSIZE, 0 JMP OBAD /BADDIE CDF TAD OBLOK /SAVE STARTING BLOCK DCA OUBLOK TAD OBLOK DCA I (OUFILE TAD OSIZE DCA OULEN CDF 10 CLA IAC JMS I (200 /GET PASS2 2 SPASS2, PASS2N 0 JMP OBAD CLA IAC JMS I (200 2 SP2O, PAS2ON /GET PASS2 OVERLAY 0 JMP OBAD CDF /SAVE PASS2 AND PASS2O BLOCKS TAD SPASS2 DCA PASS2B TAD SP2O /SKIP FIRST BLOCK IAC /ITS THE CORE TABLE DCA I (PASS2O CIF JMP INITLN /GO START COMPILE MYFILE, CDF /PUT DEFAULT INTO 17600 TAD I NAMOF DCA I NAMEOF TAD I NAMOF /ALSO INTO PAGE 0 CDF 10 DCA I OFNAME ISZ NAMOF ISZ NAMEOF ISZ OFNAME ISZ OFNSIZ JMP MYFILE CLA IAC /SET DEV TO SYS DCA I L7600 JMP EXTEST /GO OPEN FILE OBAD, CIF CDF JMP BADDIE OFNAME, 7601 /IGNORE DEVICE (ALWAYS USE SYS) NAMEOF, TMPFIL+4 NAMOF, TMPFIL OFNSIZ, -3 TMPFL2, 0617;2224;2216;2415 /FORTRN.TM PASS2N, 2001;2323;6200;2326 /PASS2.SV PAS2ON, 2001;2323;6217;2326 /PASS2O.SV NAMF, TMPFIL+7 L7600, GETRA, 7600 /CLA TAD (2201 /V3C USE RA JMP EXTSET L41, 41
PAGE / PROGRAM HEADER LIST HDRLST, TEXT 'INTEGERFUNCTIO' INTFUN TEXT 'REALFUNCTION' REAFUN TEXT 'COMPLEXFUNCTIO' CMPFUN TEXT 'DOUBLEPRECISIONFUNCTIO' DBLFUN TEXT 'LOGICALFUNCTIO' LOGFUN TEXT 'FUNCTION' XXXFUN TEXT 'SUBROUTINE' SUBRTN TEXT 'BLOCKDAT' BDATA 0
/ PS-8 FILE INPUT ROUTINES /NEED TWO PAGES BEC. MOVING ICHAR OUT OF FIELD 1 REQUIRES /ALOT OF FIELD DIDDLING. *5400 MORCHR, TAD (214 /FIX CHAR CDF 0 /** DCA I QCHAR CDF 10 TAD I (ICHAR IAC /UPDATE ADDR DCA TCHAR CIF CDF 0 TAD I QCHAR /RETURN VALUE IN AC JMP I TCHAR TCHAR, 0 QCHAR, CHAR / EXTENDED OPERATOR LIST OPRLST, -01;-1604;ANDOPR -17;-2200;OROPR -05;-2100;EQOPR -16;-0500;NEOPR -07;-0500;GEOPR -07;-2400;GTOPR -14;-0500;LEOPR -14;-2400;LTOPR -30;-1722;XOROPR -05;-2126;EQVOPR 0 / EXPONENT TABLE PETABL, 0004;2400;0000 /1E1 0000;0000;0000 0007;3100;0000 /1E2 0000;0000;0000 0016;2342;0000 /1E4 0000;0000;0000 0033;2765;7020 /1E8 0000;0000;0000 0066;2160;6744 /1E16 6770;1000;0 0153;2356;1326 /1E32 6501;2670;2655 0325;3023;6017 /1E64 5117;7747;6466 0652;2235;6443 /1E128 7114;0164;6145 1523;2523;7565 /1E256 7734;7374;7357 3245;3430;6320 /1E512 2565;1407;2176 ENDSTM, 211;"E;"N;"D;215;211;215;232 /V3C /FAKE END STATEMENT USED IF PROGRAM HAS NONE
PAGE
/MAIN PART OF OS/8 INPUT ROUTINES ICHAR, 0 /READ CHAR FROM INPUT FILE CDF 10 ISZ INJMP /BUMP THREE WAY UNPACK SWITCH ISZ INCHCT INJMPP, JMP INJMP / CDF ** TAD INEOF /DID LAST READ YEILD END OF FILE ? SNA CLA JMP INGBUF /NO, DO ANOTHER READ GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE JMP ENDIN /END OF INPUT INGBUF, TAD INCTR /BUMP RECORD COUNTER CLL IAC SNL DCA INCTR /RESTORE IF IT HASN'T OVERFLOWED SZL ISZ INEOF /SET END OF FILE SWITCH CDF 10 /** CIF 0 /** JMS I INHNDL /DO THE READ 0210 /ONE BLOCK TO FIELD 1 INBUFP, INBUF INREC, 0 JMP INERR /HANDLER ERROR INBREC, ISZ INREC /BUMP RECORD NUMBER TAD INBUFP /RESET BUFFER POINTER SVIBPT, DCA INPTR /V3C TAD (-601 /SET CHAR COUNT DCA INCHCT TAD INJMPP /RESET THREE WAY JUMP SWITCH DCA INJMP JMP ICHAR+1 /GO AGAIN INERR, ISZ INEOF /EITHER EOF OR BADDIE SMA CLA JMP INBREC /END OF FILE, DO NEXT FILE JMP TERR /INPUT ERROR, GIVE I F AND EXIT ENDIN, TAD (ENDSTM /V3C IF NO END STATEMENT, FORCE ONE JMP SVIBPT /ENDIN, TAD INCALL /END OF INPUT IS USR IN CORE ? / TAD (-200 / CIF 0 /** / SZA CLA / JMP I (ENDX /NO, ITS END OF PROG TERR, JMS I (MESSAG /YES, BAD INPUT. WAS SQ.BRCK** 311 306 INJMP, HLT /3 WAY CHAR UNPACK BRANCH JMP ICHAR1 JMP ICHAR2 ICHAR3, TAD INJMPP /RESET JUMP SWITCH DCA INJMP TAD I INPTR AND (7400 /COMBINE THE HIGH ORDER BITS CLL RTR /OF THE TWO WORDS RTR TAD INTMP /TO FORM THE THIRD CHAR RTR RTR ISZ INPTR /BUMP WORD POINTER JMP ICHAR1+1 /DO SOME COMMON STUFF ICHAR2, TAD I INPTR /SAVE THE HIGH ORDER BITS AND (7400 DCA INTMP /FOR THE THIRD CHAR ISZ INPTR /GO TO THE SECOND WORD ICHAR1, TAD I INPTR /GET THE LOW 8 BITS / CDF AND (177 /AND I MEAN ONLY 8 !! SNA /V3C YOU WERE WRONG - YOU MEANT ONLY 7 JMP ICHAR+1 TAD (-32 /IS IT ^Z (END OF FILE) SNA JMP GETNEW /YES, LOOK FOR THE NEXT FILE TAD (232-212 SNA JMP ICHAR+1 /IGNORE LINE FEEDS TAD (212-215 SNA JMP ICHARN /RETURN ON CARRIAGE RETURN ** IAC SNA JMP ICHAR+1 /IGNORE FORM FEEDS JMP I (MORCHR /** ICHARN, CIF CDF 0 JMP I ICHAR INTMP, 0 INFPTR, 7617 /POINTER TO INPUT FILE LIST INEOF, 1 INCHCT, INNEWF, -1 /FETCH HANDLER FOR NEXT FILE CDF 0 /** TAD (INDEVH+1 /THIS IS WHERE IT GOES ** DCA INHNDL CDF 10 TAD I INFPTR /GET NEXT INPUT FILE INFO SNA JMP I INNEWF /NO MORE FILES CDF 10 /WAS CIF 10** JMS I INCALL /CALL MONITOR 1 /FETCH HANDLER INHNDL, 0 /ENTRY ADDR GOES HERE JMP INERR+3 /THIS CAN'T HAPPEN HERE TAD I INFPTR /GET LENGTH AND (7760 SZA /A ZERO HERE MEANS >=256 BLOCKS TAD (17 /PUT IN SOME MORE BITS CLL CML RTR RTR DCA INCTR /STORE LENGTH OF FILE ISZ INFPTR TAD I INFPTR /GET STARTING RECORD NUMBER DCA INREC ISZ INFPTR DCA INEOF /CLEAR EOF FLAG ISZ INNEWF JMP I INNEWF INCTR, 0 INCALL, 200 /CHANGED TO 7700 AFTER FIRST TIME INPTR, 0 PAGE
/ KEYWORD LIST CMDLST, -1106;0;IF /IF -0417 -2502 -1405 -2022 -0503 -1123 -1117;0;DOUBLE /DOUBLE PRECISION -0417;0;DO /DO -0717 -2417;0;GOTO /GOTO -0317 -1515 -1716;0;COMMON /COMMON -0317 -1520 -1405;0;COMPLE /COMPLEX -0317 -1624 -1116 -2505;0;NEXTST /CONTINUE -0301 -1414;0;CALL /CALL -2205 -0114;0;REAL /REAL -2205 -0104;0;READ /READ -2205 -2711 -1604;0;REWIND /REWIND -2205 -2425 -2216;0;RETURN /RETURN -0516 -0406 -1114;0;ENDFIL /ENDFILE -0516;0;XEND /END -0411 -1505 -1623 -1117;0;DIMENS /DIMENSION -0401 -2401;0;DATA /DATA -0617 -2215 -0124;0;FORMAT /FORMAT -2722 -1124;0;WRITE /WRITE -0521 -2511 -2601 -1405 -1603;0;EQUIV /EQUIVALENCE -0405 -0611 -1605 -0611 -1405;0;DFINFL /DEFINEFILE -1116 -2405 -0705;0;INTEGE /INTEGER -1417 -0711 -0301;0;LOGICA /LOGICAL -0530 -2405 -2216 -0114;0;EXTERN /EXTERNAL -0201 -0313 -2320 -0103;0;BACKSP /BACKSPACE -0123 -2311 -0716;0;ASSIGN /ASSIGN -2001 -2523;0;PAUZE /PAUSE -2324 -1720;0;STOP /STOP -0611 -1604;0;FIND /FIND 0 /END OF LIST $