; FOR AKI-Z80 MACLIB Z80 0100 = MONITOR EQU 0100H 0FD1 ORG 0FD1H ; OUTPUT CHAR ON A ; BS -> BS, SP, BS ; CR -> CR, LF 0FD1 FE08 RST3: CPI 08H JRNZ OUTCH0 0FD3+2006 DB 20H,OUTCH0-$-1 0FD5 DF RST 3 0FD6 3E20 MVI A, 20H 0FD8 DF RST 3 0FD9 3E08 MVI A, 08H 0FDB DF OUTCH0: RST 3 0FDC FE0D CPI CR 0FDE C0 RNZ 0FDF 3E0A MVI A, LF 0FE1 DF RST 3 0FE2 3E0D MVI A, CR 0FE4 C9 RET ; INPUT CHAR TO A ; Z-FLAG IF NOT ; CTRL-C -> BREAK ; CTRL-S -> PAUSE ; DEL => BS 0FE5 CF RST2: RST 1 0FE6 C8 RZ 0FE7 D7 RST 2 0FE8 FE7F CPI 7FH ; DEL? JRNZ CHK0 0FEA+2002 DB 20H,CHK0-$-1 0FEC 3E08 MVI A, 08H ; => BS 0FEE FE03 CHK0: CPI 03H ; BREAK? 0FF0 CA5710 JZ RSTART 0FF3 FE13 CPI 13H ; PAUSE? 0FF5 C0 RNZ 0FF6 CF CHK1: RST 1 JRZ CHK1 0FF7+28FD DB 28H,CHK1-$-1 0FF9 D7 RST 2 0FFA FE03 CPI 03H ; BREAK? 0FFC CA5710 JZ RSTART 0FFF C9 RET ; PCWPATB.ASM ; ----------- ; ; SOFTWARE: ED, MAC, SID ; HARDWARE: AMSTRAD PCW8256, CP/M PLUS V1.4 ; (THE ONLY HARDWARE SPECIFIC PART IS THE ; SID RESTART POINT, AT LABEL SID: ) ; ; PALO ALTO TINY BASIC INTERPRETER VERSION 3.0 ; ; SEE "DR. DOBB'S JOURNAL" VOL.1 NO.1 TO 5. ; MY ADVICE IS TO BUY THE VOLUME 1 OF DDJ: ; M&T PUBLISHING INC. ; 501 GALVESTON DRIVE ; REDWOOD CITY ; CA 94063 ; USA ; --- ; ; PALO ALTO TINY BASIC V3.0 ; OK ; > ; ; TYPE PALO ALTO TINY BASIC COMMANDS IN UPPER CASES. ; ; ; ------------------------------- ; 000D = CR EQU 0DH 000A = LF EQU 0AH ; ; ------------------------------- ; TSTC MACRO CHAR, LABEL CALL TSTCH DB CHAR DB LOW LABEL-$-1 ENDM ; ; ------------------------------- ; ITEM MACRO FIRST, SECOND IF NUL FIRST DB HIGH SECOND + 8000H DB LOW SECOND ELSE DB FIRST DB HIGH SECOND + 8000H DB LOW SECOND ENDIF ENDM ; ; THE FOLLOWING IS THE ORIGINAL CODE (SLIGHTY EDITED FOR CP/M). ; --------------------------------------------------------------- ; ; P A T B ; PALO ALTO TINY BASIC INTERPRETER ; VERSION 3.0 ; FOR 8080 SYSTEM ; LI-CHEN WANG ; 26 APRIL, 1977 ; ; --------------------------------------------------------------- ; ; *** MEMORY USAGE *** ; ; 0080-01FF ARE FOR VARIABLES, INPUT LINE AND STACK ; 2000-3FFF ARE FOR TINY BASIC TEXT & ARRAY ; F000-F7FF ARE FOR PATB CODE ; ; 1000 = BOTROM EQU 01000H ; JIRO> BASIC 8800 = BOTSCR EQU 08800H ; JIRO> DATA 9000 = TOPSCR EQU 09000H ; JIRO> | 9000 = BOTRAM EQU 09000H ; JIRO> PROGRAM FF00 = DFTLMT EQU 0FF00H ; JIRO> | ; ; DEFINE VARIABLES, BUFFER AND STACK IN RAM ; 8800 ORG BOTSCR 8800 TXTLMT DS 2 ; -> LIMIT OF TEXT AREA 8802 VARBGN DS 2*26 ; TB VARIABLES A-Z 8836 CURRNT DS 2 ; POINTS TO CURRENT LINE 8838 STKGOS DS 2 ; SAVES SP IN 'GOSUB' 883A VARNXT DS 0 ; TEMPORARY STORAGE 883A STKINP DS 2 ; SAVES SP IN 'INPUT' 883C LOPVAR DS 2 ; 'FOR' LOOP SAVE AREA 883E LOPINC DS 2 ; INCREMENT 8840 LOPLMT DS 2 ; LIMIT 8842 LOPLN DS 2 ; LINE NUMBER 8844 LOPPT DS 2 ; TEXT POINTER 8846 RANPNT DS 2 ; RANDOM NUMBER POINTER 8848 DS 1 ; EXTRA BYTE FOR BUFFER 8849 BUFFER DS 132 ; INPUT BUFFER 88CD BUFEND DS 0 ; BUFFER END 88CD DS 4 ; EXTRA BYTES FOR STACK 88D1 STKLMT DS 0 ; SOFT LIMIT FOR STACK ; 9000 ORG TOPSCR ; 9000 STACK DS 0 ; STACK STARTS HERE ; 9000 ORG BOTRAM ; 9000 TXTUNF DS 2 ; UNFILLED TEXT SAVE AREA 9002 TEXT DS 2 ; TEXT SAVE AREA ; ; --------------------------------------------------------------- ; ; *** INITIALIZE ; ;;;;;;;; ; START ;;;;;;;; 1000 ORG BOTROM 1000 310090 INIT: LXI SP, STACK 1003 CDDD17 CALL CRLF 1006 2100FF LXI H, DFTLMT ;AND SET DEFAULT VALUE 1009 220088 SHLD TXTLMT ;IN 'TXTLMT' 100C 3E10 MVI A, HIGH BOTROM ;INITIALIZE RANPNT 100E 324788 STA RANPNT+1 1011 210690 PURGE: LXI H, TEXT+4 ;PURGE TEXT AREA 1014 220090 SHLD TXTUNF 1017 26FF MVI H, 0FFH 1019 220290 SHLD TEXT 101C 112510 TELL: LXI D, MSG ; TELL USER 101F CD6916 CALL PRTSTG ; ************************* 1022 C35710 JMP RSTART 1025 50414C4F20MSG: DB 'PALO ' 102A 414C544F20 DB 'ALTO ' 102F 54494E5920 DB 'TINY ' 1034 4241534943 DB 'BASIC' 1039 2056332E30 DB ' V3.0' 103E 2F414B490D DB '/AKI', CR ; 1043 4F4B OK: DB 'OK' 1045 0D DB CR ; 1046 574841543FWHAT: DB 'WHAT?' 104B 0D DB CR ; 104C 484F573F HOW: DB 'HOW?' 1050 0D DB CR ; 1051 534F525259SORRY: DB 'SORRY' 1056 0D DB CR ; ; --------------------------------------------------------------- ; ; *** DIRECT COMMAND / TEXT COLLECTER *** ; ; PATB PRINTS OUT "OK(CR)", AND THEN IT PROMPTS ">" AND READS ; A LINE. IF THE LINE STARTS WITH A NON-ZERO NUMBER, THIS ; NUMBER IS THE LINE NUMBER. THE LINE NUMBER (IN 16 BIT ; BINARY) AND THE REST OF THE LINE (INCLUDING CR) IS STORED ; IN THE MEMORY. IF A LINE WITH THE SAME LINE NUMBER IS ALREADY ; THERE, IT IS REPLACED BY THE NEW ONE. IF THE REST OF THE LINE ; CONSISTS OF A CR ONLY, IT IS NOT STORED AND ANY EXISTING LINE ; WITH THE SAME LINE NUMBER IS DELETED. ; ; AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM ; LOOPS BACK AND ASK FOR ANOTHER LINE. THIS LOOP WILL BE ; TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE NUMBER; ; AND CONTROL IS TRANSFERED TO "DIRECT". ; ; TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION ; LABELED "TEXT". THE END OF TEXT IS MARKED BY 2 BYTES XX FF. ; FOLLOWING THESE ARE 2 BYTES RESERVED FOR THE ARRAY ELEMENT ; @(0). THE CONTENT OF LOCATION LABELED "TXTUNF" POINTS TO ONE ; AFTER @(0). ; ; THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER THAT ; IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN THIS LOOP ; OR WHILE WE ARE INTERPRETING A DIRECT COMMAND (SEE NEXT ; SECTION), "CURRNT" SHOULD POINT TO A 0. ; 1057 310090 RSTART: LXI SP, STACK ; RE-INITIALIZE STACK 105A 216110 LXI H, ST1+1 ; LITERAL 0 105D 223688 SHLD CURRNT ; CURRNT->LINE # = 0 1060 210000 ST1: LXI H, 0 1063 223C88 SHLD LOPVAR 1066 223888 SHLD STKGOS 1069 114310 LXI D, OK ; DE->STRING 106C CD6916 CALL PRTSTG ; PRINT STRING UNTIL CR 106F 3E3E ST2: MVI A, '>' ; PROMPT '>' AND 1071 CDA917 CALL GETLN ; READ A LINE 1074 D5 PUSH D ; DE->END OF LINE 1075 114988 LXI D, BUFFER ; DE->BEGINNING OF LINE 1078 CDD315 CALL TSTNUM ; TEST IF IT IS A NUMBER 107B CD2615 CALL IGNBLK 107E 7C MOV A, H ; HL=VALUE OF THE # OR 107F B5 ORA L ; 0 IF NO # WAS FOUND 1080 C1 POP B ; BC->END OF LINE 1081 CAD010 JZ DIRECT 1084 1B DCX D ; BACKUP DE AND SAVE 1085 7C MOV A, H ; VALUE OF LINE # THERE 1086 12 STAX D 1087 1B DCX D 1088 7D MOV A, L 1089 12 STAX D 108A C5 PUSH B ; BC, DE -> BEGIN, END 108B D5 PUSH D 108C 79 MOV A, C 108D 93 SUB E 108E F5 PUSH PSW ; A=# OF BYTES IN LINE 108F CD6815 CALL FNDLN ; FIND THIS LINE IN SAVE 1092 D5 PUSH D ; AREA, DE->SAVE AREA 1093 C2A610 JNZ ST3 ; NZ=NOT FOUND, INSERT 1096 D5 PUSH D ; Z=FOUND, DELETE IT 1097 CD8115 CALL FNDNXT ; SET DE->NEXT LINE 109A C1 POP B ; BC->LINE TO BE DELETED 109B 2A0090 LHLD TXTUNF ; HL->UNFILLED SAVE AREA 109E CD0416 CALL MVUP ; MOVE UP TO DELETE 10A1 60 MOV H, B ; TXTUNF->UNFILLED AREA 10A2 69 MOV L, C 10A3 220090 SHLD TXTUNF ; UPDATE 10A6 C1 ST3: POP B ; GET READY TO INSERT 10A7 2A0090 LHLD TXTUNF ; BUT FIRST CHECK IF 10AA F1 POP PSW ; THE LENGTH OF NEW LINE 10AB E5 PUSH H ; IS 3 (LINE # AND CR) 10AC FE03 CPI 3 ; THEN DO NOT INSERT 10AE CA5710 JZ RSTART ; MUST CLEAR THE STACK 10B1 85 ADD L ; COMPUTE NEW TXTUNF 10B2 5F MOV E, A 10B3 3E00 MVI A, 0 10B5 8C ADC H 10B6 57 MOV D, A ; DE->NEW UNFILLED AREA 10B7 2A0088 LHLD TXTLMT ; CHECK TO SEE IF THERE 10BA EB XCHG 10BB CDF114 CALL COMP ; IS ENOUGH SPACE 10BE D26115 JNC QSORRY ; SORRY, NO ROOM FOR IT 10C1 220090 SHLD TXTUNF ; OK, UPDATE TXTUNF 10C4 D1 POP D ; DE->OLD UNFILLED AREA 10C5 CD0F16 CALL MVDOWN 10C8 D1 POP D ; DE->BEGIN, HL->END 10C9 E1 POP H 10CA CD0416 CALL MVUP ; MOVE NEW LINE TO 10CD C36F10 JMP ST2 ; SAVE AREA ; ; --------------------------------------------------------------- ; ; *** DIRECT *** & EXEC *** ; ; THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE. ; WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION ; OF CODE ACCORDING TO THE TABLE. ; ; AT 'EXEC', DE SHOULD POINT TO THE STRING AND HL SHOULD POINT ; TO THE TABLE-1. AT 'DIRECT', DE SHOULD POINT TO THE STRING, ; HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF ; ALL DIRECT AND STATEMENT COMMANDS. ; ; A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL ; MATCH WILL BE CONSIDERED AS A MATCH, E.G., 'P.', 'PR.', ; 'PRI.', 'PRIN.' OR 'PRINT' WILL ALL MATCH 'PRINT'. ; ; THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM IS A ; STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND A JUMP ADDRESS ; STORED HI-LOW WITH BIT 7 OF THE HIGH BYTE SET TO 1. ; ; END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE ; STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL MATCH ; THIS NULL ITEM AS DEFAULT. ; 10D0 210617 DIRECT: LXI H, TAB1-1 ; *** DIRECT *** ; 10D3 CD2615 EXEC: CALL IGNBLK ; *** EXEC *** 10D6 D5 PUSH D ; SAVE POINTER 10D7 1A EX1: LDAX D ; IF FOUND '.' IN STRING 10D8 13 INX D ; BEFORE ANY MISMATCH 10D9 FE2E CPI '.' ; WE DECLARE A MATCH 10DB CAF410 JZ EX3 10DE 23 INX H ; HL->TABLE 10DF BE CMP M ; IF MATCH, TEST NEXT 10E0 CAD710 JZ EX1 10E3 3E7F MVI A, 07FH ; ELSE, SEE IF BIT 7 10E5 1B DCX D ; OF TABLE IS SET, WHICH 10E6 BE CMP M ; IS THE JUMP ADDRESS (HIGH) 10E7 DAFB10 JC EX5 ; C=YES, MATCHED 10EA 23 EX2: INX H ; NC=NO, FIND JUMP ADDRESS 10EB BE CMP M 10EC D2EA10 JNC EX2 10EF 23 INX H ; BUMP TO NEXT TABLE ITEM 10F0 D1 POP D ; RESTORE STRING POINTER 10F1 C3D310 JMP EXEC ; TEST AGAIN NEXT ITEM 10F4 3E7F EX3: MVI A, 07FH ; PARTIAL MATCH, FIND 10F6 23 EX4: INX H ; JUMP ADDRESS, WHICH IS 10F7 BE CMP M ; FLAGGED BY BIT 7 10F8 D2F610 JNC EX4 10FB 7E EX5: MOV A, M ; LOAD HL WITH THE JUMP 10FC 23 INX H ; ADDRESS FROM THE TABLE 10FD 6E MOV L, M ; **************** 10FE E67F ANI 07FH ; *** ANI 07FH *** 1100 67 MOV H, A ; **************** 1101 F1 POP PSW ; CLEAN UP THE GARBAGE 1102 E9 PCHL ; AND WE GO DO IT ; ; --------------------------------------------------------------- ; ; WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT ; COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE ; COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST ; SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS TRANSFERED ; TO OTHER SECTIONS AS FOLLOWS: ; ; FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'RSTART'. ; FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IF ANY; ; ELSE GO BACK TO 'RSTART'. ; FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE. ; FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE. ; FOR ALL OTHERS: IF 'CURRNT' -> 0, GO TO 'RSTART', ; ELSE GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.) ; ; --------------------------------------------------------------- ; ; *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO *** ; ; 'NEW(CR)' RESETS 'TXTUNF'. ; ; 'STOP(CR)' GOES BACK TO 'RSTART'. ; ; 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS ; (IN 'CURRNT'), AND START EXECUTE IT. NOTE THAT ONLY THOSE ; COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM. ; ; THERE ARE 3 MORE ENTRIES IN 'RUN': ; 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDRESS AND EXECUTES IT. ; 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTE IT. ; 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE. ; ; 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET ; LINE, AND JUMP TO 'RUNTSL' TO DO IT. ; 1103 CD2E15 NEW: CALL ENDCHK ; *** NEW(CR) *** 1106 C31110 JMP PURGE ; 1109 CD2E15 STOP: CALL ENDCHK ; *** STOP(CR) *** 110C C35710 JMP RSTART ; 110F CD2E15 RUN: CALL ENDCHK ; *** RUN(CR) *** 1112 110290 LXI D, TEXT ; FIRST SAVED LINE ; 1115 210000 RUNNXL: LXI H, 0 ; *** RUNNXL *** 1118 CD7015 CALL FNDLP ; FIND WHATEVER LINE # 111B DA5710 JC RSTART ; C=PASSED TXTUNF, QUIT ; 111E EB RUNTSL: XCHG ; *** RUNTSL *** 111F 223688 SHLD CURRNT ; SET 'CURRNT'->LINE # 1122 EB XCHG 1123 13 INX D ; BUMP PASS LINE # 1124 13 INX D ; 1125 CDE217 RUNSML: CALL CHKIO ; *** RUNSML *** 1128 212117 LXI H, TAB2-1 ; FIND COMMAND IN TAB2 112B C3D310 JMP EXEC ; AND EXECUTE IT ; 112E CD5F13 GOTO: CALL EXPR ; *** GOTO EXPR *** 1131 D5 PUSH D ; SAVE FOR ERROR ROUTINE 1132 CD2E15 CALL ENDCHK ; MUST FIND A CR 1135 CD6815 CALL FNDLN ; FIND THE TARGET LINE 1138 C2FE15 JNZ AHOW ; NO SUCH LINE # 113B F1 POP PSW ; CLEAR THE "PUSH DE" 113C C31E11 JMP RUNTSL ; GO DO IT ; ; --------------------------------------------------------------- ; ; *** LIST *** & PRINT *** ; ; LIST HAS THREE FORMS: ; 'LIST(CR)' LISTS ALL SAVED LINES. ; 'LIST N(CR)' START LIST AT LINE N. ; 'LIST N1, N2(CR)' START LIST AT LINE N1 FOR N2 LINES. ; (YOU CAN STOP THE LISTING BY CONTROL-C KEY.) ; ; PRINT COMMAND IS 'PRINT .....;' OR 'PRINT ....(CR)' ; WHERE '...' IS A LIST OF EXPRESSIONS, FORMATS, AND/OR STRINGS. ; THESE ITEMS ARE SEPARATED BY COMMAS. ; ; A FORMAT IS A NUMBER SIGN FOLLOWED BY A NUMBER. IT CONTROLS ; THE NUMBER OF SPACES THE VALUE OF A EXPRESSION IS GOING ; TO BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT ; COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS ; SPECIFIED, 8 POSITIONS WILL BE USED. ; ; A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF ; DOUBLE QUOTES. ; ; CONTROL CHARACTERS AND LOWER CASE LETTERS CAN BE INCLUDED ; INSIDE THE QUOTES. ANOTHER (BETTER) WAY OF GENERATING CONTROL ; CHARACTERS ON THE OUTPUT IS USE THE UP-ARROW CHARACTER ; FOLLOWED BY A LETTER. L MEANS FF, I MEANS HT, ; G MEANS BELL, ETC. ; ; A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN PRINTED ; OR IF THE LIST IS A NULL LIST. HOWEWER IF THE LIST ENDED WITH ; A COMMA, NO (CRLF) IS GENERATED. ; 113F CDD315 LIST: CALL TSTNUM ; TEST IF THERE IS A # 1142 E5 PUSH H 1143 21FFFF LXI H, 0FFFFH TSTC ',', LS1 1146+CDBF15 CALL TSTCH 1149+2C DB ',' 114A+03 DB LOW LS1-$-1 114B CDD315 CALL TSTNUM 114E E3 LS1: XTHL 114F CD2E15 CALL ENDCHK ; IF NO #, WE GET A 0 1152 CD6815 CALL FNDLN ; FIND THIS OR NEXT LINE 1155 DA5710 LS2: JC RSTART ; C=PASSED TXTUNF 1158 E3 XTHL 1159 7C MOV A, H 115A B5 ORA L 115B CA5710 JZ RSTART 115E 2B DCX H 115F E3 XTHL 1160 CDF616 CALL PRTLN ; PRINT THE LINE 1163 CD6916 CALL PRTSTG 1166 CDE217 CALL CHKIO 1169 CD7015 CALL FNDLP ; FIND NEXT LINE 116C C35511 JMP LS2 ; AND LOOP BACK ; 116F 0E08 PRINT: MVI C, 8 ; C=# OF SPACES TSTC ';', PR1 ;IF NULL LIST & ";" 1171+CDBF15 CALL TSTCH 1174+3B DB ';' 1175+06 DB LOW PR1-$-1 1176 CDDD17 CALL CRLF ; GIVE CR-LF AND 1179 C32511 JMP RUNSML ; CONTINUE SAME LINE PR1: TSTC CR, PR6 ; IF NULL LIST (CR) 117C+CDBF15 CALL TSTCH 117F+0D DB CR 1180+24 DB LOW PR6-$-1 1181 CDDD17 CALL CRLF ; ALSO GIVE CR-LF AND 1184 C31511 JMP RUNNXL ; GO TO NEXT LINE PR2: TSTC '#', PR4 ; ELSE, IS IT FORMAT? 1187+CDBF15 CALL TSTCH 118A+23 DB '#' 118B+0E DB LOW PR4-$-1 118C CD5F13 PR3: CALL EXPR ; YES, EVALUATE EXPR. 118F 3EC0 MVI A, 0C0H 1191 A5 ANA L 1192 B4 ORA H 1193 C2FD15 JNZ QHOW 1196 4D MOV C, L ; AND SAVE IT IN C 1197 C3A011 JMP PR5 ; LOOK FOR MORE TO PRINT 119A CD7816 PR4: CALL QTSTG ; OR IS IT A STRING? 119D C3BE11 JMP PR9 ; IF NOT, MUST BE EXPR. PR5: TSTC ',', PR8 ; IF ",", GO FIND NEXT 11A0+CDBF15 CALL TSTCH 11A3+2C DB ',' 11A4+13 DB LOW PR8-$-1 PR6: TSTC ',', PR7 11A5+CDBF15 CALL TSTCH 11A8+2C DB ',' 11A9+08 DB LOW PR7-$-1 11AA 3E20 MVI A, ' ' 11AC CDDF17 CALL OUTCH 11AF C3A511 JMP PR6 11B2 CD1315 PR7: CALL FIN ; IN THE LIST 11B5 C38711 JMP PR2 ; LIST CONTINUES 11B8 CDDD17 PR8: CALL CRLF ; LIST ENDS 11BB C30D15 JMP FINISH 11BE CD5F13 PR9: CALL EXPR ; EVALUATE THE EXPR 11C1 C5 PUSH B 11C2 CDB216 CALL PRTNUM ; PRINT THE VALUE 11C5 C1 POP B 11C6 C3A011 JMP PR5 ; MORE TO PRINT? ; ; --------------------------------------------------------------- ; ; *** GOSUB *** & RETURN *** ; ; 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO' COMMAND, ; EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER ETC. ARE ; SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE SUBROUTINE ; 'RETURN'. IN ORDER THAT 'GOSUB' CAN BE NESTED (AND EVEN ; RECURSIVE), THE SAVE AREA MUST BE STACKED. THE STACK POINTER ; IS SAVED IN 'STKGOS'. THE OLD 'STKGOS' IS SAVED IN THE STACK. ; IF WE ARE IN THE MAIN ROUTINE, 'STKGOS' IS ZERO (THIS WAS DONE ; BY THE "MAIN" SECTION OF THE CODE), BUT WE STILL SAVE IT AS ; A FLAG FOR NO FURTHER 'RETURN'S. ; ; 'RETURN(CR)' UNDOS EVERYTHING THAT 'GOSUB' DID, AND THUS ; RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT ; 'GOSUB'. IF 'STKGOS' IS ZERO, IT INDICATES THAT WE NEVER ; HAD A 'GOSUB' AND IS THUS AN ERROR. ; 11C9 CD3A16 GOSUB: CALL PUSHA ; SAVE THE CURRENT "FOR" 11CC CD5F13 CALL EXPR ; PARAMETERS 11CF D5 PUSH D ; AND TEXT POINTER 11D0 CD6815 CALL FNDLN ; FIND THE TARGET LINE 11D3 C2FE15 JNZ AHOW ; NOT THERE, SAY "HOW?" 11D6 2A3688 LHLD CURRNT ; SAVE OLD 11D9 E5 PUSH H ; 'CURRNT' OLD 'STKGOS' 11DA 2A3888 LHLD STKGOS 11DD E5 PUSH H 11DE 210000 LXI H, 0 ; AND LOAD NEW ONES 11E1 223C88 SHLD LOPVAR 11E4 39 DAD SP 11E5 223888 SHLD STKGOS 11E8 C31E11 JMP RUNTSL ; THEN RUN THAT LINE ; 11EB CD2E15 RETURN: CALL ENDCHK ; THERE MUST BE A CR 11EE 2A3888 LHLD STKGOS ; OLD STACK POINTER 11F1 7C MOV A, H ; 0 MEANS NOT EXIST 11F2 B5 ORA L 11F3 CA3415 JZ QWHAT ; SO, WE SAY: "WHAT?" 11F6 F9 SPHL ; ELSE, RESTORE IT 11F7 E1 RESTOR: POP H 11F8 223888 SHLD STKGOS ; AND THE OLD 'STKGOS' 11FB E1 POP H 11FC 223688 SHLD CURRNT ; AND THE OLD 'CURRNT' 11FF D1 POP D ; OLD TEXT POINTER 1200 CD1E16 CALL POPA ; OLD "FOR" PARAMETERS 1203 C30D15 JMP FINISH ; ; --------------------------------------------------------------- ; ; *** FOR *** & NEXT *** ; ; 'FOR' HAS TWO FORMS: 'FOR VAR=EXP1 TO EXP2 STEP EXP3' AND ; 'FOR VAR=EXP1 TO EXP2' THE SECOND FORM MEANS THE SAME THING ; AS THE FIRST FORM WITH EXP3=1 (I.E., WITH A STEP OF +1). ; PATB WILL FIND THE VARIABLE VAR. AND SET ITS VALUE TO THE ; CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXP2 AND EXP3 AND ; SAVE ALL THESE TOGETHER WITH THE TEXT POINTER ETC. IN THE ; 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC', ; 'LOPLMT', 'LOPLN', AND 'LOPPT'. IF THERE IS ALREADY SOME- ; THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO ; 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK ; BEFORE THE NEW ONE OVERWRITES IT. PATB WILL THEN DIG IN THE ; STACK AND FIND OUT IF THIS SAME VARIABLE WAS USED IN ANOTHER ; CURRENTLY ACTIVE 'FOR' LOOP. IF THAT IS THE CASE, THEN THE ; OLD 'FOR' LOOP IS DEACTIVATED (PURGED FROM THE STACK). ; ; 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL) ; END OF THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS CHECKED ; WITH THE 'LOPVAR'. IF THEY ARE NOT THE SAME, PATB DIGS IN THE ; STACK TO FIND THE RIGHT ONE AND PURGES ALL THOSE THAT DID NOT ; MATCH. EITHER WAY, PATB THEN ADDS THE 'STEP' TO THAT VARIABLE ; AND CHECK THE RESULT WITH THE LIMIT. IF IT IS WITHIN THE LIMIT, ; CONTROL LOOPS BACK TO THE COMMAND FOLLOWING THE 'FOR'. ; IF OUTSIDE THE LIMIT, THE SAVE AREA IS PURGED AND EXECUTION ; CONTINUES. ; 1206 CD3A16 FOR: CALL PUSHA ; SAVE THE OLD SAVE AREA 1209 CDF714 CALL SETVAL ; SET THE CONTROL VAR. 120C 2B DCX H ; HL IS ITS ADDRESS 120D 223C88 SHLD LOPVAR ; SAVE THAT 1210 217D17 LXI H, TAB4-1 ; USE 'EXEC' TO LOOK 1213 C3D310 JMP EXEC ; FOR THE WORD 'TO' 1216 CD5F13 FR1: CALL EXPR ; EVALUATE THE LIMIT 1219 224088 SHLD LOPLMT ; SAVE THAT 121C 218317 LXI H, TAB5-1 ; USE 'EXEC' TO LOOK 121F C3D310 JMP EXEC ; FOR THE WORD 'STEP' 1222 CD5F13 FR2: CALL EXPR ; FOUND IT, GET STEP 1225 C32B12 JMP FR4 1228 210100 FR3: LXI H, 1 ; NOT FOUND, SET TO 1 122B 223E88 FR4: SHLD LOPINC ; SAVE THAT TOO 122E 2A3688 LHLD CURRNT ; SAVE CURRENT LINE # 1231 224288 SHLD LOPLN 1234 EB XCHG ; AND TEXT POINTER 1235 224488 SHLD LOPPT 1238 010A00 LXI B, 10 ; DIG INTO STACK TO 123B 2A3C88 LHLD LOPVAR ; FIND 'LOPVAR' 123E EB XCHG 123F 60 MOV H, B 1240 68 MOV L, B ; HL=0 NOW 1241 39 DAD SP ; HERE IS THE STACK 1242 C34612 JMP FR6 1245 09 FR5: DAD B ; EACH LEVEL IS 10 DEEP 1246 7E FR6: MOV A, M ; GET THAT OLD 'LOPVAR' 1247 23 INX H 1248 B6 ORA M 1249 CA6612 JZ FR7 ; 0 SAYS NO MORE IN IT 124C 7E MOV A, M 124D 2B DCX H 124E BA CMP D ; SAME AS THIS ONE? 124F C24512 JNZ FR5 1252 7E MOV A, M ; THE OTHER HALF? 1253 BB CMP E 1254 C24512 JNZ FR5 1257 EB XCHG ; YES, FOUND ONE 1258 210000 LXI H, 0 125B 39 DAD SP ; TRY TO MOVE SP 125C 44 MOV B, H 125D 4D MOV C, L 125E 210A00 LXI H, 10 1261 19 DAD D 1262 CD0F16 CALL MVDOWN ; AND PURGE 10 WORDS 1265 F9 SPHL ; IN THE STACK 1266 2A4488 FR7: LHLD LOPPT ; JOB DONE, RESTORE DE 1269 EB XCHG 126A C30D15 JMP FINISH ; AND CONTINUE ; 126D CD8D15 NEXT: CALL TSTV ; GET ADDRESS OF VAR. 1270 DA3415 JC QWHAT ; NO VARIABLE, "WHAT?" 1273 223A88 SHLD VARNXT ; YES, SAVE IT 1276 D5 NX1: PUSH D ; SAVE TEXT POINTER 1277 EB XCHG 1278 2A3C88 LHLD LOPVAR ; GET VAR. IN 'FOR' 127B 7C MOV A, H 127C B5 ORA L ; 0 SAYS NEVER HAD ONE 127D CA3515 JZ AWHAT ; SO WE ASK: "WHAT?" 1280 CDF114 CALL COMP ; ELSE, WE CHECK THEM 1283 CA9012 JZ NX2 ; OK, THEY AGREE 1286 D1 POP D ; NO, LET'S SEE 1287 CD1E16 CALL POPA ; PURGE CURRENT LOOP 128A 2A3A88 LHLD VARNXT ; AND POP ONE LEVEL 128D C37612 JMP NX1 ; GO CHECK AGAIN 1290 5E NX2: MOV E, M ; COME HERE WHEN AGREED 1291 23 INX H 1292 56 MOV D, M ; DE=VALUE OF VAR. 1293 2A3E88 LHLD LOPINC 1296 E5 PUSH H 1297 7C MOV A, H 1298 AA XRA D ; S=SIGN DIFFER 1299 7A MOV A, D ; A=SIGN OF DE 129A 19 DAD D ; ADD ONE STEP 129B FAA212 JM NX3 ; CANNOT OVERFLOW 129E AC XRA H ; MAY OVERFLOW 129F FAC612 JM NX5 ; AND IT DID 12A2 EB NX3: XCHG 12A3 2A3C88 LHLD LOPVAR ; PUT IT BACK 12A6 73 MOV M, E 12A7 23 INX H 12A8 72 MOV M, D 12A9 2A4088 LHLD LOPLMT ; HL=LIMIT 12AC F1 POP PSW ; OLD HL 12AD B7 ORA A 12AE F2B212 JP NX4 ; STEP > 0 12B1 EB XCHG ; STEP < 0 12B2 CDE714 NX4: CALL CKHLDE ; COMPARE WITH LIMIT 12B5 D1 POP D ; RESTORE TEXT POINTER 12B6 DAC812 JC NX6 ; OUTSIDE LIMIT 12B9 2A4288 LHLD LOPLN ; WITHIN LIMIT, SO 12BC 223688 SHLD CURRNT ; BACK TO THE SAVED 12BF 2A4488 LHLD LOPPT ; 'CURRNT' AND TEXT 12C2 EB XCHG ; POINTER 12C3 C30D15 JMP FINISH 12C6 E1 NX5: POP H ; OVERFLOW, PURGE 12C7 D1 POP D ; GARBAGE IN STACK 12C8 CD1E16 NX6: CALL POPA ; PURGE THIS LOOP 12CB C30D15 JMP FINISH ; ; --------------------------------------------------------------- ; ; *** REM *** IF *** INPUT *** & LET (& DEFLT) *** ; ; 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY PATB. ; PATB TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION. ; ; 'IF' IS FOLLOWED BY AN EXPRESSION AS A CONDITION AND ONE OR ; MORE COMMANDS (INCLUDING OTHER 'IF'S) SEPARATED BY SEMI-COLONS. ; NOTE THAT THE WORD 'THEN' IS NOT USED. PATB EVALUATES THE EXPR. ; IF IT IS NON-ZERO, EXECUTION CONTINUES. IF THE EXPR. IS ZERO, ; THE COMMANDS THAT FOLLOWS ARE IGNORED AND EXECUTION CONTINUES ; AT THE NEXT LINE. ; ; 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED ; BY A LIST OF ITEMS. IF THE ITEM IS A STRING IN SINGLE OR ; DOUBLE QUOTES, OR IS AN UP-ARROW, IT HAS THE SAME EFFECT AS ; IN 'PRINT'. IF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS ; PRINTED OUT FOLLOWED BY A COLON. THEN PATB WAITS FOR AN EXPR. ; TO BE TYPED IN. THE VARIABLE IS THEN SET TO THE VALUE OF THIS ; EXPR. IF THE VARIABLE IS PROCEDED BY A STRING (AGAIN IN SINGLE ; OR DOUBLE QUOTES), THE STRING WILL BE PRINTED FOLLOWED BY A ; COLON. PATB THEN WAITS FOR INPUT EXPR. AND SET THE VARIABLE ; TO THE VALUE OF THE EXPR. ; ; IF THE INPUT EXPRESSION IS INVALID, PATB WILL PRINT "WHAT?", ; "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT. ; THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C. ; THIS IS HANDLED IN 'INPERR'. ; ; 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPARATED BY COMMAS. ; EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR. ; PATB EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE. ; PATB WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'. ; THIS IS DONE BY 'DEFLT'. ; 12CE 210000 REM: LXI H, 0 ; *** REM *** 12D1 C3D712 JMP IF1 ; THIS IS LIKE 'IF 0' ; 12D4 CD5F13 IFF: CALL EXPR ; *** IF *** 12D7 7C IF1: MOV A, H ; IS THE EXPRESSION = 0? 12D8 B5 ORA L 12D9 C22511 JNZ RUNSML ; NO, CONTINUE 12DC CD8315 CALL FNDSKP ; YES, SKIP REST OF LINE 12DF D21E11 JNC RUNTSL ; AND RUN THE NEXT LINE 12E2 C35710 JMP RSTART ; IF NO NEXT, RE-START ; 12E5 2A3A88 INPERR: LHLD STKINP ; *** INPERR *** 12E8 F9 SPHL ; RESTORE OLD SP 12E9 E1 POP H ; AND OLD 'CURRNT' 12EA 223688 SHLD CURRNT 12ED D1 POP D ; AND OLD TEXT POINTER 12EE D1 POP D ; READ INPUT ; 12EF INPUT DS 0 12EF D5 IP1: PUSH D ; SAVE IN CASE OF ERROR 12F0 CD7816 CALL QTSTG ; IS NEXT ITEM A STRING? 12F3 C31E13 JMP IP8 ; NO 12F6 CD8D15 IP2: CALL TSTV ; YES, BUT FOLLOWED BY A 12F9 DA1213 JC IP5 ; VARIABLE? NO. 12FC CD3013 IP3: CALL IP12 12FF 114988 LXI D, BUFFER ; POINTS TO BUFFER 1302 CD5F13 CALL EXPR ; EVALUATE INPUT 1305 CD2E15 CALL ENDCHK 1308 D1 POP D ; OK, GET OLD HL 1309 EB XCHG 130A 73 MOV M, E ; SAVE VALUE IN VAR. 130B 23 INX H 130C 72 MOV M, D 130D E1 IP4: POP H ; GET OLD 'CURRNT' 130E 223688 SHLD CURRNT 1311 D1 POP D ; AND OLD TEXT POINTER 1312 F1 IP5: POP PSW ; PURGE JUNK IN STACK IP6: TSTC ',', IP7 ; IS NEXT CHAR. ","? 1313+CDBF15 CALL TSTCH 1316+2C DB ',' 1317+03 DB LOW IP7-$-1 1318 C3EF12 JMP INPUT ; YES, MORE ITEMS. 131B C30D15 IP7: JMP FINISH 131E D5 IP8: PUSH D ; SAVE FOR 'PRTSTG' 131F CD8D15 CALL TSTV ; MUST BE VARIABLE NOW 1322 D22813 JNC IP11 1325 C33415 IP10: JMP QWHAT ; "WHAT?" IT IS NOT? 1328 43 IP11: MOV B, E 1329 D1 POP D 132A CDA716 CALL PRTCHS ; PRINT THOSE AS PROMPT 132D C3FC12 JMP IP3 ; YES, INPUT VARIABLE 1330 C1 IP12: POP B ; RETURN ADDRESS 1331 D5 PUSH D ; SAVE TEXT POINTER 1332 EB XCHG 1333 2A3688 LHLD CURRNT ; ALSO SAVE 'CURRNT' 1336 E5 PUSH H 1337 21EF12 LXI H, IP1 ; A NEGATIVE NUMBER 133A 223688 SHLD CURRNT ; AS A FLAG 133D 210000 LXI H, 0 ; SAVE SP TOO 1340 39 DAD SP 1341 223A88 SHLD STKINP 1344 D5 PUSH D ; OLD HL 1345 3E20 MVI A, ' ' ; PRINT A SPACE 1347 C5 PUSH B 1348 C3A917 JMP GETLN ; AND GET A LINE ; 134B 1A DEFLT: LDAX D ; *** DEFLT *** 134C FE0D CPI CR ; EMPTY LINE IS OK 134E CA5C13 JZ LT4 ; ELSE, IT IS 'LET' ; 1351 LET: DS 0 ; *** LET *** 1351 CDF714 LT2: CALL SETVAL LT3: TSTC ',', LT4 ; SET VALUE TO VAR. 1354+CDBF15 CALL TSTCH 1357+2C DB ',' 1358+03 DB LOW LT4-$-1 1359 C35113 JMP LET ; ITEM BY ITEM 135C C30D15 LT4: JMP FINISH ; UNTIL FINISH ; ; --------------------------------------------------------------- ; ; *** EXPR *** ; ; 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS. ; : : = ; ; WHERE IS ONE OF THE OPERATORS IN TAB6 AND THE RESULT ; OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE. ; : : =(+ OR -)(+ OR -)(.....) ; WHERE () ARE OPTIONAL AND (.....) ARE OPTIONAL REPEATS. ; : : =(<* OR />)(.....) ; : : = ; ; () ; IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN ; AS INDEX. FUNCTIONS CAN HAVE AN AS ARGUMENTS, ; AND CAN BE AN IN PARENTHESE. ; 135F CDA713 EXPR: CALL EXPR1 ; *** EXPR *** 1362 E5 PUSH H ; SAVE VALUE 1363 218B17 LXI H, TAB6-1 ; LOOKUP REL.OP. 1366 C3D310 JMP EXEC ; GO DO IT 1369 CD9213 XPR1: CALL XPR8 ; REL.OP.">=" 136C D8 RC ; NO, RETURN HL=0 136D 6F MOV L, A ; YES, RETURN HL=1 136E C9 RET 136F CD9213 XPR2: CALL XPR8 ; REL.OP."#" 1372 C8 RZ ; FALSE, RETURN HL=0 1373 6F MOV L, A ; TRUE, RETURN HL=1 1374 C9 RET 1375 CD9213 XPR3: CALL XPR8 ; REL.OP.">" 1378 C8 RZ ; FALSE 1379 D8 RC ; ALSO FALSE, HL=0 137A 6F MOV L, A ; TRUE, HL=1 137B C9 RET 137C CD9213 XPR4: CALL XPR8 ; REL.OP."<=" 137F 6F MOV L, A ; SET HL=1 1380 C8 RZ ; REL.OP. TRUE, RETURN 1381 D8 RC 1382 6C MOV L, H ; ELSE, SET HL=0 1383 C9 RET 1384 CD9213 XPR5: CALL XPR8 ; REL.OP."=" 1387 C0 RNZ ; FALSE, RETURN HL=0 1388 6F MOV L, A ; ELSE SET HL=1 1389 C9 RET 138A CD9213 XPR6: CALL XPR8 ; REL.OP."<" 138D D0 RNC ; FALSE, RETURN HL=0 138E 6F MOV L, A ; ELSE SET HL=1 138F C9 RET 1390 E1 XPR7: POP H ; NOT REL.OP. 1391 C9 RET ; RETURN HL= 1392 79 XPR8: MOV A, C ; SUBROUTINE FOR ALL 1393 E1 POP H ; REL.OP.'S 1394 C1 POP B 1395 E5 PUSH H ; REVERSE TOP OF STACK 1396 C5 PUSH B 1397 4F MOV C, A 1398 CDA713 CALL EXPR1 ; SET 2ND 139B EB XCHG ; VALUE IN DE NOW 139C E3 XTHL ; 1ST IN HL 139D CDE714 CALL CKHLDE ; COMPARE 1ST WITH 2ND 13A0 D1 POP D ; RESTORE TEXT POINTER 13A1 210000 LXI H, 0 ; SET HL=0, A=1 13A4 3E01 MVI A, 1 13A6 C9 RET ; EXPR1: TSTC '-', XP11 ; NEGATIVE SIGN? 13A7+CDBF15 CALL TSTCH 13AA+2D DB '-' 13AB+06 DB LOW XP11-$-1 13AC 210000 LXI H,0 ; YES, FAKE '0-' 13AF C3D913 JMP XP16 ; TREAT LIKE SUBTRACT XP11: TSTC '+', XP12 ; POSITIVE SIGN? IGNORE 13B2+CDBF15 CALL TSTCH 13B5+2B DB '+' 13B6+00 DB LOW XP12-$-1 13B7 CDE313 XP12: CALL EXPR2 ; 1ST XP13: TSTC '+', XP15 ; ADD? 13BA+CDBF15 CALL TSTCH 13BD+2B DB '+' 13BE+15 DB LOW XP15-$-1 13BF E5 PUSH H ; YES, SAVE VALUE 13C0 CDE313 CALL EXPR2 ; GET 2ND 13C3 EB XP14: XCHG ; 2ND IN DE 13C4 E3 XTHL ; 1ST IN HL 13C5 7C MOV A, H ; COMPARE SIGN 13C6 AA XRA D 13C7 7A MOV A, D 13C8 19 DAD D 13C9 D1 POP D ; RESTORE TEXT POINTER 13CA FABA13 JM XP13 ; 1ST 2ND SIGN DIFFER 13CD AC XRA H ; 1ST 2ND SIGN EQUAL 13CE F2BA13 JP XP13 ; SO IS EQUAL 13D1 C3FD15 JMP QHOW ; ELSE, WE HAVE OVERFLOW XP15: TSTC '-', XPR9 ; SUBTRACT? 13D4+CDBF15 CALL TSTCH 13D7+2D DB '-' 13D8+92 DB LOW XPR9-$-1 13D9 E5 XP16: PUSH H ; YES, SAVE 1ST 13DA CDE313 CALL EXPR2 ; GET 2ND 13DD CDD214 CALL CHGSGN ; NEGATE 13E0 C3C313 JMP XP14 ; AND ADD THEM ; 13E3 CD4714 EXPR2: CALL EXPR3 ; GET 1ST XP21: TSTC '*', XP24 ; MULTIPLY? 13E6+CDBF15 CALL TSTCH 13E9+2A DB '*' 13EA+2D DB LOW XP24-$-1 13EB E5 PUSH H ; YES, SAVE 1ST 13EC CD4714 CALL EXPR3 ; AND GET 2ND 13EF 0600 MVI B, 0 ; CLEAR B FOR SIGN 13F1 CDCF14 CALL CHKSGN ; CHECK SIGN 13F4 E3 XTHL ; 1ST IN HL 13F5 CDCF14 CALL CHKSGN ; CHECK SIGN OF 1ST 13F8 EB XCHG 13F9 E3 XTHL 13FA 7C MOV A, H ; IS HL > 255 ? 13FB B7 ORA A 13FC CA0514 JZ XP22 ; NO 13FF 7A MOV A, D ; YES, HOW ABOUT DE 1400 B2 ORA D 1401 EB XCHG ; PUT SMALLER IN HL 1402 C2FE15 JNZ AHOW ; ALSO >, WILL OVERFLOW 1405 7D XP22: MOV A, L ; THIS IS DUMP 1406 210000 LXI H, 0 ; CLEAR RESULT 1409 B7 ORA A ; ADD AND COUNT 140A CA3914 JZ XP25 140D 19 XP23: DAD D 140E DAFE15 JC AHOW ; OVERFLOW 1411 3D DCR A 1412 C20D14 JNZ XP23 1415 C33914 JMP XP25 ; FINISHED XP24: TSTC '/', XPR9 ; DIVIDE? 1418+CDBF15 CALL TSTCH 141B+2F DB '/' 141C+4E DB LOW XPR9-$-1 141D E5 PUSH H ; YES, SAVE 1ST 141E CD4714 CALL EXPR3 ; AND GET 2ND ONE 1421 0600 MVI B, 0 ; CLEAR B FOR SIGN 1423 CDCF14 CALL CHKSGN ; CHECK SIGN OF 2ND 1426 E3 XTHL ; GET 1ST IN HL 1427 CDCF14 CALL CHKSGN ; CHECK SIGN OF 1ST 142A EB XCHG 142B E3 XTHL 142C EB XCHG 142D 7A MOV A, D ; DIVIDE BY 0? 142E B3 ORA E 142F CAFE15 JZ AHOW ; SAY "HOW?" 1432 C5 PUSH B ; ELSE, SAVE SIGN 1433 CDB214 CALL DIVIDE ; USE SUBROUTINE 1436 60 MOV H, B ; RESULT IN HL NOW 1437 69 MOV L, C 1438 C1 POP B ; GET SIGN BACK 1439 D1 XP25: POP D ; AND TEXT POINTER 143A 7C MOV A, H ; HL MUST BE + 143B B7 ORA A 143C FAFD15 JM QHOW ; ELSE, IT IS OVERFLOW 143F 78 MOV A, B 1440 B7 ORA A 1441 FCD214 CM CHGSGN ; CHANGE SIGN IF NEEDED 1444 C3E613 JMP XP21 ; LOOK FOR MORE TERMS ; 1447 216817 EXPR3: LXI H, TAB3-1 ; FIND FUNCTION IN TAB3 144A C3D310 JMP EXEC ; AND GO DO IT 144D CD8D15 NOTF: CALL TSTV ; NO, NOT A FUNCTION 1450 DA5814 JC XP32 ; NOR A VARIABLE 1453 7E MOV A, M ; VARIABLE 1454 23 INX H 1455 66 MOV H, M ; VALUE IN HL 1456 6F MOV L, A 1457 C9 RET 1458 CDD315 XP32: CALL TSTNUM ; OR IS IT A NUMBER 145B 78 MOV A, B ; # OF DIGIT 145C B7 ORA A 145D C0 RNZ ; OK PARN: TSTC '(', XPR0 ; NO DIGIT, MUST BE 145E+CDBF15 CALL TSTCH 1461+28 DB '(' 1462+09 DB LOW XPR0-$-1 1463 CD5F13 PARNP: CALL EXPR ; "(EXPR)" TSTC ')', XPR0 1466+CDBF15 CALL TSTCH 1469+29 DB ')' 146A+01 DB LOW XPR0-$-1 146B C9 XPR9: RET 146C C33415 XPR0: JMP QWHAT ; ELSE, SAY: "WHAT?" ; 146F CD5E14 RND: CALL PARN ; *** RND(EXPR) *** 1472 7C MOV A, H ; EXPR MUST BE + 1473 B7 ORA A 1474 FAFD15 JM QHOW 1477 B5 ORA L ; AND NON-ZERO 1478 CAFD15 JZ QHOW 147B D5 PUSH D ; SAVE BOTH 147C E5 PUSH H 147D 2A4688 LHLD RANPNT ; GET MEMORY AS RANDOM 1480 11A217 LXI D, RANEND 1483 CDF114 CALL COMP 1486 DA8C14 JC RA1 ; WRAP AROUND IF LAST 1489 210010 LXI H, BOTROM 148C 5E RA1: MOV E, M 148D 23 INX H 148E 56 MOV D, M 148F 224688 SHLD RANPNT 1492 E1 POP H 1493 EB XCHG 1494 C5 PUSH B 1495 CDB214 CALL DIVIDE ; RND(N)=MOD(M,N)+1 1498 C1 POP B 1499 D1 POP D 149A 23 INX H 149B C9 RET ; 149C CD5E14 ABS: CALL PARN ; *** ABS(EXPR) *** 149F 1B DCX D 14A0 CDCF14 CALL CHKSGN ; CHECK SIGN 14A3 13 INX D 14A4 C9 RET ; 14A5 2A0090 SIZE: LHLD TXTUNF ; *** SIZE *** 14A8 D5 PUSH D ; GET THE NUMBER OF FREE 14A9 EB XCHG ; BYTES BETWEEN 'TXTUNF' 14AA 2A0088 LHLD TXTLMT ; AND 'TXTLMT' 14AD CDC814 CALL SUBDE 14B0 D1 POP D 14B1 C9 RET ; ; --------------------------------------------------------------- ; ; *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE *** ; ; 'DIVIDE' DIVIDES HL BY DE. RESULT IN BC, REMAINDER IN HL. ; ; 'SUBDE' SUBTRACTS DE FROM HL. ; ; 'CHKSGN' CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE SIGN ; AND FLIP SIGN OF B. ; ; 'CHGSGN' CHANGES SIGN OF HL AND B UNCONDITIONNALLY. ; ; 'CKHLDE' CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE ; ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER CASE, ; HL DE ARE THEN COMPARED TO SET THE FLAGS. ; 14B2 E5 DIVIDE: PUSH H ; *** DIVIDE *** 14B3 6C MOV L, H ; DIVIDE H BY DE 14B4 2600 MVI H, 0 14B6 CDBD14 CALL DV1 14B9 41 MOV B, C ; SAVE RESULT IN B 14BA 7D MOV A, L ; (REMAINDER+L)/DE 14BB E1 POP H 14BC 67 MOV H, A 14BD 0EFF DV1: MVI C, -1 ; RESULT IN C 14BF 0C DV2: INR C ; DUMB ROUTINE 14C0 CDC814 CALL SUBDE ; DIVIDE BY SUBTRACT 14C3 D2BF14 JNC DV2 ; AND COUNT 14C6 19 DAD D 14C7 C9 RET ; 14C8 7D SUBDE: MOV A, L ; *** SUBDE *** 14C9 93 SUB E ; SUBTRACT DE FROM 14CA 6F MOV L, A ; HL 14CB 7C MOV A, H 14CC 9A SBB D 14CD 67 MOV H, A 14CE C9 RET ; 14CF 7C CHKSGN: MOV A, H ; *** CHKSGN *** 14D0 B7 ORA A ; CHECK SIGN OF HL 14D1 F0 RP ; IF ), CHANGE SIGN ; 14D2 7C CHGSGN: MOV A, H ; *** CHGSGN *** 14D3 B5 ORA L 14D4 C8 RZ 14D5 7C MOV A, H 14D6 F5 PUSH PSW 14D7 2F CMA ; CHANGE SIGN OF HL 14D8 67 MOV H, A 14D9 7D MOV A, L 14DA 2F CMA 14DB 6F MOV L, A 14DC 23 INX H 14DD F1 POP PSW 14DE AC XRA H 14DF F2FD15 JP QHOW 14E2 78 MOV A, B ; AND ALSO FLIP B 14E3 EE80 XRI 80H 14E5 47 MOV B, A 14E6 C9 RET ; 14E7 7C CKHLDE: MOV A, H ; *** CKHLDE *** 14E8 AA XRA D ; SAME SIGN? 14E9 F2ED14 JP CK1 ; YES, COMPARE 14EC EB XCHG ; NO, XCH AND COMP 14ED CDF114 CK1: CALL COMP 14F0 C9 RET ; 14F1 7C COMP: MOV A, H ; *** COMP *** 14F2 BA CMP D ; COMPARE HL WITH DE 14F3 C0 RNZ ; RETURN CORRECT C AND 14F4 7D MOV A, L ; Z FLAGS 14F5 BB CMP E ; BUT OLD A IS LOST 14F6 C9 RET ; ; --------------------------------------------------------------- ; ; *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) *** ; ; 'SETVAL' EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND ; THEN AN EXPR. IT EVALUATES THE EXPR. AND SET THE VARIABLE ; TO THAT VALUE. ; ; 'FIN' CHECKS THE END OF A COMMAND. IF IT ENDED WITH ";", ; EXECUTION CONTINUES. IF IT ENDED WITH A CR, IT FINDS THE NEXT ; LINE AND CONTINUE FROM THERE. ; ; 'ENDCHK' CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS ; REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.) ; ; 'ERROR' PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR). ; IT THEN PRINTS THE LINE POINTED BY 'CURRNT' WITH A "?" ; INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP OF ; THE STACK) POINTS TO. EXECUTION OF TB IS STOPPED AND PATB IS ; RESTARTED. HOWEWER, IF 'CURRNT' -> ZERO (INDICATING A DIRECT ; COMMAND), THE DIRECT COMMAND IS NOT PRINTED, AND IF 'CURRNT' ; -> NEGATIVE # (INDICATING 'INPUT' COMMAND), THE INPUT LINE IS ; NOT PRINTED AND EXECUTION IS NOT TERMINATED BUT CONTINUED AT ; 'INPERR'. ; ; RELATED TO 'ERROR' ARE THE FOLLOWING: 'QWHAT' SAVES TEXT ; POINTER IN STACK AND GET MESSAGE "WHAT?". 'AWHAT' JUST GET ; MESSAGE "WHAT?" AND JUMP TO 'ERROR'. 'QSORRY' AND 'ASORRY' ; DO SAME KIND OF THING. 'QHOW' AND 'AHOW' IN THE ZERO PAGE ; SECTION ALSO DO THIS. ; 14F7 CD8D15 SETVAL: CALL TSTV ; *** SETVAL *** 14FA DA3415 JC QWHAT ; "WHAT?" NO VARIABLE 14FD E5 PUSH H ; PUSH ADDRESS OF VAR. TSTC '=', SV1 ; PASS "=" SIGN 14FE+CDBF15 CALL TSTCH 1501+3D DB '=' 1502+0D DB LOW SV1-$-1 1503 CD5F13 CALL EXPR ; EVALUATE EXPR. 1506 44 MOV B, H ; VALUE IN BC NOW 1507 4D MOV C, L 1508 E1 POP H ; GET ADDRESS 1509 71 MOV M, C ; SAVE VALUE 150A 23 INX H 150B 70 MOV M, B 150C C9 RET ; 150D CD1315 FINISH: CALL FIN ; CHECK END OF COMMAND 1510 C33415 SV1: JMP QWHAT ; PRINT "WHAT?" IF WRONG ; FIN: TSTC ';', FI1 ;*** FIN *** 1513+CDBF15 CALL TSTCH 1516+3B DB ';' 1517+04 DB LOW FI1-$-1 1518 F1 POP PSW ; ";", PURGE RET ADDRESS 1519 C32511 JMP RUNSML ; CONTINUE SAME LINE FI1: TSTC CR, FI2 ; NOT ";", IS IT CR? 151C+CDBF15 CALL TSTCH 151F+0D DB CR 1520+04 DB LOW FI2-$-1 1521 F1 POP PSW ; YES, PURGE RET ADDRESS 1522 C31511 JMP RUNNXL ; RUN NEXT LINE 1525 C9 FI2: RET ; ELSE, RETURN TO CALLER ; 1526 1A IGNBLK: LDAX D ; *** IGNBLK *** 1527 FE20 CPI ' ' ; IGNORE BLANKS 1529 C0 RNZ ; IN TEXT (WHERE DE->) 152A 13 INX D ; AND RETURN THE FIRST 152B C32615 JMP IGNBLK ; NON-BLANK CHAR. IN A ; 152E CD2615 ENDCHK: CALL IGNBLK ; *** ENDCHK *** 1531 FE0D CPI CR ; END WITH CR? 1533 C8 RZ ; OK, ELSE SAY: "WHAT?" ; 1534 D5 QWHAT: PUSH D ; *** QWHAT *** 1535 114610 AWHAT: LXI D, WHAT ; *** AWHAT *** 1538 CDDD17 ERROR: CALL CRLF 153B CD6916 CALL PRTSTG ; PRINT ERROR MESSAGE 153E 2A3688 LHLD CURRNT ; GET CURRENT LINE # 1541 E5 PUSH H 1542 7E MOV A, M ; CHECK THE VALUE 1543 23 INX H 1544 B6 ORA M 1545 D1 POP D 1546 CA1C10 JZ TELL ; IF ZERO, JUST RESTART 1549 7E MOV A, M ; IF NEGATIVE 154A B7 ORA A 154B FAE512 JM INPERR ; REDO INPUT 154E CDF616 CALL PRTLN ; ELSE PRINT THE LINE 1551 C1 POP B 1552 41 MOV B, C 1553 CDA716 CALL PRTCHS 1556 3E3F MVI A, '?' ; PRINT A "?" 1558 CDDF17 CALL OUTCH 155B CD6916 CALL PRTSTG ; LINE 155E C31C10 JMP TELL ; THEN RESTART 1561 D5 QSORRY: PUSH D ; *** QSORRY *** 1562 115110 ASORRY: LXI D, SORRY ; *** ASORRY *** 1565 C33815 JMP ERROR ; ; --------------------------------------------------------------- ; ; *** FNDLN (& FRIENDS) *** ; ; 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE TEXT ; SAVE AREA. DE IS USED AS THE TEXT POINTER. IF THE LINE IS ; FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE (I.E., THE ; LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z. IF THAT LINE IS ; NOT THERE AND A LINE WITH A HIGHER LINE # IS FOUND, DE POINTS ; TO THERE AND FLAGS ARE NC & NZ. IF WE REACHED THE END OF TEXT ; SAVE AREA AND CANNOT FIND THE LINE, FLAGS ARE C & NZ. 'FNDLN' ; WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE AREA TO ; START THE SEARCH. SOME OTHER ENTRIES OF THIS ROUTINE WILL NOT ; INITIALIZE DE AND DO THE SEARCH. 'FNDLP' WILL START WITH DE ; AND SEARCH FOR THE LINE #. 'FNDNXT' WILL BUMP DE BY 2, FIND ; A CR AND THEN START SEARCH. 'FNDSKP' USE DE TO FIND A CR, ; AND THEN START SEARCH. ; 1568 7C FNDLN: MOV A, H ; *** FNDLN *** 1569 B7 ORA A ; CHECK SIGN OF HL 156A FAFD15 JM QHOW ; IT CANNOT BE - 156D 110290 LXI D, TEXT ; INIT. TEXT POINTER ; 1570 13 FNDLP: INX D ; IS IT EOT MARK? 1571 1A LDAX D 1572 1B DCX D 1573 87 ADD A 1574 D8 RC ; C, NZ PASSED. END. 1575 1A LDAX D ; WE DID NOT, GET BYTE 1 1576 95 SUB L ; IS THIS THE LINE? 1577 47 MOV B, A ; COMPARE LOW ORDER 1578 13 INX D 1579 1A LDAX D ; GET BYTE 2 157A 9C SBB H ; COMPARE HIGH ORDER 157B DA8215 JC FL1 ; NO, NOT THERE YET 157E 1B DCX D ; ELSE WE EITHER FOUND 157F B0 ORA B ; IT, OR IT IS NOT THERE 1580 C9 RET ; NC, Z=FOUND; NC, NZ=NO ; 1581 13 FNDNXT: INX D ; FIND NEXT LINE 1582 13 FL1: INX D ; JUST PASSED BYTE 1 & 2 ; 1583 1A FNDSKP: LDAX D ; *** FNDSKP *** 1584 FE0D CPI CR ; TRY TO FIND CR 1586 C28215 JNZ FL1 ; KEEP LOOKING 1589 13 INX D ; FOUND CR, SKIP OVER 158A C37015 JMP FNDLP ; CHECK IF END OF TEXT ; 158D CD2615 TSTV: CALL IGNBLK ; *** TSTV *** 1590 D640 SUI '@' ; TEST VARIABLES 1592 D8 RC ; C=NOT A VARIABLE 1593 C2AF15 JNZ TV1 ; NOT "@" ARRAY 1596 13 INX D ; IT IS THE "@" ARRAY 1597 CD5E14 CALL PARN ; @ SHOULD BE FOLLOWED 159A 29 DAD H ; BY (EXPR) AS ITS INDEX 159B DAFD15 JC QHOW ; IS INDEX TOO BIG? 159E D5 TSTB: PUSH D ; WILL IT FIT? 159F EB XCHG 15A0 CDA514 CALL SIZE ; FIND SIZE OF FREE 15A3 CDF114 CALL COMP ; AND CHECK THAT 15A6 DA6215 JC ASORRY ; IF NOT, SAY: "SORRY" 15A9 CD6316 CALL LOCR ; IF FITS, GET ADDRESS 15AC 19 DAD D ; OF @(EXPR) AND PUT IT 15AD D1 POP D ; IN HL 15AE C9 RET ; C FLAG IS CLEARED 15AF FE1B TV1: CPI 27 ; NOT @, IS IT A TO Z? 15B1 3F CMC ; IF NOT RETURN C FLAG 15B2 D8 RC 15B3 13 INX D ; IF A THROUGH Z 15B4 210088 LXI H, VARBGN-2 15B7 07 RLC ; HL->VARIABLE 15B8 85 ADD L ; RETURN 15B9 6F MOV L, A ; WITH C FLAG CLEARED 15BA 3E00 MVI A, 0 15BC 8C ADC H 15BD 67 MOV H, A 15BE C9 RET ; ; --------------------------------------------------------------- ; ; *** TSTCH *** TSTNUM *** ; ; 'TSTCH' IS USED TO TEST NON-BLANK CHARACTER IN THE TEXT ; (POINTED BY DE) AGAINST THE CHARACTER THAT FOLLOWS THE CALL. ; IF THEY DO NOT MATCH, N BYTES OF CODE WILL BE SKIPPED OVER, ; WHERE N IS BETWEEN 0 AND 255 AND IS STORED IN THE SECOND BYTE ; FOLLOWING THE CALL. ; ; 'TSTNUM' IS USED TO CHACK WETHER THE TEXT (POINTED BY DE) IS A ; NUMBER. IF A NUMBER IS FOUND, B WILL BE NON-ZERO AND HL WILL ; CONTAIN THE VALUE (IN BINARY) OF THE NUMBER, ELSE B AND HL ; ARE 0. ; 15BF E3 TSTCH: XTHL ; *** TSTCH *** 15C0 CD2615 CALL IGNBLK ; IGNORE LEADING BLANKS 15C3 BE CMP M ; AND TEST THE CHARACTER 15C4 23 INX H ; COMPARE THE BYTE THAT 15C5 CACF15 JZ TC1 ; FOLLOWS THE CALL INST. 15C8 C5 PUSH B ; WITH THE TEXT (DE->) 15C9 4E MOV C, M ; IF NOT =, ADD THE 2ND 15CA 0600 MVI B, 0 ; BYTE THAT FOLLOWS THE 15CC 09 DAD B ; CALL TO THE OLD PC 15CD C1 POP B ; I.E., DO A RELATIVE 15CE 1B DCX D ; JUMP IF NOT = 15CF 13 TC1: INX D ; IF =, SKIP THOSE BYTES 15D0 23 INX H ; AND CONTINUE 15D1 E3 XTHL 15D2 C9 RET ; 15D3 210000 TSTNUM: LXI H, 0 ; *** TSTNUM *** 15D6 44 MOV B, H ; TEST IF THE TEXT IS 15D7 CD2615 CALL IGNBLK ; A NUMBER 15DA FE30 TN1: CPI '0' ; IF NOT, RETURN 0 IN 15DC D8 RC ; B AND HL 15DD FE3A CPI 03AH ; IF NUMBERS, CONVERT 15DF D0 RNC ; TO BINARY IN HL AND 15E0 3EF0 MVI A, 0F0H ; SET B TO # OF DIGITS 15E2 A4 ANA H ; IF H>255, THERE IS NO 15E3 C2FD15 JNZ QHOW ; ROOM FOR NEXT DIGIT 15E6 04 INR B ; B COUNTS # OF DIGITS 15E7 C5 PUSH B 15E8 44 MOV B, H ; HL=10*HL+(NEW DIGIT) 15E9 4D MOV C, L 15EA 29 DAD H ; WHERE 10* IS DONE BY 15EB 29 DAD H ; SHIFT AND ADD 15EC 09 DAD B 15ED 29 DAD H 15EE 1A LDAX D ; AND (DIGIT) IS FROM 15EF 13 INX D ; STRIPPING THE ASCII 15F0 E60F ANI 0FH ; CODE 15F2 85 ADD L 15F3 6F MOV L, A 15F4 3E00 MVI A, 0 15F6 8C ADC H 15F7 67 MOV H, A 15F8 C1 POP B 15F9 1A LDAX D ; DO THIS DIGIT AFTER 15FA F2DA15 JP TN1 ; DIGIT. S SAY OVERFLOW 15FD D5 QHOW: PUSH D ; *** QHOW *** 15FE 114C10 AHOW: LXI D, HOW ; *** AHOW *** 1601 C33815 JMP ERROR ; ; --------------------------------------------------------------- ; ; *** MVUP *** MVDOWN *** POPA *** & PUSHA *** ; ; 'MVUP' MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC-> UNTIL ; DE = HL. ; ; 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL-> ; UNTIL DE = BC. ; ; 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE ; STACK ; ; 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE ; STACK. ; 1604 CDF114 MVUP: CALL COMP ; *** MVUP *** 1607 C8 RZ ; DE = HL, RETURN 1608 1A LDAX D ; GET ONE BYTE 1609 02 STAX B ; MOVE IT 160A 13 INX D ; INCREASE BOTH POINTERS 160B 03 INX B 160C C30416 JMP MVUP ; UNTIL DONE ; 160F 78 MVDOWN: MOV A, B ; *** MVDOWN *** 1610 92 SUB D ; TEST IF DE = BC 1611 C21716 JNZ MD1 ; NO, GO MOVE 1614 79 MOV A, C ; MAYBE, OTHER BYTE? 1615 93 SUB E 1616 C8 RZ ; YES, RETURN 1617 1B MD1: DCX D ; ELSE MOVE A BYTE 1618 2B DCX H ; BUT FIRST DECREASE 1619 1A LDAX D ; BOTH POINTERS AND 161A 77 MOV M, A ; THEN DO IT 161B C30F16 JMP MVDOWN ; LOOP BACK ; 161E C1 POPA: POP B ; BC = RETURN ADDRESS 161F E1 POP H ; RESTORE LOPVAR, BUT 1620 223C88 SHLD LOPVAR ; =0 MEANS NO MORE 1623 7C MOV A, H 1624 B5 ORA L 1625 CA3816 JZ PP1 ; YEP, GO RETURN 1628 E1 POP H ; NOP, RESTORE OTHERS 1629 223E88 SHLD LOPINC 162C E1 POP H 162D 224088 SHLD LOPLMT 1630 E1 POP H 1631 224288 SHLD LOPLN 1634 E1 POP H 1635 224488 SHLD LOPPT 1638 C5 PP1: PUSH B ; BC = RETURN ADDRESS 1639 C9 RET ; 163A 21D188 PUSHA: LXI H, STKLMT ; *** PUSHA *** 163D CDD214 CALL CHGSGN 1640 C1 POP B ; BC = RETURN ADDRESS 1641 39 DAD SP ; IS STACK NEAR THE TOP? 1642 D26115 JNC QSORRY ; YES, SORRY FOR THAT. 1645 2A3C88 LHLD LOPVAR ; ESLE, SAVE LOOP VAR.S 1648 7C MOV A, H ; BUT IF LOPVAR IS 0 1649 B5 ORA L ; THAT WILL BE ALL 164A CA6016 JZ PU1 164D 2A4488 LHLD LOPPT ; ELSE, MORE TO SAVE 1650 E5 PUSH H 1651 2A4288 LHLD LOPLN 1654 E5 PUSH H 1655 2A4088 LHLD LOPLMT 1658 E5 PUSH H 1659 2A3E88 LHLD LOPINC 165C E5 PUSH H 165D 2A3C88 LHLD LOPVAR 1660 E5 PU1: PUSH H 1661 C5 PUSH B ; BC = RETURN ADDRESS 1662 C9 RET 1663 2A0090 LOCR: LHLD TXTUNF 1666 2B DCX H 1667 2B DCX H 1668 C9 RET ; ; --------------------------------------------------------------- ; ; *** PRTSTG *** *** QTSTG *** *** PRTNUM *** & PRTLN *** ; ; 'PRTSTG' PRINTS A STRING POINTED BY DE. IT STOPS PRINTING AND ; RETURNS TO CALLER WHEN EITHER A CR IS PRINTED OR WHEN THE NEXT ; BYTE IS ZERO. REGISTERS A AND B ARE CHANGED. REGISTER DE ; POINTS TO WHAT FOLLOWS THE CR OR TO THE ZERO. ; ; 'QTSTG' LOOKS FOR UP-ARROW, SINGLE QUOTE, OR DOUBLE-QUOTE. ; IF NONE OF THESE, RETURN TO CALLER. IF UP-ARROW, OUTPUT A ; CONTROL CHARACTER. IF SINGLE OR DOUBLE QUOTE, PRINT THE ; STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE. ; AFTER THE PRINTING, THE NEXT 3 BYTES OF THE CALLER IS ; SKIPPED OVER (USUALLY A JUMP INSTRUCTION). ; ; 'PRTNUM' PRINTS THE NUMBER IN HL. LEADING BLANKS ARE ADDED ; IF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C. ; HOWEWER, IF THE NUMBER OF DIGITS IS LARGER THAN THE NUMBER ; IN C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO ; PRINTED AND COUNTED IN. POSITIVE SIGN IS NOT. ; ; 'PRTLN' FINDS A SAVED LINE, PRINTS THE LINE NUMBER AND ; A SPACE. ; 1669 97 PRTSTG: SUB A ; *** PRTSTG *** 166A 47 PS1: MOV B, A 166B 1A PS2: LDAX D ; GET A CHARACTER 166C 13 INX D ; BUMP POINTER 166D B8 CMP B ; SAME AS OLD A? 166E C8 RZ ; YES, RETURN 166F CDDF17 CALL OUTCH ; ELSE, PRINT IT 1672 FE0D CPI CR ; WAS IT A CR? 1674 C26B16 JNZ PS2 ; NO, NEXT 1677 C9 RET ; YES, RETURN ; QTSTG: TSTC '"', QT3 ; *** QTSTG *** 1678+CDBF15 CALL TSTCH 167B+22 DB '"' 167C+0F DB LOW QT3-$-1 167D 3E22 MVI A, '"' ; IT IS A " (DOUBLE QUOTE) 167F CD6A16 QT1: CALL PS1 ; PRINT UNTIL ANOTHER 1682 FE0D QT2: CPI CR ; WAS LAST ONE A CR? 1684 E1 POP H ; RETURN ADDRESS 1685 CA1511 JZ RUNNXL ; WAS CR, RUN NEXT LINE 1688 23 INX H ; SKIP 3 BYTES ON RETURN 1689 23 INX H 168A 23 INX H 168B E9 PCHL ; RETURN QT3: TSTC 27H, QT4 ; IS IT A ' (SINGLE QUOTE) ? 168C+CDBF15 CALL TSTCH 168F+27 DB 27H 1690+05 DB LOW QT4-$-1 1691 3E27 MVI A, 27H ; YES, DO SAME 1693 C37F16 JMP QT1 ; AS IN " QT4: TSTC 5EH, QT5 ; IS IT AN UP-ARROW? 1696+CDBF15 CALL TSTCH 1699+5E DB 5EH 169A+0B DB LOW QT5-$-1 169B 1A LDAX D ; YES, CONVERT CHARACTER 169C EE40 XRI 40H ; TO CONTROL-CHAR. 169E CDDF17 CALL OUTCH 16A1 1A LDAX D ; JUST IN CASE IT IS A CR 16A2 13 INX D 16A3 C38216 JMP QT2 16A6 C9 QT5: RET ; NONE OF THE ABOVE 16A7 7B PRTCHS: MOV A, E 16A8 B8 CMP B 16A9 C8 RZ 16AA 1A LDAX D 16AB CDDF17 CALL OUTCH 16AE 13 INX D 16AF C3A716 JMP PRTCHS ; 16B2 PRTNUM DS 0 ; *** PRTNUM *** 16B2 0600 PN3: MVI B, 0 ; B=SIGN 16B4 CDCF14 CALL CHKSGN ; CHECK SIGN 16B7 F2BD16 JP PN4 ; NO SIGN 16BA 062D MVI B, '-' ; B=SIGN 16BC 0D DCR C ; '-' TAKES SPACE 16BD D5 PN4: PUSH D 16BE 110A00 LXI D, 10 ; DECIMAL 16C1 D5 PUSH D ; SAVE AS A FLAG 16C2 0D DCR C ; C=SPACES 16C3 C5 PUSH B ; SAVE SIGN & SPACE 16C4 CDB214 PN5: CALL DIVIDE ; DIVIDE HL BY 10 16C7 78 MOV A, B ; RESULT O? 16C8 B1 ORA C 16C9 CAD416 JZ PN6 ; YES, WE GOT ALL 16CC E3 XTHL ; NO, SAVE REMAINDER 16CD 2D DCR L ; AND COUNT SPACE 16CE E5 PUSH H ; HL IS OLD BC 16CF 60 MOV H, B ; MOVE RESULT TO BC 16D0 69 MOV L, C 16D1 C3C416 JMP PN5 ; AND DIVIDE BY 10 16D4 C1 PN6: POP B ; WE GOT ALL DIGITS IN 16D5 0D PN7: DCR C ; THE STACK 16D6 79 MOV A, C ; LOOK AT SPACE COUNT 16D7 B7 ORA A 16D8 FAE316 JM PN8 ; NO LEADING BLANKS 16DB 3E20 MVI A, ' ' ; LEADING BLANKS 16DD CDDF17 CALL OUTCH 16E0 C3D516 JMP PN7 ; MORE? 16E3 78 PN8: MOV A, B ; PRINT SIGN? 16E4 B7 ORA A 16E5 C4DF17 CNZ OUTCH ; MAYBE - OR NULL 16E8 5D MOV E, L ; LAST REMAINDER IN E 16E9 7B PN9: MOV A, E ; CHECK DIGIT IN E 16EA FE0A CPI 10 ; 10 IS FLAG FOR NO MORE 16EC D1 POP D 16ED C8 RZ ; IF SO, RETURN 16EE C630 ADI '0' ; ELSE, CONVERT TO ASCII 16F0 CDDF17 CALL OUTCH ; AND PRINT THE DIGIT 16F3 C3E916 JMP PN9 ; GO BACK FOR MORE ; 16F6 1A PRTLN: LDAX D ; *** PRTLN *** 16F7 6F MOV L, A ; LOW ORDER LINE # 16F8 13 INX D 16F9 1A LDAX D ; HIGH ORDER 16FA 67 MOV H, A 16FB 13 INX D 16FC 0E04 MVI C, 4 ; PRINT 4 DIGIT LINE # 16FE CDB216 CALL PRTNUM 1701 3E20 MVI A, ' ' ; FOLLOWED BY A BLANK 1703 CDDF17 CALL OUTCH 1706 C9 RET ; TAB1: ITEM 'LIST', LIST ; DIRECT COMMANDS 1707+4C495354 DB 'LIST' 170B+91 DB HIGH LIST + 8000H 170C+3F DB LOW LIST ITEM 'NEW', NEW 170D+4E4557 DB 'NEW' 1710+91 DB HIGH NEW + 8000H 1711+03 DB LOW NEW ITEM 'RUN', RUN 1712+52554E DB 'RUN' 1715+91 DB HIGH RUN + 8000H 1716+0F DB LOW RUN ITEM 'LOAD', LOAD 1717+4C4F4144 DB 'LOAD' 171B+97 DB HIGH LOAD + 8000H 171C+EE DB LOW LOAD ITEM 'MON', MON 171D+4D4F4E DB 'MON' 1720+97 DB HIGH MON + 8000H 1721+E5 DB LOW MON ; TAB2: ITEM 'NEXT', NEXT ; DIRECT/STATEMENT 1722+4E455854 DB 'NEXT' 1726+92 DB HIGH NEXT + 8000H 1727+6D DB LOW NEXT ITEM 'LET', LET 1728+4C4554 DB 'LET' 172B+93 DB HIGH LET + 8000H 172C+51 DB LOW LET ITEM 'IF', IFF 172D+4946 DB 'IF' 172F+92 DB HIGH IFF + 8000H 1730+D4 DB LOW IFF ITEM 'GOTO', GOTO 1731+474F544F DB 'GOTO' 1735+91 DB HIGH GOTO + 8000H 1736+2E DB LOW GOTO ITEM 'GOSUB',GOSUB 1737+474F535542 DB 'GOSUB' 173C+91 DB HIGH GOSUB + 8000H 173D+C9 DB LOW GOSUB ITEM 'RETURN',RETURN 173E+5245545552 DB 'RETURN' 1744+91 DB HIGH RETURN + 8000H 1745+EB DB LOW RETURN ITEM 'REM', REM 1746+52454D DB 'REM' 1749+92 DB HIGH REM + 8000H 174A+CE DB LOW REM ITEM 'FOR', FOR 174B+464F52 DB 'FOR' 174E+92 DB HIGH FOR + 8000H 174F+06 DB LOW FOR ITEM 'INPUT',INPUT 1750+494E505554 DB 'INPUT' 1755+92 DB HIGH INPUT + 8000H 1756+EF DB LOW INPUT ITEM 'PRINT',PRINT 1757+5052494E54 DB 'PRINT' 175C+91 DB HIGH PRINT + 8000H 175D+6F DB LOW PRINT ITEM 'STOP', STOP 175E+53544F50 DB 'STOP' 1762+91 DB HIGH STOP + 8000H 1763+09 DB LOW STOP ITEM , MOREC 1764+97 DB HIGH MOREC + 8000H 1765+66 DB LOW MOREC ; ************************ 1766 C34B13 MOREC: JMP DEFLT ; *** JMP USER-COMMAND *** ; ************************ TAB3: ITEM 'RND', RND ; FUNCTIONS 1769+524E44 DB 'RND' 176C+94 DB HIGH RND + 8000H 176D+6F DB LOW RND ITEM 'ABS', ABS 176E+414253 DB 'ABS' 1771+94 DB HIGH ABS + 8000H 1772+9C DB LOW ABS ITEM 'SIZE', SIZE 1773+53495A45 DB 'SIZE' 1777+94 DB HIGH SIZE + 8000H 1778+A5 DB LOW SIZE ITEM , MOREF 1779+97 DB HIGH MOREF + 8000H 177A+7B DB LOW MOREF ; ************************* 177B C34D14 MOREF: JMP NOTF ; *** JMP USER-FUNCTION *** ; ************************* TAB4: ITEM 'TO', FR1 ; "FOR" COMMAND 177E+544F DB 'TO' 1780+92 DB HIGH FR1 + 8000H 1781+16 DB LOW FR1 ITEM , QWHAT 1782+95 DB HIGH QWHAT + 8000H 1783+34 DB LOW QWHAT ; TAB5: ITEM 'STEP', FR2 ; "FOR" COMMAND 1784+53544550 DB 'STEP' 1788+92 DB HIGH FR2 + 8000H 1789+22 DB LOW FR2 ITEM , FR3 178A+92 DB HIGH FR3 + 8000H 178B+28 DB LOW FR3 ; TAB6: ITEM '>=', XPR1 ; RELATION OPERATORS 178C+3E3D DB '>=' 178E+93 DB HIGH XPR1 + 8000H 178F+69 DB LOW XPR1 ITEM '#', XPR2 1790+23 DB '#' 1791+93 DB HIGH XPR2 + 8000H 1792+6F DB LOW XPR2 ITEM '>', XPR3 1793+3E DB '>' 1794+93 DB HIGH XPR3 + 8000H 1795+75 DB LOW XPR3 ITEM '=', XPR5 1796+3D DB '=' 1797+93 DB HIGH XPR5 + 8000H 1798+84 DB LOW XPR5 ITEM '<=', XPR4 1799+3C3D DB '<=' 179B+93 DB HIGH XPR4 + 8000H 179C+7C DB LOW XPR4 ITEM '<', XPR6 179D+3C DB '<' 179E+93 DB HIGH XPR6 + 8000H 179F+8A DB LOW XPR6 ITEM , XPR7 17A0+93 DB HIGH XPR7 + 8000H 17A1+90 DB LOW XPR7 ; 17A2 = RANEND EQU $ ; ; PATB ORIGINAL CODE> ; --------------------------------------------------------------- ; ; *** INPUT OUTPUT ROUTINES *** ; ; USER MUST VERIFY AND/OR MODIFY THESE ROUTINES ; ; --------------------------------------------------------------- ; ; *** CRLF *** OUTCH *** ; ; 'CRLF' WILL OUTPUT A CR. ONLY A & FLAGS MAY CHANGE AT RETURN. ; ; 'OUTCH' WILL OUTPUT THE CHARACTER IN A. IF THE CHARACTER IS CR, ; IT WILL ALSO OUTUT A LF AND THREE NULLS. FLAGS MAY CHANGE AT ; RETURN. OTHERS REGISTERS DO NOT. ; ; *** CHKIO *** GETLN *** ; ; 'CHKIO' CHECKS TO SEE IF THERE IS ANY INPUT. IF NO INPUT, ; IT RETURNS WITH Z FLAG. IF THERE IS INPUT, IT FURTHER CHECKS ; WETHER INPUT IS CONTROL-C. IF NOT CONTROL-C, IT RETURNS THE ; CHARACTER IN A WITH Z FLAG CLEARED. IF INPUT IS CONTROL-C, ; 'CHKIO' JUMPS TO 'INIT' AND WILL NOT RETURN. ONLY A & FLAGS ; MAY CHANGE AT RETURN. ; ; 'GETLN' READS A INPUT LINE INTO 'BUFFER'. IT FIRST PROMPT THE ; CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS THE BUFFER ; AND ECHOS. BACK-SPACE IS USED TO DELETE THE LAST CHARACTER ; (IF THERE IS ONE). CR SIGNALS THE END OF THE LINE, AND CAUSE ; 'GETLN' TO RETURN. WHEN BUFFER IS FULL, 'GETLN' WILL ACCEPT ; BACK-SPACE OR CR ONLY AND WILL IGNORE (AND WILL NOT ECHO) ; OTHER CHARACTERS. AFTER THE INPUT LINE IS STORED IN THE BUFFER ; TWO MORE BYTES OF FF ARE ALSO STORED AND DE POINTS TO THE ; LAST FF. A & FLAGS ARE ALSO CHANGED AT RETURN. ; ; INPUT LINE TO BUFFER ; CTRL-U -> CANCEL LINE ; BS -> BACK 1 CHAR ; DEL -> BACK 1 CHAR ; CR -> END OF INPUT ; OTHER CONTROL -> IGNORE 17A2 3E0D GL3: MVI A, CR 17A4 CDDF17 CALL OUTCH 17A7 3E23 MVI A, '#' ;; *********************** 17A9 114988 GETLN: LXI D, BUFFER ; *** MODIFY THIS ******* ;; *********************** 17AC CDDF17 GL1: CALL OUTCH ; PROMPT OR ECHO 17AF CDE217 GL2: CALL CHKIO ; GET A CHARACTER JRZ GL2 ; WAIT FOR INPUT 17B2+28FB DB 28H,GL2-$-1 17B4 FE15 CPI 15H ; CTRL-U JRZ GL3 17B6+28EA DB 28H,GL3-$-1 17B8 12 STAX D 17B9 FE08 CPI 08H ; IS IT BACK-SPACE? JRNZ GL4 ; NO, MORE TESTS 17BB+2009 DB 20H,GL4-$-1 17BD 7B MOV A, E ; YES, DELETE? 17BE FE49 CPI LOW BUFFER JRZ GL2 ; NOTHING TO DELETE 17C0+28ED DB 28H,GL2-$-1 17C2 1A LDAX D 17C3 1B DCX D JR GL1 17C4+18E6 DB 18H,GL1-$-1 17C6 FE0D GL4: CPI CR ; WAS IT CR? JRZ GL5 ; YES, END OF LINE 17C8+280D DB 28H,GL5-$-1 17CA FE20 CPI 20H JRC GL2 17CC+38E1 DB 38H,GL2-$-1 17CE 7B MOV A, E ; ELSE, MORE FREE ROOM? 17CF FECD CPI LOW BUFEND JRZ GL2 ; NO, WAIT FOR CR/RUB-OUT 17D1+28DC DB 28H,GL2-$-1 17D3 1A LDAX D ; YES, BUMP POINTER 17D4 13 INX D JR GL1 17D5+18D5 DB 18H,GL1-$-1 17D7 13 GL5: INX D ; END OF LINE 17D8 13 INX D ; BUMP POINTER 17D9 3EFF MVI A, 0FFH ; PUT MARKER AFTER IT 17DB 12 STAX D 17DC 1B DCX D 17DD 3E0D CRLF: MVI A, CR ; CR IN A 17DF C3D10F OUTCH: JMP RST3 17E2 C3E50F CHKIO: JMP RST2 ; ------------------------------- ; USE MONITOR 17E5 CD2E15 MON: CALL ENDCHK 17E8 CD0001 CALL MONITOR ; MONITOR 17EB C31C10 JMP TELL 17EE CD2E15 LOAD: CALL ENDCHK 17F1 210018 LXI H, 1800H 17F4 110090 LXI D, BOTRAM 17F7 010018 LXI B, 1800H LDIR 17FA+EDB0 DB 0EDH,0B0H 17FC C31C10 JMP TELL 17FF END