├── LICENSE ├── PATB-test.txt ├── PATB.a80 └── PATB.emu /LICENSE: -------------------------------------------------------------------------------- 1 | Creative Commons Legal Code 2 | 3 | CC0 1.0 Universal 4 | 5 | CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE 6 | LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN 7 | ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS 8 | INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES 9 | REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS 10 | PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM 11 | THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED 12 | HEREUNDER. 13 | 14 | Statement of Purpose 15 | 16 | The laws of most jurisdictions throughout the world automatically confer 17 | exclusive Copyright and Related Rights (defined below) upon the creator 18 | and subsequent owner(s) (each and all, an "owner") of an original work of 19 | authorship and/or a database (each, a "Work"). 20 | 21 | Certain owners wish to permanently relinquish those rights to a Work for 22 | the purpose of contributing to a commons of creative, cultural and 23 | scientific works ("Commons") that the public can reliably and without fear 24 | of later claims of infringement build upon, modify, incorporate in other 25 | works, reuse and redistribute as freely as possible in any form whatsoever 26 | and for any purposes, including without limitation commercial purposes. 27 | These owners may contribute to the Commons to promote the ideal of a free 28 | culture and the further production of creative, cultural and scientific 29 | works, or to gain reputation or greater distribution for their Work in 30 | part through the use and efforts of others. 31 | 32 | For these and/or other purposes and motivations, and without any 33 | expectation of additional consideration or compensation, the person 34 | associating CC0 with a Work (the "Affirmer"), to the extent that he or she 35 | is an owner of Copyright and Related Rights in the Work, voluntarily 36 | elects to apply CC0 to the Work and publicly distribute the Work under its 37 | terms, with knowledge of his or her Copyright and Related Rights in the 38 | Work and the meaning and intended legal effect of CC0 on those rights. 39 | 40 | 1. Copyright and Related Rights. A Work made available under CC0 may be 41 | protected by copyright and related or neighboring rights ("Copyright and 42 | Related Rights"). Copyright and Related Rights include, but are not 43 | limited to, the following: 44 | 45 | i. the right to reproduce, adapt, distribute, perform, display, 46 | communicate, and translate a Work; 47 | ii. moral rights retained by the original author(s) and/or performer(s); 48 | iii. publicity and privacy rights pertaining to a person's image or 49 | likeness depicted in a Work; 50 | iv. rights protecting against unfair competition in regards to a Work, 51 | subject to the limitations in paragraph 4(a), below; 52 | v. rights protecting the extraction, dissemination, use and reuse of data 53 | in a Work; 54 | vi. database rights (such as those arising under Directive 96/9/EC of the 55 | European Parliament and of the Council of 11 March 1996 on the legal 56 | protection of databases, and under any national implementation 57 | thereof, including any amended or successor version of such 58 | directive); and 59 | vii. other similar, equivalent or corresponding rights throughout the 60 | world based on applicable law or treaty, and any national 61 | implementations thereof. 62 | 63 | 2. Waiver. To the greatest extent permitted by, but not in contravention 64 | of, applicable law, Affirmer hereby overtly, fully, permanently, 65 | irrevocably and unconditionally waives, abandons, and surrenders all of 66 | Affirmer's Copyright and Related Rights and associated claims and causes 67 | of action, whether now known or unknown (including existing as well as 68 | future claims and causes of action), in the Work (i) in all territories 69 | worldwide, (ii) for the maximum duration provided by applicable law or 70 | treaty (including future time extensions), (iii) in any current or future 71 | medium and for any number of copies, and (iv) for any purpose whatsoever, 72 | including without limitation commercial, advertising or promotional 73 | purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each 74 | member of the public at large and to the detriment of Affirmer's heirs and 75 | successors, fully intending that such Waiver shall not be subject to 76 | revocation, rescission, cancellation, termination, or any other legal or 77 | equitable action to disrupt the quiet enjoyment of the Work by the public 78 | as contemplated by Affirmer's express Statement of Purpose. 79 | 80 | 3. Public License Fallback. Should any part of the Waiver for any reason 81 | be judged legally invalid or ineffective under applicable law, then the 82 | Waiver shall be preserved to the maximum extent permitted taking into 83 | account Affirmer's express Statement of Purpose. In addition, to the 84 | extent the Waiver is so judged Affirmer hereby grants to each affected 85 | person a royalty-free, non transferable, non sublicensable, non exclusive, 86 | irrevocable and unconditional license to exercise Affirmer's Copyright and 87 | Related Rights in the Work (i) in all territories worldwide, (ii) for the 88 | maximum duration provided by applicable law or treaty (including future 89 | time extensions), (iii) in any current or future medium and for any number 90 | of copies, and (iv) for any purpose whatsoever, including without 91 | limitation commercial, advertising or promotional purposes (the 92 | "License"). The License shall be deemed effective as of the date CC0 was 93 | applied by Affirmer to the Work. Should any part of the License for any 94 | reason be judged legally invalid or ineffective under applicable law, such 95 | partial invalidity or ineffectiveness shall not invalidate the remainder 96 | of the License, and in such case Affirmer hereby affirms that he or she 97 | will not (i) exercise any of his or her remaining Copyright and Related 98 | Rights in the Work or (ii) assert any associated claims and causes of 99 | action with respect to the Work, in either case contrary to Affirmer's 100 | express Statement of Purpose. 101 | 102 | 4. Limitations and Disclaimers. 103 | 104 | a. No trademark or patent rights held by Affirmer are waived, abandoned, 105 | surrendered, licensed or otherwise affected by this document. 106 | b. Affirmer offers the Work as-is and makes no representations or 107 | warranties of any kind concerning the Work, express, implied, 108 | statutory or otherwise, including without limitation warranties of 109 | title, merchantability, fitness for a particular purpose, non 110 | infringement, or the absence of latent or other defects, accuracy, or 111 | the present or absence of errors, whether or not discoverable, all to 112 | the greatest extent permissible under applicable law. 113 | c. Affirmer disclaims responsibility for clearing rights of other persons 114 | that may apply to the Work or any use thereof, including without 115 | limitation any person's Copyright and Related Rights in the Work. 116 | Further, Affirmer disclaims responsibility for obtaining any necessary 117 | consents, permissions or other rights required for any use of the 118 | Work. 119 | d. Affirmer understands and acknowledges that Creative Commons is not a 120 | party to this document and has no duty or obligation with respect to 121 | this CC0 or use of the Work. 122 | -------------------------------------------------------------------------------- /PATB-test.txt: -------------------------------------------------------------------------------- 1 | 1 REM TEST ALL COMMAND VARIATIONS 2 | 3 | 2 INPUT "HELLO WORLD" 4 | 5 | 3 INPUT "(ENTER 1,2,3)",'1='A,"2="B,C 6 | 7 | 4 LET @(A)=B,D=1+@(A)*B-6/C 8 | 9 | 5 LET C=(2>1)+(2>=2)+(2<3)+(2<=2)*(3=3)+3#4 10 | 11 | 12 | 6 PRINT 1,"2",'3',#1,4; PRINT A,@(A),D,4 13 | 14 | 7 PRINT ABS(-1),ABS(0),ABS(1),SIZE,5290,RND(D),2 15 | 16 | 8 IF AB PRINT "A>B" 19 | 20 | 10 GOTO 25*4+30 21 | 22 | 23 | 110 PRINT "IF THIS IS PRINTED, GOTO FAILED." 24 | 25 | 26 | 120 X=1; RETURN 27 | 28 | 29 | 130 X=0; GOSUB 120; IF X PRINT "GOSUB & RETURN WORKED." 30 | 31 | 32 | 140 FOR X=10 TO 0 STEP -1; PRINT X,; NEXT X; PRINT 33 | 34 | 150 PRINT "LIFTOFF!" 35 | 36 | 37 | 160 FOR X=1 TO 9; PRINT "T+",#1,X,", ",; NEXT X; 38 | 39 | 170 PRINT "T+10" 40 | 41 | 42 | 32767 STOP 43 | -------------------------------------------------------------------------------- /PATB.a80: -------------------------------------------------------------------------------- 1 | ;************************************************************* 2 | ; 3 | ; TINY BASIC FOR INTEL 8080 4 | ; VERSION 2.0 5 | ; BY LI-CHEN WANG 6 | ; MODIFIED AND TRANSLATED 7 | ; TO INTEL MNEMONICS 8 | ; BY ROGER RAUSKOLB 9 | ; 10 OCTOBER,1976 10 | ; @COPYLEFT 11 | ; ALL WRONGS RESERVED 12 | ; 13 | ; ADDED FIX FOR BUGGY CHGSGN 14 | ; UDO MUNK, 10 DECEMBER 2019 15 | ;************************************************************* 16 | ; 17 | ; *** ZERO PAGE SUBROUTINES *** 18 | ; 19 | ; THE 8080 INSTRUCTION SET LETS YOU HAVE 8 ROUTINES IN LOW 20 | ; MEMORY THAT MAY BE CALLED BY RST N, N BEING 0 THROUGH 7. 21 | ; THIS IS A ONE BYTE INSTRUCTION AND HAS THE SAME POWER AS 22 | ; THE THREE BYTE INSTRUCTION CALL LLHH. TINY BASIC WILL 23 | ; USE RST 0 AS START AND RST 1 THROUGH RST 7 FOR 24 | ; THE SEVEN MOST FREQUENTLY USED SUBROUTINES. 25 | ; TWO OTHER SUBROUTINES (CRLF AND TSTNUM) ARE ALSO IN THIS 26 | ; SECTION. THEY CAN BE REACHED ONLY BY 3-BYTE CALLS. 27 | ; 28 | DWA: .MACRO WHERE 29 | DB (WHERE / 256 ) + 128 30 | DB WHERE & 0FFH 31 | .ENDM 32 | ; 33 | ; -- MM variables 34 | ACIA_DATA EQU 17 35 | ACIA_CTRL EQU 16 36 | ; -- bit 0: char received 37 | ; -- bit 1: clear to send 38 | .ENGINE PATB 39 | ; 40 | ; 41 | .ORG 0H 42 | START: LXI SP,STACK ;*** COLD START *** 43 | MVI A,0FFH 44 | JMP INIT 45 | ; 46 | XTHL ;*** TSTC OR RST 1 *** 47 | RST 5 ;IGNORE BLANKS AND 48 | CMP M ;TEST CHARACTER 49 | JMP TC1 ;REST OF THIS IS AT TC1 50 | ; 51 | CRLF: MVI A,CR ;*** CRLF *** 52 | ; 53 | PUSH PSW ;*** OUTC OR RST 2 *** 54 | LDA OCSW ;PRINT CHARACTER ONLY 55 | ORA A ;IF OCSW SWITCH IS ON 56 | JMP OC2 ;REST OF THIS IS AT OC2 57 | ; 58 | CALL EXPR2 ;*** EXPR OR RST 3 *** 59 | PUSH H ;EVALUATE AN EXPRESSION 60 | JMP EXPR1 ;REST OF IT AT EXPR1 61 | DB "W" 62 | ; 63 | MOV A,H ;*** COMP OR RST 4 *** 64 | CMP D ;COMPARE HL WITH DE 65 | RNZ ;RETURN CORRECT C AND 66 | MOV A,L ;Z FLAGS 67 | CMP E ;BUT OLD A IS LOST 68 | RET 69 | DB "AN" 70 | ; 71 | SS1: LDAX D ;*** IGNBLK/RST 5 *** 72 | CPI 20H ;IGNORE BLANKS 73 | RNZ ;IN TEXT (WHERE DE->) 74 | INX D ;AND RETURN THE FIRST 75 | JMP SS1 ;NON-BLANK CHAR. IN A 76 | ; 77 | POP PSW ;*** FINISH/RST 6 *** 78 | CALL FIN ;CHECK END OF COMMAND 79 | JMP QWHAT ;PRINT "WHAT?" IF WRONG 80 | DB "G" 81 | ; 82 | RST 5 ;*** TSTV OR RST 7 *** 83 | SUI 40H ;TEST VARIABLES 84 | RC ;C:NOT A VARIABLE 85 | JNZ TV1 ;NOT "@" ARRAY 86 | INX D ;IT IS THE "@" ARRAY 87 | CALL PARN ;@ SHOULD BE FOLLOWED 88 | DAD H ;BY (EXPR) AS ITS INDEX 89 | JC QHOW ;IS INDEX TOO BIG? 90 | PUSH D ;WILL IT OVERWRITE 91 | XCHG ;TEXT? 92 | CALL SIZE ;FIND SIZE OF FREE 93 | RST 4 ;AND CHECK THAT 94 | JC ASORRY ;IF SO, SAY "SORRY" 95 | LXI H,VARBGN ;IF NOT GET ADDRESS 96 | CALL SUBDE ;OF @(EXPR) AND PUT IT 97 | POP D ;IN HL 98 | RET ;C FLAG IS CLEARED 99 | TV1: CPI 1BH ;NOT @, IS IT A TO Z? 100 | CMC ;IF NOT RETURN C FLAG 101 | RC 102 | INX D ;IF A THROUGH Z 103 | LXI H,VARBGN ;COMPUTE ADDRESS OF 104 | RLC ;THAT VARIABLE 105 | ADD L ;AND RETURN IT IN HL 106 | MOV L,A ;WITH C FLAG CLEARED 107 | MVI A,0 108 | ADC H 109 | MOV H,A 110 | RET 111 | ; 112 | ;TSTC: XTHL ;*** TSTC OR RST 1 *** 113 | ; RST 5 ;THIS IS AT LOC. 8 114 | ; CMP M ;AND THEN JUMP HERE 115 | TC1: INX H ;COMPARE THE BYTE THAT 116 | JZ TC2 ;FOLLOWS THE RST INST. 117 | PUSH B ;WITH THE TEXT (DE->) 118 | MOV C,M ;IF NOT =, ADD THE 2ND 119 | MVI B,0 ;BYTE THAT FOLLOWS THE 120 | DAD B ;RST TO THE OLD PC 121 | POP B ;I.E., DO A RELATIVE 122 | DCX D ;JUMP IF NOT = 123 | TC2: INX D ;IF =, SKIP THOSE BYTES 124 | INX H ;AND CONTINUE 125 | XTHL 126 | RET 127 | ; 128 | TSTNUM: LXI H,0 ;*** TSTNUM *** 129 | MOV B,H ;TEST IF THE TEXT IS 130 | RST 5 ;A NUMBER 131 | TN1: CPI 30H ;IF NOT, RETURN 0 IN 132 | RC ;B AND HL 133 | CPI 3AH ;IF NUMBERS, CONVERT 134 | RNC ;TO BINARY IN HL AND 135 | MVI A,0F0H ;SET B TO # OF DIGITS 136 | ANA H ;IF H>255, THERE IS NO 137 | JNZ QHOW ;ROOM FOR NEXT DIGIT 138 | INR B ;B COUNTS # OF DIGITS 139 | PUSH B 140 | MOV B,H ;HL=10*HL+(NEW DIGIT) 141 | MOV C,L 142 | DAD H ;WHERE 10* IS DONE BY 143 | DAD H ;SHIFT AND ADD 144 | DAD B 145 | DAD H 146 | LDAX D ;AND (DIGIT) IS FROM 147 | INX D ;STRIPPING THE ASCII 148 | ANI 0FH ;CODE 149 | ADD L 150 | MOV L,A 151 | MVI A,0 152 | ADC H 153 | MOV H,A 154 | POP B 155 | LDAX D ;DO THIS DIGIT AFTER 156 | JP TN1 ;DIGIT. S SAYS OVERFLOW 157 | QHOW: PUSH D ;*** ERROR "HOW?" *** 158 | AHOW: LXI D,HOW 159 | JMP ERROR 160 | HOW: DB "HOW?" 161 | DB CR 162 | OK: DB "OK" 163 | DB CR 164 | WHAT: DB "WHAT?" 165 | DB CR 166 | SORRY: DB "SORRY" 167 | DB CR 168 | ; 169 | ;************************************************************* 170 | ; 171 | ; *** MAIN *** 172 | ; 173 | ; THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM 174 | ; AND STORES IT IN THE MEMORY. 175 | ; 176 | ; AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE 177 | ; STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS 178 | ; ">" AND READS A LINE. IF THE LINE STARTS WITH A NON-ZERO 179 | ; NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER 180 | ; (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR) 181 | ; IS STORED IN THE MEMORY. IF A LINE WITH THE SAME LINE 182 | ; NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW ONE. IF 183 | ; THE REST OF THE LINE CONSISTS OF A CR ONLY, IT IS NOT STORED 184 | ; AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED. 185 | ; 186 | ; AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM 187 | ; LOOPS BACK AND ASKS FOR ANOTHER LINE. THIS LOOP WILL BE 188 | ; TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE 189 | ; NUMBER; AND CONTROL IS TRANSFERED TO "DIRECT". 190 | ; 191 | ; TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION 192 | ; LABELED "TXTBGN" AND ENDS AT "TXTEND". WE ALWAYS FILL THIS 193 | ; AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED 194 | ; BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF". 195 | ; 196 | ; THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER 197 | ; THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN 198 | ; THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND 199 | ; (SEE NEXT SECTION). "CURRNT" SHOULD POINT TO A 0. 200 | ; 201 | RSTART: LXI SP,STACK 202 | ST1: CALL CRLF ;AND JUMP TO HERE 203 | LXI D,OK ;DE->STRING 204 | SUB A ;A=0 205 | CALL PRTSTG ;PRINT STRING UNTIL CR 206 | LXI H,ST2+1 ;LITERAL 0 207 | SHLD CURRNT ;CURRENT->LINE # = 0 208 | ST2: LXI H,0 209 | SHLD LOPVAR 210 | SHLD STKGOS 211 | ST3: MVI A,3EH ;PROMPT ">" AND 212 | CALL GETLN ;READ A LINE 213 | PUSH D ;DE->END OF LINE 214 | LXI D,BUFFER ;DE->BEGINNING OF LINE 215 | CALL TSTNUM ;TEST IF IT IS A NUMBER 216 | RST 5 217 | MOV A,H ;HL=VALUE OF THE # OR 218 | ORA L ;0 IF NO # WAS FOUND 219 | POP B ;BC->END OF LINE 220 | JZ DIRECT 221 | DCX D ;BACKUP DE AND SAVE 222 | MOV A,H ;VALUE OF LINE # THERE 223 | STAX D 224 | DCX D 225 | MOV A,L 226 | STAX D 227 | PUSH B ;BC,DE->BEGIN, END 228 | PUSH D 229 | MOV A,C 230 | SUB E 231 | PUSH PSW ;A=# OF BYTES IN LINE 232 | CALL FNDLN ;FIND THIS LINE IN SAVE 233 | PUSH D ;AREA, DE->SAVE AREA 234 | JNZ ST4 ;NZ:NOT FOUND, INSERT 235 | PUSH D ;Z:FOUND, DELETE IT 236 | CALL FNDNXT ;FIND NEXT LINE 237 | ;DE->NEXT LINE 238 | POP B ;BC->LINE TO BE DELETED 239 | LHLD TXTUNF ;HL->UNFILLED SAVE AREA 240 | CALL MVUP ;MOVE UP TO DELETE 241 | MOV H,B ;TXTUNF->UNFILLED AREA 242 | MOV L,C 243 | SHLD TXTUNF ;UPDATE 244 | ST4: POP B ;GET READY TO INSERT 245 | LHLD TXTUNF ;BUT FIRST CHECK IF 246 | POP PSW ;THE LENGTH OF NEW LINE 247 | PUSH H ;IS 3 (LINE # AND CR) 248 | CPI 3 ;THEN DO NOT INSERT 249 | JZ RSTART ;MUST CLEAR THE STACK 250 | ADD L ;COMPUTE NEW TXTUNF 251 | MOV L,A 252 | MVI A,0 253 | ADC H 254 | MOV H,A ;HL->NEW UNFILLED AREA 255 | LXI D,TXTEND ;CHECK TO SEE IF THERE 256 | RST 4 ;IS ENOUGH SPACE 257 | JNC QSORRY ;SORRY, NO ROOM FOR IT 258 | SHLD TXTUNF ;OK, UPDATE TXTUNF 259 | POP D ;DE->OLD UNFILLED AREA 260 | CALL MVDOWN 261 | POP D ;DE->BEGIN, HL->END 262 | POP H 263 | CALL MVUP ;MOVE NEW LINE TO SAVE 264 | JMP ST3 ;AREA 265 | ; 266 | ;************************************************************* 267 | ; 268 | ; WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT 269 | ; COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE 270 | ; COMMAND TABLE LOOKUP CODE OF "DIRECT" AND "EXEC" IN LAST 271 | ; SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS 272 | ; TRANSFERED TO OTHERS SECTIONS AS FOLLOWS: 273 | ; 274 | ; FOR "LIST", "NEW", AND "STOP": GO BACK TO "RSTART" 275 | ; FOR "RUN": GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE 276 | ; GO BACK TO "RSTART". 277 | ; FOR "GOTO" AND "GOSUB": GO EXECUTE THE TARGET LINE. 278 | ; FOR "RETURN" AND "NEXT": GO BACK TO SAVED RETURN LINE. 279 | ; FOR ALL OTHERS: IF "CURRENT" -> 0, GO TO "RSTART", ELSE 280 | ; GO EXECUTE NEXT COMMAND. (THIS IS DONE IN "FINISH".) 281 | ;************************************************************* 282 | ; 283 | ; *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO *** 284 | ; 285 | ; "NEW(CR)" SETS "TXTUNF" TO POINT TO "TXTBGN" 286 | ; 287 | ; "STOP(CR)" GOES BACK TO "RSTART" 288 | ; 289 | ; "RUN(CR)" FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN 290 | ; "CURRENT"), AND START EXECUTE IT. NOTE THAT ONLY THOSE 291 | ; COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM. 292 | ; 293 | ; THERE ARE 3 MORE ENTRIES IN "RUN": 294 | ; "RUNNXL" FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT. 295 | ; "RUNTSL" STORES THE ADDRESS OF THIS LINE AND EXECUTES IT. 296 | ; "RUNSML" CONTINUES THE EXECUTION ON SAME LINE. 297 | ; 298 | ; "GOTO EXPR(CR)" EVALUATES THE EXPRESSION, FIND THE TARGET 299 | ; LINE, AND JUMP TO "RUNTSL" TO DO IT. 300 | ; 301 | NEW: CALL ENDCHK ;*** NEW(CR) *** 302 | LXI H,TXTBGN 303 | SHLD TXTUNF 304 | ; 305 | STOP: CALL ENDCHK ;*** STOP(CR) *** 306 | JMP RSTART 307 | ; 308 | RUN: CALL ENDCHK ;*** RUN(CR) *** 309 | LXI D,TXTBGN ;FIRST SAVED LINE 310 | ; 311 | RUNNXL: LXI H,0 ;*** RUNNXL *** 312 | CALL FNDLP ;FIND WHATEVER LINE # 313 | JC RSTART ;C:PASSED TXTUNF, QUIT 314 | ; 315 | RUNTSL: XCHG ;*** RUNTSL *** 316 | SHLD CURRNT ;SET "CURRENT"->LINE # 317 | XCHG 318 | INX D ;BUMP PASS LINE # 319 | INX D 320 | ; 321 | RUNSML: CALL CHKIO ;*** RUNSML *** 322 | LXI H,TAB2-1 ;FIND COMMAND IN TAB2 323 | JMP EXEC ;AND EXECUTE IT 324 | ; 325 | GOTO: RST 3 ;*** GOTO EXPR *** 326 | PUSH D ;SAVE FOR ERROR ROUTINE 327 | CALL ENDCHK ;MUST FIND A CR 328 | CALL FNDLN ;FIND THE TARGET LINE 329 | JNZ AHOW ;NO SUCH LINE # 330 | POP PSW ;CLEAR THE PUSH DE 331 | JMP RUNTSL ;GO DO IT 332 | ; 333 | ;************************************************************* 334 | ; 335 | ; *** LIST *** & PRINT *** 336 | ; 337 | ; LIST HAS TWO FORMS: 338 | ; "LIST(CR)" LISTS ALL SAVED LINES 339 | ; "LIST #(CR)" START LIST AT THIS LINE # 340 | ; YOU CAN STOP THE LISTING BY CONTROL C KEY 341 | ; 342 | ; PRINT COMMAND IS "PRINT ....;" OR "PRINT ....(CR)" 343 | ; WHERE "...." IS A LIST OF EXPRESIONS, FORMATS, BACK- 344 | ; ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS. 345 | ; 346 | ; A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS 347 | ; THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO 348 | ; BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT 349 | ; COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS 350 | ; SPECIFIED, 6 POSITIONS WILL BE USED. 351 | ; 352 | ; A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF 353 | ; DOUBLE QUOTES. 354 | ; 355 | ; A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF) 356 | ; 357 | ; A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN 358 | ; PRINTED OR IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST 359 | ; ENDED WITH A COMMA, NO (CRLF) IS GENERATED. 360 | ; 361 | LIST: CALL TSTNUM ;TEST IF THERE IS A # 362 | CALL ENDCHK ;IF NO # WE GET A 0 363 | CALL FNDLN ;FIND THIS OR NEXT LINE 364 | LS1: JC RSTART ;C:PASSED TXTUNF 365 | CALL PRTLN ;PRINT THE LINE 366 | CALL CHKIO ;STOP IF HIT CONTROL-C 367 | CALL FNDLP ;FIND NEXT LINE 368 | JMP LS1 ;AND LOOP BACK 369 | ; 370 | PRINT: MVI C,6 ;C = # OF SPACES 371 | RST 1 ;IF NULL LIST & ";" 372 | DB 3BH 373 | DB PR2-$-1 374 | CALL CRLF ;GIVE CR-LF AND 375 | JMP RUNSML ;CONTINUE SAME LINE 376 | PR2: RST 1 ;IF NULL LIST (CR) 377 | DB CR 378 | DB PR0-$-1 379 | CALL CRLF ;ALSO GIVE CR-LF AND 380 | JMP RUNNXL ;GO TO NEXT LINE 381 | PR0: RST 1 ;ELSE IS IT FORMAT? 382 | DB "#" 383 | DB PR1-$-1 384 | RST 3 ;YES, EVALUATE EXPR. 385 | MOV C,L ;AND SAVE IT IN C 386 | JMP PR3 ;LOOK FOR MORE TO PRINT 387 | PR1: CALL QTSTG ;OR IS IT A STRING? 388 | JMP PR8 ;IF NOT, MUST BE EXPR. 389 | PR3: RST 1 ;IF ",", GO FIND NEXT 390 | DB "," 391 | DB PR6-$-1 392 | CALL FIN ;IN THE LIST. 393 | JMP PR0 ;LIST CONTINUES 394 | PR6: CALL CRLF ;LIST ENDS 395 | RST 6 396 | PR8: RST 3 ;EVALUATE THE EXPR 397 | PUSH B 398 | CALL PRTNUM ;PRINT THE VALUE 399 | POP B 400 | JMP PR3 ;MORE TO PRINT? 401 | ; 402 | ;************************************************************* 403 | ; 404 | ; *** GOSUB *** & RETURN *** 405 | ; 406 | ; "GOSUB EXPR;" OR "GOSUB EXPR (CR)" IS LIKE THE "GOTO" 407 | ; COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER 408 | ; ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE 409 | ; SUBROUTINE "RETURN". IN ORDER THAT "GOSUB" CAN BE NESTED 410 | ; (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED. 411 | ; THE STACK POINTER IS SAVED IN "STKGOS", THE OLD "STKGOS" IS 412 | ; SAVED IN THE STACK. IF WE ARE IN THE MAIN ROUTINE, "STKGOS" 413 | ; IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE), 414 | ; BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER "RETURN"S. 415 | ; 416 | ; "RETURN(CR)" UNDOS EVERYTHING THAT "GOSUB" DID, AND THUS 417 | ; RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT 418 | ; "GOSUB". IF "STKGOS" IS ZERO, IT INDICATES THAT WE 419 | ; NEVER HAD A "GOSUB" AND IS THUS AN ERROR. 420 | ; 421 | GOSUB: CALL PUSHA ;SAVE THE CURRENT "FOR" 422 | RST 3 ;PARAMETERS 423 | PUSH D ;AND TEXT POINTER 424 | CALL FNDLN ;FIND THE TARGET LINE 425 | JNZ AHOW ;NOT THERE. SAY "HOW?" 426 | LHLD CURRNT ;FOUND IT, SAVE OLD 427 | PUSH H ;"CURRNT" OLD "STKGOS" 428 | LHLD STKGOS 429 | PUSH H 430 | LXI H,0 ;AND LOAD NEW ONES 431 | SHLD LOPVAR 432 | DAD SP 433 | SHLD STKGOS 434 | JMP RUNTSL ;THEN RUN THAT LINE 435 | RETURN: CALL ENDCHK ;THERE MUST BE A CR 436 | LHLD STKGOS ;OLD STACK POINTER 437 | MOV A,H ;0 MEANS NOT EXIST 438 | ORA L 439 | JZ QWHAT ;SO, WE SAY: "WHAT?" 440 | SPHL ;ELSE, RESTORE IT 441 | POP H 442 | SHLD STKGOS ;AND THE OLD "STKGOS" 443 | POP H 444 | SHLD CURRNT ;AND THE OLD "CURRNT" 445 | POP D ;OLD TEXT POINTER 446 | CALL POPA ;OLD "FOR" PARAMETERS 447 | RST 6 ;AND WE ARE BACK HOME 448 | ; 449 | ;************************************************************* 450 | ; 451 | ; *** FOR *** & NEXT *** 452 | ; 453 | ; "FOR" HAS TWO FORMS: 454 | ; "FOR VAR=EXP1 TO EXP2 STEP EXP3" AND "FOR VAR=EXP1 TO EXP2" 455 | ; THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH 456 | ; EXP3=1. (I.E., WITH A STEP OF +1.) 457 | ; TBI WILL FIND THE VARIABLE VAR, AND SET ITS VALUE TO THE 458 | ; CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXP2 AND EXP3 459 | ; AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTER ETC. IN 460 | ; THE "FOR" SAVE AREA, WHICH CONSISTS OF "LOPVAR", "LOPINC", 461 | ; "LOPLMT", "LOPLN", AND "LOPPT". IF THERE IS ALREADY SOME- 462 | ; THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO 463 | ; "LOPVAR"), THEN THE OLD SAVE AREA IS SAVED IN THE STACK 464 | ; BEFORE THE NEW ONE OVERWRITES IT. 465 | ; TBI WILL THEN DIG IN THE STACK AND FIND OUT IF THIS SAME 466 | ; VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE "FOR" LOOP. 467 | ; IF THAT IS THE CASE, THEN THE OLD "FOR" LOOP IS DEACTIVATED. 468 | ; (PURGED FROM THE STACK..) 469 | ; 470 | ; "NEXT VAR" SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL) 471 | ; END OF THE "FOR" LOOP. THE CONTROL VARIABLE VAR. IS CHECKED 472 | ; WITH THE "LOPVAR". IF THEY ARE NOT THE SAME, TBI DIGS IN 473 | ; THE STACK TO FIND THE RIGHT ONE AND PURGES ALL THOSE THAT 474 | ; DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE "STEP" TO 475 | ; THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT. IF IT 476 | ; IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND 477 | ; FOLLOWING THE "FOR". IF OUTSIDE THE LIMIT, THE SAVE AREA 478 | ; IS PURGED AND EXECUTION CONTINUES. 479 | ; 480 | FOR: CALL PUSHA ;SAVE THE OLD SAVE AREA 481 | CALL SETVAL ;SET THE CONTROL VAR. 482 | DCX H ;HL IS ITS ADDRESS 483 | SHLD LOPVAR ;SAVE THAT 484 | LXI H,TAB5-1 ;USE "EXEC" TO LOOK 485 | JMP EXEC ;FOR THE WORD "TO" 486 | FR1: RST 3 ;EVALUATE THE LIMIT 487 | SHLD LOPLMT ;SAVE THAT 488 | LXI H,TAB6-1 ;USE "EXEC" TO LOOK 489 | JMP EXEC ;FOR THE WORD "STEP" 490 | FR2: RST 3 ;FOUND IT, GET STEP 491 | JMP FR4 492 | FR3: LXI H,1H ;NOT FOUND, SET TO 1 493 | FR4: SHLD LOPINC ;SAVE THAT TOO 494 | FR5: LHLD CURRNT ;SAVE CURRENT LINE # 495 | SHLD LOPLN 496 | XCHG ;AND TEXT POINTER 497 | SHLD LOPPT 498 | LXI B,0AH ;DIG INTO STACK TO 499 | LHLD LOPVAR ;FIND "LOPVAR" 500 | XCHG 501 | MOV H,B 502 | MOV L,B ;HL=0 NOW 503 | DAD SP ;HERE IS THE STACK 504 | DB 3EH 505 | FR7: DAD B ;EACH LEVEL IS 10 DEEP 506 | MOV A,M ;GET THAT OLD "LOPVAR" 507 | INX H 508 | ORA M 509 | JZ FR8 ;0 SAYS NO MORE IN IT 510 | MOV A,M 511 | DCX H 512 | CMP D ;SAME AS THIS ONE? 513 | JNZ FR7 514 | MOV A,M ;THE OTHER HALF? 515 | CMP E 516 | JNZ FR7 517 | XCHG ;YES, FOUND ONE 518 | LXI H,0H 519 | DAD SP ;TRY TO MOVE SP 520 | MOV B,H 521 | MOV C,L 522 | LXI H,0AH 523 | DAD D 524 | CALL MVDOWN ;AND PURGE 10 WORDS 525 | SPHL ;IN THE STACK 526 | FR8: LHLD LOPPT ;JOB DONE, RESTORE DE 527 | XCHG 528 | RST 6 ;AND CONTINUE 529 | ; 530 | NEXT: RST 7 ;GET ADDRESS OF VAR. 531 | JC QWHAT ;NO VARIABLE, "WHAT?" 532 | SHLD VARNXT ;YES, SAVE IT 533 | NX0: PUSH D ;SAVE TEXT POINTER 534 | XCHG 535 | LHLD LOPVAR ;GET VAR. IN "FOR" 536 | MOV A,H 537 | ORA L ;0 SAYS NEVER HAD ONE 538 | JZ AWHAT ;SO WE ASK: "WHAT?" 539 | RST 4 ;ELSE WE CHECK THEM 540 | JZ NX3 ;OK, THEY AGREE 541 | POP D ;NO, LET'S SEE 542 | CALL POPA ;PURGE CURRENT LOOP 543 | LHLD VARNXT ;AND POP ONE LEVEL 544 | JMP NX0 ;GO CHECK AGAIN 545 | NX3: MOV E,M ;COME HERE WHEN AGREED 546 | INX H 547 | MOV D,M ;DE=VALUE OF VAR. 548 | LHLD LOPINC 549 | PUSH H 550 | MOV A,H 551 | XRA D 552 | MOV A,D 553 | DAD D ;ADD ONE STEP 554 | JM NX4 555 | XRA H 556 | JM NX5 557 | NX4: XCHG 558 | LHLD LOPVAR ;PUT IT BACK 559 | MOV M,E 560 | INX H 561 | MOV M,D 562 | LHLD LOPLMT ;HL->LIMIT 563 | POP PSW ;OLD HL 564 | ORA A 565 | JP NX1 ;STEP > 0 566 | XCHG ;STEP < 0 567 | NX1: CALL CKHLDE ;COMPARE WITH LIMIT 568 | POP D ;RESTORE TEXT POINTER 569 | JC NX2 ;OUTSIDE LIMIT 570 | LHLD LOPLN ;WITHIN LIMIT, GO 571 | SHLD CURRNT ;BACK TO THE SAVED 572 | LHLD LOPPT ;"CURRNT" AND TEXT 573 | XCHG ;POINTER 574 | RST 6 575 | NX5: POP H 576 | POP D 577 | NX2: CALL POPA ;PURGE THIS LOOP 578 | RST 6 579 | ; 580 | ;************************************************************* 581 | ; 582 | ; *** REM *** IF *** INPUT *** & LET (& DEFLT) *** 583 | ; 584 | ; "REM" CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI. 585 | ; TBI TREATS IT LIKE AN "IF" WITH A FALSE CONDITION. 586 | ; 587 | ; "IF" IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE 588 | ; COMMANDS (INCLUDING OTHER "IF"S) SEPERATED BY SEMI-COLONS. 589 | ; NOTE THAT THE WORD "THEN" IS NOT USED. TBI EVALUATES THE 590 | ; EXPR. IF IT IS NON-ZERO, EXECUTION CONTINUES. IF THE 591 | ; EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND 592 | ; EXECUTION CONTINUES AT THE NEXT LINE. 593 | ; 594 | ; "INPUT" COMMAND IS LIKE THE "PRINT" COMMAND, AND IS FOLLOWED 595 | ; BY A LIST OF ITEMS. IF THE ITEM IS A STRING IN SINGLE OR 596 | ; DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS 597 | ; IN "PRINT". IF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS 598 | ; PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN 599 | ; EXPR. TO BE TYPED IN. THE VARIABLE IS THEN SET TO THE 600 | ; VALUE OF THIS EXPR. IF THE VARIABLE IS PROCEDED BY A STRING 601 | ; (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE 602 | ; PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR. 603 | ; AND SET THE VARIABLE TO THE VALUE OF THE EXPR. 604 | ; 605 | ; IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?", 606 | ; "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT. 607 | ; THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C. 608 | ; THIS IS HANDLED IN "INPERR". 609 | ; 610 | ; "LET" IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS. 611 | ; EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR. 612 | ; TBI EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE. 613 | ; TBI WILL ALSO HANDLE "LET" COMMAND WITHOUT THE WORD "LET". 614 | ; THIS IS DONE BY "DEFLT". 615 | ; 616 | REM: LXI H,0H ;*** REM *** 617 | DB 3EH ;THIS IS LIKE "IF 0" 618 | ; 619 | IFF: RST 3 ;*** IF *** 620 | MOV A,H ;IS THE EXPR.=0? 621 | ORA L 622 | JNZ RUNSML ;NO, CONTINUE 623 | CALL FNDSKP ;YES, SKIP REST OF LINE 624 | JNC RUNTSL ;AND RUN THE NEXT LINE 625 | JMP RSTART ;IF NO NEXT, RE-START 626 | ; 627 | INPERR: LHLD STKINP ;*** INPERR *** 628 | SPHL ;RESTORE OLD SP 629 | POP H ;AND OLD "CURRNT" 630 | SHLD CURRNT 631 | POP D ;AND OLD TEXT POINTER 632 | POP D ;REDO INPUT 633 | ; 634 | INPUT: ;*** INPUT *** 635 | IP1: PUSH D ;SAVE IN CASE OF ERROR 636 | CALL QTSTG ;IS NEXT ITEM A STRING? 637 | JMP IP2 ;NO 638 | RST 7 ;YES, BUT FOLLOWED BY A 639 | JC IP4 ;VARIABLE? NO. 640 | JMP IP3 ;YES. INPUT VARIABLE 641 | IP2: PUSH D ;SAVE FOR "PRTSTG" 642 | RST 7 ;MUST BE VARIABLE NOW 643 | JC QWHAT ;"WHAT?" IT IS NOT? 644 | LDAX D ;GET READY FOR "PRTSTR" 645 | MOV C,A 646 | SUB A 647 | STAX D 648 | POP D 649 | CALL PRTSTG ;PRINT STRING AS PROMPT 650 | MOV A,C ;RESTORE TEXT 651 | DCX D 652 | STAX D 653 | IP3: PUSH D ;SAVE TEXT POINTER 654 | XCHG 655 | LHLD CURRNT ;ALSO SAVE "CURRNT" 656 | PUSH H 657 | LXI H,IP1 ;A NEGATIVE NUMBER 658 | SHLD CURRNT ;AS A FLAG 659 | LXI H,0H ;SAVE SP TOO 660 | DAD SP 661 | SHLD STKINP 662 | PUSH D ;OLD HL 663 | MVI A,3AH ;PRINT THIS TOO 664 | CALL GETLN ;AND GET A LINE 665 | LXI D,BUFFER ;POINTS TO BUFFER 666 | RST 3 ;EVALUATE INPUT 667 | NOP ;CAN BE "CALL ENDCHK" 668 | NOP 669 | NOP 670 | POP D ;OK, GET OLD HL 671 | XCHG 672 | MOV M,E ;SAVE VALUE IN VAR. 673 | INX H 674 | MOV M,D 675 | POP H ;GET OLD "CURRNT" 676 | SHLD CURRNT 677 | POP D ;AND OLD TEXT POINTER 678 | IP4: POP PSW ;PURGE JUNK IN STACK 679 | RST 1 ;IS NEXT CH. ","? 680 | DB "," 681 | DB IP5-$-1 682 | JMP IP1 ;YES, MORE ITEMS. 683 | IP5: RST 6 684 | ; 685 | DEFLT: LDAX D ;*** DEFLT *** 686 | CPI CR ;EMPTY LINE IS OK 687 | JZ LT1 ;ELSE IT IS "LET" 688 | ; 689 | LET: CALL SETVAL ;*** LET *** 690 | RST 1 ;SET VALUE TO VAR. 691 | DB "," 692 | DB LT1-$-1 693 | JMP LET ;ITEM BY ITEM 694 | LT1: RST 6 ;UNTIL FINISH 695 | ; 696 | ;************************************************************* 697 | ; 698 | ; *** EXPR *** 699 | ; 700 | ; "EXPR" EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS. 701 | ; :: 702 | ; 703 | ; WHERE IS ONE OF THE OPERATORS IN TAB8 AND THE 704 | ; RESULT OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE. 705 | ; ::=(+ OR -)(+ OR -)(....) 706 | ; WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS. 707 | ; ::=(* OR />)(....) 708 | ; ::= 709 | ; 710 | ; () 711 | ; IS RECURSIVE SO THAT VARIABLE "@" CAN HAVE AN 712 | ; AS INDEX, FUNCTIONS CAN HAVE AN AS ARGUMENTS, AND 713 | ; CAN BE AN IN PARANTHESE. 714 | ; 715 | ;EXPR: CALL EXPR2 ;THIS IS AT LOC. 18 716 | ; PUSH H ;SAVE VALUE 717 | EXPR1: LXI H,TAB8-1 ;LOOKUP REL.OP. 718 | JMP EXEC ;GO DO IT 719 | XP11: CALL XP18 ;REL.OP.">=" 720 | RC ;NO, RETURN HL=0 721 | MOV L,A ;YES, RETURN HL=1 722 | RET 723 | XP12: CALL XP18 ;REL.OP."#" 724 | RZ ;FALSE, RETURN HL=0 725 | MOV L,A ;TRUE, RETURN HL=1 726 | RET 727 | XP13: CALL XP18 ;REL.OP.">" 728 | RZ ;FALSE 729 | RC ;ALSO FALSE, HL=0 730 | MOV L,A ;TRUE, HL=1 731 | RET 732 | XP14: CALL XP18 ;REL.OP."<=" 733 | MOV L,A ;SET HL=1 734 | RZ ;REL. TRUE, RETURN 735 | RC 736 | MOV L,H ;ELSE SET HL=0 737 | RET 738 | XP15: CALL XP18 ;REL.OP."=" 739 | RNZ ;FALSE, RETURN HL=0 740 | MOV L,A ;ELSE SET HL=1 741 | RET 742 | XP16: CALL XP18 ;REL.OP."<" 743 | RNC ;FALSE, RETURN HL=0 744 | MOV L,A ;ELSE SET HL=1 745 | RET 746 | XP17: POP H ;NOT .REL.OP 747 | RET ;RETURN HL= 748 | XP18: MOV A,C ;SUBROUTINE FOR ALL 749 | POP H ;REL.OP.'S 750 | POP B 751 | PUSH H ;REVERSE TOP OF STACK 752 | PUSH B 753 | MOV C,A 754 | CALL EXPR2 ;GET 2ND 755 | XCHG ;VALUE IN DE NOW 756 | XTHL ;1ST IN HL 757 | CALL CKHLDE ;COMPARE 1ST WITH 2ND 758 | POP D ;RESTORE TEXT POINTER 759 | LXI H,0H ;SET HL=0, A=1 760 | MVI A,1 761 | RET 762 | ; 763 | EXPR2: RST 1 ;NEGATIVE SIGN? 764 | DB "-" 765 | DB XP21-$-1 766 | LXI H,0H ;YES, FAKE "0-" 767 | JMP XP26 ;TREAT LIKE SUBTRACT 768 | XP21: RST 1 ;POSITIVE SIGN? IGNORE 769 | DB "+" 770 | DB XP22-$-1 771 | XP22: CALL EXPR3 ;1ST 772 | XP23: RST 1 ;ADD? 773 | DB "+" 774 | DB XP25-$-1 775 | PUSH H ;YES, SAVE VALUE 776 | CALL EXPR3 ;GET 2ND 777 | XP24: XCHG ;2ND IN DE 778 | XTHL ;1ST IN HL 779 | MOV A,H ;COMPARE SIGN 780 | XRA D 781 | MOV A,D 782 | DAD D 783 | POP D ;RESTORE TEXT POINTER 784 | JM XP23 ;1ST AND 2ND SIGN DIFFER 785 | XRA H ;1ST AND 2ND SIGN EQUAL 786 | JP XP23 ;SO IS RESULT 787 | JMP QHOW ;ELSE WE HAVE OVERFLOW 788 | XP25: RST 1 ;SUBTRACT? 789 | DB "-" 790 | DB XP42-$-1 791 | XP26: PUSH H ;YES, SAVE 1ST 792 | CALL EXPR3 ;GET 2ND 793 | CALL CHGSGN ;NEGATE 794 | JMP XP24 ;AND ADD THEM 795 | ; 796 | EXPR3: CALL EXPR4 ;GET 1ST 797 | XP31: RST 1 ;MULTIPLY? 798 | DB "*" 799 | DB XP34-$-1 800 | PUSH H ;YES, SAVE 1ST 801 | CALL EXPR4 ;AND GET 2ND 802 | MVI B,0H ;CLEAR B FOR SIGN 803 | CALL CHKSGN ;CHECK SIGN 804 | XTHL ;1ST IN HL 805 | CALL CHKSGN ;CHECK SIGN OF 1ST 806 | XCHG 807 | XTHL 808 | MOV A,H ;IS HL > 255 ? 809 | ORA A 810 | JZ XP32 ;NO 811 | MOV A,D ;YES, HOW ABOUT DE 812 | ORA D 813 | XCHG ;PUT SMALLER IN HL 814 | JNZ AHOW ;ALSO >, WILL OVERFLOW 815 | XP32: MOV A,L ;THIS IS DUMB 816 | LXI H,0H ;CLEAR RESULT 817 | ORA A ;ADD AND COUNT 818 | JZ XP35 819 | XP33: DAD D 820 | JC AHOW ;OVERFLOW 821 | DCR A 822 | JNZ XP33 823 | JMP XP35 ;FINISHED 824 | XP34: RST 1 ;DIVIDE? 825 | DB "/" 826 | DB XP42-$-1 827 | PUSH H ;YES, SAVE 1ST 828 | CALL EXPR4 ;AND GET THE SECOND ONE 829 | MVI B,0H ;CLEAR B FOR SIGN 830 | CALL CHKSGN ;CHECK SIGN OF 2ND 831 | XTHL ;GET 1ST IN HL 832 | CALL CHKSGN ;CHECK SIGN OF 1ST 833 | XCHG 834 | XTHL 835 | XCHG 836 | MOV A,D ;DIVIDE BY 0? 837 | ORA E 838 | JZ AHOW ;SAY "HOW?" 839 | PUSH B ;ELSE SAVE SIGN 840 | CALL DIVIDE ;USE SUBROUTINE 841 | MOV H,B ;RESULT IN HL NOW 842 | MOV L,C 843 | POP B ;GET SIGN BACK 844 | XP35: POP D ;AND TEXT POINTER 845 | MOV A,H ;HL MUST BE + 846 | ORA A 847 | JM QHOW ;ELSE IT IS OVERFLOW 848 | MOV A,B 849 | ORA A 850 | CM CHGSGN ;CHANGE SIGN IF NEEDED 851 | JMP XP31 ;LOOK FOR MORE TERMS 852 | ; 853 | EXPR4: LXI H,TAB4-1 ;FIND FUNCTION IN TAB4 854 | JMP EXEC ;AND GO DO IT 855 | XP40: RST 7 ;NO, NOT A FUNCTION 856 | JC XP41 ;NOR A VARIABLE 857 | MOV A,M ;VARIABLE 858 | INX H 859 | MOV H,M ;VALUE IN HL 860 | MOV L,A 861 | RET 862 | XP41: CALL TSTNUM ;OR IS IT A NUMBER 863 | MOV A,B ;# OF DIGIT 864 | ORA A 865 | RNZ ;OK 866 | PARN: RST 1 867 | DB "(" 868 | DB XP43-$-1 869 | RST 3 ;"(EXPR)" 870 | RST 1 871 | DB ")" 872 | DB XP43-$-1 873 | XP42: RET 874 | XP43: JMP QWHAT ;ELSE SAY: "WHAT?" 875 | ; 876 | RND: CALL PARN ;*** RND(EXPR) *** 877 | MOV A,H ;EXPR MUST BE + 878 | ORA A 879 | JM QHOW 880 | ORA L ;AND NON-ZERO 881 | JZ QHOW 882 | PUSH D ;SAVE BOTH 883 | PUSH H 884 | LHLD RANPNT ;GET MEMORY AS RANDOM 885 | LXI D,LSTROM ;NUMBER 886 | RST 4 887 | JC RA1 ;WRAP AROUND IF LAST 888 | LXI H,START 889 | RA1: MOV E,M 890 | INX H 891 | MOV D,M 892 | SHLD RANPNT 893 | POP H 894 | XCHG 895 | PUSH B 896 | CALL DIVIDE ;RND(N)=MOD(M,N)+1 897 | POP B 898 | POP D 899 | INX H 900 | RET 901 | ; 902 | ABS: CALL PARN ;*** ABS(EXPR) *** 903 | DCX D 904 | CALL CHKSGN ;CHECK SIGN 905 | INX D 906 | RET 907 | ; 908 | SIZE: LHLD TXTUNF ;*** SIZE *** 909 | PUSH D ;GET THE NUMBER OF FREE 910 | XCHG ;BYTES BETWEEN "TXTUNF" 911 | LXI H,VARBGN ;AND "VARBGN" 912 | CALL SUBDE 913 | POP D 914 | RET 915 | ; 916 | ;************************************************************* 917 | ; 918 | ; *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE *** 919 | ; 920 | ; "DIVIDE" DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL 921 | ; 922 | ; "SUBDE" SUBSTRACTS DE FROM HL 923 | ; 924 | ; "CHKSGN" CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE 925 | ; SIGN AND FLIP SIGN OF B. 926 | ; 927 | ; "CHGSGN" CHECKS SIGN N OF HL AND B UNCONDITIONALLY. 928 | ; 929 | ; "CKHLDE" CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE 930 | ; ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER 931 | ; CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS. 932 | ; 933 | DIVIDE: PUSH H ;*** DIVIDE *** 934 | MOV L,H ;DIVIDE H BY DE 935 | MVI H,0 936 | CALL DV1 937 | MOV B,C ;SAVE RESULT IN B 938 | MOV A,L ;(REMINDER+L)/DE 939 | POP H 940 | MOV H,A 941 | DV1: MVI C,0FFH ;RESULT IN C 942 | DV2: INR C ;DUMB ROUTINE 943 | CALL SUBDE ;DIVIDE BY SUBTRACT 944 | JNC DV2 ;AND COUNT 945 | DAD D 946 | RET 947 | ; 948 | SUBDE: MOV A,L ;*** SUBDE *** 949 | SUB E ;SUBSTRACT DE FROM 950 | MOV L,A ;HL 951 | MOV A,H 952 | SBB D 953 | MOV H,A 954 | RET 955 | ; 956 | CHKSGN: MOV A,H ;*** CHKSGN *** 957 | ORA A ;CHECK SIGN OF HL 958 | RP ;IF -, CHANGE SIGN 959 | ; 960 | CHGSGN: MOV A,H ;*** CHGSGN *** 961 | ORA L ;*UM* 962 | RZ ;*UM* NOT ON ZERO VALUE 963 | MOV A,H ;*UM* 964 | PUSH PSW 965 | CMA ;CHANGE SIGN OF HL 966 | MOV H,A 967 | MOV A,L 968 | CMA 969 | MOV L,A 970 | INX H 971 | POP PSW 972 | XRA H 973 | JP QHOW 974 | MOV A,B ;AND ALSO FLIP B 975 | XRI 80H 976 | MOV B,A 977 | RET 978 | ; 979 | CKHLDE: MOV A,H 980 | XRA D ;SAME SIGN? 981 | JP CK1 ;YES, COMPARE 982 | XCHG ;NO, XCH AND COMP 983 | CK1: RST 4 984 | RET 985 | ; 986 | ;************************************************************* 987 | ; 988 | ; *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) *** 989 | ; 990 | ; "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND 991 | ; THEN AN EXPR. IT EVALUATES THE EXPR. AND SET THE VARIABLE 992 | ; TO THAT VALUE. 993 | ; 994 | ; "FIN" CHECKS THE END OF A COMMAND. IF IT ENDED WITH ";", 995 | ; EXECUTION CONTINUES. IF IT ENDED WITH A CR, IT FINDS THE 996 | ; NEXT LINE AND CONTINUE FROM THERE. 997 | ; 998 | ; "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS 999 | ; REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.) 1000 | ; 1001 | ; "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR). 1002 | ; IT THEN PRINTS THE LINE POINTED BY "CURRNT" WITH A "?" 1003 | ; INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP 1004 | ; OF THE STACK) POINTS TO. EXECUTION OF TB IS STOPPED 1005 | ; AND TBI IS RESTARTED. HOWEVER, IF "CURRNT" -> ZERO 1006 | ; (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT 1007 | ; PRINTED. AND IF "CURRNT" -> NEGATIVE # (INDICATING "INPUT" 1008 | ; COMMAND), THE INPUT LINE IS NOT PRINTED AND EXECUTION IS 1009 | ; NOT TERMINATED BUT CONTINUED AT "INPERR". 1010 | ; 1011 | ; RELATED TO "ERROR" ARE THE FOLLOWING: 1012 | ; "QWHAT" SAVES TEXT POINTER IN STACK AND GET MESSAGE "WHAT?" 1013 | ; "AWHAT" JUST GET MESSAGE "WHAT?" AND JUMP TO "ERROR". 1014 | ; "QSORRY" AND "ASORRY" DO SAME KIND OF THING. 1015 | ; "AHOW" AND "AHOW" IN THE ZERO PAGE SECTION ALSO DO THIS. 1016 | ; 1017 | SETVAL: RST 7 ;*** SETVAL *** 1018 | JC QWHAT ;"WHAT?" NO VARIABLE 1019 | PUSH H ;SAVE ADDRESS OF VAR. 1020 | RST 1 ;PASS "=" SIGN 1021 | DB "=" 1022 | DB SV1-$-1 1023 | RST 3 ;EVALUATE EXPR. 1024 | MOV B,H ;VALUE IS IN BC NOW 1025 | MOV C,L 1026 | POP H ;GET ADDRESS 1027 | MOV M,C ;SAVE VALUE 1028 | INX H 1029 | MOV M,B 1030 | RET 1031 | SV1: JMP QWHAT ;NO "=" SIGN 1032 | ; 1033 | FIN: RST 1 ;*** FIN *** 1034 | DB 3BH 1035 | DB FI1-$-1 1036 | POP PSW ;";", PURGE RET. ADDR. 1037 | JMP RUNSML ;CONTINUE SAME LINE 1038 | FI1: RST 1 ;NOT ";", IS IT CR? 1039 | DB CR 1040 | DB FI2-$-1 1041 | POP PSW ;YES, PURGE RET. ADDR. 1042 | JMP RUNNXL ;RUN NEXT LINE 1043 | FI2: RET ;ELSE RETURN TO CALLER 1044 | ; 1045 | ENDCHK: RST 5 ;*** ENDCHK *** 1046 | CPI CR ;END WITH CR? 1047 | RZ ;OK, ELSE SAY: "WHAT?" 1048 | ; 1049 | QWHAT: PUSH D ;*** QWHAT *** 1050 | AWHAT: LXI D,WHAT ;*** AWHAT *** 1051 | ERROR: SUB A ;*** ERROR *** 1052 | CALL PRTSTG ;PRINT "WHAT?", "HOW?" 1053 | POP D ;OR "SORRY" 1054 | LDAX D ;SAVE THE CHARACTER 1055 | PUSH PSW ;AT WHERE OLD DE -> 1056 | SUB A ;AND PUT A 0 THERE 1057 | STAX D 1058 | LHLD CURRNT ;GET CURRENT LINE # 1059 | PUSH H 1060 | MOV A,M ;CHECK THE VALUE 1061 | INX H 1062 | ORA M 1063 | POP D 1064 | JZ RSTART ;IF ZERO, JUST RESTART 1065 | MOV A,M ;IF NEGATIVE, 1066 | ORA A 1067 | JM INPERR ;REDO INPUT 1068 | CALL PRTLN ;ELSE PRINT THE LINE 1069 | DCX D ;UPTO WHERE THE 0 IS 1070 | POP PSW ;RESTORE THE CHARACTER 1071 | STAX D 1072 | MVI A,3FH ;PRINT A "?" 1073 | RST 2 1074 | SUB A ;AND THE REST OF THE 1075 | CALL PRTSTG ;LINE 1076 | JMP RSTART ;THEN RESTART 1077 | ; 1078 | QSORRY: PUSH D ;*** QSORRY *** 1079 | ASORRY: LXI D,SORRY ;*** ASORRY *** 1080 | JMP ERROR 1081 | ; 1082 | ;************************************************************* 1083 | ; 1084 | ; *** GETLN *** FNDLN (& FRIENDS) *** 1085 | ; 1086 | ; "GETLN" READS A INPUT LINE INTO "BUFFER". IT FIRST PROMPT 1087 | ; THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS 1088 | ; THE BUFFER AND ECHOS. IT IGNORES LF'S AND NULLS, BUT STILL 1089 | ; ECHOS THEM BACK. RUB-OUT IS USED TO CAUSE IT TO DELETE 1090 | ; THE LAST CHARACTER (IF THERE IS ONE), AND ALT-MOD IS USED TO 1091 | ; CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER. 1092 | ; CR SIGNALS THE END OF A LINE, AND CAUSE "GETLN" TO RETURN. 1093 | ; 1094 | ; "FNDLN" FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE 1095 | ; TEXT SAVE AREA. DE IS USED AS THE TEXT POINTER. IF THE 1096 | ; LINE IS FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE 1097 | ; (I.E., THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z. 1098 | ; IF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE # 1099 | ; IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ. IF 1100 | ; WE REACHED THE END OF TEXT SAVE AREA AND CANNOT FIND THE 1101 | ; LINE, FLAGS ARE C & NZ. 1102 | ; "FNDLN" WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE 1103 | ; AREA TO START THE SEARCH. SOME OTHER ENTRIES OF THIS 1104 | ; ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH. 1105 | ; "FNDLNP" WILL START WITH DE AND SEARCH FOR THE LINE #. 1106 | ; "FNDNXT" WILL BUMP DE BY 2, FIND A CR AND THEN START SEARCH. 1107 | ; "FNDSKP" USE DE TO FIND A CR, AND THEN START SEARCH. 1108 | ; 1109 | GETLN: RST 2 ;*** GETLN *** 1110 | LXI D,BUFFER ;PROMPT AND INIT. 1111 | GL1: CALL CHKIO ;CHECK KEYBOARD 1112 | JZ GL1 ;NO INPUT, WAIT 1113 | CPI 7FH ;DELETE LAST CHARACTER? 1114 | JZ GL3 ;YES 1115 | RST 2 ;INPUT, ECHO BACK 1116 | CPI 0AH ;IGNORE LF 1117 | JZ GL1 1118 | ORA A ;IGNORE NULL 1119 | JZ GL1 1120 | CPI 7DH ;DELETE THE WHOLE LINE? 1121 | JZ GL4 ;YES 1122 | STAX D ;ELSE SAVE INPUT 1123 | INX D ;AND BUMP POINTER 1124 | CPI 0DH ;WAS IT CR? 1125 | RZ ;YES, END OF LINE 1126 | MOV A,E ;ELSE MORE FREE ROOM? 1127 | CPI BUFEND & 0FFH 1128 | JNZ GL1 ;YES, GET NEXT INPUT 1129 | GL3: MOV A,E ;DELETE LAST CHARACTER 1130 | CPI BUFFER & 0FFH ;BUT DO WE HAVE ANY? 1131 | JZ GL4 ;NO, REDO WHOLE LINE 1132 | DCX D ;YES, BACKUP POINTER 1133 | MVI A,5CH ;AND ECHO A BACK-SLASH 1134 | RST 2 1135 | JMP GL1 ;GO GET NEXT INPUT 1136 | GL4: CALL CRLF ;REDO ENTIRE LINE 1137 | MVI A,05EH ;CR, LF AND UP-ARROW 1138 | JMP GETLN 1139 | ; 1140 | FNDLN: MOV A,H ;*** FNDLN *** 1141 | ORA A ;CHECK SIGN OF HL 1142 | JM QHOW ;IT CANNOT BE - 1143 | LXI D,TXTBGN ;INIT TEXT POINTER 1144 | ; 1145 | FNDLP: ;*** FDLNP *** 1146 | FL1: PUSH H ;SAVE LINE # 1147 | LHLD TXTUNF ;CHECK IF WE PASSED END 1148 | DCX H 1149 | RST 4 1150 | POP H ;GET LINE # BACK 1151 | RC ;C,NZ PASSED END 1152 | LDAX D ;WE DID NOT, GET BYTE 1 1153 | SUB L ;IS THIS THE LINE? 1154 | MOV B,A ;COMPARE LOW ORDER 1155 | INX D 1156 | LDAX D ;GET BYTE 2 1157 | SBB H ;COMPARE HIGH ORDER 1158 | JC FL2 ;NO, NOT THERE YET 1159 | DCX D ;ELSE WE EITHER FOUND 1160 | ORA B ;IT, OR IT IS NOT THERE 1161 | RET ;NC,Z:FOUND, NC,NZ:NO 1162 | ; 1163 | FNDNXT: ;*** FNDNXT *** 1164 | INX D ;FIND NEXT LINE 1165 | FL2: INX D ;JUST PASSED BYTE 1 & 2 1166 | ; 1167 | FNDSKP: LDAX D ;*** FNDSKP *** 1168 | CPI CR ;TRY TO FIND CR 1169 | JNZ FL2 ;KEEP LOOKING 1170 | INX D ;FOUND CR, SKIP OVER 1171 | JMP FL1 ;CHECK IF END OF TEXT 1172 | ; 1173 | ;************************************************************* 1174 | ; 1175 | ; *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN *** 1176 | ; 1177 | ; "PRTSTG" PRINTS A STRING POINTED BY DE. IT STOPS PRINTING 1178 | ; AND RETURNS TO CALLER WHEN EITHER A CR IS PRINTED OR WHEN 1179 | ; THE NEXT BYTE IS THE SAME AS WHAT WAS IN A (GIVEN BY THE 1180 | ; CALLER). OLD A IS STORED IN B, OLD B IS LOST. 1181 | ; 1182 | ; "QTSTG" LOOKS FOR A BACK-ARROW, SINGLE QUOTE, OR DOUBLE 1183 | ; QUOTE. IF NONE OF THESE, RETURN TO CALLER. IF BACK-ARROW, 1184 | ; OUTPUT A CR WITHOUT A LF. IF SINGLE OR DOUBLE QUOTE, PRINT 1185 | ; THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE. 1186 | ; AFTER THE PRINTING THE NEXT 3 BYTES OF THE CALLER IS SKIPPED 1187 | ; OVER (USUALLY A JUMP INSTRUCTION. 1188 | ; 1189 | ; "PRTNUM" PRINTS THE NUMBER IN HL. LEADING BLANKS ARE ADDED 1190 | ; IF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C. 1191 | ; HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN 1192 | ; C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO 1193 | ; PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT. 1194 | ; 1195 | ; "PRTLN" PRINTS A SAVED TEXT LINE WITH LINE # AND ALL. 1196 | ; 1197 | PRTSTG: MOV B,A ;*** PRTSTG *** 1198 | PS1: LDAX D ;GET A CHARACTER 1199 | INX D ;BUMP POINTER 1200 | CMP B ;SAME AS OLD A? 1201 | RZ ;YES, RETURN 1202 | RST 2 ;ELSE PRINT IT 1203 | CPI CR ;WAS IT A CR? 1204 | JNZ PS1 ;NO, NEXT 1205 | RET ;YES, RETURN 1206 | ; 1207 | QTSTG: RST 1 ;*** QTSTG *** 1208 | DB 022h ;""" 1209 | DB QT3-$-1 1210 | MVI A,22H ;IT IS A " 1211 | QT1: CALL PRTSTG ;PRINT UNTIL ANOTHER 1212 | CPI CR ;WAS LAST ONE A CR? 1213 | POP H ;RETURN ADDRESS 1214 | JZ RUNNXL ;WAS CR, RUN NEXT LINE 1215 | QT2: INX H ;SKIP 3 BYTES ON RETURN 1216 | INX H 1217 | INX H 1218 | PCHL ;RETURN 1219 | QT3: RST 1 ;IS IT A '? 1220 | DB 27H 1221 | DB QT4-$-1 1222 | MVI A,27H ;YES, DO THE SAME 1223 | JMP QT1 ;AS IN " 1224 | QT4: RST 1 ;IS IT BACK-ARROW? 1225 | DB 5FH 1226 | DB QT5-$-1 1227 | MVI A,08DH ;YES, CR WITHOUT LF 1228 | RST 2 ;DO IT TWICE TO GIVE 1229 | RST 2 ;TTY ENOUGH TIME 1230 | POP H ;RETURN ADDRESS 1231 | JMP QT2 1232 | QT5: RET ;NONE OF ABOVE 1233 | ; 1234 | PRTNUM: MVI B,0 ;*** PRTNUM *** 1235 | CALL CHKSGN ;CHECK SIGN 1236 | JP PN1 ;NO SIGN 1237 | MVI B,"-" ;B=SIGN 1238 | DCR C ;"-" TAKES SPACE 1239 | PN1: PUSH D ;SAVE 1240 | LXI D,0AH ;DECIMAL 1241 | PUSH D ;SAVE AS A FLAG 1242 | DCR C ;C=SPACES 1243 | PUSH B ;SAVE SIGN & SPACE 1244 | PN2: CALL DIVIDE ;DIVIDE HL BY 10 1245 | MOV A,B ;RESULT 0? 1246 | ORA C 1247 | JZ PN3 ;YES, WE GOT ALL 1248 | XTHL ;NO, SAVE REMAINDER 1249 | DCR L ;AND COUNT SPACE 1250 | PUSH H ;HL IS OLD BC 1251 | MOV H,B ;MOVE RESULT TO BC 1252 | MOV L,C 1253 | JMP PN2 ;AND DIVIDE BY 10 1254 | PN3: POP B ;WE GOT ALL DIGITS IN 1255 | PN4: DCR C ;THE STACK 1256 | MOV A,C ;LOOK AT SPACE COUNT 1257 | ORA A 1258 | JM PN5 ;NO LEADING BLANKS 1259 | MVI A,20H ;LEADING BLANKS 1260 | RST 2 1261 | JMP PN4 ;MORE? 1262 | PN5: MOV A,B ;PRINT SIGN 1263 | ORA A 1264 | CNZ 10H 1265 | MOV E,L ;LAST REMAINDER IN E 1266 | PN6: MOV A,E ;CHECK DIGIT IN E 1267 | CPI 0AH ;10 IS FLAG FOR NO MORE 1268 | POP D 1269 | RZ ;IF SO, RETURN 1270 | ADI 30H ;ELSE CONVERT TO ASCII 1271 | RST 2 ;AND PRINT THE DIGIT 1272 | JMP PN6 ;GO BACK FOR MORE 1273 | ; 1274 | PRTLN: LDAX D ;*** PRTLN *** 1275 | MOV L,A ;LOW ORDER LINE # 1276 | INX D 1277 | LDAX D ;HIGH ORDER 1278 | MOV H,A 1279 | INX D 1280 | MVI C,4H ;PRINT 4 DIGIT LINE # 1281 | CALL PRTNUM 1282 | MVI A,20H ;FOLLOWED BY A BLANK 1283 | RST 2 1284 | SUB A ;AND THEN THE NEXT 1285 | CALL PRTSTG 1286 | RET 1287 | ; 1288 | ;************************************************************* 1289 | ; 1290 | ; *** MVUP *** MVDOWN *** POPA *** & PUSHA *** 1291 | ; 1292 | ; "MVUP" MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC-> UNTIL 1293 | ; DE = HL 1294 | ; 1295 | ; "MVDOWN" MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL-> 1296 | ; UNTIL DE = BC 1297 | ; 1298 | ; "POPA" RESTORES THE "FOR" LOOP VARIABLE SAVE AREA FROM THE 1299 | ; STACK 1300 | ; 1301 | ; "PUSHA" STACKS THE "FOR" LOOP VARIABLE SAVE AREA INTO THE 1302 | ; STACK 1303 | ; 1304 | MVUP: RST 4 ;*** MVUP *** 1305 | RZ ;DE = HL, RETURN 1306 | LDAX D ;GET ONE BYTE 1307 | STAX B ;MOVE IT 1308 | INX D ;INCREASE BOTH POINTERS 1309 | INX B 1310 | JMP MVUP ;UNTIL DONE 1311 | ; 1312 | MVDOWN: MOV A,B ;*** MVDOWN *** 1313 | SUB D ;TEST IF DE = BC 1314 | JNZ MD1 ;NO, GO MOVE 1315 | MOV A,C ;MAYBE, OTHER BYTE? 1316 | SUB E 1317 | RZ ;YES, RETURN 1318 | MD1: DCX D ;ELSE MOVE A BYTE 1319 | DCX H ;BUT FIRST DECREASE 1320 | LDAX D ;BOTH POINTERS AND 1321 | MOV M,A ;THEN DO IT 1322 | JMP MVDOWN ;LOOP BACK 1323 | ; 1324 | POPA: POP B ;BC = RETURN ADDR. 1325 | POP H ;RESTORE LOPVAR, BUT 1326 | SHLD LOPVAR ;=0 MEANS NO MORE 1327 | MOV A,H 1328 | ORA L 1329 | JZ PP1 ;YEP, GO RETURN 1330 | POP H ;NOP, RESTORE OTHERS 1331 | SHLD LOPINC 1332 | POP H 1333 | SHLD LOPLMT 1334 | POP H 1335 | SHLD LOPLN 1336 | POP H 1337 | SHLD LOPPT 1338 | PP1: PUSH B ;BC = RETURN ADDR. 1339 | RET 1340 | ; 1341 | PUSHA: LXI H,STKLMT ;*** PUSHA *** 1342 | CALL CHGSGN 1343 | POP B ;BC=RETURN ADDRESS 1344 | DAD SP ;IS STACK NEAR THE TOP? 1345 | JNC QSORRY ;YES, SORRY FOR THAT 1346 | LHLD LOPVAR ;ELSE SAVE LOOP VAR'S 1347 | MOV A,H ;BUT IF LOPVAR IS 0 1348 | ORA L ;THAT WILL BE ALL 1349 | JZ PU1 1350 | LHLD LOPPT ;ELSE, MORE TO SAVE 1351 | PUSH H 1352 | LHLD LOPLN 1353 | PUSH H 1354 | LHLD LOPLMT 1355 | PUSH H 1356 | LHLD LOPINC 1357 | PUSH H 1358 | LHLD LOPVAR 1359 | PU1: PUSH H 1360 | PUSH B ;BC = RETURN ADDR. 1361 | RET 1362 | ; 1363 | ;************************************************************* 1364 | ; 1365 | ; *** OUTC *** & CHKIO *** 1366 | ; 1367 | ; THESE ARE THE ONLY I/O ROUTINES IN TBI. 1368 | ; "OUTC" IS CONTROLLED BY A SOFTWARE SWITCH "OCSW". IF OCSW=0 1369 | ; "OUTC" WILL JUST RETURN TO THE CALLER. IF OCSW IS NOT 0, 1370 | ; IT WILL OUTPUT THE BYTE IN A. IF THAT IS A CR, A LF IS ALSO 1371 | ; SEND OUT. ONLY THE FLAGS MAY BE CHANGED AT RETURN. ALL REG. 1372 | ; ARE RESTORED. 1373 | ; 1374 | ; "CHKIO" CHECKS THE INPUT. IF NO INPUT, IT WILL RETURN TO 1375 | ; THE CALLER WITH THE Z FLAG SET. IF THERE IS INPUT, Z FLAG 1376 | ; IS CLEARED AND THE INPUT BYTE IS IN A. HOWEVER, IF THE 1377 | ; INPUT IS A CONTROL-O, THE "OCSW" SWITCH IS COMPLIMENTED, AND 1378 | ; Z FLAG IS RETURNED. IF A CONTROL-C IS READ, "CHKIO" WILL 1379 | ; RESTART TBI AND DO NOT RETURN TO THE CALLER. 1380 | ; 1381 | ;OUTC: PUSH PSW ;THIS IS AT LOC. 10 1382 | ; LDA OCSW ;CHECK SOFTWARE SWITCH 1383 | ; ORA A 1384 | INIT: STA OCSW 1385 | MVI A,3 ;RESET ACIA 1386 | OUT ACIA_CTRL 1387 | MVI A,15H ;15H FOR 8N1, 11H FOR 8N2 1388 | OUT ACIA_CTRL 1389 | MVI D,19H 1390 | PATLOP: 1391 | CALL CRLF 1392 | DCR D 1393 | JNZ PATLOP 1394 | SUB A 1395 | LXI D,MSG1 1396 | CALL PRTSTG 1397 | LXI H,START 1398 | SHLD RANPNT 1399 | LXI H,TXTBGN 1400 | SHLD TXTUNF 1401 | JMP RSTART 1402 | OC2: JNZ OC3 ;IT IS ON 1403 | POP PSW ;IT IS OFF 1404 | RET ;RESTORE AF AND RETURN 1405 | OC3: IN ACIA_CTRL ;COME HERE TO DO OUTPUT 1406 | ANI 2H ;STATUS BIT 1407 | JZ OC3 ;NOT READY, WAIT 1408 | POP PSW ;READY, GET OLD A BACK 1409 | OUT ACIA_DATA ;AND SEND IT OUT 1410 | CPI CR ;WAS IT CR? 1411 | RNZ ;NO, FINISHED 1412 | MVI A,LF ;YES, WE SEND LF TOO 1413 | RST 2 ;THIS IS RECURSIVE 1414 | MVI A,CR ;GET CR BACK IN A 1415 | RET 1416 | ; 1417 | ;CHKIO: IN ACIA_CTRL ;*** CHKIO *** 1418 | ; NOP ;STATUS BIT FLIPPED? 1419 | ; ANI 1H ;MASK STATUS BIT 1420 | ; RZ ;NOT READY, RETURN "Z" 1421 | ; IN ACIA_DATA ;READY, READ DATA 1422 | ; ANI 7FH ;MASK BIT 7 OFF 1423 | ; CPI 0FH ;IS IT CONTROL-O? 1424 | ; JNZ CI1 ;NO, MORE CHECKING 1425 | ; LDA OCSW ;CONTROL-O FLIPS OCSW 1426 | ; CMA ;ON TO OFF, OFF TO ON 1427 | ; STA OCSW 1428 | ; JMP CHKIO ;GET ANOTHER INPUT 1429 | ;CI1: CPI 3H ;IS IT CONTROL-C? 1430 | ; RNZ ;NO, RETURN "NZ" 1431 | ; JMP RSTART ;YES, RESTART TBI 1432 | ; the problem you are mention is caused by terminal. My terminal sends 08h for backspace and 1Bh for Escape. TINY BASIC takes 7Fh for backspace (RUB-OUT) and 7Dh for delete line. 1433 | 1434 | ;It is possible to change those constants at lines 1113 and 1120 (from 7Fh to 08h, from 7Dh to 1Bh), or update the CHKIO routine in the way I attached below. 1435 | 1436 | ;Caution! When you press the backspace key, TINY BASIC enter the backslash character. It is not a bug, it is a desired behavior (I guess it's for old printer terminals / teletype, which can not "delete a character"). So you will end with: 1437 | 1438 | ;PRIM\NT "HELLO" 1439 | 1440 | ;It is ugly, but it works! :) 1441 | 1442 | ;Regards, Martin 1443 | CHKIO: IN ACIA_CTRL ;*** CHKIO *** 1444 | NOP ;STATUS BIT FLIPPED? 1445 | ANI 1H ;MASK STATUS BIT 1446 | RZ ;NOT READY, RETURN "Z" 1447 | IN ACIA_DATA ;READY, READ DATA 1448 | ANI 7FH ;MASK BIT 7 OFF 1449 | CPI 08H ;MM: IS IT A BACKSPACE? 1450 | JZ CIRUB 1451 | CPI 1BH ;MM: IS IT AN ESCAPE? 1452 | JZ CIESC 1453 | CPI 0FH ;IS IT CONTROL-O? 1454 | JNZ CI1 ;NO, MORE CHECKING 1455 | LDA OCSW ;CONTROL-O FLIPS OCSW 1456 | CMA ;ON TO OFF, OFF TO ON 1457 | STA OCSW 1458 | JMP CHKIO ;GET ANOTHER INPUT 1459 | CI1: CPI 3H ;IS IT CONTROL-C? 1460 | RNZ ;NO, RETURN "NZ" 1461 | JMP RSTART ;YES, RESTART TBI 1462 | CIRUB: MVI A,7Fh ;RUBOUT 1463 | JMP CI1 1464 | CIESC: MVI A,7Dh ;DELETE LINE 1465 | JMP CI1 1466 | MSG1: DB "TINY " 1467 | DB "BASIC" 1468 | DB CR 1469 | ; 1470 | ;************************************************************* 1471 | ; 1472 | ; *** TABLES *** DIRECT *** & EXEC *** 1473 | ; 1474 | ; THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE. 1475 | ; WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION 1476 | ; OF CODE ACCORDING TO THE TABLE. 1477 | ; 1478 | ; AT "EXEC", DE SHOULD POINT TO THE STRING AND HL SHOULD POINT 1479 | ; TO THE TABLE-1. AT "DIRECT", DE SHOULD POINT TO THE STRING. 1480 | ; HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF 1481 | ; ALL DIRECT AND STATEMENT COMMANDS. 1482 | ; 1483 | ; A "." IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL 1484 | ; MATCH WILL BE CONSIDERED AS A MATCH. E.G., "P.", "PR.", 1485 | ; "PRI.", "PRIN.", OR "PRINT" WILL ALL MATCH "PRINT". 1486 | ; 1487 | ; THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM 1488 | ; IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND 1489 | ; A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH 1490 | ; BYTE SET TO 1. 1491 | ; 1492 | ; END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE 1493 | ; STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL 1494 | ; MATCH THIS NULL ITEM AS DEFAULT. 1495 | ; 1496 | TAB1: ;DIRECT COMMANDS 1497 | DB "LIST" 1498 | DWA LIST 1499 | DB "RUN" 1500 | DWA RUN 1501 | DB "NEW" 1502 | DWA NEW 1503 | ; 1504 | TAB2: ;DIRECT/STATEMENT 1505 | DB "NEXT" 1506 | DWA NEXT 1507 | DB "LET" 1508 | DWA LET 1509 | DB "IF" 1510 | DWA IFF 1511 | DB "GOTO" 1512 | DWA GOTO 1513 | DB "GOSUB" 1514 | DWA GOSUB 1515 | DB "RETURN" 1516 | DWA RETURN 1517 | DB "REM" 1518 | DWA REM 1519 | DB "FOR" 1520 | DWA FOR 1521 | DB "INPUT" 1522 | DWA INPUT 1523 | DB "PRINT" 1524 | DWA PRINT 1525 | DB "STOP" 1526 | DWA STOP 1527 | DWA DEFLT 1528 | ; 1529 | TAB4: ;FUNCTIONS 1530 | DB "RND" 1531 | DWA RND 1532 | DB "ABS" 1533 | DWA ABS 1534 | DB "SIZE" 1535 | DWA SIZE 1536 | DWA XP40 1537 | ; 1538 | TAB5: ;"TO" IN "FOR" 1539 | DB "TO" 1540 | DWA FR1 1541 | DWA QWHAT 1542 | ; 1543 | TAB6: ;"STEP" IN "FOR" 1544 | DB "STEP" 1545 | DWA FR2 1546 | DWA FR3 1547 | ; 1548 | TAB8: ;RELATION OPERATORS 1549 | DB ">=" 1550 | DWA XP11 1551 | DB "#" 1552 | DWA XP12 1553 | DB ">" 1554 | DWA XP13 1555 | DB "=" 1556 | DWA XP15 1557 | DB "<=" 1558 | DWA XP14 1559 | DB "<" 1560 | DWA XP16 1561 | DWA XP17 1562 | ; 1563 | DIRECT: LXI H,TAB1-1 ;*** DIRECT *** 1564 | ; 1565 | EXEC: ;*** EXEC *** 1566 | EX0: RST 5 ;IGNORE LEADING BLANKS 1567 | PUSH D ;SAVE POINTER 1568 | EX1: LDAX D ;IF FOUND "." IN STRING 1569 | INX D ;BEFORE ANY MISMATCH 1570 | CPI 2EH ;WE DECLARE A MATCH 1571 | JZ EX3 1572 | INX H ;HL->TABLE 1573 | CMP M ;IF MATCH, TEST NEXT 1574 | JZ EX1 1575 | MVI A,07FH ;ELSE SEE IF BIT 7 1576 | DCX D ;OF TABLE IS SET, WHICH 1577 | CMP M ;IS THE JUMP ADDR. (HI) 1578 | JC EX5 ;C:YES, MATCHED 1579 | EX2: INX H ;NC:NO, FIND JUMP ADDR. 1580 | CMP M 1581 | JNC EX2 1582 | INX H ;BUMP TO NEXT TAB. ITEM 1583 | POP D ;RESTORE STRING POINTER 1584 | JMP EX0 ;TEST AGAINST NEXT ITEM 1585 | EX3: MVI A,07FH ;PARTIAL MATCH, FIND 1586 | EX4: INX H ;JUMP ADDR., WHICH IS 1587 | CMP M ;FLAGGED BY BIT 7 1588 | JNC EX4 1589 | EX5: MOV A,M ;LOAD HL WITH THE JUMP 1590 | INX H ;ADDRESS FROM THE TABLE 1591 | MOV L,M 1592 | ANI 7FH ;MASK OFF BIT 7 1593 | MOV H,A 1594 | POP PSW ;CLEAN UP THE GABAGE 1595 | PCHL ;AND WE GO DO IT 1596 | ; 1597 | LSTROM: ;ALL ABOVE CAN BE ROM 1598 | ; ORG 1000H ;HERE DOWN MUST BE RAM 1599 | .ORG 0800H 1600 | OCSW: DS 1 ;SWITCH FOR OUTPUT 1601 | CURRNT: DS 2 ;POINTS TO CURRENT LINE 1602 | STKGOS: DS 2 ;SAVES SP IN "GOSUB" 1603 | VARNXT: DS 2 ;TEMP STORAGE 1604 | STKINP: DS 2 ;SAVES SP IN "INPUT" 1605 | LOPVAR: DS 2 ;"FOR" LOOP SAVE AREA 1606 | LOPINC: DS 2 ;INCREMENT 1607 | LOPLMT: DS 2 ;LIMIT 1608 | LOPLN: DS 2 ;LINE NUMBER 1609 | LOPPT: DS 2 ;TEXT POINTER 1610 | RANPNT: DS 2 ;RANDOM NUMBER POINTER 1611 | TXTUNF: DS 2 ;->UNFILLED TEXT AREA 1612 | TXTBGN: DS 2 ;TEXT SAVE AREA BEGINS 1613 | ; ORG 1366H 1614 | .ORG 1F00H 1615 | TXTEND: DS 0 ;TEXT SAVE AREA ENDS 1616 | VARBGN: DS 55 ;VARIABLE @(0) 1617 | BUFFER: DS 64 ;INPUT BUFFER 1618 | BUFEND: DS 1 ;BUFFER ENDS 1619 | STKLMT: DS 1 ;TOP LIMIT FOR STACK 1620 | ; ORG 1400H 1621 | .ORG 2000H 1622 | STACK: DS 0 ;STACK STARTS HERE 1623 | ; 1624 | CR EQU 0DH 1625 | LF EQU 0AH 1626 | ; 1627 | END 1628 | -------------------------------------------------------------------------------- /PATB.emu: -------------------------------------------------------------------------------- 1 | cpu I8080 2 | 3 | 4 | memory.ram.from 0x0800 5 | memory.ram.to 0x4000 6 | memory.rom.from 0x0000 7 | memory.rom.to 0x07ff 8 | 9 | serial simple 10 | serial.in 17 11 | serial.out 17 12 | serial.status 16 13 | serial.status.available 0x01 14 | serial.status.ready 0x02 15 | 16 | terminal.caps 1 17 | --------------------------------------------------------------------------------