11 2 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3+ 13:28 11/10/2019 4+ PAGE 1 5 6 7 8 ;************************************************************* 9 ; 10 ; TINY BASIC FOR INTEL 8080 11 ; VERSION 2.0 12 ; BY LI-CHEN WANG 13 ; MODIFIED AND TRANSLATED 14 ; TO INTEL MNEMONICS 15 ; BY ROGER RAUSKOLB 16 ; 10 OCTOBER,1976 17 ; @COPYLEFT 18 ; ALL WRONGS RESERVED 19 ; 20 ; ADDED FIX FOR BUGGY CHGSGN 21 ; UDO MUNK, 10 DECEMBER 2019 22 ;************************************************************* 23 ; 24 ; *** ZERO PAGE SUBROUTINES *** 25 ; 26 ; THE 8080 INSTRUCTION SET LETS YOU HAVE 8 ROUTINES IN LOW 27 ; MEMORY THAT MAY BE CALLED BY RST N, N BEING 0 THROUGH 7. 28 ; THIS IS A ONE BYTE INSTRUCTION AND HAS THE SAME POWER AS 29 ; THE THREE BYTE INSTRUCTION CALL LLHH. TINY BASIC WILL 30 ; USE RST 0 AS START AND RST 1 THROUGH RST 7 FOR 31 ; THE SEVEN MOST FREQUENTLY USED SUBROUTINES. 32 ; TWO OTHER SUBROUTINES (CRLF AND TSTNUM) ARE ALSO IN THIS 33 ; SECTION. THEY CAN BE REACHED ONLY BY 3-BYTE CALLS. 34 ; 35 DWA MACRO WHERE 36 1 DB (WHERE SHR 8) + 128 37 1 DB WHERE AND 0FFH 38 ENDM 39 ; 40 0000 ORG 0H 41 0000 310020 START: LXI SP,STACK ;*** COLD START *** 42 0003 3EFF MVI A,0FFH 43 0005 C34506 JMP INIT 44 ; 45 0008 E3 XTHL ;*** TSTC OR RST 1 *** 46 0009 EF RST 5 ;IGNORE BLANKS AND 47 000A BE CMP M ;TEST CHARACTER 48 000B C36800 JMP TC1 ;REST OF THIS IS AT TC1 49 ; 50 000E 3E0D CRLF: MVI A,CR ;*** CRLF *** 51 ; 52 0010 F5 PUSH PSW ;*** OUTC OR RST 2 *** 53 0011 3A0008 LDA OCSW ;PRINT CHARACTER ONLY 54 0014 B7 ORA A ;IF OCSW SWITCH IS ON 55 0015 C36F06 JMP OC2 ;REST OF THIS IS AT OC2 56 ; 57 0018 CD7103 CALL EXPR2 ;*** EXPR OR RST 3 *** 58 001B E5 PUSH H ;EVALUATE AN EXPRESSION 591 60 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 61+ 13:28 11/10/2019 62+ PAGE 2 63 64 65 66 001C C32D03 JMP EXPR1 ;REST OF IT AT EXPR1 67 001F 57 DB 'W' 68 ; 69 0020 7C MOV A,H ;*** COMP OR RST 4 *** 70 0021 BA CMP D ;COMPARE HL WITH DE 71 0022 C0 RNZ ;RETURN CORRECT C AND 72 0023 7D MOV A,L ;Z FLAGS 73 0024 BB CMP E ;BUT OLD A IS LOST 74 0025 C9 RET 75 0026 414E DB 'AN' 76 ; 77 0028 1A SS1: LDAX D ;*** IGNBLK/RST 5 *** 78 0029 FE20 CPI 20H ;IGNORE BLANKS 79 002B C0 RNZ ;IN TEXT (WHERE DE->) 80 002C 13 INX D ;AND RETURN THE FIRST 81 002D C32800 JMP SS1 ;NON-BLANK CHAR. IN A 82 ; 83 0030 F1 POP PSW ;*** FINISH/RST 6 *** 84 0031 CDB604 CALL FIN ;CHECK END OF COMMAND 85 0034 C3C904 JMP QWHAT ;PRINT "WHAT?" IF WRONG 86 0037 47 DB 'G' 87 ; 88 0038 EF RST 5 ;*** TSTV OR RST 7 *** 89 0039 D640 SUI 40H ;TEST VARIABLES 90 003B D8 RC ;C:NOT A VARIABLE 91 003C C25800 JNZ TV1 ;NOT "@" ARRAY 92 003F 13 INX D ;IT IS THE "@" ARRAY 93 0040 CD1A04 CALL PARN ;@ SHOULD BE FOLLOWED 94 0043 29 DAD H ;BY (EXPR) AS ITS INDEX 95 0044 DA9F00 JC QHOW ;IS INDEX TOO BIG? 96 0047 D5 PUSH D ;WILL IT OVERWRITE 97 0048 EB XCHG ;TEXT? 98 0049 CD5904 CALL SIZE ;FIND SIZE OF FREE 99 004C E7 RST 4 ;AND CHECK THAT 100 004D DAF704 JC ASORRY ;IF SO, SAY "SORRY" 101 0050 21001F LXI H,VARBGN ;IF NOT GET ADDRESS 102 0053 CD7C04 CALL SUBDE ;OF @(EXPR) AND PUT IT 103 0056 D1 POP D ;IN HL 104 0057 C9 RET ;C FLAG IS CLEARED 105 0058 FE1B TV1: CPI 1BH ;NOT @, IS IT A TO Z? 106 005A 3F CMC ;IF NOT RETURN C FLAG 107 005B D8 RC 108 005C 13 INX D ;IF A THROUGH Z 109 005D 21001F LXI H,VARBGN ;COMPUTE ADDRESS OF 110 0060 07 RLC ;THAT VARIABLE 111 0061 85 ADD L ;AND RETURN IT IN HL 112 0062 6F MOV L,A ;WITH C FLAG CLEARED 113 0063 3E00 MVI A,0 114 0065 8C ADC H 115 0066 67 MOV H,A 116 0067 C9 RET 1171 118 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 119+ 13:28 11/10/2019 120+ PAGE 3 121 122 123 124 ; 125 ;TSTC: XTHL ;*** TSTC OR RST 1 *** 126 ; RST 5 ;THIS IS AT LOC. 8 127 ; CMP M ;AND THEN JUMP HERE 128 0068 23 TC1: INX H ;COMPARE THE BYTE THAT 129 0069 CA7300 JZ TC2 ;FOLLOWS THE RST INST. 130 006C C5 PUSH B ;WITH THE TEXT (DE->) 131 006D 4E MOV C,M ;IF NOT =, ADD THE 2ND 132 006E 0600 MVI B,0 ;BYTE THAT FOLLOWS THE 133 0070 09 DAD B ;RST TO THE OLD PC 134 0071 C1 POP B ;I.E., DO A RELATIVE 135 0072 1B DCX D ;JUMP IF NOT = 136 0073 13 TC2: INX D ;IF =, SKIP THOSE BYTES 137 0074 23 INX H ;AND CONTINUE 138 0075 E3 XTHL 139 0076 C9 RET 140 ; 141 0077 210000 TSTNUM: LXI H,0 ;*** TSTNUM *** 142 007A 44 MOV B,H ;TEST IF THE TEXT IS 143 007B EF RST 5 ;A NUMBER 144 007C FE30 TN1: CPI 30H ;IF NOT, RETURN 0 IN 145 007E D8 RC ;B AND HL 146 007F FE3A CPI 3AH ;IF NUMBERS, CONVERT 147 0081 D0 RNC ;TO BINARY IN HL AND 148 0082 3EF0 MVI A,0F0H ;SET B TO # OF DIGITS 149 0084 A4 ANA H ;IF H>255, THERE IS NO 150 0085 C29F00 JNZ QHOW ;ROOM FOR NEXT DIGIT 151 0088 04 INR B ;B COUNTS # OF DIGITS 152 0089 C5 PUSH B 153 008A 44 MOV B,H ;HL=10*HL+(NEW DIGIT) 154 008B 4D MOV C,L 155 008C 29 DAD H ;WHERE 10* IS DONE BY 156 008D 29 DAD H ;SHIFT AND ADD 157 008E 09 DAD B 158 008F 29 DAD H 159 0090 1A LDAX D ;AND (DIGIT) IS FROM 160 0091 13 INX D ;STRIPPING THE ASCII 161 0092 E60F ANI 0FH ;CODE 162 0094 85 ADD L 163 0095 6F MOV L,A 164 0096 3E00 MVI A,0 165 0098 8C ADC H 166 0099 67 MOV H,A 167 009A C1 POP B 168 009B 1A LDAX D ;DO THIS DIGIT AFTER 169 009C F27C00 JP TN1 ;DIGIT. S SAYS OVERFLOW 170 009F D5 QHOW: PUSH D ;*** ERROR "HOW?" *** 171 00A0 11A600 AHOW: LXI D,HOW 172 00A3 C3CD04 JMP ERROR 173 00A6 484F573F HOW: DB 'HOW?' 174 00AA 0D DB CR 1751 176 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 177+ 13:28 11/10/2019 178+ PAGE 4 179 180 181 182 00AB 4F4B OK: DB 'OK' 183 00AD 0D DB CR 184 00AE 57484154 WHAT: DB 'WHAT?' 185 00B2 3F 186 00B3 0D DB CR 187 00B4 534F5252 SORRY: DB 'SORRY' 188 00B8 59 189 00B9 0D DB CR 190 ; 191 ;************************************************************* 192 ; 193 ; *** MAIN *** 194 ; 195 ; THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM 196 ; AND STORES IT IN THE MEMORY. 197 ; 198 ; AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE 199 ; STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS 200 ; ">" AND READS A LINE. IF THE LINE STARTS WITH A NON-ZERO 201 ; NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER 202 ; (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR) 203 ; IS STORED IN THE MEMORY. IF A LINE WITH THE SAME LINE 204 ; NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW ONE. IF 205 ; THE REST OF THE LINE CONSISTS OF A CR ONLY, IT IS NOT STORED 206 ; AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED. 207 ; 208 ; AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM 209 ; LOOPS BACK AND ASKS FOR ANOTHER LINE. THIS LOOP WILL BE 210 ; TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE 211 ; NUMBER; AND CONTROL IS TRANSFERED TO "DIRECT". 212 ; 213 ; TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION 214 ; LABELED "TXTBGN" AND ENDS AT "TXTEND". WE ALWAYS FILL THIS 215 ; AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED 216 ; BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF". 217 ; 218 ; THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER 219 ; THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN 220 ; THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND 221 ; (SEE NEXT SECTION). "CURRNT" SHOULD POINT TO A 0. 222 ; 223 00BA 310020 RSTART: LXI SP,STACK 224 00BD CD0E00 ST1: CALL CRLF ;AND JUMP TO HERE 225 00C0 11AB00 LXI D,OK ;DE->STRING 226 00C3 97 SUB A ;A=0 227 00C4 CD6305 CALL PRTSTG ;PRINT STRING UNTIL CR 228 00C7 21CE00 LXI H,ST2+1 ;LITERAL 0 229 00CA 220108 SHLD CURRNT ;CURRENT->LINE # = 0 230 00CD 210000 ST2: LXI H,0 231 00D0 220908 SHLD LOPVAR 232 00D3 220308 SHLD STKGOS 2331 234 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 235+ 13:28 11/10/2019 236+ PAGE 5 237 238 239 240 00D6 3E3E ST3: MVI A,3EH ;PROMPT '>' AND 241 00D8 CDFD04 CALL GETLN ;READ A LINE 242 00DB D5 PUSH D ;DE->END OF LINE 243 00DC 11371F LXI D,BUFFER ;DE->BEGINNING OF LINE 244 00DF CD7700 CALL TSTNUM ;TEST IF IT IS A NUMBER 245 00E2 EF RST 5 246 00E3 7C MOV A,H ;HL=VALUE OF THE # OR 247 00E4 B5 ORA L ;0 IF NO # WAS FOUND 248 00E5 C1 POP B ;BC->END OF LINE 249 00E6 CA3B07 JZ DIRECT 250 00E9 1B DCX D ;BACKUP DE AND SAVE 251 00EA 7C MOV A,H ;VALUE OF LINE # THERE 252 00EB 12 STAX D 253 00EC 1B DCX D 254 00ED 7D MOV A,L 255 00EE 12 STAX D 256 00EF C5 PUSH B ;BC,DE->BEGIN, END 257 00F0 D5 PUSH D 258 00F1 79 MOV A,C 259 00F2 93 SUB E 260 00F3 F5 PUSH PSW ;A=# OF BYTES IN LINE 261 00F4 CD3B05 CALL FNDLN ;FIND THIS LINE IN SAVE 262 00F7 D5 PUSH D ;AREA, DE->SAVE AREA 263 00F8 C20B01 JNZ ST4 ;NZ:NOT FOUND, INSERT 264 00FB D5 PUSH D ;Z:FOUND, DELETE IT 265 00FC CD5705 CALL FNDNXT ;FIND NEXT LINE 266 ;DE->NEXT LINE 267 00FF C1 POP B ;BC->LINE TO BE DELETED 268 0100 2A1508 LHLD TXTUNF ;HL->UNFILLED SAVE AREA 269 0103 CDE805 CALL MVUP ;MOVE UP TO DELETE 270 0106 60 MOV H,B ;TXTUNF->UNFILLED AREA 271 0107 69 MOV L,C 272 0108 221508 SHLD TXTUNF ;UPDATE 273 010B C1 ST4: POP B ;GET READY TO INSERT 274 010C 2A1508 LHLD TXTUNF ;BUT FIRST CHECK IF 275 010F F1 POP PSW ;THE LENGTH OF NEW LINE 276 0110 E5 PUSH H ;IS 3 (LINE # AND CR) 277 0111 FE03 CPI 3 ;THEN DO NOT INSERT 278 0113 CABA00 JZ RSTART ;MUST CLEAR THE STACK 279 0116 85 ADD L ;COMPUTE NEW TXTUNF 280 0117 6F MOV L,A 281 0118 3E00 MVI A,0 282 011A 8C ADC H 283 011B 67 MOV H,A ;HL->NEW UNFILLED AREA 284 011C 11001F LXI D,TXTEND ;CHECK TO SEE IF THERE 285 011F E7 RST 4 ;IS ENOUGH SPACE 286 0120 D2F604 JNC QSORRY ;SORRY, NO ROOM FOR IT 287 0123 221508 SHLD TXTUNF ;OK, UPDATE TXTUNF 288 0126 D1 POP D ;DE->OLD UNFILLED AREA 289 0127 CDF105 CALL MVDOWN 290 012A D1 POP D ;DE->BEGIN, HL->END 2911 292 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 293+ 13:28 11/10/2019 294+ PAGE 6 295 296 297 298 012B E1 POP H 299 012C CDE805 CALL MVUP ;MOVE NEW LINE TO SAVE 300 012F C3D600 JMP ST3 ;AREA 301 ; 302 ;************************************************************* 303 ; 304 ; WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT 305 ; COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE 306 ; COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST 307 ; SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS 308 ; TRANSFERED TO OTHERS SECTIONS AS FOLLOWS: 309 ; 310 ; FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'RSTART' 311 ; FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE 312 ; GO BACK TO 'RSTART'. 313 ; FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE. 314 ; FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE. 315 ; FOR ALL OTHERS: IF 'CURRENT' -> 0, GO TO 'RSTART', ELSE 316 ; GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.) 317 ;************************************************************* 318 ; 319 ; *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO *** 320 ; 321 ; 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN' 322 ; 323 ; 'STOP(CR)' GOES BACK TO 'RSTART' 324 ; 325 ; 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN 326 ; 'CURRENT'), AND START EXECUTE IT. NOTE THAT ONLY THOSE 327 ; COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM. 328 ; 329 ; THERE ARE 3 MORE ENTRIES IN 'RUN': 330 ; 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT. 331 ; 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT. 332 ; 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE. 333 ; 334 ; 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET 335 ; LINE, AND JUMP TO 'RUNTSL' TO DO IT. 336 ; 337 0132 CDC504 NEW: CALL ENDCHK ;*** NEW(CR) *** 338 0135 211708 LXI H,TXTBGN 339 0138 221508 SHLD TXTUNF 340 ; 341 013B CDC504 STOP: CALL ENDCHK ;*** STOP(CR) *** 342 013E C3BA00 JMP RSTART 343 ; 344 0141 CDC504 RUN: CALL ENDCHK ;*** RUN(CR) *** 345 0144 111708 LXI D,TXTBGN ;FIRST SAVED LINE 346 ; 347 0147 210000 RUNNXL: LXI H,0 ;*** RUNNXL *** 348 014A CD4305 CALL FNDLP ;FIND WHATEVER LINE # 3491 350 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 351+ 13:28 11/10/2019 352+ PAGE 7 353 354 355 356 014D DABA00 JC RSTART ;C:PASSED TXTUNF, QUIT 357 ; 358 0150 EB RUNTSL: XCHG ;*** RUNTSL *** 359 0151 220108 SHLD CURRNT ;SET 'CURRENT'->LINE # 360 0154 EB XCHG 361 0155 13 INX D ;BUMP PASS LINE # 362 0156 13 INX D 363 ; 364 0157 CD8706 RUNSML: CALL CHKIO ;*** RUNSML *** 365 015A 21C006 LXI H,TAB2-1 ;FIND COMMAND IN TAB2 366 015D C33E07 JMP EXEC ;AND EXECUTE IT 367 ; 368 0160 DF GOTO: RST 3 ;*** GOTO EXPR *** 369 0161 D5 PUSH D ;SAVE FOR ERROR ROUTINE 370 0162 CDC504 CALL ENDCHK ;MUST FIND A CR 371 0165 CD3B05 CALL FNDLN ;FIND THE TARGET LINE 372 0168 C2A000 JNZ AHOW ;NO SUCH LINE # 373 016B F1 POP PSW ;CLEAR THE PUSH DE 374 016C C35001 JMP RUNTSL ;GO DO IT 375 ; 376 ;************************************************************* 377 ; 378 ; *** LIST *** & PRINT *** 379 ; 380 ; LIST HAS TWO FORMS: 381 ; 'LIST(CR)' LISTS ALL SAVED LINES 382 ; 'LIST #(CR)' START LIST AT THIS LINE # 383 ; YOU CAN STOP THE LISTING BY CONTROL C KEY 384 ; 385 ; PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)' 386 ; WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACK- 387 ; ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS. 388 ; 389 ; A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS 390 ; THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO 391 ; BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT 392 ; COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS 393 ; SPECIFIED, 6 POSITIONS WILL BE USED. 394 ; 395 ; A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF 396 ; DOUBLE QUOTES. 397 ; 398 ; A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF) 399 ; 400 ; A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN 401 ; PRINTED OR IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST 402 ; ENDED WITH A COMMA, NO (CRLF) IS GENERATED. 403 ; 404 016F CD7700 LIST: CALL TSTNUM ;TEST IF THERE IS A # 405 0172 CDC504 CALL ENDCHK ;IF NO # WE GET A 0 406 0175 CD3B05 CALL FNDLN ;FIND THIS OR NEXT LINE 4071 408 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 409+ 13:28 11/10/2019 410+ PAGE 8 411 412 413 414 0178 DABA00 LS1: JC RSTART ;C:PASSED TXTUNF 415 017B CDD505 CALL PRTLN ;PRINT THE LINE 416 017E CD8706 CALL CHKIO ;STOP IF HIT CONTROL-C 417 0181 CD4305 CALL FNDLP ;FIND NEXT LINE 418 0184 C37801 JMP LS1 ;AND LOOP BACK 419 ; 420 0187 0E06 PRINT: MVI C,6 ;C = # OF SPACES 421 0189 CF RST 1 ;IF NULL LIST & ";" 422 018A 3B DB 3BH 423 018B 06 DB PR2-$-1 424 018C CD0E00 CALL CRLF ;GIVE CR-LF AND 425 018F C35701 JMP RUNSML ;CONTINUE SAME LINE 426 0192 CF PR2: RST 1 ;IF NULL LIST (CR) 427 0193 0D DB CR 428 0194 06 DB PR0-$-1 429 0195 CD0E00 CALL CRLF ;ALSO GIVE CR-LF AND 430 0198 C34701 JMP RUNNXL ;GO TO NEXT LINE 431 019B CF PR0: RST 1 ;ELSE IS IT FORMAT? 432 019C 23 DB '#' 433 019D 05 DB PR1-$-1 434 019E DF RST 3 ;YES, EVALUATE EXPR. 435 019F 4D MOV C,L ;AND SAVE IT IN C 436 01A0 C3A901 JMP PR3 ;LOOK FOR MORE TO PRINT 437 01A3 CD6F05 PR1: CALL QTSTG ;OR IS IT A STRING? 438 01A6 C3B601 JMP PR8 ;IF NOT, MUST BE EXPR. 439 01A9 CF PR3: RST 1 ;IF ",", GO FIND NEXT 440 01AA 2C DB ',' 441 01AB 06 DB PR6-$-1 442 01AC CDB604 CALL FIN ;IN THE LIST. 443 01AF C39B01 JMP PR0 ;LIST CONTINUES 444 01B2 CD0E00 PR6: CALL CRLF ;LIST ENDS 445 01B5 F7 RST 6 446 01B6 DF PR8: RST 3 ;EVALUATE THE EXPR 447 01B7 C5 PUSH B 448 01B8 CD9505 CALL PRTNUM ;PRINT THE VALUE 449 01BB C1 POP B 450 01BC C3A901 JMP PR3 ;MORE TO PRINT? 451 ; 452 ;************************************************************* 453 ; 454 ; *** GOSUB *** & RETURN *** 455 ; 456 ; 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO' 457 ; COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER 458 ; ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE 459 ; SUBROUTINE 'RETURN'. IN ORDER THAT 'GOSUB' CAN BE NESTED 460 ; (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED. 461 ; THE STACK POINTER IS SAVED IN 'STKGOS', THE OLD 'STKGOS' IS 462 ; SAVED IN THE STACK. IF WE ARE IN THE MAIN ROUTINE, 'STKGOS' 463 ; IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE), 464 ; BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S. 4651 466 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 467+ 13:28 11/10/2019 468+ PAGE 9 469 470 471 472 ; 473 ; 'RETURN(CR)' UNDOS EVERYTHING THAT 'GOSUB' DID, AND THUS 474 ; RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT 475 ; 'GOSUB'. IF 'STKGOS' IS ZERO, IT INDICATES THAT WE 476 ; NEVER HAD A 'GOSUB' AND IS THUS AN ERROR. 477 ; 478 01BF CD1C06 GOSUB: CALL PUSHA ;SAVE THE CURRENT "FOR" 479 01C2 DF RST 3 ;PARAMETERS 480 01C3 D5 PUSH D ;AND TEXT POINTER 481 01C4 CD3B05 CALL FNDLN ;FIND THE TARGET LINE 482 01C7 C2A000 JNZ AHOW ;NOT THERE. SAY "HOW?" 483 01CA 2A0108 LHLD CURRNT ;FOUND IT, SAVE OLD 484 01CD E5 PUSH H ;'CURRNT' OLD 'STKGOS' 485 01CE 2A0308 LHLD STKGOS 486 01D1 E5 PUSH H 487 01D2 210000 LXI H,0 ;AND LOAD NEW ONES 488 01D5 220908 SHLD LOPVAR 489 01D8 39 DAD SP 490 01D9 220308 SHLD STKGOS 491 01DC C35001 JMP RUNTSL ;THEN RUN THAT LINE 492 01DF CDC504 RETURN: CALL ENDCHK ;THERE MUST BE A CR 493 01E2 2A0308 LHLD STKGOS ;OLD STACK POINTER 494 01E5 7C MOV A,H ;0 MEANS NOT EXIST 495 01E6 B5 ORA L 496 01E7 CAC904 JZ QWHAT ;SO, WE SAY: "WHAT?" 497 01EA F9 SPHL ;ELSE, RESTORE IT 498 01EB E1 POP H 499 01EC 220308 SHLD STKGOS ;AND THE OLD 'STKGOS' 500 01EF E1 POP H 501 01F0 220108 SHLD CURRNT ;AND THE OLD 'CURRNT' 502 01F3 D1 POP D ;OLD TEXT POINTER 503 01F4 CD0006 CALL POPA ;OLD "FOR" PARAMETERS 504 01F7 F7 RST 6 ;AND WE ARE BACK HOME 505 ; 506 ;************************************************************* 507 ; 508 ; *** FOR *** & NEXT *** 509 ; 510 ; 'FOR' HAS TWO FORMS: 511 ; 'FOR VAR=EXP1 TO EXP2 STEP EXP3' AND 'FOR VAR=EXP1 TO EXP2' 512 ; THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH 513 ; EXP3=1. (I.E., WITH A STEP OF +1.) 514 ; TBI WILL FIND THE VARIABLE VAR, AND SET ITS VALUE TO THE 515 ; CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXP2 AND EXP3 516 ; AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTER ETC. IN 517 ; THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC', 518 ; 'LOPLMT', 'LOPLN', AND 'LOPPT'. IF THERE IS ALREADY SOME- 519 ; THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO 520 ; 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK 521 ; BEFORE THE NEW ONE OVERWRITES IT. 522 ; TBI WILL THEN DIG IN THE STACK AND FIND OUT IF THIS SAME 5231 524 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 525+ 13:28 11/10/2019 526+ PAGE 10 527 528 529 530 ; VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP. 531 ; IF THAT IS THE CASE, THEN THE OLD 'FOR' LOOP IS DEACTIVATED. 532 ; (PURGED FROM THE STACK..) 533 ; 534 ; 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL) 535 ; END OF THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS CHECKED 536 ; WITH THE 'LOPVAR'. IF THEY ARE NOT THE SAME, TBI DIGS IN 537 ; THE STACK TO FIND THE RIGHT ONE AND PURGES ALL THOSE THAT 538 ; DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE 'STEP' TO 539 ; THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT. IF IT 540 ; IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND 541 ; FOLLOWING THE 'FOR'. IF OUTSIDE THE LIMIT, THE SAVE AREA 542 ; IS PURGED AND EXECUTION CONTINUES. 543 ; 544 01F8 CD1C06 FOR: CALL PUSHA ;SAVE THE OLD SAVE AREA 545 01FB CDA304 CALL SETVAL ;SET THE CONTROL VAR. 546 01FE 2B DCX H ;HL IS ITS ADDRESS 547 01FF 220908 SHLD LOPVAR ;SAVE THAT 548 0202 211607 LXI H,TAB5-1 ;USE 'EXEC' TO LOOK 549 0205 C33E07 JMP EXEC ;FOR THE WORD 'TO' 550 0208 DF FR1: RST 3 ;EVALUATE THE LIMIT 551 0209 220D08 SHLD LOPLMT ;SAVE THAT 552 020C 211C07 LXI H,TAB6-1 ;USE 'EXEC' TO LOOK 553 020F C33E07 JMP EXEC ;FOR THE WORD 'STEP' 554 0212 DF FR2: RST 3 ;FOUND IT, GET STEP 555 0213 C31902 JMP FR4 556 0216 210100 FR3: LXI H,1H ;NOT FOUND, SET TO 1 557 0219 220B08 FR4: SHLD LOPINC ;SAVE THAT TOO 558 021C 2A0108 FR5: LHLD CURRNT ;SAVE CURRENT LINE # 559 021F 220F08 SHLD LOPLN 560 0222 EB XCHG ;AND TEXT POINTER 561 0223 221108 SHLD LOPPT 562 0226 010A00 LXI B,0AH ;DIG INTO STACK TO 563 0229 2A0908 LHLD LOPVAR ;FIND 'LOPVAR' 564 022C EB XCHG 565 022D 60 MOV H,B 566 022E 68 MOV L,B ;HL=0 NOW 567 022F 39 DAD SP ;HERE IS THE STACK 568 0230 3E DB 3EH 569 0231 09 FR7: DAD B ;EACH LEVEL IS 10 DEEP 570 0232 7E MOV A,M ;GET THAT OLD 'LOPVAR' 571 0233 23 INX H 572 0234 B6 ORA M 573 0235 CA5202 JZ FR8 ;0 SAYS NO MORE IN IT 574 0238 7E MOV A,M 575 0239 2B DCX H 576 023A BA CMP D ;SAME AS THIS ONE? 577 023B C23102 JNZ FR7 578 023E 7E MOV A,M ;THE OTHER HALF? 579 023F BB CMP E 580 0240 C23102 JNZ FR7 5811 582 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 583+ 13:28 11/10/2019 584+ PAGE 11 585 586 587 588 0243 EB XCHG ;YES, FOUND ONE 589 0244 210000 LXI H,0H 590 0247 39 DAD SP ;TRY TO MOVE SP 591 0248 44 MOV B,H 592 0249 4D MOV C,L 593 024A 210A00 LXI H,0AH 594 024D 19 DAD D 595 024E CDF105 CALL MVDOWN ;AND PURGE 10 WORDS 596 0251 F9 SPHL ;IN THE STACK 597 0252 2A1108 FR8: LHLD LOPPT ;JOB DONE, RESTORE DE 598 0255 EB XCHG 599 0256 F7 RST 6 ;AND CONTINUE 600 ; 601 0257 FF NEXT: RST 7 ;GET ADDRESS OF VAR. 602 0258 DAC904 JC QWHAT ;NO VARIABLE, "WHAT?" 603 025B 220508 SHLD VARNXT ;YES, SAVE IT 604 025E D5 NX0: PUSH D ;SAVE TEXT POINTER 605 025F EB XCHG 606 0260 2A0908 LHLD LOPVAR ;GET VAR. IN 'FOR' 607 0263 7C MOV A,H 608 0264 B5 ORA L ;0 SAYS NEVER HAD ONE 609 0265 CACA04 JZ AWHAT ;SO WE ASK: "WHAT?" 610 0268 E7 RST 4 ;ELSE WE CHECK THEM 611 0269 CA7602 JZ NX3 ;OK, THEY AGREE 612 026C D1 POP D ;NO, LET'S SEE 613 026D CD0006 CALL POPA ;PURGE CURRENT LOOP 614 0270 2A0508 LHLD VARNXT ;AND POP ONE LEVEL 615 0273 C35E02 JMP NX0 ;GO CHECK AGAIN 616 0276 5E NX3: MOV E,M ;COME HERE WHEN AGREED 617 0277 23 INX H 618 0278 56 MOV D,M ;DE=VALUE OF VAR. 619 0279 2A0B08 LHLD LOPINC 620 027C E5 PUSH H 621 027D 7C MOV A,H 622 027E AA XRA D 623 027F 7A MOV A,D 624 0280 19 DAD D ;ADD ONE STEP 625 0281 FA8802 JM NX4 626 0284 AC XRA H 627 0285 FAAA02 JM NX5 628 0288 EB NX4: XCHG 629 0289 2A0908 LHLD LOPVAR ;PUT IT BACK 630 028C 73 MOV M,E 631 028D 23 INX H 632 028E 72 MOV M,D 633 028F 2A0D08 LHLD LOPLMT ;HL->LIMIT 634 0292 F1 POP PSW ;OLD HL 635 0293 B7 ORA A 636 0294 F29802 JP NX1 ;STEP > 0 637 0297 EB XCHG ;STEP < 0 638 0298 CD9B04 NX1: CALL CKHLDE ;COMPARE WITH LIMIT 6391 640 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 641+ 13:28 11/10/2019 642+ PAGE 12 643 644 645 646 029B D1 POP D ;RESTORE TEXT POINTER 647 029C DAAC02 JC NX2 ;OUTSIDE LIMIT 648 029F 2A0F08 LHLD LOPLN ;WITHIN LIMIT, GO 649 02A2 220108 SHLD CURRNT ;BACK TO THE SAVED 650 02A5 2A1108 LHLD LOPPT ;'CURRNT' AND TEXT 651 02A8 EB XCHG ;POINTER 652 02A9 F7 RST 6 653 02AA E1 NX5: POP H 654 02AB D1 POP D 655 02AC CD0006 NX2: CALL POPA ;PURGE THIS LOOP 656 02AF F7 RST 6 657 ; 658 ;************************************************************* 659 ; 660 ; *** REM *** IF *** INPUT *** & LET (& DEFLT) *** 661 ; 662 ; 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI. 663 ; TBI TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION. 664 ; 665 ; 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE 666 ; COMMANDS (INCLUDING OTHER 'IF'S) SEPERATED BY SEMI-COLONS. 667 ; NOTE THAT THE WORD 'THEN' IS NOT USED. TBI EVALUATES THE 668 ; EXPR. IF IT IS NON-ZERO, EXECUTION CONTINUES. IF THE 669 ; EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND 670 ; EXECUTION CONTINUES AT THE NEXT LINE. 671 ; 672 ; 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED 673 ; BY A LIST OF ITEMS. IF THE ITEM IS A STRING IN SINGLE OR 674 ; DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS 675 ; IN 'PRINT'. IF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS 676 ; PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN 677 ; EXPR. TO BE TYPED IN. THE VARIABLE IS THEN SET TO THE 678 ; VALUE OF THIS EXPR. IF THE VARIABLE IS PROCEDED BY A STRING 679 ; (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE 680 ; PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR. 681 ; AND SET THE VARIABLE TO THE VALUE OF THE EXPR. 682 ; 683 ; IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?", 684 ; "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT. 685 ; THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C. 686 ; THIS IS HANDLED IN 'INPERR'. 687 ; 688 ; 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS. 689 ; EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR. 690 ; TBI EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE. 691 ; TBI WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'. 692 ; THIS IS DONE BY 'DEFLT'. 693 ; 694 02B0 210000 REM: LXI H,0H ;*** REM *** 695 02B3 3E DB 3EH ;THIS IS LIKE 'IF 0' 696 ; 6971 698 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 699+ 13:28 11/10/2019 700+ PAGE 13 701 702 703 704 02B4 DF IFF: RST 3 ;*** IF *** 705 02B5 7C MOV A,H ;IS THE EXPR.=0? 706 02B6 B5 ORA L 707 02B7 C25701 JNZ RUNSML ;NO, CONTINUE 708 02BA CD5905 CALL FNDSKP ;YES, SKIP REST OF LINE 709 02BD D25001 JNC RUNTSL ;AND RUN THE NEXT LINE 710 02C0 C3BA00 JMP RSTART ;IF NO NEXT, RE-START 711 ; 712 02C3 2A0708 INPERR: LHLD STKINP ;*** INPERR *** 713 02C6 F9 SPHL ;RESTORE OLD SP 714 02C7 E1 POP H ;AND OLD 'CURRNT' 715 02C8 220108 SHLD CURRNT 716 02CB D1 POP D ;AND OLD TEXT POINTER 717 02CC D1 POP D ;REDO INPUT 718 ; 719 02CD INPUT: ;*** INPUT *** 720 02CD D5 IP1: PUSH D ;SAVE IN CASE OF ERROR 721 02CE CD6F05 CALL QTSTG ;IS NEXT ITEM A STRING? 722 02D1 C3DB02 JMP IP2 ;NO 723 02D4 FF RST 7 ;YES, BUT FOLLOWED BY A 724 02D5 DA1503 JC IP4 ;VARIABLE? NO. 725 02D8 C3EB02 JMP IP3 ;YES. INPUT VARIABLE 726 02DB D5 IP2: PUSH D ;SAVE FOR 'PRTSTG' 727 02DC FF RST 7 ;MUST BE VARIABLE NOW 728 02DD DAC904 JC QWHAT ;"WHAT?" IT IS NOT? 729 02E0 1A LDAX D ;GET READY FOR 'PRTSTR' 730 02E1 4F MOV C,A 731 02E2 97 SUB A 732 02E3 12 STAX D 733 02E4 D1 POP D 734 02E5 CD6305 CALL PRTSTG ;PRINT STRING AS PROMPT 735 02E8 79 MOV A,C ;RESTORE TEXT 736 02E9 1B DCX D 737 02EA 12 STAX D 738 02EB D5 IP3: PUSH D ;SAVE TEXT POINTER 739 02EC EB XCHG 740 02ED 2A0108 LHLD CURRNT ;ALSO SAVE 'CURRNT' 741 02F0 E5 PUSH H 742 02F1 21CD02 LXI H,IP1 ;A NEGATIVE NUMBER 743 02F4 220108 SHLD CURRNT ;AS A FLAG 744 02F7 210000 LXI H,0H ;SAVE SP TOO 745 02FA 39 DAD SP 746 02FB 220708 SHLD STKINP 747 02FE D5 PUSH D ;OLD HL 748 02FF 3E3A MVI A,3AH ;PRINT THIS TOO 749 0301 CDFD04 CALL GETLN ;AND GET A LINE 750 0304 11371F LXI D,BUFFER ;POINTS TO BUFFER 751 0307 DF RST 3 ;EVALUATE INPUT 752 0308 00 NOP ;CAN BE 'CALL ENDCHK' 753 0309 00 NOP 754 030A 00 NOP 7551 756 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 757+ 13:28 11/10/2019 758+ PAGE 14 759 760 761 762 030B D1 POP D ;OK, GET OLD HL 763 030C EB XCHG 764 030D 73 MOV M,E ;SAVE VALUE IN VAR. 765 030E 23 INX H 766 030F 72 MOV M,D 767 0310 E1 POP H ;GET OLD 'CURRNT' 768 0311 220108 SHLD CURRNT 769 0314 D1 POP D ;AND OLD TEXT POINTER 770 0315 F1 IP4: POP PSW ;PURGE JUNK IN STACK 771 0316 CF RST 1 ;IS NEXT CH. ','? 772 0317 2C DB ',' 773 0318 03 DB IP5-$-1 774 0319 C3CD02 JMP IP1 ;YES, MORE ITEMS. 775 031C F7 IP5: RST 6 776 ; 777 031D 1A DEFLT: LDAX D ;*** DEFLT *** 778 031E FE0D CPI CR ;EMPTY LINE IS OK 779 0320 CA2C03 JZ LT1 ;ELSE IT IS 'LET' 780 ; 781 0323 CDA304 LET: CALL SETVAL ;*** LET *** 782 0326 CF RST 1 ;SET VALUE TO VAR. 783 0327 2C DB ',' 784 0328 03 DB LT1-$-1 785 0329 C32303 JMP LET ;ITEM BY ITEM 786 032C F7 LT1: RST 6 ;UNTIL FINISH 787 ; 788 ;************************************************************* 789 ; 790 ; *** EXPR *** 791 ; 792 ; 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS. 793 ; <EXPR>::<EXPR2> 794 ; <EXPR2><REL.OP.><EXPR2> 795 ; WHERE <REL.OP.> IS ONE OF THE OPERATORS IN TAB8 AND THE 796 ; RESULT OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE. 797 ; <EXPR2>::=(+ OR -)<EXPR3>(+ OR -<EXPR3>)(....) 798 ; WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS. 799 ; <EXPR3>::=<EXPR4>(* OR /><EXPR4>)(....) 800 ; <EXPR4>::=<VARIABLE> 801 ; <FUNCTION> 802 ; (<EXPR>) 803 ; <EXPR> IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN <EXPR> 804 ; AS INDEX, FUNCTIONS CAN HAVE AN <EXPR> AS ARGUMENTS, AND 805 ; <EXPR4> CAN BE AN <EXPR> IN PARANTHESE. 806 ; 807 ;EXPR: CALL EXPR2 ;THIS IS AT LOC. 18 808 ; PUSH H ;SAVE <EXPR2> VALUE 809 032D 212407 EXPR1: LXI H,TAB8-1 ;LOOKUP REL.OP. 810 0330 C33E07 JMP EXEC ;GO DO IT 811 0333 CD5C03 XP11: CALL XP18 ;REL.OP.">=" 812 0336 D8 RC ;NO, RETURN HL=0 8131 814 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 815+ 13:28 11/10/2019 816+ PAGE 15 817 818 819 820 0337 6F MOV L,A ;YES, RETURN HL=1 821 0338 C9 RET 822 0339 CD5C03 XP12: CALL XP18 ;REL.OP."#" 823 033C C8 RZ ;FALSE, RETURN HL=0 824 033D 6F MOV L,A ;TRUE, RETURN HL=1 825 033E C9 RET 826 033F CD5C03 XP13: CALL XP18 ;REL.OP.">" 827 0342 C8 RZ ;FALSE 828 0343 D8 RC ;ALSO FALSE, HL=0 829 0344 6F MOV L,A ;TRUE, HL=1 830 0345 C9 RET 831 0346 CD5C03 XP14: CALL XP18 ;REL.OP."<=" 832 0349 6F MOV L,A ;SET HL=1 833 034A C8 RZ ;REL. TRUE, RETURN 834 034B D8 RC 835 034C 6C MOV L,H ;ELSE SET HL=0 836 034D C9 RET 837 034E CD5C03 XP15: CALL XP18 ;REL.OP."=" 838 0351 C0 RNZ ;FALSE, RETURN HL=0 839 0352 6F MOV L,A ;ELSE SET HL=1 840 0353 C9 RET 841 0354 CD5C03 XP16: CALL XP18 ;REL.OP."<" 842 0357 D0 RNC ;FALSE, RETURN HL=0 843 0358 6F MOV L,A ;ELSE SET HL=1 844 0359 C9 RET 845 035A E1 XP17: POP H ;NOT .REL.OP 846 035B C9 RET ;RETURN HL=<EXPR2> 847 035C 79 XP18: MOV A,C ;SUBROUTINE FOR ALL 848 035D E1 POP H ;REL.OP.'S 849 035E C1 POP B 850 035F E5 PUSH H ;REVERSE TOP OF STACK 851 0360 C5 PUSH B 852 0361 4F MOV C,A 853 0362 CD7103 CALL EXPR2 ;GET 2ND <EXPR2> 854 0365 EB XCHG ;VALUE IN DE NOW 855 0366 E3 XTHL ;1ST <EXPR2> IN HL 856 0367 CD9B04 CALL CKHLDE ;COMPARE 1ST WITH 2ND 857 036A D1 POP D ;RESTORE TEXT POINTER 858 036B 210000 LXI H,0H ;SET HL=0, A=1 859 036E 3E01 MVI A,1 860 0370 C9 RET 861 ; 862 0371 CF EXPR2: RST 1 ;NEGATIVE SIGN? 863 0372 2D DB '-' 864 0373 06 DB XP21-$-1 865 0374 210000 LXI H,0H ;YES, FAKE '0-' 866 0377 C39B03 JMP XP26 ;TREAT LIKE SUBTRACT 867 037A CF XP21: RST 1 ;POSITIVE SIGN? IGNORE 868 037B 2B DB '+' 869 037C 00 DB XP22-$-1 870 037D CDA503 XP22: CALL EXPR3 ;1ST <EXPR3> 8711 872 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 873+ 13:28 11/10/2019 874+ PAGE 16 875 876 877 878 0380 CF XP23: RST 1 ;ADD? 879 0381 2B DB '+' 880 0382 15 DB XP25-$-1 881 0383 E5 PUSH H ;YES, SAVE VALUE 882 0384 CDA503 CALL EXPR3 ;GET 2ND <EXPR3> 883 0387 EB XP24: XCHG ;2ND IN DE 884 0388 E3 XTHL ;1ST IN HL 885 0389 7C MOV A,H ;COMPARE SIGN 886 038A AA XRA D 887 038B 7A MOV A,D 888 038C 19 DAD D 889 038D D1 POP D ;RESTORE TEXT POINTER 890 038E FA8003 JM XP23 ;1ST AND 2ND SIGN DIFFER 891 0391 AC XRA H ;1ST AND 2ND SIGN EQUAL 892 0392 F28003 JP XP23 ;SO IS RESULT 893 0395 C39F00 JMP QHOW ;ELSE WE HAVE OVERFLOW 894 0398 CF XP25: RST 1 ;SUBTRACT? 895 0399 2D DB '-' 896 039A 86 DB XP42-$-1 897 039B E5 XP26: PUSH H ;YES, SAVE 1ST <EXPR3> 898 039C CDA503 CALL EXPR3 ;GET 2ND <EXPR3> 899 039F CD8604 CALL CHGSGN ;NEGATE 900 03A2 C38703 JMP XP24 ;AND ADD THEM 901 ; 902 03A5 CD0504 EXPR3: CALL EXPR4 ;GET 1ST <EXPR4> 903 03A8 CF XP31: RST 1 ;MULTIPLY? 904 03A9 2A DB '*' 905 03AA 2D DB XP34-$-1 906 03AB E5 PUSH H ;YES, SAVE 1ST 907 03AC CD0504 CALL EXPR4 ;AND GET 2ND <EXPR4> 908 03AF 0600 MVI B,0H ;CLEAR B FOR SIGN 909 03B1 CD8304 CALL CHKSGN ;CHECK SIGN 910 03B4 E3 XTHL ;1ST IN HL 911 03B5 CD8304 CALL CHKSGN ;CHECK SIGN OF 1ST 912 03B8 EB XCHG 913 03B9 E3 XTHL 914 03BA 7C MOV A,H ;IS HL > 255 ? 915 03BB B7 ORA A 916 03BC CAC503 JZ XP32 ;NO 917 03BF 7A MOV A,D ;YES, HOW ABOUT DE 918 03C0 B2 ORA D 919 03C1 EB XCHG ;PUT SMALLER IN HL 920 03C2 C2A000 JNZ AHOW ;ALSO >, WILL OVERFLOW 921 03C5 7D XP32: MOV A,L ;THIS IS DUMB 922 03C6 210000 LXI H,0H ;CLEAR RESULT 923 03C9 B7 ORA A ;ADD AND COUNT 924 03CA CAF703 JZ XP35 925 03CD 19 XP33: DAD D 926 03CE DAA000 JC AHOW ;OVERFLOW 927 03D1 3D DCR A 928 03D2 C2CD03 JNZ XP33 9291 930 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 931+ 13:28 11/10/2019 932+ PAGE 17 933 934 935 936 03D5 C3F703 JMP XP35 ;FINISHED 937 03D8 CF XP34: RST 1 ;DIVIDE? 938 03D9 2F DB '/' 939 03DA 46 DB XP42-$-1 940 03DB E5 PUSH H ;YES, SAVE 1ST <EXPR4> 941 03DC CD0504 CALL EXPR4 ;AND GET THE SECOND ONE 942 03DF 0600 MVI B,0H ;CLEAR B FOR SIGN 943 03E1 CD8304 CALL CHKSGN ;CHECK SIGN OF 2ND 944 03E4 E3 XTHL ;GET 1ST IN HL 945 03E5 CD8304 CALL CHKSGN ;CHECK SIGN OF 1ST 946 03E8 EB XCHG 947 03E9 E3 XTHL 948 03EA EB XCHG 949 03EB 7A MOV A,D ;DIVIDE BY 0? 950 03EC B3 ORA E 951 03ED CAA000 JZ AHOW ;SAY "HOW?" 952 03F0 C5 PUSH B ;ELSE SAVE SIGN 953 03F1 CD6604 CALL DIVIDE ;USE SUBROUTINE 954 03F4 60 MOV H,B ;RESULT IN HL NOW 955 03F5 69 MOV L,C 956 03F6 C1 POP B ;GET SIGN BACK 957 03F7 D1 XP35: POP D ;AND TEXT POINTER 958 03F8 7C MOV A,H ;HL MUST BE + 959 03F9 B7 ORA A 960 03FA FA9F00 JM QHOW ;ELSE IT IS OVERFLOW 961 03FD 78 MOV A,B 962 03FE B7 ORA A 963 03FF FC8604 CM CHGSGN ;CHANGE SIGN IF NEEDED 964 0402 C3A803 JMP XP31 ;LOOK FOR MORE TERMS 965 ; 966 0405 210407 EXPR4: LXI H,TAB4-1 ;FIND FUNCTION IN TAB4 967 0408 C33E07 JMP EXEC ;AND GO DO IT 968 040B FF XP40: RST 7 ;NO, NOT A FUNCTION 969 040C DA1404 JC XP41 ;NOR A VARIABLE 970 040F 7E MOV A,M ;VARIABLE 971 0410 23 INX H 972 0411 66 MOV H,M ;VALUE IN HL 973 0412 6F MOV L,A 974 0413 C9 RET 975 0414 CD7700 XP41: CALL TSTNUM ;OR IS IT A NUMBER 976 0417 78 MOV A,B ;# OF DIGIT 977 0418 B7 ORA A 978 0419 C0 RNZ ;OK 979 041A CF PARN: RST 1 980 041B 28 DB '(' 981 041C 05 DB XP43-$-1 982 041D DF RST 3 ;"(EXPR)" 983 041E CF RST 1 984 041F 29 DB ')' 985 0420 01 DB XP43-$-1 986 0421 C9 XP42: RET 9871 988 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 989+ 13:28 11/10/2019 990+ PAGE 18 991 992 993 994 0422 C3C904 XP43: JMP QWHAT ;ELSE SAY: "WHAT?" 995 ; 996 0425 CD1A04 RND: CALL PARN ;*** RND(EXPR) *** 997 0428 7C MOV A,H ;EXPR MUST BE + 998 0429 B7 ORA A 999 042A FA9F00 JM QHOW 1000 042D B5 ORA L ;AND NON-ZERO 1001 042E CA9F00 JZ QHOW 1002 0431 D5 PUSH D ;SAVE BOTH 1003 0432 E5 PUSH H 1004 0433 2A1308 LHLD RANPNT ;GET MEMORY AS RANDOM 1005 0436 116C07 LXI D,LSTROM ;NUMBER 1006 0439 E7 RST 4 1007 043A DA4004 JC RA1 ;WRAP AROUND IF LAST 1008 043D 210000 LXI H,START 1009 0440 5E RA1: MOV E,M 1010 0441 23 INX H 1011 0442 56 MOV D,M 1012 0443 221308 SHLD RANPNT 1013 0446 E1 POP H 1014 0447 EB XCHG 1015 0448 C5 PUSH B 1016 0449 CD6604 CALL DIVIDE ;RND(N)=MOD(M,N)+1 1017 044C C1 POP B 1018 044D D1 POP D 1019 044E 23 INX H 1020 044F C9 RET 1021 ; 1022 0450 CD1A04 ABS: CALL PARN ;*** ABS(EXPR) *** 1023 0453 1B DCX D 1024 0454 CD8304 CALL CHKSGN ;CHECK SIGN 1025 0457 13 INX D 1026 0458 C9 RET 1027 ; 1028 0459 2A1508 SIZE: LHLD TXTUNF ;*** SIZE *** 1029 045C D5 PUSH D ;GET THE NUMBER OF FREE 1030 045D EB XCHG ;BYTES BETWEEN 'TXTUNF' 1031 045E 21001F LXI H,VARBGN ;AND 'VARBGN' 1032 0461 CD7C04 CALL SUBDE 1033 0464 D1 POP D 1034 0465 C9 RET 1035 ; 1036 ;************************************************************* 1037 ; 1038 ; *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE *** 1039 ; 1040 ; 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL 1041 ; 1042 ; 'SUBDE' SUBSTRACTS DE FROM HL 1043 ; 1044 ; 'CHKSGN' CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE 10451 1046 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1047+ 13:28 11/10/2019 1048+ PAGE 19 1049 1050 1051 1052 ; SIGN AND FLIP SIGN OF B. 1053 ; 1054 ; 'CHGSGN' CHECKS SIGN N OF HL AND B UNCONDITIONALLY. 1055 ; 1056 ; 'CKHLDE' CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE 1057 ; ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER 1058 ; CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS. 1059 ; 1060 0466 E5 DIVIDE: PUSH H ;*** DIVIDE *** 1061 0467 6C MOV L,H ;DIVIDE H BY DE 1062 0468 2600 MVI H,0 1063 046A CD7104 CALL DV1 1064 046D 41 MOV B,C ;SAVE RESULT IN B 1065 046E 7D MOV A,L ;(REMINDER+L)/DE 1066 046F E1 POP H 1067 0470 67 MOV H,A 1068 0471 0EFF DV1: MVI C,0FFH ;RESULT IN C 1069 0473 0C DV2: INR C ;DUMB ROUTINE 1070 0474 CD7C04 CALL SUBDE ;DIVIDE BY SUBTRACT 1071 0477 D27304 JNC DV2 ;AND COUNT 1072 047A 19 DAD D 1073 047B C9 RET 1074 ; 1075 047C 7D SUBDE: MOV A,L ;*** SUBDE *** 1076 047D 93 SUB E ;SUBSTRACT DE FROM 1077 047E 6F MOV L,A ;HL 1078 047F 7C MOV A,H 1079 0480 9A SBB D 1080 0481 67 MOV H,A 1081 0482 C9 RET 1082 ; 1083 0483 7C CHKSGN: MOV A,H ;*** CHKSGN *** 1084 0484 B7 ORA A ;CHECK SIGN OF HL 1085 0485 F0 RP ;IF -, CHANGE SIGN 1086 ; 1087 0486 7C CHGSGN: MOV A,H ;*** CHGSGN *** 1088 0487 B5 ORA L ;*UM* 1089 0488 C8 RZ ;*UM* NOT ON ZERO VALUE 1090 0489 7C MOV A,H ;*UM* 1091 048A F5 PUSH PSW 1092 048B 2F CMA ;CHANGE SIGN OF HL 1093 048C 67 MOV H,A 1094 048D 7D MOV A,L 1095 048E 2F CMA 1096 048F 6F MOV L,A 1097 0490 23 INX H 1098 0491 F1 POP PSW 1099 0492 AC XRA H 1100 0493 F29F00 JP QHOW 1101 0496 78 MOV A,B ;AND ALSO FLIP B 1102 0497 EE80 XRI 80H 11031 1104 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1105+ 13:28 11/10/2019 1106+ PAGE 20 1107 1108 1109 1110 0499 47 MOV B,A 1111 049A C9 RET 1112 ; 1113 049B 7C CKHLDE: MOV A,H 1114 049C AA XRA D ;SAME SIGN? 1115 049D F2A104 JP CK1 ;YES, COMPARE 1116 04A0 EB XCHG ;NO, XCH AND COMP 1117 04A1 E7 CK1: RST 4 1118 04A2 C9 RET 1119 ; 1120 ;************************************************************* 1121 ; 1122 ; *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) *** 1123 ; 1124 ; "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND 1125 ; THEN AN EXPR. IT EVALUATES THE EXPR. AND SET THE VARIABLE 1126 ; TO THAT VALUE. 1127 ; 1128 ; "FIN" CHECKS THE END OF A COMMAND. IF IT ENDED WITH ";", 1129 ; EXECUTION CONTINUES. IF IT ENDED WITH A CR, IT FINDS THE 1130 ; NEXT LINE AND CONTINUE FROM THERE. 1131 ; 1132 ; "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS 1133 ; REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.) 1134 ; 1135 ; "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR). 1136 ; IT THEN PRINTS THE LINE POINTED BY 'CURRNT' WITH A "?" 1137 ; INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP 1138 ; OF THE STACK) POINTS TO. EXECUTION OF TB IS STOPPED 1139 ; AND TBI IS RESTARTED. HOWEVER, IF 'CURRNT' -> ZERO 1140 ; (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT 1141 ; PRINTED. AND IF 'CURRNT' -> NEGATIVE # (INDICATING 'INPUT' 1142 ; COMMAND), THE INPUT LINE IS NOT PRINTED AND EXECUTION IS 1143 ; NOT TERMINATED BUT CONTINUED AT 'INPERR'. 1144 ; 1145 ; RELATED TO 'ERROR' ARE THE FOLLOWING: 1146 ; 'QWHAT' SAVES TEXT POINTER IN STACK AND GET MESSAGE "WHAT?" 1147 ; 'AWHAT' JUST GET MESSAGE "WHAT?" AND JUMP TO 'ERROR'. 1148 ; 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING. 1149 ; 'AHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS. 1150 ; 1151 04A3 FF SETVAL: RST 7 ;*** SETVAL *** 1152 04A4 DAC904 JC QWHAT ;"WHAT?" NO VARIABLE 1153 04A7 E5 PUSH H ;SAVE ADDRESS OF VAR. 1154 04A8 CF RST 1 ;PASS "=" SIGN 1155 04A9 3D DB '=' 1156 04AA 08 DB SV1-$-1 1157 04AB DF RST 3 ;EVALUATE EXPR. 1158 04AC 44 MOV B,H ;VALUE IS IN BC NOW 1159 04AD 4D MOV C,L 1160 04AE E1 POP H ;GET ADDRESS 11611 1162 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1163+ 13:28 11/10/2019 1164+ PAGE 21 1165 1166 1167 1168 04AF 71 MOV M,C ;SAVE VALUE 1169 04B0 23 INX H 1170 04B1 70 MOV M,B 1171 04B2 C9 RET 1172 04B3 C3C904 SV1: JMP QWHAT ;NO "=" SIGN 1173 ; 1174 04B6 CF FIN: RST 1 ;*** FIN *** 1175 04B7 3B DB 3BH 1176 04B8 04 DB FI1-$-1 1177 04B9 F1 POP PSW ;";", PURGE RET. ADDR. 1178 04BA C35701 JMP RUNSML ;CONTINUE SAME LINE 1179 04BD CF FI1: RST 1 ;NOT ";", IS IT CR? 1180 04BE 0D DB CR 1181 04BF 04 DB FI2-$-1 1182 04C0 F1 POP PSW ;YES, PURGE RET. ADDR. 1183 04C1 C34701 JMP RUNNXL ;RUN NEXT LINE 1184 04C4 C9 FI2: RET ;ELSE RETURN TO CALLER 1185 ; 1186 04C5 EF ENDCHK: RST 5 ;*** ENDCHK *** 1187 04C6 FE0D CPI CR ;END WITH CR? 1188 04C8 C8 RZ ;OK, ELSE SAY: "WHAT?" 1189 ; 1190 04C9 D5 QWHAT: PUSH D ;*** QWHAT *** 1191 04CA 11AE00 AWHAT: LXI D,WHAT ;*** AWHAT *** 1192 04CD 97 ERROR: SUB A ;*** ERROR *** 1193 04CE CD6305 CALL PRTSTG ;PRINT 'WHAT?', 'HOW?' 1194 04D1 D1 POP D ;OR 'SORRY' 1195 04D2 1A LDAX D ;SAVE THE CHARACTER 1196 04D3 F5 PUSH PSW ;AT WHERE OLD DE -> 1197 04D4 97 SUB A ;AND PUT A 0 THERE 1198 04D5 12 STAX D 1199 04D6 2A0108 LHLD CURRNT ;GET CURRENT LINE # 1200 04D9 E5 PUSH H 1201 04DA 7E MOV A,M ;CHECK THE VALUE 1202 04DB 23 INX H 1203 04DC B6 ORA M 1204 04DD D1 POP D 1205 04DE CABA00 JZ RSTART ;IF ZERO, JUST RESTART 1206 04E1 7E MOV A,M ;IF NEGATIVE, 1207 04E2 B7 ORA A 1208 04E3 FAC302 JM INPERR ;REDO INPUT 1209 04E6 CDD505 CALL PRTLN ;ELSE PRINT THE LINE 1210 04E9 1B DCX D ;UPTO WHERE THE 0 IS 1211 04EA F1 POP PSW ;RESTORE THE CHARACTER 1212 04EB 12 STAX D 1213 04EC 3E3F MVI A,3FH ;PRINT A "?" 1214 04EE D7 RST 2 1215 04EF 97 SUB A ;AND THE REST OF THE 1216 04F0 CD6305 CALL PRTSTG ;LINE 1217 04F3 C3BA00 JMP RSTART ;THEN RESTART 1218 ; 12191 1220 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1221+ 13:28 11/10/2019 1222+ PAGE 22 1223 1224 1225 1226 04F6 D5 QSORRY: PUSH D ;*** QSORRY *** 1227 04F7 11B400 ASORRY: LXI D,SORRY ;*** ASORRY *** 1228 04FA C3CD04 JMP ERROR 1229 ; 1230 ;************************************************************* 1231 ; 1232 ; *** GETLN *** FNDLN (& FRIENDS) *** 1233 ; 1234 ; 'GETLN' READS A INPUT LINE INTO 'BUFFER'. IT FIRST PROMPT 1235 ; THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS 1236 ; THE BUFFER AND ECHOS. IT IGNORES LF'S AND NULLS, BUT STILL 1237 ; ECHOS THEM BACK. RUB-OUT IS USED TO CAUSE IT TO DELETE 1238 ; THE LAST CHARACTER (IF THERE IS ONE), AND ALT-MOD IS USED TO 1239 ; CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER. 1240 ; CR SIGNALS THE END OF A LINE, AND CAUSE 'GETLN' TO RETURN. 1241 ; 1242 ; 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE 1243 ; TEXT SAVE AREA. DE IS USED AS THE TEXT POINTER. IF THE 1244 ; LINE IS FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE 1245 ; (I.E., THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z. 1246 ; IF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE # 1247 ; IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ. IF 1248 ; WE REACHED THE END OF TEXT SAVE AREA AND CANNOT FIND THE 1249 ; LINE, FLAGS ARE C & NZ. 1250 ; 'FNDLN' WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE 1251 ; AREA TO START THE SEARCH. SOME OTHER ENTRIES OF THIS 1252 ; ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH. 1253 ; 'FNDLNP' WILL START WITH DE AND SEARCH FOR THE LINE #. 1254 ; 'FNDNXT' WILL BUMP DE BY 2, FIND A CR AND THEN START SEARCH. 1255 ; 'FNDSKP' USE DE TO FIND A CR, AND THEN START SEARCH. 1256 ; 1257 04FD D7 GETLN: RST 2 ;*** GETLN *** 1258 04FE 11371F LXI D,BUFFER ;PROMPT AND INIT. 1259 0501 CD8706 GL1: CALL CHKIO ;CHECK KEYBOARD 1260 0504 CA0105 JZ GL1 ;NO INPUT, WAIT 1261 0507 FE7F CPI 7FH ;DELETE LAST CHARACTER? 1262 0509 CA2605 JZ GL3 ;YES 1263 050C D7 RST 2 ;INPUT, ECHO BACK 1264 050D FE0A CPI 0AH ;IGNORE LF 1265 050F CA0105 JZ GL1 1266 0512 B7 ORA A ;IGNORE NULL 1267 0513 CA0105 JZ GL1 1268 0516 FE7D CPI 7DH ;DELETE THE WHOLE LINE? 1269 0518 CA3305 JZ GL4 ;YES 1270 051B 12 STAX D ;ELSE SAVE INPUT 1271 051C 13 INX D ;AND BUMP POINTER 1272 051D FE0D CPI 0DH ;WAS IT CR? 1273 051F C8 RZ ;YES, END OF LINE 1274 0520 7B MOV A,E ;ELSE MORE FREE ROOM? 1275 0521 FE77 CPI BUFEND AND 0FFH 1276 0523 C20105 JNZ GL1 ;YES, GET NEXT INPUT 12771 1278 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1279+ 13:28 11/10/2019 1280+ PAGE 23 1281 1282 1283 1284 0526 7B GL3: MOV A,E ;DELETE LAST CHARACTER 1285 0527 FE37 CPI BUFFER AND 0FFH ;BUT DO WE HAVE ANY? 1286 0529 CA3305 JZ GL4 ;NO, REDO WHOLE LINE 1287 052C 1B DCX D ;YES, BACKUP POINTER 1288 052D 3E5C MVI A,5CH ;AND ECHO A BACK-SLASH 1289 052F D7 RST 2 1290 0530 C30105 JMP GL1 ;GO GET NEXT INPUT 1291 0533 CD0E00 GL4: CALL CRLF ;REDO ENTIRE LINE 1292 0536 3E5E MVI A,05EH ;CR, LF AND UP-ARROW 1293 0538 C3FD04 JMP GETLN 1294 ; 1295 053B 7C FNDLN: MOV A,H ;*** FNDLN *** 1296 053C B7 ORA A ;CHECK SIGN OF HL 1297 053D FA9F00 JM QHOW ;IT CANNOT BE - 1298 0540 111708 LXI D,TXTBGN ;INIT TEXT POINTER 1299 ; 1300 0543 FNDLP: ;*** FDLNP *** 1301 0543 E5 FL1: PUSH H ;SAVE LINE # 1302 0544 2A1508 LHLD TXTUNF ;CHECK IF WE PASSED END 1303 0547 2B DCX H 1304 0548 E7 RST 4 1305 0549 E1 POP H ;GET LINE # BACK 1306 054A D8 RC ;C,NZ PASSED END 1307 054B 1A LDAX D ;WE DID NOT, GET BYTE 1 1308 054C 95 SUB L ;IS THIS THE LINE? 1309 054D 47 MOV B,A ;COMPARE LOW ORDER 1310 054E 13 INX D 1311 054F 1A LDAX D ;GET BYTE 2 1312 0550 9C SBB H ;COMPARE HIGH ORDER 1313 0551 DA5805 JC FL2 ;NO, NOT THERE YET 1314 0554 1B DCX D ;ELSE WE EITHER FOUND 1315 0555 B0 ORA B ;IT, OR IT IS NOT THERE 1316 0556 C9 RET ;NC,Z:FOUND, NC,NZ:NO 1317 ; 1318 0557 FNDNXT: ;*** FNDNXT *** 1319 0557 13 INX D ;FIND NEXT LINE 1320 0558 13 FL2: INX D ;JUST PASSED BYTE 1 & 2 1321 ; 1322 0559 1A FNDSKP: LDAX D ;*** FNDSKP *** 1323 055A FE0D CPI CR ;TRY TO FIND CR 1324 055C C25805 JNZ FL2 ;KEEP LOOKING 1325 055F 13 INX D ;FOUND CR, SKIP OVER 1326 0560 C34305 JMP FL1 ;CHECK IF END OF TEXT 1327 ; 1328 ;************************************************************* 1329 ; 1330 ; *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN *** 1331 ; 1332 ; 'PRTSTG' PRINTS A STRING POINTED BY DE. IT STOPS PRINTING 1333 ; AND RETURNS TO CALLER WHEN EITHER A CR IS PRINTED OR WHEN 1334 ; THE NEXT BYTE IS THE SAME AS WHAT WAS IN A (GIVEN BY THE 13351 1336 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1337+ 13:28 11/10/2019 1338+ PAGE 24 1339 1340 1341 1342 ; CALLER). OLD A IS STORED IN B, OLD B IS LOST. 1343 ; 1344 ; 'QTSTG' LOOKS FOR A BACK-ARROW, SINGLE QUOTE, OR DOUBLE 1345 ; QUOTE. IF NONE OF THESE, RETURN TO CALLER. IF BACK-ARROW, 1346 ; OUTPUT A CR WITHOUT A LF. IF SINGLE OR DOUBLE QUOTE, PRINT 1347 ; THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE. 1348 ; AFTER THE PRINTING THE NEXT 3 BYTES OF THE CALLER IS SKIPPED 1349 ; OVER (USUALLY A JUMP INSTRUCTION. 1350 ; 1351 ; 'PRTNUM' PRINTS THE NUMBER IN HL. LEADING BLANKS ARE ADDED 1352 ; IF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C. 1353 ; HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN 1354 ; C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO 1355 ; PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT. 1356 ; 1357 ; 'PRTLN' PRINTS A SAVED TEXT LINE WITH LINE # AND ALL. 1358 ; 1359 0563 47 PRTSTG: MOV B,A ;*** PRTSTG *** 1360 0564 1A PS1: LDAX D ;GET A CHARACTER 1361 0565 13 INX D ;BUMP POINTER 1362 0566 B8 CMP B ;SAME AS OLD A? 1363 0567 C8 RZ ;YES, RETURN 1364 0568 D7 RST 2 ;ELSE PRINT IT 1365 0569 FE0D CPI CR ;WAS IT A CR? 1366 056B C26405 JNZ PS1 ;NO, NEXT 1367 056E C9 RET ;YES, RETURN 1368 ; 1369 056F CF QTSTG: RST 1 ;*** QTSTG *** 1370 0570 22 DB '"' 1371 0571 0F DB QT3-$-1 1372 0572 3E22 MVI A,22H ;IT IS A " 1373 0574 CD6305 QT1: CALL PRTSTG ;PRINT UNTIL ANOTHER 1374 0577 FE0D CPI CR ;WAS LAST ONE A CR? 1375 0579 E1 POP H ;RETURN ADDRESS 1376 057A CA4701 JZ RUNNXL ;WAS CR, RUN NEXT LINE 1377 057D 23 QT2: INX H ;SKIP 3 BYTES ON RETURN 1378 057E 23 INX H 1379 057F 23 INX H 1380 0580 E9 PCHL ;RETURN 1381 0581 CF QT3: RST 1 ;IS IT A '? 1382 0582 27 DB 27H 1383 0583 05 DB QT4-$-1 1384 0584 3E27 MVI A,27H ;YES, DO THE SAME 1385 0586 C37405 JMP QT1 ;AS IN " 1386 0589 CF QT4: RST 1 ;IS IT BACK-ARROW? 1387 058A 5F DB 5FH 1388 058B 08 DB QT5-$-1 1389 058C 3E8D MVI A,08DH ;YES, CR WITHOUT LF 1390 058E D7 RST 2 ;DO IT TWICE TO GIVE 1391 058F D7 RST 2 ;TTY ENOUGH TIME 1392 0590 E1 POP H ;RETURN ADDRESS 13931 1394 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1395+ 13:28 11/10/2019 1396+ PAGE 25 1397 1398 1399 1400 0591 C37D05 JMP QT2 1401 0594 C9 QT5: RET ;NONE OF ABOVE 1402 ; 1403 0595 0600 PRTNUM: MVI B,0 ;*** PRTNUM *** 1404 0597 CD8304 CALL CHKSGN ;CHECK SIGN 1405 059A F2A005 JP PN1 ;NO SIGN 1406 059D 062D MVI B,'-' ;B=SIGN 1407 059F 0D DCR C ;'-' TAKES SPACE 1408 05A0 D5 PN1: PUSH D ;SAVE 1409 05A1 110A00 LXI D,0AH ;DECIMAL 1410 05A4 D5 PUSH D ;SAVE AS A FLAG 1411 05A5 0D DCR C ;C=SPACES 1412 05A6 C5 PUSH B ;SAVE SIGN & SPACE 1413 05A7 CD6604 PN2: CALL DIVIDE ;DIVIDE HL BY 10 1414 05AA 78 MOV A,B ;RESULT 0? 1415 05AB B1 ORA C 1416 05AC CAB705 JZ PN3 ;YES, WE GOT ALL 1417 05AF E3 XTHL ;NO, SAVE REMAINDER 1418 05B0 2D DCR L ;AND COUNT SPACE 1419 05B1 E5 PUSH H ;HL IS OLD BC 1420 05B2 60 MOV H,B ;MOVE RESULT TO BC 1421 05B3 69 MOV L,C 1422 05B4 C3A705 JMP PN2 ;AND DIVIDE BY 10 1423 05B7 C1 PN3: POP B ;WE GOT ALL DIGITS IN 1424 05B8 0D PN4: DCR C ;THE STACK 1425 05B9 79 MOV A,C ;LOOK AT SPACE COUNT 1426 05BA B7 ORA A 1427 05BB FAC405 JM PN5 ;NO LEADING BLANKS 1428 05BE 3E20 MVI A,20H ;LEADING BLANKS 1429 05C0 D7 RST 2 1430 05C1 C3B805 JMP PN4 ;MORE? 1431 05C4 78 PN5: MOV A,B ;PRINT SIGN 1432 05C5 B7 ORA A 1433 05C6 C41000 CNZ 10H 1434 05C9 5D MOV E,L ;LAST REMAINDER IN E 1435 05CA 7B PN6: MOV A,E ;CHECK DIGIT IN E 1436 05CB FE0A CPI 0AH ;10 IS FLAG FOR NO MORE 1437 05CD D1 POP D 1438 05CE C8 RZ ;IF SO, RETURN 1439 05CF C630 ADI 30H ;ELSE CONVERT TO ASCII 1440 05D1 D7 RST 2 ;AND PRINT THE DIGIT 1441 05D2 C3CA05 JMP PN6 ;GO BACK FOR MORE 1442 ; 1443 05D5 1A PRTLN: LDAX D ;*** PRTLN *** 1444 05D6 6F MOV L,A ;LOW ORDER LINE # 1445 05D7 13 INX D 1446 05D8 1A LDAX D ;HIGH ORDER 1447 05D9 67 MOV H,A 1448 05DA 13 INX D 1449 05DB 0E04 MVI C,4H ;PRINT 4 DIGIT LINE # 1450 05DD CD9505 CALL PRTNUM 14511 1452 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1453+ 13:28 11/10/2019 1454+ PAGE 26 1455 1456 1457 1458 05E0 3E20 MVI A,20H ;FOLLOWED BY A BLANK 1459 05E2 D7 RST 2 1460 05E3 97 SUB A ;AND THEN THE NEXT 1461 05E4 CD6305 CALL PRTSTG 1462 05E7 C9 RET 1463 ; 1464 ;************************************************************* 1465 ; 1466 ; *** MVUP *** MVDOWN *** POPA *** & PUSHA *** 1467 ; 1468 ; 'MVUP' MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC-> UNTIL 1469 ; DE = HL 1470 ; 1471 ; 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL-> 1472 ; UNTIL DE = BC 1473 ; 1474 ; 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE 1475 ; STACK 1476 ; 1477 ; 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE 1478 ; STACK 1479 ; 1480 05E8 E7 MVUP: RST 4 ;*** MVUP *** 1481 05E9 C8 RZ ;DE = HL, RETURN 1482 05EA 1A LDAX D ;GET ONE BYTE 1483 05EB 02 STAX B ;MOVE IT 1484 05EC 13 INX D ;INCREASE BOTH POINTERS 1485 05ED 03 INX B 1486 05EE C3E805 JMP MVUP ;UNTIL DONE 1487 ; 1488 05F1 78 MVDOWN: MOV A,B ;*** MVDOWN *** 1489 05F2 92 SUB D ;TEST IF DE = BC 1490 05F3 C2F905 JNZ MD1 ;NO, GO MOVE 1491 05F6 79 MOV A,C ;MAYBE, OTHER BYTE? 1492 05F7 93 SUB E 1493 05F8 C8 RZ ;YES, RETURN 1494 05F9 1B MD1: DCX D ;ELSE MOVE A BYTE 1495 05FA 2B DCX H ;BUT FIRST DECREASE 1496 05FB 1A LDAX D ;BOTH POINTERS AND 1497 05FC 77 MOV M,A ;THEN DO IT 1498 05FD C3F105 JMP MVDOWN ;LOOP BACK 1499 ; 1500 0600 C1 POPA: POP B ;BC = RETURN ADDR. 1501 0601 E1 POP H ;RESTORE LOPVAR, BUT 1502 0602 220908 SHLD LOPVAR ;=0 MEANS NO MORE 1503 0605 7C MOV A,H 1504 0606 B5 ORA L 1505 0607 CA1A06 JZ PP1 ;YEP, GO RETURN 1506 060A E1 POP H ;NOP, RESTORE OTHERS 1507 060B 220B08 SHLD LOPINC 1508 060E E1 POP H 15091 1510 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1511+ 13:28 11/10/2019 1512+ PAGE 27 1513 1514 1515 1516 060F 220D08 SHLD LOPLMT 1517 0612 E1 POP H 1518 0613 220F08 SHLD LOPLN 1519 0616 E1 POP H 1520 0617 221108 SHLD LOPPT 1521 061A C5 PP1: PUSH B ;BC = RETURN ADDR. 1522 061B C9 RET 1523 ; 1524 061C 21781F PUSHA: LXI H,STKLMT ;*** PUSHA *** 1525 061F CD8604 CALL CHGSGN 1526 0622 C1 POP B ;BC=RETURN ADDRESS 1527 0623 39 DAD SP ;IS STACK NEAR THE TOP? 1528 0624 D2F604 JNC QSORRY ;YES, SORRY FOR THAT 1529 0627 2A0908 LHLD LOPVAR ;ELSE SAVE LOOP VAR'S 1530 062A 7C MOV A,H ;BUT IF LOPVAR IS 0 1531 062B B5 ORA L ;THAT WILL BE ALL 1532 062C CA4206 JZ PU1 1533 062F 2A1108 LHLD LOPPT ;ELSE, MORE TO SAVE 1534 0632 E5 PUSH H 1535 0633 2A0F08 LHLD LOPLN 1536 0636 E5 PUSH H 1537 0637 2A0D08 LHLD LOPLMT 1538 063A E5 PUSH H 1539 063B 2A0B08 LHLD LOPINC 1540 063E E5 PUSH H 1541 063F 2A0908 LHLD LOPVAR 1542 0642 E5 PU1: PUSH H 1543 0643 C5 PUSH B ;BC = RETURN ADDR. 1544 0644 C9 RET 1545 ; 1546 ;************************************************************* 1547 ; 1548 ; *** OUTC *** & CHKIO *** 1549 ; 1550 ; THESE ARE THE ONLY I/O ROUTINES IN TBI. 1551 ; 'OUTC' IS CONTROLLED BY A SOFTWARE SWITCH 'OCSW'. IF OCSW=0 1552 ; 'OUTC' WILL JUST RETURN TO THE CALLER. IF OCSW IS NOT 0, 1553 ; IT WILL OUTPUT THE BYTE IN A. IF THAT IS A CR, A LF IS ALSO 1554 ; SEND OUT. ONLY THE FLAGS MAY BE CHANGED AT RETURN. ALL REG. 1555 ; ARE RESTORED. 1556 ; 1557 ; 'CHKIO' CHECKS THE INPUT. IF NO INPUT, IT WILL RETURN TO 1558 ; THE CALLER WITH THE Z FLAG SET. IF THERE IS INPUT, Z FLAG 1559 ; IS CLEARED AND THE INPUT BYTE IS IN A. HOWEVER, IF THE 1560 ; INPUT IS A CONTROL-O, THE 'OCSW' SWITCH IS COMPLIMENTED, AND 1561 ; Z FLAG IS RETURNED. IF A CONTROL-C IS READ, 'CHKIO' WILL 1562 ; RESTART TBI AND DO NOT RETURN TO THE CALLER. 1563 ; 1564 ;OUTC: PUSH PSW ;THIS IS AT LOC. 10 1565 ; LDA OCSW ;CHECK SOFTWARE SWITCH 1566 ; ORA A 15671 1568 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1569+ 13:28 11/10/2019 1570+ PAGE 28 1571 1572 1573 1574 0645 320008 INIT: STA OCSW 1575 0648 3E03 MVI A,3 ;RESET ACIA 1576 064A D310 OUT 16 1577 064C 3E15 MVI A,15H ;15H FOR 8N1, 11H FOR 8N2 1578 064E D310 OUT 16 1579 0650 1619 MVI D,19H 1580 0652 PATLOP: 1581 0652 CD0E00 CALL CRLF 1582 0655 15 DCR D 1583 0656 C25206 JNZ PATLOP 1584 0659 97 SUB A 1585 065A 11A606 LXI D,MSG1 1586 065D CD6305 CALL PRTSTG 1587 0660 210000 LXI H,START 1588 0663 221308 SHLD RANPNT 1589 0666 211708 LXI H,TXTBGN 1590 0669 221508 SHLD TXTUNF 1591 066C C3BA00 JMP RSTART 1592 066F C27406 OC2: JNZ OC3 ;IT IS ON 1593 0672 F1 POP PSW ;IT IS OFF 1594 0673 C9 RET ;RESTORE AF AND RETURN 1595 0674 DB10 OC3: IN 16 ;COME HERE TO DO OUTPUT 1596 0676 E602 ANI 2H ;STATUS BIT 1597 0678 CA7406 JZ OC3 ;NOT READY, WAIT 1598 067B F1 POP PSW ;READY, GET OLD A BACK 1599 067C D311 OUT 17 ;AND SEND IT OUT 1600 067E FE0D CPI CR ;WAS IT CR? 1601 0680 C0 RNZ ;NO, FINISHED 1602 0681 3E0A MVI A,LF ;YES, WE SEND LF TOO 1603 0683 D7 RST 2 ;THIS IS RECURSIVE 1604 0684 3E0D MVI A,CR ;GET CR BACK IN A 1605 0686 C9 RET 1606 ; 1607 0687 DB10 CHKIO: IN 16 ;*** CHKIO *** 1608 0689 00 NOP ;STATUS BIT FLIPPED? 1609 068A E601 ANI 1H ;MASK STATUS BIT 1610 068C C8 RZ ;NOT READY, RETURN "Z" 1611 068D DB11 IN 17 ;READY, READ DATA 1612 068F E67F ANI 7FH ;MASK BIT 7 OFF 1613 0691 FE0F CPI 0FH ;IS IT CONTROL-O? 1614 0693 C2A006 JNZ CI1 ;NO, MORE CHECKING 1615 0696 3A0008 LDA OCSW ;CONTROL-O FLIPS OCSW 1616 0699 2F CMA ;ON TO OFF, OFF TO ON 1617 069A 320008 STA OCSW 1618 069D C38706 JMP CHKIO ;GET ANOTHER INPUT 1619 06A0 FE03 CI1: CPI 3H ;IS IT CONTROL-C? 1620 06A2 C0 RNZ ;NO, RETURN "NZ" 1621 06A3 C3BA00 JMP RSTART ;YES, RESTART TBI 1622 ; 1623 06A6 54494E59 MSG1: DB 'TINY ' 1624 06AA 20 16251 1626 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1627+ 13:28 11/10/2019 1628+ PAGE 29 1629 1630 1631 1632 06AB 42415349 DB 'BASIC' 1633 06AF 43 1634 06B0 0D DB CR 1635 ; 1636 ;************************************************************* 1637 ; 1638 ; *** TABLES *** DIRECT *** & EXEC *** 1639 ; 1640 ; THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE. 1641 ; WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION 1642 ; OF CODE ACCORDING TO THE TABLE. 1643 ; 1644 ; AT 'EXEC', DE SHOULD POINT TO THE STRING AND HL SHOULD POINT 1645 ; TO THE TABLE-1. AT 'DIRECT', DE SHOULD POINT TO THE STRING. 1646 ; HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF 1647 ; ALL DIRECT AND STATEMENT COMMANDS. 1648 ; 1649 ; A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL 1650 ; MATCH WILL BE CONSIDERED AS A MATCH. E.G., 'P.', 'PR.', 1651 ; 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'. 1652 ; 1653 ; THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM 1654 ; IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND 1655 ; A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH 1656 ; BYTE SET TO 1. 1657 ; 1658 ; END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE 1659 ; STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL 1660 ; MATCH THIS NULL ITEM AS DEFAULT. 1661 ; 1662 06B1 TAB1: ;DIRECT COMMANDS 1663 06B1 4C495354 DB 'LIST' 1664 DWA LIST 1665 06B5 1 81 + DB (LIST SHR 8) + 128 1666 06B6 1 6F + DB LIST AND 0FFH 1667 06B7 52554E DB 'RUN' 1668 DWA RUN 1669 06BA 1 81 + DB (RUN SHR 8) + 128 1670 06BB 1 41 + DB RUN AND 0FFH 1671 06BC 4E4557 DB 'NEW' 1672 DWA NEW 1673 06BF 1 81 + DB (NEW SHR 8) + 128 1674 06C0 1 32 + DB NEW AND 0FFH 1675 ; 1676 06C1 TAB2: ;DIRECT/STATEMENT 1677 06C1 4E455854 DB 'NEXT' 1678 DWA NEXT 1679 06C5 1 82 + DB (NEXT SHR 8) + 128 1680 06C6 1 57 + DB NEXT AND 0FFH 1681 06C7 4C4554 DB 'LET' 1682 DWA LET 16831 1684 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1685+ 13:28 11/10/2019 1686+ PAGE 30 1687 1688 1689 1690 06CA 1 83 + DB (LET SHR 8) + 128 1691 06CB 1 23 + DB LET AND 0FFH 1692 06CC 4946 DB 'IF' 1693 DWA IFF 1694 06CE 1 82 + DB (IFF SHR 8) + 128 1695 06CF 1 B4 + DB IFF AND 0FFH 1696 06D0 474F544F DB 'GOTO' 1697 DWA GOTO 1698 06D4 1 81 + DB (GOTO SHR 8) + 128 1699 06D5 1 60 + DB GOTO AND 0FFH 1700 06D6 474F5355 DB 'GOSUB' 1701 06DA 42 1702 DWA GOSUB 1703 06DB 1 81 + DB (GOSUB SHR 8) + 128 1704 06DC 1 BF + DB GOSUB AND 0FFH 1705 06DD 52455455 DB 'RETURN' 1706 06E1 524E 1707 DWA RETURN 1708 06E3 1 81 + DB (RETUR SHR 8) + 128 1709 06E4 1 DF + DB RETUR AND 0FFH 1710 06E5 52454D DB 'REM' 1711 DWA REM 1712 06E8 1 82 + DB (REM SHR 8) + 128 1713 06E9 1 B0 + DB REM AND 0FFH 1714 06EA 464F52 DB 'FOR' 1715 DWA FOR 1716 06ED 1 81 + DB (FOR SHR 8) + 128 1717 06EE 1 F8 + DB FOR AND 0FFH 1718 06EF 494E5055 DB 'INPUT' 1719 06F3 54 1720 DWA INPUT 1721 06F4 1 82 + DB (INPUT SHR 8) + 128 1722 06F5 1 CD + DB INPUT AND 0FFH 1723 06F6 5052494E DB 'PRINT' 1724 06FA 54 1725 DWA PRINT 1726 06FB 1 81 + DB (PRINT SHR 8) + 128 1727 06FC 1 87 + DB PRINT AND 0FFH 1728 06FD 53544F50 DB 'STOP' 1729 DWA STOP 1730 0701 1 81 + DB (STOP SHR 8) + 128 1731 0702 1 3B + DB STOP AND 0FFH 1732 DWA DEFLT 1733 0703 1 83 + DB (DEFLT SHR 8) + 128 1734 0704 1 1D + DB DEFLT AND 0FFH 1735 ; 1736 0705 TAB4: ;FUNCTIONS 1737 0705 524E44 DB 'RND' 1738 DWA RND 1739 0708 1 84 + DB (RND SHR 8) + 128 1740 0709 1 25 + DB RND AND 0FFH 17411 1742 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1743+ 13:28 11/10/2019 1744+ PAGE 31 1745 1746 1747 1748 070A 414253 DB 'ABS' 1749 DWA ABS 1750 070D 1 84 + DB (ABS SHR 8) + 128 1751 070E 1 50 + DB ABS AND 0FFH 1752 070F 53495A45 DB 'SIZE' 1753 DWA SIZE 1754 0713 1 84 + DB (SIZE SHR 8) + 128 1755 0714 1 59 + DB SIZE AND 0FFH 1756 DWA XP40 1757 0715 1 84 + DB (XP40 SHR 8) + 128 1758 0716 1 0B + DB XP40 AND 0FFH 1759 ; 1760 0717 TAB5: ;"TO" IN "FOR" 1761 0717 544F DB 'TO' 1762 DWA FR1 1763 0719 1 82 + DB (FR1 SHR 8) + 128 1764 071A 1 08 + DB FR1 AND 0FFH 1765 DWA QWHAT 1766 071B 1 84 + DB (QWHAT SHR 8) + 128 1767 071C 1 C9 + DB QWHAT AND 0FFH 1768 ; 1769 071D TAB6: ;"STEP" IN "FOR" 1770 071D 53544550 DB 'STEP' 1771 DWA FR2 1772 0721 1 82 + DB (FR2 SHR 8) + 128 1773 0722 1 12 + DB FR2 AND 0FFH 1774 DWA FR3 1775 0723 1 82 + DB (FR3 SHR 8) + 128 1776 0724 1 16 + DB FR3 AND 0FFH 1777 ; 1778 0725 TAB8: ;RELATION OPERATORS 1779 0725 3E3D DB '>=' 1780 DWA XP11 1781 0727 1 83 + DB (XP11 SHR 8) + 128 1782 0728 1 33 + DB XP11 AND 0FFH 1783 0729 23 DB '#' 1784 DWA XP12 1785 072A 1 83 + DB (XP12 SHR 8) + 128 1786 072B 1 39 + DB XP12 AND 0FFH 1787 072C 3E DB '>' 1788 DWA XP13 1789 072D 1 83 + DB (XP13 SHR 8) + 128 1790 072E 1 3F + DB XP13 AND 0FFH 1791 072F 3D DB '=' 1792 DWA XP15 1793 0730 1 83 + DB (XP15 SHR 8) + 128 1794 0731 1 4E + DB XP15 AND 0FFH 1795 0732 3C3D DB '<=' 1796 DWA XP14 1797 0734 1 83 + DB (XP14 SHR 8) + 128 1798 0735 1 46 + DB XP14 AND 0FFH 17991 1800 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1801+ 13:28 11/10/2019 1802+ PAGE 32 1803 1804 1805 1806 0736 3C DB '<' 1807 DWA XP16 1808 0737 1 83 + DB (XP16 SHR 8) + 128 1809 0738 1 54 + DB XP16 AND 0FFH 1810 DWA XP17 1811 0739 1 83 + DB (XP17 SHR 8) + 128 1812 073A 1 5A + DB XP17 AND 0FFH 1813 ; 1814 073B 21B006 DIRECT: LXI H,TAB1-1 ;*** DIRECT *** 1815 ; 1816 073E EXEC: ;*** EXEC *** 1817 073E EF EX0: RST 5 ;IGNORE LEADING BLANKS 1818 073F D5 PUSH D ;SAVE POINTER 1819 0740 1A EX1: LDAX D ;IF FOUND '.' IN STRING 1820 0741 13 INX D ;BEFORE ANY MISMATCH 1821 0742 FE2E CPI 2EH ;WE DECLARE A MATCH 1822 0744 CA5D07 JZ EX3 1823 0747 23 INX H ;HL->TABLE 1824 0748 BE CMP M ;IF MATCH, TEST NEXT 1825 0749 CA4007 JZ EX1 1826 074C 3E7F MVI A,07FH ;ELSE SEE IF BIT 7 1827 074E 1B DCX D ;OF TABLE IS SET, WHICH 1828 074F BE CMP M ;IS THE JUMP ADDR. (HI) 1829 0750 DA6407 JC EX5 ;C:YES, MATCHED 1830 0753 23 EX2: INX H ;NC:NO, FIND JUMP ADDR. 1831 0754 BE CMP M 1832 0755 D25307 JNC EX2 1833 0758 23 INX H ;BUMP TO NEXT TAB. ITEM 1834 0759 D1 POP D ;RESTORE STRING POINTER 1835 075A C33E07 JMP EX0 ;TEST AGAINST NEXT ITEM 1836 075D 3E7F EX3: MVI A,07FH ;PARTIAL MATCH, FIND 1837 075F 23 EX4: INX H ;JUMP ADDR., WHICH IS 1838 0760 BE CMP M ;FLAGGED BY BIT 7 1839 0761 D25F07 JNC EX4 1840 0764 7E EX5: MOV A,M ;LOAD HL WITH THE JUMP 1841 0765 23 INX H ;ADDRESS FROM THE TABLE 1842 0766 6E MOV L,M 1843 0767 E67F ANI 7FH ;MASK OFF BIT 7 1844 0769 67 MOV H,A 1845 076A F1 POP PSW ;CLEAN UP THE GABAGE 1846 076B E9 PCHL ;AND WE GO DO IT 1847 ; 1848 076C LSTROM: ;ALL ABOVE CAN BE ROM 1849 ; ORG 1000H ;HERE DOWN MUST BE RAM 1850 0800 ORG 0800H 1851 0800 OCSW: DS 1 ;SWITCH FOR OUTPUT 1852 0801 CURRNT: DS 2 ;POINTS TO CURRENT LINE 1853 0803 STKGOS: DS 2 ;SAVES SP IN 'GOSUB' 1854 0805 VARNXT: DS 2 ;TEMP STORAGE 1855 0807 STKINP: DS 2 ;SAVES SP IN 'INPUT' 1856 0809 LOPVAR: DS 2 ;'FOR' LOOP SAVE AREA 18571 1858 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1859+ 13:28 11/10/2019 1860+ PAGE 33 1861 1862 1863 1864 080B LOPINC: DS 2 ;INCREMENT 1865 080D LOPLMT: DS 2 ;LIMIT 1866 080F LOPLN: DS 2 ;LINE NUMBER 1867 0811 LOPPT: DS 2 ;TEXT POINTER 1868 0813 RANPNT: DS 2 ;RANDOM NUMBER POINTER 1869 0815 TXTUNF: DS 2 ;->UNFILLED TEXT AREA 1870 0817 TXTBGN: DS 2 ;TEXT SAVE AREA BEGINS 1871 ; ORG 1366H 1872 1F00 ORG 1F00H 1873 1F00 TXTEND: DS 0 ;TEXT SAVE AREA ENDS 1874 1F00 VARBGN: DS 55 ;VARIABLE @(0) 1875 1F37 BUFFER: DS 64 ;INPUT BUFFER 1876 1F77 BUFEND: DS 1 ;BUFFER ENDS 1877 1F78 STKLMT: DS 1 ;TOP LIMIT FOR STACK 1878 ; ORG 1400H 1879 2000 ORG 2000H 1880 2000 STACK: DS 0 ;STACK STARTS HERE 1881 ; 1882 000D CR EQU 0DH 1883 000A LF EQU 0AH 1884 1885 END 1886 NO PROGRAM ERRORS 18871 1888 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1889+ 13:28 11/10/2019 1890+ PAGE 34 1891 1892 1893 1894 SYMBOL TABLE 1895 1896 * 01 1897 1898 A 0007 ABS 0450 AHOW 00A0 ASORR 04F7 1899 AWHAT 04CA B 0000 BUFEN 1F77 BUFFE 1F37 1900 C 0001 CHGSG 0486 CHKIO 0687 CHKSG 0483 1901 CI1 06A0 CK1 04A1 CKHLD 049B CR 000D 1902 CRLF 000E CURRN 0801 D 0002 DEFLT 031D 1903 DIREC 073B DIVID 0466 DV1 0471 DV2 0473 1904 DWA 06CB E 0003 ENDCH 04C5 ERROR 04CD 1905 EX0 073E EX1 0740 EX2 0753 EX3 075D 1906 EX4 075F EX5 0764 EXEC 073E EXPR1 032D 1907 EXPR2 0371 EXPR3 03A5 EXPR4 0405 FI1 04BD 1908 FI2 04C4 FIN 04B6 FL1 0543 FL2 0558 1909 FNDLN 053B FNDLP 0543 FNDNX 0557 FNDSK 0559 1910 FOR 01F8 FR1 0208 FR2 0212 FR3 0216 1911 FR4 0219 FR5 021C * FR7 0231 FR8 0252 1912 GETLN 04FD GL1 0501 GL3 0526 GL4 0533 1913 GOSUB 01BF GOTO 0160 H 0004 HOW 00A6 1914 IFF 02B4 INIT 0645 INPER 02C3 INPUT 02CD 1915 IP1 02CD IP2 02DB IP3 02EB IP4 0315 1916 IP5 031C L 0005 LET 0323 LF 000A 1917 LIST 016F LOPIN 080B LOPLM 080D LOPLN 080F 1918 LOPPT 0811 LOPVA 0809 LS1 0178 LSTRO 076C 1919 LT1 032C M 0006 MD1 05F9 MSG1 06A6 1920 MVDOW 05F1 MVUP 05E8 NEW 0132 NEXT 0257 1921 NX0 025E NX1 0298 NX2 02AC NX3 0276 1922 NX4 0288 NX5 02AA OC2 066F OC3 0674 1923 OCSW 0800 OK 00AB PARN 041A PATLO 0652 1924 PN1 05A0 PN2 05A7 PN3 05B7 PN4 05B8 1925 PN5 05C4 PN6 05CA POPA 0600 PP1 061A 1926 PR0 019B PR1 01A3 PR2 0192 PR3 01A9 1927 PR6 01B2 PR8 01B6 PRINT 0187 PRTLN 05D5 1928 PRTNU 0595 PRTST 0563 PS1 0564 PSW 0006 1929 PU1 0642 PUSHA 061C QHOW 009F QSORR 04F6 1930 QT1 0574 QT2 057D QT3 0581 QT4 0589 1931 QT5 0594 QTSTG 056F QWHAT 04C9 RA1 0440 1932 RANPN 0813 REM 02B0 RETUR 01DF RND 0425 1933 RSTAR 00BA RUN 0141 RUNNX 0147 RUNSM 0157 1934 RUNTS 0150 SETVA 04A3 SIZE 0459 SORRY 00B4 1935 SP 0006 SS1 0028 ST1 00BD * ST2 00CD 1936 ST3 00D6 ST4 010B STACK 2000 START 0000 1937 STKGO 0803 STKIN 0807 STKLM 1F78 STOP 013B 1938 SUBDE 047C SV1 04B3 TAB1 06B1 TAB2 06C1 1939 TAB4 0705 TAB5 0717 TAB6 071D TAB8 0725 1940 TC1 0068 TC2 0073 TN1 007C TSTNU 0077 1941 TV1 0058 TXTBG 0817 TXTEN 1F00 TXTUN 0815 1942 VARBG 1F00 VARNX 0805 WHAT 00AE XP11 0333 1943 XP12 0339 XP13 033F XP14 0346 XP15 034E 1944 XP16 0354 XP17 035A XP18 035C XP21 037A 19451 1946 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1947+ 13:28 11/10/2019 1948+ PAGE 35 1949 SYMBOL TABLE 1950 1951 1952 XP22 037D XP23 0380 XP24 0387 XP25 0398 1953 XP26 039B XP31 03A8 XP32 03C5 XP33 03CD 1954 XP34 03D8 XP35 03F7 XP40 040B XP41 0414 1955 XP42 0421 XP43 0422 1956 1957 * 02 1958 1959 1960 * 03 1961 1962 1963 * 04 1964 1965 1966 * 05 1967 1968 1969 * 06 1970 1971 1972 * 07 1973 1974 1975 * 08 1976 1977 1978 * 09 1979 1980 1981 * 10 1982 1983 1984 * 11 1985 1986 1987 * 12 1988 1989 1990 * 13 1991 1992 1993 * 14 1994 1995 1996 * 15 1997 1998 1999 * 16 2000 2001 2002 * 17 2003 2004 20051 2006 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2007+ 13:28 11/10/2019 2008+ PAGE 36 2009 SYMBOL TABLE 2010 2011 2012 * 18 2013 2014 2015 * 19 2016 2017 2018 * 20 2019 2020 2021 * 21 2022 2023 2024 * 22 2025 2026 2027 * 23 2028 2029 2030 * 24 2031 2032 2033 * 25 2034 2035 2036 * 26 2037 2038 2039 * 27 2040 2041 2042 * 28 2043 2044 2045 * 29 2046 2047 2048 * 30 2049 2050 2051 * 31 2052 2053 2054