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