/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 $