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