/TSS/8 BASIC COMPILER (BASCOM) VERSION 18 / /REVISION: 13-AUG-71 IDC/GWB/PJK / /COPYRIGHT 1969, 1970, 1971 DIGITAL EQUIPMENT CORP. / MAYNARD, MASSACHUSETTS / /ORIGINALLY WRITTEN BY: / INFORMATION DEVELOPMENT CORP. / DEDHAM, MASS. / / / DESIGNED TO RUN ON A PDP-8 CAPABLE OF SUPPORTING / THE TSS/8 TIME SHARING MONITOR. / / THE BASIC SYSTEM IS BROKEN INTO 4 PARTS / 1. MONITOR, CALLS PARTS BELOW, HANDLES ERRORS. / 2. EDITOR, EDITS BASIC SOURCE FILES / 3. COMPILER, COMPILES SOURCE FROM EDITOR / 4. INTERPRETER, EXECUTES OBJECT CODE FROM COMPILER / / / /DIRECTORY OF ROUTINES, TSS/8 BASIC COMPILER / /THE ROUTINES OF THE COMPILER ARE GROUPS INTO THE /FOLLOWING GROUPS. THESE GROUPS ARE SELECTED BY THEIR /LOGICAL FUNCTION WITHIN THE COMPILER. / /THE GROUPS ARE: / /ASSIGN FINDS AND ASSIGNS LINES, CONSTANTS, VARIABLE NAMES, ARRAY /NAMES, FUNCTION NAMES USING THE ASSIGNMENT & LINE TABLES / /CONTROL DOES COMMON STATEMENT PROCESSING. / /EXPRESSION GENERATES INTERPRETIVE CODE FOR EXPRESSION EVALUATION / /INPUT USED TO INPUT LANGUAGE ELEMENTS. / /OUTPUT WRITES A LOADER FILE WITH CODE, CONSTANTS, FIX-UPS / / VERB PROCESSES EACH BASIC LANGUAGE ELEMENT, / / UTILITY DOES GENERAL WORK IN SUPPORT OF ABOVE GROUPS. / / / NAME FUNCTION GROUP / / ASI ASSIGN ITEM ASSIGN / ASL ASSIGN LINE ASSIGN / CHK CHECK CORE CONTROL / DAT DATA PROCESSOR VERB / DEF DEFINE PROCESSOR VERB / DIM DIMENSION PROCESSOR VERB / DIV DIVIDE BY TEN, THREE WORDS UTILITY / END END PROCESSOR VERB / EXP EXPRESSION ANALIZER EXPRESSION / FLT FLOAT A NUMBER INPUT / FOR FOR PROCESSOR VERB / GOS GOSUB PROCESSOR VERB / GOT GO TO PROCESSOR VERB / IBN INPUT BINARY NUMBER INPUT / ICH INPUT CONVERT, CHARACTER INPUT / ICO INPUT COLUMN INPUT / IFP IF PROCESSOR VERB / ILN INPUT LINE NUMBER INPUT / INA INPUT NAME INPUT / INI INPUT ITEM INPUT / INN INPUT NEXT ELEMENT INPUT / INP INPUT PROCESSOR VERB / INZ INITIALIZE ROUTINE CONTROL / IOP INPUT OPERATOR INPUT / ISV INPUT SIMPLE VARIABLE INPUT / ITS INPUT OPERATOR TESTS INPUT / LET LET PROCESSOR VERB / LLA LOAD LOW ASSIGNMENT ASSIGN / MPY THREE WORD MULTIPLY BY TEN UTILITY / MUL TWELVE BIT MULTIPLY UTILITY / NEX NEXT PROCESSOR VERB / NRM NORMALIZE, THREE WORDS UTILITY / OBB OUTPUT BYTE BOUNDARY OUTPUT / OCH OUTPUT CHAIN OUTPUT / OFS OUTPUT FORCE STRING OUTPUT / OLA OUTPUT ABSOLUTE LOAD LOCATION OUTPUT / OLL OUTPUT LOADING LOCATION OUTPUT / OLW OUTPUT LOADER WORD OUTPUT / OPI OUTPUT STRING INITIALIZE OUTPUT / OTA OUTPUT INSTRUCTION-TYPE3 OUTPUT / OTB OUTPUT BYTE OUTPUT / OTC OUTPUT INSTRUCTION-TYPE2 OUTPUT / OTF OUTPUT FUNCTION CALL OUTPUT / OTI OUTPUT INSTRUCTION-TYPE1 OUTPUT / OTN OUTPUT NUMBER OUTPUT / OTR OUTPUT INSTRUCTION/REFERENCE OUTPUT / OWB OUTPUT WORD BOUNDARY OUTPUT / OWD OUTPUT WORD OUTPUT / PAS PASS CHARACTERS CONTROL / POP POP ITEM EXPRESSION / PRI PRINT PROCESSOR VERB / PUS PUSH ITEM EXPRESSION / REA READ PROCESSOR VERB / REM REMARKS PROCESSOR VERB / RES RESTORE PROCESSOR VERB / RET RETURN PROCESSOR VERB / RFL READ INPUT FILE INPUT / SCN SCAN STATEMENT ID TABLES CONTROL / SHL SHIFT LEFT, THREE WORDS. UTILITY / SHR SHIFT RIGHT, THREE WORDS. UTILITY / SID STATEMENT IDENTIFY CONTROL / SLA STORE LOW ASSIGNMENT ASSIGN / STO STOP PROCESSOR VERB / STT STATEMENT TERMINATE CONTROL / / TABLES OF CHARACTER ASSIGNMENTS / / ALL ARE PREFIXED BY AN "X" FOLLOWED BY A CODE FOR / THE CHARACTER. / / LETTERS-X& / XA=01 XB=02 XC=03 XD=04 XE=05 XF=06 XG=07 XH=10 XI=11 XJ=12 XK=13 XL=14 XM=15 XN=16 XO=17 XP=20 XQ=21 XR=22 XS=23 XT=24 XU=25 XV=26 XW=27 XX=30 XY=31 XZ=32 XDOL=44 / / NUMBERS XC& / XC0=60 XC1=61 XC2=62 XC3=63 XC4=64 XC5=65 XC6=66 XC7=67 XC8=70 XC9=71 / / SPECIALS X& / XBL=40 XQU=42 XLP=50 XRP=51 XPL=53 XCM=54 XPT=56 XEQ=75 XSC=73 XLS=74 / / OP-CODE DEFINITIONS FOR INTERPRETER. / / X IS PREFIX FOLLOWED BY NAME OF OP AS / DEFINED IN THE DESIGN SPEC. / / XALPHA=42 /ALPHA STRING OPERATOR XCHAIN=61 /CHAIN XCLO=62 /CLOSE FILE OR REL DEVICE XDATI=13 /DATA INPUT INDIRECT XDATD=23 /DATA INPUT DIRECT XDO=35 /DO XDUMM=53 /DUMMY VARIABLE PICK-UP XEND=17 /END PROGRAM XFNRT=52 /FUNCTION RETURN XFORF=43 /FORMAT TERMINATE, SEMI-COLON XFORL=45 /FORMATE TERMINATE, C/R XFORZ=44 /FORMAT TERMINATE, COMMA XFUNC=34 /FUNCTION CALL, USER DEFINED XGET=57 /GET XGOTO=31 /GO TO XIF=32 /IF XIFUN=51 /FUNCTION CALL, INTERNALLY DEFINED XINPD=24 /INPUT DIRECT XINPI=14 /INPUT INDIRECT XLINE=25 /REMEMBER LINE XLSTA=26 /LOAD ADDRESS TO STACK XLSTD=20 /LOAD STACK DIRECT XLSTI=10 /LOAD STACK INDIRECT XLSTR=71 /LOAD RELOCATED ADDRESS TO STACK XLPRX=66 /END LPRINT XLPRT=65 /BEGIN LPRINT XNEXT=30 /NEXT VALUE ON DO XNOOP=0 /NO OPERATION XONGT=67 /ON ... GOTO XOPEN=60 /OPEN XPRNT=41 /PRINT XPUT=XGET-1 /PUT (=56) XREST=15 /RESTORE DATA (NUMERIC) XRSTR=12 /RESTORE DATA (STRING) XSAME=70 /NEW STATEMENT ON SAME LINE XSBRT=07 /SUBROUTINE RETURN XSBSC=22 /SUBSCRIPT COMPUTE XSLEEP=XCLO+1 /SLEEP XSSTD=21 /STORE STACK DIRECT XSSTI=11 /STORE STACK INDIRECT XSUBR=33 /SUBROUTINE CALL XTEST=50 /TEST STACK XUNS=XCLO+2 /UNSAVE FILE XRDZ=36 /RANDOMIZE XINTRM=27 /TERMINATE INPUT LIST XMPY=3 /MULTIPLY ITEMS XCHS=37 /CHANGE STRING TO NUMBERS XCHDD=40 /CHANGE A TO A$ XCHDI=55 /CHANGE A TO A$(I) XSSF=46 /SET STRING FLAG (OUTPUT ON DOLLAR SEEN) XLINP=47 /SPECIAL LINE INPUT MODE /NOTE!!!!! /THE END STATEMENT HAS BEEN MOVED INTO THE LOADER!!! /IT USES VARIOUS PAGE ZERO STUFF, AND CALLS ROUTINES /IN THE COMPILER WHICH RESIDE ABOVE 1077. /DANGER--DO NOT CHANGE PAGE ZERO OR MOVE ROUTINES /INTO THE AREA BELOW 1077 WITHOUT CHECKING LOADER. /THE SUPER-CRITICAL LOCATIONS ARE LISTED BELOW. /PAL10 WILL GENERATE AN ERROR IF YOU GO WRONG! DSTBND=35 /ALSO USED BY BASEXC TC=130 HLIMIT=32 /ALSO USED BY BASEXC DATBND=33 /ALSO USED BY BASEXC LLIMIT=31 /ALSO USED BY BASEXC START=30 /ALSO USED BY BASEXC T1=131 CM1=47 FORFG=133 LS=113 LT=114 LINE=34 /IF THIS MOVES ALSO CHANGE ERROR HANDLER IN BASED EL=77 JT=107 J=105 IU=104 DF=76 AF=72 C3=37 OW=117 OFS=3030 ID=100 ID1=101 ID2=102 X1=11 ISTACK=100 CODEON=7775 XEND=17 /CRITICAL LOCATIONS IN BASIN INTLOW=5400 /END OF INTERPRETER IF NO FILE I/O INTEND=6020 /END OF INTERPRETER INTONE=4764 INTZER=4765 / / PAGE ZERO AND SYSTEM DEFINITIONS / NOPUNCH *0 INTRET, 0 /INTERUPT RETURN ADDRESS INTJMP, 0 /JMP I 2 INTPRG, 0 /INTERRUPT PROCESSOR ADDRESS ENDINT, 0 /DECREMENT TO BE ADDED TO INTEND TO ARRIVE AT TRUE INTEND / I.E. INTLOW-INTEND IFF NO FILE I/O; 0 OTHERWISE DDTBKP, 0 /DDT BREAKPOINT SYSERR, 0 /SYSTEM ERROR PROSESSOR VECTOR SYSIOE, 0 /SYSTEM I/O CHECK AND ERROR SYSPRG, 0 /SYSTEM PROGRAM CALL ROUTINE VECTOR / / AUTO INDEX EQUIVALENCES / X0=10 X1=11 X2=12 X3=13 X4=14 X5=15 X6=16 X7=17 /INPUT WORD POINTER. / *20 / / SYSTEM FILE VARIABLES / FINAME, 0 /CURRENT FILE NAME 0 / THREE WORDS 0 / FOR A NAME FISIZE, 0 /CURRENT FILE SIZE FITYPE, 0 /CURRENT FILE TYPE SEGMNT, 0 /-(SEGMENT SIZE IN WORDS) SRSIZE, 0 /SOURCE FILE, FILE-1, SIZE IN SEGMENTS DEVSTS, 0 /DEVICE STATUS BITS / BIT DEVICE / 0 DTA 0 / ... ... / 7 DTA 7 / 8 DSK 8 / 9 DSK 9 / 10 PTP / 11 LPT / / ITEMS PASSED TO THE INTERPRETER / ZONE=. /BEGIN OF INITIALIZED PAGE ZERO /THIS IS ASSEMBLED AS PAGE ZERO AND LOADED ELSEWHERE INZPZ=5234 /DEFINE LOAD ADDRESS ENPUNCH *INZPZ NOPUNCH *ZONE ENPUNCH / / MEND=7776 /END OF AVAIL MEMORY-1. / START, 0 /BEGIN PROGRAM, FIND VARIABLES LLIMIT, 0 /LOWER LIMIT OF STACK, END PROGRAM ISTACK=100 /INITAL STACK SIZE HLIMIT, 0 /UPPER LIMIT OF STACK, BEGIN CONSTANTS DATBND, 0 /UPPER LIMIT OF DATA DATTOP=MEND+1 /END OF DATA AREA / / ITEMS PASSED TO THE ERROR ROUTINES / LINE, 0 /LINE # BEING COMPILED. DSTBND, 0 /NUMBER OF STRING DATA ITEMS (FOR LOADER) / / CONSTANTS / / C2, 2 C3, 3 C4, 4 C5, 5 C7, 7 C12, 12 CSIZ, BUFSIZ C70, 70 C77, 77 / / CM1, -1 CM2, -2 CM3, -3 CM4, -4 CM12, -12 CM13, -13 CM20, -20 CM26, -26 CMSIZ, -BUFSIZ CM41, -41 CM42, -42 CM100, -100 DIVC1, 7740 DIVC2, 5400 / / CMXRP, -XRP CMXPT, -XPT CMXEQ, -XEQ / / LOADER CODES / CODEND=0 /END OF LOAD CODE CODELL=7777 / SET LOADING LOCATION FOR LOADER CODECH=7776 / CHAIN CODE FOR LOADER CODEON=7775 /WRITE PROGRAM ON DISK CODELA=7774 /SET ABSOLUTE LOCATION LOADING ADDRESS CODEIG=4000 /IGNORE CODE FOR LOADER. / / VARIABLES, GLOBAL / BSLFG, 0 /BACKSLASH FLAG DOLLAR, 0 /$ STRING FLAG AF, 0 /ADDRESS FIELD OF ITEM AG, 0 /ARGUMENT COUNT IN FUNCTION DEF. BE, 0 /BINARY EXPONENT BUILD AREA DE, 0 /DECIMAL EXPONENT AREA DF, 0 /DEFINITION FLAG OF ITEM EL, 0 /ENTRY LENGTH ID, 0 /ID AREA FOR ASSIGNMENT BREAK-OUT ID1, 0 / ID2, 0 / IS, 0 /INPUT SWITCH FOR COLUMN INPUT IU, 0 /ITEM USAGE FLAG J, 0 /WORKING POINTER TO ASSIGNMENT TABLE JS, MEND+1 /UPPER LIMIT OF ASSIGNMENT TABLE JT, MEND+1 /LOWER LIMIT OF ASSIGNMENT TABLE L, 0 /LINE # ENTRY POINTER LA, 0 /LINE ADDRESS OF ENTRY POINTED TO BY L LI, 0 /LINE # OF ENTRY POINTED TO BY L LS, PEND /LINE TABLE, TOP ADDRESS LT, PEND /LINE TABLE, START ADDRESS OH, OBUF /HEADER WORD POINTER, LOAD STRING WORD COUNT OP, 0 /OPERATOR, TC TYPE FROM INPUT OW, OBUF /OUTPUT WORD POINTER, NEXT AVAIL WORD. PC, 0 /PROGRAM COUNTER, OUTPUT STRING RE, 0 /RE-READ SWITCH FOR CHAR INPUT RF, 0 /REL/REP FLAG FOR EXPRESSION SF, -1 / SIDE OF OUTPUT WORD, -1 IS LEFT, 0 IS RIGHT SIDE. SN, 0 /SIGN FLAG FOR FLOATING NUMBER SNFL, 0 / SIGN FLAG FOR EXPRESSIONS SS, PEND-1 /COMPILING STACK START ADDRESS ST, PEND-1 /COMPLING STACK TOP ADDRESS. TC, 0 /CHAR FROM INPUT - TERMINATOR FOR ELEMENT; MUST BE INIT TO 0 / / T1, 0 / TEMP STORE FOR VERB PROCESSORS. T2, 0 / TEMP STORE FOR VERB PROCESSORS. FORFG, 0 /FOR-NEXT COUNTER / /TRANSFER VECTORS FOR ROUTINE CALLING / /"J" PREFIXES A CALL TO THE ROUTINE, USED AS /AN OP-CODE THE ADDRESS OF THE ROUTINE IS / / / JASI=JMS I . ASI JASL=JMS I . ASL JCHK=JMS I . CHK JEXP=JMS I . EXP JFLT=JMS I . FLT JGCH=JMS I . GCH JIBN=JMS I . IBN JICH=JMS I . ICH JICO=JMS I . ICO JILN=JMS I . ILN JINA=JMS I . INA JINI=JMS I . INI JINN=JMS I . INN JISV=JMS I . ISV JITS=JMS I . ITS JLLA=JMS I . LLA JMPY=JMS I . MPY JMUL=JMS I . MUL JOBB=JMS I . OBB JOCH=JMS I . OCH JOLA=JMS I . OLA JOTA=JMS I . OTA JOTC=JMS I . OTC JOTI=JMS I . OTI JOTN=JMS I . OTN JOTR=JMS I . OTR JOWB=JMS I . OWB JOWD=JMS I . OWD JPAS=JMS I . PAS JPOP=JMS I . POP JPUS=JMS I . PUS JSLA=JMS I . SLA JSTT=JMP I . STT JTCM=JMS I . TCM / RECFL, 0 /RECORD FLAG; NON-ZERO IFF PROCESSING RECORD STMNT DDFL, 0 /DIM FLAG--TO CHECK FOR DUPLICATE DIM'S / / OTHER OPERATION DEFINITIONS. / ERROR=JMS I SYSERR /SYSTEM ERROR PROCESSOR. IOECHK=JMS I SYSIOE /SYSTEM I/O ERROR HANDLER. CALPRG=JMP I SYSPRG /CALL NEXT PROGRAM / / TSS/8 IOT DEFINITIONS. / WFILE=6605 /WRITE DISK. RFILE=6603 /READ DISK. EXT=6611 /EXTEND FILE. /DEFINE SOME MORE SUPERCRITICAL STUFF IFNZRO JPAS-4570 IFNZRO JSTT-5574 IFNZRO JOTI-4563 IFNZRO JLLA-4553 IFNZRO JOLA-4560 IFNZRO JOCH-4557 IFNZRO JOWD-4567 IFNZRO JOTN-4564 *400 / / JMP I .+1 /ENTRY POINT, CALL INITIALIZE INZ /ROUTINE. / / / / ASI- ASSIGN ITEM TO TABLE. / / ASI SCANS THE ASSIGNMENT TABLE FOR THE ITEM / AS SUPPLIED IN ID,ID1,ID2,IU,&EL. IF THE / ITEM CANNOT BE FOUND THEN AN ASSIGNMENT ENTRY / IS MADE IN THE TABLE / / THIS ROUTINE ALLOCATES STORAGE FOR VARIABLES, CONSTANTS / AND RECORDS. THE AF FIELD OF A VARIABLE OR RECORD / IS AN ABSOLUTE MEMORY REFERENCE, WHILE THE / CONSTANT AF IS A CHAIN TO THE LAST REFERENCE. / / ARRAY AND RECORD REFERENCES MUST BE FOUND, IF NOT / NO DIM OR RECORD STATEMENT HAS BEEN / ENCOUNTERED AND AN ERROR IS PUBLISHED. / / ASI, 0 TAD IU /SAVE IU AND EL FOR DCA ASIT1 /TEST AND USING IN CASE TAD EL /OF NO-FIND DCA ASIT2 TAD DDFL /USED TO SKIP LAST ENTRY IF DIM TEST DCA EL /INZ FOR LLA SEQUENCE TAD JT DCA J /J TO BOTTOM ASI1, JLLA /LOAD LOW ARGS FOR ITEM SNA CLA JMP ASI4 /NO FIND, TABLE EXHAUSTED TAD ASIT1 CIA TAD IU SZA CLA /CHECK SUPPLIED IN VS ACTUAL IU JMP ASI1 /NO MATCH TAD I X1 CIA TAD ID /CHECK OUT ID'S SZA CLA JMP ASI1 /NO-MATCH; ON ID'S CLA CMA /ID'S MATCH; TEST FOR DONE TAD IU SZA /CHECK FOR VARIABLE TAD CM1 SZA /CHECK FOR ARRAY TAD CM2 SNA CLA /CHECK FOR RECORD JMP I ASI /RETURN IF IU=1,2, OR 4 TAD I X1 CIA TAD ID1 /CHECK NEXT ID FIELD SZA JMP ASI1 /NO-MATCH-AGAIN TAD IU TAD CM3 /CHECK FOR MATCH WITH FUNCTION SNA CLA JMP I ASI /FOUND A FUNCTION TAD I X1 CIA TAD ID2 /CHECK FOR ONLY ONE LEFT SZA /-A CONSTANT JMP ASI1 /NOT A CONSTANT MATCH JMP I ASI /COMMON SUCCESS /ITEM NOT IN TABLE-ENTER IF NOT ARRAY ASI4, TAD ASIT1 /CHECK TO SEE IF IT WAS TAD CM2 /AN ARRAY OR RECORD THAT WAS NOT FOUND SZA /THEY MUST ALWAYS BE FOUND TAD CM2 SZA CLA JMP ASI45 /FOUND TAD DDFL /NOT FOUND; WAS THIS JUST A TEST? SNA CLA JMP .+3 /NO ISZ ASI /YES, ITS ALL RIGHT JMP I ASI /INCREMENT AND GO BACK TO DIM TAD RECFL /ARE WE PROCESSING A RECORD STATEMENT SNA CLA /NO, ERROR ERROR /*** ARRAY OR RECORD USED BEFORE DEFINITION *** 14 /YES, ASSIGN IT ASI45, TAD ASIT2 CIA TAD JT DCA JT TAD JT /BUMP END OF TABLE TO MAKE DCA J /ROOM IN THE ENTRY JCHK TAD ASIT2 DCA EL /SAVE LENGTH OF NEW ENTRY TAD ASIT1 /SET IU FROM TEMP DCA IU /HOLD. DCA AF /CLEAR AF & DCA DF /DF FOR INIT TRIAL CLA CMA TAD IU /IF IU=1 THEN ASSIGN ITEM SZA JMP ASI5 /CHECK FOR VARIB DEF TAD START DCA AF /DEFINE LOCATION FOR VARIB TAD C3 TAD START /ALLOCATE ROOM DCA START ASI5, JSLA /STORE AF,DF,IU,EL,+ID TAD EL TAD CM3 SNA CLA JMP I ASI /ITEM WAS A VARIB OR ARRAY TAD ID1 DCA I X1 /SAVE ID FOR FUMCTION OR CONSTANET TAD EL TAD CM4 SNA CLA JMP I ASI /ITEM WAS A FUNCTION TAD ID2 DCA I X1 /ITEM IS A CONSTANT TAD HLIMIT TAD C3 /ACCOUNT FOR CONSTANT DCA HLIMIT ASI6, JMP I ASI /COMMON EXIT FOR NO-FIND & ENTER / ASIT1, 0 /SAVE IU ASIT2, 0 /SAVE EL AAASI=.-ASI / /OPE - OPEN STATEMENT PROCESSOR / OPE, JPAS /SCAN OFF EN -2 DCA ENDINT /INDICATE FILE I/O IN PROGRAM CLA IAC /GEN CODE FOR UNIT NUMBER JEXP JTCM /CHECK FOR COMMA JMP OPFN /NEXT ARG IS FILE NAME TAD PZERO /NO COMMA JOTA /GENERATE LOAD STACK (0) XLSTD OPEL, TAD OP /IS THERE AN ELSE CLAUSE TAD CM13 SZA CLA JMP .+3 /NO, USE ELSE ADDR OF 0 JILN /YES, GET ELSE ADDR TAD LA JOTA /GENERATE OP CODE FOLLOWED BY ELSE ADDR XOPEN JSTT OPFN, STA /GEN CODE TO PUSH STRING ON STACK JINA / STING IS FILE NAME JMP OPEL /NOW GO LOOK FOR ELSE CLAUSE PZERO, INTZER /ADDR OF CONSTANT ZERO IN BASIN / /DEF-DEFINE FUNCTION PROCESSOR / / DEF SETS UP CODE TO EVALUATE A FUNCTION IN / THE INTERPRETER EXECUTION LIST. IT SETS UP / A "GOTO" AROUND THE CODE AND THEN DEFINES /THE FUNCTION AS THE PC OF THE OUTPUT. THE /CODE IS EXECUTED BY PLACING THE ARGUMENTS, /IN ORDER ON THE LIST AND CALLING THE /FUNCTION. THE ARGUMENTS ARE PICKED UP /VIA "DUMM" OP'S. THE ARGUMENT PICK-UP /CODE IS DONE IN OTR ON THE FLAG DF. / / DEF CLEARS THE DF FLAG OF ALL SYMBOLS / IN THE ASSIGNMENT TABLE BEFORE EXIT TO STT. / DEF, JGCH /DEFINE = ISZ DOLLAR /PROHIBIT STRINGS DCA AG JOTA /JUMP AROUND FUNCTION CALL XGOTO CLA CMA TAD PC /SAVE ROUT FOR SINGLE CHAIN DCA T1 JINI /GET NAME AND ASSIGN CLA CLL CMA RTL /INSURE THAT IT WAS A FUNCTION TAD IU SNA CLA TAD ID /VERIFY THAT THE FIRST TWO LETTERS ARE "FN" TAD DXFN SNA TAD DF /INSURE AGAINST DUPLICATE DEFINITION SZA CLA JMP DEF50 /ILLEGAL FORMAT IN DEF TAD AF SZA /TEST FOR PREVIOUS REFERENCES JOCH /FORWARD REF'S OUT TAD PC DCA AF /SET AF TO THE PC ISZ DF /SET DF TO 1 JSLA /DEFINE OUR FUNCTION DEF2, JINI /DUMMY PICK-UP CLA CMA TAD IU SZA CLA /CHECK FOR SIMPLEST VARIABLE DEF50, ERROR /ILLEGAL LINE FORMAT 5 ISZ AG /COUNT ARGUMENT TAD AG DCA DF /SET-UP DUMMY FLAG IN JSLA /THE VARIB'S ASSIGNMENT JTCM /TEST FOR COMMA TC JMP DEF2 /GO GET NEXT DUMMY TAD TC /GO GET NEXT DUMMY TAD CMXRP /GO BACK TO A RIGHT PAREN SZA CLA JMP DEF50 /SORRY MUST BE A PAREN JICH /GET NEXT DEAL TAD TC TAD CMXEQ /TEST FOR AN EQUAL SZA CLA JMP DEF50 /MUST BE EQUAL CLA IAC /SET AC TO 1 FOR NO FIRST READ IN INI. JEXP /EVAL EXPRESSION CLA CMA /NUMBER OF ARGS - 1. TAD AG /ADD A FUNCTION RETURN JOTC XFNRT JOWB /WORD BOUNDARY FOR LINK-UP TAD T1 JOCH /LINK TO "GOTO" TAD JT DCA J /SET-UP FOR CLEAR OF ALL DCA EL /OF FLAGS DEF5, JLLA /GET ITEM AND SNA CLA JSTT /IF DONE THEN DONE CLA CMA TAD IU /CHECK IU FOR A ONE SZA CLA JMP DEF5 /NOT A SIMPLE VARIB DCA DF TAD I X1 /RESTORE FIRST OF ID DCA ID JSLA /STORE CLEARED DF FLAG JMP DEF5 DXFN, -616 /-"FN" FOR DEF VERB AADEF=.-DEF / / ASL-ASSIGN LINE TO LINE TABLE / /ASL ENTERS A LINE # ENTRY INTO THE LINE TABLE / OR IF AN ENTRY EXISTS DELIVERS THE ARGUMENTS; / L WHICH POINTS TO THE ENTRY, LA WHICH IS /THE ADDRESS ASSIGNMENT OF THE LINE, LI WHICH / IS THE LINE #. / / IF THE LINE HAD TO BE ENTERED INTO THE TABLE LA / IS CLEARED AND BIT 0 SET TO INDICATE LINE / HAS NOT BEEN DEFINRD. / / ASL, 0 DCA LI /SAVE LINE # ARGUMENT TAD LS DCA L ASL1, TAD L CIA /TEST CURRENT POINTER AGAINST END TAD LT SNA CLA JMP ASL2 /NO SUCH ENTRY IN TABLE CLA CLL CMA RAR /GET RID OF POSSIBLE UDEF BIT AND I L CIA /TEST LINE AGIANST TABLE ENTRY TAD LI SNA CLA JMP ASL3 /MATCH ON TABLE ENTRY ISZ L /BUMP FOR NEXT LINE ISZ L JMP ASL1 /& GO GET IT ASL2, TAD ST /CHECK FOR EMPTY COMPILE STACK CMA TAD SS DCA X1 /NUMBER OF ENTRIES ON STACK CLA CMA TAD ST ASL2A, DCA X2 /SET UP FOR MOVE ISZ X1 JMP ASL2C /MOVE STACK TAD L /SAVE NEWEST LINE DCA X1 STL RAR /SET HIGH BIT FOR UNDEF. TAD LI /SAVE NEW LINE # DCA I L DCA I X1 /SAVE ADDRESS AS 0 ISZ LT /BUMP LINE TABLE LIMIT ISZ LT /BY TWO FOR THE NEW LINE ISZ SS /STACK ALWAYS GETS BUMPED. ISZ SS /BUMP LINE TABLE AND STACK START ISZ ST /BUMP TOP ISZ ST JCHK /AND CHECK ASL3, TAD L DCA X1 TAD I X1 /SET UP LA FOR ADDRESS DCA LA JMP I ASL ASL2C, TAD I X2 /MOVE ONE WORD OF STACK ISZ X2 /BUMB OVER EMPTY DCA I X2 TAD X2 TAD CM4 JMP ASL2A AAASL=.-ASL / /PUS - PUSH ITEM ONTO COMPILING STACK / / PUS STORES AC AS TOP ITEM AFTER INCREMENTATION / THE STACK POINTER OFLO CHECK IS MADE / / PUS, 0 ISZ ST /BUMP POINTER DCA I ST /SAVE ELEMENT JCHK /MAKE SURE ROOM JMP I PUS AAPUS=.-PUS / /REC - RECORD STATEMENT PROCESSOR / REC, TAD START /SAVE RECORD CORE ADDRESS DCA RECFL DCA ENDINT /INDICATE FILE I/O IN PROGRAM JPAS /SCAN OFF "OR" -2 /FALL INTO DIM PROCESSOR / /DIM-DIMENSION ARRAY PROCESSOR. / /DIM ASSIGNS ARRAYS TO THE ASSIGNMENT TABLE AND /ALLOCATES ROOM FOR THEM IN THE OBJECT LOAD. IT /HANDLES 1 AND TWO DIMENSION ARRAY'S. NOTE /THAT SINCE 0 IS A VALID SUBSCRIPT AN /EXTRA ELEMENT IS NEEDED IN EACH VECTOR OF /EACH ARRAY. / /THE ASSIGNMENT IS HANDLED BY FINDING THE ENTRY /AT THE END AND CHECKING FOR POSSIBLE DUPLICATIONS / / ARRAYS ARE STORED AS IN GENERAL FORTRAN. / DIM, JGCH /DIMENSION , DIM1, JINN /GET NAME TAD IU TAD CM2 SZA CLA JMP DIM110 /NAME MUST BE SUBSCRIPTED (UNLESS WE ARE DOING RECORD STMNT) TAD START DCA AF /DEFINE ARRAY AS NEXT LOCATION DCA T2 /CLEAR 1/2 DIM DEAL DCA DF /AND DEFINED FLAG. JIBN /GET FIRST DIMENSION IN AC JMP DIM115 /RETURNS HERE FOR 0 OR BAD NO. IAC /ADD BIAS FOR DIMENSION 0 DCA T1 /SAVE FIRST DIMENSION JTCM /TEST FOR TWO DIMENSIONS JMP .+2 /COMMA WAS THERE JMP DIM2 /NON COMMA JIBN /GET SECOND DIMENSION IN AC JMP DIM115 /RETURNS HERE FOR 0 OR BAD NO. IAC /ADD BIAS FOR DIMENSION 0 DCA T2 /SAVE AND TAD T2 /SET-UP JMUL /MPY AC (DIM-2) BY (DIM-1) T1 /ANS IN AC AND T1 JMP DIM150 / OFLO TO GR TAHNE TEWLVE BITS DIM2, CLA TAD T1 /TEST ARRAY SIZE TAD CMDS SMA CLA DIM150, ERROR /*** DIMENSION TOO LARGE *** 16 TAD TC /CHECK FOR A C AS LAST OP TAD CMXRP SZA CLA JMP DIM115 /SORRY JICH /GO GET THE TERMINATOR. TAD C3 JMUL /ALLOCATE ROOM FOR ARRAY T1 JMP DIM150 /OFLO AGAIN TAD START /BUMP STARTING OF CODE SPA /WATCH OUT FOR OVERFLOWING CORE!!! JMP DIM120 DCA START /LOCATION / /ENTER ARRAY NAME IN SYMBOL TABLE / TAD T2 /SAVE ENTRY AT END OF TABLE SZA CLA /BUMP JT DOWN BY- CLA CMA /4 IF A TWO-DIMENSION TAD CM3 /3 IF A ONE-D TAD JT DCA JT TAD JT /SET J TO STORE NEW ENTRY DCA J TAD T2 SZA CLA /SET EL TO CLA IAC /4 FOR 2-D TAD C3 /3 FOR 1-D DCA EL JSLA /STORE ID,AF,DF,EL,& IU TAD X1 /SAVE POINTER TO ID1 TO DCA X3 /SAVE DIMENSION SIZE POINTER JCHK /SEE IF NE DID IT IN TAD EL DCA DDFL /SET THE DIM FLAG JASI /DOUBLE CHECK- MAKE SURE JMP DIM115 /RETURNS HERE IF ERROR DCA DDFL /CLEAR DDFL UNTIL NEXT TIME TAD T2 /TEST FOR 2-D ARRAY SNA CLA JMP DIM3 /NOT A 2 DIM TAD T2 /SET UP FOR COMPUT CON. DCA ID2 DCA ID1 /SET UP # IN ID FOR DCA ID /DIMENSION COMPUTE DCA SN /AS A + INTEGER DCA DE JFLT /FLOAT IT JMP DIM150 /NOT TOO REALISTIC TAD C5 DCA EL /SET TYPE UP AND DCA IU /SIZE THEN, JASI /ASSIGN IT TO TABLE TAD J DCA I X3 /SET UP POINTER TO # IN ENTRY FOR ARRAY DIM3, JTCM /MORE TO DO? JMP DIM1 /YES TAD RECFL /NO, ARE WE PROCESSING A RECORD STATEMENT SNA CLA JMP DIM5 /NO TAD C4 /YES, GET READY TO MAKE ASSIGNMENT TABLE ENTRY DCA IU /SET USE INDICATOR TO RECORD TAD C4 DCA EL /ELEM. LENGTH IS 4 TAD LINE /IDENTIFY RECORD STATEMENT BY LINE NO. DCA ID TAD RECFL /COMPUTE RECORD LENGTH CIA TAD START DCA ID1 JASI /GO ENTER IN TABLE TAD RECFL /SET UP CORE ADDRESS FIELD OF ENTRY DCA AF JSLA TAD ID1 /ROUND OFF LENGTH OF STORAGE ALLOCATION TO NEXT TAD CM201 / HIGHEST BLOCK OF 129 (DECIMAL) WORDS SMA SZA JMP .-2 CIA TAD START SPA /CHECK FOR STORAGE SPACE OVERFLOW JMP DIM120 DCA START /NO OVERFLOW, STORE ADDR OF NEXT AVAILABLE WORD DIM5, DCA RECFL /CLEAR RECORD FLAG UNTIL NEXT TIME JSTT /NEXT STATEMENT. DIM110, TAD RECFL /ARE WE DOING A RECORD STMNT SNA CLA JMP DIM115 /NO, ALL NAMES MUST BE SUBSCRIPTED STA /YES, IS NAME A SIMPLE VAR TAD IU SZA CLA DIM115, ERROR /*** IMPROPER DIM OR RECORD STATEMENT *** 17 JASI /YES, SO ASSIGN IT JMP DIM3 /AND GO BACK FOR MORE CMDS, -454 /MACIMUM DIM SIZE=300 (DECIMAL) CM201, -201 DIM120, ERROR 1 /PROGRAM TOO LARGE AADIM=.-DIM C100, 100 C26, 26 C46, 46 C6, 6 CM10, -10 CM71, -71 JEXP20=JMP I . EXP200 JEX10A=JMP I . EXP10A JEXP14=JMP I . EXP14 JEXP17=JMP I . EXP17 EXP10X, DCA EXPT1 /CLEAR ENTRY FLAG JMP I EXP /EXIT VECTOR. / /EXP-EXPRESSION ANALIZER / /EXP CONVERTS AN INFIX EXPRESSION TO REVERSE POLISH /FOR EVALUATION BY THE INTERPRETER. EXP WILL OUTPUT /A BODY OF CODE THAT WILL CLEAR THE STACK OR /WILL LEAVE A VALUE ON THE TOP OF THE STACK. THIS /ACTION IS ON CONTEXT AND ON THE CONTENTS OF THE AC /UPON ENTRY. / /RF IS SET UPON EXIT TO INDICATE IF A RELATIONAL OPERATION /WAS ENCOUNTERRED IN THE SCAN / / AC ON ENTRY HAS THE FOLLOWING EFFECTS: / AC=-1 SPECIAL HACK FOR CHANGE STATEMENT!!!!! / AC=0 DO NOT READ FIRST VARIABLE, IT IS IN ALREADY. / AC=1 DO NOT ALLOW RELATIONALS / AC=2 ALLOW ONLY "=" BUT AS REPLACE / AC=3 ALLOW RELATIONALS AS LOGICALS / EXP, 0 DCA EXPT1 /SAVE ENTRY STATE DCA RF /CLEAR RELATION/REPLACE FLAG JPUS /MARK STACK WITH AN M.T. TAD C100 DCA SNFL /SET SIGN FLAG FOR EXP COMPILE TAD EXPT1 SPA SNA CLA /ENTRY SWITCH TO ZERO (?) JMP EXP3 /CHECK FOR RELATIONAL OP EXP1, JINI /GET ITEM TAD EL SZA CLA JMP EXP3 /OP ALONE CLA CMA TAD OP /CHECK FOR OP=1, LEFT PAREN SZA CLA / JMP EXP2 /NO LEFT RAREN TAD OP EXP1A, JPUS /PLANT OP ON LIST JMP EXP1 EXP2, TAD OP TAD CM41 /CHECK FOR UNARY OP'S SNA /IF PLUS DROP IT JMP EXP1 /PLUS SIGN - LONE OP - UNARY + TAD CM1 SZA CLA /CHECK FOR UNARY - OP JEXP20 /ALLOW ONLY UNARY + OR - TAD C46 /IF A - SET TO UANARY - JMP EXP1A /GO PUSH THE UNARY EXP3, TAD OP /CHECK FOR RELATIONAL OP'S TAD CM26 /IF OP > 25 .OR. OP < 20 GOTO EXP4 CLL TAD C6 SNL CLA JMP EXP4 TAD RF SZA CLA JEXP20 /DANGLING OP. TAD EXPT1 TAD CM2 SPA CLA JEXP20 ISZ RF EXP4, TAD OP TAD CM20 SZA CLA JMP EXP5 /TEST FOR REPLACE OR EQUAL TAD EXPT1 /TEST FOR REL TAD CM2 SZA CLA JMP EXP5 TAD C26 DCA OP TAD J /THE LEFT SIDE JPUS TAD IU JPUS /PUSH POINTER AND USAGE JMP EXP6A /GO PUSH THE REPALCE OP. EXP5, TAD OP /TEST FOR SPECIAL OP'S TAD CM71 SZA JMP EXP6 TAD J /OP WAS A Z JPUS TAD C2 /SET TO FUNCTION CALLER JMP EXP6B /DO A PUSH AND GO BACK TO THE TOP EXP6, IAC /DO ARRAY CHECK SZA CLA JMP EXP8 / TAD J /OP WAS 3 FOR JPUS /ITEM POINTER PUSH TAD EL TAD CM3 SZA CLA JMP EXP7 /TWO DIMENSION ARRAY JMP EXP7A /PUSH A 0 FOR 1-D. EXP6A, TAD OP /PUSH THE OPERATOR. EXP6B, JPUS /JUSH PUSH AND GO THE TOP. JMP EXP1 EXP7, TAD I X1 /PUSH DIMENSION SIZE POINTER EXP7A, JPUS /AND CODE FOR DIMENSION TAD C3 JMP EXP6B EXP8, TAD IU /OUTPUT A LOAD FOR CURRENT TAD CM2 /ITEM IN J + IU. SNA CLA JMP EXP9 /CHECK FOR ARRAY OR VARIAB TAD J /VARIABLE REF JOTR XLSTD JMP EXP10 EXP9, TAD I ST /CHECK TO SEE OUPUT OF A LSTI TAD EXPT1 /IS WANTED. USED BY INPUT AND SNA CLA /READ VERBS. JMP EXP10 /SKIP IT. JOTI /ARRAY REFERENCE XLSTI EXP10, TAD OP AND C70 /CHECK FOR HIERARCHY CHANGE CIA DCA X2 /HR IS IN BITS 6-8 TAD I ST /OF THE OP VALUE AND C70 TAD X2 SMA CLA JEXP14 /HR OF TOP LESS THAN OP SO POP TAD OP TAD CM20 SPA JEX10A /OP WAS LESS THAN 20. TAD CM10 SNA CLA JEXP17 /OP WAS A COMMA. JMP EXP6A / EXPT1, 0 /ENTRY FLAG SAVE PAGE / / BEGIN NEXT PAGE OF EXPRESSION. / C11, 11 C41, 41 CM5, -5 CM7, -7 CM11, -11 CM30, -30 JEXP1=JMP I . EXP1 JEXP90=JMP I . EXP90 JEXP10=JMP I . EXP10 JOTF=JMS I . OTF JIOP=JMS I . IOP / / / EXP10A, CLA /TEST OP FOR RIGHT PAREN. TAD OP TAD CM11 SZA CLA JMP EXP100 /DONE IF OP NOT A ), MAYBE CLA CMA TAD I ST SNA JMP EXP12 /CHECK OUT LEFT PAREN TAD CM1 SZA JMP EXP11 JPOP JPOP /GET PIONTER TO FUNCTION NAME. DCA J /SET UP POINTER TO FUNCTION NAME JOTF /OUTPUT THE FUNCTION CALL. JMP EXP12A EXP11, TAD CM1 SZA CLA JMP EXP200 /EXTRA PAREN ( JPOP JPOP /POP INTO AC SZA CLA JMP EXP200 JPOP DCA J TAD J JOTR XSBSC TAD C2 /SET UASGE TO ARRAY DCA IU /FOR THE OUTPUT JICH JEXP90 EXP12, JPOP /SCAN-OFF LEFT PAREN EXP12A, JIOP /AND THEN GET NEW TERMINATOR. JEXP10 EXP14, TAD OP TAD CM11 SNA JMP EXP16 /RIGHT PAREN TAD CM7 SNA CLA /CONTIUE FOR LESS THAN 20. JMP EXP16 /HR FOR AN OP TAD I ST TAD CM26 SZA JMP EXP16 /NEXT UP NOT TREPLAVCE JPOP /GET RID OF REPLACE JPOP DCA IU /SET UP OTHER SIDE OF STORE JPOP DCA J CLA CMA TAD IU SZA JMP EXP15 /DO SIMPLE VARIABLE OR ARRAY STORE TAD J JOTR XSSTD JMP EXP100 /THAT MUST BE ALL! EXP15, TAD CM1 /ARRAY STORE CODE SZA CLA JMP EXP200 JOTI /STORE ARRAY ELEMENT XSSTI JMP EXP100 /THAT MUST BE ALL! EXP16, CLA CLL /OUTPUT AN OPERATOR TAD I ST TAD CM26 SNA CLA JMP EXP200 JPOP /PICK UP OP ON STACK TAD CM30 /TEST FOR RELATIONAL OR ARITH SMA JMP EXP16A /IT IS A ARITHMETIC TAD C11 /ADJUST BACK FOR REL ATIONAL JOTC XTEST JMP EXP100 /THAT MUST BE ALL! EXP16A, AND C7 /GET RID OF ALL BIT BIUT LO THREE DCA EXPOP /SAVE OP AND CHECK FOR EXPONENTIATION TAD EXPOP TAD CM5 SNA CLA JOBB /BASIN TREATS ^ LIKE AN INTERNAL FCN; / SINCE FUNCTION RETURN IS DONE TO THE / WORD FOLLOWING THE CALL (I.E. THE ^ OP / CODE) THIS LOCATION MUST BE START OF A / WORD; HENCE THE JOBB JOTI /OUTPUT OP CODE EXPOP, XEND JEXP10 EXP17, TAD I ST /OP IS A COMMA TAD CM2 SNA /MARK FOR ARRAY JEXP1 /AFTER END CHECK. TAD CM1 SZA CLA JMP EXP100 JPOP JPOP /GET THE POINTER TO THE DIM SIZE. SNA JMP EXP200 DCA J JPUS /MARK WITH A ZERO FOR NEXT DIM PROCESSING. TAD C3 JPUS /MAKE WITH 3 FOR ARRAY TAD J JOTR XLSTD TAD C41 JPUS JOTC XMPY /COMPUTATION OF ARRAY POSITION JEXP1 / / EXP100, JPOP /TEST FOR THE STACK MARK. SZA CLA /AS MARKER ON STACK EXP200, ERROR /*** ILLEGAL SYNTAX *** 15 JMP I .+1 /RETURN TO CALLER VIA A VECTOR TO AVECTOR EXP10X AAEXP=.-EXP PAGE CM14, -14 CM15, -15 / /FOR - FOR STATEMENT PROCESSOR / /FOR SETS UP CODE FOR A DO LOOP IN THE /INTERPRETER EXECUTION LIST. CODE IS GENERATED /TO INIT THE CONTROL VARIABLE AND SET-UP /THE PARAMETERS ON THE STACK FOR EXECUTION / /THE PC OF THE DO IS SAVED ON THE STACK /FOR THE PROCESSING OF THE NEXT VERB / / / FOR, JGCH /FOR=TOSTEP JISV /GET CONTROL VARIAB TAD J DCA T1 /SAVE IT'S ADDRESS IN TABLE TAD TC TAD CMXEQ ISZ DOLLAR /PROHIBIT STRING!! SKIP IF CNTRL WAS STRING SZA CLA JMP FOR10 TAD ID JPUS /PUT OUT ON STACK FOR ID CLA IAC /SET TO IGNORE FIRST READ. JEXP /GET CODE FOR INIT VALUE TAD OP TAD CM15 SZA CLA /OP/TC MUST BE "TO" JMP FOR10 TAD T1 /OUTPUT CODE TO STORE INIT JOTR XSSTD CLA IAC JEXP /PICK UP STEP VALUE TAD OP TAD CM14 /TEST FOR THE "STEP" OPERATOR SZA CLA JMP FOR1 /NO STEP CLA IAC /ALLOW NO RELATIONALS. JEXP /GET STEP VALUE JMP FOR2 FOR1, TAD PONE JOTA /OUTPUT CODE TO PUSH A 1 AS THE STEP XLSTD FOR2, JOWB /OUTPUT FOR THE DO TAD PC /PICK UP ADDRESS IF DO TAD C3 /COMMAND JOTA XLSTA TAD T1 /PICK UP PICKUP OF CONTROL JOTR XLSTD JOBB /SET TO PROPER BOUNDARY JOTA XDO CLA CMA TAD PC /PLACE MARKER FOR NEXT JPUS /ON THE STACK ISZ FORFG /COUNT FOR STATEMENTS JSTT FOR10, ERROR /*** ILLEGAL LINE FORMAT *** 5 PONE, INTONE /ADDRESS OF CONSTANT ONE IN BASIN AAFOR=.-FOR / /IFP - IF PROCESSOR / /IFP USES EXPRESSION TO DEPOSIT A TRUTH VALUE ON /THE TOP ENTRY OF THE STACK AND OUTPUTS AN /"IF" AND THE LINE # OF THE REFERENCE. / IFP, /IF(THEN, GOTO) /NONE TO PASS OFF. TAD C3 /ALLOW RELATIONALS IN EXPRESSSION JEXP TAD OP /CHECK THE OPERATOR TAD CM12 SNA CLA TAD RF /TEST THE RELATIONAL FLAG TO SNA CLA /MAKE SURE THERE WAS A RELATIONAL. JMP FOR10 /ILLEGAL LINE FORMAT JILN TAD LA JOTA XIF JSTT AAIFP=.-IFP / / UNS - UNSAVE STATEMENT PROCESSOR / SLE - SLEEP STATEMENT PROCESSOR / CLO - CLOSE STATEMENT PROCESSOR / / ALL THREE STATEMENTS TAKE ARITH EXPR AS ONLY ARGUMENT / UNS, JGCH /PASS OVER "S" DCA ENDINT /INDICATE FILE I/O IN PROGRAM IAC /XUNS=XCLO+2 SLE, IAC /XSLEEP=XCLO+1 CLO1, TAD CXCLO DCA CLOC1 /STORE APPROPRIATE OP CODE JPAS /PASS OVER LAST 3 CHARS OF VERB -3 CLA IAC /GENERATE CODE TO PUSH ARG ON RUNTIME STACK JEXP JOTI /OUTPUT OP CODE CLOC1, XEND /THIS IS FILLED WITH XCLO, XSLEEP OR XUNS JSTT CXCLO, XCLO CLO, DCA ENDINT /INDICATE FILE I/O IN PROGRAM JMP CLO1 / /LINP - LINE INPUT / /LINPUT IS A VARIATION ON REGULAR INPUT WHICH PERMITS READING /BLOCKS OF STRING DATA. AN ENTIRE LINE IS READ INTO SEVERAL /STRING VARIABLES (ONLY -CR- IS TERMINATOR) 6 CHARACTERS INTO EACH. LINP, JOTI XLINP JGCH /SCAN OVER "N" /FALL INTO INPUT PROCESSOR /INP - INPUT PROCESSOR / /INP GENERATES CODE TO PICK UP AND STORE A NUMBER /FROM THE USER CONSOLE INTO AN ARRAY ELEMENT /OR A SIMPLE VARIABLE / / INP, JPAS /INPUT , -3 /PUT INP1, JMS OXR /OUTPUT REFERENCE XINPD XINPI JTCM /COMMA TC JMP INP1 /YES MORE JOTI XINTRM /TERMINATE INPUT STRING JSTT AAINP=.-INP / /OUTPUT REFERENCE TO VARIABLE / (1) IF SIMPLE VARIABLE / (2) IF ARRAY VARIABLE / OXR, 0 JINA CLA CMA TAD IU /IU=1 IF SIMPLE VARIABLE SZA CLA JMP OXR1 TAD I OXR DCA OXR2 /SET UP CALL TAD J /POINTER TO REFERENCE JOTR OXR2, 0 JMP I OXR OXR1, ISZ OXR /GET ARG2 TAD I OXR DCA .+2 /SET UP CALL JOTI 0 JMP I OXR /AND EXIT / / CHK-CHECK MEMORY OVERFLOW / / CHECKING OF THE TABLE POINTERS FOR CROSSING IS DONE / BY THIS ROUTINE. THE LINE TABLE & ASSIGNMENT TABLE / MAY MEET, OR THE COMPILING STACK AND THE LINE / TABLE MAY MEET. IF LIMITS CROSS THEN AN OVERFLOW / ERROR EXIT IS MADE. / CHK, 0 CLA CLL TAD ST /CHECK STACK AGAINST SYMBOLS. CIA TAD JT SMA SZA CLA /IF ST .GE. JT JMP I CHK ERROR /*** DATA POOL OVERFLOW *** 1 AACHK=.-CHK / /CHAIN - CHAIN STATEMENT PROCESSOR / CHAIN, JGCH /SCAN OFF "N" STA /GEN CODE TO PUSH STRING ON STACK JINA / STRING IS PROGRAM NAME JOTI /OUTPUT CHAIN OP CODE XCHAIN JSTT PAGE CM23, -23 CM33, -33 CMXBL=DIVC1 CMXLS, -XLS / / ICH-INPUT CHARACTER ROUTINE / / ICH IS USED TO READ AND CONVERT THE NEXT / CHARACTER OF THE INPUT STRING. ICH SETS TC / TO CONTAIN THE 6 BIT VALUE OF THE CHARACTER / AND SETS OP TO INDICATE THE CHARACTER CLASS / THESE VALUES ARE LISTED BELOW. ICH USES TBLB / TO CONVERT THE OPERATORS TO THEIR INTERNAL CODE. / / OP IS SET AS FOLLOWS BY ICH / OP=-1 TC CONTAINS A NUMBER / OP=100 TC CONTAINS A LETTER / OP=ALL ELSE TC IS AN OPERATOR AND / OP HAS INTERNAL CODE / RE SWITCH IS SET TO CAUSE A CHARACTER TO BE RE-READ. / IF RE=-1 THE THE LAST CHARACTER IS RE-READ / IF RE=0 THE THE NEXT CHARACTER IS PRESENTED. / / ICH, 0 CLA TAD ICHT1 /SET TEMP TO TC IN CASE DCA TC ISZ RE /IGNORE CALL TO ICO IF RE=-1 JMS GCH /INPUT COLUMN, IGNORE BLANKS DCA RE /RESET REREAD TAD TC DCA ICHT1 /SET-UP TC FOR POSSIBLE RE-READ CLA CLL /TEST FOR OP,ALPHA, OR NUMBER. TAD TC / SNA /TEST FOR OP AND EOL. JMP ICH1 TAD CM33 /CHECK FOR RANGE A-Z SMA /IF NEGATIVE THEN ALPHA JMP ICH2 /CHAR IS NOT A LETTER CLA /SET OP TO 100 FOR ALPHA TAD C70 /SET OP TO 100 ICH1, TAD ICHC2 /SET OP TO 10 JMP ICH3 ICH2, TAD CM25 SPA /LINE ON IS OVER CH0 JMP ICH4 /AC IS BETW -25 AND -1 TAD CM12 /CHAR BETWEEN 0 & 9 SMA /IF 0 OR + THEN OVER CH9 JMP ICH4 /AS IS BETW 0-6 CLA CMA ICH3, DCA OP /SET OP TO A -1 AND GO JMP I ICH / / AC HAS INTERGER THAT IS AN INDEX INTO THE OP/CHAR TABLE / IT MUST BE SCARED BY A 25 BEFORE USAGE / ICH4, TAD ICHC1 / DCA X1 TAD I X1 /PICK UP TABLE ENTRY SPA JMP ICH10 /CHAR NOT VALID OP AND C77 DCA OP /SAVE LOW 6 ONLY AS OP TAD TC /TEST FOR SPECIAL DOUBLE CHAR TAD CMXLS /OP'S. SZA /SKIP IF A < WAS READ TAD CM2 SZA CLA /IF ZERO IT WAS GR THAN. JMP I ICH TAD TC DCA ICHT2 JMS GCH /GET NEXT; POSSIBLE DOUBLE TAD TC TAD CMXEQ /TEST FOR <= OR>= SEQ SNA JMP ICH11 /.LE. OR .GE. SEQUENCE TAD CM1 SNA CLA /CHECK FOR <> SEQUENCE JMP ICH9 /SET OP FOR NOT EQUAL CLA CMA DCA RE /OP IS < OR > ALONE, SET TAD TC /SET UP OLD TC FOR NEXT GO-AROUND. DCA ICHT1 /SAVE FOR PICK-UP TAD ICHT2 /PICK UP THE TC FROM BEFORE. DCA TC /BECAUSE WE NEED IT AFTER ALL JMP I ICH /TO RE-READ THE CHAR ICH9, TAD OP TAD CM23 /TEST FOR LAST CHAR A '<' SZA CLA /OR GR ICH10, ERROR /*** ILLEGAL INPUT CHAR ICHC2, 10 /OP VALUE FOR EOL ISZ OP ICH11, ISZ OP /BUMP OP TO A 22 JMP I ICH GCH, 0 GCH1, JICO /NEXT LETTER TAD TC TAD CMXBL SNA JMP GCH1 /SCAN OFF BLANKS TAD C4 /CHECK FOR BACKSLASH SNA JMP GCH20 /GOT ONE TAD CM13 /CHECK FOR APOSTROPHE SZA CLA JMP I GCH /EXIT GCH10, JICO /CROSS OVER TO EOL TAD TC SNA /WAS IT CR JMP I GCH /YES, SO EOL TAD CM34 /WAS IT BACKSLASH SZA CLA JMP GCH10 /NO, KEEP GOING UNTIL EOL REACHED GCH20, TAD IS /SAVE BUFFER WORD SIDE INDICATOR DCA BSLFG DCA IS /ACT LIKE AN EOL DCA TC JMP I GCH ICHT1, XBL /INITIAL CHAR-ASSUME BLANK-FORCE IGNORE ICHT2, 0 /SAVE TC ACROSS LOOK-AHEAD FOR RESTORE ICHC1, TBLB+24 /TABLE OFSET FOR AUTO + CHAR CM25, -25 CM34, -34 AAICH=.-ICH / /ITS - INPUT TESTS / /ITS GETS THE CURRENT CHAR AND THE NEXT CHAR FOR /AN OP LIKE "STEP", "GOTO", "TO", "THEN" AND IF /FOUND EXITS AT CALL+2 WITH OP SET. /IF NOT FOUND EXITS AT CALL+1 / / / ITS, 0 TAD TC /SAVE CURRENT CHAR RTL CLL RTL CLL RTL CLL DCA X6 JICH /GET NEXT TAD TC TAD X6 DCA TC JMS I PSCN ITSTAB-2 TAD TC /RETURNS HERE ONLY IF NO MATCH AND C77 / SO RESTORE TC TO LAST CHAR DCA TC JMP I ITS PSCN, SCN ITSTO, TAD C15 DCA OP JMP ITSOUT C15, 15 ITSST, IAC ITSEL, IAC ITSTH, TAD C12 DCA OP JGCH JGCH ITSOUT, ISZ ITS JMP I ITS AAITS=.-ITS PAGE / /NEX - NEXT PROCESSOR / /"NEXT" IS THE COMPANION TO "FOR". NEX CHECKS THE /COMPILING STACK FOR AN ENTRY WHICH IS RESUMED TO /BE THE PC OF ITS FOR IN THE FOR/NEXT NEST. / /CODE FOR THE VARIABLE, AND PC OF THE FOR ARR /OUTPUT FORM NEX / / NEX, JPAS /NEXT -2 /XT JISV /GET SIMPLE VARIABLE TAD J JOTR /THE NEXT OP AND OUTPUT XNEXT JOWB CLA CMA TAD FORFG /IS THERE ANY FOR WITH THIS NEXT? SPA JMP NEX10 /NO THERE ISNT DCA FORFG /RESET FOR-NEXT COUNT JPOP /CODE JOCH /CHAIN BACK TO "DO" IN INTERD JPOP CIA TAD ID SNA CLA JSTT NEX10, ERROR /****NEXT WITHOUT FOR IN LINE XXXX 36 AANEX=.-NEX C17, 17 / / IBN-INPUT A BINARY NUMBER. / / INPUTS A BINARY NUMBER ONLY. REQUIRES AT LEAST ONE / DIGIT, AND THAT NUMBER FITS INTO LESS THAN 12 BITS / USES THE MULTIPLY ROUTINE. / / EXITS AT CALL&1 FOR BAD NUMBER AND AT CALL&2 / WITH THE GOOD NUMBER IN THE AC / / IBN, 0 CLA CLL DCA IBNT1 JICH /MAKE SURE FIRST IS A DIGIT. TAD OP SMA JMP I IBN /EXIT AT CALL&1, NON-DIGIT AS #1 JMP IBN2 /FUDGE ON FIRST DIGIT. IBN1, JICH /GET A DIGIT TAD OP SMA CLA /TEST TO SEE HOW IT WAS JMP IBN3 /EXIT WITH NICE # TAD C12 JMUL /MULTIPLY BY 10-10 IBNT1 JMP I IBN IBN2, CLA CLL / TAD TC /ACCUMULATOR NEWEST POSITION AND C17 TAD IBNT1 SZL /TEST FOR ACCUM OFLO. JMP I IBN /OF-LO ON NUMBER DCA IBNT1 JMP IBN1 IBN3, ISZ IBN TAD IBNT1 JMP I IBN / IBNT1, 0 /NUMBER BUILD AREA AAIBN=.-IBN JRFL=JMS I . RFL / / ICO- INPUT A SOURCE COLUMN / / ICO READS LINE NUMBERS IN BINARY AND SOURCE COLUMNS IN / ASCII (6 BIT SQUOZE CODE). THE CHARACTER IS IN TC AND / A LINE # IS IN LINE. THE INITIAL READ FOR A LINE / IS SET BY SETTING IS EQUAL TO -3. THE LINE # AND / FIRST COLUMN ARE READ / / / IS=-1 LEFT 6 BITS OF IBUF TO TC / IS=-2 RIGHT 6 BITS OF IBUF TO TC / IS=-3 READ LINE # AND FIRST COL. / IS=0 EOF READ ONCE ALREADY, NEXT READ IS ERROR. / / ICO, 0 ISZ IS /CHECK INPUT SWITCH JMP ICO2 /WAS NOT A-1 JRFL /NEW WORD FOR IS=-1 SNA JMP ICO3 /END OF FILE WORD ICO1, DCA ICOT1 STA CLL RAL /RESET IS FOR RIGHT SIX NEXT DCA IS TAD ICOT1 /PICK-UP WORD FROM BUFFER RTR RTR RTR /SET HI 6 OF IBUF TO LO 6 AC JMP ICO2A /COMMON EDIT ICO2, ISZ IS JMP ICO4 /WAS NOT A-Z CLA CMA /SET IS FOR NEXT COLUMN. DCA IS /SINCE ISZ MADE IT ZERO TAD ICOT1 /IS IS-1 FOR LEFT SIDE NEXT ICO2A, AND C77 ICO2B, DCA TC /SET UP LO 6 IN AC CLEARED JMP I ICO /AND GO ICO3, DCA IS JMP ICO2B ICO4, ISZ IS JMP ICO5 /WAS NOT A -3 JRFL /READ LINE# DCA LINE JRFL /READ FIRST WORD + DO SZA /EOF CHECK JMP ICO1 ERROR /*** MISSING END STATEMENT $$$$ 2 ICO5, ERROR /*** ILLEGAL LINE FORMAT $$$$ 5 ICOT1, 0 /SAVE CURRENT WORD OF INPUT AAICO=.-ICO / / INA-INPUT NAME / / INA PERFORMS ONE OF TWO FUNCTIONS DEPENDING ON THE / CONTENTS OF THE AC WHEN IT IS CALLED. / / AC .EQ. -1 : GET STRING / TESTS THE INPUT LINE FOR A STRING CONSTANT OR STRING / VARIABLE AND GENERATES THE CODE TO PUSH THE STRING ON / THE STACK AT RUNTIME. IF NO STRING IS FOUND IT IS AN ERROR. / TERMINATOR AFTER STRING MUST BE EOL OR "ELSE" / / AC .NE. -1 : GET VARIABLE OR ARRAY REFERENCE / TESTS THE INPUT LINE FOR A VARIABLE OR ARRAY REFERENCE. / ANY OTHER IS ERROR. IF THE REFERENCE IS TO AN ARRAY, THE / CODE TO COMPUTE THE SUBSCRIPT IS COMPILED, BUT NO LOAD / IS GENERATED. / / INA, 0 DCA INASW DCA DOLLAR /PERMIT STRING OR NOT STRING JINI /GET AN OPERAND CLA CMA TAD IU SNA JMP INA2 /ITEM IS SIMPLE VARIB TAD CM1 SZA CLA JMP INA1 JEXP /SET UP SUBSCRIPT CODE CLA CLL CML RTL DCA IU /SET TO ARRAY INA2, ISZ INASW /ARE WE LOOKING FOR STRING JMP I INA /NO, GO BACK INA3, TAD OP /YES, TERMINATOR MUST BE ... TAD M10 / EOL OR ... SZA TAD CM3 / "ELSE" SZA CLA JSTT /LET STT ROUTINE SIGNAL ERROR ISZ DOLLAR /WAS STRING FOUND JMP INA4 /NO, ERROR STA /GENERATE CODE TO LOAD STACK JEXP JMP I INA INA1, ISZ INASW /LOOKING FOR STRING? INA4, ERROR /NO, ERROR 12 /*** ILLEGAL VARIABLE *** JMP INA3 /YES, STRING CONSTANT IS OK M10, -10 INASW, 0 AAINA=.-INA / /LET - LET PROCESSOR / /LET USES EXPRESSION TO GENERATE CODE AND /STORE IT. LET REQUIRES A REPLACEMENT /OPERATOR TO BE PRESENT / LET, JGCH /LET = LET1, CLA CLL CML RTL JEXP /ALL = AS REPLACE TAD RF SZA CLA /MAKE SURE = WAS THERE JSTT JMP ICO5 /ILLEGAL LINE FORMAT AALET=.-LET PAGE / / END - END STATEMENT PROCESSOR / END, TAD C3 CALPRG /DO IT ALL IN THE LOADER CMXPL, -XPL JINN15=JMP I . INN15 JINN16=JMP I . INN16 JDOLL=JMS I . DOLL JINNL=JMP I . INNL C4400, 4400 C71, 71 CMXLP, -XLP / /INN - INPUT NEXT NAME / /INN WILL SET-UP THE ELEMENT AND TC OR /TC ALONE WHEN CALLED THE ELEMENT IS IN /ID,ID1,+ ID2 AND THE TC IN TC AND OP. / /IT PACKS UP SYMBOLS + MAKES CONSTANTS INTO FLOATING /POINT #'S ARE NICE AND REAL / /IT ALSO CONVERTS OPERATORS AS TO, STEP, THEN, ETC / TO SINGLE OP' NOT A VALUE. / / INN ALSO CLASSSIFIES THE ELEMENT VIA IU AND EL / / INN, 0 CLA DCA ID /ID CHARS 1-2 DCA ID2 /CHAR 3 DCA ID1 /MANTISSA LOW 12 DCA EL /ENTRY LENGTH / DECIMAL NUMBER SWITCH DCA IU /USAGE SWITCH DCA SN /SIGN OF NUMBER SWITCH DCA DE /DECIMAL EXP BUILD SWITCH INN1, JICH TAD OP SPA CLA JMP INN13 /CHARACTER WAS A NUMBER TAD EL SZA CLA JINN16 /DECIMAL NUBER BEING BUILT. TAD TC TAD CMXPT /TEST FOR A DECIMAL POINT. SNA CLA JINN15 /GO TO THE DECIMAL POINT TAD SN SNA /TEST FOR SAVE + OR - MARK JMP INN2 /NONE SAVED IF SN=0 DCA OP CLA CMA /SET RE-READ SWITCH DCA RE /FOR NEXT ICH SEQUENCE. JMP I INN /EXIT FOR ONE + OR - MRAK. INN2, TAD TC /TEST FOR QUOTE TAD CM42 SNA CLA JINNL /TREAT AS STRING CONSTANT INN2X, TAD SNFL TAD TC /WIL BE FOUND TAD CMXPL /TEST FOR A "+" AND SNFL=0 SZA TAD CM2 /TEST FOR A "-" AND SNFL=0 SZA CLA JMP INN3 /NOT A + OR - OR SNFL=100 TAD OP DCA SN /SAVE UNARY SIGN MAYBE UNARY MINUS. JMP INN1 /MORE INN3, TAD OP /TEST FOR OP ALONE TAD CM100 /WAS IT ALPHA? SZA CLA JMP I INN /OP ALONE TAD TC RTL CLL /SET UP TC IN HI6 RTL CLL RTL CLL DCA ID /STORE FIRST CHAR OF ID JICH /GET NEXT CHAR TAD OP /TES FOR A TERMINATOR SMA CLA JMP INN3D /NOT A NUMBER TAD ID TAD TC DCA ID /ADD IN SECOND CHAR JICH INN3D, JDOLL /TEST FOR DOLLAR TAD CM100 TAD OP /CONTINUE CHECK SNA CLA JMP INN4 TAD TC /SECOND IS DELIMITER. TAD CMXLP SZA CLA JMP INN3A TAD C70 /ITEM IS AN AARAY DCA OP CLA IAC INN3A, IAC DCA IU TAD C3 /SET LENGTH TO TREE AND GO ON INN3B, DCA EL JMP I INN /EXIT FOR ARRAY OR VARIB PLUS OTHERS / / CONSTANTS ENTER HERE WITH EL=5 AND IU=0 / INN4, TAD OP /TEST FOT TYPE OF OP SPA JMP INN12 /NUMBERS NOT ALLOWED TAD CM100 SZA CLA JMP INN5A /CHAR IS A DELIMITER. TAD TC DCA X5 /SAVE TC TO SAVE SHIFTING. JITS /TEST FOR GOTO ETC. JMP INN7 /DIDN'T FIND ONE, ASSUME FUNCTION. INN5A, TAD EL /OP WAS A TO SNA CLA /TEST TYPE OF TERMINATOR. JMP INN3A /GO SET FOR VARIABLE JMP I INN /GO EXIT FOR CONSTANT INN7, TAD IU /FUNCTION CALLS TAD EL /TEST FOR CONSTANT AS ITEM SZA CLA INN12, ERROR /******** ILLEGAL CHARACTER $$$$$$$$$ 10 TAD X5 TAD ID DCA ID /RE-BUILD FUNCTION CALL TAD TC INN7B, DCA ID1 JICH /GET FUNCTION CALL TERM TAD TC TAD CMXLP SNA JMP INN7A /OK--WE GOT A ( TAD C4 SZA CLA /WAS IT A $? JMP INN12 /NO--ERROR TAD ID1 /ADD DOLLAR TO ID1 TAD C4400 JMP INN7B INN7A, TAD C71 DCA OP /SET FUNCTION OP TAD C3 DCA IU /USAGE AND TAD C4 /LENGTH JMP INN3B / /NUMBER DETECT (MANTISSA ONLY) / INN13, TAD ID /TEST FOR POSSIBLE OFLO TAD CM20 / / START NEW PAGE OF INPUT ROUTINE. / SMA CLA INN200, ERROR 6 /*** ILLEGAL CONSTANT *** CLA CLL /MUST CLEAR LINK BEFORE CALL TO JMPY JMPY /MULTIPLY TO MAKE ROOM FOR 10 DIGIT TAD TC /ADJUST # TO 0-9 TAD CMX0 CLL /SET UP LINK FOR OFL. TAD ID2 DCA ID2 SNL /TEST OFLO JMP .+4 /NO OFLO INTO ID1 ISZ ID1 JMP .+2 /NO OFLO TO ID ISZ ID TAD DE TAD INNT1 /ACCUM SIGN IF ON RIGHT OF DCA DE /DEC PIOIONT JMP INN15A /DECIMAL POINT DETECT. INN15, CLA CMA /DEC PIONT DETECT DCA INNT1 /SET UP COUNT FOR THE DECIMAL EXP INN15A, TAD C5 /SIGN IF AND DCA EL /FLAG EL AS NUMBER INN. JINN1 /MANTISSA TERMINATED. INN16, TAD TC TAD CMXPT SZA CLA JMP INN18 /TERM - NOT A DEC POINT TAD INNT1 SZA /TEST FOR FIRST DEC POINT. JMP INN200 /DECIMAL PIONT DETECT. JMP INN15 /GO TO THE DECIMAL POINT DETECT SHOW. INN18, TAD TC TAD CMXE /TEST OR EXP SZA CLA JMP INN23 /NO BLATANT EXPONENT CLA CMA DCA X6 /SET UP PROCESS JICH /GET SIGN TAD OP SPA JMP INN20 /NO-SIGN TAD CM41 SNA JMP INN20A /+ SIGN, IGNORE TAD CM1 SNA CLA JMP INN18A TAD TC /CHECK FOR "L" TAD M14 SZA CLA JMP INN200 /NO-GOOD CHAR AFTER E TAD C5 /PUT "E" BACK INTO TO DCA TC STA /FORCE "L" TO BE REREAD DCA RE JMP INN23 INN18A, DCA X6 /CLEAR EL FOR A - SIGN JMP INN20A INN20, CLA CMA DCA RE INN20A, JIBN /INPUT A BINARY TC JMP INN200 /BAD EXPONENT ISZ X6 CIA TAD DE DCA DE INN23, DCA INNT1 /CLEAR DEC PT SWITCH FOR NEXT TRY. JFLT JMP INN200 JINN4 INNT1, 0 /DECIMAL POINT DETECT SWITCH. CMX0, -XC0 CMXE, -XE JINN1=JMP I . INN1 JINN4=JMP I . INN4 M14, -14 AAINN=.-INN / /IOP-INPUT AN OPERATOR / /IOP IS USED BY EXPRESSION TO GET AN OP IN /THE CASE OF A TERMINATOR OR PAREN. IT WILL /GET A GOTO, THEN, STEP, AND TO TYPE OPERATOR. / / IOP WILL ALSO SET RF IF AN OPERATOR WAS IN THE RANGE / OF 20-26. / / / IOP, 0 JICH /GET POSSIBLE TERMINATOR TAD OP /TEST FOR NUMERIC SPA JMP IOP1 /ERROR IF NUMBER TAD CM100 /CHECK FOR LETTER SZA CLA JMP IOP2 /EXIT, NORMAL TC JITS /GO TEST FOR SPECIAL OP'S JMP IOP1 JMP I IOP /OK. THEN, STEP, GOTO, OR TO IOP1, ERROR /*****ILLEGAL CHARACTER$$$$$ 10 IOP2, TAD OP /TEST FOR RELATIONAL OPS. TAD CM27 /I.E. IN RANGE 20-26 CLL TAD C7 SZL CLA ISZ RF /GOT ONE JMP I IOP CM27, -27 AAIOP=.-IOP / /OTF-OUTPUT FUNCTION CALL / /OTF IS USED BY EXPRESSION TO OUTPUT A CALL TO /AN INTERNAL FUNCTION, AS SIN, COS, ETC. OR TO A /USER DEFINED FUNCTION VIA A "DEF" STATEMENT / /IF THE FUNCTION HAS NOT BEEN DEFINED, DF=0 /THEN A CHAIN ENTRY IS MADE. IF IT HAS, DF=1, /BEEN DEFINED A CALL TO OTA IS MADE USING /AF. IF IT IS AN INTERNAL FUNCTION IS CALLED, /DF=2 THEN OTC IS CALLED USING AF. / /OTF EXPECTS J TO POINT TO THE FUNCTION'S ENTRY. / / OTF, 0 CLA CLL DCA EL /CLEAR EL FOR LOOK-UP JLLA /LOAD OUR ASSIGNMENT CLA /WATCH OUT!! LLA RETURNS WITH A 1 IN AC IF SUCCESS TAD AF /SAVE ADDRESS FOR LATER DCA OTFT1 CLA CMA TAD DF /TEST DF OR 0,1,OR 2 SPA JMP OTF2 /DF WAS 0 SO CHAIN SNA CLA JMP OTF3 /DF WAS A 1 SO NO CHAIN JOWB /SET OUTPUT TO A WORD TAD AF /DF WAS A Z SO IN ERROR JOTC XIFUN /OUTPUT AN INTERNAL FUNCTION CALL JMP I OTF OTF2, CLA IAC TAD PC /CHAIN TO PC+1 FOR DCA AF TAD I X1 DCA ID JSLA /STORE NEW CHAIN LINK OTF3, JOBB /SET OUTPUT TO A BYTE FOR THE CALL TAD OTFT1 /PICK UP THE ADDRESS. JOTA XFUNC /OUTPUT A NORMAL FUNCTION CALL JMP I OTF / OTFT1, 0 /SAVE FOR CHAIN VALUE AAOTF=.-OTF PAGE JOTB=JMS I . OTB / /RANDOMIZE STATEMENT (BOTH RANDOM AND RANDOMIZE PERMITTED) / /RANDOMIZE IS USED TO START OFF THE RANDOM NUMBER FUNCTION /AT A "RANDOM" POINT (BASED OF TIME OF DAY). / RAN, JPAS -5 /NDOM TAD TC SNA CLA JMP .+3 JPAS -3 /IZE JOTI XRDZ JSTT AARAN=.-RAN / / OCH-OUTPUT CHAIN ROOT / / OCH IS USED TO TERMINATE A FIX-UP STRING. THE LOADER WILL CHAIN / BACK THROUGH THE OBJECT PROGRAM STORING THE PC IN THE WORDS / ALONG THE CHAIN. THE CHAIN BEGINS AT THE ADDRESS (FULL WORD) / PASSED IN THE AC AND TERMINATES WITH A LINK EQUAL TO / 0. OCH FORCES THE OUTPUT STRING TO BE COMPLETED BEFORE / THE CHAIN DIRECTIVE IS SENT OUT / / OCH, 0 DCA OCHT1 / SAVE ARG FOR CODE IN CHAIN JMS OFS /FORCE STRING STA CLL RAL /SEND OUT CHAIN CODE TO LOADER JMS OCH1 /COMMON DEAL TO OCH AND OLL. JMP I OCH / / COMMON DIRECTIVE OUTPUT, CODE IN AC ARG IN T1 / OCH1, 0 JOWD / OUTPUT LOAD CODE IN AC TAD OCHT1 / SET UP ARG FOR CODE IN AC JOWD /AND SEND IT OUT JMS OPI /RESET FOR NEW HEADER JMP I OCH1 / SUB-RETURN / OCHT1, 0 / SAVE CHAIN ROOT, OR LOADING LOC ACROSS OWD CALLS. AAOCH=.-OCH / / OFS-OUTPUT FORCE ON LOADING STRING. / / IF A LOADING STRING IS IN PROCESS OF BEING OUTPUT OFS / WILL TERMINATE IT. IT SEES OUTPUT TO A WORD BOUNDARY / AND RESETS THE HEADER POINTER TO THE CURRENT VALUE OF THE / OUTPUT WORD POINTER. / / OFS, 0 TAD OH / IF THE HEADER POINTER EQUALS THE CIA / WORD POINTER THEN THE LOADER OUTPUT TAD OW / STRING IS EMPTY SNA CLA JMP I OFS / EXIT, NOTHING TO FORCE JOWB /BE SURE OF WORD BOUNDARY JMS OPI /RESET HEADER TO NEW WORD JMP I OFS /EXIT AAOFS=.-OFS / / OLA-OUTPUT LOADING LOCATION ABSOLUTE / / OLA IS USED TO SET AN ABSOLUTE ADDRESS IN THE LOADER FOR / THE PURPOSE OF STORING AND ASSIGNING CHAIN ADDRESSES / TO CONSTANTS AND DATA. / / / OLA, 0 DCA OCHT1 /SAVE THE ADDRESS JMS OFS /FORECE ANY STRINGS TAD CM4 /SET OUTPUT CODE JMS OCH1 /DO THE COMMON PRUCESSING JMP I OLA AAOLA=.-OLA / / OLL-OUTPUT LOADING LOCATION SET DIRECTIVE / / OLL IS USED TO SET UP THE PC FOR LOADING A STRING. IT IS / USED IN SETTING UP THE PLACES FOR THE DATA AREA & / STRINGING CONSTANTS IN THE OBJECT PROGRAM. IT USES / A SUBROUTINE COMMON TO OCH TO DO THE REAL OUTPUT. / / OLL, 0 DCA OCHT1 / SAVE AC IN COMMON OCH/OLL JMS OFS /FORCE STRING OUT AND SET AC T/ -1 CLA CMA / SEND OUT LOAD LOCATION SET DIRECTIVE JMS OCH1 /DO COMMON OCH AND OLL OUTPUT JMP I OLL AAOLL=.-OLL / / OLW-OUPUT LOADER WORD. / / THIS ROUTINE OUTPUTS TWO BYTES TO THE LOADER STRING VIA / TWO CALLS TO OTB. THE WORD TO BE OUTPUT IS CONTAINED / IN THE AC. OLW ASSUMES THE WORD IS IN THE LOADER / STRING AND IS NOT A CONTROL WORD OR CONTROL ARGUMENT / / OLW, 0 DCA OLWT1 TAD OLWT1 RTR /SET UP HIGH SIX TO LO SIX RTR RTR JOTB /SEND OUT BOTS 0-5 TAD OLWT1 JOTB /SEND OT BITS L-11 JMP I OLW / OLWT1, 0 / SAVE LOAD WORD ACROSS OTB CALLS. AAOLW=.-OLW / / OPI-OUTPUT STRING INITALIZE. / / OPI RESETS OH TO OW TO SIGNAL THE BEGINNING OF A NEW LOADER / STRING. IT'S REASON FOR EXISTENCE IS TO SAVE CODE. / / OPI, 0 CLA TAD OW / RESET POINTERS DCA OH JMP I OPI /LEAVE WITH AC=0 AAOPI=.-OPI / / OTA-OUTPUT ABSOLUTE REFERENCE INSTRUCTION / / OTA OUTPUTS AN 18 BIT INSTRUCTION TO THE LOADER STRING. THE / FIRST SIX BITS, COMPRISING THE OP CODE ARE SENT VIA / OTI AND THE LAST 12, COMPRISING THE ADDRESS OF THE / OP-CODE ARE SENT VIA OLW. / / OTA OUTPUTS INSTRUCTIONS OF THE FORM OP-ADDRESS / WHICH ARE CLASSIFIED AS TYPE 3 IN THE INTERPRETER. / / OTA, 0 DCA OTAT1 /SAVE THE A ADDRESS TAD I OTA /BUMP ENTRY PIONT ISZ OTA JOTB /SET TO BYTE BOUNDARY. TAD OTAT1 /DO UP ADDRESS JMS OLW /ADDRESS FIELD OUT JMP I OTA / OTAT1, 0 AAOTA=.-OTA / / OTR-OUTPUT REFERENCE / / OTR WILL CHECK THE ASSIGNMENT TABLE ENTRY POINTED TO / BY AC AND SET UP A CALL TO THE OTRA ROUTINE WITH / THE PROPER ARGUMENT IN AC. / / IF AC POINTS TO A CONSTANT A CHAIN LINK IS SAVED IN / THE AF VALUE OF THE ENTRY. AC WILL CONTAIN THE LINK / TO THE NEXT FIX-UP / / IF AC POINTS TO A SIMPLE VARIABLE DUMMY THEN AC / WILL CONTAIN IT'S DUMMY #. A CALL TO OTC IS MADE / WITH A "DUMM" OPERATOR. / / ALL OTHER TYPES ARE HANDLED BY SETTING AC TO THE / VALUE OF THE ENTRY'S AF / / OTR, 0 DCA J DCA EL /CLEAR POINTERS AND SUCH TAD I OTR ISZ OTR DCA OTR3A JLLA /LOAD ITEM'S ASSIGNMENT CLA TAD IU /TEST FOR TYPE OF ITEM SNA JMP OTR1 /IU IS 0 FOR CONSTANT, CHAIN IT TAD CM1 SZA CLA JMP OTR2 /IU IS NOT 1 TAD DF SZA JMP OTR4 /DF IS NOW ZERO, DUMMY REF JMP OTR2 /NORMAL VARIABLE OTR1, JOBB /SET WORD BOUNDARY TAD AF /SAVE LAST CHAIN ADDR DCA OTRT1 CLA IAC TAD PC /STORE BUMPED PC FOR NEXT LINK DCA AF TAD I X1 /SET UP ID FOR THE STORE DCA ID JSLA /STORE NEW AF TAD OTRT1 JMP OTR3 OTR2, TAD AF /DO STRAIGHT OUTPUT OTR3, JOTA OTR3A, XEND JMP I OTR OTR4, CIA /SET UP NO OF ARGS. TAD AG /SET UP DUMM VALUE. JOTC XDUMM /OUTPUT A DUMMY PICK-UP JMP I OTR / OTRT1, 0 AAOTR=.-OTR / /GOS - GOSUB PROCESSOR. / /THE GOSUB PROCESSOR OUTPUTS A CALL TO THE /LINE # PICKED UP BY ILN. / / GOS, JPAS /GOSUB -2 /UB JILN /GET LINE # JOBB /SET FOR RETURN TAD LA /GET THE NUMBER OR LINK JOTA XSUBR JSTT AAGOS=.-GOS / /SHR - TRIPLE PRECISION SHIFT RIGHT / SHR, 0 /RIGHT SHIFT ID SETTING LINK TO ZERO TAD ID CLL RAR DCA ID TAD ID1 RAR DCA ID1 TAD ID2 RAR DCA ID2 JMP I SHR AASHR=.-SHR PAGE JOPI=JMS I . OPI / / OBB-OUTPUT TO BYTE BOUNDARY. / / OBB CAUSES THE OUTPUT STRING TO FALL ON A BYTE BOUNDARY. / SF IS CHECKED AND FORCED TO BE 0 VIA A "NOOP" OPERATION. / OBB IS USED FOR FORCING OUTPUT CHAINS TO WORD LOCATIONS / AS REQUIRED BY THE LOADER. / / OBB, 0 CLA IAC / TEST TO SEE WHICH SIDE OUTPUT IS CURRENTLY TAD SF / SET TOO. SNA CLA /AC WILL BE 0 IF SF WAS -1 JMS OTB /TO A BYTE BOUNDARY. JMP I OBB / TO A BYTE BOUNDARY. AAOBB=.-OBB / / OTB-OUTPUT BYTE TO LOADER STRING. / / THIS ROUTINE IS USED TO OUTPUT 6 BITS TO A LOADER STRING. / IT USES A SWITCH, SF (SIDE-FLAG) TO DETERMINE WHICH SIDE / THE SIX BITS ARE TO BE STORED INTO. IF SF=-1 THEN / THE LEFT SIDE OF THE OUTPUT WORD GETS THE LO SIX / BITS OF THE AC. IF SF=0 THE LO 6 BITS OF THE / AC ARE OR'ED INTO THE LO SIX BITS OF THE OUTPUT / WORD / / IF A FULL WORD WAS SET-UP BY OTB THEN THE HEADER / WORD AND PC ARE BUMPED BY 1. / / OWD IS USED TO OUTPUT THE WORD AND A HEADER WORD IF A / NEW STRING IS STARTED / / OTB, 0 DCA OTBT1 /SAVE OUTPUT BYTE TAD OH / CHECK FOR FIRST BYTE OF NEW STRING CIA TAD OW / IF NEW STRING HEADER POINTER EQUALS RECORD SZA CLA / WORD POINTER. JMP OTB3 / JUST STORE THAT BYTE TAD OTBC1 / CHECK FOR ROOM FOR HEADER +1 WORD TAD OW SPA CLA JMP OTB2 STL RAR / OUTPUT AN IGNORE CODE TO LOADER-4000 JMS OWD /TO COAUSE ROOM FO R STRING OTB2, JOPI /RESET HEADER PIONTER TO BEGIN OF STRING JMS OWD /OUTPUT WORD OF ZERO'S FOR HEARDER OTB3, TAD C77 AND OTBT1 ISZ SF / IF SIDE FLAG BUMPED IS EQUAL TO ZERO JMP OTB4 / THEN GO DO LEFT SIDE / PROCESS RIGHT SIDE OF OUTPUT WORD. RTL CLL / SHIFT BYTE TO HIGH 6 BITS RTL CLL RTL CLL DCA I OW / SAVE HIGH 6 BITS JMP I OTB / EXIT / PROCESS LEFT SIDE OF OUTPUT WORD, SIDE FLAG IS 0 FOR NEXT RIGHT OTB4, ISZ I OH / COUNT WORD OF OUTPUT TAD I OW JMS OWD /OUTPUT A FILL FULL WIORD CLA CMA DCA SF /SET TO RH SIDE ISZ PC /BUMP PROGRAM COUNTER. JMP I OTB / EXIT ERROR /***** PROGRAM TOO LARGE TO LOAD $$$$$$$$$$$ /EXTEND BLOCK!!...ALSO CONSTANT 1 FOR ERROR CALL!! EXPRM, 1 1 / OTBC1, -OBUF-BUFSIZ+1 / OUTPUT BUFFER WITH 2 WORDS LEFT OTBT1, 0 / SAVE OUTPUT BYTE ACROSS OWD & OPI CALLS AAOTB=.-OTB / / OTC-OUTPUT CONTROL INSTRUCTION / / OTC IS USED TO OUTPUT INSTRUCTIONS OF INTERPRETER TYPE 2. THIS / TYPE OF INSTRUCTION IS COMPRISED OF A 6 BIT. OP-CODE AND / A SIX BIT OPERAND. THE OP-CODE IS SENT VIA OTI AND / THE OPERAND IS SENT VIA OTB. / / / OTC, 0 DCA OTCT1 /SAVE LO SIX TAD I OTC /PICK UP OP ISZ OTC /BUMP ENTRY JMS OTB TAD OTCT1 /A FIELD JMS OTB /AND THE LO XIX OFMA C AS THE JMP I OTC / CONTROL CODE. / OTCT1, 0 AAOTC=.-OTC / / OTI-OUTPUT INSTRUCTION CODE / / OTI WILL OUTPUT A 6-BIT TYPE 1 INSTRUCTION TO THE INTERPRETER. / THE SIX BITS ARE SENT VIA A CALL TO OTB. / / / OTI, 0 CLA CLL TAD I OTI ISZ OTI JMS OTB JMP I OTI AAOTI=.-OTI / / OWB-OUTPUT TO WORD BOUNDARY / / OWB CAUSES THE OUTPUT TO BE SET TO EVEN WORD BOUNDARY, IE / SF=-1, IF SF IS 0 A "NOOP" IS OUTPUT TO LOADER / AND POINT IS MADE. OWB IS USED TO FORCE TO / WORDS FOR ADDRESS ASSIGNMENT IN THE OBJECT PROGRAM. / / OWB, 0 TAD SF /IF SF=TO-1 THEN OKAY SNA CLA /SKIP IF SF=-1 JMS OTB /OUTPUT A NOOP TO SPACE OUTPUT JMP I OWB / TO WORD BOUNDARY AAOWB=.-OWB / / INI-INPUT AN ITEM / / INI CAUSES AN ELEMENT TO BE INPUT AND IF / IT WAS NOT AN OP ALONE AN ENTRY TO BE / MADE IN THE SYMBOL TABLE / / INI, 0 JINN /GET NEXT ELEMENT TAD EL /LENGTH OF ZERO IS LINE OP SZA CLA JASI /ASSIGN SYMBOL JMP I INI AAINI=.-INI / / OWD-OUTPUT WORD / / OWD IS THE INTERFACE BETWEEN THE BASIC COMPILER AND TSS/8 / IT STORES A WORD IN THE OUTPUT BUFFER AND TESTS TO / SEE IF ANY ROOM IS LEFT. IF NOT THE RECORD IS / WRITTEN AND POINTERS RESET. / / NOTE THAT SF NEEDS NOT BE RESET SINCE THE WRITE ALWAYS / TAKES PLACE AT AN EVEN WORD. / / THE WORD TO BE OUTPUT IS IN THE AC / / OWD, 0 DCA I OW / STORE THE WORD VIA OA ISZ OW / AND COUNT IT TAD OWDC1 TAD OW SZA CLA /CHECK FOR ROOM IN JMP I OWD /PLEMTY OF ROOM TAD CMSIZ DCA OTPRAM+2 TAD OWDC3 DCA OTPRAM+3 OWD1, TAD OWDC2 / SET IO7 FOR TSS/8 WFILE /********* TSS/8 CALL *************** TAD OTPRAM+5 /CHECK FOR NEED OF SEGMENTS. TAD CM2 /CHECK TO SEE IF WE NEED A BIGGER FILE SNA CLA /NO MAYBE AN ERROR THOUGH JMP OWD2 /GO EXTEND TAD OTPRAM+5 /RESTORE FOR CHECK IOECHK / I/O ERROR- NO RECOVERY - SO SOLLY CLA CLL TAD CSIZ / COMPUTE ADDRESS FOR NEXT RECORD OF OUTPUT TAD OTPRAM+4 SZL ISZ OTPRAM / OVER-FLOW?-BUMP HIGH ORDER COUNTER DCA OTPRAM+4 TAD OWDC4 DCA OW / RESET OW JOPI JMP I OWD OWD2, TAD OTPREX /EXTEND THE FILE EXT /****************** TSS/8 CALL ********** SPA SNA JMP .+3 CLA TAD K7400 /DISK FULL IOECHK /CHECK FOR DISK FULL ISZ SRSIZE /UPDATE THE SEGMENT COUNT. JMP OWD1 /AND CONTINUE THE WRITE / OWDC1, -OBUF-BUFSIZ / OUTPUT BUFFER WITH NO ROOM LEFT OWDC2, OTPRAM / ADDRESS OF PARAMETERS OWDC3, OBUF-1 OWDC4, OBUF /ADDRESS OF OUTPUT BUFFER. K7400, 7400 / / PARAMETERS TO WRITE DISK FILE IOT / OTPRAM, 0 / FILE ADDRESS HI 12 BITS 1 / INTERNAL FILE # OF OBJECT OUTPUT FILE -BUFSIZ / NUMBER OF WORDS TO OUTPUT OBUF-1 / ADDRESS OF BUFFER 0 / FILE ADDRESS LO 12 BITS 0 /ERROR CODE WORD. / / PARAMETERS TO EXTEND DISK FILE IOT / OTPREX, EXPRM /PARAMETERS FOR EXTEND AAOWD=.-OWD / /REA-READ PROCESSOR / /REA SCANS THE INPUT STATEMENT ALLOWING ONLY /VARIABLES AND ARRAY REFERENCES TO GET BY. /THE OUTPUT IS A "DATA" OR "DATI" INSTRUCTION /TO THE INTERPRETER WITH A POINTER TO THE /PLACE IN THE VARIABLE/ARRAY AREA ON THE LIST. / REA, JGCH /READ REA1, JOXR XDATD XDATI JTCM JMP REA1 JSTT /TEST STORE ON LIST JOXR= JMS I . OXR AAREA=.-REA / /LPRI - LPRINT PROCESSOR / LPRI, JOTI /OUTPUT BEGIN LPRINT OP CODE XLPRT ISZ LPFLG /INDICATE WE ARE DOING LPRINT JGCH /SCAN OVER "R" /FALL INTO PRINT PROCESSOR / /PRI - PRINT PROCESSOR / /PRI USES EXPRESSION TO DELIVER A NON-RELATIONAL OR /REPLACEMENT TYPE EXPRESSION. THE RESULT, ASSUMED TO /BE ON THE TOP OF THE RUN-TIME STACK, IS PRINTED /VIA A "PRINT" OP IN THE INTERP. / /TEXT IS STORED AS A STRING HEADED BY A "ALPHA" /OPERATOR AND TERMINATED BY A QUOTE, """ / /THE PRINT STATEMENT IS TERMINATED BY A ";", "(" OR "BLANK" /& THAT SEQUENCE IS CHECKED AT THIS POINT / / PRI, JPAS /PRINT ,; -3 /INT CLA CMA /SET FIRST TIME SWITCH DCA T1 PRI1, JICH TAD TC /TC TEST FOR TEXT STRING SNA JMP PRI7 TAD CMXQU SNA CLA JMP PRI5 /QUOTE IS FIRST CHAR CLA CMA DCA RE /RE-READ THE NON-QUOTE DCA DOLLAR /PERMIT STRINGS CLA IAC JEXP JOTI /PRINT THE TOP STACK ELEMENT XPRNT PRI1A, TAD TC SNA /TEST FOR EOL JMP PRI2L /IT WAS AN EOL TAD CMXSC SNA /TEST FOR ; JMP PRI2F /IT WAS A SEMICOLON JTCM /TEST FOR COMMA JMP PRI2Z /IT WAS A COMMA CLA CMA /TREAT EVERYTHING ELSE AS A ;-- DCA RE /BUT RE-READ PRI2F, TAD CXFORF /FORF ; DCA .+2 JOTI XEND DCA T1 /ASSURE FIRST TIME OFF TAD TC SZA CLA /TEST TC TO SEE IF MORE PRINTING JMP PRI1 /YES!!!!!! PRI7, ISZ T1 /CHECK TO SEE IF THE JMP PRI10 PRI2L, IAC /FORL EOL PRI2Z, IAC /FORZ COMMA JMP PRI2F PRI5, JOTI /BUILD STRING IN EXECUTION XALPHA PRI5A, JICO /GET NEXT CHAR TAD TC DCA .+2 JOTI /OUTPUT THE CHAR-6-BIT XQU TAD TC TAD CMXQU /TEST FOR TERM SZA JMP PRI5A /MORE JICH /GET NEXT PAST QUOTE JMP PRI1A /RETURN TO TEST TERMINATOR PRI10, TAD LPFLG /IS THIS AN LPRINT SNA CLA JSTT /NO, SO NO MORE TO DO DCA LPFLG /YES, CLEAR FLAG FOR NEXT TIME JOTI /OUTPUT END LPRINT OP CODE XLPRX JSTT LPFLG, 0 CMXQU=CM42 CMXSC, -XSC CXFORF, XFORF AAPRI=.-PRI / /POP-POP ITEM FROM COMPILING STACK / /THE STACK POINTER IS DECREMENTED AND THE TOP / ITEM IS PRESENTED IN THE AC / POP, 0 CLA CLL TAD I ST DCA PAS /SAVE ITEM CLA CMA TAD ST /DECREMENT STACK POINTER DCA ST TAD PAS JMP I POP AAPOP=.-POP / / PAS-PASS OF ALPHA CHARACTERS / / PASSING OF CHARS IS DONE ON VERBS & OPERATORS / THAT HAVE BEEN IDENTIFIED. THE # OF CHARS / IN THE AC IS PASSED. / / PAS, 0 TAD I PAS ISZ PAS DCA X4 /SAVE # OF CHARS PAS1, JGCH /GET CHAR ISZ X4 JMP PAS1 /MORE JMP I PAS /NO MORE 1 AAPAS=.-PAS MPY, 0 /MULTIPLY ID BY 10 JSHL TAD ID DCA MPYT1 TAD ID1 DCA MPYT2 TAD ID2 DCA MPYT3 JSHL JSHL TAD ID2 TAD MPYT3 DCA ID2 GLK TAD ID1 TAD MPYT2 DCA ID1 GLK TAD ID TAD MPYT1 DCA ID JMP I MPY MPYT1, 0 MPYT2, 0 AAMPY=.-MPY / / DIV, 0 /DIVIDE ID BY 10 /AC AND LINK MUST BE CLEAR AT THIS POINT!!! TAD DIVC1 DCA MPYT1 DIV1, TAD ID TAD DIVC2 SMA DCA ID CLA JSHL ISZ MPYT1 JMP DIV1 TAD ID AND DIVC3 DCA ID JMP I DIV DIVC3, 377 JSHL=JMS I . SHL AADIV=.-DIV MPYT3=DIV /SAVE A LOCATION / /STO - STOP PROCESSOR / /STO ISSUES AN "END" OP TO THE INTERP AND THIS /WILL END THE EXECUTION OF THE OBJECT PGM. /COMPILATION CONTINUES / STO, JPAS /STOP -3 /OP JOTI /OUTPUT END OP XEND /FALL INTO STATEMENT TERMINATE ROUTINE AASTO=.-STO / / STT-STATEMENT TERMINATOR / / STT IS CALLED TO MAKE SURE THE LINE THAT HAS / BEEN COMPILED WAS PROPERLY TERMINATED. IF / THE LAST CHAR WAS NOT ON EOL (0) THEN ERROR / STT, CLA TAD TC SNA CLA /CHECK FOR AN EOL JMP SID /OK-DO STATEMNET ERROR /*** ILLEGAL LINE FORMAT $$$$ 5 AASTT=.-STT / / LLA-LOAD LOW ASSIGNMENT OF ITEM / / LLA IS USED TO SET UP THE IU,EL,AF,& DF / FIELDS OF THE ENTRY POINTED TO BY (J + EL) / IF EL=0 THEN IT LOADS STRAIGHT. IT CAN / BE USED TO STEP THRU THE TABLE. / / X1 WILL POINT TO THE FIRST ID FIELD IF / ANYONE IS INTERESTED / / LLA, 0 CLA TAD J /TEST J AGAINST END OF TAD EL /UPDATE J POINTER DCA J /FOR BREAKOUT TAD J CIA TAD JS SNA CLA /TEST FOR NO MORE IN TABLE. JMP I LLA /NO MORE SO GO. TAD I J AND C7 /SAVE LOW 3 BITS FOR EL DCA EL /BITS 9-11 ARE EL TAD I J RAR RTR AND C7 /SAVE LOW 3 BITS FOR IU DCA IU /BITS 6-8 ARE IU TAD I J RTR RTR RTR AND C77 /SAVE LOW 6 BITS FOR DF DCA DF /BITS 0-6 ARE DF TAD J DCA X1 /USE BUMP IN AUTO TAD I X1 /PICK UP NEXT LOCATION FOR AF DCA AF IAC /SET AC TO 1 FOR SUCCESS JMP I LLA AALLA=.-LLA JSCN=JMS SCN / / SID-STATEMENT START AND INDENTIFY / / SID IS CALLED TO BEGIN THE PROCESSING OF THE SOURCE / STATEMENT. IT SETS THE OUTPUT TO A NICE WORD BOUNDARY / AND ASSIGNS THE PC TO THE LINE FOR IT'S LINK ADDRESS / IF THE LINE WAS REFERENCED PREVIOUSLY THEN / A CHAIN IS MADE FOR THIS LINE. / / NEXT SID IDENTIFIES THE STATEMENT VIA ITS VERB / USING TABLA. ONCE THE VERB HAS BEEN IDENTIFIED / THEN THE ROUTINE TO PROCESS THE VERB IS CALLED. / / SID, TAD BSLFG /IS THERE MORE THAN ONE STATEMENT ON THIS LINE SNA JMP SIDX /NO DCA IS /YES, RESTORE BUFFER WORD SIDE INDICATOR DCA BSLFG /CLEAR BACKSLASH FLAG JGCH /GET NEXT CHAR JMP SIDS /SKIP LINE NO. PROCESSING SIDX, CLA CLL CMA RTL DCA IS /SET SWITCH FOR LINE # FETCH STA /SET NEW LINE FLAG DCA LINFG DCA SNFL /CLEAR SIGN FLAG FOR EXP JGCH /GET LINE #,IU=2 JOWB /SET OUTPUT TO WORD TAD LINE JASL /ASSIGN LINE TO LINE TABLE TAD LA /CHECK FOR FWD LINE REFERENCES SZA JOCH /LINE-PREV REF, CHAIN TO PC CLA CLL CMA RAR /ASSURE UNDEFINED BIT IS OFF. AND I L DCA I L /RESTORE W/O HI BIT TAD L /COMPUTE ADDR OF LINE ADDRESS CELL DCA X1 TAD PC DCA I X1 /DEFINE ADDRESS OF THIS LINE SIDS, TAD TC SNA CLA JMP SID /IGNORE BLANK LINES ISZ LINFG /IS THIS FIRST STATEMENT ON LINE JMP SIDA /NO TAD LINE /YES, OUTPUT LINE NO. OP CODE JOTA XLINE SIDB, DCA DOLLAR /CLEAR FLAG FOR LINE TAD TC /SAVE CHAR 1 DCA T1 JGCH /GET CHAR 2 TAD T1 /PACK CHARS 1 AND 2 CLL RTL RTL RTL TAD TC DCA TC JSCN /SCAN STATEMENT TABLE; RETURNS IFF NO MATCH IS FOUND TBLA-2 /PARM: PTR TO TABLE-2 ISZ IS /MUST BACK UP TWO CHARS; WHICH SIDE OF WORD WAS CHAR 2 JMP SID2 /LEFT STA CLL RAL /RIGHT; SET INPUT SWITCH TO CAUSE REREAD OF RIGHT SIDE DCA IS SID1, STA /FORCE ICH ROUTINE TO DO REREAD DCA RE TAD T1 /SET UP CHAR 1 AS REREAD CHAR FOR ICH DCA I PICHT1 JMP I LETFUJ /GO DO IMPLIED LET STATEMENT SID2, STA /NOTE: IS IS NOW -1 TO INDICATE GET NEW WORD FROM TAD X7 / INPUT BUFFER; BACK UP INPUT PTR TO GET PROPER REREAD DCA X7 JMP SID1 SIDA, JOTI /OUTPUT SAME LINE OP CODE XSAME JMP SIDB /GO WORK ON STATEMENT PICHT1, ICHT1 LETFUJ, LET1 LINFG, 0 AASID=.-SID / / SCN-SCAN STATEMENT ID TABLE / / POINTER TO THE TABLE-2 TO BE SCANNED FOLLOWS CALLING JMS. / TRIES TO MATCH CURRENT INPUT CHARACTER(S) IN TC WITH ENTRY IN TABLE. / IF MATCH IS FOUND CONTROL GOES TO ROUTINE POINTED TO BY SECOND WORD / OF TABLE ENTRY. IF NO MATCH THEN NORMAL RETURN IS MADE. SEE / STATEMENT ID TABLES FOR FULL DESCRIPTION OF TABLE FORMAT. / / SCN, 0 TAD I SCN /PICK UP PTR TO TABLE DCA X1 ISZ SCN /BUMP RETURN ADDRESS PAST PARM SCN1, ISZ X1 TAD I X1 /PICK UP TABLE ENTRY SNA /ZERO MARKS END OF TABLE JMP I SCN TAD TC /ADD IN CURRENT CHAR(S) SZA CLA JMP SCN1 TAD I X1 DCA SCN JMP I SCN AASCN=.-SCN / /RET - RETURN PROCESSOR / /RET ISSUES A RETURN COMMAND TO THE INTERP. /THE RETURN POINT IS SET VIA A "GOSUB" / RET, JPAS /RETURN -4 /URN JOTI /RETURN OUT XSBRT JSTT AARET=.-RET / /TCM-TEST FOR COMMA / /TESTS TC FOR A COMMA AND SKIPS CALL+1 /NOT EQUAL TO A COMMA, SKIP ON NOT COMMA / TCM, 0 /SKIP IF NOT COMMA CLA CLL CMA RTL /IN TC TAD TC TAD CMXRP SZA CLA ISZ TCM JMP I TCM AATCM=.-TCM PAGE / /GOT - GOTO PROCESSOR / /THE GO TO PROCESSOR OUTPUTS A JUMP TO THE LINE /LINE # PICKED UP BY ILN / GOT, JGCH /GOTO JILN /GET LINE ADDRESS TAD LA /OUTPUT ADDRESS OR LINQUE JOTA XGOTO JSTT AAGOT=.-GOT / / RFL-READ INPUT FILE / / RFL INTERFACES BASIC TO TSS/8. IT READS A WORD FROM / FILE-0 THE SOURCE FILE LEAVING THE WORD IN THE / AC. X7 IS KEPT AS A POINTER TO THE NEXT INPUT / LOCATION TO BE READ. WHEN 40 WORDS HAVE BEEN / READ THEN A NEW RECORD IS READ FROM THE DISK / VIA A RFILE CALL TO TSS/8 / / NOTE THAT THE ROUTINE IS SELF INZ ON THE FIRST CALL / / RFL, 0 CLA CLL TAD X7 TAD RFLC1 /CHECK TO SEE IF THIS RECORD USED UP SNL CLA JMP RFL1 /NO NEED TO READ FROM DISK TAD CMSIZ DCA INPRAM+2 TAD RFLC3 DCA INPRAM+3 TAD RFLC2 RFILE /*** TSS/8 CALL *** TAD INPRAM+5 /CEHECK ERROR RETURN AND CM3 /IGNORE END OF FILE IOECHK TAD RFLC3 /RESET INPUT POINTER DCA X7 /BUMP LOW FILE POINTER CLA CLL TAD CSIZ TAD INPRAM+4 DCA INPRAM+4 SZL /CHECK FOR OFLO INTO HIGH 12 ISZ INPRAM RFL1, TAD I X7 /GET NEXT WORD JMP I RFL /EXIT / / RFLC1, -IBUF-BUFSIZ+1 /TEST FOR END OF INPUT RFLC2, INPRAM /BEGIN OF PARAM LIST RFLC3, IBUF-1 /ADDRESS OF BUFFER / / INPRAM, 0 /HIGH COUNTER 0 /READ FROM FILE-0 -BUFSIZ /140 WORDS IBUF-1 /ADDRESS OF BUFFER 0 /LOW ORDER COUNTER 0 /ERROR CODE WORD. AARFL=.-RFL JNRM=JMS I . NRM JDIV=JMS I . DIV JSHR=JMS I . SHR / / FLT-FLOAT A NUMBER INTO INTERNAL FP FORM / / FLT TAKES THE # IN THE ID AREA AND ACCORDING TO THE DE / SCALES IT. FLT DIVIDES BY 10 FOR A - #, AND MULT'S BY 10 FOR / A + #. IT NORMALIZES THE NUMBER AND FORMATS IT ACCORDING / TO BE AND SN. IF THE NUMBER ID WAS ZERO ALONE IT IS LEFT / / FLT, 0 TAD FLTC3 /SET BASIC ASSUMED EXPONENT DCA BE TAD ID SNA /CHECK FOR NON ZERO TAD ID1 SNA /IGNORE ADDS AFTER FIRST NON- ZERO. TAD ID2 /TEST FOR ALL ZEROS SNA CLA JMP FLT4 FLT1, JNRM /NORMALIZE YHE NUMBER TAD DE SNA JMP FLT3 /DECIMAL EXP IS ZERO SMA CLA JMP FLT2 /IS PLUS, MAKE NO LARGER JDIV ISZ DE /DECREASE SIZE FLTC2, 7400 /MASK FOR MAX EXP JMP FLT1 /MORE FLT2, JSHR JSHR JSHR /MAKE ROOM FOR A MPY BY TEN JSHR TAD BE TAD C4 DCA BE /ACCOUNT FOR THE SHIFTS JMPY CLA CMA TAD DE DCA DE /SET UP NEW DE JMP FLT1 FLT3, TAD BE AND FLTC2 /ALL DONE, CEHECK SZA CLA JMP I FLT /ERROR TOO BIG TAD FLTC1 /MOVE ID RIGHT NINE BITS. DCA T2 /NUMBER IS BUILT AND NORMALIZED JSHR /WITH TOO MANY BITS. ISZ T2 JMP .-2 TAD SN TAD CM42 SNA CLA TAD DIVC2 /PUT IN SIGN TAD BE RAL CLL RTL CLL TAD ID DCA ID /AND PUT IT BACK. FLT4, ISZ FLT JMP I FLT /NORMALL EXIT / FLTC1, -10 /# SHR'S TO RESET. FLTC3, 243 /INTEGER ASSUME EXPENENT. AAFLT=.-FLT / /RES - RESTORE PROCESSOR / /RES ISSUES A "REST" OP TO THE INTERPRETER /AND THIS OP DOES NOT CAUSE THE INTERP TO STOP /FOR A BREATHER, BUT CAUSES IT TO TAKE THE /CONSTANT REFERENCING THE BEGINNING OF DATA /AND PLACE IT IN THE VARIABLE REFERENCING THE /END OF DATA / / / RES, JPAS /RESTORE -5 /TORE TAD TC /WHAT KIND OF RESTORE? SZA JMP RES1 JOTI XREST /RESTORE RES2, TAD CX6 /TEST FOR RESTORE$ SNA CLA JGCH /RESTORE$--GET ANOTHER CHAR JOTI XRSTR /RESTORE$ JSTT /EXIT...CAN GENERATE AN ERROR RES1, TAD CMX52 /TEST FOR RESTORE* SZA JMP RES2 JOTI XREST JGCH /TRY TO GET EOL JSTT CMX52, -52 CX6, 6 AARES=.-RES EXP90, TAD OP /COMES HERE WHEN EXPRESSION TAD CM100 /IS TERMINATED BY A RIGHT PAREN SZA CLA /DID WE GET A LETTER? JEXP3 JITS /YES, IS IT PROPER? ERROR 15 /ILLEGAL FORMULA JEXP3 /YES RETURN JEXP3=JMP I . EXP3 ITSTAB=. -XG^100-XO; ITSTH /GOTO -XT^100-XH; ITSTH /THEN -XE^100-XL; ITSEL /ELSE -XT^100-XO; ITSTO /TO -XS^100-XT; ITSST /STEP 0 / /CHANGE VERB, THIS HAS TWO DISTINCT FORMS... / (1) CHANGE A$ TO A / (2) CHANGE A TO A$ / CHANG, JPAS -2 /SCAN OVER "GE" JINA TAD OP TAD M15 /OP MUST BE "TO" SZA CLA CHER, ERROR 5 CLA CMA /CALL EXP WITH AC=-1 (HACK!) ISZ DOLLAR JMP CHA2 /CHANGE A TO A$ FORM /CHANGE A$ TO A JEXP /LET EXP OUTPUT LSTD ISZ DOLLAR /PROHIBIT STRING JISV /GET ARRAY NAME JMS CHX /OUTPUT POINTER LOAD JOTI XCHS JSTT /CHANGE A TO A$ --NOTE THAT AC=-1 AT THIS POINT! CHA2, TAD IU SZA CLA /"A" MUST BE A SIMPLE VARIABLE JMP CHER /BAD NAME JMS CHX /OUTPUT POINTER LOAD JMS I COXR XCHDD XCHDI ISZ DOLLAR /VERIFY THAT A STRING VARIABLE WAS USED JMP CHER JSTT /SUBROUTINE OUTPUTS A LDA (POINTER TO ARRAY CHX, 0 CLA CLL CML RTL DCA IU /CHANGE TO ARRAY VARIABLE JASI TAD J JOTR XLSTR JMP I CHX M15, -15 COXR, OXR /SEARCH FOR DOLLAR SIGN /THIS SUBROUTINE IS CALLED FOR INN /AND TESTS TO SEE IF A DOLLAR STRING /WAS INPUT. DOLL, 0 TAD TC TAD CM44 SZA CLA JMP I DOLL /NOT A DOLLAR TAD ID TAD C12 DCA ID /CHANGE VARIABLE NAME DOLL1A, JOTI XSSF DOLL1, TAD DOLLAR SMA SZA CLA /CHECK FOR LEGAL STRING ERROR 15 CLA CMA DCA DOLLAR /SET STRING FLAG JICH /GET NEXT PAST DOLLAR JMP I DOLL CM44, -44 /INPUT A LITERAL STRING /THIS ROUTINE BUILDS A LITERAL CONSTANT STRING /!!BUT NOT FOR PRINT!! MINI-STRINGS ONLY INNL, CLA CMA TAD I PEXPT1 /CHECK FOR HACK SNA CLA JMP I PINN2X /HACK TO AVOID SCREWING PRINT TAD CM6 DCA EL /USE AS COUNTER INNL1, TAD TC SMA CLA /DO WE NEED MORE INPUT JICO /GET NEXT CHARACTER JMS INNTR /TEST FOR TERM TAD CM6 DCA IU /USE AS COUNT CLL JMS I CSHL ISZ IU JMP .-3 TAD TC /INSERT NEW CHAR TAD CM37 /SPECIAL FORMAT CONVERSION AND C77 TAD ID2 DCA ID2 ISZ EL /6 CHARACTERS YET? JMP INNL1 /NO INNL2, TAD TC /TERMINATOR YET? SPA CLA JMP INNL3 JICO JMS INNTR JMP INNL2 INNL3, TAD C5 DCA EL /ITS A CONSTANT TAD INNLX DCA DOLL /KLUDGE EXIT THRU DOLL CLA CLL CMA RTL TAD I PEXPT1 /ARE WE COMPILING AN IF STATEMENT? SNA CLA JMP DOLL1A /YES JMP DOLL1 INNLX, INN4 /GOTO RETURN CONSTANT INNTR, 0 TAD TC TAD CM42 SZA CLA JMP I INNTR /IT IS NOT A QUOTE TAD CM41 /QUOTE SEEN DCA TC JMP I INNTR CM6, -6 CM37, -37 PEXPT1, EXPT1 PINN2X, INN2X CSHL, SHL / / ONGT - ON ... GOTO PROCESSOR / ONGT, CLA IAC /GENERATE CODE TO PUSH INDEX ON STACK JEXP TAD OP /TERMINATOR MUST BE GOTO/THEN (=12) TAD CM12 SZA CLA JMP CHER /ERROR JOBB /ALIGN OUTPUT TO BYTE BOUNDARY IN CASE OF FOWARD REF JOTI /OUTPUT ON...GOTO OP CODE XONGT ONGT1, STA /INDICATE BOUNDARY ALIGNMENT ALREADY DONE JILN /GET A LINE NUMBER REFERENCE TAD LA /OUTPUT THE LINE ADDRESS JOLW JTCM /TEST FOR COMMA JMP ONGT1 /YES, MUST BE MORE JOLW /NO, OUTPUT A ZERO TO MARK END OF LINE ADDRS JSTT / / MUL-MULTIPLY, PRODUCT LESS THAN 12 BITS. / / MUL TAKES THE AC, USES IT AS A MULTIPLIER AND TAKES / THE LOCATION FOLLOWING THE CALL AS A POINTER TO A / MULTIPLICAND AND PLACES THE PRODUCT IN THE AC AND / THE WORD POINTED TO BY THE POINTER IN CALL+1. / IF OFLO RESULTS AN EXIT TO CALL+2 IS MADE ELSE / AN EXIT TO CALL +3 IS MADE / / MUL, 0 DCA MULT1 /SAVE MULTIPLIER TAD I MUL /SET-UP MULTIPLICAND DCA MULT3 TAD I MULT3 /SET UP ADDRESS OF PRODUCT. DCA MULT2 /PARTIAL PRODUCT CLEAR DCA I MULT3 /AFTER SET UP MUL1, CLA CLL TAD MULT1 /PICK UP MULTIPLIER SNA JMP MUL3 /ALL DONE, NO MORE MULITIPLIER RAR DCA MULT1 /SAVE SHIFTED MULTIPLOEIER SNL JMP MUL2 /NO LO/-BIT -- NO ACCUM CLA CLL TAD I MULT3 TAD MULT2 /GET PARTAIAL PRODUCT DCA I MULT3 /AND SAVE SZL JMP MUL4 /SORRY OFLO MUL2, CLA CLL TAD MULT2 /MUPTIPLY MULTIPLICAND BY A 2 RAL SZL JMP MUL4 /GETTING, GOT TOO BIG DCA MULT2 JMP MUL1 MUL3, TAD I MULT3 /NORMAL EXIT, A CALL+3 ISZ MUL /AC HAS THE PRODUCT MUL4, ISZ MUL /ERROER EXIT, AT CALL+2 JMP I MUL / / MULT1, 0 /SAVE MULTIPLIER MULT2, 0 /SAVE PSEUDO MULTIPLIER MULT3, 0 /ADDRESS OF PRODUCT BUILD. AAMUL=.-MUL JOLW=JMS I . OLW / / OTN-OUTPUT NUMBER TO OBJECT PROGRAM / / OTN TAKES THE THREE WORDS LABELED ID,ID1,ID2 AND OUTPUTS THEM / USING OLW. THIS ROUTINE IS USED IN SENDING CONSTANTS AND / DATA TO THE OBJECT PROGRAM. NO LOADING LOCATION DIRECTIVES ARE / ISSUED. / / OTN, 0 TAD ID / WORD 1 OUT JOLW TAD ID1 / WORD 2 JOLW TAD ID2 / WORD 3 JOLW JMP I OTN AAOTN=.-OTN / /GET - GET STATEMENT PROCESSOR /PUT - PUT STATEMENT PROCESSOR / GET, CLA IAC /XGET=XPUT+1 PUT, TAD CXPUT DCA GPOP /STORE GET OR PUT OP CODE DCA ENDINT /INDICATE FILE I/O IN PROGRAM JGCH /PASS OVER "T" CLA IAC /GEN CODE TO PUT DEVICE NO. ON STACK JEXP JTCM /TEST FOR COMMA SKP /COMMA FOUND JMP E5 /NOT FOUND, ERROR JIBN /GET LINE NO OF RECORD STATEMENT JMP E13 DCA ID /SET UP TO SEARCH ASSIGNMENT TABLE TAD C4 / FOR SPECIFIED RECORD DCA EL TAD C4 DCA IU JASI /DO SEARCH; NO RETURN IF RECORD NOT FOUND TAD I X1 /SAVE RECORD LENGTH DCA GPT1 STA /SAVE RECORD CORE ADDR - 1 TAD AF DCA GPT2 JTCM /TEST FOR COMMA SKP /COMMA FOUND E5, ERROR /*** ILLEGAL FORMAT *** 5 JISV /GET RECORD NO. VARIABLE TAD J /GENERATE CODE TO LOAD STACK WITH REC. NO. JOTR XLSTD TAD AF /OUTPUT GET OR PUT OP CODE FOLLNWED BY JOTA / ADDR OF VARIABLE TO AUTO-INCREMENT GPOP, XNOOP TAD GPT2 /FOLLOWED BY RECORD ADDR - 1 JOLW TAD GPT1 /FOLLOWED BY RECORD LENGTH JOLW DCA GPT2 /COMPUTE NO. OF DTA BLOCKS PER RECORD TAD GPT1 ISZ GPT2 TAD CM201A SMA SZA JMP .-3 CLA TAD GPT2 /OUPUT -(NO. OF DTA BLOCKS PER RECORD) CIA JOLW JSTT E13, ERROR /*** INVALID LINE NUMBER *** 13 CM201A, -201 CXPUT, XPUT GPT1=MULT1 GPT2=MULT2 / / SLA-STORE LOW ASSIGNMENT OF ITEM. / / SLA IS USED TO STORE IU, EL,AF,DF & ID INTO THE ENTRY / POINTED TO BY J. X1 IS LEFT POINTING TO THE NEXT / WORD ABOVE ID. / SLA, 0 CLA CLL TAD DF /PICK-UP 6 BIT DEF FLAG RTL CLL RAL CLL AND C770 /AND OUT ROOM FOR IU TAD IU /PICK UP 3 BITS OF IU RTL CLL RAL CLL / TAD EL /PICK UP 3 BITS OF EL DCA I J /STORE TAD J DCA X1 TAD AF /ADDERSS FIELD TO NEXT-UP DCA I X1 TAD ID /ID TO FOR IT'S SAKE DCA I X1 /X1 POINTS TO NEXT OR NEXT JMP I SLA /EXIT C770, 770 AASLA=.-SLA / /DAT - DATA PROCESSOR / / "DATA" IS PROCESSED BY THIS ROUTINE. DAT SCANS THE /ARGUMENTS GOING FROM COMMA TO COMMA FOR NUMERIC /VALUES AND SENDS THE NUMBERS TO THE LOADER AND /COUNTS THE SPACE USED IN THE DATA AREA. / / DAT, JPAS /DATA , -2 /TA CLA IAC /PICK-UP PC+1 FOR RESTORE. TAD PC DCA T1 /SAVE PC FOR LOAD LOC REST DAT1, JICH /IGNORE TRAILING COMMAS TAD TC SNA CLA JMP DAT5 /EOL FOLLOWING COMMA--IGNORE CLA CMA DCA RE /REREAD CHARACTER DCA DOLLAR /PERMIT STRING CONSTANTS JINN /GET AN ELEMENT TAD IU /CHECK IU FOR NUMBER. SZA CLA ERROR /**** NOT CONSTANT IN DATA $$$$ 6 CLA CLL CMA RTL TAD DATBND DCA DATBND /DECREMENT DATA BOUND AND ISZ DOLLAR /HACK FOR STRING DATA JMP DAT3 /NORMAL DATA MODE ISZ DSTBND /YES--COUNT IT DAT4, JOLA /SET UP FOR DATA LOAD JOTN /OUTPUT # IN ID-ID2 JTCM /TEST FOR TERM JMP DAT1 /MORE NUMBERS, COMMA TC DAT5, TAD T1 /RESTORE PC FOR CODE LOADING DCA PC /RESTORE PC TAD PC /SEND IT OUT FOR RESET IN LOADER. JOLL JSTT /MAKE SURE DAT3, TAD DATBND /CORRECT ADDRESS FOR STRING DATA SEEN TAD DSTBND TAD DSTBND TAD DSTBND JMP DAT4 JOLL=JMS I . OLL / / ISV-INPUT SIMPLE VARIABLE / / ISV CAUSES ONLY VARIABLES TO PASS. ALL / CONSTANTS, ARRAYS, FUNCTIONS, & LONE OP'S CRASH / USED BY FOR AND NEXT PROCESSORS. / ISV, 0 JINA CLA CMA TAD IU SNA CLA JMP I ISV ERROR /*** ILLEGAL FORMAT *** 5 AAISV=.-ISV / /SHL - TRIPLE PRECISION SHIFT LEFT / SHL, 0 /LEFT SHIFT ID, INCLUDING LINK TAD ID2 RAL DCA ID2 TAD ID1 RAL DCA ID1 TAD ID RAL DCA ID JMP I SHL AASHL=.-SHL / /NRM - NORMALIZE ROUTINE / NRM, 0 /NORMALIZE ID NRM1, CLA CLL CML RTR AND ID SZA CLA JMP I NRM /IMPORTANT!!! THE LINK IS CLEAR AT THIS POINT /THIS IS USEFUL WHEN "FLT" CALLS "DIV". JMS SHL CLA CMA TAD BE DCA BE JMP NRM1 AANRM=.-NRM ZCH, JGCH /MATCHED "CH"; SCAN OFF "A" TAD PCH ZRE, TAD PRE /MATCHED "RE" ZGO, TAD PGO /MATCHED "GO" DCA TPT /STORE POINTER TO TABLE-2 OF VALID NEXT CHARS JGCH /PICK UP NEXT CHAR JMS I SCAN /GO SCAN TABLE TPT, 0 ERROR /RETURNS IFF NO MATCH 4 /*** ILLEGAL STATEMENT *** PGO, ZGOT-2 PRE=C5 PCH, ZCHT-ZRET SCAN, SCN / /REM-REMARKS PROCESSOR / /REM SCANS LINE TILL AN EOL CHAR IS FOUND / REM, /REM /NONE TO PASS OFF TAD TC SNA /LOOK FOR TC JSTT /LET STT DO THE WALKING JGCH /ON AND ON AND ... JMP REM AAREM=.-REM / / ILN-INPUT LINE NUMBER. / / ILN IS USED TO FORCE A LINE # AS THE NEXT ITEM. / FROM THE SOURCE STRING, THE LINE # IS BUILT / WITH ERROR CHECKING. / / ONCE A LEGAL LINE # HAS BEEN FOUND IT IS / ENTERED INTO THE LINE TABLE. IF THE LINE / IS A FORWARD REFERENCE THEN A CHAIN DEAL. / IS SET-UP. COMPLETION OF THE CHAIN IS DONE IN / THE SID ROUTINE / / ON ENTRY AC=-1 IFF OUTPUT STREAM WAS PREVIOULY ALIGNED TO BYTE / BOUNDARY. OTHERWISE AC=0. / ILN, 0 DCA ILNT1 /SAVE ENTRY AC JIBN /GET NUMBER OF 12 BITS OR LESS JMP ILN5 /SORRY BAD DEAL DCA ID /SAVE TAD ID TAD ILNC1 SMA CLA /CHECK FOR .GT. 2047 ILN5, ERROR /*** INVALID LINE NUMBER *** 13 TAD ID JASL /PLANT/CHECK LINE # IN TABLE TAD LI CIA /CHECK FOR LINE BEING COMPILED TAD LINE /IS GREATER THAN LINE REFERENCED SMA CLA JMP I ILN /EXIT-BACK-REFERENCE ISZ ILNT1 JOBB /FORCE OUTPUT TO BOUNDARY FOR TAD L /A CHAIN. DCA X1 TAD ILNT1 TAD PC /SAVE PC FOR NEXT CKHAION DCA I X1 /LA HAS THIS VALUE JMP I ILN ILNC1, -3777 ILNT1=NRM AAILN=.-ILN / / / STATEMENT ID TABLES / / USED IN SID ROUTINE VIA SCN ROUTINE WHICH PERFORMS SEARCH / OPERATION. / / EACH TABLE ENTRY IS TWO WORDS LONG. THE INPUT ITEM IS ADDED TO THE / FIRST WORD OF AN ENTRY. IF THE RESULTING SUM IS ZERO A MATCH OCCURS / AND CONTRO PASSES TO THE ROUTINE POINTED TO BY THE SECOND WORD OF / THE ENTRY. A ZERO WORD MUST FOLLOW THE LAST TABLE ENTRY. / / THE MAIN TABLE CONTAINS AN ENTRY FOR EACH PAIR OF CHARACTERS WHICH ARE / THE INITIAL TWO CHARACTERS OF A BASIC STATEMENT VERB. IN MOST CASES / A MATCH IN THIS TABLE UNIQUELY IDENTIFIES THE VERB AND THE POINTER / IS TO THE VERB PROCESSING ROUTINE. IN THE OTHER CASES THE POINTER / IS TO A ROUTINE WHICH USES ONE THE SMALLER TABLES TO TEST FOR A VALID / THIRD CHARACTER WHICH WILL IDENTIFY THE VERB. / TBLA=. -XC^100-XH; ZCH /CHANGE, CHAIN -XC^100-XL; CLO /CLOSE -XD^100-XA; DAT /DATA -XD^100-XE; DEF /DEF -XD^100-XI; DIM /DIM -XE^100-XN; END /END -XF^100-XO; FOR /FOR -XG^100-XE; GET /GET -XG^100-XO; ZGO /GOSUB, GOTO -XI^100-XF; IFP /IF -XI^100-XN; INP /INPUT -XL^100-XE; LET /LET -XL^100-XI; LINP /LINPUT -XL^100-XP; LPRI /LPRINT -XN^100-XE; NEX /NEXT -XO^100-XN; ONGT /ON ... GOTO -XO^100-XP; OPE /OPEN -XP^100-XR; PRI /PRINT -XP^100-XU; PUT /PUT -XR^100-XA; RAN /RANDOM -XR^100-XE; ZRE /READ, RECORD, REM, RESTORE, RETURN -XS^100-XL; SLE /SLEEP -XS^100-XT; STO /STOP -XU^100-XN; UNS /UNSAVE 0 ZGOT=. -XS; GOS /GOSUB -XT; GOT /GOTO 0 ZRET=. -XA; REA /READ -XC; REC /RECORD -XM; REM /REM -XS; RES /RESTORE -XT; RET /RETURN 0 ZCHT=. -XI; CHAIN /CHAIN -XN; CHANG /CHANGE 0 IFNZRO ZRET-ZGOT-5 / /END OF TABLE A- / / OPERATOR/TERMINATOR TABLE (USED BY ICH ROUTINE) / / THE CHAR IS RANGED TO BE BETWEEN -25 AND 5 / SO THAT THE TABLE MAY BE INDEXED BY A / DISPLACED ADDRESS PLUS THE VALUE OF THE RANGED / CHARACTER. IF THE ENTRY IS MINUS THEN THE / CHARACTER IS ILLEGAL. IF THE ENTRY IS PLUS / THEN THE LO SIX BITS ARE THE VALUE TO BE / PLACED IN "OP" / / IF OP IS AN OPERATOR (RELATIONAL OR ARITH) / THEN THE BITS 6-8 ARE THE HIERARCHY OF THE / OPERATION. IF IT IS AN ARITH OPERATOR THE / BITS 9-11 ARE THE INTERPRETER OPERATION CODE / FOR THE OP. IF IT IS A RELATIONAL OPERATOR / THE BITS 9-11 ARE THE "C" VALUE FOR A "TEST" / OPERATION / / TERMINATORS HAVE HIERARCHIES WHEN APPROPRIATE. / / TBLB, -1 /LEFT BRACKET -1 /BACK SLASH -1 /RIGHT BRACKET 65 /UP-ARROW -1 /BACK ARROW -1 /BLANK -1 /FACTORIAL 30 /DOUBLE QUOTE -1 /NUMBER SIGN 00 /DOLLAR SIGN -1 /PERCENT SIGN -1 /CENT SIGN -1 /SINGLE QUOTE 01 /LEFT PAREN 11 /RIGHT PAREN 53 /ASTERISK 41 /PLUS SIGN 30 /COMMA 42 /MINUS SIGN 00 /PERIOD 54 /SLASH -1 /COLON 30 /SEMI-COLON 23 /LESS THAN 20 /EQUAL 21 /GREATER THAN -1 /QUESTION MARK / / END OF TABLE B / / THE FOLLOWING OVERLAY THE INITIALIZE ROUTINE. / / / END OF CODE AND FIXED TABLES. / / BEGIN BUFFERS AND DYNAMIC TABLES / BUFSIZ=200 /SIZE OF I-O BUFFERS / OBUF=. /OUTPUT BUFFER -BUFSIZ WORDS IFNZRO OBUF-5115 / IBUF=OBUF+BUFSIZ /INPUT BUFFER -BUFSIZ WORDS / / PEND=IBUF+BUFSIZ /END OF ABOVE, BEGIN TABLES / / TABLES ARE AS FOLLOWS, / 1. LINE TABLE, 2 WORDS TO EACH ENTRY / A. BEGIN POINTER - LS / B. END POINTER -LT / / 2. COMPILE STACK, 1 WORD PER ENTRY / A. BEGIN POINTER -SS / B. END POINTER -ST / / 3. ASSIGNMENT TABLE 3-5 WORDS PER ENTRY / A. BEGIN POINTER JT / B. END POINTER JS / / ACORE=MEND-PEND /AVAILABLE CORE. / / / END OF BUFFERS AND TABLES *OBUF+2 IFNZRO .-OBUF-2&4000 INZC1, INZPZ-1 /DUPLICATE PAGE ZERO ADDRESS INZC2, ZONE-1 /REAL ADDRESS FOR DUPLICATE INZC3, ZONE-200 /NUMBER OF PAGE 0 WORDS TO MOVE INZC5, DATTOP /TOP OF DATA AREA INZC6, IBUF+BUFSIZ-1 /INZ CONSTANT FOR READ INZC7, INTLOW-INTEND / /INZ-INITIALIZE ROUTINE / /INZ MOVES A PICTURE OF PAGE ZERO INTO /PAGE ZERO, OUTPUTS A PAIR OF NOOP'S /TO SET PC=1, (0 IS AN INVALID ADDRESS), /SETS UP CORE SIZE CONSTANTS FOR THE /OBJECT PROGRAM AND THEN BUILDS THE /INITIAL SYMBOL TABLE. / / / INZ, CLA CLL /MOVE CONSTANTS, VARIABLES AND TAD INZC1 /VECTORS TO PAGE ZERO DCA X1 /FROM ADDRESS TAD INZC2 DCA X2 /TOO ADDRESS INZ2, TAD I X1 DCA I X2 /MO E ONE ISZ INZC3 JMP INZ2 /+ MORE INZ3, JOTI /SET THE ODD ONES XNOOP JOTI /SET PC=1 WITH TWO NOOP'S XNOOP CLA IAC DCA START /SET UP FIRST RELOCATABLE VAR ADDRESS TAD INZC5 DCA DATBND /SET UP END OF DATA IN OUTPUT TAD INZC7 /SET END OF INTERP DECREMENT DCA ENDINT TAD INZC6 /SET INPUT POINTER TO FORCE DCA X7 /A READ / /BUILD INITAL SYMBOL TABLE / TAD INZC4 DCA X3 /ADDRESS OF THINGS FOR SYMBOL TABLE INZ4, TAD I X3 /PICK UP FIRST TWO CHARS SNA JSTT /START UP COMPILER DCA ID TAD I X3 DCA ID1 /PICK UP SECOND TWO CHARS TAD C3 DCA IU /SET UP ITEM USAGE AND TAD C4 DCA EL /IT'S LENGTH AND JASI /ASSIGN IT TAD INZC3 ISZ INZC3 DCA AF /SET UP CALL NUMBER TAD C2 DCA DF /SET UP DF FOR INTERNAL JSLA /PLUNCK IT IN THERE AND JMP INZ4 /GO TO NEXT INZC4, INZST-1 /ADDRESS OF INIT TABLE AAINZ=.-INZ / /INITIAL SYMBOL TABLE ID'S / / THIS TABLE CONTAINS THE INITAL SYMBOL TABLE / CONSISTING OF THE WIRED IN FUNCTIONS. THESE / ARE ASSIGNED USING ASI AND THEN THE / OTHER VALUES ARE SET UP. THE "C" VALUE / FOR IN INTERPRETER "IFUN" CALL IS / BASED ON THE ORDER OF THIS TABLE, SO / ORDER COUNTS / / INZST, /BEGINNING OF SYMBOL TABLE XS^100+XI /SINE CALL C=0 XN XC^100+XO /COSINE CALL C=1 XS XT^100+XA /TANGENT CALL C=2 XN XA^100+XT /ARC-TANGENT C=3 XN XE^100+XX /EXPONENT C=4 XP XL^100+XO /LOGARITHIM C=5 XG XS^100+XQ /SQUARE ROOT C=6 XR XA^100+XB /ABSOLUTE VALUE C=7 XS XI^100+XN /INTEGER C=10 XT XR^100+XN /RANDOM NUMBER C=11 XD XS^100+XG /SIGNUM C=12 XN XT^100+XA /TAB FUNCTION C=13 XB XC^100+XH /CHR$ FUNCTION C=14 XDOL^100+XR XF^100+XI /FIX FUNCTION C=15 XX 0 /TABLE TERMINATOR / /INITIAL PAGE ZERO VALUES / /THIS TABLE IS MOVED TO PAGE ZERO BY /THE INZ ROUTINE AND THE TABLE CONTAINS /ALL THE CONSTANTS AND INITAL VALUES FOR /THE VARIABLES / /IT IS MOVED TO ADDRESS "ZONE" / / INZPZ, 0 TOPOFCORE=INZPZ+200-ZONE $