0001 0000 ;SATBROM.asm 0002 0000 ;TinyBASIC version for standalone Z80 computer ROM by Donn Stewart Oct 22, 2020 0003 0000 ;8080 code 0004 0000 ;Revised from SATBRAM2.asm 0005 0000 ;Origin changed to 16C7h to fit in space in standalone-ROM-5 0006 0000 ;Changed addresses to match standalone-ROM-5 0007 0000 0008 0000 0009 0000 ;************************************************************* 0010 0000 ; 0011 0000 ; TINY BASIC FOR INTEL 8080 0012 0000 ; VERSION 2.0 0013 0000 ; BY LI-CHEN WANG 0014 0000 ; MODIFIED AND TRANSLATED 0015 0000 ; TO INTEL MNEMONICS 0016 0000 ; BY ROGER RAUSKOLB 0017 0000 ; 10 OCTOBER,1976 0018 0000 ; @COPYLEFT 0019 0000 ; ALL WRONGS RESERVED 0020 0000 ; 0021 0000 ;************************************************************* 0022 0000 ; 0023 0000 ; *** ZERO PAGE SUBROUTINES *** 0024 0000 ; 0025 0000 ; THE 8080 INSTRUCTION SET LETS YOU HAVE 8 ROUTINES IN LOW 0026 0000 ; MEMORY THAT MAY BE CALLED BY RST N, N BEING 0 THROUGH 7. 0027 0000 ; THIS IS A ONE BYTE INSTRUCTION AND HAS THE SAME POWER AS 0028 0000 ; THE THREE BYTE INSTRUCTION CALL LLHH. TINY BASIC WILL 0029 0000 ; USE RST 0 AS START AND RST 1 THROUGH RST 7 FOR 0030 0000 ; THE SEVEN MOST FREQUENTLY USED SUBROUTINES. 0031 0000 ; TWO OTHER SUBROUTINES (CRLF AND TSTNUM) ARE ALSO IN THIS 0032 0000 ; SECTION. THEY CAN BE REACHED ONLY BY 3-BYTE CALLS. 0033 0000 ; 0034 0000 ;This is the troublesome macro. Left the references in the code but 0035 0000 ; commented them out, and just pasted in the macro code 0036 0000 #Define DWA(WHERE) .DB ((WHERE >> 8) + 128)\ .DB (WHERE & 0FFH) 0037 0000 ; 0038 16C7 .ORG 16C7H ;For space in standalone-ROM-5 0039 16C7 31 FF 7F START: LXI SP,STACK ;*** COLD START *** 0040 16CA 3E FF MVI A,0FFH 0041 16CC C3 A1 1D JMP INIT 0042 16CF ; 0043 16CF E3 TSTC: XTHL ;*** TSTC OR RST 1 *** 0044 16D0 CD F1 16 CALL IGNBLK ;IGNORE BLANKS AND 0045 16D3 BE CMP M ;TEST CHARACTER 0046 16D4 C3 35 17 JMP TC1 ;REST OF THIS IS AT TC1 0047 16D7 ; 0048 16D7 3E 0D CRLF: mvi a,0dh ;no need to add newline, display does newline on CR 0049 16D9 ; 0050 16D9 F5 OUTC: PUSH PSW ;*** OUTC OR RST 2 *** 0051 16DA 3A 00 30 LDA OCSW ;PRINT CHARACTER ONLY 0052 16DD B7 ORA A ;IF OCSW SWITCH IS ON 0053 16DE C3 C3 1D JMP OC2 ;REST OF THIS IS AT OC2 0054 16E1 ; 0055 16E1 CD 78 1A EXPR: CALL EXPR2 ;*** EXPR OR RST 3 *** 0056 16E4 E5 PUSH H ;EVALUATE AN EXPRESSION 0057 16E5 C3 34 1A JMP EXPR1 ;REST OF IT AT EXPR1 0058 16E8 57 .DB 'W' 0059 16E9 ; 0060 16E9 7C COMP: MOV A,H ;*** COMP OR RST 4 *** 0061 16EA BA CMP D ;COMPARE HL WITH DE 0062 16EB C0 RNZ ;RETURN CORRECT C AND 0063 16EC 7D MOV A,L ;Z FLAGS 0064 16ED BB CMP E ;BUT OLD A IS LOST 0065 16EE C9 RET 0066 16EF 41 4E .DB "AN" 0067 16F1 ; 0068 16F1 IGNBLK: 0069 16F1 1A SS1: LDAX D ;*** IGNBLK/RST 5 *** 0070 16F2 FE 20 CPI 20H ;IGNORE BLANKS 0071 16F4 C0 RNZ ;IN TEXT (WHERE DE->) 0072 16F5 13 INX D ;AND RETURN THE FIRST 0073 16F6 C3 F1 16 JMP SS1 ;NON-BLANK CHAR. IN A 0074 16F9 ; 0075 16F9 F1 FINISH: POP PSW ;*** FINISH/RST 6 *** 0076 16FA CD D8 1B CALL FIN ;CHECK END OF COMMAND 0077 16FD C3 F1 1B JMP QWHAT ;PRINT "WHAT?" IF WRONG 0078 1700 47 .DB 'G' 0079 1701 ; 0080 1701 CD F1 16 TSTV: CALL IGNBLK ;*** TSTV OR RST 7 *** 0081 1704 D6 40 SUI 40H ;TEST VARIABLES 0082 1706 D8 RC ;C:NOT A VARIABLE 0083 1707 C2 25 17 JNZ TV1 ;NOT "@" ARRAY 0084 170A 13 INX D ;IT IS THE "@" ARRAY 0085 170B CD 2F 1B CALL PARN ;@ SHOULD BE FOLLOWED 0086 170E 29 DAD H ;BY (EXPR) AS ITS INDEX 0087 170F DA 6E 17 JC QHOW ;IS INDEX TOO BIG? 0088 1712 D5 PUSH D ;WILL IT OVERWRITE 0089 1713 EB XCHG ;TEXT? 0090 1714 CD 76 1B CALL SIZE ;FIND SIZE OF FREE 0091 1717 CD E9 16 CALL COMP ;AND CHECK THAT 0092 171A DA 21 1C JC ASORRY ;IF SO, SAY "SORRY" 0093 171D 21 00 7F LXI H,VARBGN ;IF NOT GET ADDRESS 0094 1720 CD 99 1B CALL SUBDE ;OF @(EXPR) AND PUT IT 0095 1723 D1 POP D ;IN HL 0096 1724 C9 RET ;C FLAG IS CLEARED 0097 1725 FE 1B TV1: CPI 1BH ;NOT @, IS IT A TO Z? 0098 1727 3F CMC ;IF NOT RETURN C FLAG 0099 1728 D8 RC 0100 1729 13 INX D ;IF A THROUGH Z 0101 172A 21 00 7F LXI H,VARBGN ;COMPUTE ADDRESS OF 0102 172D 07 RLC ;THAT VARIABLE 0103 172E 85 ADD L ;AND RETURN IT IN HL 0104 172F 6F MOV L,A ;WITH C FLAG CLEARED 0105 1730 3E 00 MVI A,0 0106 1732 8C ADC H 0107 1733 67 MOV H,A 0108 1734 C9 RET 0109 1735 ; 0110 1735 ;TSTC: XTHL ;*** TSTC OR RST 1 *** 0111 1735 ; CALL IGNBLK ;THIS IS AT LOC. 8 0112 1735 ; CMP M ;AND THEN JUMP HERE 0113 1735 23 TC1: INX H ;COMPARE THE BYTE THAT 0114 1736 CA 40 17 JZ TC2 ;FOLLOWS THE RST INST. 0115 1739 C5 PUSH B ;WITH THE TEXT (DE->) 0116 173A 4E MOV C,M ;IF NOT =, ADD THE 2ND 0117 173B 06 00 MVI B,0 ;BYTE THAT FOLLOWS THE 0118 173D 09 DAD B ;RST TO THE OLD PC 0119 173E C1 POP B ;I.E., DO A RELATIVE 0120 173F 1B DCX D ;JUMP IF NOT = 0121 1740 13 TC2: INX D ;IF =, SKIP THOSE BYTES 0122 1741 23 INX H ;AND CONTINUE 0123 1742 E3 XTHL 0124 1743 C9 RET 0125 1744 ; 0126 1744 21 00 00 TSTNUM: LXI H,0 ;*** TSTNUM *** 0127 1747 44 MOV B,H ;TEST IF THE TEXT IS 0128 1748 CD F1 16 CALL IGNBLK ;A NUMBER 0129 174B FE 30 TN1: CPI 30H ;IF NOT, RETURN 0 IN 0130 174D D8 RC ;B AND HL 0131 174E FE 3A CPI 3AH ;IF NUMBERS, CONVERT 0132 1750 D0 RNC ;TO BINARY IN HL AND 0133 1751 3E F0 MVI A,0F0H ;SET B TO # OF DIGITS 0134 1753 A4 ANA H ;IF H>255, THERE IS NO 0135 1754 C2 6E 17 JNZ QHOW ;ROOM FOR NEXT DIGIT 0136 1757 04 INR B ;B COUNTS # OF DIGITS 0137 1758 C5 PUSH B 0138 1759 44 MOV B,H ;HL=10*HL+(NEW DIGIT) 0139 175A 4D MOV C,L 0140 175B 29 DAD H ;WHERE 10* IS DONE BY 0141 175C 29 DAD H ;SHIFT AND ADD 0142 175D 09 DAD B 0143 175E 29 DAD H 0144 175F 1A LDAX D ;AND (DIGIT) IS FROM 0145 1760 13 INX D ;STRIPPING THE ASCII 0146 1761 E6 0F ANI 0FH ;CODE 0147 1763 85 ADD L 0148 1764 6F MOV L,A 0149 1765 3E 00 MVI A,0 0150 1767 8C ADC H 0151 1768 67 MOV H,A 0152 1769 C1 POP B 0153 176A 1A LDAX D ;DO THIS DIGIT AFTER 0154 176B F2 4B 17 JP TN1 ;DIGIT. S SAYS OVERFLOW 0155 176E D5 QHOW: PUSH D ;*** ERROR "HOW?" *** 0156 176F 11 75 17 AHOW: LXI D,HOW 0157 1772 C3 F5 1B JMP ERROR 0158 1775 48 4F 57 3F HOW: .DB "HOW?" 0159 1779 0D .DB CR 0160 177A 4F 4B OK: .DB "OK" 0161 177C 0D .DB CR 0162 177D 574841543F WHAT: .DB "WHAT?" 0163 1782 0D .DB CR 0164 1783 534F525259 SORRY: .DB "SORRY" 0165 1788 0D .DB CR 0166 1789 ; 0167 1789 ;************************************************************* 0168 1789 ; 0169 1789 ; *** MAIN *** 0170 1789 ; 0171 1789 ; THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM 0172 1789 ; AND STORES IT IN THE MEMORY. 0173 1789 ; 0174 1789 ; AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE 0175 1789 ; STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS 0176 1789 ; ">" AND READS A LINE. IF THE LINE STARTS WITH A NON-ZERO 0177 1789 ; NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER 0178 1789 ; (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR) 0179 1789 ; IS STORED IN THE MEMORY. IF A LINE WITH THE SAME LINE 0180 1789 ; NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW ONE. IF 0181 1789 ; THE REST OF THE LINE CONSISTS OF A CR ONLY, IT IS NOT STORED 0182 1789 ; AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED. 0183 1789 ; 0184 1789 ; AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM 0185 1789 ; LOOPS BACK AND ASKS FOR ANOTHER LINE. THIS LOOP WILL BE 0186 1789 ; TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE 0187 1789 ; NUMBER; AND CONTROL IS TRANSFERED TO "DIRECT". 0188 1789 ; 0189 1789 ; TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION 0190 1789 ; LABELED "TXTBGN" AND ENDS AT "TXTEND". WE ALWAYS FILL THIS 0191 1789 ; AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED 0192 1789 ; BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF". 0193 1789 ; 0194 1789 ; THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER 0195 1789 ; THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN 0196 1789 ; THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND 0197 1789 ; (SEE NEXT SECTION). "CURRNT" SHOULD POINT TO A 0. 0198 1789 ; 0199 1789 31 FF 7F RSTART: LXI SP,STACK 0200 178C CD D7 16 ST1: CALL CRLF ;AND JUMP TO HERE 0201 178F 11 7A 17 LXI D,OK ;DE->STRING 0202 1792 97 SUB A ;A=0 0203 1793 CD AB 1C CALL PRTSTG ;PRINT STRING UNTIL CR 0204 1796 21 9D 17 LXI H,ST2+1 ;LITERAL 0 0205 1799 22 01 30 SHLD CURRNT ;CURRENT->LINE # = 0 0206 179C 21 00 00 ST2: LXI H,0 0207 179F 22 09 30 SHLD LOPVAR 0208 17A2 22 03 30 SHLD STKGOS 0209 17A5 3E 3E ST3: MVI A,3EH ;PROMPT '>' AND 0210 17A7 CD 27 1C CALL GETLN ;READ A LINE 0211 17AA D5 PUSH D ;DE->END OF LINE 0212 17AB 11 37 7F LXI D,BUFFER ;DE->BEGINNING OF LINE 0213 17AE CD 44 17 CALL TSTNUM ;TEST IF IT IS A NUMBER 0214 17B1 CD F1 16 CALL IGNBLK 0215 17B4 7C MOV A,H ;HL=VALUE OF THE # OR 0216 17B5 B5 ORA L ;0 IF NO # WAS FOUND 0217 17B6 C1 POP B ;BC->END OF LINE 0218 17B7 CA 8F 1E JZ DIRECT 0219 17BA 1B DCX D ;BACKUP DE AND SAVE 0220 17BB 7C MOV A,H ;VALUE OF LINE # THERE 0221 17BC 12 STAX D 0222 17BD 1B DCX D 0223 17BE 7D MOV A,L 0224 17BF 12 STAX D 0225 17C0 C5 PUSH B ;BC,DE->BEGIN, END 0226 17C1 D5 PUSH D 0227 17C2 79 MOV A,C 0228 17C3 93 SUB E 0229 17C4 F5 PUSH PSW ;A=# OF BYTES IN LINE 0230 17C5 CD 81 1C CALL FNDLN ;FIND THIS LINE IN SAVE 0231 17C8 D5 PUSH D ;AREA, DE->SAVE AREA 0232 17C9 C2 DC 17 JNZ ST4 ;NZ:NOT FOUND, INSERT 0233 17CC D5 PUSH D ;Z:FOUND, DELETE IT 0234 17CD CD 9F 1C CALL FNDNXT ;FIND NEXT LINE 0235 17D0 ;DE->NEXT LINE 0236 17D0 C1 POP B ;BC->LINE TO BE DELETED 0237 17D1 2A 15 30 LHLD TXTUNF ;HL->UNFILLED SAVE AREA 0238 17D4 CD 42 1D CALL MVUP ;MOVE UP TO DELETE 0239 17D7 60 MOV H,B ;TXTUNF->UNFILLED AREA 0240 17D8 69 MOV L,C 0241 17D9 22 15 30 SHLD TXTUNF ;UPDATE 0242 17DC C1 ST4: POP B ;GET READY TO INSERT 0243 17DD 2A 15 30 LHLD TXTUNF ;BUT FIRST CHECK IF 0244 17E0 F1 POP PSW ;THE LENGTH OF NEW LINE 0245 17E1 E5 PUSH H ;IS 3 (LINE # AND CR) 0246 17E2 FE 03 CPI 3 ;THEN DO NOT INSERT 0247 17E4 CA 89 17 JZ RSTART ;MUST CLEAR THE STACK 0248 17E7 85 ADD L ;COMPUTE NEW TXTUNF 0249 17E8 6F MOV L,A 0250 17E9 3E 00 MVI A,0 0251 17EB 8C ADC H 0252 17EC 67 MOV H,A ;HL->NEW UNFILLED AREA 0253 17ED 11 00 7F LXI D,TXTEND ;CHECK TO SEE IF THERE 0254 17F0 CD E9 16 CALL COMP ;IS ENOUGH SPACE 0255 17F3 D2 20 1C JNC QSORRY ;SORRY, NO ROOM FOR IT 0256 17F6 22 15 30 SHLD TXTUNF ;OK, UPDATE TXTUNF 0257 17F9 D1 POP D ;DE->OLD UNFILLED AREA 0258 17FA CD 4D 1D CALL MVDOWN 0259 17FD D1 POP D ;DE->BEGIN, HL->END 0260 17FE E1 POP H 0261 17FF CD 42 1D CALL MVUP ;MOVE NEW LINE TO SAVE 0262 1802 C3 A5 17 JMP ST3 ;AREA 0263 1805 ; 0264 1805 ;************************************************************* 0265 1805 ; 0266 1805 ; WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT 0267 1805 ; COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE 0268 1805 ; COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST 0269 1805 ; SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS 0270 1805 ; TRANSFERED TO OTHERS SECTIONS AS FOLLOWS: 0271 1805 ; 0272 1805 ; FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'RSTART' 0273 1805 ; FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE 0274 1805 ; GO BACK TO 'RSTART'. 0275 1805 ; FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE. 0276 1805 ; FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE. 0277 1805 ; FOR ALL OTHERS: IF 'CURRENT' -> 0, GO TO 'RSTART', ELSE 0278 1805 ; GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.) 0279 1805 ;************************************************************* 0280 1805 ; 0281 1805 ; *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO *** 0282 1805 ; 0283 1805 ; 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN' 0284 1805 ; 0285 1805 ; 'STOP(CR)' GOES BACK TO 'RSTART' 0286 1805 ; 0287 1805 ; 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN 0288 1805 ; 'CURRENT'), AND START EXECUTE IT. NOTE THAT ONLY THOSE 0289 1805 ; COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM. 0290 1805 ; 0291 1805 ; THERE ARE 3 MORE ENTRIES IN 'RUN': 0292 1805 ; 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT. 0293 1805 ; 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT. 0294 1805 ; 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE. 0295 1805 ; 0296 1805 ; 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET 0297 1805 ; LINE, AND JUMP TO 'RUNTSL' TO DO IT. 0298 1805 ; 0299 1805 CD EB 1B NEW: CALL ENDCHK ;*** NEW(CR) *** 0300 1808 21 17 30 LXI H,TXTBGN 0301 180B 22 15 30 SHLD TXTUNF 0302 180E ; 0303 180E CD EB 1B STOP: CALL ENDCHK ;*** STOP(CR) *** 0304 1811 C3 89 17 JMP RSTART 0305 1814 ; 0306 1814 CD EB 1B RUN: CALL ENDCHK ;*** RUN(CR) *** 0307 1817 11 17 30 LXI D,TXTBGN ;FIRST SAVED LINE 0308 181A ; 0309 181A 21 00 00 RUNNXL: LXI H,0 ;*** RUNNXL *** 0310 181D CD 89 1C CALL FNDLP ;FIND WHATEVER LINE # 0311 1820 DA 89 17 JC RSTART ;C:PASSED TXTUNF, QUIT 0312 1823 ; 0313 1823 EB RUNTSL: XCHG ;*** RUNTSL *** 0314 1824 22 01 30 SHLD CURRNT ;SET 'CURRENT'->LINE # 0315 1827 EB XCHG 0316 1828 13 INX D ;BUMP PASS LINE # 0317 1829 13 INX D 0318 182A ; 0319 182A CD D5 1D RUNSML: CALL CHKIO ;*** RUNSML *** CHKIO here just to check for ctrl-C 0320 182D 21 14 1E LXI H,TAB2-1 ;FIND COMMAND IN TAB2 0321 1830 C3 92 1E JMP EXEC ;AND EXECUTE IT 0322 1833 ; 0323 1833 CD E1 16 GOTO: CALL EXPR ;*** GOTO EXPR *** 0324 1836 D5 PUSH D ;SAVE FOR ERROR ROUTINE 0325 1837 CD EB 1B CALL ENDCHK ;MUST FIND A CR 0326 183A CD 81 1C CALL FNDLN ;FIND THE TARGET LINE 0327 183D C2 6F 17 JNZ AHOW ;NO SUCH LINE # 0328 1840 F1 POP PSW ;CLEAR THE PUSH DE 0329 1841 C3 23 18 JMP RUNTSL ;GO DO IT 0330 1844 ; 0331 1844 ;************************************************************* 0332 1844 ; 0333 1844 ; *** LIST *** & PRINT *** 0334 1844 ; 0335 1844 ; LIST HAS TWO FORMS: 0336 1844 ; 'LIST(CR)' LISTS ALL SAVED LINES 0337 1844 ; 'LIST #(CR)' START LIST AT THIS LINE # 0338 1844 ; YOU CAN STOP THE LISTING BY CONTROL C KEY 0339 1844 ; 0340 1844 ; PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)' 0341 1844 ; WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACK- 0342 1844 ; ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS. 0343 1844 ; 0344 1844 ; A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS 0345 1844 ; THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO 0346 1844 ; BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT 0347 1844 ; COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS 0348 1844 ; SPECIFIED, 6 POSITIONS WILL BE USED. 0349 1844 ; 0350 1844 ; A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF 0351 1844 ; DOUBLE QUOTES. 0352 1844 ; 0353 1844 ; A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF) 0354 1844 ; 0355 1844 ; A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN 0356 1844 ; PRINTED OR IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST 0357 1844 ; ENDED WITH A COMMA, NO (CRLF) IS GENERATED. 0358 1844 ; 0359 1844 CD 44 17 LIST: CALL TSTNUM ;TEST IF THERE IS A # 0360 1847 CD EB 1B CALL ENDCHK ;IF NO # WE GET A 0 0361 184A CD 81 1C CALL FNDLN ;FIND THIS OR NEXT LINE 0362 184D D3 05 out 5 ;clear shift register 0363 184F DA 89 17 LS1: JC RSTART ;C:PASSED TXTUNF 0364 1852 CD 2D 1D CALL PRTLN ;PRINT THE LINE 0365 1855 CD D5 1D CALL CHKIO ;STOP IF HIT CONTROL-C 0366 1858 CD 89 1C CALL FNDLP ;FIND NEXT LINE 0367 185B C3 4F 18 JMP LS1 ;AND LOOP BACK 0368 185E ; 0369 185E 0E 06 PRINT: MVI C,6 ;C = # OF SPACES 0370 1860 CD CF 16 CALL TSTC ;IF NULL LIST & ";" 0371 1863 3B .DB 3BH 0372 1864 06 .DB PR2-$-1 0373 1865 CD D7 16 CALL CRLF ;GIVE CR-LF AND 0374 1868 C3 2A 18 JMP RUNSML ;CONTINUE SAME LINE 0375 186B CD CF 16 PR2: CALL TSTC ;IF NULL LIST (CR) 0376 186E 0D .DB CR 0377 186F 06 .DB PR0-$-1 0378 1870 CD D7 16 CALL CRLF ;ALSO GIVE CR-LF AND 0379 1873 C3 1A 18 JMP RUNNXL ;GO TO NEXT LINE 0380 1876 CD CF 16 PR0: CALL TSTC ;ELSE IS IT FORMAT? 0381 1879 23 .DB '#' 0382 187A 07 .DB PR1-$-1 0383 187B CD E1 16 CALL EXPR ;YES, EVALUATE EXPR. 0384 187E 4D MOV C,L ;AND SAVE IT IN C 0385 187F C3 88 18 JMP PR3 ;LOOK FOR MORE TO PRINT 0386 1882 CD B9 1C PR1: CALL QTSTG ;OR IS IT A STRING? 0387 1885 C3 99 18 JMP PR8 ;IF NOT, MUST BE EXPR. 0388 1888 CD CF 16 PR3: CALL TSTC ;IF ",", GO FIND NEXT 0389 188B 2C .DB ',' 0390 188C 06 .DB PR6-$-1 0391 188D CD D8 1B CALL FIN ;IN THE LIST. 0392 1890 C3 76 18 JMP PR0 ;LIST CONTINUES 0393 1893 CD D7 16 PR6: CALL CRLF ;LIST ENDS 0394 1896 CD F9 16 CALL FINISH 0395 1899 CD E1 16 PR8: CALL EXPR ;EVALUATE THE EXPR 0396 189C C5 PUSH B 0397 189D CD E9 1C CALL PRTNUM ;PRINT THE VALUE 0398 18A0 C1 POP B 0399 18A1 C3 88 18 JMP PR3 ;MORE TO PRINT? 0400 18A4 ; 0401 18A4 ;************************************************************* 0402 18A4 ; 0403 18A4 ; *** GOSUB *** & RETURN *** 0404 18A4 ; 0405 18A4 ; 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO' 0406 18A4 ; COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER 0407 18A4 ; ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE 0408 18A4 ; SUBROUTINE 'RETURN'. IN ORDER THAT 'GOSUB' CAN BE NESTED 0409 18A4 ; (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED. 0410 18A4 ; THE STACK POINTER IS SAVED IN 'STKGOS', THE OLD 'STKGOS' IS 0411 18A4 ; SAVED IN THE STACK. IF WE ARE IN THE MAIN ROUTINE, 'STKGOS' 0412 18A4 ; IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE), 0413 18A4 ; BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S. 0414 18A4 ; 0415 18A4 ; 'RETURN(CR)' UNDOS EVERYTHING THAT 'GOSUB' DID, AND THUS 0416 18A4 ; RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT 0417 18A4 ; 'GOSUB'. IF 'STKGOS' IS ZERO, IT INDICATES THAT WE 0418 18A4 ; NEVER HAD A 'GOSUB' AND IS THUS AN ERROR. 0419 18A4 ; 0420 18A4 CD 78 1D GOSUB: CALL PUSHA ;SAVE THE CURRENT "FOR" 0421 18A7 CD E1 16 CALL EXPR ;PARAMETERS 0422 18AA D5 PUSH D ;AND TEXT POINTER 0423 18AB CD 81 1C CALL FNDLN ;FIND THE TARGET LINE 0424 18AE C2 6F 17 JNZ AHOW ;NOT THERE. SAY "HOW?" 0425 18B1 2A 01 30 LHLD CURRNT ;FOUND IT, SAVE OLD 0426 18B4 E5 PUSH H ;'CURRNT' OLD 'STKGOS' 0427 18B5 2A 03 30 LHLD STKGOS 0428 18B8 E5 PUSH H 0429 18B9 21 00 00 LXI H,0 ;AND LOAD NEW ONES 0430 18BC 22 09 30 SHLD LOPVAR 0431 18BF 39 DAD SP 0432 18C0 22 03 30 SHLD STKGOS 0433 18C3 C3 23 18 JMP RUNTSL ;THEN RUN THAT LINE 0434 18C6 CD EB 1B RETURN: CALL ENDCHK ;THERE MUST BE A CR 0435 18C9 2A 03 30 LHLD STKGOS ;OLD STACK POINTER 0436 18CC 7C MOV A,H ;0 MEANS NOT EXIST 0437 18CD B5 ORA L 0438 18CE CA F1 1B JZ QWHAT ;SO, WE SAY: "WHAT?" 0439 18D1 F9 SPHL ;ELSE, RESTORE IT 0440 18D2 E1 POP H 0441 18D3 22 03 30 SHLD STKGOS ;AND THE OLD 'STKGOS' 0442 18D6 E1 POP H 0443 18D7 22 01 30 SHLD CURRNT ;AND THE OLD 'CURRNT' 0444 18DA D1 POP D ;OLD TEXT POINTER 0445 18DB CD 5C 1D CALL POPA ;OLD "FOR" PARAMETERS 0446 18DE CD F9 16 CALL FINISH ;AND WE ARE BACK HOME 0447 18E1 ; 0448 18E1 ;************************************************************* 0449 18E1 ; 0450 18E1 ; *** FOR *** & NEXT *** 0451 18E1 ; 0452 18E1 ; 'FOR' HAS TWO FORMS: 0453 18E1 ; 'FOR VAR=EXP1 TO EXP2 STEP EXP3' AND 'FOR VAR=EXP1 TO EXP2' 0454 18E1 ; THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH 0455 18E1 ; EXP3=1. (I.E., WITH A STEP OF +1.) 0456 18E1 ; TBI WILL FIND THE VARIABLE VAR, AND SET ITS VALUE TO THE 0457 18E1 ; CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXP2 AND EXP3 0458 18E1 ; AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTER ETC. IN 0459 18E1 ; THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC', 0460 18E1 ; 'LOPLMT', 'LOPLN', AND 'LOPPT'. IF THERE IS ALREADY SOME- 0461 18E1 ; THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO 0462 18E1 ; 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK 0463 18E1 ; BEFORE THE NEW ONE OVERWRITES IT. 0464 18E1 ; TBI WILL THEN DIG IN THE STACK AND FIND OUT IF THIS SAME 0465 18E1 ; VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP. 0466 18E1 ; IF THAT IS THE CASE, THEN THE OLD 'FOR' LOOP IS DEACTIVATED. 0467 18E1 ; (PURGED FROM THE STACK..) 0468 18E1 ; 0469 18E1 ; 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL) 0470 18E1 ; END OF THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS CHECKED 0471 18E1 ; WITH THE 'LOPVAR'. IF THEY ARE NOT THE SAME, TBI DIGS IN 0472 18E1 ; THE STACK TO FIND THE RIGHT ONE AND PURGES ALL THOSE THAT 0473 18E1 ; DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE 'STEP' TO 0474 18E1 ; THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT. IF IT 0475 18E1 ; IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND 0476 18E1 ; FOLLOWING THE 'FOR'. IF OUTSIDE THE LIMIT, THE SAVE AREA 0477 18E1 ; IS PURGED AND EXECUTION CONTINUES. 0478 18E1 ; 0479 18E1 CD 78 1D FOR: CALL PUSHA ;SAVE THE OLD SAVE AREA 0480 18E4 CD BF 1B CALL SETVAL ;SET THE CONTROL VAR. 0481 18E7 2B DCX H ;HL IS ITS ADDRESS 0482 18E8 22 09 30 SHLD LOPVAR ;SAVE THAT 0483 18EB 21 6A 1E LXI H,TAB5-1 ;USE 'EXEC' TO LOOK 0484 18EE C3 92 1E JMP EXEC ;FOR THE WORD 'TO' 0485 18F1 CD E1 16 FR1: CALL EXPR ;EVALUATE THE LIMIT 0486 18F4 22 0D 30 SHLD LOPLMT ;SAVE THAT 0487 18F7 21 70 1E LXI H,TAB6-1 ;USE 'EXEC' TO LOOK 0488 18FA C3 92 1E JMP EXEC ;FOR THE WORD 'STEP' 0489 18FD CD E1 16 FR2: CALL EXPR ;FOUND IT, GET STEP 0490 1900 C3 06 19 JMP FR4 0491 1903 21 01 00 FR3: LXI H,1H ;NOT FOUND, SET TO 1 0492 1906 22 0B 30 FR4: SHLD LOPINC ;SAVE THAT TOO 0493 1909 2A 01 30 FR5: LHLD CURRNT ;SAVE CURRENT LINE # 0494 190C 22 0F 30 SHLD LOPLN 0495 190F EB XCHG ;AND TEXT POINTER 0496 1910 22 11 30 SHLD LOPPT 0497 1913 01 0A 00 LXI B,0AH ;DIG INTO STACK TO 0498 1916 2A 09 30 LHLD LOPVAR ;FIND 'LOPVAR' 0499 1919 EB XCHG 0500 191A 60 MOV H,B 0501 191B 68 MOV L,B ;HL=0 NOW 0502 191C 39 DAD SP ;HERE IS THE STACK 0503 191D 3E .DB 3EH 0504 191E 09 FR7: DAD B ;EACH LEVEL IS 10 DEEP 0505 191F 7E MOV A,M ;GET THAT OLD 'LOPVAR' 0506 1920 23 INX H 0507 1921 B6 ORA M 0508 1922 CA 3F 19 JZ FR8 ;0 SAYS NO MORE IN IT 0509 1925 7E MOV A,M 0510 1926 2B DCX H 0511 1927 BA CMP D ;SAME AS THIS ONE? 0512 1928 C2 1E 19 JNZ FR7 0513 192B 7E MOV A,M ;THE OTHER HALF? 0514 192C BB CMP E 0515 192D C2 1E 19 JNZ FR7 0516 1930 EB XCHG ;YES, FOUND ONE 0517 1931 21 00 00 LXI H,0H 0518 1934 39 DAD SP ;TRY TO MOVE SP 0519 1935 44 MOV B,H 0520 1936 4D MOV C,L 0521 1937 21 0A 00 LXI H,0AH 0522 193A 19 DAD D 0523 193B CD 4D 1D CALL MVDOWN ;AND PURGE 10 WORDS 0524 193E F9 SPHL ;IN THE STACK 0525 193F 2A 11 30 FR8: LHLD LOPPT ;JOB DONE, RESTORE DE 0526 1942 EB XCHG 0527 1943 CD F9 16 CALL FINISH ;AND CONTINUE 0528 1946 ; 0529 1946 CD 01 17 NEXT: CALL TSTV ;GET ADDRESS OF VAR. 0530 1949 DA F1 1B JC QWHAT ;NO VARIABLE, "WHAT?" 0531 194C 22 05 30 SHLD VARNXT ;YES, SAVE IT 0532 194F D5 NX0: PUSH D ;SAVE TEXT POINTER 0533 1950 EB XCHG 0534 1951 2A 09 30 LHLD LOPVAR ;GET VAR. IN 'FOR' 0535 1954 7C MOV A,H 0536 1955 B5 ORA L ;0 SAYS NEVER HAD ONE 0537 1956 CA F2 1B JZ AWHAT ;SO WE ASK: "WHAT?" 0538 1959 CD E9 16 CALL COMP ;ELSE WE CHECK THEM 0539 195C CA 69 19 JZ NX3 ;OK, THEY AGREE 0540 195F D1 POP D ;NO, LET'S SEE 0541 1960 CD 5C 1D CALL POPA ;PURGE CURRENT LOOP 0542 1963 2A 05 30 LHLD VARNXT ;AND POP ONE LEVEL 0543 1966 C3 4F 19 JMP NX0 ;GO CHECK AGAIN 0544 1969 5E NX3: MOV E,M ;COME HERE WHEN AGREED 0545 196A 23 INX H 0546 196B 56 MOV D,M ;DE=VALUE OF VAR. 0547 196C 2A 0B 30 LHLD LOPINC 0548 196F E5 PUSH H 0549 1970 7C MOV A,H 0550 1971 AA XRA D 0551 1972 7A MOV A,D 0552 1973 19 DAD D ;ADD ONE STEP 0553 1974 FA 7B 19 JM NX4 0554 1977 AC XRA H 0555 1978 FA 9F 19 JM NX5 0556 197B EB NX4: XCHG 0557 197C 2A 09 30 LHLD LOPVAR ;PUT IT BACK 0558 197F 73 MOV M,E 0559 1980 23 INX H 0560 1981 72 MOV M,D 0561 1982 2A 0D 30 LHLD LOPLMT ;HL->LIMIT 0562 1985 F1 POP PSW ;OLD HL 0563 1986 B7 ORA A 0564 1987 F2 8B 19 JP NX1 ;STEP > 0 0565 198A EB XCHG ;STEP < 0 0566 198B CD B5 1B NX1: CALL CKHLDE ;COMPARE WITH LIMIT 0567 198E D1 POP D ;RESTORE TEXT POINTER 0568 198F DA A1 19 JC NX2 ;OUTSIDE LIMIT 0569 1992 2A 0F 30 LHLD LOPLN ;WITHIN LIMIT, GO 0570 1995 22 01 30 SHLD CURRNT ;BACK TO THE SAVED 0571 1998 2A 11 30 LHLD LOPPT ;'CURRNT' AND TEXT 0572 199B EB XCHG ;POINTER 0573 199C CD F9 16 CALL FINISH 0574 199F E1 NX5: POP H 0575 19A0 D1 POP D 0576 19A1 CD 5C 1D NX2: CALL POPA ;PURGE THIS LOOP 0577 19A4 CD F9 16 CALL FINISH 0578 19A7 ; 0579 19A7 ;************************************************************* 0580 19A7 ; 0581 19A7 ; *** REM *** IF *** INPUT *** & LET (& DEFLT) *** 0582 19A7 ; 0583 19A7 ; 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI. 0584 19A7 ; TBI TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION. 0585 19A7 ; 0586 19A7 ; 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE 0587 19A7 ; COMMANDS (INCLUDING OTHER 'IF'S) SEPERATED BY SEMI-COLONS. 0588 19A7 ; NOTE THAT THE WORD 'THEN' IS NOT USED. TBI EVALUATES THE 0589 19A7 ; EXPR. IF IT IS NON-ZERO, EXECUTION CONTINUES. IF THE 0590 19A7 ; EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND 0591 19A7 ; EXECUTION CONTINUES AT THE NEXT LINE. 0592 19A7 ; 0593 19A7 ; 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED 0594 19A7 ; BY A LIST OF ITEMS. IF THE ITEM IS A STRING IN SINGLE OR 0595 19A7 ; DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS 0596 19A7 ; IN 'PRINT'. IF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS 0597 19A7 ; PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN 0598 19A7 ; EXPR. TO BE TYPED IN. THE VARIABLE IS THEN SET TO THE 0599 19A7 ; VALUE OF THIS EXPR. IF THE VARIABLE IS PROCEDED BY A STRING 0600 19A7 ; (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE 0601 19A7 ; PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR. 0602 19A7 ; AND SET THE VARIABLE TO THE VALUE OF THE EXPR. 0603 19A7 ; 0604 19A7 ; IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?", 0605 19A7 ; "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT. 0606 19A7 ; THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C. 0607 19A7 ; THIS IS HANDLED IN 'INPERR'. 0608 19A7 ; 0609 19A7 ; 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS. 0610 19A7 ; EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR. 0611 19A7 ; TBI EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE. 0612 19A7 ; TBI WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'. 0613 19A7 ; THIS IS DONE BY 'DEFLT'. 0614 19A7 ; 0615 19A7 21 00 00 REM: LXI H,0H ;*** REM *** 0616 19AA 3E .DB 3EH ;THIS IS LIKE 'IF 0' 0617 19AB ; 0618 19AB CD E1 16 IFF: CALL EXPR ;*** IF *** 0619 19AE 7C MOV A,H ;IS THE EXPR.=0? 0620 19AF B5 ORA L 0621 19B0 C2 2A 18 JNZ RUNSML ;NO, CONTINUE 0622 19B3 CD A1 1C CALL FNDSKP ;YES, SKIP REST OF LINE 0623 19B6 D2 23 18 JNC RUNTSL ;AND RUN THE NEXT LINE 0624 19B9 C3 89 17 JMP RSTART ;IF NO NEXT, RE-START 0625 19BC ; 0626 19BC 2A 07 30 INPERR: LHLD STKINP ;*** INPERR *** 0627 19BF F9 SPHL ;RESTORE OLD SP 0628 19C0 E1 POP H ;AND OLD 'CURRNT' 0629 19C1 22 01 30 SHLD CURRNT 0630 19C4 D1 POP D ;AND OLD TEXT POINTER 0631 19C5 D1 POP D ;REDO INPUT 0632 19C6 ; 0633 19C6 INPUT: ;*** INPUT *** 0634 19C6 D5 IP1: PUSH D ;SAVE IN CASE OF ERROR 0635 19C7 CD B9 1C CALL QTSTG ;IS NEXT ITEM A STRING? 0636 19CA C3 D6 19 JMP IP2 ;NO 0637 19CD CD 01 17 CALL TSTV ;YES, BUT FOLLOWED BY A 0638 19D0 DA 14 1A JC IP4 ;VARIABLE? NO. 0639 19D3 C3 E8 19 JMP IP3 ;YES. INPUT VARIABLE 0640 19D6 D5 IP2: PUSH D ;SAVE FOR 'PRTSTG' 0641 19D7 CD 01 17 CALL TSTV ;MUST BE VARIABLE NOW 0642 19DA DA F1 1B JC QWHAT ;"WHAT?" IT IS NOT? 0643 19DD 1A LDAX D ;GET READY FOR 'PRTSTR' 0644 19DE 4F MOV C,A 0645 19DF 97 SUB A 0646 19E0 12 STAX D 0647 19E1 D1 POP D 0648 19E2 CD AB 1C CALL PRTSTG ;PRINT STRING AS PROMPT 0649 19E5 79 MOV A,C ;RESTORE TEXT 0650 19E6 1B DCX D 0651 19E7 12 STAX D 0652 19E8 D5 IP3: PUSH D ;SAVE TEXT POINTER 0653 19E9 EB XCHG 0654 19EA 2A 01 30 LHLD CURRNT ;ALSO SAVE 'CURRNT' 0655 19ED E5 PUSH H 0656 19EE 21 C6 19 LXI H,IP1 ;A NEGATIVE NUMBER 0657 19F1 22 01 30 SHLD CURRNT ;AS A FLAG 0658 19F4 21 00 00 LXI H,0H ;SAVE SP TOO 0659 19F7 39 DAD SP 0660 19F8 22 07 30 SHLD STKINP 0661 19FB D5 PUSH D ;OLD HL 0662 19FC 3E 3A MVI A,3AH ;PRINT THIS TOO 0663 19FE CD 27 1C CALL GETLN ;AND GET A LINE 0664 1A01 11 37 7F LXI D,BUFFER ;POINTS TO BUFFER 0665 1A04 CD E1 16 CALL EXPR ;EVALUATE INPUT 0666 1A07 00 NOP ;CAN BE 'CALL ENDCHK' 0667 1A08 00 NOP 0668 1A09 00 NOP 0669 1A0A D1 POP D ;OK, GET OLD HL 0670 1A0B EB XCHG 0671 1A0C 73 MOV M,E ;SAVE VALUE IN VAR. 0672 1A0D 23 INX H 0673 1A0E 72 MOV M,D 0674 1A0F E1 POP H ;GET OLD 'CURRNT' 0675 1A10 22 01 30 SHLD CURRNT 0676 1A13 D1 POP D ;AND OLD TEXT POINTER 0677 1A14 F1 IP4: POP PSW ;PURGE JUNK IN STACK 0678 1A15 CD CF 16 CALL TSTC ;IS NEXT CH. ','? 0679 1A18 2C .DB ',' 0680 1A19 03 .DB IP5-$-1 0681 1A1A C3 C6 19 JMP IP1 ;YES, MORE ITEMS. 0682 1A1D CD F9 16 IP5: CALL FINISH 0683 1A20 ; 0684 1A20 1A DEFLT: LDAX D ;*** DEFLT *** 0685 1A21 FE 0D CPI CR ;EMPTY LINE IS OK 0686 1A23 CA 31 1A JZ LT1 ;ELSE IT IS 'LET' 0687 1A26 ; 0688 1A26 CD BF 1B LET: CALL SETVAL ;*** LET *** 0689 1A29 CD CF 16 CALL TSTC ;SET VALUE TO VAR. 0690 1A2C 2C .DB ',' 0691 1A2D 03 .DB LT1-$-1 0692 1A2E C3 26 1A JMP LET ;ITEM BY ITEM 0693 1A31 CD F9 16 LT1: CALL FINISH ;UNTIL FINISH 0694 1A34 ; 0695 1A34 ;************************************************************* 0696 1A34 ; 0697 1A34 ; *** EXPR *** 0698 1A34 ; 0699 1A34 ; 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS. 0700 1A34 ; :: 0701 1A34 ; 0702 1A34 ; WHERE IS ONE OF THE OPERATORS IN TAB8 AND THE 0703 1A34 ; RESULT OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE. 0704 1A34 ; ::=(+ OR -)(+ OR -)(....) 0705 1A34 ; WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS. 0706 1A34 ; ::=(* OR />)(....) 0707 1A34 ; ::= 0708 1A34 ; 0709 1A34 ; () 0710 1A34 ; IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN 0711 1A34 ; AS INDEX, FUNCTIONS CAN HAVE AN AS ARGUMENTS, AND 0712 1A34 ; CAN BE AN IN PARANTHESE. 0713 1A34 ; 0714 1A34 ;EXPR: CALL EXPR2 ;THIS IS AT LOC. 18 0715 1A34 ; PUSH H ;SAVE VALUE 0716 1A34 21 78 1E EXPR1: LXI H,TAB8-1 ;LOOKUP REL.OP. 0717 1A37 C3 92 1E JMP EXEC ;GO DO IT 0718 1A3A CD 63 1A XP11: CALL XP18 ;REL.OP.">=" 0719 1A3D D8 RC ;NO, RETURN HL=0 0720 1A3E 6F MOV L,A ;YES, RETURN HL=1 0721 1A3F C9 RET 0722 1A40 CD 63 1A XP12: CALL XP18 ;REL.OP."#" 0723 1A43 C8 RZ ;FALSE, RETURN HL=0 0724 1A44 6F MOV L,A ;TRUE, RETURN HL=1 0725 1A45 C9 RET 0726 1A46 CD 63 1A XP13: CALL XP18 ;REL.OP.">" 0727 1A49 C8 RZ ;FALSE 0728 1A4A D8 RC ;ALSO FALSE, HL=0 0729 1A4B 6F MOV L,A ;TRUE, HL=1 0730 1A4C C9 RET 0731 1A4D CD 63 1A XP14: CALL XP18 ;REL.OP."<=" 0732 1A50 6F MOV L,A ;SET HL=1 0733 1A51 C8 RZ ;REL. TRUE, RETURN 0734 1A52 D8 RC 0735 1A53 6C MOV L,H ;ELSE SET HL=0 0736 1A54 C9 RET 0737 1A55 CD 63 1A XP15: CALL XP18 ;REL.OP."=" 0738 1A58 C0 RNZ ;FALSE, RETURN HL=0 0739 1A59 6F MOV L,A ;ELSE SET HL=1 0740 1A5A C9 RET 0741 1A5B CD 63 1A XP16: CALL XP18 ;REL.OP."<" 0742 1A5E D0 RNC ;FALSE, RETURN HL=0 0743 1A5F 6F MOV L,A ;ELSE SET HL=1 0744 1A60 C9 RET 0745 1A61 E1 XP17: POP H ;NOT .REL.OP 0746 1A62 C9 RET ;RETURN HL= 0747 1A63 79 XP18: MOV A,C ;SUBROUTINE FOR ALL 0748 1A64 E1 POP H ;REL.OP.'S 0749 1A65 C1 POP B 0750 1A66 E5 PUSH H ;REVERSE TOP OF STACK 0751 1A67 C5 PUSH B 0752 1A68 4F MOV C,A 0753 1A69 CD 78 1A CALL EXPR2 ;GET 2ND 0754 1A6C EB XCHG ;VALUE IN DE NOW 0755 1A6D E3 XTHL ;1ST IN HL 0756 1A6E CD B5 1B CALL CKHLDE ;COMPARE 1ST WITH 2ND 0757 1A71 D1 POP D ;RESTORE TEXT POINTER 0758 1A72 21 00 00 LXI H,0H ;SET HL=0, A=1 0759 1A75 3E 01 MVI A,1 0760 1A77 C9 RET 0761 1A78 ; 0762 1A78 CD CF 16 EXPR2: CALL TSTC ;NEGATIVE SIGN? 0763 1A7B 2D .DB '-' 0764 1A7C 06 .DB XP21-$-1 0765 1A7D 21 00 00 LXI H,0H ;YES, FAKE '0-' 0766 1A80 C3 AA 1A JMP XP26 ;TREAT LIKE SUBTRACT 0767 1A83 CD CF 16 XP21: CALL TSTC ;POSITIVE SIGN? IGNORE 0768 1A86 2B .DB '+' 0769 1A87 00 .DB XP22-$-1 0770 1A88 CD B4 1A XP22: CALL EXPR3 ;1ST 0771 1A8B CD CF 16 XP23: CALL TSTC ;ADD? 0772 1A8E 2B .DB '+' 0773 1A8F 15 .DB XP25-$-1 0774 1A90 E5 PUSH H ;YES, SAVE VALUE 0775 1A91 CD B4 1A CALL EXPR3 ;GET 2ND 0776 1A94 EB XP24: XCHG ;2ND IN DE 0777 1A95 E3 XTHL ;1ST IN HL 0778 1A96 7C MOV A,H ;COMPARE SIGN 0779 1A97 AA XRA D 0780 1A98 7A MOV A,D 0781 1A99 19 DAD D 0782 1A9A D1 POP D ;RESTORE TEXT POINTER 0783 1A9B FA 8B 1A JM XP23 ;1ST AND 2ND SIGN DIFFER 0784 1A9E AC XRA H ;1ST AND 2ND SIGN EQUAL 0785 1A9F F2 8B 1A JP XP23 ;SO IS RESULT 0786 1AA2 C3 6E 17 JMP QHOW ;ELSE WE HAVE OVERFLOW 0787 1AA5 CD CF 16 XP25: CALL TSTC ;SUBTRACT? 0788 1AA8 2D .DB '-' 0789 1AA9 92 .DB XP42-$-1 0790 1AAA E5 XP26: PUSH H ;YES, SAVE 1ST 0791 1AAB CD B4 1A CALL EXPR3 ;GET 2ND 0792 1AAE CD A3 1B CALL CHGSGN ;NEGATE 0793 1AB1 C3 94 1A JMP XP24 ;AND ADD THEM 0794 1AB4 ; 0795 1AB4 CD 18 1B EXPR3: CALL EXPR4 ;GET 1ST 0796 1AB7 CD CF 16 XP31: CALL TSTC ;MULTIPLY? 0797 1ABA 2A .DB '*' 0798 1ABB 2D .DB XP34-$-1 0799 1ABC E5 PUSH H ;YES, SAVE 1ST 0800 1ABD CD 18 1B CALL EXPR4 ;AND GET 2ND 0801 1AC0 06 00 MVI B,0H ;CLEAR B FOR SIGN 0802 1AC2 CD A0 1B CALL CHKSGN ;CHECK SIGN 0803 1AC5 E3 XTHL ;1ST IN HL 0804 1AC6 CD A0 1B CALL CHKSGN ;CHECK SIGN OF 1ST 0805 1AC9 EB XCHG 0806 1ACA E3 XTHL 0807 1ACB 7C MOV A,H ;IS HL > 255 ? 0808 1ACC B7 ORA A 0809 1ACD CA D6 1A JZ XP32 ;NO 0810 1AD0 7A MOV A,D ;YES, HOW ABOUT DE 0811 1AD1 B2 ORA D 0812 1AD2 EB XCHG ;PUT SMALLER IN HL 0813 1AD3 C2 6F 17 JNZ AHOW ;ALSO >, WILL OVERFLOW 0814 1AD6 7D XP32: MOV A,L ;THIS IS DUMB 0815 1AD7 21 00 00 LXI H,0H ;CLEAR RESULT 0816 1ADA B7 ORA A ;ADD AND COUNT 0817 1ADB CA 0A 1B JZ XP35 0818 1ADE 19 XP33: DAD D 0819 1ADF DA 6F 17 JC AHOW ;OVERFLOW 0820 1AE2 3D DCR A 0821 1AE3 C2 DE 1A JNZ XP33 0822 1AE6 C3 0A 1B JMP XP35 ;FINISHED 0823 1AE9 CD CF 16 XP34: CALL TSTC ;DIVIDE? 0824 1AEC 2F .DB '/' 0825 1AED 4E .DB XP42-$-1 0826 1AEE E5 PUSH H ;YES, SAVE 1ST 0827 1AEF CD 18 1B CALL EXPR4 ;AND GET THE SECOND ONE 0828 1AF2 06 00 MVI B,0H ;CLEAR B FOR SIGN 0829 1AF4 CD A0 1B CALL CHKSGN ;CHECK SIGN OF 2ND 0830 1AF7 E3 XTHL ;GET 1ST IN HL 0831 1AF8 CD A0 1B CALL CHKSGN ;CHECK SIGN OF 1ST 0832 1AFB EB XCHG 0833 1AFC E3 XTHL 0834 1AFD EB XCHG 0835 1AFE 7A MOV A,D ;DIVIDE BY 0? 0836 1AFF B3 ORA E 0837 1B00 CA 6F 17 JZ AHOW ;SAY "HOW?" 0838 1B03 C5 PUSH B ;ELSE SAVE SIGN 0839 1B04 CD 83 1B CALL DIVIDE ;USE SUBROUTINE 0840 1B07 60 MOV H,B ;RESULT IN HL NOW 0841 1B08 69 MOV L,C 0842 1B09 C1 POP B ;GET SIGN BACK 0843 1B0A D1 XP35: POP D ;AND TEXT POINTER 0844 1B0B 7C MOV A,H ;HL MUST BE + 0845 1B0C B7 ORA A 0846 1B0D FA 6E 17 JM QHOW ;ELSE IT IS OVERFLOW 0847 1B10 78 MOV A,B 0848 1B11 B7 ORA A 0849 1B12 FC A3 1B CM CHGSGN ;CHANGE SIGN IF NEEDED 0850 1B15 C3 B7 1A JMP XP31 ;LOOK FOR MORE TERMS 0851 1B18 ; 0852 1B18 21 58 1E EXPR4: LXI H,TAB4-1 ;FIND FUNCTION IN TAB4 0853 1B1B C3 92 1E JMP EXEC ;AND GO DO IT 0854 1B1E CD 01 17 XP40: CALL TSTV ;NO, NOT A FUNCTION 0855 1B21 DA 29 1B JC XP41 ;NOR A VARIABLE 0856 1B24 7E MOV A,M ;VARIABLE 0857 1B25 23 INX H 0858 1B26 66 MOV H,M ;VALUE IN HL 0859 1B27 6F MOV L,A 0860 1B28 C9 RET 0861 1B29 CD 44 17 XP41: CALL TSTNUM ;OR IS IT A NUMBER 0862 1B2C 78 MOV A,B ;# OF DIGIT 0863 1B2D B7 ORA A 0864 1B2E C0 RNZ ;OK 0865 1B2F CD CF 16 PARN: CALL TSTC 0866 1B32 28 .DB '(' 0867 1B33 09 .DB XP43-$-1 0868 1B34 CD E1 16 CALL EXPR ;"(EXPR)" 0869 1B37 CD CF 16 CALL TSTC 0870 1B3A 29 .DB ')' 0871 1B3B 01 .DB XP43-$-1 0872 1B3C C9 XP42: RET 0873 1B3D C3 F1 1B XP43: JMP QWHAT ;ELSE SAY: "WHAT?" 0874 1B40 ; 0875 1B40 CD 2F 1B RND: CALL PARN ;*** RND(EXPR) *** 0876 1B43 7C MOV A,H ;EXPR MUST BE + 0877 1B44 B7 ORA A 0878 1B45 FA 6E 17 JM QHOW 0879 1B48 B5 ORA L ;AND NON-ZERO 0880 1B49 CA 6E 17 JZ QHOW 0881 1B4C D5 PUSH D ;SAVE BOTH 0882 1B4D E5 PUSH H 0883 1B4E 2A 13 30 LHLD RANPNT ;GET MEMORY AS RANDOM 0884 1B51 11 C2 1E LXI D,LSTROM ;NUMBER 0885 1B54 CD E9 16 CALL COMP 0886 1B57 DA 5D 1B JC RA1 ;WRAP AROUND IF LAST 0887 1B5A 21 C7 16 LXI H,START 0888 1B5D 5E RA1: MOV E,M 0889 1B5E 23 INX H 0890 1B5F 56 MOV D,M 0891 1B60 22 13 30 SHLD RANPNT 0892 1B63 E1 POP H 0893 1B64 EB XCHG 0894 1B65 C5 PUSH B 0895 1B66 CD 83 1B CALL DIVIDE ;RND(N)=MOD(M,N)+1 0896 1B69 C1 POP B 0897 1B6A D1 POP D 0898 1B6B 23 INX H 0899 1B6C C9 RET 0900 1B6D ; 0901 1B6D CD 2F 1B ABS: CALL PARN ;*** ABS(EXPR) *** 0902 1B70 1B DCX D 0903 1B71 CD A0 1B CALL CHKSGN ;CHECK SIGN 0904 1B74 13 INX D 0905 1B75 C9 RET 0906 1B76 ; 0907 1B76 2A 15 30 SIZE: LHLD TXTUNF ;*** SIZE *** 0908 1B79 D5 PUSH D ;GET THE NUMBER OF FREE 0909 1B7A EB XCHG ;BYTES BETWEEN 'TXTUNF' 0910 1B7B 21 00 7F LXI H,VARBGN ;AND 'VARBGN' 0911 1B7E CD 99 1B CALL SUBDE 0912 1B81 D1 POP D 0913 1B82 C9 RET 0914 1B83 ; 0915 1B83 ;************************************************************* 0916 1B83 ; 0917 1B83 ; *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE *** 0918 1B83 ; 0919 1B83 ; 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL 0920 1B83 ; 0921 1B83 ; 'SUBDE' SUBSTRACTS DE FROM HL 0922 1B83 ; 0923 1B83 ; 'CHKSGN' CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE 0924 1B83 ; SIGN AND FLIP SIGN OF B. 0925 1B83 ; 0926 1B83 ; 'CHGSGN' CHECKS SIGN N OF HL AND B UNCONDITIONALLY. 0927 1B83 ; 0928 1B83 ; 'CKHLDE' CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE 0929 1B83 ; ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER 0930 1B83 ; CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS. 0931 1B83 ; 0932 1B83 E5 DIVIDE: PUSH H ;*** DIVIDE *** 0933 1B84 6C MOV L,H ;DIVIDE H BY DE 0934 1B85 26 00 MVI H,0 0935 1B87 CD 8E 1B CALL DV1 0936 1B8A 41 MOV B,C ;SAVE RESULT IN B 0937 1B8B 7D MOV A,L ;(REMINDER+L)/DE 0938 1B8C E1 POP H 0939 1B8D 67 MOV H,A 0940 1B8E 0E FF DV1: MVI C,0FFH ;RESULT IN C 0941 1B90 0C DV2: INR C ;DUMB ROUTINE 0942 1B91 CD 99 1B CALL SUBDE ;DIVIDE BY SUBTRACT 0943 1B94 D2 90 1B JNC DV2 ;AND COUNT 0944 1B97 19 DAD D 0945 1B98 C9 RET 0946 1B99 ; 0947 1B99 7D SUBDE: MOV A,L ;*** SUBDE *** 0948 1B9A 93 SUB E ;SUBSTRACT DE FROM 0949 1B9B 6F MOV L,A ;HL 0950 1B9C 7C MOV A,H 0951 1B9D 9A SBB D 0952 1B9E 67 MOV H,A 0953 1B9F C9 RET 0954 1BA0 ; 0955 1BA0 7C CHKSGN: MOV A,H ;*** CHKSGN *** 0956 1BA1 B7 ORA A ;CHECK SIGN OF HL 0957 1BA2 F0 RP ;IF -, CHANGE SIGN 0958 1BA3 ; 0959 1BA3 7C CHGSGN: MOV A,H ;*** CHGSGN *** 0960 1BA4 F5 PUSH PSW 0961 1BA5 2F CMA ;CHANGE SIGN OF HL 0962 1BA6 67 MOV H,A 0963 1BA7 7D MOV A,L 0964 1BA8 2F CMA 0965 1BA9 6F MOV L,A 0966 1BAA 23 INX H 0967 1BAB F1 POP PSW 0968 1BAC AC XRA H 0969 1BAD F2 6E 17 JP QHOW 0970 1BB0 78 MOV A,B ;AND ALSO FLIP B 0971 1BB1 EE 80 XRI 80H 0972 1BB3 47 MOV B,A 0973 1BB4 C9 RET 0974 1BB5 ; 0975 1BB5 7C CKHLDE: MOV A,H 0976 1BB6 AA XRA D ;SAME SIGN? 0977 1BB7 F2 BB 1B JP CK1 ;YES, COMPARE 0978 1BBA EB XCHG ;NO, XCH AND COMP 0979 1BBB CD E9 16 CK1: CALL COMP 0980 1BBE C9 RET 0981 1BBF ; 0982 1BBF ;************************************************************* 0983 1BBF ; 0984 1BBF ; *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) *** 0985 1BBF ; 0986 1BBF ; "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND 0987 1BBF ; THEN AN EXPR. IT EVALUATES THE EXPR. AND SET THE VARIABLE 0988 1BBF ; TO THAT VALUE. 0989 1BBF ; 0990 1BBF ; "FIN" CHECKS THE END OF A COMMAND. IF IT ENDED WITH ";", 0991 1BBF ; EXECUTION CONTINUES. IF IT ENDED WITH A CR, IT FINDS THE 0992 1BBF ; NEXT LINE AND CONTINUE FROM THERE. 0993 1BBF ; 0994 1BBF ; "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS 0995 1BBF ; REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.) 0996 1BBF ; 0997 1BBF ; "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR). 0998 1BBF ; IT THEN PRINTS THE LINE POINTED BY 'CURRNT' WITH A "?" 0999 1BBF ; INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP 1000 1BBF ; OF THE STACK) POINTS TO. EXECUTION OF TB IS STOPPED 1001 1BBF ; AND TBI IS RESTARTED. HOWEVER, IF 'CURRNT' -> ZERO 1002 1BBF ; (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT 1003 1BBF ; PRINTED. AND IF 'CURRNT' -> NEGATIVE # (INDICATING 'INPUT' 1004 1BBF ; COMMAND), THE INPUT LINE IS NOT PRINTED AND EXECUTION IS 1005 1BBF ; NOT TERMINATED BUT CONTINUED AT 'INPERR'. 1006 1BBF ; 1007 1BBF ; RELATED TO 'ERROR' ARE THE FOLLOWING: 1008 1BBF ; 'QWHAT' SAVES TEXT POINTER IN STACK AND GET MESSAGE "WHAT?" 1009 1BBF ; 'AWHAT' JUST GET MESSAGE "WHAT?" AND JUMP TO 'ERROR'. 1010 1BBF ; 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING. 1011 1BBF ; 'AHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS. 1012 1BBF ; 1013 1BBF CD 01 17 SETVAL: CALL TSTV ;*** SETVAL *** 1014 1BC2 DA F1 1B JC QWHAT ;"WHAT?" NO VARIABLE 1015 1BC5 E5 PUSH H ;SAVE ADDRESS OF VAR. 1016 1BC6 CD CF 16 CALL TSTC ;PASS "=" SIGN 1017 1BC9 3D .DB '=' 1018 1BCA 0A .DB SV1-$-1 1019 1BCB CD E1 16 CALL EXPR ;EVALUATE EXPR. 1020 1BCE 44 MOV B,H ;VALUE IS IN BC NOW 1021 1BCF 4D MOV C,L 1022 1BD0 E1 POP H ;GET ADDRESS 1023 1BD1 71 MOV M,C ;SAVE VALUE 1024 1BD2 23 INX H 1025 1BD3 70 MOV M,B 1026 1BD4 C9 RET 1027 1BD5 C3 F1 1B SV1: JMP QWHAT ;NO "=" SIGN 1028 1BD8 ; 1029 1BD8 CD CF 16 FIN: CALL TSTC ;*** FIN *** 1030 1BDB 3B .DB 3BH 1031 1BDC 04 .DB FI1-$-1 1032 1BDD F1 POP PSW ;";", PURGE RET. ADDR. 1033 1BDE C3 2A 18 JMP RUNSML ;CONTINUE SAME LINE 1034 1BE1 CD CF 16 FI1: CALL TSTC ;NOT ";", IS IT CR? 1035 1BE4 0D .DB CR 1036 1BE5 04 .DB FI2-$-1 1037 1BE6 F1 POP PSW ;YES, PURGE RET. ADDR. 1038 1BE7 C3 1A 18 JMP RUNNXL ;RUN NEXT LINE 1039 1BEA C9 FI2: RET ;ELSE RETURN TO CALLER 1040 1BEB ; 1041 1BEB CD F1 16 ENDCHK: CALL IGNBLK ;*** ENDCHK *** 1042 1BEE FE 0D CPI CR ;END WITH CR? 1043 1BF0 C8 RZ ;OK, ELSE SAY: "WHAT?" 1044 1BF1 ; 1045 1BF1 D5 QWHAT: PUSH D ;*** QWHAT *** 1046 1BF2 11 7D 17 AWHAT: LXI D,WHAT ;*** AWHAT *** 1047 1BF5 97 ERROR: SUB A ;*** ERROR *** 1048 1BF6 CD AB 1C CALL PRTSTG ;PRINT 'WHAT?', 'HOW?' 1049 1BF9 D1 POP D ;OR 'SORRY' 1050 1BFA 1A LDAX D ;SAVE THE CHARACTER 1051 1BFB F5 PUSH PSW ;AT WHERE OLD DE -> 1052 1BFC 97 SUB A ;AND PUT A 0 THERE 1053 1BFD 12 STAX D 1054 1BFE 2A 01 30 LHLD CURRNT ;GET CURRENT LINE # 1055 1C01 E5 PUSH H 1056 1C02 7E MOV A,M ;CHECK THE VALUE 1057 1C03 23 INX H 1058 1C04 B6 ORA M 1059 1C05 D1 POP D 1060 1C06 CA 89 17 JZ RSTART ;IF ZERO, JUST RESTART 1061 1C09 7E MOV A,M ;IF NEGATIVE, 1062 1C0A B7 ORA A 1063 1C0B FA BC 19 JM INPERR ;REDO INPUT 1064 1C0E CD 2D 1D CALL PRTLN ;ELSE PRINT THE LINE 1065 1C11 1B DCX D ;UPTO WHERE THE 0 IS 1066 1C12 F1 POP PSW ;RESTORE THE CHARACTER 1067 1C13 12 STAX D 1068 1C14 3E 3F MVI A,3FH ;PRINT A "?" 1069 1C16 CD D9 16 CALL OUTC 1070 1C19 97 SUB A ;AND THE REST OF THE 1071 1C1A CD AB 1C CALL PRTSTG ;LINE 1072 1C1D C3 89 17 JMP RSTART ;THEN RESTART 1073 1C20 ; 1074 1C20 D5 QSORRY: PUSH D ;*** QSORRY *** 1075 1C21 11 83 17 ASORRY: LXI D,SORRY ;*** ASORRY *** 1076 1C24 C3 F5 1B JMP ERROR 1077 1C27 ; 1078 1C27 ;************************************************************* 1079 1C27 ; 1080 1C27 ; *** GETLN *** FNDLN (& FRIENDS) *** 1081 1C27 ; 1082 1C27 ; 'GETLN' READS A INPUT LINE INTO 'BUFFER'. IT FIRST PROMPT 1083 1C27 ; THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS 1084 1C27 ; THE BUFFER AND ECHOS. IT IGNORES LF'S AND NULLS, BUT STILL 1085 1C27 ; ECHOS THEM BACK. RUB-OUT IS USED TO CAUSE IT TO DELETE 1086 1C27 ; THE LAST CHARACTER (IF THERE IS ONE), AND ALT-MOD IS USED TO 1087 1C27 ; CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER. 1088 1C27 ; CR SIGNALS THE END OF A LINE, AND CAUSE 'GETLN' TO RETURN. 1089 1C27 ; 1090 1C27 ; 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE 1091 1C27 ; TEXT SAVE AREA. DE IS USED AS THE TEXT POINTER. IF THE 1092 1C27 ; LINE IS FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE 1093 1C27 ; (I.E., THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z. 1094 1C27 ; IF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE # 1095 1C27 ; IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ. IF 1096 1C27 ; WE REACHED THE END OF TEXT SAVE AREA AND CANNOT FIND THE 1097 1C27 ; LINE, FLAGS ARE C & NZ. 1098 1C27 ; 'FNDLN' WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE 1099 1C27 ; AREA TO START THE SEARCH. SOME OTHER ENTRIES OF THIS 1100 1C27 ; ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH. 1101 1C27 ; 'FNDLNP' WILL START WITH DE AND SEARCH FOR THE LINE #. 1102 1C27 ; 'FNDNXT' WILL BUMP DE BY 2, FIND A CR AND THEN START SEARCH. 1103 1C27 ; 'FNDSKP' USE DE TO FIND A CR, AND THEN START SEARCH. 1104 1C27 ; 1105 1C27 CD D9 16 GETLN: CALL OUTC ;*** GETLN *** 1106 1C2A 11 37 7F LXI D,BUFFER ;PROMPT AND INIT. 1107 1C2D D3 05 out 5 ;clear shift register 1108 1C2F CD D5 1D GL1: CALL CHKIO ;CHECK KEYBOARD 1109 1C32 CA 2F 1C JZ GL1 ;NO INPUT, WAIT 1110 1C35 FE 7F CPI 7FH ;DELETE LAST CHARACTER? 1111 1C37 CA 5B 1C JZ GL3 ;YES 1112 1C3A ;This compare added for backspace key code 08h 1113 1C3A FE 08 CPI 08H ;Backspace 1114 1C3C CA 5B 1C JZ GL3 ;Code that deletes char from buffer and screen 1115 1C3F ;Back to original code 1116 1C3F CD D9 16 CALL OUTC ;INPUT, ECHO BACK 1117 1C42 FE 0A CPI 0AH ;IGNORE LF 1118 1C44 CA 2F 1C JZ GL1 1119 1C47 B7 ORA A ;IGNORE NULL 1120 1C48 CA 2F 1C JZ GL1 1121 1C4B FE 7D CPI 7DH ;DELETE THE WHOLE LINE? 1122 1C4D CA 79 1C JZ GL4 ;YES 1123 1C50 12 STAX D ;ELSE SAVE INPUT 1124 1C51 13 INX D ;AND BUMP POINTER 1125 1C52 FE 0D CPI 0DH ;WAS IT CR? 1126 1C54 C8 RZ ;YES, END OF LINE 1127 1C55 7B MOV A,E ;ELSE MORE FREE ROOM? 1128 1C56 FE 77 CPI (BUFEND & 0FFH) 1129 1C58 C2 2F 1C JNZ GL1 ;YES, GET NEXT INPUT 1130 1C5B 7B GL3: MOV A,E ;DELETE LAST CHARACTER 1131 1C5C FE 37 CPI (BUFFER & 0FFH) ;BUT DO WE HAVE ANY? 1132 1C5E CA 79 1C JZ GL4 ;NO, REDO WHOLE LINE 1133 1C61 1B DCX D ;YES, BACKUP POINTER 1134 1C62 ;The following alters the line as diplayed on the screen. 1135 1C62 ;Original TinyBASIC just put a backslash after the deleted character 1136 1C62 ;We improve a bit by using the ANSI sequence for backspace-and-erase (rubout) 1137 1C62 ; MVI A,5CH ;AND ECHO A BACK-SLASH (this is original) 1138 1C62 ;Here is the new: 1139 1C62 3E 08 MVI A,08H ;Backspace character 1140 1C64 CD D9 16 CALL OUTC ;Put char routine 1141 1C67 3E 1B MVI A,1BH ;Escape character 1142 1C69 CD D9 16 CALL OUTC 1143 1C6C 3E 5B MVI A,5BH ;Left bracket "[" 1144 1C6E CD D9 16 CALL OUTC 1145 1C71 3E 4B MVI A,4BH ;Upper case "K" 1146 1C73 CD D9 16 CALL OUTC 1147 1C76 ;Now back to original code 1148 1C76 C3 2F 1C JMP GL1 ;GO GET NEXT INPUT 1149 1C79 CD D7 16 GL4: CALL CRLF ;REDO ENTIRE LINE 1150 1C7C 3E 5E MVI A,05EH ;CR, LF AND UP-ARROW 1151 1C7E C3 27 1C JMP GETLN 1152 1C81 ; 1153 1C81 7C FNDLN: MOV A,H ;*** FNDLN *** 1154 1C82 B7 ORA A ;CHECK SIGN OF HL 1155 1C83 FA 6E 17 JM QHOW ;IT CANNOT BE - 1156 1C86 11 17 30 LXI D,TXTBGN ;INIT TEXT POINTER 1157 1C89 ; 1158 1C89 FNDLP: ;*** FDLNP *** 1159 1C89 E5 FL1: PUSH H ;SAVE LINE # 1160 1C8A 2A 15 30 LHLD TXTUNF ;CHECK IF WE PASSED END 1161 1C8D 2B DCX H 1162 1C8E CD E9 16 CALL COMP 1163 1C91 E1 POP H ;GET LINE # BACK 1164 1C92 D8 RC ;C,NZ PASSED END 1165 1C93 1A LDAX D ;WE DID NOT, GET BYTE 1 1166 1C94 95 SUB L ;IS THIS THE LINE? 1167 1C95 47 MOV B,A ;COMPARE LOW ORDER 1168 1C96 13 INX D 1169 1C97 1A LDAX D ;GET BYTE 2 1170 1C98 9C SBB H ;COMPARE HIGH ORDER 1171 1C99 DA A0 1C JC FL2 ;NO, NOT THERE YET 1172 1C9C 1B DCX D ;ELSE WE EITHER FOUND 1173 1C9D B0 ORA B ;IT, OR IT IS NOT THERE 1174 1C9E C9 RET ;NC,Z:FOUND, NC,NZ:NO 1175 1C9F ; 1176 1C9F FNDNXT: ;*** FNDNXT *** 1177 1C9F 13 INX D ;FIND NEXT LINE 1178 1CA0 13 FL2: INX D ;JUST PASSED BYTE 1 & 2 1179 1CA1 ; 1180 1CA1 1A FNDSKP: LDAX D ;*** FNDSKP *** 1181 1CA2 FE 0D CPI CR ;TRY TO FIND CR 1182 1CA4 C2 A0 1C JNZ FL2 ;KEEP LOOKING 1183 1CA7 13 INX D ;FOUND CR, SKIP OVER 1184 1CA8 C3 89 1C JMP FL1 ;CHECK IF END OF TEXT 1185 1CAB ; 1186 1CAB ;************************************************************* 1187 1CAB ; 1188 1CAB ; *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN *** 1189 1CAB ; 1190 1CAB ; 'PRTSTG' PRINTS A STRING POINTED BY DE. IT STOPS PRINTING 1191 1CAB ; AND RETURNS TO CALLER WHEN EITHER A CR IS PRINTED OR WHEN 1192 1CAB ; THE NEXT BYTE IS THE SAME AS WHAT WAS IN A (GIVEN BY THE 1193 1CAB ; CALLER). OLD A IS STORED IN B, OLD B IS LOST. 1194 1CAB ; 1195 1CAB ; 'QTSTG' LOOKS FOR A BACK-ARROW, SINGLE QUOTE, OR DOUBLE 1196 1CAB ; QUOTE. IF NONE OF THESE, RETURN TO CALLER. IF BACK-ARROW, 1197 1CAB ; OUTPUT A CR WITHOUT A LF. IF SINGLE OR DOUBLE QUOTE, PRINT 1198 1CAB ; THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE. 1199 1CAB ; AFTER THE PRINTING THE NEXT 3 BYTES OF THE CALLER IS SKIPPED 1200 1CAB ; OVER (USUALLY A JUMP INSTRUCTION. 1201 1CAB ; 1202 1CAB ; 'PRTNUM' PRINTS THE NUMBER IN HL. LEADING BLANKS ARE ADDED 1203 1CAB ; IF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C. 1204 1CAB ; HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN 1205 1CAB ; C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO 1206 1CAB ; PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT. 1207 1CAB ; 1208 1CAB ; 'PRTLN' PRINTS A SAVED TEXT LINE WITH LINE # AND ALL. 1209 1CAB ; 1210 1CAB 47 PRTSTG: MOV B,A ;*** PRTSTG *** 1211 1CAC 1A PS1: LDAX D ;GET A CHARACTER 1212 1CAD 13 INX D ;BUMP POINTER 1213 1CAE B8 CMP B ;SAME AS OLD A? 1214 1CAF C8 RZ ;YES, RETURN 1215 1CB0 CD D9 16 CALL OUTC ;ELSE PRINT IT 1216 1CB3 FE 0D CPI CR ;WAS IT A CR? 1217 1CB5 C2 AC 1C JNZ PS1 ;NO, NEXT 1218 1CB8 C9 RET ;YES, RETURN 1219 1CB9 ; 1220 1CB9 CD CF 16 QTSTG: CALL TSTC ;*** QTSTG *** 1221 1CBC 22 .DB '"' 1222 1CBD 0F .DB QT3-$-1 1223 1CBE 3E 22 MVI A,22H ;IT IS A " 1224 1CC0 CD AB 1C QT1: CALL PRTSTG ;PRINT UNTIL ANOTHER 1225 1CC3 FE 0D CPI CR ;WAS LAST ONE A CR? 1226 1CC5 E1 POP H ;RETURN ADDRESS 1227 1CC6 CA 1A 18 JZ RUNNXL ;WAS CR, RUN NEXT LINE 1228 1CC9 23 QT2: INX H ;SKIP 3 BYTES ON RETURN 1229 1CCA 23 INX H 1230 1CCB 23 INX H 1231 1CCC E9 PCHL ;RETURN 1232 1CCD CD CF 16 QT3: CALL TSTC ;IS IT A '? 1233 1CD0 27 .DB 27H 1234 1CD1 05 .DB QT4-$-1 1235 1CD2 3E 27 MVI A,27H ;YES, DO THE SAME 1236 1CD4 C3 C0 1C JMP QT1 ;AS IN " 1237 1CD7 CD CF 16 QT4: CALL TSTC ;IS IT BACK-ARROW? 1238 1CDA 5F .DB 5FH 1239 1CDB 0C .DB QT5-$-1 1240 1CDC 3E 8D MVI A,08DH ;YES, CR WITHOUT LF 1241 1CDE CD D9 16 CALL OUTC ;DO IT TWICE TO GIVE 1242 1CE1 CD D9 16 CALL OUTC ;TTY ENOUGH TIME 1243 1CE4 E1 POP H ;RETURN ADDRESS 1244 1CE5 C3 C9 1C JMP QT2 1245 1CE8 C9 QT5: RET ;NONE OF ABOVE 1246 1CE9 ; 1247 1CE9 06 00 PRTNUM: MVI B,0 ;*** PRTNUM *** 1248 1CEB CD A0 1B CALL CHKSGN ;CHECK SIGN 1249 1CEE F2 F4 1C JP PN1 ;NO SIGN 1250 1CF1 06 2D MVI B,'-' ;B=SIGN 1251 1CF3 0D DCR C ;'-' TAKES SPACE 1252 1CF4 D5 PN1: PUSH D ;SAVE 1253 1CF5 11 0A 00 LXI D,0AH ;DECIMAL 1254 1CF8 D5 PUSH D ;SAVE AS A FLAG 1255 1CF9 0D DCR C ;C=SPACES 1256 1CFA C5 PUSH B ;SAVE SIGN & SPACE 1257 1CFB CD 83 1B PN2: CALL DIVIDE ;DIVIDE HL BY 10 1258 1CFE 78 MOV A,B ;RESULT 0? 1259 1CFF B1 ORA C 1260 1D00 CA 0B 1D JZ PN3 ;YES, WE GOT ALL 1261 1D03 E3 XTHL ;NO, SAVE REMAINDER 1262 1D04 2D DCR L ;AND COUNT SPACE 1263 1D05 E5 PUSH H ;HL IS OLD BC 1264 1D06 60 MOV H,B ;MOVE RESULT TO BC 1265 1D07 69 MOV L,C 1266 1D08 C3 FB 1C JMP PN2 ;AND DIVIDE BY 10 1267 1D0B C1 PN3: POP B ;WE GOT ALL DIGITS IN 1268 1D0C 0D PN4: DCR C ;THE STACK 1269 1D0D 79 MOV A,C ;LOOK AT SPACE COUNT 1270 1D0E B7 ORA A 1271 1D0F FA 1A 1D JM PN5 ;NO LEADING BLANKS 1272 1D12 3E 20 MVI A,20H ;LEADING BLANKS 1273 1D14 CD D9 16 CALL OUTC 1274 1D17 C3 0C 1D JMP PN4 ;MORE? 1275 1D1A 78 PN5: MOV A,B ;PRINT SIGN 1276 1D1B B7 ORA A 1277 1D1C C4 10 00 CNZ 10H 1278 1D1F 5D MOV E,L ;LAST REMAINDER IN E 1279 1D20 7B PN6: MOV A,E ;CHECK DIGIT IN E 1280 1D21 FE 0A CPI 0AH ;10 IS FLAG FOR NO MORE 1281 1D23 D1 POP D 1282 1D24 C8 RZ ;IF SO, RETURN 1283 1D25 C6 30 ADI 30H ;ELSE CONVERT TO ASCII 1284 1D27 CD D9 16 CALL OUTC ;AND PRINT THE DIGIT 1285 1D2A C3 20 1D JMP PN6 ;GO BACK FOR MORE 1286 1D2D ; 1287 1D2D 1A PRTLN: LDAX D ;*** PRTLN *** 1288 1D2E 6F MOV L,A ;LOW ORDER LINE # 1289 1D2F 13 INX D 1290 1D30 1A LDAX D ;HIGH ORDER 1291 1D31 67 MOV H,A 1292 1D32 13 INX D 1293 1D33 0E 04 MVI C,4H ;PRINT 4 DIGIT LINE # 1294 1D35 CD E9 1C CALL PRTNUM 1295 1D38 3E 20 MVI A,20H ;FOLLOWED BY A BLANK 1296 1D3A CD D9 16 CALL OUTC 1297 1D3D 97 SUB A ;AND THEN THE NEXT 1298 1D3E CD AB 1C CALL PRTSTG 1299 1D41 C9 RET 1300 1D42 ; 1301 1D42 ;************************************************************* 1302 1D42 ; 1303 1D42 ; *** MVUP *** MVDOWN *** POPA *** & PUSHA *** 1304 1D42 ; 1305 1D42 ; 'MVUP' MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC-> UNTIL 1306 1D42 ; DE = HL 1307 1D42 ; 1308 1D42 ; 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL-> 1309 1D42 ; UNTIL DE = BC 1310 1D42 ; 1311 1D42 ; 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE 1312 1D42 ; STACK 1313 1D42 ; 1314 1D42 ; 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE 1315 1D42 ; STACK 1316 1D42 ; 1317 1D42 CD E9 16 MVUP: CALL COMP ;*** MVUP *** 1318 1D45 C8 RZ ;DE = HL, RETURN 1319 1D46 1A LDAX D ;GET ONE BYTE 1320 1D47 02 STAX B ;MOVE IT 1321 1D48 13 INX D ;INCREASE BOTH POINTERS 1322 1D49 03 INX B 1323 1D4A C3 42 1D JMP MVUP ;UNTIL DONE 1324 1D4D ; 1325 1D4D 78 MVDOWN: MOV A,B ;*** MVDOWN *** 1326 1D4E 92 SUB D ;TEST IF DE = BC 1327 1D4F C2 55 1D JNZ MD1 ;NO, GO MOVE 1328 1D52 79 MOV A,C ;MAYBE, OTHER BYTE? 1329 1D53 93 SUB E 1330 1D54 C8 RZ ;YES, RETURN 1331 1D55 1B MD1: DCX D ;ELSE MOVE A BYTE 1332 1D56 2B DCX H ;BUT FIRST DECREASE 1333 1D57 1A LDAX D ;BOTH POINTERS AND 1334 1D58 77 MOV M,A ;THEN DO IT 1335 1D59 C3 4D 1D JMP MVDOWN ;LOOP BACK 1336 1D5C ; 1337 1D5C C1 POPA: POP B ;BC = RETURN ADDR. 1338 1D5D E1 POP H ;RESTORE LOPVAR, BUT 1339 1D5E 22 09 30 SHLD LOPVAR ;=0 MEANS NO MORE 1340 1D61 7C MOV A,H 1341 1D62 B5 ORA L 1342 1D63 CA 76 1D JZ PP1 ;YEP, GO RETURN 1343 1D66 E1 POP H ;NOP, RESTORE OTHERS 1344 1D67 22 0B 30 SHLD LOPINC 1345 1D6A E1 POP H 1346 1D6B 22 0D 30 SHLD LOPLMT 1347 1D6E E1 POP H 1348 1D6F 22 0F 30 SHLD LOPLN 1349 1D72 E1 POP H 1350 1D73 22 11 30 SHLD LOPPT 1351 1D76 C5 PP1: PUSH B ;BC = RETURN ADDR. 1352 1D77 C9 RET 1353 1D78 ; 1354 1D78 21 78 7F PUSHA: LXI H,STKLMT ;*** PUSHA *** 1355 1D7B CD A3 1B CALL CHGSGN 1356 1D7E C1 POP B ;BC=RETURN ADDRESS 1357 1D7F 39 DAD SP ;IS STACK NEAR THE TOP? 1358 1D80 D2 20 1C JNC QSORRY ;YES, SORRY FOR THAT 1359 1D83 2A 09 30 LHLD LOPVAR ;ELSE SAVE LOOP VAR'S 1360 1D86 7C MOV A,H ;BUT IF LOPVAR IS 0 1361 1D87 B5 ORA L ;THAT WILL BE ALL 1362 1D88 CA 9E 1D JZ PU1 1363 1D8B 2A 11 30 LHLD LOPPT ;ELSE, MORE TO SAVE 1364 1D8E E5 PUSH H 1365 1D8F 2A 0F 30 LHLD LOPLN 1366 1D92 E5 PUSH H 1367 1D93 2A 0D 30 LHLD LOPLMT 1368 1D96 E5 PUSH H 1369 1D97 2A 0B 30 LHLD LOPINC 1370 1D9A E5 PUSH H 1371 1D9B 2A 09 30 LHLD LOPVAR 1372 1D9E E5 PU1: PUSH H 1373 1D9F C5 PUSH B ;BC = RETURN ADDR. 1374 1DA0 C9 RET 1375 1DA1 ; 1376 1DA1 ;************************************************************* 1377 1DA1 ; 1378 1DA1 ; *** OUTC *** & CHKIO *** 1379 1DA1 ; 1380 1DA1 ; THESE ARE THE ONLY I/O ROUTINES IN TBI. 1381 1DA1 ; 'OUTC' IS CONTROLLED BY A SOFTWARE SWITCH 'OCSW'. IF OCSW=0 1382 1DA1 ; 'OUTC' WILL JUST RETURN TO THE CALLER. IF OCSW IS NOT 0, 1383 1DA1 ; IT WILL OUTPUT THE BYTE IN A. IF THAT IS A CR, A LF IS ALSO 1384 1DA1 ; SEND OUT. ONLY THE FLAGS MAY BE CHANGED AT RETURN. ALL REG. 1385 1DA1 ; ARE RESTORED. 1386 1DA1 ; 1387 1DA1 ; 'CHKIO' CHECKS THE INPUT. IF NO INPUT, IT WILL RETURN TO 1388 1DA1 ; THE CALLER WITH THE Z FLAG SET. IF THERE IS INPUT, Z FLAG 1389 1DA1 ; IS CLEARED AND THE INPUT BYTE IS IN A. HOWEVER, IF THE 1390 1DA1 ; INPUT IS A CONTROL-O, THE 'OCSW' SWITCH IS COMPLIMENTED, AND 1391 1DA1 ; Z FLAG IS RETURNED. IF A CONTROL-C IS READ, 'CHKIO' WILL 1392 1DA1 ; RESTART TBI AND DO NOT RETURN TO THE CALLER. 1393 1DA1 ; 1394 1DA1 ;OUTC: PUSH PSW ;THIS IS AT LOC. 10 1395 1DA1 ; LDA OCSW ;CHECK SOFTWARE SWITCH 1396 1DA1 ; ORA A ;sets flags depending on OCSW 1397 1DA1 32 00 30 INIT: STA OCSW 1398 1DA4 16 04 MVI D,04H ;No. of newlines at start 1399 1DA6 CD D7 16 PATLOP: CALL CRLF ;CRLF is entry to OUTC 1400 1DA9 15 DCR D ;OUTC will preserve D reg 1401 1DAA C2 A6 1D JNZ PATLOP 1402 1DAD 97 SUB A 1403 1DAE 11 FA 1D LXI D,MSG1 1404 1DB1 CD AB 1C CALL PRTSTG 1405 1DB4 21 C7 16 LXI H,START 1406 1DB7 22 13 30 SHLD RANPNT 1407 1DBA 21 17 30 LXI H,TXTBGN 1408 1DBD 22 15 30 SHLD TXTUNF 1409 1DC0 C3 89 17 JMP RSTART 1410 1DC3 ;OUTC routine, modified to use write_char subroutine in standalone ROM 1411 1DC3 ;This routine outputs character in A reg to screen 1412 1DC3 ;Increments line position and peforms backspace on 08h 1413 1DC3 ;and newline on 0dh 1414 1DC3 ;Returns with original character in A reg 1415 1DC3 ;write_char uses many registers, so need to save the ones you need 1416 1DC3 C2 C8 1D OC2: JNZ OC3 ;IT IS ON 1417 1DC6 F1 POP PSW ;IT IS OFF 1418 1DC7 C9 RET ;RESTORE AF AND RETURN 1419 1DC8 F1 OC3: pop psw 1420 1DC9 D5 push d 1421 1DCA C5 push b 1422 1DCB E5 push h ;need to save any registers the caller needs unchanged 1423 1DCC F5 push psw ;needs to return with char in A 1424 1DCD CD 0C 00 call write_char 1425 1DD0 F1 pop psw 1426 1DD1 E1 pop h 1427 1DD2 C1 pop b 1428 1DD3 D1 pop d 1429 1DD4 C9 RET 1430 1DD5 ; 1431 1DD5 DB 05 CHKIO: in 5 ;*** CHKIO *** 1432 1DD7 E6 20 ani 20h ;MASK STATUS BIT start bit in keycode reg 1433 1DD9 C8 RZ ;NOT READY, RETURN "Z" 1434 1DDA E5 push h ;get_char uses all registers, so need to save 1435 1DDB D5 push d 1436 1DDC C5 push b 1437 1DDD CD CB 06 call get_char ;READY, READ DATA mode 1 call to get_char 1438 1DE0 C1 pop b 1439 1DE1 D1 pop d 1440 1DE2 E1 pop h 1441 1DE3 E6 7F ANI 7FH ;MASK BIT 7 OFF 1442 1DE5 FE 0F CPI 0FH ;IS IT CONTROL-O? 1443 1DE7 C2 F4 1D JNZ CI1 ;NO, MORE CHECKING 1444 1DEA 3A 00 30 LDA OCSW ;CONTROL-O FLIPS OCSW 1445 1DED 2F CMA ;ON TO OFF, OFF TO ON 1446 1DEE 32 00 30 STA OCSW 1447 1DF1 C3 D5 1D JMP CHKIO ;GET ANOTHER INPUT 1448 1DF4 FE 03 CI1: CPI 3H ;IS IT CONTROL-C? 1449 1DF6 C0 RNZ ;NO, RETURN "NZ" 1450 1DF7 C3 89 17 JMP RSTART ;YES, RESTART TBI 1451 1DFA ; 1452 1DFA 54494E5920 MSG1: .DB "TINY " 1453 1DFF 4241534943 .DB "BASIC" 1454 1E04 0D .DB CR 1455 1E05 ; 1456 1E05 ;************************************************************* 1457 1E05 ; 1458 1E05 ; *** TABLES *** DIRECT *** & EXEC *** 1459 1E05 ; 1460 1E05 ; THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE. 1461 1E05 ; WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION 1462 1E05 ; OF CODE ACCORDING TO THE TABLE. 1463 1E05 ; 1464 1E05 ; AT 'EXEC', DE SHOULD POINT TO THE STRING AND HL SHOULD POINT 1465 1E05 ; TO THE TABLE-1. AT 'DIRECT', DE SHOULD POINT TO THE STRING. 1466 1E05 ; HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF 1467 1E05 ; ALL DIRECT AND STATEMENT COMMANDS. 1468 1E05 ; 1469 1E05 ; A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL 1470 1E05 ; MATCH WILL BE CONSIDERED AS A MATCH. E.G., 'P.', 'PR.', 1471 1E05 ; 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'. 1472 1E05 ; 1473 1E05 ; THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM 1474 1E05 ; IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND 1475 1E05 ; A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH 1476 1E05 ; BYTE SET TO 1. 1477 1E05 ; 1478 1E05 ; END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE 1479 1E05 ; STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL 1480 1E05 ; MATCH THIS NULL ITEM AS DEFAULT. 1481 1E05 ; 1482 1E05 TAB1: ;DIRECT COMMANDS 1483 1E05 4C 49 53 54 .DB "LIST" 1484 1E09 ; DWA LIST 1485 1E09 98 .DB ((LIST >> 8) + 128) 1486 1E0A 44 .DB (LIST & 0FFH) 1487 1E0B 52 55 4E .DB "RUN" 1488 1E0E ; DWA RUN 1489 1E0E 98 .DB ((RUN >> 8) + 128) 1490 1E0F 14 .DB (RUN & 0FFH) 1491 1E10 4E 45 57 .DB "NEW" 1492 1E13 ; DWA NEW 1493 1E13 98 .DB ((NEW >> 8) + 128) 1494 1E14 05 .DB (NEW & 0FFH) 1495 1E15 ; 1496 1E15 TAB2: ;DIRECT/STATEMENT 1497 1E15 4E 45 58 54 .DB "NEXT" 1498 1E19 ; DWA NEXT 1499 1E19 99 .DB ((NEXT >> 8) + 128) 1500 1E1A 46 .DB (NEXT & 0FFH) 1501 1E1B 4C 45 54 .DB "LET" 1502 1E1E ; DWA LET 1503 1E1E 9A .DB ((LET >> 8) + 128) 1504 1E1F 26 .DB (LET & 0FFH) 1505 1E20 49 46 .DB "IF" 1506 1E22 ; DWA IFF 1507 1E22 99 .DB ((IFF >> 8) + 128) 1508 1E23 AB .DB (IFF & 0FFH) 1509 1E24 47 4F 54 4F .DB "GOTO" 1510 1E28 ; DWA GOTO 1511 1E28 98 .DB ((GOTO >> 8) + 128) 1512 1E29 33 .DB (GOTO & 0FFH) 1513 1E2A 474F535542 .DB "GOSUB" 1514 1E2F ; DWA GOSUB 1515 1E2F 98 .DB ((GOSUB >> 8) + 128) 1516 1E30 A4 .DB (GOSUB & 0FFH) 1517 1E31 52455455524E .DB "RETURN" 1518 1E37 ; DWA RETURN 1519 1E37 98 .DB ((RETURN >> 8) + 128) 1520 1E38 C6 .DB (RETURN & 0FFH) 1521 1E39 52 45 4D .DB "REM" 1522 1E3C ; DWA REM 1523 1E3C 99 .DB ((REM >> 8) + 128) 1524 1E3D A7 .DB (REM & 0FFH) 1525 1E3E 46 4F 52 .DB "FOR" 1526 1E41 ; DWA FOR 1527 1E41 98 .DB ((FOR >> 8) + 128) 1528 1E42 E1 .DB (FOR & 0FFH) 1529 1E43 494E505554 .DB "INPUT" 1530 1E48 ; DWA INPUT 1531 1E48 99 .DB ((INPUT >> 8) + 128) 1532 1E49 C6 .DB (INPUT & 0FFH) 1533 1E4A 5052494E54 .DB "PRINT" 1534 1E4F ; DWA PRINT 1535 1E4F 98 .DB ((PRINT >> 8) + 128) 1536 1E50 5E .DB (PRINT & 0FFH) 1537 1E51 53 54 4F 50 .DB "STOP" 1538 1E55 ; DWA STOP 1539 1E55 98 .DB ((STOP >> 8) + 128) 1540 1E56 0E .DB (STOP & 0FFH) 1541 1E57 ; DWA DEFLT 1542 1E57 9A .DB ((DEFLT >> 8) + 128) 1543 1E58 20 .DB (DEFLT & 0FFH) 1544 1E59 ; 1545 1E59 TAB4: ;FUNCTIONS 1546 1E59 52 4E 44 .DB "RND" 1547 1E5C ; DWA RND 1548 1E5C 9B .DB ((RND >> 8) + 128) 1549 1E5D 40 .DB (RND & 0FFH) 1550 1E5E 41 42 53 .DB "ABS" 1551 1E61 ; DWA ABS 1552 1E61 9B .DB ((ABS >> 8) + 128) 1553 1E62 6D .DB (ABS & 0FFH) 1554 1E63 53 49 5A 45 .DB "SIZE" 1555 1E67 ; DWA SIZE 1556 1E67 9B .DB ((SIZE >> 8) + 128) 1557 1E68 76 .DB (SIZE & 0FFH) 1558 1E69 ; DWA XP40 1559 1E69 9B .DB ((XP40 >> 8) + 128) 1560 1E6A 1E .DB (XP40 & 0FFH) 1561 1E6B ; 1562 1E6B TAB5: ;"TO" IN "FOR" 1563 1E6B 54 4F .DB "TO" 1564 1E6D ; DWA FR1 1565 1E6D 98 .DB ((FR1 >> 8) + 128) 1566 1E6E F1 .DB (FR1 & 0FFH) 1567 1E6F ; DWA QWHAT 1568 1E6F 9B .DB ((QWHAT >> 8) + 128) 1569 1E70 F1 .DB (QWHAT & 0FFH) 1570 1E71 ; 1571 1E71 TAB6: ;"STEP" IN "FOR" 1572 1E71 53 54 45 50 .DB "STEP" 1573 1E75 ; DWA FR2 1574 1E75 98 .DB ((FR2 >> 8) + 128) 1575 1E76 FD .DB (FR2 & 0FFH) 1576 1E77 ; DWA FR3 1577 1E77 99 .DB ((FR3 >> 8) + 128) 1578 1E78 03 .DB (FR3 & 0FFH) 1579 1E79 ; 1580 1E79 TAB8: ;RELATION OPERATORS 1581 1E79 3E 3D .DB ">=" 1582 1E7B ; DWA XP11 1583 1E7B 9A .DB ((XP11 >> 8) + 128) 1584 1E7C 3A .DB (XP11 & 0FFH) 1585 1E7D 23 .DB '#' 1586 1E7E ; DWA XP12 1587 1E7E 9A .DB ((XP12 >> 8) + 128) 1588 1E7F 40 .DB (XP12 & 0FFH) 1589 1E80 3E .DB '>' 1590 1E81 ; DWA XP13 1591 1E81 9A .DB ((XP13 >> 8) + 128) 1592 1E82 46 .DB (XP13 & 0FFH) 1593 1E83 3D .DB '=' 1594 1E84 ; DWA XP15 1595 1E84 98 .DB ((RUN >> 8) + 128) 1596 1E85 14 .DB (RUN & 0FFH) 1597 1E86 3C 3D .DB "<=" 1598 1E88 ; DWA XP14 1599 1E88 9A .DB ((XP14 >> 8) + 128) 1600 1E89 4D .DB (XP14 & 0FFH) 1601 1E8A 3C .DB '<' 1602 1E8B ; DWA XP16 1603 1E8B 9A .DB ((XP16 >> 8) + 128) 1604 1E8C 5B .DB (XP16 & 0FFH) 1605 1E8D ; DWA XP17 1606 1E8D 9A .DB ((XP17 >> 8) + 128) 1607 1E8E 61 .DB (XP17 & 0FFH) 1608 1E8F ; 1609 1E8F 21 04 1E DIRECT: LXI H,TAB1-1 ;*** DIRECT *** 1610 1E92 ; 1611 1E92 EXEC: ;*** EXEC *** 1612 1E92 CD F1 16 EX0: CALL IGNBLK ;IGNORE LEADING BLANKS 1613 1E95 D5 PUSH D ;SAVE POINTER 1614 1E96 1A EX1: LDAX D ;IF FOUND '.' IN STRING 1615 1E97 13 INX D ;BEFORE ANY MISMATCH 1616 1E98 FE 2E CPI 2EH ;WE DECLARE A MATCH 1617 1E9A CA B3 1E JZ EX3 1618 1E9D 23 INX H ;HL->TABLE 1619 1E9E BE CMP M ;IF MATCH, TEST NEXT 1620 1E9F CA 96 1E JZ EX1 1621 1EA2 3E 7F MVI A,07FH ;ELSE SEE IF BIT 7 1622 1EA4 1B DCX D ;OF TABLE IS SET, WHICH 1623 1EA5 BE CMP M ;IS THE JUMP ADDR. (HI) 1624 1EA6 DA BA 1E JC EX5 ;C:YES, MATCHED 1625 1EA9 23 EX2: INX H ;NC:NO, FIND JUMP ADDR. 1626 1EAA BE CMP M 1627 1EAB D2 A9 1E JNC EX2 1628 1EAE 23 INX H ;BUMP TO NEXT TAB. ITEM 1629 1EAF D1 POP D ;RESTORE STRING POINTER 1630 1EB0 C3 92 1E JMP EX0 ;TEST AGAINST NEXT ITEM 1631 1EB3 3E 7F EX3: MVI A,07FH ;PARTIAL MATCH, FIND 1632 1EB5 23 EX4: INX H ;JUMP ADDR., WHICH IS 1633 1EB6 BE CMP M ;FLAGGED BY BIT 7 1634 1EB7 D2 B5 1E JNC EX4 1635 1EBA 7E EX5: MOV A,M ;LOAD HL WITH THE JUMP 1636 1EBB 23 INX H ;ADDRESS FROM THE TABLE 1637 1EBC 6E MOV L,M 1638 1EBD E6 7F ANI 7FH ;MASK OFF BIT 7 1639 1EBF 67 MOV H,A 1640 1EC0 F1 POP PSW ;CLEAN UP THE GABAGE 1641 1EC1 E9 PCHL ;AND WE GO DO IT 1642 1EC2 ; 1643 1EC2 LSTROM: ;ALL ABOVE CAN BE ROM 1644 1EC2 ; .ORG 1000H ;HERE DOWN MUST BE RAM 1645 1EC2 ; .ORG 0800H 1646 3000 .org 3000h ;keep variables away from code 1647 3000 OCSW: .DS 1 ;SWITCH FOR OUTPUT 1648 3001 CURRNT: .DS 2 ;POINTS TO CURRENT LINE 1649 3003 STKGOS: .DS 2 ;SAVES SP IN 'GOSUB' 1650 3005 VARNXT: .DS 2 ;TEMP STORAGE 1651 3007 STKINP: .DS 2 ;SAVES SP IN 'INPUT' 1652 3009 LOPVAR: .DS 2 ;'FOR' LOOP SAVE AREA 1653 300B LOPINC: .DS 2 ;INCREMENT 1654 300D LOPLMT: .DS 2 ;LIMIT 1655 300F LOPLN: .DS 2 ;LINE NUMBER 1656 3011 LOPPT: .DS 2 ;TEXT POINTER 1657 3013 RANPNT: .DS 2 ;RANDOM NUMBER POINTER 1658 3015 TXTUNF: .DS 2 ;->UNFILLED TEXT AREA 1659 3017 TXTBGN: .DS 2 ;TEXT SAVE AREA BEGINS 1660 3019 ; .ORG 1366H 1661 3019 ; .ORG 1F00H 1662 3019 ; .ORG 0F00H ;for 2K RAM 1663 3019 ; .ORG 0FF00H ;for 64K RAM 1664 7F00 .ORG 7F00h ;for 32K RAM 1665 7F00 TXTEND: .DS 0 ;TEXT SAVE AREA ENDS 1666 7F00 VARBGN: .DS 55 ;VARIABLE @(0) 1667 7F37 BUFFER: .DS 64 ;INPUT BUFFER 1668 7F77 BUFEND: .DS 1 ;BUFFER ENDS 1669 7F78 STKLMT: .DS 1 ;TOP LIMIT FOR STACK 1670 7F79 ; .ORG 1400H 1671 7F79 ; .ORG 2000H 1672 7F79 ; .ORG 1000H ;for 4K system -- 2k ROM, 2K RAM 1673 7F79 ; .ORG 0FFFFH ;for 64K RAM system 1674 7FFF .ORG 7FFFH ;for 32K RAM system 1675 7FFF STACK: .DS 0 ;STACK STARTS HERE 1676 7FFF ; 1677 7FFF CR .EQU 0DH 1678 7FFF LF .EQU 0AH 1679 7FFF 1680 7FFF ;ROM subroutines 1681 7FFF write_char .equ 000ch ;write_char subroutine in ROM 1682 7FFF newline .equ 085Ah 1683 7FFF monitor_warm_start .equ 043eh 1684 7FFF get_char .equ 06cBh 1685 7FFF 1686 7FFF .END tasm: Number of errors = 0