X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;ds=inline;f=sw%2Ff4%2FFRTSRC%2Ff4.pa;fp=sw%2Ff4%2FFRTSRC%2Ff4.pa;h=8bebc298d75ff4829babd39424ec8da9f8a00404;hb=7af5ad59491ddf2066641aef1e0025a337c0f247;hp=0000000000000000000000000000000000000000;hpb=919757fd611e482003ce51f366f6783cab73dea3;p=pdp8.git diff --git a/sw/f4/FRTSRC/f4.pa b/sw/f4/FRTSRC/f4.pa new file mode 100644 index 0000000..8bebc29 --- /dev/null +++ b/sw/f4/FRTSRC/f4.pa @@ -0,0 +1,3661 @@ +/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 .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 + $ +