X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Fextensions%2Fdectapes%2Fdectape2%2Fbcomp.pa;fp=sw%2Fos8%2Fv3d%2Fsources%2Fextensions%2Fdectapes%2Fdectape2%2Fbcomp.pa;h=989ae145c710e2610e295cd455c5d99a3e81d5a8;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git diff --git a/sw/os8/v3d/sources/extensions/dectapes/dectape2/bcomp.pa b/sw/os8/v3d/sources/extensions/dectapes/dectape2/bcomp.pa new file mode 100644 index 0000000..989ae14 --- /dev/null +++ b/sw/os8/v3d/sources/extensions/dectapes/dectape2/bcomp.pa @@ -0,0 +1,3415 @@ +/OS8 BASIC COMPILER, V5 +/ +/ +/ +/ +/ +/ +/ +// +/ +/ +/ +/ +/COPYRIGHT (C) 1972, 1973, 1974, 1975 +/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. +/ +/ +/ +/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A +/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- +/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER +/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE +/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO +/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE +/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. +/ +/ +/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT +/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL +/EQUIPMRNT COROPATION. +/ +/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS +/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. +/ +/ +/ +/ +/ +/ + /DEC-S8-LBASA-B-LA +/ +/COPYRIGHT C 1972, 1973, 1974 +/ +/DIGITAL EQUIPMENT CORPORATION +/MAYNARD,MASSACHUSETTS 01754 +/ +/AUGUST 19, 1972 +/ +/HANK MAURER, 1972 +/SHAWN SPILMAN, 1973 +/ +/ +/ASSEMBLE AND LOAD AS FOLLOWS: +/ +/ .R PAL8 +/ *BCOMP,BCOMP + JMP I XABORT + TAD I QERMSG /SET POST PROCESSOR ERROR SWITCH + DCA ERMSG2 + JMP I POSTX /START IT UP + / RESTORE, PRINT, AND INPUT PROCESSORS + PAGE +INPUT, JMS I QLODSN /OUTPUT STMT NUM + JMS GETFN /LOOK FOR #: +INPUTL, CLL CML RAR /PROCESS INPUT STMT + JMS I QEXPR /GET EXPR + JMP I QREMARK + JMS I QGETA1 /GET TOP OF STACK + TAD TYPE1 /LOOK AT THE TYPE + SPA CLA + JMP RSTRNG /READ STRING + JMS I QMODSET /SET MODE + CLL CML RTR /IS IT DIMENSIONED ? + AND TYPE1 + SZA CLA + JMP I (DIMREAD/YES + TAD (READ /OUTPUT READ COMMAND + JMS I QOUTWRD + TAD (FSTA /USE SCALAR STORE +FININP, TAD SYMBL1 /PLUS SYMBOL NUMBER + JMS I QOUTWRD /OUTPUT INSTR + JMS I QCHECKC /LOOK FOR , + -54 + JMP I QNEWLIN /END OF INPUT + JMP INPUTL /YES, LOOP +RSTRNG, CLL CML RAR /SET MODE + JMS I QMODSET /TO STRING + CLL CML RTR /SUBSCRIPTED ? + AND TYPE1 + SNA CLA + JMP .+3 /NO + JMS I QLOADSS /LOAD SS REG + TAD (SAREAD-SREAD + TAD (SREAD /STRING READ + JMP FININP /USE SOME COMMON CODE +PRINT, JMS I QLODSN /OUTPUT STMT NUM + JMS GETFN /GET FILE NUMBER + DCA I QEXPR /USE ENTRY AS SWITCH +PRINTL, DCA PCRLF /CLEAR THE FLAG + JMS I QGETC /LOOK FOR A CHAR + JMP PRTEND /NONE LEFT, END PRINT + TAD (-73 /; ? + SNA + JMP NOCR /YES, DON'T SPACE OUTPUT + TAD (73-54 /, ? + SZA CLA + JMP TABPNT /LOOK FOR TAB OR PNT + TAD (FUNC3+20 + JMS I QOUTWRD /OUTPUT FUNC3+20 (COMMA) +NOCR, DCA I QEXPR /CLEAR THE SWITCH + CLA IAC /SET NO CRLF FLAG + JMP PRINTL +TABPNT, TAD I QEXPR /WAS LAST THING AN EXPR ? + SZA CLA + JMP I QNEWLIN /YES, CAN'T HAVE TWO IN A ROW + JMS I QBACK1 /PUT THAT CHAR BACK + JMS I QSAVECP /SAVE CHAR POS + JMS I QCHKWD /LOOK FOR "TAB(" + WTAB + JMP TRYPNT /NO TAB + TAD (FUNC3+100 +PFCALL, DCA PRFUN /SAVE PRINT FUNCTION + JMS I QEXPR /GET ARG + JMP I QREMARK + JMS I QLOAD /LOAD ARG + TAD TYPE1 /MUST BE NUMERIC + SMA CLA + JMP .+4 /OK, IT IS +BADPF, JMS I QERMSG /PRINT ERROR + 0622 /BAD FUNCTION REFERENCE + JMP I QREMARK + JMS I QCHECKC /LOOK FOR ) + -51 + JMP BADPF /BAD FUN REFERENCE + TAD PRFUN /OUTPUT FUNCTION CALL + JMP PUT1 +TRYPNT, JMS I QRESTCP /RESTORE CHAR POS + JMS I QCHKWD /LOOK FOR PNT( + WPNT + JMP PEXP /NO + TAD (FUNC3+120 + JMP PFCALL /GO DO FUN CALL +PEXP, JMS I QRESTCP /RESTORE CHAR POS + JMS I QEXPR /GET EXPR TO BE PRINTED + JMP I QREMARK + JMS I QLOAD /PUT THING INTO FAC (OR SAC) + CLL CML RAR + AND TYPE1 /GET TYPE BIT + CLL RTL /INTO AC 11 + TAD (WRITE /SWRITE=WRITE+1 +PUT1, JMS I QOUTWRD + JMP PRINTL +PRTEND, TAD PCRLF /DID PRINT END WITH + SZA CLA /, OR ; + JMP I QNEWLIN /YES, NO CR LF + TAD (FUNC3+40 +PUT2, JMS I QOUTWRD /CALL TO CRLF ROUTINE + JMP I QNEWLIN /END OF PRINT +RESTOR, JMS I QLODSN /OUTPUT LOAD STMT NUMBER + CLA IAC /NO COLON NEEDED + JMS GETFN /LOAD FILE REG + TAD (REST /OUTPUT RESTORE OP + JMP PUT2 +PRFUN, +LODSN, 0 /OUTPUT STMT NUMBER INTO CODE + TAD NOSN /ANY STMT NUMBER ? + SNA CLA + JMP I LODSN /NO, JUST RETURN + TAD WORD1 /NOW OUTPUT "LOAD STMT NUM REG" + TAD (LOADSN + JMS I QOUTWRD + TAD WORD2 + JMS I QOUTWRD + JMP I LODSN + +XADD, FADD;AFADD + / DIM PROCESSOR + PAGE +DIM, JMS I QGETNAM /GET VAR NAME + JMP DIMERR + TAD TYPE /CHECK TYPE + RTL /MOVE BITS TO BE TESTED + SMA CLA /IF FUNC BIT SET THEN ERROR + SNL /IF DIM BIT NOT SET THEN ERROR + JMP DIMERR /NO DIMENSIONS + JMS SMLNUM /GET DIMENSION + TAD EXPON /SAVE IT + DCA DIM1 + JMS I QCOMARP /, OR ) ?? + JMP DIMERR /NEITHER IS BAD + JMP TWODIM /, THERE'S ANOTHER DIMENSION + JMS CHKSDM /CHECK SIZE IF STRING + JMP CHKDIM /NUMERIC VECTOR, CHECK PREV REF + CLL CML RAR /THIS WAS A STRING SIZE DIM + DCA TYPE /PERFORM THE SPECIAL CASE + JMS I QLOOKUP + CDF 10 /OF NOT CHECKING PREVIOUS REFS + JMP FINDIM +TWODIM, JMS SMLNUM /GET SECOND + JMS I QCHECKC /LOOK FOR ) + -51 + JMP DIMERR + JMS CHKSDM /CHECK SIZE IF STRING ARRAY + TAD (7000 /NUMERIC ARRAY +CHKDIM, TAD (7000 /GET NUMBER OF DIMS + DCA TEMP + JMS I QLOOKUP /FIND ST ENTRY + CDF 10 + TAD I STPTR /LOOK AT DIM BITS + AND (7000 /PREVIOUSLY REFERENCED ? + SNA + JMP UNREFD /NO + SMA /IF MINUS, CAUSE ERROR + TAD TEMP /COMPARE NUMBER + SZA CLA + JMP DIMERR /NUMBER OF DIMS DON'T MATCH + DCA TEMP /ZERO TEMP +UNREFD, CLL CML RAR /PUT IN DIMENSIONED BIT + TAD TEMP /AND NUMBER OF DIMENSIONS + CIA /NEGATE WHOLE MESS (4000=-4000) + TAD I STPTR /TOGETHER WITH SYM NUMBER + DCA I STPTR + ISZ STPTR + TAD DIM1 /NOW FIRST DIMENSION (IF 2) + DCA I STPTR +FINDIM, ISZ STPTR + TAD EXPON /NOW SECOND (IF 2, OTHERWISE FIRST) + DCA I STPTR + CDF + JMS I QCHECKC /LOOK FOR , + -54 + JMP I QNEWLIN /NONE, ASSUME END OF DIM + JMP DIM /GET NEXT ELEMENT +CHKSDM, 0 /CHECK SIZE OF STRINGS + TAD TYPE /WAS THIS A STRING DIM ? + SMA CLA + JMP I CHKSDM /NO, RETURN IMMEDIATE + ISZ CHKSDM /YES, SKIP ON RETURN + TAD EXPON /SIZE MUST BE < 73 + CLL + TAD (-STRLIM-1 + SNL CLA + JMP I CHKSDM /OK, SIZE < 73 +DIMERR, JMS I QERMSG /GIVE ERROR + 0411 + JMP I QREMARK /ABORT STMT + / NEXT PROCESSOR +NEXTX, JMS I QGETNAM /GET INDEX VARIABLE + JMP BADNXT + JMS I QLOOKUP + TAD TYPE /MUST BE NUMERIC + SPA CLA + JMP BADNXT /IT ISN'T + JMS I QMODSET /N MODE +NEXTL, TAD (-STACKA-3 + TAD STACK /ANY FOR'S LEFT ? + SPA CLA /(OK IF STACKA ABOVE 4000) + JMP BADNXT /NO + JMS I QPOP /GET LABEL ADDR + DCA TEMP + JMS I QPOP /GET LABEL FIELD + DCA LUPFLD + JMS I QPOP /GET STEP VAR + TAD XLOAD /LOAD IT + JMS I QOUTWRD + JMS I (PSETJF /PATCH! + TAD FINDEX /ADD IT TO STEP (FADD=0) + JMS I QOUTWRD + TAD LUPFLD /CREATE JUMP TO LOOP + AND (70 + CLL RTL + TAD (JUMP + JMS I QOUTWRD + CLL CMA RAL /GET LABEL DEFINITION ADDR + TAD TEMP + JMS I QOUTWRD /OUTPUT IT AS LOW PART OF JUMP +DIM1, +LUPFLD, HLT + CLL CML RAR /SET LABEL DEFINED BIT + TAD LOCTRH /DEFINE END OF LOOP LABEL + DCA I TEMP + ISZ TEMP + TAD LOCTRL + DCA I TEMP + CDF + TAD STACK /BACK OFF STACK LEVEL + DCA STKLVL + JMS I QNOREGS /FORGET REGS + TAD SYMBOL /IS THIS THE RIGHT NEXT ? + CIA + TAD FINDEX + SNA CLA + JMP I QNEWLIN /YES, FINISHED +BADNXT, JMS I QERMSG /NEXT WITHOUT FOR + 1606 + JMP I QREMARK +UMOPR, 40;1;UMRTNE-1 +XLOAD, FLDA;AFLDA + / UDEF PROCESSOR (DEFINE USER FUNCTION) + PAGE +UDEF, ISZ NFUNS /ROOM FOR ANOTHER FUN ? + JMS I QLETTER /GET FIRST LETTER + JMP DEFBAD /ERROR IN DEFINE + CLL RTL /PUT INTO HIGH ORDER + RTL + RTL + DCA NAME1 /SAVE CHAR 1 + JMS I QLETTER /GET SECOND LETTER + JMP DEFBAD /ERROR + TAD NAME1 /COMBINE THE TWO CHARS + CIA + DCA I FUNPTR /SAVE IN FUN TABLE + ISZ FUNPTR + JMS I QLETTER /GET THIRD LETTER + JMP DEFBAD + CIA /SAVE NEG OF THIRD LETTER + DCA I FUNPTR + ISZ FUNPTR /BUMP POINTER + TAD M5 /NUMERIC ARG COUNT + DCA TEMP / (MAX OF 4 ARGS) + CLL CMA RTL /STRING ARG COUNT + DCA TEMP2 / (MAX OF 2 ARGS) + JMS I QCHECKC /IS IT A STRING FUN ? + -44 + SKP CLA + CLL CML RAR /YES, SET TYPE OF FUNCTION + DCA TYPE1 + JMS I QCHECKC /LOOK FOR ( + -50 + JMP DEFBAD /ERROR IF MISSING +DALOOP, JMS I QGETNAM /GET AN ARG + JMP DEFBAD + TAD TYPE /LOOK AT ITS TYPE + CLL RAL /SHIFT TYPE BIT INTO LINK + SZA CLA + JMP DEFBAD /OTHER BITS MUST BE OFF + SZL + JMP STRARG /STRING ARG + TAD TEMP /GET ARG NUMBER + ISZ TEMP /INCREMENT IT + JMP DAPUSH /GO SAVE IT +DEFBAD, JMS I QERMSG /BAD USER DEF + 2504 + JMP I QREMARK +STRARG, TAD TEMP2 /GET ARG NUMBER + ISZ TEMP2 /AND INCREMENT IT + JMP DAPUSH+1 + JMP DEFBAD /TOO MANY STRING ARGS +DAPUSH, TAD Q2 /ADJUST ARG NUMBER + TAD Q2 /ADD 4 FOR NUM, 2 FOR STRING + SPA + CLA CLL CML RTR /FIRST ARG STAYS IN AC + TAD TYPE /ADD IN TYPE BIT + JMS I QPUSH /SAVE IT ON STACK + JMS I QCOMARP /LOOK FOR , OR ) + JMP DEFBAD /ERROR IF NEITHER + JMP DALOOP /, GET NEXT ARG + TAD TEMP2 /GET TOTAL NUMBER OF ARGS + TAD TEMP + TAD Q10 /ADJUST COUNT + CIA /NEGATED + DCA DACNT + TAD I FUNPTR /GET FUNCTION CODE + ISZ FUNPTR /BUMP POINTER + DCA WORD1 /MAKE IT THE SEARCH OBJECT + JMS I XSTCHEK /MAKE SURE THERE'S ROOM + EOST-10 + JMS I QLUKUP2 /ENTER NEW FUNCTION + FUNCTN + -1 + TAD DACNT /PUT IN ARG COUNT + JMS SETFLD /(FIRST SET THE FIELD) + DCA I NEXT +DAPUT, CDF + JMS I QPOP /GET ARG TYPE (LAST TO FIRST) + JMS SETFLD /SET THE FIELD + DCA I NEXT /SAVE IT + ISZ DACNT /ANY MORE ? + JMP DAPUT /YES + TAD TYPE1 /PUT IN TYPE OF FUNCTION + DCA I NEXT + CDF + JMS I QCHECKC /LOOK FOR A COMMA + -54 + JMP I QNEWLIN /NO COMMA, END OF LINE + JMP UDEF /GET NEXT DEFINITION +XSTCHEK,STCHEK +FUNPTR, ENDFNS +Q2, 2 /THESE FOUR WORDS +M5, -5 /PREVENT ERRONEOUS "SAVES" +Q10, 10 /BY THE ROUTINE SAVAC +NFUNS, -21 /WHEN THE OP STACK IS EMPTY +STACKO, /OPERAND STACK + STOKSZ=UDEF+200-STACKO + / DEF PROCESSOR + PAGE +DEF, JMS I QNOREGS /FORGET REGS + JMS I QGETNAM /GET FUN NAME + JMP BADDEF /NO GOOD + TAD TYPE /SAVE ITS TYPE + DCA TEMP2 + DCA ARGCNT /ZERO ARG COUNT + TAD TYPE /TYPE MUST BE 3000 OR 7000 + RTL /MOVE BITS TO BE TESTED + SPA CLA /FUN BIT OFF IS AN ERROR + SNL /DIM BIT OFF IS AN ERROR + JMP BADDEF + JMS I QMODSET /ENTER N MODE + TAD SYMBOL /SAVE FUNCTION NAME + DCA FUNNAM +ARGLUP, JMS I QGETNAM /GET ARG NAME + JMP BADDEF + CLL CMA RAR /LOOK AT TYPE + AND TYPE + SZA CLA + JMP BADDEF /ARG WAS AN ARRAY OR FUNC + JMS I QLOOKUP /ENTER INTO S.T. + TAD STPTR /SAVE ST ADDRESS + JMS I QPUSH + TAD SYMBOL /AND SYMBOL NUMBER + JMS I QPUSH + TAD TYPE /AND ARG TYPE + JMS I QPUSH + ISZ ARGCNT /BUMP ARG COUNT + JMS I QCOMARP /LOOK FOR , OR ) + JMP BADDEF + JMP ARGLUP /, GET NEXT ARG + TAD FUNNAM /ENTER FUNCTION + DCA WORD1 + TAD ARGCNT /FIRST GET ENOUGH ROOM + CIA + TAD (EOST-3 + DCA FUNNAM + JMS STCHEK /CHECK IT +FUNNAM, 0 + JMS I QLUKUP2 /LOOK UP FUNCTION + FUNCTN + -1 + JMP OKFUN /OK, NOT MULTIPLY DEFINED +BADDEF, JMS I QERMSG /BAD DEFINE + 0405 + JMP I QREMARK +OKFUN, TAD NEXT /SAVE "NEXT" + DCA X12 + TAD NEXT /INCREMENT NEXT BY + TAD ARGCNT /NUMBER OF ARGS + TAD (4 /PLUS 4 + DCA NEXT + JMS SETFLD /GET ROOM FOR LABEL + CLL CML RAR /FOR JUMP AROUND + DCA I NEXT /SET DEFINED BIT + TAD NEXT /SAVE ADDR + DCA JAROND /FOR LATER + ISZ NEXT + CDF + TAD LUFLD /SAVE FIELD OF FUN BLOCK + DCA FUNFLD + TAD LUFLD /ALSO FIELD OF LABEL + DCA JARFLD + TAD LUFLD /GET FIELD + AND (70 /ISOLATE BITS + CLL RTL /INTO JUMP INSTR + TAD (JUMP + JMS I QOUTWRD /OUTPUT IT + TAD JAROND /OUTPUT LOW PART + JMS I QOUTWRD /OF JUMP ADDR + TAD STACK /SAVE STACK + DCA OLDSTK + TAD ARGCNT /GET COUNT + CMA + DCA TEMP + TAD ARGCNT /TWICE + CIA + DCA ARGCNT + TAD ARGCNT /STORE COUNT FIRST + JMP FUNFLD +CHGARG, CDF + JMS I QPOP /GET ARG TYPE + DCA TYPE + TAD TYPE + JMS GENTMP /GENERATE A TEMPORARY +SWTARG, JMS I QPOP /PURGE SYMBOL NUMBER + CLA + JMS I QPOP /GET ST ADDR OF + DCA STPTR /OF DUMMY ARG + CDF 10 + TAD SYMBOL /PUT IN TEMP SYMBOL NUMBER + DCA I STPTR /TO FAKE EXPR + TAD TYPE /CREATE ARG DESCRIPTOR + TAD SYMBOL /FOR FUNC BLOCK +FUNFLD, HLT + DCA I X12 /AND PUT IT INTO F.B. + ISZ TEMP /MORE ARGS? + JMP CHGARG /YUP + CLL CML RAR + AND TEMP2 /SAVE TYPE OF FUNCTION + DCA I X12 + CLL CML RAR /SET DEFINED BIT + TAD LOCTRH /AND LOCATION COUNTER + DCA I X12 /AT START OF FUNCTION + TAD LOCTRL + DCA I X12 + CDF + TAD STACK /SAVE BOTTOM OF STACK + DCA X13 + TAD OLDSTK /RESTORE TO TOP + DCA STACK + JMS I QCHECKC /FIND = + -75 + JMP BADDEF + JMS I QEXPR /COMPILE FUNCTION + JMP I QREMARK + JMS I QLOAD /GET IT INTO AC + TAD X13 /RESTORE STACK + DCA STACK /TO BOTTOM + JMP RESARG /FINISH DEF + / DEF PROCESSOR (FINALE) + PAGE +RESARG, TAD I X13 /GET ST ADDR + DCA STPTR + TAD I X13 /PUT BACK CORRECT SYM # + CDF 10 + DCA I STPTR + CDF + ISZ X13 /SKIP OTHER STUFF + ISZ ARGCNT + JMP RESARG /RESTORE NEXT + TAD (RET /OUTPUT RETURN CODE + JMS I QOUTWRD +JARFLD, HLT + CLL CML RAR /SET LABEL DEFINED BIT + TAD LOCTRH /STICK IN ADDR + DCA I JAROND /OF END OF FUNCT + ISZ JAROND /PLUS ONE + TAD LOCTRL /STORE LOW ADDR + DCA I JAROND + CDF + TAD TMPCNT /SAVE NEW TEMP LEVELS + DCA TMPLVL + TAD STMPCT + DCA STMPLV + JMS I QNOREGS /FORGET REGS + JMP I QNEWLIN /END OF DEF + / DATA STATEMENT PROCESSOR +DATA, JMS I QNUMBER /LOOK FOR NUMBER + JMP DSTRNG /MUST BE A STRING + JMS DENTRY /MAKE AN ENTRY + -3 /3 WORDS LONG +MORDAT, JMS I QCHECKC /LOOK FOR , + -54 + JMP I QNEWLIN /END OF DATA + JMP DATA /DO NEXT ELEMENT +DSTRNG, JMS I QSTRING /LOOK FOR STRING + JMP I QNEWLIN /BAD + TAD WORD1 /COMPUTE SIZE + IAC + CLL CML CMA RAR + DCA DSSIZE /INCLUDING CHAR COUNT + TAD WORD1 /NEGATE COUNT + CIA + DCA WORD1 + JMS DENTRY /CREATE ENTRY +DSSIZE, 0 + JMP MORDAT /GO DO MORE +DENTRY, 0 /MAKE AN ENTRY IN DATA LIST + TAD I DENTRY /GET SIZE + DCA TEMP + ISZ DENTRY + TAD TEMP /INCREMENT SIZE COUNT + TAD DLSIZE + DCA DLSIZE + TAD (EOST /HOW MUCH DO WE NEED ? + TAD TEMP + DCA .+2 + JMS STCHEK /ASK FOR IT + 0 + TAD FREFLD /GET FIELD OF FREE SPACE + DCA LUFLD /SAVE IT IN SETFLD SUBROUTINE +DATFLD, CDF 10 + TAD NEXT /HOOK IN NEW ENTRY + IAC + DCA I DATPTR +PATCH3, ISZ DATPTR /POINTER THEN FIELD + TAD LUFLD + DCA I DATPTR + JMS SETFLD + TAD TEMP /SAVE SIZE OF ENTRY + DCA I NEXT + TAD (WORD1-1/MAKE READY TO MOVE + DCA X10 +DELOOP, CDF + TAD I X10 /GET WORD + JMS SETFLD + DCA I NEXT /SAVE IT + ISZ TEMP /MORE ? + JMP DELOOP + DCA I NEXT /SAVE ROOM FOR POINTER&CDF + TAD NEXT /THIS IS NOW LAST ENTRY + DCA DATPTR +PATCH4, TAD LUFLD + DCA DATFLD /AND THIS IS ITS FIELD + DCA I NEXT + CDF + JMP I DENTRY +DATPTR, DATLST + / READ PROCESSOR +READX, JMS I QLODSN /OUTPUT STMT NUMBER + CLL CML RAR /GET VAR TO READ + JMS I QEXPR /SAME AS LEFT SIDE OF LET + JMP I QREMARK + JMS I QGETA1 /GET VAR INFO FROM STACK + TAD TYPE1 /SET MODE + JMS I QMODSET + TAD TYPE1 /WHAT TYPE ? + SPA CLA + TAD (SRDL-NRDL + TAD (NRDL /STRING OR NUMERIC + JMS I QOUTWRD + CLL CML RTR /SUBSCRIPTS ? + AND TYPE1 + SNA CLA + JMP .+3 /NO + JMS I QLOADSS /YES, LOAD SS REGS + TAD (AFSTA-FSTA + TAD (FSTA /ARRAY OR SCALAR STORE + TAD SYMBL1 + JMS I QOUTWRD + JMS I QCHECKC /ANY MORE ? + -54 /CHECK FOR COMMA + JMP I QNEWLIN /NO + JMP READX+1 /YUP +AMPSND, 40;1;AMPRTN-1;4000;SCONTS;SCONTS +SCONTS, FADD;AISUB + / FOR PROCESSOR + PAGE +FOR, JMS I QLODSN /OUTPUT STMT NUMBER + JMS I QGETNAM /GET INDEX VARIABLE + JMP BADFOR /BAD + TAD TYPE /MUST BE NUMBER + SZA CLA + JMP BADFOR /ITS NOT + JMS I QLOOKUP /ST SEARCH + TAD SYMBOL /SAVE INDEX VAR + DCA FINDEX /FOR LATER + JMS I QCHECKC /FIND = + -75 + JMP BADFOR + TAD CHRPTR /SAVE CHAR POSITION + DCA FORCP /IN A SPECIAL PLACE + TAD NCHARS + DCA FORNC + SKP +FINDTO, JMS I QRESTCP /RESTORE CHAR POS + JMS I QGETC /SKIP A CHAR + JMP BADFOR + CLA + JMS I QSAVECP /SAVE THIS POSITION + JMS I QCHKWD /LOOK FOR "TO" + WTO + JMP FINDTO /KEEP GOING + JMS FSUB2 /LOAD LIMIT AND SAVE IN TEMP + DCA FLIMIT /SAVE LIMIT VAR + JMS I QCHKWD /LOOK FOR "STEP" + WSTEP + JMP STEP1 /USE 1.0 FOR THE STEP + JMS FSUB2 /LOAD STEP AND SAVE IN TEMP + DCA FSTEP /SAVE STEP VAR + TAD (SETJF /OUTPUT SETJF + JMS I QOUTWRD + TAD (JFOR /STEP IS VARIABLE, USE JFOR +SAVEJF, DCA FORJMP /SAVE CORRECT JUMP + JMS I QGETC /ANY MORE CHARS ? + SKP + JMP BADFOR /YES, ERROR + TAD FORNC /RESTORE CHAR POSITION + DCA NCHARS /FROM SPECIAL PLACE + TAD FORCP + DCA CHRPTR + JMS FSUB1 /COMPILE INITIAL VALUE INTO FAC + JMS STCHEK /CHECK FOR ROOM + EOST + TAD FREFLD /SAVE FIELD OF LABELS + DCA FORFLD +FORFLD, HLT + CLL CML RAR /SET LABEL DEFINED BIT + TAD LOCTRH /DEFINE THE LOOP LABEL + DCA I NEXT + TAD LOCTRL + DCA I NEXT + CLL CML RAR /SET LABEL DEFINED BIT + DCA I NEXT /FOR END OF LOOP LABEL + CDF + TAD FLIMIT /TEST FOR DONE + TAD XSUB /BY SUBTRACTING THE LIMIT + JMS I QOUTWRD + TAD FORFLD /OUTPUT JUMP TO DONE + AND (70 + CLL RTL /SHIFT FIELD BITS + TAD FORJMP /USE PROPER JUMP INS + JMS I QOUTWRD + TAD NEXT /OUTPUT LOW PART OF JMP + JMS I QOUTWRD + TAD FLIMIT /FADD FLIMIT (FADD=0) + JMS I QOUTWRD + TAD FINDEX /FSTA INDEX + TAD (FSTA + JMS I QOUTWRD + TAD FINDEX /PUT STUFF ONTO STACK + JMS I QPUSH + TAD FSTEP + JMS I QPUSH + TAD FORFLD + JMS I QPUSH + TAD NEXT + JMS I QPUSH + ISZ NEXT /BUMP NEXT AGAIN + TAD TMPCNT /RESERVE THESE TEMPS + DCA TMPLVL + JMS I QNOREGS /FORGET REGISTORS + TAD STACK /SET NEW STACK LEVEL + DCA STKLVL + JMP I QREMARK +STEP1, TAD (3 /1.0 IS SLOT #3 + DCA FSTEP + TAD (JGT /USE JGT + JMP SAVEJF /GO DO THE REST +FLIMIT, 0 /FOR LOOP UPPER LIMIT +FSTEP, 0 /FOR LOOP STEP +FORNC, 0 /FOR STMT CHAR POSITION +FORCP, 0 +WTHEN, -124;-110;-105;-116 +XSUB, FSUB;AFSUB + / USE PROCESSOR +USEX, TAD (USE /OUTPUT USE OPERATOR + JMS I QOUTWRD + JMS I QGETNAM /GET ARRAY NAME + JMP USEERR /ERROR + TAD TYPE /CHECK TYPE + SMA CLA /(MUST BE NUMERIC) + JMP .+3 /IT WAS +USEERR, JMS I QERMSG /ERROR IN USE STMT + 2525 + CLL CML RTR /SET DIM BIT + DCA TYPE + JMS I QLOOKUP /LOOKUP SYMBOL + TAD SYMBOL /OUTPUT ARRAY NUMBER + JMS I QOUTWRD + JMP I QREMARK + / IF AND IFEND PROCESSORS + PAGE +IF, JMS I QLODSN /OUTPUT STMT NUMBER + JMS I QEXPR /GET LEFT EXPRESSION + JMP I QREMARK + JMS I QGETC /GET RELATIONAL OPERATOR + JMP BADIF /ERROR IF NONE + CLL RTL + RTL /MOVE TO LEFT HALF + RTL + DCA TEMP /AND SAVE IT + JMS I QGETC /GET 2 CHAR RELATIONALS + JMP BADIF + TAD TEMP /COMBINE THE 2 + DCA TEMP2 + TAD (IFOPS-1/SETUP POINTER + DCA X10 +IFLUP1, TAD I X10 /GET JUMP OPCODE + SNA + JMP IFLUP2-1/NOT A 2 CHAR RELATIONAL + DCA RELOPR /SAVE IT + TAD I X10 /COMPARE CHARS + TAD TEMP2 + SZA CLA + JMP IFLUP1 /NOT THIS OOE +GOTREL, JMS I QEXPR /GET RIGHT HALF + JMP I QREMARK + CLA CMA /GET TYPE OF RIGHT SIDE + TAD OSTACK + DCA TEMP + TAD I TEMP + SPA CLA + JMP STRCMP /STRING, DO STRING COMPARE + TAD (MINUS /NUMERIC, DO A SUBTRACT + JMS I QOUTOPR +NUMCMP, JMS I QSAVECP /SAVE CHAR POSITION + JMS I QCHKWD /LOOK FOR "THEN" + WTHEN + JMP NOTHEN /NOT THEN +GETIFN, JMS I QSNUM /GET STATEMENT NUMBER + JMP BADGO2 + TAD TEMP /OUTPUT JUMP + TAD RELOPR + JMS I QOUTWRD + TAD TEMP2 /TWO WORDS + JMS I QOUTWRD + JMP I QNEWLIN +NOTHEN, JMS I QRESTCP /BACKUP CHAR POS + JMS I QCHKWD /LOOK FOR "GOTO" + WGOTO + SKP + JMP GETIFN /OK, GO GET STMT NUMBER +BADIF, JMS I QERMSG /BAD IF STMT + 1106 + JMP I QREMARK +STRCMP, TAD (SCOMPR-1 + JMS I QOUTOPR /OUTPUT STRING COMPARE + JMS I QMODSET /BACK TO N MODE + JMP NUMCMP /REST IS LIKE NUMERIC COMPARES + JMS I QBACK1 /PUT BACK NON OPERATOR +IFLUP2, TAD I X10 /GET CONDITIONAL JUMP + SNA + JMP BADIF /RELATIONAL INCORRECT + DCA RELOPR + TAD I X10 /COMPARE OPERATORS + TAD TEMP + SNA CLA + JMP GOTREL /GOTIT + JMP IFLUP2 +IFEND, JMS I QLODSN /OUTPUT STMT NUMBER + CLA IAC /(NO COLON) + JMS GETFN /GET FILE NUMBER + TAD (JEOF /SETUP CORRECT JUMP + DCA RELOPR + JMP NUMCMP /GO FIND "THEN" OR "GOTO" +RELOPR, +GETFN, 0 /GET FILE NUMBER + DCA COLON /SAVE COLON SWITCH + JMS I QCHECKC /LOOK FOR # + -43 + JMP TTYFIL /NONE, MUST BE TTY + JMS I QEXPR /GET FILE EXPR + JMP I QREMARK /ERROR + TAD COLON /DO WE NEED A COLON ? + SZA CLA + JMP .+4 /NO, SKIP THIS TEST + JMS I QCHECKC /YES, LOOK FOR IT + -72 + JMP BADFN /NOT THERE, BAD + JMS I QLOAD /LOAD IT + TAD TYPE1 /TYPE MUST BE NUMERIC + SPA CLA +BADFN, JMS I QERMSG /NOPE, IT ISN'T + 0616 + CLA IAC /SET IFNREG TO "NOT TTY" + DCA IFNREG /SAVE NEW IFNREG + TAD (FILENO /OUTPUT SET IFN COMMAND + JMS I QOUTWRD + JMP I GETFN +TTYFIL, TAD IFNREG /IS IFNREG 0 ? + SNA CLA + JMP I GETFN /IF YES, QUIT + TAD (CLRFN /OTHERWISE ZERO AC + JMS I QOUTWRD + DCA IFNREG /SET IFNREG TO TTY + JMP I GETFN /RETURN + / GOTO AND GOSUB +GOTO, JMS I QSNUM /GET NUMBER + JMP BADGO2 + JMS I QMODSET /ALL GOTO'S IN NMODE + CLA IAC /JUMP=JSUB+1 + JMP .+5 +GOSUB, JMS I QLODSN /OUTPUT STMT NUM LOAD + JMS I QSNUM /GET NUMBER + JMP BADGO2 + JMS I QMODSET /ALL GOTO'S IN NMODE + TAD (JSUB /GET GOSUB OPCODE + TAD TEMP /PLUS ADDRESS + JMS I QOUTWRD /OUTPUT IT + TAD TEMP2 /BOTH WORDS + JMS I QOUTWRD + JMP I QNEWLIN +BADGO2, JMS I QERMSG /BAD GOTO OR GOSUB + 1615 /NUMBER MISSING + JMP I QREMARK + / TABLE SEARCH FOR LITERALS, STMT NUMBERS, TEMPS, ETC. + PAGE +LUKUP2, 0 + TAD I LUKUP2 /GET THE BUCKET START + DCA OLDN3 /SAVE IT AS THE PREVIOUS ENTRY + ISZ LUKUP2 + TAD I LUKUP2 /GET THE ENTRY SIZE + ISZ LUKUP2 + DCA N3SIZE + TAD (6211 /PRIME THE FIELD SETTER + DCA LUFLD + JMS SETFLD /NOW SET THE FIELD +LOOK2, TAD I OLDN3 /GET ADDR OF NEXT ENTRY + DCA NEWN3 /SAVE IT +PATCH1, ISZ OLDN3 /GET TO FIELD OF NEW ENTRY + TAD I OLDN3 /GET INTO AC + DCA NEWFLD /AND SAVE IT + TAD NEWN3 + SNA + JMP HOOKIN /IF 0 ITS END OF LIST +PATCH5, IAC + DCA X10 /START OF VALUE INFO + TAD (WORD1-1/SETUP POINTER TO VALUE + DCA X11 + TAD N3SIZE /AND TEMP OF ENTRY SIZE + DCA LTEMP +CHKVAL, CDF + TAD I X11 + CIA CLL /COMPARE THIS WORD +NEWFLD, CDF 10 /FIELD OF NEW ENTRY + TAD I X10 + SZA CLA + JMP NOTSAM /NOT THIS ONE + ISZ LTEMP /INCR SIZE COUNT + JMP CHKVAL /MORE STUFF + TAD I X10 /GET SYMBOL NUMBER +L6201, CDF + DCA SYMBOL + TAD NEWFLD /MAKE ENTRY ADDRESSABLE + DCA LUFLD /THROUGH SETFLD + ISZ LUKUP2 /BUMP RETURN + JMP I LUKUP2 +NOTSAM, SZL + JMP HOOKIN /NEW SYMBOL < CURRENT + TAD NEWN3 /GO TO NEXT ENTRY + DCA OLDN3 /(MOVE POINTER) + TAD NEWFLD /(AND FIELD) + DCA LUFLD + JMP LOOK2 +HOOKIN, CLL CMA RAL /HOW MANY WORDS NEEDED ? + TAD N3SIZE + TAD (EOST + DCA .+2 + JMS STCHEK /MAKE SURE + 0 /WE GOT ENOUGH + TAD NEWN3 /HOOK IN NEW ENTRY +FREFLD, CDF 10 /CHANGE TO FREE FIELD + DCA I NEXT +PATCH2, TAD NEWFLD /HOOK IN FIELD + DCA I NEXT + JMS SETFLD /BACK TO FIELD OF OLD + TAD FREFLD /PUT FIELD OF NEW + DCA I OLDN3 + CLA CMA /BACK UP OLDN3 + TAD OLDN3 /SO THAT IT POINTS TO POINTER + DCA OLDN3 + CLA CMA + TAD NEXT /PUT POINTER TO NEW ENTRY + DCA I OLDN3 /INTO OLD + TAD FREFLD /SAVE ENTRY FIELD + DCA LUFLD /FOR POSSIBLE POST PROCESSING + TAD (WORD1-1/PREPARE TO STICK IN THE VALUE + DCA X11 +ENTERV, CDF + TAD I X11 /MOVE IN THE VALUE +FFLD2, CDF 10 + DCA I NEXT + ISZ N3SIZE /INCR SIZE COUNT + JMP ENTERV + CDF + JMP I LUKUP2 +STCHEK, 0 /CHECK FOR ENOUGH ROOM + TAD NEXT /CHECK FOR OVERFLOW + CIA CLL + CDF + TAD I STCHEK /THIS IS LIMIT + ISZ STCHEK + SZL CLA + JMP I STCHEK + TAD FREFLD /BUMP FREE FIELD + TAD (10 + DCA FREFLD + TAD FREFLD /PUT IN TWO PLACES + DCA FFLD2 + DCA NEXT /START POINTER AT 0 + ISZ NFLDS /GONE TOO FAR ? + JMP I STCHEK /NO +STOVER, JMS I QERMSG /S.T. FULL + 2324 + JMP I XABORT /ABORT COMPILATION +OLDN3, 0 /ADDR OF PREVIOUS ENTRY +NEWN3, 0 /ADDR OF NEW ENTRY +LTEMP, 0 +NFLDS, 0 /- COUNT OF AVAILABLE FIELDS +N3SIZE, /SIZE OF ENTRY +KBDCHK, 0 /CHECK FOR ^C OR ^O + KSF + JMP I KBDCHK /NO CHAR + KRB + AND (177 /REMOVE PARITY BIT + TAD (-3 /^C ?? + SNA + JMP I XABORT /YES, EXIT TO OS8 + TAD (3-17 /^O ?? + SZA CLA + JMP I KBDCHK /NO, RETURN + DCA TTX+1 /NOP TTY OUTPUT ROUTINE + JMP I KBDCHK +/ +WSTEP, -123;-124;-105;-120;0 + / SYMBOL TABLE LOOKUP + PAGE +LOOKUP, 0 /LOOK UP SYMBOL + TAD NAME1 /GET NAME1*11+NAME2 + CLL RTL + TAD NAME1 + CLL RAL + TAD NAME1 + TAD NAME2 + DCA NAME1 /THIS IS IT + TAD TYPE /WHAT KIND SYMBOL ? + CLL RTL /MOVE TYPE BITS + RTL /INTO AC 9,10,11 + TAD JTABLE + DCA .+1 +VCPTR, 0 /GO THERE +JTABLE, JMP I .+1 + LUVAR + LURETN + LUARAY + LURETN + LUSTRG + LURETN + LUSARY + LURETN +LUVAR, TAD (VARCNT /POINTER TO VAR COUNT + DCA VCPTR + TAD (VARST-13 +DOLU, TAD NAME1 + DCA STPTR /ST POINTER + CDF 10 /THATS WHERE ST IS + TAD I STPTR /IS THIS VAR DEFINED YET ? + SMA + JMP GOTSYM /YES + TAD (4401 /GET 401 INTO AC +CHEKST, CDF + TAD I VCPTR /PLUS VAR COUNT + CDF 10 + DCA SYMBOL /THATS THE NEW SYMBOL NUMBER + TAD SYMBOL /PUT SYMBOL NUMBER + DCA I STPTR /INTO S.T. ENTRY + CDF + ISZ I VCPTR /BUMP SYMBOL NUMBER +LURETN, JMP I LOOKUP + JMP STOVER /S.T. OVERFLOW +GOTSYM, DCA SYMBOL /PUT NUMBER INTO SYMBOL + CDF + JMP I LOOKUP +LUSTRG, TAD (SVCNT /POINTER TO STRING VAR COUNT + DCA VCPTR + TAD (SVARST-26 + TAD NAME1 /TWO WORDS PER ENTRY + JMP DOLU +LUARAY, TAD (ACNT /ARRAY VAR COUNT + DCA VCPTR + TAD (ARAYST /ARRAY SYMBOL TABLE + DCA STPTR + CDF 10 +FINDA, TAD I STPTR /SEARCH TABLE + SNA + JMP NEWARY /NEW ENTRY + CIA + TAD NAME1 /IS THIS IT ? + ISZ STPTR + SNA CLA + JMP GOTARY /YES + ISZ STPTR + ISZ STPTR + ISZ STPTR /GO TO NEXT ENTRY + JMP FINDA +GOTARY, TAD (37 /GET NUMBER + AND I STPTR + DCA SYMBOL /INTO SYMBOL + CDF + JMP I LOOKUP +NEWARY, TAD NAME1 /PUT IN NEW ENTRY + DCA I STPTR + ISZ STPTR + TAD (41 /PUT IN NUMBER + JMP CHEKST /GO DO THE REST +LUSARY, TAD (SACNT /STRING ARRAY COUNT + DCA VCPTR + TAD (SARYST /USE STRING ARRAY TABLE + JMP FINDA-2 /GO DO SEARCH + / FILE AND CLOSE PROCESSORS +FILE, JMS I QLODSN /OUTPUT STMT NUMBER + TAD (FOPENS /POINTER TO FILE OPENS + DCA FILESW + JMS I QCHECKC /LOOK FOR "V" + -126 + SKP /NOT V + ISZ FILESW /YUP, INCR FILESW + JMS I QCHECKC /LOOK FOR "N" + -116 + JMP .+3 + ISZ FILESW /INCR FILESW BY TWO IF "N" + ISZ FILESW + JMS GETFN /GET FILE NUMBER + JMS I QEXPR /GET DEVICE/FILE DESCRIPTOR + JMP I QREMARK + JMS I QLOAD /LOAD INTO SAC + TAD TYPE1 /TYPE MUST BE STRING + SPA CLA + JMP .+3 /IT WERE + JMS I QERMSG /IT WEREN'T + 0616 + TAD I FILESW /GET CORRECT OPEN + JMS I QOUTWRD + JMP I QNEWLIN +FOPENS, OPENAF;OPENAV;OPENNF;OPENNV +FILESW, 0 +PLUS, 40;0;XADD;XADD + / EXPRESSION ANALYZER + PAGE +EXPR, 0 /POLISHIZE EXPRESSION + DCA TEMP /SAVE LEFT + TAD LEFT /SO WE CAN PUSH OLD VALUE + JMS I QPUSH /OF IT + TAD TEMP /NOW SET NEW VALUE + DCA LEFT /OF THAT SWITCH + TAD EXPR + JMS I QPUSH /SAVE RETURN ADDR + JMS I QPUSH /MARK STACK + TAD LEFT /IS THIS LEFT SIDE ? + SPA CLA + JMP OPRAND+1/YES, NO UNARY MINUS +UNOPR, JMS I QGETC /LOOK FOR UNARY OPERATOR + JMP MISARG /THERE HAS TO BE AN OPERAND + TAD (-53 /UNARY+(NOP) + SNA + JMP UNOPR + TAD (53-55 /UNARY - + SZA + JMP NOTMIN /NOT UNARY MINUS + TAD (UMOPR /PUSH UNARY MINUS + JMS I QPUSH + JMP UNOPR +NOTMIN, TAD (55-50 /LOOK FOR ( + SZA CLA + JMP OPRAND /NOT A SUB EXPRESSION + JMS I QEXPR /COMPILE SUB EXPRESSION + JMP BADEXP /BAD SUB EXPRESSION + JMS I QCHECKC /LOOK FOR ) + -51 + SKP /ERROR + JMP OPR8R /GOTIT + JMS I QERMSG /PARENTHESIS MIS MATCH + 1520 + JMP BADEXP +OPRAND, JMS I QBACK1 /PUT BACK NON UNARY OP + JMS I QGETNAM /LOOK FOR VARIABLE REF + JMP NOTVAR /NOPE. + JMS I QLOOKUP /SYMBOL TABLE SEARCH + TAD SYMBOL /SAVE SYMBOL NUMBER + DCA TEMP2 /BECAUSE SAVAC MIGHT KILL IT + JMS I QSAVAC /GENERATE FSTA (MAYBE) + -3 + TAD TYPE /WAS THIS A FUNCTION OR ARRAY ? + AND (3000 + SZA + JMP FUNSS /YES, GO PROCESS IT + TAD TYPE /MAKE OPERAND STACK ENTRY + JMS I QPUSHO + TAD TEMP2 /FIRST TYPE THEN SYMBOL # + JMS I QPUSHO +OPR8R, TAD LEFT /LEFT SIDE ? + SMA CLA /YES, NO OPERATORS LEGAL + JMS I QGETC /LOOK FOR OPERATOR + JMP ENDEXP /END OF EXPR + TAD (-52 /** IS SPECIAL CASE + SZA + JMP NOSTAR /NOT * + JMS I QGETC /LOOK FOR SECOND * + JMP NOSTAR + TAD (-52 + SNA CLA + TAD (136-52 /** -> ^ + SNA + JMS I QBACK1 /PUT IT BACK +NOSTAR, TAD (52 /RESTORE CHAR + DCA TEMP + TAD (OPR8RS-1 + DCA X10 /PTR TO LIST +OPRLUP, TAD I X10 /GET OPERATOR PTR + SNA + JMP ENDEXP-3/END OF LIST + DCA NEWOP /SAVE IT IN CASE + TAD I X10 /COMPARE + TAD TEMP + SZA CLA + JMP OPRLUP /KEEP LOOKING +GOTOPR, JMS I QPOP /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 QPUSH /OLD < NEW + TAD NEWOP /GO PUSH BOTH + JMS I QPUSH + JMP UNOPR /GO LOOK FOR NEXT OPERAND +OUTOLD, TAD OLDOP /OUTPUT CODE FOR OLD OPR8R + JMS I QOUTOPR + JMP GOTOPR /LOOK AT NEXT TOP OF STACK + JMS I QBACK1 /PUT BACK NON OPERATOR + SKP + JMS I QOUTOPR /OUTPUT OPERATOR +ENDEXP, JMS I QPOP /LOOK FOR STACK MARK + SZA + JMP ENDEXP-1/NOT THIS + JMS I QPOP /GET RETURN ADDR + IAC + DCA TEMP + JMS I QPOP /GET LEFT SIDE SWITCH + DCA LEFT + JMP I TEMP /RETURN +MISARG, JMS I QERMSG /MISSING OPERAND + 1517 + JMP BADEXP +MINUS, 40;0;XISUB;XSUB +SLASH, 50;0;XIDIV;XDIV + / EXPRESSION ANALYZER (HANDLE SUBSCRIPTS) + PAGE +FUNSS, AND (1000 /IS IT FUN CALL ? + SNA CLA + JMP .+3 /NO + JMS I QSAVAC /YES, SAVE AC + -1 + TAD TYPE /SAVE TYPE + JMS I QPUSH + TAD TEMP2 /AND SYMBOL NUMBER + JMS I QPUSH + TAD STPTR /AND SYMBOL TABLE PTR + JMS I QPUSH + SKP +SSLOOP, JMS I QPOP /GET ARG/SS COUNT + IAC + JMS I QPUSH /INCREMENT IT + JMS I QEXPR /GET NEXT ARG/SS + JMP BADFSS + JMS I QGETA1 /IS THIS ARG(SS) AN ARRAY REF ? + CLL CML RTR + AND TYPE1 /CHECK THE TYPE + SNA CLA + JMP NOTSSD /NOT AN ARRAY REFERENCE + JMS I QLOADSS /LOAD THE SS REGS + JMS I QSAVAC /SAVE AC IF NEEDED + -1 + TAD TYPE1 /SET THE MODE + JMS I QMODSET + TAD (AFLDA /LOAD THIS ARG/SS + TAD SYMBL1 + JMS I QOUTWRD + TAD Q400 /SET THE IN-AC BIT + TAD MODE /WE JUST CALLED MODSET + DCA I OSTACK /CHANGE THIS STACK ENTRY + SKP +NOTSSD, ISZ OSTACK /FIX UP OSTACK + ISZ OSTACK + JMS I QCOMARP /LOOK FOR , OR ) + JMP BADFSS /NEITHER IS BAD + JMP SSLOOP /, MEANS MORE ARGS/SS + JMS I QPOP /GET # OF ARG/SS + DCA TEMP /GET ARG/SS COUNT + JMS I QPOP /RESTORE S.T. ADDR + DCA STPTR + JMS I QPOP + DCA SYMBOL /GET BACK THE SYMBOL # + JMS I QPOP + DCA TYPE /GET BACK THE TYPE + TAD TYPE /IS IT AN ARRAY OR FUN REF ? + AND (1000 + SZA CLA + JMP DOCALL /FUNCTION REFERENCE + TAD TEMP /MOVE SS COUNT + CLL RTR /INTO THE CORRECT + RTR /FIELD + DCA TEMP2 /AND SAVE IT + CDF 10 + TAD I STPTR /ANY PREV REFERENCE ? + AND (3000 + SZA + JMP NOTNEW /YES, GO CHECK NUMBERS + TAD TEMP2 /IF NONE, PUT IN NUMBER + TAD I STPTR + DCA I STPTR + JMP NDOK /THATS ALL +NOTNEW, CIA /COMPARE NUMBER OF SS + TAD TEMP2 /WITH ANY PREVIOUS + SZA CLA + JMP BADFSS+3/THEY DON'T MATCH +NDOK, CDF + TAD TYPE /PUT TYPE + TAD TEMP /AND DIM COUNT +ONSTAK, JMS I QPUSHO /ONTO ARGUMENT STACK + TAD SYMBOL + JMS I QPUSHO /AND SYMBOL NUMBER + JMS I QSAVAC /SAVE FIRST SS IF LEFT IN AC + -5 + JMP OPR8R /GO GET AN OPERATOR +BADFSS, TAD (-4 /PURGE STACK JUNK + TAD STACK + DCA STACK + JMS I QERMSG /PUT ERROR MESSAGE + 2323 +BADEXP, JMS I QPOP /LOOK FOR STACK MARK + SZA CLA + JMP BADEXP /NOT YET + JMS I QPOP /RETURN ADDR + DCA TEMP + JMS I QPOP /SS LOAD SWITCH + DCA LEFT + JMP I TEMP /TAKE ERROR EXIT +WTAB, -124;-101;-102;-50 +NOTVAR, TAD LEFT /LEFT SIDE ? + SPA CLA + JMP MISARG /YES, NO LITERALS LEGAL + JMS I QNUMBER /LOOK FOR LITERAL + JMP NOTNUM /NOT A NUMBER + JMS I QLUKUP2 /SEARCH LITERAL TABLE + LITRL + -3 + JMS NEWVAR /IF NEW, GIVE IT NUMBER + JMP ONSTAK /GO PUT IT ONTO THE STACK +NOTNUM, JMS I QSTRING /LOOK FOR STRING LITERAL + JMP MISARG /NO, MISSING ARG + TAD WORD1 /GET -NUMBER WORDS - 1 + IAC + CLL CML CMA RAR + DCA .+3 /FOR LOOKUP + JMS I QLUKUP2 /LOOK UP LITERAL + SLITRL + 0 + JMS NWSVAR /IF NEW, GIVE IT NUMBER + CLL CML RAR /SET TYPE BIT FOR STRING + JMP ONSTAK /PUT INFO ONTO STACK + +UPAROW, 60;1;EXPRTN-1 + / EXPRESSION ANALYZER (HANDLE FUNCTION CALLS) + PAGE +DOCALL, TAD LEFT /IS THIS LEFT SIDE ? + SMA CLA /IF YES, FUN ILLEGAL + JMS OUTCAL /GENERATE CALL + SKP /SKIP IF ERROR + JMP OPR8R /GO LOOK FOR OPERATOR + JMS I QERMSG /BAD FUNCTION REFERENCE + 0622 + JMP BADEXP +OUTCAL, 0 /GENERATE FUN CALL; TYPE, + /SYMBOL AND TEMP ARE INPUTS + TAD SYMBOL /SAVE FUNCTION NUMBER AROUND SAVAC + DCA FUNNUM + JMS I QSAVAC /SAVE SECOND FROM TOP + -3 + TAD FUNNUM /SETUP FOR FINDING FUNCTION + DCA WORD1 /INFO BLOCK + JMS I QLUKUP2 /ON THE FUNCTION LIST + FUNCTN + -1 + JMP I OUTCAL /UNDEFINED FUNCTION + TAD SYMBOL /CHECK NUMBER OF ARGS + TAD TEMP + SZA CLA + JMP I OUTCAL +MOVARG, JMS I QLOAD /GET TOP OF STACK INTO AC + JMS SETFLD /GET FIELD OF FORMAL-PARAMS + TAD I X10 /GET FIRST ONE + CDF + DCA TEMP + CLL CML RAR /COMPARE TYPE OF ARG + AND TYPE1 /WITH THAT OF FORMAL PARAMETER + TAD TEMP + SPA CLA /THEY MUST MATCH + JMP I OUTCAL /(THEY DON'T) + CLL CML RTR /SHOULD WE LEAVE IT IN THE AC ? + AND TEMP + SZA CLA + JMP OKINAC /YES, SAVES AN INSTRUCTION + TAD TYPE1 /SET MODE + JMS I QMODSET /APPROPRIATELY + CLL CMA RAR /3777 + AND TEMP /GET SYM NUMBER + TAD (FSTA /STORE VALUE IN FORM PARAM + JMS I QOUTWRD +OKINAC, ISZ SYMBOL /MORE ARGS ? + JMP MOVARG + JMS SETFLD + TAD I X10 /GET TYPE OF FUNCTION + DCA TYPE1 /(ITS RESULT THAT IS) + CDF + TAD TYPE /IS TYPE OF FUNCTION + TAD TYPE1 /SAME AS TYPE OF CALL + SPA CLA + JMP I OUTCAL /NO, ERROR + JMS I QMODSET /ALL CALLS IN N MODE + TAD WORD1 /CHECK FOR USER FUNCTION + SMA + JMP CALLUF /YES, DO SPECIAL CALL +FINCAL, ISZ OUTCAL /FIX RETURN + JMS I QOUTWRD /OUTPUT CODE + TAD Q400 /SET TOP OF STACK + TAD TYPE1 + DCA I OSTACK /TO AC + DCA I OSTACK /SYMBOL NUMBER IS MEANINGLESS + CLL CML RAR + AND TYPE1 /INTERPRETER MODE SAME + DCA MODE /AS FUNCTION TYPE + JMP I OUTCAL /ON RETURN +CALLUF, JMS I QNOREGS /FORGET REGS ON USER FUNC + TAD LUFLD /OUTPUT JSUB + AND (70 /WITH POINTER TO + CLL RTL /DOUBLE WORD + TAD (JSUB /VALUE OF LOCATION + JMS I QOUTWRD /COUNTER FOR THE + TAD X10 /START OF THE + IAC /USER "DEF"INED FUNC + JMP FINCAL +FSUB1, 0 /FOR SUBROUTINE #1 + JMS I QEXPR /GET AN EXPRESSION + JMP BADFOR + JMS I QLOAD /LOAD VALUE + TAD TYPE1 /MUST BE NUMERIC + SMA CLA + JMP I FSUB1 /OK +BADFOR, JMS I QERMSG /BAD FOR LOOP PARAMETERS + 0620 + JMP I QREMARK +FSUB2, 0 /FOR SUBROUTINE #2 + JMS FSUB1 /GET EXPR AND LOAD IT + JMS GENTMP /MAKE A TEMP FOR IT + TAD SYMBOL /STORE EXPR IN TEMP + TAD (FSTA + JMS I QOUTWRD + TAD SYMBOL /RETURN SLOT # + JMP I FSUB2 +FUNNUM, +NOREGS, 0 /FORGET REGISTORS + CLA IAC /FILE NUMBER REG + DCA IFNREG +/ CMA /SUBSCRIPT REG #1 +/ DCA SSREG1 +/ CMA /SUBSCRIPT REG #2 +/ DCA SSREG2 + JMP I NOREGS +CLOSE, JMS I QLODSN /OUTPUT STMT NUMBER + CLA IAC /NO COLON NEEDED AFTER FILE NUM + JMS GETFN /GET FILE NUM + TAD (CLOSEF /OUTPUT CLOSE + JMS I QOUTWRD + JMP I QNEWLIN +PSETJF, 0 + TAD (SETJF + JMS I QOUTWRD + JMS I QPOP /GET INDEX VAR + DCA FINDEX + JMP I PSETJF +DIMREAD,JMS I QLOADSS /PATCH TO INPUT PROC. SET UP SS REG + TAD (READ /OUTPUT INSTR + JMS I QOUTWRD + TAD (AFSTA + JMP I (FININP /RESUME IN LINE + / CODE GENERATOR + PAGE +OUTOPR, 0 /OUTPUT CODE FOR OPERATOR + DCA X10 /SAVE POINTER TO SKELETON + TAD I X10 /GET CONTROL WORD + SMA SZA + JMP SPCIAL /TREAT AS SPECIAL CASE + DCA TYPE /ITS THE TYPE ALLOWANCE + TAD (XLOAD /GET SKEL ADDRS + DCA CASEMM /FOR THE THREE CASES + TAD I X10 + DCA CASEMA + TAD I X10 + DCA CASEAM + TAD TYPE /ENTER CORRECT MODE + JMS I QMODSET + CLL CMA RAL /GET THE SECOND OPERAND + TAD OSTACK + DCA OSTACK + TAD OSTACK + DCA X10 /BY BACKING UP THE STACK + TAD I X10 /TYPE + DCA TYPE2 + TAD I X10 + DCA SYMBL2 /SYMBOL NUMBER + TAD TYPE2 + AND (3 + DCA TEMP /SS COUNT + TAD TYPE2 /LOOK AT OPERAND 2 + AND Q400 + SZA CLA + JMP MAC /MUST BE CASE M,AC + CLL CML RTR /ITS IN MEMORY, IS IT SS'D + AND TYPE2 + SNA CLA + JMP A2OK /NO, ITS SCALAR + JMS I QLOADSS /LOAD NECESSARY SS REGS + ISZ CASEMM /FIXUP THE SKELETON POINTERS + ISZ CASEAM +A2OK, JMS GETA1 /GET STUF FOR ARG1 + TAD TYPE1 /LOOK AT IT + AND Q400 + SZA CLA + JMP ACM /ITS CASE AC,M +MM, TAD I CASEMM /ITS CASE M,M LOAD OPERAND 2 + TAD SYMBL2 + JMS I QOUTWRD + SKP +MAC, JMS GETA1 /GET STUF FRO ARG1 + CLL CML RTR /IS IT SS'D ? + AND TYPE1 + SNA CLA + JMP A1OK /NO, ITS SCALAR + JMS I QLOADSS /LOAD THE SS REGS + ISZ CASEMA /BUMP SKELETON ADDR +A1OK, TAD I CASEMA /GET CORRECT INSTRUCTION + TAD SYMBL1 /PLUS SYMBOL NUMBER +TYPCHK, JMS I QOUTWRD /OUTPUT IT + CLL CML RAR /TYPES OF OPERANDS MUST MATCH + AND TYPE1 + TAD TYPE2 + SPA CLA + JMP MIXED /THEY DON'T + TAD TYPE /TYPE OF OPERATOR + TAD TYPE1 /MUST MATCH + SPA CLA /THAT OF OPERANDS + JMP MIXED /THEY DON'T + TAD Q400 /GENERATE STACK ENTRY + TAD TYPE + DCA I OSTACK + DCA I OSTACK /THIS IS SAFE + JMP I OUTOPR +ACM, TAD I CASEAM /ITS CASE AC,M + TAD SYMBL2 /GEN OPERATION FOR OPERAND 2 + JMP TYPCHK /GO FINISH IT UP +MIXED, JMS I QERMSG /MIXED TYPES + 1524 + JMP I OUTOPR +SPCIAL, TAD I X10 /GET ADDR OF SPECIAL RTNE + DCA TEMP /(PLUS 1 FROM THE TYPE WORD) + JMP I TEMP /HANDLE SPECIAL CASE +GETA1, 0 /GET STUFF FOR ARG 1 + CLL CMA RAL /BACK UP STACK + TAD OSTACK + DCA OSTACK + TAD OSTACK + DCA X11 + TAD I X11 /GET TYPE1 + DCA TYPE1 + TAD I X11 /GET SYMBL1 + DCA SYMBL1 + TAD TYPE1 /GET SS COUNT + AND (3 + DCA TEMP + JMP I GETA1 +UMRTNE, JMS I QSAVAC /SAVE CURRENT AC IF NEEDED + -3 + JMS I QLOAD /GET ARG IN AC + DCA TYPE /TYPE MUST BE NUMERIC + DCA TYPE2 + TAD (FNEG /DO NEGATE + JMP TYPCHK +EXPRTN, DCA TYPE /SET FUNC TYPE + CLL CML RTL /SET NUMBER OF ARGS + DCA TEMP + TAD (FUNC1+60 + DCA SYMBOL /EXP2 + JMS OUTCAL /OUTPUT FUNCTION CALL + JMP MIXED /ERROR + JMP I OUTOPR /DONE +CASEMA, 0 +CASEMM, 0 +CASEAM, 0 +TYPE2, 0 +SYMBL2, 0 +RETURN, JMS I QLODSN /OUTPUT STMT NUM LOAD + JMS I QMODSET /ALWAYS RETURN IN N MODE + TAD (RET-RNDO +RANDOM, TAD (RNDO-STOP +STOPX, TAD (STOP /RETURN, RANDOMIZE, OR STOP + JMS I QOUTWRD + JMP I QNEWLIN + / LETTER AND DIGIT SCANNERS + PAGE +LETTER, 0 /SKIP ON LETTER + JMS I QGETC + JMP I LETTER /NO LETTER + TAD (-133 /MUST BE .LT. 133 + SMA + JMP NOLETR + TAD (133-100/MUST BE .GT. 100 + SPA + JMP NOLETR + AND (77 /RESTORE 6 BITS + ISZ LETTER /BUMP RETURN ADDR + JMP I LETTER +NOLETR, JMS I QBACK1 /PUT CHAR BACK + JMP I LETTER +DIGIT, 0 /SKIP ON DIGIT + JMS I QGETC + JMP I DIGIT /NO DIGIT + TAD (-72 /MUST BE .LT. 72 +O7100, CLL /(USED AS LITERAL BY "TTY") + TAD (72-60 /MUST BE .GE. 60 + SNL + JMP NODIGT /NOPE + ISZ DIGIT /RETURN DIGIT MINUS 60 + JMP I DIGIT +NODIGT, JMS I QBACK1 /PUT IT BACK + JMP I DIGIT + / STATEMENT NUMBER GETTER +SNUM, 0 /GET A STATEMENT NUMBER + DCA TEMP /SAVE DEFINED SWITCH + JMS I QDIGIT /GET FIRST DIGIT + JMP I SNUM /NO STATEMENT NUMBER + DCA WORD2 /THIS WILL BE THE BUCKET + TAD WORD2 + CLL RAL /TWO WORDS PER BUCKET + TAD (SNUMS + DCA BUCKET + ISZ SNUM /OK, ITS A STMT NUMBER + TAD (-4 /FIVE DIGITS MAX + DCA TEMP2 + DCA WORD1 /CLEAR TOP WORD +SNLOOP, JMS I QDIGIT /GET NEXT DIGIT + JMP GOTSN /END OF NUMBER + DCA WORD3 /SAVE IT + TAD (-4 /SET SHIFT COUNT + DCA ACO +SHIFT, TAD WORD2 /SHIFT LEFT ONE BIT + CLL RAL + DCA WORD2 + TAD WORD1 + RAL + DCA WORD1 + ISZ ACO /BUMP SHIFT COUNTER + JMP SHIFT + TAD WORD2 /PUT IN NEW DIGIT + TAD WORD3 + DCA WORD2 + ISZ TEMP2 /BUMP DIGIT COUNT + JMP SNLOOP +GOTSN, JMS I QLUKUP2 /FIND STMT NUMBER +BUCKET, 0 + -2 + JMP NEWSN /ITS A NEW STMT NUM + CLL CML RAR /CHECK FOR MULTIPLY DEFINED + AND SYMBOL + AND TEMP + SZA CLA + JMP MDLABL /YES, IT IS + TAD X10 /GET ADDR OF LABEL VALUE + DCA TEMP2 + JMS SETFLD /GET TO FIELD OF ENTRY + TAD TEMP /OR IN THESE BITS + TAD SYMBOL + DCA I TEMP2 +FINSN, CDF + TAD LUFLD /GET FIELD BITS + AND (70 + CLL RTL + DCA TEMP /INTO A CONVIENIENT + JMP I SNUM /PLACE +NEWSN, JMS SETFLD /GET FIELD + TAD TEMP /PUT IN BITS + DCA I NEXT + TAD NEXT /SAVE N3 ADDR + DCA TEMP2 + DCA I NEXT /1 EXTRA WORD + JMP FINSN +MDLABL, JMS I QERMSG /MULTIPLY DEFINED + 1504 /LABEL + JMP I SNUM +TTY, 0 /CONVERT TO ASCII AND PRINT + AND (77 /SIX BITS ONLY + TAD (-40 /WHAT SIDE OF FORTY ? + SPA + TAD O7100 /LOW SIDE + TAD (240 /HIGH SIDE + JMS TTX /PRINT CHAR + JMP I TTY /RETURN +TTX, 0 /PRINT CHAR ON TTY + SKP /(CONTROL O ZEROES THIS WORD) + JMP .+4 /(THUS KILLING ERROR REPORTING) + TSF + JMP .-1 + TLS + CLA + JMP I TTX + / CHAIN PROCESSOR +CHAIN, JMS I QLODSN /OUTPUT STMT NUMBER + JMS I QEXPR /GET CHAIN STRING + JMP I QREMARK + JMS I QLOAD /INTO SAC + TAD TYPE1 /TYPE MUST BE STRING + SMA CLA + JMS I QERMSG /IT WASN'T + 0616 /(OK IF ERROR CODE IS NOP) + TAD (CHN /OUTPUT CHAIN OPCODE + JMS I QOUTWRD + JMP I QNEWLIN +XISUB, FISUB;AISUB + / SEVERAL SHORT UTILITY ROUTINES + PAGE +BACK1, 0 /BACK UP ONE CHAR + CLA CMA + TAD NCHARS + DCA NCHARS + CLA CMA + TAD CHRPTR + DCA CHRPTR + JMP I BACK1 +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 + DCA NCSAVE + TAD CHRPTR + DCA CPSAVE + JMP I SAVECP +RESTCP, 0 /RESTORE CHAR POS + TAD CPSAVE + DCA CHRPTR + TAD NCSAVE + DCA NCHARS + JMP I RESTCP +GETC, 0 /GET A CHARACTER (IGNORING BLANKS) + ISZ NCHARS + JMP .+4 + CLA CMA + DCA NCHARS + JMP I GETC + TAD I CHRPTR + TAD (-40 /IS IT A BLANK + SNA + JMP GETC+1 /YES IGNORE IT + TAD (40 /FIX CHAR + ISZ GETC + JMP I GETC +POP, 0 /GET TOP OF STACK + TAD STACK + DCA PUSH + CLA CMA + TAD STACK + DCA STACK /DECREMENT STACK POINTER + TAD I PUSH + JMP I POP +PUSH, 0 /PUT AC ONTO STACK + DCA I STACK /STORE + TAD (-STACKA-STAKSZ+1 + TAD STACK /CHECK FOR OVERFLOW + SPA CLA + JMP I PUSH /OK, RETURN +STKOVR, JMS I QERMSG + 2004 + JMP I XABORT /ABORT COMPILATION +PUSHO, 0 /PUSH OPERAND STACK + DCA I OSTACK /PUSHIT + TAD (-STACKO-STOKSZ+1 + TAD OSTACK /CHECK FOR STACK OVERFLOW + SPA CLA + JMP I PUSHO + JMP STKOVR /TOO FULL +COMARP, 0 /SKIP ON COMA OR RITE PAREN + JMS I QGETC /GET CHAR + JMP I COMARP + TAD (-51 + SNA + ISZ COMARP /RITE PAREN, SKIP 2 + SZA + TAD (51-54 /CHECK FOR , + SNA + ISZ COMARP /, SKIP 1 + SZA CLA + JMS I QBACK1 /NEITHER PUT BACK + JMP I COMARP +LOAD, 0 /LOAD SAC OR FAC + JMS I QGETA1 /GET TOP OF STACK + TAD TYPE1 /SET MODE + JMS I QMODSET + TAD TYPE1 /IS IT IN THE AC? + AND Q400 + SZA CLA + JMP I LOAD /YUP + CLL CML RTR /SUBSCRIPTED ? + AND TYPE1 + SNA CLA + JMP .+3 /NO + JMS I QLOADSS /FILL SS REGS + TAD (AFLDA-FLDA + TAD (FLDA /ARRAY OR SCALAR LOAD + TAD SYMBL1 /PLUS SYMBOL NUMBER + JMS I QOUTWRD + JMP I LOAD +IFOPS, JNE;-7476 /<> + JNE;-7674 />< + JGE;-7576 /=> + JGE;-7675 />= + JLE;-7574 /=< + JLE;-7475 /<= + 0 + JEQ;-7500 /= + JGT;-7600 /> + JLT;-7400 /< + 0 +NCSAVE, 0 +CPSAVE, 0 + / TEMP GENERATORS AND AC SAVING ROUTINES + PAGE +GENTMP, 0 /GENERATE A TEMP + SZA CLA + JMP STRTMP /ITS A STRING TEMP + TAD TMPCNT + ISZ TMPCNT /BUMP COUNT + DCA NAME1 + JMS I QLUKUP2 /LOOK UP THIS TEMP + TEMPS + -1 + JMS NEWVAR /NEW ONE ON ME + JMP I GENTMP +STRTMP, TAD STMPCT + ISZ STMPCT /BUMP COUNT + DCA NAME1 + JMS I QLUKUP2 /LOOK UP THIS TEMP + STEMPS + -1 + JMS NWSVAR /NEW STRING TEMP + JMP I GENTMP +NEWVAR, 0 /MAKE SYM NUM FOR VAR + TAD VARCNT /PUT SYM NUM + TAD (401 + DCA SYMBOL /INTO SYMBOL + TAD SYMBOL /AND INTO ST ENTRY + JMS SETFLD + DCA I NEXT + CDF + ISZ VARCNT /BUMP COUNT + JMP I NEWVAR /RETURN WITH SYM NUM + JMP STOVER /S.T. OVERFLOW +NWSVAR, 0 /MAKE SYM NUM FOR VAR$ + TAD SVCNT /PUT SYM NUM + TAD (401 + DCA SYMBOL + TAD SYMBOL /INTO SYMBOL AND + JMS SETFLD + DCA I NEXT /S.T. ENTRY + CDF + ISZ SVCNT /OVERFLOW ? + JMP I NWSVAR /NO, WE'RE OK + JMP STOVER +SAVAC, 0 /SAVE FAC (OR SAC) IF NECESSARY + TAD I SAVAC /GET ENTRY POINTER + TAD OSTACK + ISZ SAVAC + DCA SVTEMP /ADDR OF TYPE WORD + TAD I SVTEMP /LOOK AT IT + AND Q400 + SNA CLA + JMP I SAVAC /NOT IN AC + CLL CML RAR /SAVE STRING BIT ONLY + AND I SVTEMP /OF TYPE WORD + DCA I SVTEMP + TAD I SVTEMP + JMS GENTMP /GENERATE TEMP + TAD I SVTEMP + JMS I QMODSET /SET MODE + TAD XSTOR + TAD SYMBOL /GENERATE STORE + JMS I QOUTWRD + TAD SYMBOL /RETURN S.T. NUMBER + ISZ SVTEMP /MOVE TO SYMBOL NUM WORD + DCA I SVTEMP /SAVE THE TEMP NUM THERE + JMP I SAVAC /RETURN WITH SAVE MADE +SVTEMP, 0 +XSTOR, FSTA;AFSTA + / SUBSCRIPT REGISTER LOADING ROUTINE +LOADSS, 0 /LOAD SS REGS + CLL CMA RAL /LOOK AT NUMBER OF SS + TAD TEMP + SNA CLA + JMP LODSS2 /2 SS + SNL + JMP TOOMNY /MORE THAN 2 + JMS SSLOAD /LOAD SS REG 1 + JMP I LOADSS +LODSS2, CLA IAC + JMS SSLOAD /LOAD SS REG 2 + JMS SSLOAD /NOW SS REG 1 + JMP I LOADSS +SSTYPE, +TOOMNY, JMS I QERMSG /SUBSCRIPTING ERROR + 2323 + JMP I LOADSS +SSLOAD, 0 /LOAD A SS REG FROM TOP OF STACK + DCA TEMP2 /SS REG 1 OR 2 SWITCH + CLL CMA RAL /BACK UP ONE ENTRY + TAD OSTACK /ON THE OPERAND STACK + DCA OSTACK + TAD OSTACK + DCA X11 /USE X11 TO GET STUFF + TAD I X11 /GET TYPE WORD + SPA + JMP SSTYPE /SS MUST BE A NUMBER + AND Q400 /GET AC BIT + SZA CLA + JMP SSINAC /ITS IN THE AC + TAD TEMP2 + SZA CLA + TAD (LSS2-LSS1 + TAD (LSS1 /LOAD REG 1 OR 2 ?? + TAD I X11 /ANYHOW, THIS IS THE SOURCE + JMS I QOUTWRD /OUTPUT THE CODE + JMP I SSLOAD +SSINAC, TAD TEMP2 + TAD (LSS1AC /NOTE: LSS2AC=LSS1AC+1 + JMS I QOUTWRD /SO OUTPUT ONE OF THEM + JMP I SSLOAD +/ +XSCOMP, SCOMP;SACOMP +XDIV, FDIV;AFDIV +/ +PATCH6, 0 + ISZ SIGDIG + JMP I PATCH6 + CMA + DCA SIGDIG + JMP CONVLP +/ +STAR, 50;0;XMUL;XMUL + / NUMERIC CONVERSION ROUTINE (PART ONE) + PAGE +NUMBER, 0 /GENERAL NUMBER CONVERSION ROUTINE + DCA DECPT /ZERO DECIMAL POINT SWITCH + DCA WORD1 /ZERO FAC + DCA WORD2 + DCA WORD3 + DCA ACO + DCA SIGN /CLEAR SIGN SWITCH + TAD NUMDIG + DCA SIGDIG + JMS I QGETC /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 QDIGIT /GET A DIGIT + JMP TRYDEC /IS THERE A DECIMAL POINT ? + DCA NXTDGT /SAVE THE DIGIT + JMS PATCH6 + ISZ NDIGIT /INCR NUMBER OF DIGITS + TAD WORD2 /PREPARE TO MULT BY 10 + DCA OP2 + TAD WORD3 + DCA OP3 + 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 + 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 QGETC /LOOK FOR . + JMP DIGTST /SEE IF THERE WAS ANYTHING + TAD (-56 + SZA CLA + JMP TRYE1 /TRY FOR E + ISZ DECPT /SET DECIMAL POINT SW + JMP CONVLP-1/LOOP FOR OTHER DIGITS +TRYE1, JMS I QBACK1 /PUT BACK NON . +DIGTST, TAD NDIGIT /ANY DIGITS YET ? + SNA CLA + JMP I NUMBER /NO, NO NUMBER +TRYE2, JMS I QGETC /LOOK FOR E + JMP NOEXP+1 /GO HANDLE EXPONENT + TAD WSTEP+2 /USE PART OF "STEP" LITERAL + SZA CLA + JMP NOEXP /NO EXPONENT +GETEXP, DCA ESIGN /ZERO EXPONENT SIGN SWITCH + JMS I QGETC /GET A CHAR + JMP NOEXP /TREAT AS NO EXPONENT + JMS 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 NOEXP+2 + TAD EXPON /COMPLEMENT EXPONENT + CIA + SKP +NOEXP, JMS I QBACK1 /PUT BACK NON E + DCA EXPON /ZERO EXPONENT + TAD (43 /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 + DCA X11 /POWERS OF TEN TABLE +EXPMUL, TAD EXPON /LOOK AT THE EXPONENT + SNA + JMP DOSIGN /IF 0 ITS THRU + CLL RAR + DCA EXPON /PUT LOWEST BIT INTO LINK + SNL + JMP SKPEXP /THIS ONE DOESN'T COUNT + TAD I X11 /MOVE FACTOR INTO OPERAND + DCA OP1 + TAD I X11 + DCA OP2 + TAD I X11 + DCA OP3 + TAD I X11 + DCA OPO + JMS I FPRTNE /MULTIPLY OR DIVIDE BY THIS FACTOR + JMP EXPMUL /CHECK NEXT BIT +SKPEXP, TAD X11 /SKIP OVER THIS FACTOR + TAD (4 + JMP EXPMUL-1 +DOSIGN, TAD SIGN /CHECK THE SIGN + SZA CLA + JMS I (NEGFAC /NEGATE IF NEGATIVE + ISZ NUMBER /BUMP RETURN + JMP I NUMBER /RETURN +NXTDGT, 0 + +/INPUT DEVICE HANDLER + *INDEVH + 0 + /INITIALIZATION CODE FOR RUN CASE + PAGE +RUNNED, CIF 10 /COME HERE IF .R BCOMP + JMS I (200 /CALL COMMAND DECODER + 5 + 0201 /ASSUMED EXTENSION "BA" + CDF 10 + TAD I (7644 /TEST FOR /V + CDF + AND (4 + SZA CLA + JMS VERNUM + TAD (INFO-1 + DCA X10 + CDF 10 + TAD 7617 + CDF + SNA CLA /NULL INPUT? + JMP RUNNED /YES: NAUGHTY + TAD 7777 + CLL RAL /BATCH RUNNING + SPA CLA + JMP SAVBOS /YES + CDF 10 + JMP FINDSV-2 +SAVBOS, TAD (INFO-5 + DCA X10 + TAD 7777 + AND (70 + TAD CDFZRO + DCA .+1 /CDF TO BATCH FIELD + CDF 10 + TAD I BOSCTR + CDF 10 + DCA I X10 /SAVE BOS WRDS IN INFO AREA + ISZ BOSCTR + JMP .-5 + DCA I X10 /ZERO EDITOR BLOCK NUMBER + CDF +FINDSV, TAD I X11 /LOOKUP SOME SAVE FILES + SNA + JMP LUBUF /GO LOOK FOR BASIC.UF + DCA XXXXSV /SAVE POINTER TO NAME + CLA IAC /THEY'RE ON SYS + CIF 10 + JMS I (200 + 2 +XXXXSV, 0 + 0 + JMP NG /ERROR + TAD XXXXSV /GET STARTING BLOCK + IAC /PLUS 1 + CDF 10 + DCA I X10 /INTO INFO AREA +CDFZRO, CDF + JMP FINDSV /LOOP +LUBUF, CLA IAC + CIF 10 + JMS I (200 /LOOKUP BASIC.UF + 2 + BUFN /(USER DEFINED FUNCTIONS) + 0 + JMP .+3 /OK IF NOT THERE + TAD .-3 /GET STARTING BLOCK +1 + IAC + CDF 10 + DCA I X10 /INTO INFO BLOCK +STRT3, CDF + CLA IAC /ENTER TEMPORARY FILE + CIF 10 + JMS I (200 + 3 +TMPBLK, TMPFIL + 0 + JMP NG + TAD TMPBLK /SAVE START OF TEMP FILE + DCA OUBLOK + TAD TMPBLK /IN A COUPLE PLACES + DCA BLOCK + TAD TMPBLK+1/ALSO THE SIZE + DCA OUSIZE + JMP GETDEV /GO FETCH DEVICE HANDLER +BOSCTR, 7774 +VERNUM, 0 + TAD (VTEXT + DCA TEMP + TAD (-5 + DCA TEMP2 + TLS +MOREV, TAD I TEMP + CLL RTR + RTR + RTR + JMS TTY + TAD I TEMP + JMS TTY + ISZ TEMP + ISZ TEMP2 + JMP MOREV + TAD (215 + JMS TTX + TAD (212 + JMS TTX + TSF /WAIT FOR TTY TO GET DONE + JMP .-1 /BEFORE RETURNING + JMP I VERNUM +/ +VTEXT, TEXT /BCOMP V/ + *.-1 +VERLOC, VERSON^100+6001 + 0 + / NUMERIC CONVERSION ROUTINE (PART TWO) + 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 (-30 /SET ITERATION COUNTER + DCA ITRCNT + DCA WORD2 /ZERO FAC MANTISSA + DCA WORD3 + DCA ACO +MULLUP, JMS I (AR1 /SHIFT FAC RIGHT ONE + TAD TW2 /SHIFT MULTIPLIER RIGHT + CLL RAR + DCA TW2 + TAD TW3 + RAR + DCA TW3 + SZL + JMS OADD /ADD IF LINK IS ONE + ISZ ITRCNT /BUMP COUNT + JMP MULLUP /LOOP + TAD OP1 /PUT IN CORRECT EXPONENT + DCA WORD1 + JMS ANORM /NORMALIZE THE RESULT + JMP I FPMUL +D2, +TW2, 0 +D3, +TW3, 0 +NFCNT, +ANORM, 0 /NORMALIZE FAC + TAD WORD2 /IS MANTISSA 0 ? + SNA + TAD WORD3 + 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 CRAP + TAD WORD3 /YES, IS THE REST 0 ? + 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 + CLL CMA RTL /THREE 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 +FPDIV, 0 + JMS I (AR1 /UNNORMALIZE AC BY ONE + TAD OP1 /COMPUTE FINAL EXPONENT + CIA + TAD WORD1 + DCA OP1 /AND SAVE IT + TAD (-30 /SET ITERATION COUNTER + DCA ITRCNT + TAD WORD2 + RAL /INITIALIZE LINK +FPDVLP, CLA RAR /COMPARE SIGNS + TAD OP2 + SPA CLA + JMP .+3 + TAD (OPO-ACO/NEGATE OPERAND + JMS NEGFAC + JMS OADD /ADD OPERAND AND FAC + TAD D3 + RAL + DCA D3 + TAD D2 + RAL + DCA D2 + JMS I (AL1 /LEFT SHIFT FAC ONE + ISZ ITRCNT /TEST ITERATION COUNT + JMP FPDVLP + TAD OP1 /PUT QUOTIENT INTO FAC + DCA WORD1 + TAD D2 + DCA WORD2 + TAD D3 + DCA WORD3 + DCA ACO + JMS ANORM /NORMALIZE + JMP I FPDIV +OADD, 0 /ADD OPERAND TO FAC + CLL + TAD OPO + TAD ACO + DCA ACO + RAL + TAD OP3 + TAD WORD3 + DCA WORD3 + RAL + TAD OP2 + TAD WORD2 + DCA WORD2 + JMP I OADD +ITRCNT, 0 + / NUMERIC CONVERSION ROUTINE (FINALE) + PAGE +SMLNUM, 0 /INPUT A NUMBER <= 4095 +EXPLUP, DCA EXPON /ZERO THE EXPONENT + JMS I QDIGIT /GET THE NEXT DIGIT + JMP I SMLNUM /NUMBER DONE + 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 +AR1, 0 /SHIFT FAC RIGHT 1 BIT + TAD WORD2 + CLL RAR + DCA WORD2 + TAD WORD3 + RAR + DCA WORD3 + TAD ACO + RAR + DCA ACO + ISZ WORD1 + JMP I AR1 + JMP I AR1 +AL1, 0 /SHIFT FAC LEFT ONE + TAD ACO + CLL RAL + DCA ACO + TAD WORD3 + RAL + DCA WORD3 + TAD WORD2 + RAL + DCA WORD2 + JMP I AL1 +CHKSGN, 0 /CHECK FOR SIGN + TAD (-55 /IS IT - ? + SNA + ISZ I CHKSGN /YES, SET SWITCH + SZA + TAD (55-53 /IS IT + ? + SZA CLA + JMS I QBACK1 /RETURN CHAR OTHERWISE + JMP I CHKSGN + / STRING LITERAL SCANNER +STRING, 0 /LOOK FOR A STRING + JMS I QCHECKC /LOOK FOR " +M42, -42 + JMP I STRING /NONE MEANS NO STRING + ISZ STRING + DCA WORD1 /ZERO CHAR COUNT + TAD (WORD2 /SETUP POINTER + DCA TEMP + TAD (-STRLIM%2 /AND MAX SIZE + DCA TEMP2 +SLOOP, JMS GCS /GET HIGH ORDER CHAR + JMP I STRING /END OF STRING + CLL RTL + RTL + RTL + DCA I TEMP /PUT INTO UPPER HALF OF WORD + JMS GCS /GET LOWER CHAR + JMP PUT40 /FILL LAST WORD WITH BLANK + TAD I TEMP /COMBINE THEM + DCA I TEMP + ISZ TEMP /BUMP POINTER + ISZ TEMP2 /TOO BIG YET ? + JMP SLOOP /NO, LOOP + JMS I QGETC /MAX SIZE STRING, MUST FIND " + JMP STRGER /BAD STRING LITERAL + TAD M42 + SNA CLA + JMP I STRING /OK +STRGER, JMS I QERMSG /STRING ERROR + 2123 + JMP I STRING +PUT40, TAD I TEMP /GET LAST WORD + TAD (40 /PUT BLANK IN LOW CHAR + DCA I TEMP /STORE NEW WORD + JMP I STRING /RETURN +GCS, 0 /GET A CHAR FOR STRING + JMS I QGETCWB /GET A CHAR (INCLUDE BLANKS) + JMP STRGER /BAD + TAD M42 /IS IT " + SZA + JMP NOTQOT /NO + JMS I QGETCWB /IS IT "" + JMP I GCS /NO, THAT WAS IT + TAD M42 /LOOK FOR SECOND " + SNA CLA + JMP NOTQOT /"" BECOMES " + JMS I QBACK1 /PUT IT BACK + JMP I GCS /LITERAL IS DONE +NOTQOT, TAD (42 /RECREATE CHAR + AND (77 /ELIMINATE EXTRA BITS + ISZ WORD1 /BUMP STRING COUNT + ISZ GCS /FIX RETURN + JMP I GCS +MODSET, 0 /SET INTERPRETER MODE + TAD MODE /SUM OF DESIRED AND CURRENT + SMA CLA + JMP I MODSET /THEY WERE THE SAME + TAD MODE /OTHERWISE SWITCH MODES + SZA CLA + TAD (NMODE-SMODE + TAD (SMODE /ENTER NMODE OR MAYBE SMODE + JMS I QOUTWRD + CLL CML RAR + TAD MODE /CHANGE THE SWITCH + DCA MODE + JMP I MODSET /AND RETURN +XIDIV, FIDIV;AIDIV +WPNT, -120;-116;-124;-50;0 + / VARIABLE OR FUNCTION REFERENCE SCANNER + PAGE +GETNAM, 0 /LOOK FOR VARIABLE OR FUNCT REFNCE + DCA TYPE /ZERO TYPE + JMS I QLETTER /MUST START WITH LETTER + JMP I GETNAM /NO NAME + DCA NAME1 + JMS I QDIGIT / ? + JMP TRYFUN /NO, LOOK FOR FUN REF + IAC /INCREMENT DIGIT +LFDOLR, DCA NAME2 /STORE AS NAME2 + JMS I QGETC /LOOK FOR $ (STRING) + JMP GOTNAM+2/NOT THERE + TAD (-44 + SZA + JMP NOSTRG /NO $ MEANS NO STRING + CLL CML RAR /SET STRING BIT + TAD TYPE + DCA TYPE + JMS I QGETC /LOOK FOR ( (ARRAY) + JMP GOTNAM+2/NAME FINI + TAD (-44 /PRIME THE CHAR +NOSTRG, TAD (44-50 /LOOK FOR ( (ARRAY) + SNA CLA + CLL CML RTR /YES, SET ARRAY BIT + SNA + JMS I QBACK1 /NO, BACKUP 1 CHAR +GOTNAM, TAD TYPE /MODIFY TYPE + DCA TYPE + ISZ GETNAM /BUMP RETURN + JMP I GETNAM +TRYFUN, JMS I QSAVECP /SAVE CHAR POSITION + TAD NAME1 /MOVE FIRST CHAR OVER + CLL RTL + RTL + RTL + DCA NAME2 + JMS I QLETTER /LOOK FOR SECOND LETTER + JMP LFDOLR /NONE THERE, LOOK FOR $ + TAD NAME2 /COMBINE WITH FIRST LETTER + DCA NAME2 + JMS I QLETTER /LOOK FOR THIRD LETTER + JMP NOFNAM /NOT A FUNCTION NAME + DCA NAME3 /PUT INTO NAME + TAD NAME2 /IS IT A USER FUNCT ? + TAD (-616 /FN + SNA CLA + JMP USRFUN /YES + TAD (FUNS-1 /NO, CHECK VALIDITY OF NAME + DCA X10 +FUNSRC, TAD I X10 /GET NEXT FUN NAME + SNA + JMP NOFNAM /END OF LIST, INVALID NAME + TAD NAME2 /COMPARE FIRST 2 CHARS + SZA CLA + JMP NOMATC /THEY DON'T MATCH + TAD I X10 /COMPARE 3RD CHAR + TAD NAME3 + SZA CLA + JMP NOMATC+1/DON'T MATCH + TAD I X10 /GET FUNCTION CODE +FUNOK, DCA SYMBOL /SAVE IT AS SYMBOL VALU + TAD (1000 /SET FUNCTION BIT + DCA TYPE + JMP LFDOLR /LOOK FOR Q$] Q(] +NOMATC, ISZ X10 /SKIP THIRD CHAR + ISZ X10 /SKIP FUNCTION NUMBER + JMP FUNSRC /KEEP LOOKING +NOFNAM, JMS I QRESTCP /RESTORE CHAR POS + JMP LFDOLR /LOOK FOR Q$] Q(] +USRFUN, TAD NAME3 /GENERATE FUN NUMBER + JMP FUNOK + / ERROR MESSAGE REPORTER +ERMSG, 0 /PRINT ERROR MESSAGE + CLA + CDF + TAD I ERMSG /GET CODE + CLL RTR /PRINT FIRST CHAR + RTR + RTR + JMS TTY + TAD I ERMSG /PRINT SECOND CHAR + JMS TTY + ISZ ERMSG /FIX RETURN ADDR + TAD SPACE /PRINT SPACE + JMS TTY + DCA TTY /USE TTY AS A SWITCH + TAD LINEH /PRINT HIGH ORDER + JMS PSN + TAD LINEL /THEN LOW ORDER + JMS PSN /(LINE NUMBER NATCH !) + TAD (215 /PRINT CARRIAGE RETURN + JMS TTX + TAD (212 /PRINT LINE FEED + JMS TTX + JMP I ERMSG /RETURN +PSN, 0 /PRINT 3 DIGITS DECIMAL + DCA WORD2 + CLL CMA RTL /-3 + DCA TEMP +PRNTSN, TAD WORD2 /GET NEXT DIGIT + CLL RTL /INTO THE LOW ORDER + RTL /THREE BITS AND THE LINK + DCA WORD2 /SAVE SHIFTED NUMBER + TAD WORD2 /NOW DO LAST SHIFT + RAL + AND (17 /ONLY FOUR BITS +SPACE, SZA + JMP NOZERO /NOT A ZERO + TAD TTY /ANY DIGITS YET ? + SNA CLA + JMP LEAD0 /NO, ITS A LEADING ZERO +NOZERO, TAD (60 /MAKE IT ASCII + JMS TTY /PRINT DIGIT +LEAD0, ISZ TEMP /BUMP COUNT + JMP PRNTSN /MORE DIGIT(S) + JMP I PSN +XMUL, FMPY;AFMPY + / EXPONENT TABLE + PAGE +PETABL, 0004;2400;0000;0000 + 0007;3100;0000;0000 + 0016;2342;0000;0000 + 0033;2765;7020;0000 + 0066;2160;6744;6770 + 0153;2356;1326;6501 + 0325;3023;6017;5120 + 0652;2235;6443;7114 + 1523;2523;7565;7735 + 3245;3430;6320;2565 + / OPERATOR TABLE +OPR8RS, PLUS;-53 + MINUS;-55 + STAR;-52 + SLASH;-57 + UPAROW;-136 + AMPSND;-46 + 0 +SASIGN, 4000;XSTOR +ASSIGN, 0;XSTOR + / FUNCTION NAME TABLE (INTERNAL FUNCTIONS) +FUNS, -0102;-23;FUNC3 + -0123;-03;FUNC2 + -0124;-16;FUNC1 + -0310;-22;FUNC2+20 + -0317;-23;FUNC1+20 + -0401;-24;FUNC2+40 + -0530;-20;FUNC1+40 + -1116;-24;FUNC1+100 + -1405;-16;FUNC2+60 + -1417;-07;FUNC1+120 + -2017;-23;FUNC2+100 + -2216;-04;FUNC1+200 + -2305;-07;FUNC2+120 + -2307;-16;FUNC1+140 + -2311;-16;FUNC1+160 + -2321;-22;FUNC1+220 + -2324;-22;FUNC2+140 + -2601;-14;FUNC2+160 + -2422;-03;FUNC2+220 +ENDFNS, 0;0;FUNC4 /SPACE FOR NEW FUNCTIONS + 0;0;FUNC4+20 + 0;0;FUNC4+40 + 0;0;FUNC4+60 + 0;0;FUNC4+100 + 0;0;FUNC4+120 + 0;0;FUNC4+140 + 0;0;FUNC4+160 + 0;0;FUNC4+200 + 0;0;FUNC4+220 + 0;0;FUNC4+240 + 0;0;FUNC4+260 + 0;0;FUNC4+300 + 0;0;FUNC4+320 + 0;0;FUNC4+340 + 0;0;FUNC4+360 /SIXTEEN OF THEM + 0 + / KEYWORD LIST +KEYWRD, -114;-105;-124;LET + -111;-106;-105;-116;-104;IFEND + -111;-106;IF + -106;-117;-122;FOR + -116;-105;-130;-124;NEXTX +WGOTO, -107;-117 +WTO, -124;-117;GOTO + -107;-117;-123;-125;-102;GOSUB + -111;-116;-120;-125;-124;INPUT + -120;-122;-111;-116;-124;PRINT + -104;-111;-115;DIM + -104;-101;-124;-101;DATA + -104;-105;-106;DEF + -106;-111;-114;-105;FILE + -122;-105;-101;-104;READX + -122;-105;-115;REMARK + -122;-105;-123;-124;-117;-122;-105;RESTOR + -122;-105;-124;-125;-122;-116;RETURN + -123;-124;-117;-120;STOPX + -122;-101;-116;-104;-117;-115;-111;-132;-105;RANDOM + -103;-114;-117;-123;-105;CLOSE + -103;-110;-101;-111;-116;CHAIN + -125;-104;-105;-106;UDEF + -125;-123;-105;USEX + -105;-116;-104;END + 0 + / OS-8 OUTPUT ROUTINE +OWTEMP, 0 +OUPTR, OUBUF +OCOUNT, -401 +OUTWRD, 0 /OUTPUT ROUTINE + DCA OWTEMP /SAVE WORD + ISZ LOCTRL /INCREMENT PSEUDO CODE + SKP /LOCATION COUNTER + ISZ LOCTRH /BOTH HALVES + NOP /IT'LL NEVER HAPPEN + 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 +OUDUMP, 0 /DUMP OUT BUFFER + JMS I (7607 /CALL OUTPUT HANDLER + 4210 + OUBUF +OUBLOK, 0 + JMP OUERR + ISZ OUBLOK /INCREMENT BLOCK NUMBER + ISZ OUSIZE /CHECK FOR HOLE FULL + JMP I OUDUMP +OUERR, JMS I QERMSG /OUTPUT FILE ERROR + 1706 + JMP I XABORT /ABORT COMPILATION +ODEVH, 0 +OUSIZE, 0 +AMPRTN, JMS LOD1ST /LOAD OP1$ + AMPSND+2 /CONC OP2$ +SCRTN, JMS LOD1ST /LOAD OP1$ + SCOMPR+1 /COMP OP2$ +LOD1ST, 0 /HANDLE ONE WAY INSTRUCTIONS + JMS I QSAVAC /STORE 2ND ARG IF IN SAC + -1 + CLA CMA /GET TYPE OF 2ND ARG + TAD OSTACK + DCA TEMP + CLL CML RTR /IS IT SUBSCRIPTED ? + AND I TEMP + SNA CLA + JMP SKIP2 /NO, ENTRY IS ONLY 2 WORDS + TAD I TEMP /GET NUMBER OF DIMS + AND SCOMPR /LITERAL 3 + CLL RAL /DOUBLE IT + CIA +SKIP2, TAD (-2 /FIND SIZE OF 2ND ARG + DCA OP2SIZ /AND SAVE IT + TAD OSTACK /BACK UP STACK + TAD OP2SIZ + DCA OSTACK + TAD OSTACK /AND SAVE THIS ADDR + DCA X12 + JMS I QLOAD /LOAD ARG 1 + CLL CML RAR /GET TYPE BIT + AND TYPE1 /PUT BACK ARG1 + TAD Q400 + DCA I OSTACK + DCA I OSTACK + TAD I X12 /PUT BACK ARG 2 + DCA I OSTACK + ISZ OP2SIZ + JMP .-3 + TAD I LOD1ST /GET OPERATOR FINISH + JMP OUTOPR+1/GO FINISH CODE +OP2SIZ, 0 /SACRED COUNT WORD +CHECKC, 0 /CHAR CHECKER + JMS I QGETC /GET A CHARACTER + JMP .+6 /FAILED + TAD I CHECKC /COMPARE + SNA + ISZ CHECKC /MATCHES, SKIP TWO + SZA CLA + JMS I QBACK1 /NO MATCH, REPLACE + ISZ CHECKC /ALWAYS SKIP AT LEAST 1 + JMP I CHECKC +SCOMPR, 3;SCRTN-3;4000;XSCOMP;XSCOMP + / OS-8 FILE INPUT ROUTINE + PAGE +ICHAR, 0 /READ CHAR FROM INPUT FILE + ISZ INJMP /BUMP THREE WAY UNPACK SWITCH + ISZ INCHCT +INJMPP, JMP INJMP + TAD INEOF /LAST READ YEILD END OF FILE ? + SZA CLA + JMP ENDFIL /YES +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 + JMS I INHNDL /DO THE READ + 0200 /ONE BLOCK TO FIELD 0 +INBUFP, INBUF +INREC, 0 + JMP INERR /HANDLER ERROR +INBREC, ISZ INREC /BUMP RECORD NUMBER + TAD (-601 /SET CHAR COUNT + DCA INCHCT + TAD INJMPP /RESET THREE WAY JUMP SWITCH + DCA INJMP + TAD INBUFP /RESET BUFFER POINTER + DCA INPTR + JMP ICHAR+1 /GO AGAIN +INERR, SMA CLA + JMP INBREC +ENDFIL, JMS I QERMSG /INPUT FILE ERROR + 1505 +ABORT, TAD (4207 /RESTORE ^C LOCZTIONS + DCA 7600 + TAD (6213 + DCA 7605 + CDF 10 + TAD INFO /GET START OF BASIC.SV + CDF + SNA + JMP 7605 /T'WERE RUNNED + DCA EDTBLK /SAVE MAGICAL BLOCK NUMBER + JMS 7607 /USE SYS HANDLER + EDTSIZ /TO READ IN THIS MUCH + 0 /INTO ZERO +EDTBLK, 0 /FROM HERE + HLT /HALT IF BAD READ + JMP EDTBGN /GO RESTART EDITOR +INJMP, HLT /3 WAY CHAR UNPACK JUMP + 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 7 BITS + AND (177 /AND I MEAN ONLY 7 !! + SNA /IGNOR LEADER-TRAILER + JMP ICHAR+1 + TAD (-134 /CHECK FOR \ (STMT SEPARATOR) + SNA + JMP I ICHAR /TREAT LIKE CR + TAD (134-32 /IS IT ^Z (END OF FILE) + SNA + JMP ENDFIL /YES, ITS END OF FILE + TAD (32-12 + SNA + JMP ICHAR+1 /IGNORE LINE FEEDS + IAC /TABS -> BLANKS + SNA + TAD (40-11 + TAD (11-15 + SNA + JMP I ICHAR /RETURN ON CARRIAGE RETURN + IAC + SNA + JMP ICHAR+1 /IGNORE FORM FEEDS + TAD (14 /FIX CHAR + ISZ ICHAR + JMP I ICHAR /RETURN TO THE CALLING WORLD +INTMP, 0 +INEOF, 0 +INCHCT, -1 +INHNDL, 0 /ENTRY ADDR GOES HERE +INCTR, 0 +INPTR, 0 +CHKWD, 0 /WORD CHECKER + TAD I CHKWD /GET POINTER + ISZ CHKWD + DCA CWTEMP /SAVE POINTER +WDLOOP, TAD I CWTEMP /GET NEXT CHAR + SMA + ISZ CHKWD /IF NON NEG, FIX RETURN + SPA CLA + JMS I QGETC /GET CHAR + JMP I CHKWD /RETURN + TAD I CWTEMP /COMPARE + ISZ CWTEMP /INCR POINTER + SNA CLA + JMP WDLOOP /MORE + JMP I CHKWD /FAILED +CWTEMP, 0 + / INITIALIZATION CODE + *LINE +START, JMP RUNNED /DO LOOKUPS, AND FIND TEMPFILE +CHAINED,CDF 10 + TAD I (7644 /WAS IT A CHAIN FROM BRTS ? + CDF + AND (100 + SNA CLA + JMP CHEDIT /NO, FROM THE EDITOR + CIF 10 /CHAIN FROM BRTS, RESET + JMS I (200 /TO FORGET DSK: HANDLER + 13 + JMP STRT3 /NOW GO OPEN TEMP FILE +CHEDIT, TAD (INFO+7 /PICK UP SOME STUFF + DCA X10 + CDF 10 /FROM THE INFO BLOCK + TAD I X10 /START OF TEMP FILE + SNA + JMP I (RUNNED+4 /MUST BE CHAIN FROM CCL + DCA BLOCK + TAD I X10 /SIZE OF HOLE + CDF + DCA OUSIZE + TAD BLOCK + DCA OUBLOK + CDF 10 + TAD I X10 /ENTRY ADDR OF HANDLER + CDF + DCA INHNDL + JMP STRT2 +GETDEV, CDF 10 + TAD 7617 /GET DEVICE NUM FOR INPUT FILE + CDF + CIF 10 + JMS I (200 /GO FETCH THE DEVICE + 1 + INDEVH+1 /2 PAGE HANDLER IS OK + JMP NG /ERROR + TAD .-2 /GET HANDLER ADDRESS + DCA INHNDL /SAVE IT + CIF 10 + JMS I (200 /RESET SYSTEM TABLES + 13 /DELETING TENTATIVE FILES +STRT2, CDF 10 + TAD 7617 /SET UP INPUT FILE PARAMS + CDF + AND (7760 /GET SIZE + TAD (17 + CLL CML RTR + RTR + DCA INCTR + CDF 10 + TAD 7620 /GET BLOCK NUMBER + CDF + DCA INREC + CDF 10 + TAD INFO+3 /GET START OF BRTS.SV (+1) + DCA BRTS + TAD INFO /GET START OF BASIC.SV (+1) + DCA ABORTX /BOTH FOR BLOAD + TAD INFO+2 /GET START OF BLOAD.SV + CDF + DCA LDRBLK /FOR CHAIN TO BLOAD + TLS /SET TTY FLAG + ISZ WASTE + JMP .-1 + ISZ TIME + JMP .-1 +INITST, TAD (VARST-1/INITIALIZE ST AREA + DCA X12 + TAD (-436-436-436 + DCA X11 /SIZE OF NUM AND STRING TABLES + CDF 10 + CLL CML RAR /SET TO 4000 + DCA I X12 + ISZ X11 + JMP .-3 + TAD (-440 /NOW ARRAY TABLES + DCA X11 /AND BUCKETS + DCA I X12 + ISZ X11 /SET THEM TO ZERO + JMP .-2 + CDF + TAD JABORT /MODIFY ^C LOCATIONS + DCA 7600 + TAD JABORT + DCA 7605 + JMP CORE /GET CORE SIZE +NG, TLS + JMS I QERMSG /SUPER ERROR + 2331 + TSF + JMP .-1 +JABORT, JMP I XABORT /ABORT COMPILATION +WASTE, 0 +TIME, 200 + *INBUF +CORE, TAD 7777 /MODIFIED CORE SIZE ROUTINE FROM + AND (70 + SNA + JMP COR0 + CLL RAR + RTR + IAC + DCA CORSIZ + JMP COREX /OS8 SOFTWARE SUPPORT MANUAL +COR0, CDF + TAD CORSIZ + RTL + RAL + AND COR70 + TAD COREX + DCA .+1 +COR1, CDF + TAD I CORLOC +COR2, NOP + DCA COR1 + TAD COR2 + DCA I CORLOC +COR70, 70 + TAD I CORLOC +CORX, 7400 + TAD CORX + TAD CORV + SZA CLA + JMP COREX + TAD COR1 + DCA I CORLOC + ISZ CORSIZ + JMP COR0 +COREX, CDF + CLA CMA /HI FIELD IS #FIELDS-1 + TAD CORSIZ + DCA HIFLD + TAD HIFLD + CIA + DCA NFLDS + CMA /HOW MANY FIELDS ? + TAD HIFLD /MUST THIS BASIC USE ? + SZA CLA /(SOUNDS LIKE A LINE BY DYLAN) + JMP GENER + TAD (PATCH1+3&177+5200 + DCA PATCH1 /ONLY 8K, DON'T USE CDF'S + TAD (PATCH2+11&177+5200 + DCA PATCH2 + TAD (PATCH3+4&177+5200 + DCA PATCH3 + TAD (PATCH4+3&177+5200 + DCA PATCH4 + TAD (7000 + DCA PATCH5 +GENER, JMS GENTMP /GENERATE TEMP 0 + JMS GENTMP /GENERATE TEMP 1 + JMS GENTMP /GENERATE TEMP 2 + CLA IAC /GENERATE STRING TEMP 0 + JMS GENTMP + CLA IAC + DCA WORD1 /GENERATE LITERAL 1.0 + CLL CML RTR + DCA WORD2 + JMS I QLUKUP2 /ENTER INTO ST + LITRL + -3 + JMS NEWVAR + TAD (FNINIT /SET UP FUNCTIONS + DCA FDPTR +FDLOOP, TAD (WORD1-1 + DCA X12 + TAD I FDPTR /GET FIRST WORD + ISZ FDPTR + SNA + JMP I QREMARK /DONE, START COMPILER + DCA I X12 /SAVE IN WORD1 + CLL CMA RTL /GET LOOKUP COUNT + TAD I FDPTR + DCA FUNSIZ + TAD FUNSIZ /GET SIZE OF MOVE + IAC + DCA TEMP + TAD I FDPTR /GET A WORD + ISZ FDPTR + DCA I X12 /PUT INTO WORDN + ISZ TEMP + JMP .-4 + JMS I QLUKUP2 /ENTER INTO S.T. + FUNCTN +FUNSIZ, 0 + JMP FDLOOP /LOOP +FDPTR, 0 +CORLOC, CORX +CORV, 1400 +CORSIZ, 1 +NAMLST, BCOMPN /SAVE FILE NAME-POINTER LIST + BLOADN + BRTSN + BAFN + BSFN + BFFN + 0 + PAGE +FNINIT, FUNC3;-1;2000;0 /ABS + FUNC1;-1;2000;0 /ATN + FUNC2;-1;6000;0 /ASC + FUNC1+20;-1;2000;0 /COS + FUNC2+20;-1;2000;4000 /CHR + FUNC1+40;-1;2000;0 /EXP + FUNC2+40;-1;2000;4000 /DAT + FUNC1+220;-1;2000;0 /SQR + FUNC1+60;-2;0;2000;0 /EXP2 + FUNC2+60;-1;6000;0 /LEN + FUNC1+100;-1;2000;0 /INT + FUNC2+100;-3;2000;4000;6000;0 /POS + FUNC1+120;-1;2000;0 /LOG + FUNC2+120;-3;0;2000;6000;4000 /SEG + FUNC1+140;-1;2000;0 /SGN + FUNC2+140;-1;2000;4000 /STR + FUNC1+160;-1;2000;0 /SIN + FUNC2+160;-1;6000;0 /VAL + FUNC1+200;-1;2000;0 /RND + FUNC2+220;-1;2000;0 /TRC + 0 +BASICN, FILENAME BASIC.SV /FILE NAMES +BCOMPN, FILENAME BCOMP.SV /FOR LOOKUPS +BLOADN, FILENAME BLOAD.SV +BRTSN, FILENAME BRTS.SV +BAFN, FILENAME BASIC.AF +BSFN, FILENAME BASIC.SF +BFFN, FILENAME BASIC.FF +BUFN, FILENAME BASIC.UF +TMPFIL, FILENAME BASIC.TM + $ +