* * IBM 1401 Tiny Basic * Paul Laughton * paul@laughton.com * * This code is open source. It is available to anyone for any pupose. * * Rev 02 February 8, 2015 * ORG 1 CARD EQU 1 DS 80 CARD READ AREA ORG 87 X1 DS 3 INDEX REGISTER 1 ORG 92 X2 DS 3 INDEX REGISTER 2 ORG 97 X3 DS 3 INDEX REGISTER 3 * LINE ORG 100 * SWA EQU 199 PRA EQU 201 DS 132 PRINT AREA * * LINE NUMBER TABLE * ORG 333 LTBL DA 100X6,X1 LNO 1,3 LINE NUMBR LADR 4,6 ADR OF LINE TOKENS * * NUMERIC VALUE STORAGE TABLE * EACH ENTRY HOLD 10 DIGIT NUMBER * FIRST 27 ENTRIES HOLD VALUES * FOR VARIABLES A - Z. * THE NEXT 70 ENTRIES HOLD * NUMERIC CONSTANT VALUES * NVT DA 98X10,X1 NVTE 1,10 * * STRING VARIBLE TABLE * EACH ENTRY HOLDS A DISPLACEMENT * INTO THE STRING TABLE * * THE INITIAL VALUE FOR A STRING * VARIABLE IS A DEFAULT 1 CHAR * STRING * * FIRST 27 FOR A$ - Z$ * REMAINING ENTRIES FOR LITERALS * SVT DA 98X3,X2 A$-Z$ PLUS 2 FOR ! AND + SVTE 1,3 * * STRING TABLE * HOLDS STRINGS * EACH STRING STARTS WITH A 2 DIGIT * CHARACTER COUNT FOLLOWED BY THE STRING * * TSVAL(XXX) * | | A$ * |--->| B$ (XXX) * | C$ | * |----| * | * CCSS...SS * ST EQU * START OF STRING TABLE STDEF DCW 01 THE DEFAULT STRING DCW @X@ ORG *+980 * * DATA TABLE * * WILL HAVE TSVAL OR TNVAL TOKENS * DATA EQU * ORG *+500 NADATA DCW 000 INDEX TO NEXT AVAIL NRDATA DCW 000 INDEX TO NEXT TO READ DCW 0 * * PROGRAM TOKEN AREA * PTA EQU * AREA IS 1000 CHARS PLUS ORG *+1100 A 100 CHAR BUFFER ZONE * ILT DCW 000 LINE TABLE INDEX INCT DCW 269 NEXT AVAILABLE CONSTANT INSL DCW 081 NEXT STRING LITERAL IPTA DCW 000 PROG TOKEN INDEX PIPTA DCW 000 PREVIOUS IPTA ISTNXT DCW 003 NEXT AVAILABLE STRING INDEX * * COMMAND TABLE * * * *` TOKEN VALUE IS INDEX * FROM THEAD TO PARSE ADR * THEAD DCW 3 SIZE OF WORD DCW @LET@ THE WORD DCW PLET PARSE ADR DCW XLET EXECUTE ADR * DCW 2 DCW @IF@ DCW PIF DCW XIF * DCW 3 CREM DCW @REM@ DCW PREM DCW XREM * DCW 3 DCW @FOR@ DCW PFOR DCW XFOR * DCW 4 DCW @NEXT@ DCW PNEXT DCW XNEXT * DCW 4 DCW @GOTO@ DCW PGOTO DCW XGOTO * DCW 5 DCW @GOSUB@ DCW PGOSUB DCW XGOSUB * DCW 6 DCW @RETURN@ DCW PRTN DCW XRTN * DCW 5 DCW @PRINT@ DCW PPRINT DCW XPRINT * DCW 4 DCW @READ@ DCW PREAD DCW XREAD * DCW 4 DCW @DATA@ DCW PDATA DCW XDATA * DCW 3 DCW @END@ DCW PEND DCW XEND * TTAIL DCW @X@ END MARKER * * * * TCMND DCW 1 TOKEN FOR COMMAND TNVAL DCW 2 NUMERIC VALUE TSVAL DCW 3 STRING VALUE TSOP DCW 4 STRING OPERATOR TSSUBS DCW 5 SUBSTRING FOLLOWS TNUMOP DCW 6 NUMERIC OPERATOR * * OPEATORS * * * NUMERIC OPERATOR TABLE * A NUMERIC TOKEN IS FOLLOWED * BY THE DISPLACEMENT INTO THIS TABLE * FROM OTS TO TOKEN CHARACTER * OTS DCW @%@ CHARACTER (END OF EXP) DCW 0 PRIORITY DCW XEOE EXECUTE ADR * DCW @,@ ANOTHER EOE, 005 DCW 0 DCW XEOE * DCW @*@ MULTIPLY, 010 DCW 3 DCW XMUL * DCW @/@ DIVIDE, 015 DCW 3 DCW XDIV * CPLUS DCW @(@ PLUS, 020 DCW 2 NOTE: ( WITH GET TRANSFORMED DCW XPLUS TO + * DCW @-@ MINUS, 025 DCW 2 DCW XMINUS * DCW @<@ LESS THAN, 030 DCW 1 DCW XLT * DCW @=@ LOGICAL EQUAL, 035 DCW 1 DCW XEQU * DCW @>@ GREATER THAN, 040 DCW 1 DCW XGT * DCW @(@ LEFT PAREN, 045 DCW 0 DCW 000 * DCW @+@ CONCAT OP, 50 DCW 2 DCW XCCAT * DCW @-@ UNARY MINUS, OP, 55 DCW 5 DCW XUMNUS * OPEND DCW @:@ END OF TABLE OLPRN DCW 045 LEFT PAREN INDEX OUMNUS DCW 055 UNARY MINUS OPEOE DCW 010 EOE OP INDEX = 10 OLTI DCW 030 INDEX FOR < OEQI DCW 035 INDEX FOR = OGTI DCW 040 INDEX FOR > OCCAT DCW 050 CONCAT INDEX CLT DCW @.LT.@ CEQ DCW @.EQ.@ CGT DCW @.GT.@ * * VECTOR ADRESSES * ATALPH DCW TALPH ASLIT DCW SLIT ATNUM DCW TNUM AINXP DCW INEXP ANEXP DCW NEXP ANV DCW NV ANOP DCW NOP AXEOE DCW XEOE AEXEP DCW EXEP AUMNUS DCW XUMNUS * ASEXP DCW SEXP ASS1 DCW SS1 ASV DCW SV AXEESE DCW XEESE AXCCAT DCW XCCAT AESEXP DCW ESEXP * * MISC STUFF * ZERO DCW @0000000000@ CREG DCW 000 CMINUS DCW @-@ CZ DCW @Z@ SQUOTE DCW @'@ BLANK DCW @ @ CDOT DCW @.@ CT DCW @T@ CASN DCW @=@ CCOM DCW @,@ CLPRN DCW @(@ CRPRN DCW @)@ C$ DCW @$@ MINUS1 DCW @00!@ N269 DCW 269 N81 DCW 081 N79 DCW 79 N026 DCW 026 N11 DCW 11 N10 DCW 10 N9 DCW 9 N7 DCW 7 N6 DCW 6 N5 DCW 5 N004 DCW 004 N4 DCW 4 N003 DCW 003 N3 DCW 3 N002 DCW 002 N2 DCW 2 N001 DCW 001 N1 DCW 1 N00 DCW 00 N0 DCW 0 * * FLAGS * ECP DCW 0 END CARD PROCESSED ERROR DCW 0 PARSING OR EXE ERROR * * START OF PROGRAM * REVMSG DCW @**** IBM 1401 TINY BASIC, VERSION 02 *****@ * START NOP CC 1 UNCOMMENT FOR REAL 1401 LCA REVMSG,PRA+45 PRINT REVISION MESSAGE W CS 299 * * INITIALIZE * LCA CREG,ILT LINE TABLE INDEX LCA N269,INCT NEXT AVAIL NUM CONST LCA N81,INSL STRING STRING LITERAL TABLE INDEX LCA N003,ISTNXT NEXT STRING INDEX LCA CREG,IPTA PROG TOKENS INDEX LCA CREG,PIPTA PREVIOUS TOKEN INDEX LCA N0,ERROR SET NO ERRORS LCA N0,ECP SET NOT PROCESSED END CARD LCA CREG,FNSTOS FOR/NEXT TOP OF STACK LCA CREG,GSSTOS GOSUB TOP OF STACK INDEX LCA CREG,NADATA NEXT AVAIL DATA LCA CREG,NRDATA NEXT READ DATA MZ CT,CPLUS CREATE A + CHAR SW CARD * * READ CARD LOOP * NEXTR R READ NEXT PROGRAM CARD LCA CARD+80,PRA+81 MOVE CARD TO PRINT AREA W AND PRINT THE CARD CS 299 CLEAR PRINT AREA * B BLANKS GO REMOVE BLANKS * LCA CREG,J_TOS CLEAR JSR STACK LCA CREG,O_TOS CLEAR OPERATOR TOS B PARSE AND THE PARSE THE LINE BCE PDONE,ECP,1 IF END CARD PROCESSED, EXECUTE PROGRAM B NOEC,A IF READER EMPTY, ERROR B NEXTR GET NEXT CARD * NOEC B ER1 PR NO END CARD MESSAGE B TRYAGN TELL EM TRY AGAIN * PDONE C N0,ERROR IF NO ERRORS BE EXEC EXECUTE PROGRAM * TRYAGN B ER5 ELSE PRINT MESSAGE H START AND WAIT FOR RESTART * * * ************* EXECUTE PROGRAM ************* * LOOPCK DCW 000 EXEC LCA CREG,LOOPCK LCA CREG,ENLN INITIALIZE NEXT LINE INDEX LCA N0,ECP SET NOT ZERO WHEN END EXECUTED * EX_NXT BSS E_KILL,B KILL PROGRAM IF SS1 ON * A N001,LOOPCK LOOP CHECK FOR C LOOPCK,@999@ SIMULATOR BE E_KILL * LCA ENLN,X1 LCA LADR+X1,X3 GET START OF LINE TOKEN LCA LNO,CLNO SAVE EXECUTING LINE NUMBER SBR X1,6+X1 PRE-ADVANCE TO NEXT LINE LCA X1,ENLN * SW PTA+1+X3 MCW PTA+3+X3,J_TO GET THE EXEC ADR SBR X3,4+X3 INCREMENT TOKEN COUNTER B J_JSR GO EXEC TOKEN * BU EX_FIN BRANCH IF FAIL C N0,ECP BR IF END BE EX_NXT NOT EXCUTED * EX_FIN H START FINISHED * E_KILL B ER12 PRINT STOP MESSAG B EX_FIN AND STOP * ENLN DCW 000 EX NEXT LINE INDEX CLNO DCW 000 CURRENTLY EXECUTING LINE NO * * REMOVE BLANKS FROM INPUT CARD * AND * SET CHARACTER COUNT * BLANKS NOP SBR B_RTS+3 LCA CREG,X1 CARD FROM INDEX LCA CREG,X2 CARD TO INDEX CS 199 SW LINE * B_0 C CARD+X1,BLANK NEXT CARD CHAR A BLANK BU B_1 BRANCH IF NOT BLANK * SBR X1,1+X1 MOVE TO NEXT CHAR C X1,N79 IF ALL CHARS, BE B_DONE DONE B B_0 ELSE GO FOR NEXT CHAR * B_1 C CARD+X1,SQUOTE START OF LITERAL? BE B_LIT BRANCH IF LITERAL * B_2 MZ CARD+X1,LINE+X2 MOVE SINGLE CHAR MN CARD+X1,LINE+X2 * B_2A SBR X1,1+X1 INCREMENT REGISTER SBR X2,1+X2 B B_0 ELSE FOR NEXT CHAR * B_LIT LCA SQUOTE,LINE+X2 MOVE ' TO LINE SBR X1,1+X1 INCREMENT OVER CARD @ * SBR X2,2+X2 INC LINE INDEX OVER LCA N00,B_LCC CLEAR LIT CHAR COUNT LCA N00,LINE+X2 @ + LENTH LCA X2,B_LI SAVE INDEX TO LINE INDEX SBR X2,1+X2 SW LINE+X2 * B_LIT1 MZ CARD+X1,LINE+X2 MOVE SINGLE CHAR MN CARD+X1,LINE+X2 A N1,B_LCC INCREMENT CHAR COUNT SBR X1,1+X1 INCREMENT CARD INDEX SBR X2,1+X2 INCREMENT LINE INDEX * C CARD+X1,SQUOTE NEXT AN ENDING ' SIGN BU B_LIT1 KEEP LOOKING IF NOT * SBR X1,1+X1 SKIP OVER ENDING @ LCA B_LI,X3 GET INDEX TO COUNT LCA B_LCC,LINE+X3 MOVE COUNT * B B_0 ELSE CONTINUE AS NORMAL * * B_DONE LCA OTS,LINE+X2 SET END MARKER CW LINE+X2 B_RTS B 0000 * B_LI DCW 000 SAVED X2 LENGTH INDEX B_LCC DCW 00 * * ****************PARSE A LINE************* * * START BY ADDING CARD TO LINE NUMBER TABLE * TABLE HAS TWO ENTRIES: * LINE NUMBER, FIRST LINE TOKEN INDEX * PARSE SBR P_RTS+3 * C IPTA,PIPTA IF TOKEN INDEX BE P_A BL P_A HAS WRAPPED AROUND B ER14 REPORT OUT OF MEMORY B TRYAGN AND QUIT * P_A C LINE+2,CREG BR IF NOT A LINE NUMBER BH P_0 * C LINE+5,CREM IF REM BE P_RTS SKIP IT * LCA ILT,X1 X1= LINE TABLE INDEX C CREG,X1 BRANCH IF FIRST ENTRY BE P_1 * C LNO-6,LINE&2 IF NEW LINE NO > PREVIOUS BH P_1 CONTINUE * P_0 B ER2 ELSE SIGNAL ERROR B P_RTS RETURN * P_1 LCA LINE+2,LNO MOVE LINE NUMBER LCA IPTA,LADR MOVE NEXT PROG TOKEN INDEX A N6,ILT INCREMENT TO NEXT ILT ENTRY * * FIND THE COMMAND * * X2 INDEXES THE TOKEN TABLE LCA CREG,X2 ZERO IT AND * PNXT ZA THEAD+X2,X1 MOVE LETTER COUNT TO X1 MZ ZERO,X1 CLEAR ZONE BITS A X1,X2 ADD LETTER COUNT TO X2 C LINE+2+X1,THEAD+X2 FOUND COMMAND? BE P2 BRANCH IF FOUND * A N7,X2 SKIP TO NEXT LETTER COUNT C TTAIL,THEAD+X2 AT END OF TOKENS BE PCNF COMMAND NOT FOUND B PNXT GO TEST NEXT * PCNF B ER3 PRINT COMMAND NOT FOUND B NEXTR READ NEXT CARD * COMMAND FOUND * * X1 = COMMAND LETTER COUNT * X2 = INDEX OF END OF COMMAND WORD IN TOKEN TABLE * P2 SBR X1,3+X1 X1 NOW FIRST CHAR PAST COMMAND LCA IPTA,X3 GET INDEX TO NEXT TOKEN CHAR LCA TCMND,PTA+X3 LCA THEAD+6+X2,PTA+3+X3 SET TOKEN EXEC ADR AS TOKEN VALUE A N4,IPTA INCREMENT TO NEXT TOKEN * SBR X2,3+X2 GET THE COMMAND PARSE ADR MCW THEAD+X2,PCMD+3 AND GOTO PARSE IT PCMD B 000 JUMPS TO PARSER FOR THE COMMAND * * UPON ENTRY, * X1=NEXT LINE CHARACTER * IPTA=NEXT AVAILABLE PROGRAM TOKEN * * * PARSE LET * LET = | = * PLET NOP MCW ANV,J_TO ? B J_JSR BU PL_STR * C LINE+X1,CASN = ? BU P_ERR SBR X1,1+X1 * MCW AINXP,J_TO B J_JSR BU P_ERR BR IF FAIL * B P_RTS * PL_STR NOP LCA N0,J_ERR CLEAR JSR ERROR MCW ASV,J_TO ? B J_JSR BU P_ERR RETURN IF NOT ERROR * C LINE+X1,CASN = ? BU P_ERR SBR X1,1+X1 * ? LCA N0,J_ERR CLEAR JSR ERROR MCW ASEXP,J_TO B J_JSR BU P_ERR BR IF FAIL * C LINE+X1,CDOT BE P_ERR * B P_RTS ELSE DONE * * * PARSE IF * IF THEN GOTO * IF ,|, * PIF NOP MCW AINXP,J_TO ? B J_JSR BU PF_STR IF NOT, MAYBE STRING * PFCNXP NOP PARSE , C LINE+X1,CCOM , ? BU P_ERR SBR X1,1+X1 * PFNEXP NOP PARSE A FINAL MCW AINXP,J_TO B J_JSR BU P_ERR * B P_RTS ALL IS GOOD * PF_STR LCA N0,J_ERR CLEAR JSR ERROR MCW ASEXP,J_TO ? B J_JSR BU P_ERR IF FAIL, RETURN FAIL * LOGICAL OPS MUST FOLLOW LCA OLTI,X3 BE PF_SC LCA N1,J_ERR IF NONE OF THE ABOVE, B P_ERR THEN RETURN ERROR * PF_SC LCA X3,PF_OPI SAVE LOGICAL OPERATOR SBR X1,4+X1 SKIP OVER OPERATOR * MCW ASEXP,J_TO ? B J_JSR BU P_ERR IF FAIL, RETURN FAIL * LCA IPTA,X2 SET OPERATOR AS LCA TNUMOP,PTA+X2 POST FIXE LCA PF_OPI,PTA+3+X2 SBR X2,4+X2 NEXT TOKEN CHAR LCA X2,IPTA B PFCNXP NOW, GO THE GOTO PART * PF_OPI DCW 000 LOGICAL OPERATOR INDEX * * PARSE REM * PREM B P_RTS NOTHING TO PARSE * * PARSE FOR * FOR = TO STEP * FOR =,, * PFOR NOP MCW ANV,J_TO ? B J_JSR BU P_ERR * C LINE+X1,CASN = ? BU P_ERR SBR X1,1+X1 * MCW AINXP,J_TO START VALUE B J_JSR BU P_ERR BR IF FAIL * C LINE+X1,CCOM , ? BU P_ERR SBR X1,1+X1 * MCW AINXP,J_TO LIMIT B J_JSR BU P_ERR * B PFCNXP STEP * * PARSE NEXT * PNEXT B P_RTS NOTHING TO PARSE * * PARSE GOTO * GOTO * PGOTO NOP B PFNEXP ? * * PARSE GOSUB * GOSUB PGOSUB NOP B PFNEXP * * PARSE RETURN * PRTN B P_RTS NOTHING TO PARSE * * PARSE PRINT * PPRINT NOP MCW ASEXP,J_TO B J_JSR BU P_ERR BR IF FAIL * * PARSE READ * PREAD C LINE+X1,OTS BR IF AT END OF LINE BE P_RTS * PREAD1 BWZ P_ERR,LINE+X1,2 INSURE CHAR NOT NUMBER * MCW ANV,J_TO B J_JSR BU PR_1 BE PRNXT BR IF * PR_1 LCA N0,J_ERR CLEAR ERROR CODE MCW ASV,J_TO B J_JSR BU P_ERR SYNTAX ERROR IF NOT * PRNXT C LINE+X1,OTS IF AT END OF LINE BE P_RTS RETURN * C LINE+X1,CCOM IF NOT COMMA BU P_ERR THEN SYNTAX ERROR SBR X1,1+X1 SKIP OVER COMMA B PREAD1 AND GET NEXT VALUE * * PARSE DATA * PDATA C LINE+X1,OTS BR IF AT END OF LINE BE P_RTS * PDATA1 LCA IPTA,DSIPTA SAVE TOKEN START MCW ATNUM,J_TO NUMBER? B J_JSR BU PD_SLT IF NOT, TRY STRING LITERAL * LCA DSIPTA,X3 MOVE TOKEN FROM LCA NADATA,X2 PROGRAM TOKEN AREA LCA PTA+X3,DATA+X2 TO DATA AREA LCA PTA+3+X3,DATA+3+X2 3 CHAR VALUE SBR X2,4+X2 LCA X2,NADATA SAVE NEW DATA INDEX LCA DSIPTA,IPTA RESTORE IPTA B PDNXT LOOK FOR NEXT VALUE * PD_SLT C LINE+X1,SQUOTE STRING LITERAL BU P_ERR SYNTAX ERROR IF NOT * LCA N0,J_ERR CLEAR JSR ERR * MCW ASLIT,J_TO ? B J_JSR BU P_ERR SYN ERROR IF NOT * LCA DSIPTA,X3 MOVE TOKEN FROM LCA NADATA,X2 PROGRAM TOKEN AREA LCA PTA+X3,DATA+X2 TO DATA AREA LCA PTA+3+X3,DATA+3+X2 3 CHAR VALUE SBR X2,4+X2 LCA X2,NADATA SAVE NEW DATA INDEX LCA DSIPTA,IPTA RESTORE IPTA * PDNXT C LINE+X1,OTS IF AT END OF LINE BE P_RTS RETURN * C LINE+X1,CCOM IF NOT COMMA BU P_ERR THEN SYNTAX ERROR SBR X1,1+X1 SKIP OVER COMMA B PDATA1 AND GET NEXT VALUE * DSIPTA DCW 000 SAVES IPTA * * PARSE END CARD * PEND NOP LCA ILT,X1 SET MINUS 1 LINE NO LCA MINUS1,LNO+X1 AS END OF TABLE MARKER LCA XEND,LNO+3+X1 LCA N1,ECP SIGNAL LAST CARD PROCESSED B P_RTS DONE PARSING END * P_ERR B ER4 SYNTAX ERROR P_RTS B 000 * * PARSE A NUMERIC EXPRESSION * ASSUMES X1 POINTS TO NEXT CARD CHAR * ASSUMES X2 POINTS TO NEXT TOKEN SLOT * * := () | * := ")"|| * := | * := A|B...Y|Z * : = 1|2..9|0 * := +|-|*|/|<|>|= * * * * if tos == * rts+ * if c == "(" * push ( * c++ * jsr * jmp * jsr * if + jmp * else rts- * INEXP LCA CREG,O_TOS CLEAR STACK * NEXP NOP * NE_1 C LINE+X1,CMINUS BU NE_1A * LCA O_TOS,X3 GET TOS SBR X3,3+X3 INCREMENT LCA OUMNUS,O_STCK+X3 PUSH LEFT PAREN LCA X3,O_TOS SAVE NEW TOS SBR X1,1+X1 INCREMENT CARD CHAR INDEX MCW ANEXP,J_TO B J_JSR B J_RTS NE_1A C LINE+X1,CLPRN NEXT CHAR A LEFT PAREN BU NE_2 BR IF NOT LCA O_TOS,X3 GET TOS SBR X3,3+X3 INCREMENT LCA OLPRN,O_STCK+X3 PUSH LEFT PAREN LCA X3,O_TOS SAVE NEW TOS SBR X1,1+X1 INCREMENT CARD CHAR INDEX MCW ANEXP,J_TO B J_JSR BU NE_3 BR IF FAIL B NOP * NE_2 MCW ANV,J_TO B J_JSR BU NE_3 FAIL ? B NOP ELSE NE_3 B J_RTS RETURN WITH ERROR * * * * if + * if c+1 == "$" * rts - * create token * ++src ptr * rts+ * * if - * rts- * create token * ++src ptr * rts+ * NV NOP MCW ATALPH,J_TO IF NEXT CHAR A-Z B J_JSR BU TNUM THEN IS IT A NUMBER? * C LINE+1+X1,C$ IF ALPHA, IS NEXT CHAR == $ BU NV_A1 IF NOT, THEN OK * LCA N1,J_ERR ELSE FAIL B J_RTS RETURN * NV_A1 SBR X1,1+X1 GOOD ALPHA CHAR LCA IPTA,X3 GET NEXT TOKEN INDEX LCA TNVAL,PTA+X3 TOKEN IS NUM VALUE LCA TA_NDX,PTA+3+X3 MOVE NV TABLE INDEX LCA TA_NDX,X2 CLEAR VALUE TO ZERO LCA ZERO,NVTE+X2 A N4,IPTA INCREMENT TOKEN INDEX B J_RTS RETURN * * TEST FOR AN ALPHA VARIABLE * IF VALID, TA_NDX WILL * CONTAIN INDEX INTO VNT * TALPH NOP SW TA_NUM-2 RE-ESTABLISH WORD MARKS CW TA_NUM-1 LCA CREG,TA_NUM CLEAR NUMBER MN LINE+X1,TA_NUM GET THE NUMBER PORTION C TA_001,TA_NUM BL TA_NO BWZ TA_NO,LINE+X1,2 BR IF NOT A OR B BITS BWZ TA_1,LINE+X1,B BR IF A AND B BITS A TA_9,TA_NUM ADD 9 TO TO NUMBER BWZ TA_1,LINE+X1,K BR IF B BUT NOT A A TA_9,TA_NUM ADD 9 TO NUMBER TA_1 S N1,TA_NUM MZ N0,TA_NUM * * TA_NUM NOW 0 TO 26 * C LINE+1+X1,C$ IF STRING VAR BU TA_N BRANCH SW TA_NUM+1 ELSE SET WM FOR STRING B J_RTS AND RETURN * TA_N CW TA_NUM+1 CLEAR WM FOR STRING SW TA_NUM-1 SET WM SUCH THAT * TA_NUM IS * NOW INDEX INTO VNT B J_RTS DONE * TA_NO LCA N1,J_ERR ERROR RETURN B J_RTS TA_NUM DCW 000 NUMBER PORTION OF CHARACTER TA_NDX DC 0 INDEX IN NVT TA_001 DCW 001 TA_9 DCW 009 * * TEST FOR NUMBER * X1 = INDEX TO NEXT CARD CHAR * TNUM LCA ZERO,TN_NH CLEAR CW TN_NH+1 LCA CREG,X2 SET DIGIT COUNT == 0 TN_NXT C LINE+X1,CLPRN BR IF CHAR ( BE TN_FK BWZ TN_1,LINE+X1,2 BR IF CHAR IS NUMBER * TN_FK C CREG,X2 DID WE FIND ANY CHARS BU TN_2 BR IF YES TN_NO LCA N1,J_ERR SET FAIL B J_RTS RETURN * TN_2 C X2,N0 DONE 9 SHIFTS BE TN_FIN BR IF 9 SBR X2,1+X2 INCREMENT DIGIT COUNT LCA TN_NUM-1,TN_NUM SHIFT AGAIN B TN_2 AND LOOP * TN_FIN SW TN_NH+1 SET WM FOR 10 CHAR NUM LCA IPTA,X3 GET NEXT TOKEN INDEX LCA TNVAL,PTA+X3 TOKEN IS NUM VAR LCA INCT,PTA+3+X3 MOVE NEXT ENTRY INDEX LCA INCT,X2 GET THAT INDEX LCA TN_NUM,NVTE+X2 MOVE THE VALUE A N10,INCT MOVE TO NEXT NV ENTRY A N4,IPTA INCREMENT TOKEN INDEX LCA N0,J_ERR NOT FAIL B J_RTS RETURN * TN_1 MN LINE+X1,TN_NH+1+X2 SBR X1,1+X1 INCREMENT TO NEXT CHAR SBR X2,1+X2 INCREMENT DIGIT COUNT B TN_NXT GO TEST NEXT CHAR * TN_NH DCW @0000000000@ TN_NUM DC @0000000000@ * * := | * if char == ")" * pull ops to token area until "(" * ++src ptr * save new tos * save new IPTA * jsr * * if fail * rts- * else grab token and priority * while tos_op_pr > new_op_pr * pull tos_op * push new_op * ++src ptr * rts+ * else rts- * NOP C N1,OSTR IN STRING EXPRESSION BU NO_A BR IF NOT C CREG,O_TOS IS STACK EMPTY BE NO_EOE BR IF EMPTY * HAVE A UNARY MINUS OPERATOR LCA AUMNUS,FN_OEA SET OP EXECUTE ADR LCA IPTA,X2 X2=NEXT TOKEN INDEX LCA TNUMOP,PTA+X2 SET NUM TOKEN LCA FN_OEA,PTA+3+X2 VALUE = OP EXECUTE ADR SBR X2,4+X2 INCRMENT TOKEN INDEX LCA X2,IPTA SAVE TOKEN INDEX * B NO_EOE * NO_A C LINE+X1,CLPRN IS THIS A ( BE NO_NO BR IF NOT * NO_0 LCA IPTA,X2 X2=NEXT TOKEN INDEX LCA O_TOS,X3 X3=TOS INDEX C LINE+X1,CRPRN CHAR =")" BU FINDOP BR IF NOT * PAREN PULL LOOP NO_1 C CREG,X3 BR IF STACK EMPTY BE NO_NO C O_STCK+X3,OLPRN "(" ? BU NO_2 BR IF NOT * S N3,X3 DECREMENT TOS MZ ZERO,X3 LCA X3,O_TOS SBR X1,1+X1 INCREMENT LINE PTR LCA X2,IPTA SAVE TOKEN POINTER B J_RTS * NO_2 LCA X2,IPTA TEMP SAVE X2 LCA O_STCK+X3,X2 GET OP INDEX LCA OTS+4+X2,FN_OEA GRAB THE EXECUTE ADR LCA IPTA,X2 RESTSORE X2 LCA TNUMOP,PTA+X2 SET TOKEN TYPE LCA FN_OEA,PTA+3+X2 VALUE = OP EXECUTE ADR SBR X2,4+X2 INCREMENT TOKEN INDEX S N3,X3 DECREMENT TOS MZ ZERO,X3 C CREG,X3 IF STACK EMPTY BE NO_NO THEN NO { FOUND B NO_1 ELSE LOOP * * FIND OP IN TABLE * FINDOP NOP * LCA OLTI,X3 SPECIAL CASE OPS C LINE+3+X1,CLT < BE FN_SC LCA OEQI,X3 C LINE+3+X1,CEQ = BE FN_SC LCA OGTI,X3 C LINE+3+X1,CGT > BU FN_REG * FN_SC SBR X1,3+X1 INCREMENT MINUS 1 B FN_FND WE FOUND A SPECIAL CASE * FN_REG LCA CREG,X3 X3=0 * FN_1 C OTS+X3,OPEND BR IF NOT AT BE NO_NO END OF TABLE * FN_2 NOP C LINE+X1,OTS+X3 BR IF BE FN_FND OP FOUND SBR X3,5+X3 ELSE INCREMENT B FN_1 AND TRY NEXT * FN_FND LCA OTS+1+X3,FN_PRI SAVE NEW OP PRI LCA X3,FN_TOK AND NEW OP INDEX * LCA O_TOS,X3 GET TOS INDEX FN_PUL C CREG,X3 IF STACK IS EMPTY BE NO_PSH PUSH NEW OP * LCA O_STCK+X3,X2 GET STACK OP INDEX C OTS+1+X2,FN_PRI TOS PR : NOP PR BH NO_PSH * PULL OP LCA OTS+4+X2,FN_OEA GRAB OP EXECUTE ADR LCA IPTA,X2 X2=NEXT TOKEN INDEX LCA TNUMOP,PTA+X2 SET NUM TOKEN LCA FN_OEA,PTA+3+X2 VALUE = OP EXECUTE ADR SBR X2,4+X2 INCRMENT TOKEN INDEX LCA X2,IPTA SAVE TOKEN INDEX C CREG,X3 STACK EMPTY BE NO_NO BR IF NOT S N3,X3 DECREMENT STACK INDEX MZ ZERO,X3 B FN_PUL NEXT * NO_PSH C FN_TOK,OPEOE WAS TOKEN EOE (, OR .) BH NO_EOE BR IF YES, DONT INC LINE PTR * SBR X3,3+X3 PUSH NEW OP LCA FN_TOK,O_STCK+X3 * NO_FIN LCA X3,O_TOS SAVE NEW TOS SBR X1,1+X1 INCREMENT TO NEXT CHAR MCW ANEXP,J_TO AND DO B J_JSR B J_RTS RETURN * NO_EOE LCA IPTA,X2 X2=NEXT TOKEN INDEX LCA TNUMOP,PTA+X2 SET NUM TOKEN LCA AXEOE,PTA+3+X2 VALUE = EOE EXECUTE ADR SBR X2,4+X2 INCRMENT TOKEN INDEX LCA X2,IPTA SAVE TOKEN INDEX B J_RTS DONE * NO_NO C N1,OSTR SUBSTRING )? BE NO_EOE SET EOE IF YES * NO_NO1 LCA N1,J_ERR RETURN FAIL B J_RTS * FN_OEA DCW 000 SVVVT DCW 000 FN_TOK DCW 000 NEW TOKEN VALUE FN_PRI DCW 1 NEW TOKEN PRIORITY * O_TOS DCW 000 OPT TOP OF STACK INDEX O_STCK DA 10X3,X3 OPERATOR STACK * * STRING EXPRESSION * := * := |(,) * := || * := A$...Z$ * :=' XXX ' * := +| * * SEXP * ENTERED WITH X1 = NEXT LINE CHAR * OSTR DCW 0 1 = PROCESSING STRING EXPRESSION * SEXP MCW ASS1,J_TO ? B J_JSR BU J_RTS IF NOT, FAIL * C LINE+X1,CLPRN (? BU SXOP BR IF NO SUBSTRING * LCA IPTA,X3 SET SUBSTRING LCA TSSUBS,PTA+X3 FOLLOWS TOKEN SBR X3,1+X3 LCA X3,IPTA * SBR X1,1+X1 INCREMENT OVER ( LCA N0,OSTR MCW AINXP,J_TO B J_JSR BU J_RTS IF NOT, FAIL * C LINE+X1,CCOM COMMA? BU SEXPF BAD SYNTAX * SBR X1,1+X1 INCREMENT OVER , LCA N1,OSTR MCW AINXP,J_TO B J_JSR LCA N0,OSTR BU J_RTS IF NOT, FAIL * C LINE+X1,CRPRN )? BU SEXPF IF NOT FAIL SBR X1,1+X1 * SXOP B SOP * SEXPF LCA N1,J_ERR B J_RTS RETURN FAIL * * := |+ * SOP C LINE+X1,OTS AT END OF STMT BE SOP_1 BR IF NOT C LINE+X1,CCOM MAYBE A COMMA? BE SOP_1 C LINE+X1,CDOT START OF LOGICAL OPERATOR? BU SOP_TP BR IF NOT SOP_1 LCA IPTA,X3 SET TOKENS LCA TSOP,PTA+X3 STRING OP TOKEN LCA AXEESE,PTA+3+X3 XESOE EXECUTE ADR SBR X3,4+X3 INCREMENT LCA X3,IPTA B J_RTS * SOP_TP C LINE+X1,CPLUS IS IT A + BU SEXPF FAIL IF NOT LCA IPTA,X3 SET TOPENS LCA TSOP,PTA+X3 STRING OP TOKEN LCA AXCCAT,PTA+3+X3 CONCAT OP SBR X3,4+X3 INCREMENT LCA X3,IPTA SBR X1,1+X1 B SEXP GO * * = A$.....Z$ * * SV MCW ATALPH,J_TO B J_JSR BU J_RTS BR IF FAIL * C LINE+1+X1,C$ $ ? BE SV_1 LCA N1,J_ERR IF NOT, B J_RTS ERROR RETURN * SV_1 SBR X1,2+X1 SKIP OVER A$ LCA TA_NUM,X2 NUM = 0-26 A TA_NUM,X2 MULTIPLY BY 3 A TA_NUM,X2 FOR SVT INDEX * LCA CREG,SVTE+X2 SET DEFAULT STRING LCA IPTA,X3 NEXT TOKEN LCA TSVAL,PTA+X3 SET TOKEN TYPE LCA X2,PTA+3+X3 SET TOKEN VALUE SBR X3,4+X3 LCA X3,IPTA * B J_RTS DONE * * :=|| * SS1 C LINE+X1,SQUOTE '? BU SS_SV IF NOT, TRY * * * SLIT LCA INSL,X3 NEXT SVT INDEX LCA X3,SINSL SAVE FOR TOKEN LCA ISTNXT,SVTE+X3 SET ST INDEX SBR X3,3+X3 INCREMENT LCA X3,INSL * SBR X1,1+X1 INCREMENT OVER ' LCA CREG,X2 INSURE X2 CLEAR LCA LINE+1+X1,X2 GET CHAR COUNT SBR X1,1+X1 INCREMENT OVER COUNT * LCA ISTNXT,X3 INDEX TO NEXT ST CHAR SBR X3,2+X3 LCA X2,ST+X3 SET COUNT INTO ST CW X2-1 * A X2,X3 ADD COUNT TO INDEXES A X2,X1 AND LCA LINE+X1,ST+X3 MOVE THE LITERAL SBR X1,1+X1 NEXT LINE CHAR LCA X3,ISTNXT SAVE NEW ST INDEX * LCA IPTA,X3 NEXT PTA LCA TSVAL,PTA+X3 SET STRING VALUE TOKEN LCA SINSL,PTA+3+X3 AND SVT INDEX SBR X3,4+X3 INCREMENT INDEX LCA X3,IPTA AND SAVE IT * B J_RTS RETURN * SS_SV LCA N0,J_ERR CLEAR JSR ERROR MCW ASV,J_TO B J_JSR BE J_RTS RETURN PASS * LCA N1,OSTR MCW AINXP,J_TO B J_JSR LCA N0,OSTR B J_RTS RETURN IF SINSL DCW 000 INDEX INTO SVT * * EXECUTE COMMANDS * XLET NOP LET LCA PTA+3+X3,XL_ASN GET ASSIGN VALUE INDEX C PTA+X3,TSVAL BR IF THIS IS A BE XSLET STRING ASSIGNMENT * SBR X3,4+X3 INCREMENT TO NEXT TOKEN MCW AEXEP,J_TO EVALUATE EXPRESSION B J_JSR * LCA XL_ASN,X1 EXPRESSION RESULT LCA EE_NV1,NVTE+X1 TO NVT B J_RTS DONE * XL_ASN DCW 000 * XSLET SBR X3,4+X3 INCREMENT TO NEXT TOKEN CS 299 CLEAR STRING WORK AREA SW SWA LCA N00,SWA+1 SET CHAR COUNT = 0 LCA CREG,SWAI SET START OF WORK AREA LCA CREG,ISWAI AND INITIAL SWA (COUNT) MCW AESEXP,J_TO EXECUTE THE STRING EXPRESSION B J_JSR * LCA XL_ASN,X2 ASSIGN NEXT ST CHAR INDEX LCA ISTNXT,SVTE+X2 TO THE VARIABLE * LCA X3,IPTA PRESERVE X3 LCA N001,X2 LCA SWA+X2,ESLCNT GRAB COUNT FROM SWA SBR X2,1+X2 LCA CREG,X1 X1 = CHAR MOVE COUNTER LCA ISTNXT,X3 X2 = CHAR MOVE INDEX LCA ESLCNT,ST+2+X3 MOVE COUNT TO ST SW ST+3+X3 SBR X3,2+X3 INCREMENT * ESL_1 MZ SWA+X2,ST+1+X3 MOVE CHAR BY CHAR MN SWA+X2,ST+1+X3 SBR X2,1+X2 INCREMENT SBR X3,1+X3 SBR X1,1+X1 C X1,ESLCNT IF NOT MOVED ALL CHARS BU ESL_1 LOOP * LCA X3,ISTNXT SAVE NEXT ST CHAR INDEX LCA IPTA,X3 RESTORE X3 * B J_RTS DONE * ESLCNT DCW 00 * XIF C PTA+X3,TSVAL BRANCH IF THIS IS A BE XSIF STRING COMPARE * MCW AEXEP,J_TO EVALUATE EXPRESSION B J_JSR * C ZERO,EE_NV1 IF FALSE, BE J_RTS CONTINUE TO NEXT LINE B GTLINE ELSE GOTO DESIGNATED LINE * XSIF SW SWA LCA N00,SWA+1 SET CHAR COUNT = 0 LCA CREG,SWAI LCA CREG,ISWAI AND INITIAL SWA (COUNT) MCW AESEXP,J_TO EVALUATE THE LEFT SIDE B J_JSR * LCA SWAI,X1 INDEX TO NEXT SWA CHAR SBR X1,2+X1 LCA X1,XSIFS1 LCA N00,SWA+1+X1 APPEND RIGHT STRING LCA X1,SWAI AFTER LEFT STRING LCA X1,ISWAI MCW AESEXP,J_TO EVALUATE THE LEFT SIDE B J_JSR * LCA XSIFS1,X1 DO THE COMPARE LCA SWAI,X2 C SWA-1+X1,SWA+1+X2 * BRANCH ON RESULTS BL SFSCLT < BE SFSCEQ = * C PTA+3+X3,OLTI > B XSIFR * SFSCLT C PTA+3+X3,OGTI COMPARE RESULT WITH REQUESTED B XSIFR SFSCEQ C PTA+3+X3,OEQI * XSIFR SBR X3,4+x3 INCREMENT TOKEN BU J_RTS IF NOT REQUESTED, RETURN B GTLINE ELSE GOTO * XSIFS1 DCW 000 INDEX TO STRING 1 XFSC DCW 0 STRING COMPARE FLAG * XREM B J_RTS REM * XFOR LCA FNSTOS,X2 * C X2,FNMXST IF STACK OVERFLOW BU XF_1 B ER13 STOP B J_RTS * XF_1 LCA ENLN,FNNLI+X2 LINE AFTER FOR * LCA PTA+3+X3,FNASN+X2 ASSIGN NV INDEX * SBR X3,4+X3 INCREMENT TO NEXT TOKEN MCW AEXEP,J_TO EVALUATE EXPRESSION B J_JSR FOR START VALUE * LCA FNSTOS,X2 LCA FNASN+X2,X1 PUT RESULT INTO NVT LCA EE_NV1,NVTE+X1 TO NVT * MCW AEXEP,J_TO LIMIT EXPRESSION B J_JSR LCA FNSTOS,X2 LCA EE_NV1,FNLMT+X2 * MCW AEXEP,J_TO STEP EXPRESSION B J_JSR LCA FNSTOS,X2 LCA EE_NV1,FNSTP+X2 * SBR X2,26+X2 INCREMENT TOS LCA X2,FNSTOS * B J_RTS DONE * FNSTOS DCW 000 FNMXST DCW 260 MAX STACK INDEX FNSTCK DA 10X26,X2 FOR/NEXT STACK FNNLI 1,3 LINE INDEX AFTER FOR FNASN 3,6 THE ASSIGN TO VAR FNLMT 6,16 LIMIT FNSTP 16,26 STEP * XNEXT C CREG,FNSTOS IF STACK EMPY BE FN_BAD ERROR * LCA FNSTOS,X2 GET TOS INDEX S N026,X2 DECREMENT MZ ZERO,X2 * LCA FNASN+X2,X1 GET NV INDEX A FNSTP+X2,NVTE+X1 ADD STEP TO NV BWZ FN_1B,NVTE+X1,K IF VAR NOT NEG MZ ZERO,NVTE+X1 FIX THE DAMN ZONE FN_1B BWZ FNDTST,FNSTP+X2,K IF STEP NEG, DO DEC TEST * ELSE DO INC TEST BWZ FN_2A,NVTE+X1,K IF VAR NEG, SEE IF LIMIT NEG * * TEST INCREMENT WITH NON NEG VAR AND LIMIT * FN_1A C NVTE+X1,FNLMT+X2 IF NOT OVER LIMIT BH FNCONT CONTINUE BE FNCONT B FNDONE ELSE DONE LOOPING * FN_2A BWZ FN_3,FNLMT+X2,K BR IF LIMIT ALSO NEGATIVE B FN_1A DO THE TEST * * TEST INCREMENT WITH NEG VAR AND LIMIT * FN_3 C NVTE+X1,FNLMT+X2 IF NOT OVER LIMIT BH FNCONT CONTINUE BE FNCONT B FNDONE ELSE DONE LOOPING * FNDTST BWZ FN_3B,NVTE+X1,K BR IF VAR NEG * * TEST DECREMENT WITH NON NEG VAR AND LIMIT * FN_3A C NVTE+X1,FNLMT+X2 IF NOT OVER LIMIT BL FNCONT CONTINUE BE FNCONT B FNDONE ELSE DONE LOOPING * FN_3B BWZ FN_4,FNLMT+X2,K B FN_3A * * TEST DECREMENT WITH NEG VAR AND LIMIT * FN_4 C NVTE+X1,FNLMT+X2 IF NOT OVER LIMIT BH FNCONT CONTINUE BE FNCONT B FNDONE ELSE DONE LOOPING * FNDONE LCA X2,FNSTOS ELSE SAVE NEW TOS B J_RTS EX NEXT STMT AFTER NEXT * FNCONT LCA FNNLI,ENLN NEXT STMT IS STMT AFTER FOR B J_RTS DONE * FN_BAD B ER8 B J_RTS * XGOTO B GTLINE GOTO * XGOSUB LCA GSSTOS,X2 PUSH NEXT LINE INDEX * C X2,GSSMAX IF STACK OVERFLOW BU XGS_1 B ER13 ERROR B J_RTS * XGS_1 LCA ENLN,GSSLTI+X2 ONTO GOSUB STACK SBR X2,3+X2 INCREMENT STACK INDEX LCA X2,GSSTOS B GTLINE NOW GOTO THE LINE * XRTN C CREG,GSSTOS BR IF STACK NOT EMPTY BU XR_1 B ER7 RETURN WITHOUT GOSUB * XR_1 LCA GSSTOS,X2 DECREMENT TOS S N3,X2 MZ ZERO,X2 LCA X2,GSSTOS * LCA GSSLTI+X2,ENLN SET NEXT EX LINE INDED B J_RTS AND DONE. * GSSMAX DCW 030 MAX STACK INDEX GSSTOS DCW 000 GSSTCK DA 10X3,X2 GSSLTI 1,3 GTLINE MCW AEXEP,J_TO EVALUATE EXPRESSION B J_JSR MCW EE_NV1,GO_LNO SET A THREE DIGIT LINE NUMBER * LCA CREG,X1 START AT TOP OF TABLE * GTNXTL C X1,ILT BR AT END OF TABLE BE GTLNF C GO_LNO,LNO+X1 BR IF AT THE RIGHT LINE BE GTLFND BH GTLNF BR IF IF NOT FOUND SBR X1,6+X1 INCREMENT TO NEXT LINE B GTNXTL AND TRY IT * GTLFND LCA X1,ENLN SET NEXT LINE TO EXECUTE B J_RTS * GTLNF B ER6 LINE NOT FOUND B J_RTS GO_LNO DCW 000 XPRINT NOP CS 299 CLEAR STRING WORK AREA SW SWA LCA N00,SWA+1 SET CHAR COUNT = 0 LCA CREG,SWAI LCA SWAI,ISWAI MCW AESEXP,J_TO EXECUTE THE STRING EXPRESSION B J_JSR W B J_RTS * XREAD C NRDATA,NADATA INSURE DATA AVAILABLE BU XR1 B ER10 B J_RTS * XR1 LCA NRDATA,X1 C DATA+X1,PTA+X3 INSURE SAME TYPE BE XR2 B ER11 B J_RTS * XR2 C DATA+X1,TNVAL BRANCH IF NOT NUMBER BU XR_S * LCA DATA+3+X1,XDIND NVT INDEX OF DATA VALUE LCA PTA+3+X3,X2 NVT INDEX OF VAR VALUE LCA XDIND,X1 * LCA NVTE+X1,NVTE+X2 MOVE THE VALUE B XRNXT * XR_S C DATA+X1,TSVAL IF NOT STRING TOKEN BU J_RTS THEN DONE * LCA DATA+3+X1,XDIND NVT INDEX OF DATA VALUE LCA PTA+3+X3,X2 NVT INDEX OF VAR VALUE LCA XDIND,X1 * LCA SVTE+X1,SVTE+X2 MOVE THE VALUE B XRNXT * XRNXT SBR X3,4+X3 NEXT TOKEN A N4,NRDATA NEXT DATA * C PTA+X3,TCMND NEXT TOKEN A COMMAND BE J_RTS MEANS WE ARE DONE * B XREAD ELSE READ NEXT * XDIND DCW 000 XDATA B J_RTS * XEND LCA N1,ECP END B J_RTS * XEOE H START SHOULD NOT GET EXECUTED * XMUL LCA EE_NV2,M_Y * LCA EE_NV1,M_X B M_MULT LCA M_PROD,EE_NV1 B J_RTS * XDIV LCA EE_NV2,D_Y \ LCA EE_NV1,D_X B D_DIV LCA D_QUOT,EE_NV1 LCA D_REM,EE_NV2 B J_RTS * XPLUS A EE_NV2,EE_NV1 B J_RTS * XMINUS S EE_NV2,EE_NV1 MINUS B J_RTS * XUMNUS LCA ZERO,EE_NV1 UNARY MINUS S EE_NV2,EE_NV1 B J_RTS * XLT BWZ XLTN1,EE_NV2,K BR IF V2 IS NEGATIVE XLT_1 C EE_NV2,EE_NV1 < FOR NON-NEGATIVE PAIR LCA ZERO,EE_NV1 BE J_RTS BH J_RTS A N1,EE_NV1 B J_RTS * XLTN1 BWZ XLTN2,EE_NV1,K BR IF V1 IS NEGATIVE B XLT_1 * XLTN2 C EE_NV2,EE_NV1 < FOR NEGATIVE PAIR LCA ZERO,EE_NV1 BE J_RTS BL J_RTS A N1,EE_NV1 B J_RTS * XEQU NOP = C EE_NV2,EE_NV1 LCA ZERO,EE_NV1 BU J_RTS A N1,EE_NV1 B J_RTS XGT BWZ XGTN1,EE_NV2,K BR IF V2 IS NEGATIVE XGT_1 C EE_NV2,EE_NV1 > FOR NON-NEGATIVE PAIR LCA ZERO,EE_NV1 BE J_RTS BL J_RTS A N1,EE_NV1 B J_RTS * XGTN1 BWZ XGTN2,EE_NV1,K BR IF V1 IS NEGATIVE B XLT_1 * XGTN2 C EE_NV2,EE_NV1 > FOR NEGATIVE PAIR LCA ZERO,EE_NV1 BE J_RTS BH J_RTS A N1,EE_NV1 B J_RTS * * EXECUTE EXPRESSION * X3 = TOKEN INDEX * EXEP LCA CREG,EE_TOS ZERO TOS * EXP_1 C PTA+X3,TNVAL ? BE EE_PSH C PTA+X3,TNUMOP ? BE EE_OP * EXP_E1 H START PROGRAM ERROR * EE_PSH LCA PTA+3+X3,X1 X1=NVT INDEX LCA EE_TOS,X2 LCA NVTE+X1,EESENT+X2 NUMBER VALUE -> STACK SBR X2,10+X2 INCREMENT TOS LCA X2,EE_TOS SBR X3,4+X3 INCREMENT TO NEXT TOKEN B EXP_1 LOOP WHILE * EE_OP MCW PTA+3+X3,J_TO OP EXECUTE CODE SBR X3,4+x3 INCREMENT TO NEXT TOKEN * C J_TO,AXEOE BR IF BE EE_FIN END OF EXPRESSION * EE1 LCA EE_TOS,X2 S N10,X2 MZ ZERO,X2 LCA EESENT+X2,EE_NV2 PULL FIRST s * C J_TO,AUMNUS BR NOT OP UNARY MINUS BE EE2 * S N10,X2 PULL SECOND OP MZ ZERO,X2 LCA EESENT+X2,EE_NV1 * EE2 LCA X2,EE_TOS SAVE NEW TOS B J_JSR EXECUTE OPERATOR BU B_RTS IF FAIL, RETURN * RESULT IN NV1 BWZ EENF,EE_NV1,K IF NOT MINUS, FIX + ZONE MZ ZERO,EE_NV1 * EENF LCA EE_TOS,X2 LCA EE_NV1,EESENT+X2 PUSH NV1 ONTO STACK SBR X2,10+X2 LCA X2,EE_TOS B EXP_1 TEST NEXT TOKEN * EE_FIN C EE_TOS,N10 STACK SHOULD HAVE ONE VALUE BU EXP_E2 RETURN: EE_NV1 HAS VALUE LCA CREG,X2 LCA EESENT+X2,EE_NV1 B J_RTS * EXP_E2 H START PRGRAM FAIL * EE_TOS DCW 000 TOP OF STACK EE_NV1 DCW @0000000000@ NUMERIC VALUE 1 EE_NV2 DCW @0000000000@ NUMERIC VALUE 2 EESTK DA 10X10,X2 EESENT 1,10 * * STRING EXECUTIONS * * XCCAT B ESEXP CONCAT NEXT STRING * XEESE B J_RTS END OF STRING EXPRESSION * ESEXP NOP C PTA+X3,TSVAL IS TOKEN STRING VALUE BU ESXNE IF NOT, THEN NUMERIC EXPRESSION LCA PTA+3+X3,X2 GET INDEX TO SVTE SBR X3,4+X3 INCREMENT TOKEN INDEX * LCA X2,ESSVTI SAVE INDEX TO SVTE * LCA SVTE+X2,X1 X1 = INDEX INTO ST LCA ST+2+X1,SSLN GET SOURCE STRING COUNT LCA SSLN,SMSL SET AS MOVE STRING LENGTH SBR X1,3+X1 INCREMENT TO START OF STRING LCA X1,SSTI SAVE SOURCE STRING INDEX LCA SSTI,SMSSTI SET AS MOVE STRING INDEX * ES_2 C PTA+X3,TSSUBS SUBSTRING FOLLOW? BU ES_MS0 IF NOT, BRANCH * * SUBSTRING PROCESSING * SBR X3,1+X3 SKIP OVER TOKEN MCW AEXEP,J_TO EXECUTE EXPRESSION B J_JSR MCW EE_NV1,SMSSTI SAVE AS MOVE START * MCW AEXEP,J_TO EXECUTE EXPRESSION B J_JSR MCW EE_NV1,SMSL SAVE AS MOVE LENGTH * C N001,SMSSTI TEST START <= 0 BL ESSER * C N001,SMSL TEST LENGTH <=0 BL ESSER * S N001,SMSSTI DECREMENT START BY 1 MZ ZERO,SMSSTI LCA SMSSTI,X1 IS MOVE START A SMSL,X1 PLUS LENGTH C X1,SSLN >= SOURCE LENGTH BE ESS_1 BH ESS_1 B ESSER ERROR IF NO * ESS_1 A SSTI,SMSSTI ADD SOURCE INDEX TO START B ES_MS0 AND DO THE MOVE * ESSER B ER9 SUBSTRING ERROR B J_RTS * ESXNE MCW AEXEP,J_TO EXECUTE EXPRESSION B J_JSR LCA ISTNXT,X1 USING ST AS WORK AREA. LCA ESNEEW,ST+13+X1 MOVE EDIT WORD SW ST+3+X1 SET WM FOR COUNT MCE EE_NV1,ST+13+X1 MOVE AND EDIT SW ST+3+X1 * LCA N11,SSLN SET THE LENGTHS LCA SSLN,SMSL SBR X1,3+X1 LCA X1,SSTI AND THE INDEXES LCA SSTI,SMSSTI B ES_2 * @NN1234567890-@ ESNEEW DCW @11 0 -@ * * STRING EXECUTION VARIABLES * ESSVTI DCW 000 INDEX INTO SVT SSLN DCW 00 SOURCE STRING LENGTH SSTI DCW 000 SOURCE STRING INDEX * SMSL DCW 00 MOVE STRING LENGTH SMSSTI DCW 000 MOVE STRING INDEX * SWAI DCW 000 STRING WORK AREA INDEX ISWAI DCW 000 INITIAL SWA INDEX * * MOVE STRING FROM SOURCE TO WORK AREA * ES_MS0 NOP LCA X3,IPTA SAVE TOKEN INDEX LCA ISWAI,X3 GET COUNT PTR ES_MS1 A SMSL,SWA+1+X3 ADD MOVE COUNT TO DEST STRING SW SWA+2+X3 * LCA SWAI,X3 GET NEXT MOVE CHAR INDEX * LCA CREG,X1 X1 = MOVE COUNTER LCA SMSSTI,X2 X2 = SOURCE STRING INDEX * LCA SWAI,X3 X3 = WORK AREA INDEX * ES_MS2 MZ ST+X2,SWA+2+X3 MOVE CHAR BY CHAR MN ST+X2,SWA+2+X3 SBR X1,1+X1 INCREMENT INDEXES SBR X2,1+X2 SBR X3,1+X3 C X1,SMSL IF NOT MOVED ALL CHARS BU ES_MS2 CONTINUE * LCA X3,SWAI SAVE NEW WORK AREA INDEX LCA IPTA,X3 RESTORE TOKEN INDEX * MCW PTA+3+X3,ES_EOP+3 CW ES_EOP+1 SBR X3,4+X3 ES_EOP B 000 * * ERRORS * ER1 SBR ERTN+3 NO END CARD LCA STARS,PRA+6 LCA EM1,PRA+80 B ERTN_2 EM1 DCW @NO END CARD@ * ER2 SBR ERTN+3 NEW LINE NOT > LAST CS 299 LCA STARS,PRA+6 LCA EM2,PRA+80 B ERTN_2 EM2 DCW @THIS LINE NUMBER LESS THAN PREVIOUS@ * ER3 SBR ERTN+3 INVALID COMMAND CS 299 LCA STARS,PRA+6 LCA EM3,PRA+80 B ERTN_2 EM3 DCW @INVALID COMMAND@ * ER4 SBR ERTN+3 SYNTAX ERROR CS 299 LCA STARS,PRA+6 LCA EM4,PRA+80 B ERTN_2 EM4 DCW @SYNTAX ERROR@ * ER5 SBR ERTN+3 TRY AGAIN CS 299 LCA STARS,PRA+6 LCA EM5,PRA+80 B ERTN_2 EM5 DCW @FIX ERRORS AND TRY AGAIN@ * ER6 SBR ERTN+3 GOTO LINE NOT FOUND CS 299 MCW EE_NV1,EM6B SET GT LINE NO LCA EM6A,PRA+27 LCA EM6B,PRA+30 LCA EM6C,PRA+40 B ERTN_1 EM6A DCW @ LINE NUMBER @ EM6B DCW 000 EM6C DCW @ NOT FOUND@ * ER7 SBR ERTN+3 CS 299 LCA EM7,PRA+35 RETURN WITHOUT GOSUB B ERTN_1 EM7 DCW @ RETURN WITHOUT GOSUB@ * ER8 SBR ERTN+3 NEXT WITHOUT FOR CS 299 LCA EM8,PRA+32 B ERTN_1 EM8 DCW @ NEXT WITHOUT FOR@ * ER9 SBR ERTN+3 CS 299 LCA EM9,PRA+42 B ERTN_1 EM9 DCW @ INVALID SUBSTRING PARAMETER@ * ER10 SBR ERTN+3 CS 299 LCA EM10,PRA+28 B ERTN_1 EM10 DCW @ ALL DATA READ@ * ER11 SBR ERTN+3 CS 299 LCA EM11,PRA+34 B ERTN_1 EM11 DCW @ READ/DATA NOT SAME@ * ER12 SBR ERTN+3 CS 299 LCA EM12,PRA+35 B ERTN_1 EM12 DCW @ STOPPED BY OPERATOR@ * ER13 SBR ERTN+3 CS 299 LCA EM13,PRA+30 B ERTN_1 EM13 DCW @ STACK OVERFLOW@ * ER14 SBR ERTN+3 CS 299 LCA EM14,PRA+27 B ERTN_1 EM14 DCW @ OUT OF MEMORY@ * ERTN_1 LCA XLINE, PRA+10 SET AT LINE NO LCA CLNO,ELNO MESSAGE LCA ELNO,PRA+13 LCA N1,J_ERR * ERTN_2 W PRINT MSG CS 299 CLEAR PRINT AREA LCA N1,ERROR FLAG ERROR ERTN B 000 * XLINE DCW @*AT LINE: @ ELNO DCW 000 NOTE: MESSAGE START AT 14 STARS DCW @*****@ * * JUMP TO SUBROUTINE * USED FOR RECURSIVE CALLS * PUT JUMP_TO ADDR IN J_TO * J_JSR SBR J_RTN TEMP STORE OF RTN ADR LCA X1,J_X1 PRESERVE X1 A N3,J_TOS INCREMENT TOS LCA J_TOS,X1 AND LOAD IT INTO X1 * C X1,J_MAXS IF STACK OVERFLOW BU J_1 B ER13 PRINT ERROR MESSAGE B EX_FIN AND STOP EVERYTHING * J_1 LCA J_RTN,J_SENT MOVE RETURN ADR TO STACK LCA J_X1,X1 RESTORE X1 LCA N0,J_ERR SET NO ERROR J_TO EQU *+4 B 000 GO TO THE SUBROUTINE J_RTN DCW 000 * * RETURN FROM SUBROUTINE * IF RETURNING AN ERROR CONDITION * SET J_ERR TO NOT ZERO * RTS WILL COMPARE TO SET A CONDITION CODE * J_RTS C CREG,J_TOS INSURE STACK NOT EMPTY BU J_R1 J_HALT H START * J_R1 LCA X1,J_X1 PRESERVE X1 LCA J_TOS,X1 MOVE TOS TO X1 S N3,J_TOS DECREMENT TOS MZ N3+1,J_TOS CLEAR THE &%! ZONE MCW J_SENT,J_RTN1+3 PULL RETURN TO ADR LCA J_X1,X1 RESTORE X1 C N0,J_ERR SET CONDITION CODE J_RTN1 B 000 RETURN TO CALLER * DCW @XX@ J_ERR DCW 0 ERROR IF 1 J_X1 DCW 000 J_TOS DCW 000 J_MAXS DCW 060 MAX STACK SIZE J_STK DA 20X3,X1 J_SENT 1,3 * * * ************* MULTIPLY SUBROUTINE ************ * * * M_X = MULTIPLICAND, 10 CHAR * M_Y = MULTIPLYER, 10 CHAR * M_PROD = PRODUCT, LEAST SIGNIFICANT 10 CHARS * PRODUCT SIGN WILL BE CORRECT * M_MULT NOP SBR M_SR1+3 CW M_PROD-9 CLEAR ANY PREVIOUS WM * * ****** PREPARE FOR PROPER SIGN ********* * MZ M_Y,M_YZN SAVE Y ZONE MZ M_ZERO,M_Y SET Y POSITIVE MZ M_X,M_XZN SAVE X ZONE MZ M_ZERO,M_X MAKE X POSITIVE * BSS M_NMUL,F SSF ON, NOT MACHINE MULTIPLY * * ******** DO MACHINE MULTIPLY ************ * LCA M_Y,M_HPRD+9 MOVE Y TO UPPER HALF M M_X,M_PROD MACHINE MULTIPLY * * ******** SET PRODUCT SIGN *************** * M_SIGN NOP SW M_PROD-9 SET PRODUCT 10 CHAR WM C M_XZN,M_MNUS IF X IS MINUS BE M_FIXY LEAVE ZONE BITS ALONE MZ M_ZERO,M_XZN ELSE STRIP AB BITS FROM IT M_FIXY C M_YZN,M_MNUS IF Y IS MINUS BE M_SS LEAVE ZONE BITS ALONE MZ M_ZERO,M_YZN ELSE STRIP AB BIT FROM IT * M_SS MZ M_ZERO,M_PROD SET PRODUCT POSTIVE C M_YZN,M_XZN IF Z AND Y ZONE MATCH, POSTIVE BE M_SR1 MZ M_MNUS,M_PROD ELSE NEGATIVE * DONE M_SR1 B 0000 RETURN * * @1234567890 M_X DCW #10 MULTIPLICAND M_Y DCW #10 MULTIPLYER DCW @XX@ MARKER M_HPRD DCW #10 DC #10 PRODUCT, UPPER HALF M_PROD DC #10 PRODUCT, LOWER HALF DCW @XX@ MARKER * * NON MACHINE MULTIPLY * M_NMUL SBR M_SR2+3 SAVE RETURN ADR * LCA M_ZERO,M_PROD CLEAR PRODUCT AREA ZA M_Y,M_HPRD MOVE Y TO UPPER AREA * M_ZTST BCE M_TWM,M_HPRD,0 TEST FOR TRUE ZERO BCE M_TWM,M_HPRD,? IF TRUE ZERO BCE M_TWM,M_HPRD, IF TRUE ZERO * A M_X,M_PROD-9 ADD X TO PRODUCT S M_ONE,M_HPRD DECREMENT COUNTER B M_ZTST TEST FOR TENS * M_TWM BW M_SR2,M_HPRD IF AT M_CNTR WM, DONE LCA M_PROD-1,M_PROD SHIFT PRODUCT RIGHT B M_ZTST GO TEST FOR TENS * M_SR2 B 0000 RETURN * DCW @0000000000@ DC @0000000000@ M_ZERO DC @0000000000@ M_ONE DCW 1 M_MNUS DCW -0 M_YZN DCW 0 M_XZN DCW 0 DCW @X@ M_CNTR DCW #12 DCW @X@ MARKER * * ****************** DIVIDE SUBROUTINE ********************** * DIVIDEND = D_X * DIVSOR = D_Y * QUOTION = D_QUOT * REMAINDER = D_REM * * ALL FIELDS ARE 10 CHARCTERS * D_DIV NOP SBR D_RTS+3 SET RTS ADR LCA X1,D_SVX1 SAVE X1 FOR RESTORE LCA X1,D_SVX2 SAVE X2 FOR RESTORE * * DO SOFTWARE DIVIDE * * * * SAVE SIGNS AND MAKE X AND Y UNSIGNED * MZ D_X,D_XZN MZ D_ZERO,D_X MZ D_Y,D_YZN MZ D_ZERO,D_Y * * LEFT JUSTIFY DIVISOR AND DIVIDEND * * LEFT JUSTIFY DIVISOR SW D_Y+1 CW D_Y+1 LCA D_ZERO-7,X2 X2=DIVISOR DIGIT COUNT * SHIFT Y INTO VSOR D_VSSR C D_ZERO,D_Y UNTIL Y IS ZERO BE D_VND THEN DO SAME FOR DIVIDEND SBR X2,1+X2 ADD ONE TO DIGIT COUNT MZ D_ZERO,D_Y CLEAR ZONES LCA D_VSOR-1,D_VSOR SHIFT ONE CHAR RIGHT B D_VSSR UNTI DONE. * * * LEFT JUSTIFY DIVIDEND D_VND SW D_X+1 CW D_X+1 ZA D_ZERO,D_DVNC CLEAR DIVIDEND DIGIT COUNT * D_VNSR NOP C D_ZERO,D_X SHIFT X INTO VEND BE D_BGN UNTIL X IS ZERO A D_ONE,D_DVNC ADD ONE TO DIGIT COUNT MZ D_ZERO,D_X CLEAR ZONE BEFORE SHIFT LCA D_VEND-1,D_VEND SHIFT ONE CHAR RIGHT B D_VNSR * * * D_BGN NOP BEGIN PROCESS SW D_Y+1 SW D_X+1 ZA D_ZERO,D_QUOT CLEAR QUOTION ZA D_ZERO,X1 CLEAR X1 MZ D_ZERO,X1 MCW X2,X1 ZA D_ZERO,D_SCNT CLEAR SUBTRACT COUNTER ZA D_DVNC,D_DGCN SET DIGIT COUNT DOWN S X1,D_DGCN DIVIDEND DIGITS - DEVISOR DIGITS * D_SUB NOP C D_X+X1,D_Y+X2 IS DIVSOR > DIVIDEND BH D_L1 BRANCH BRANCH IF YES A D_ONE,D_SCNT ELSE INCREMENT SUBTRACT COUNT S D_Y+X2,D_X+X1 AND SUBTRACT DIVISOR FROM DIVIDEND MZ D_ZERO,D_X+X1 CLEAR ZONE B D_SUB AND DO AGAIN * D_L1 NOP ZA D_ZERO,D_WRK SHIFT QUOTION LEFT ONE DIGIT LCA D_QUOT,D_WRK-1 MCW D_WRK,D_QUOT A D_SCNT,D_QUOT ADD SUBTRACT COUNT TO QUOTE * S D_ONE,D_DGCN DECREMENT DIGIT COUNT BM D_DONE,D_DGCN IF NOW < ZERO, DONE * ZA D_ZERO,D_SCNT CLEAR SUBTRACT COUNT SBR X1,1+X1 INCREMENT X1 SBR X2,1+X2 INCREMENT X2 CW D_Y+1 LCA D_VSOR-1,D_VSOR SHIFT DIVISIOR RIGHT ONE SW D_Y+1 * B D_SUB NEXT DIGITS * D_DONE NOP LCA D_ZERO,D_X RIGHT JUSTIFY REMAINDER CW D_X+1 D_JREM LCA D_REM-1,D_REM SHIFT REMAINER RIGHT A D_ONE,D_DVNC ADD ONE TO DIVIDEND DIGIT COUNT MZ D_ZERO,D_DVNC C D_DVNC,D_TEN UNTIL IT IS TEN BU D_JREM SW D_X+1 * * SET SIGNS * C D_XZN,D_MNUS IF X IS MINUS BE D_FIXY LEAVE ZONE BITS ALONE MZ D_ZERO,D_XZN ELSE STRIP AB BITS FROM IT D_FIXY C D_YZN,D_MNUS IF Y IS MINUS BE D_CXY LEAVE ZONE BITS ALONE MZ D_ZERO,D_YZN ELSE STRIP AB BIT FROM IT * D_CXY C D_XZN,D_YZN X=Y BE D_TXZ BR X,Y ZONES EQUAL MZ D_MNUS,D_QUOT ELSE SET QUOTION MINUS D_TXZ C D_XZN,D_ZERO-9 TEST UNSINGED PLUS BE D_RTS MZ D_MNUS,D_REM ELSE SET REMAINDER MINUS D_RTS B 0000 * * * DCW @XX@ D_QUOT DCW #10 QUOTION DCW @X@ D_X DCW #10 X D_REM EQU D_VEND VEND IS ALSO REMAINDER D_VEND DCW #10 DIVIDEND DCW @X@ D_Y DCW #10 Y D_VSOR DCW #10 DIVSOR DCW @ZZ@ * D_DVNC DCW 00 DIVIDEND DIGIT COUNT D_DGCN DCW 00 DIV DIGIT COUNT DOWN D_SCNT DCW 00 SUBTRACT COUNT DCW @X@ D_AB DCW @A@ AB ZONES = 1 D_TEN DCW @10@ D_ONE DCW 1 CONSTANT ONE D_MNUS DCW -0 MINUS ZONE D_ZERO DCW @0000000000@ CONSTANT ZERO DCW @X@ D_WRK DCW #11 WORK AREA OF SHIFT LEFT DCW @XXX@ D_XZN DCW 0 D_YZN DCW 0 D_SVX1 DCW 000 SAVE X1 D_SVX2 DCW 000 SAVE X2 * END START