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