11 2 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3+ 21:37 05/19/2019 4+ PAGE 1 5 6 7 8 ;EDITS: 9 ; 30-JUN-08 KJL 10 ; - CREATED FROM IMSAI 8K BASIC VERSION 1.4 MANUAL 11 ; 12 ; 07-FEB-14 UM 13 ; - FIXED TYPOS, MATCHES MANUAL NOW 14 ; 15 ; 19-JUN-19 UM 16 ; - FIXED CHARACTER LITERALS NOT WORKING WITH MACRO-80 17 ; - FIXED COMMENTS 18 ;--------------------------------------------------------- 19 ; BASIC30.ASM 1.4 05/19/77 JRB 8K BASIC 20 ; BASICS2.ASM 1.401 05/11/77 DK 8K BASIC 21 ; BASIC19.ASM 1.401 05/11/77 DH 22 ; BASIC18.ASM 1.401 05/10/77 JRB 23 ; BASIC16.ASM 1.401 05/09/77 DH 24 ; BASIC11.ASM 1.401 05/04/77 DH 25 ; BASIC10.ASM 1.401 05/03/77 DH 26 ; BASIC8.ASM 1.401 05/02/77 DH 27 ; 28 ; IMSAI 8K-9K BASIC 29 ; 30 ; COPYRIGHT (C) 1977 31 ; IMSAI MANUFACTURING CORPORATION 32 ; 14860 WICKS BLVD, SAN LEANDRO CALIFORNIA 94577 33 ; 34 ; CORRECTION HISTORY: 35 ; 36 ; 02/25/77 - FIXED BEGPR POINTERS 37 ; - FIXED LOG(X) FOR 0.5 < X < 1.0 38 ; - FIXED SQR(X) FOR 0.0 < X < 0.5 39 ; - FIXED SCI NOTATION INPUT ROUTINE 40 ; - FIXED EDIT ROUTINE WHEN PROGRAM ENDS ON 41 ; 00 BOUNDARY (SYSTEM USED TO GO AWAY) 42 ; - ADDED XEQ COMMAND (LIKE RUN BUT KEEPS DATA) 43 ; - SOFTWARE MEMORY PROTECT OF 1ST 9K IMPLIMENTED 44 ; - FIXED TAB FOR BACKWARDS MOVEMENT 45 ; - FIXED OV ERROR FOR SMALL X IN TRIG,LOG & EXP 46 ; - ADDED PROGRAM CHAINING CAPABILITY. 47 ; - FIXED EXP(X) ROUTINE FOR LARGE X. 48 ; - ADDED PEEK(X) COMMAND 49 ; - ADDED POKE A,X COMMAND 50 ; - ADDED CALL A COMMAND 51 ; 04/02/77 - ADDED TARBEL CASSETTE SAVE AND LOAD 52 ; - ADDED FIX LINE EDITOR 53 ; - RENAMED NATURAL LOG TO LN(X) 54 ; - ADDED BASE 10 LOG AS LOG(X) 55 ; - ALLOWED FOR DAZZLER IN OUTPUT ROUTINE 56 ; - ADDED LINE # SEARCH UTILITY (LOCAT EQU $) 57 ; - ADDED TABLE SEARCH UTILITY (SEEK EQU $) 58 ; - ARRAYS CAN NOW HAVE > 256 ELEMENTS PER DIM 591 60 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 61+ 21:37 05/19/2019 62+ PAGE 2 63 64 65 66 ; 04/09/77 -ADDED CONDITIONAL ASSY PARAMS FOR 8 AND 9K 67 ; -FIXED POWER ERROR. (X B WHEN B=0 GAVE X 2.) 68 ; -ADDED CONTROL H AS PHYSICAL RUBOUT OF CHAR 69 ; 04/27/77 -CHANGE RST'S TO RUN UNDER CP/M 70 ; -ADDED EXPRESSION EVALUATER FIX 71 ; -LOAD UNDER CP/M 72 ; 05/02/77 -ADD DDT, BYE COMMANDS, BIOS I/O 73 ; 05/03/77 -OPTIMIZE FUNCTION ITERATION LOOP (SIN5) 74 ; -SO UNDERFLOW CAN BE MADE NON-FATAL 75 ; 05/04/77 -OPTIMIZE SIN(X) ROUTINE 76 ; -ADD NON-FATAL ERRORS 77 ; 05/09/77 -SQUISH TO INCLUDE PEEK,POKE,CALL IN 8K 78 ; 05/11/77 -MAKE RND(X) USE X AS RANGE; X 0->1,0 X->0 79 ; -TAB(N) GO TO NEXT LINE IF PAST POSITION 80 ; 5/12/77 - BUG IN NESTED FOR'S AND REENTERED FOR'S FIXED 81 ; 82 ; ASSEMBLY PARAMETERS: 83 0000 LARGE EQU 0 ;-1=9K ASSEMBLY, 0=8K 84 0000 CPM EQU 0 ;-1=RUN UNDER CPM 85 0000 HUNTER EQU 0 ;-1= INCLUDE BAUD COMMAND 86 ; 87 ; CPM EQUATES 88 ; 89 0000 BOOT EQU 0 ;WARM BOOT 90 0005 BDOS EQU 5 ;BDOS ENTRY 91 0100 TBASE EQU 0100H ;PROGRAM LOAD UNDER CPM 92 0003 CSTAT EQU 3 ;OFFSET OF CONSOLE STATUS 93 ;...QUERY IN BIOS TABLE 94 ; 95 ; ASCII EQUATES, CHARACTER LITERALS NOT WORKING WITH MACRO-80 96 ; 97 005E UPARR EQU 05EH 98 005C BACKSL EQU 05CH 99 ; 100 ; BASIC EQUATES 101 ; 102 00F7 FATAL EQU 0F7H ;CODE FOR FATAL IS RST 6 103 ; 104 0000 BASIC: IF NOT CPM 105 0000 1 ORG 0 106 0000 1 210024 LXI H,RAM+1024 107 0003 1 3EAE MVI A,0AEH ;START OF INIT SEQUENCE 108 0005 1 C38100 JMP INIT1 ;FINISH INIT 109 ENDIF 110 ; 111 IF CPM 112 1 ORG TBASE 113 1 JMP INITC ;USE TEMPORARY CODE AT END 114 ENDIF 115 ; 116 ; ORG 8 1171 118 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 119+ 21:37 05/19/2019 120+ PAGE 3 121 122 123 124 ; 125 ; SKIP CHARS POINTED BY H,L UNTIL NON-BLANK, 126 ; LEAVE IN REG A 127 ; 128 0008 7E RST1: MOV A,M ;LOAD THE BYTE AT (H,L) 129 0009 FE20 CPI ' ' ;TEST IF BLANK 130 000B C0 RNZ ;RETURN IF NOT 131 000C 23 INX H ;POINT NEXT 132 000D C30800 JMP RST1 ;LOOP 133 ; 134 ; 135 ; ORG 16 136 ; 137 ; COMPARE STRING AT (H,L) TO STRING AT (D,E) 138 ; RETURN IF EQUAL (THRU X'00' IN D,E) OR ON FIRST NOT EQUAL 139 ; ONLY THE FIRST THREE CHARS NEED BE EQUAL 140 ; IGNORE ALL SPACES 141 ; 142 0010 C5 RST2: PUSH B ;SAVE B,C 143 0011 0600 MVI B,0 ;INIT COUNT 144 0013 CF COMP1: RST 1 ;SKIP SPACES 145 0014 1A LDAX D ;GET CHAR TO MATCH WITH 146 0015 C3791A JMP COMP2 ;CONTINUE ELSEWHERE 147 ; 148 ; 149 ; ORG 24 150 ; 151 ; STORE THE FLOATING POINT ACCUMULATOR AT (H,L) 152 ; 153 0018 115822 RST3: LXI D,FACC ;POINT FLOAT ACC 154 001B 0604 MVI B,4 ;BYTE COUNT 155 001D C34D1C JMP COPYD ;GO MOVE IT 156 ; 157 ; 158 ; ORG 32 159 ; 160 ; INCREMENT H,L BY BYTE AT (SP), RETURN TO (SP)+1 161 ; 162 0020 E3 RST4: XTHL ;GET RETURN ADDRESS IN H,L 163 0021 7E MOV A,M ;GET THE INCREMENT 164 0022 23 INX H ;POINT TRUE RETURN 165 0023 E3 XTHL ;PUT BACK TO STACK 166 0024 D5 PUSH D ;SAVE D,E 167 0025 C33B00 JMP RST4A ;CONTINUE 168 ; 169 ; 170 ; ORG 40 171 ; 172 ; LOAD THE FLOATING POINT ACCUM WITH THE 4 BYTES AT (H,L) 173 ; 174 0028 115822 RST5: LXI D,FACC ;POINT FLOAT ACC 1751 176 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 177+ 21:37 05/19/2019 178+ PAGE 4 179 180 181 182 002B 0604 MVI B,4 ;BYTE COUNT 183 002D C3581C JMP COPYH ;GO MOVE IT 184 ; 185 ; 186 ; ORG 48 187 ; 188 ; PRINT: 'XX ERR & NNN' 189 ; **** IF ERROR MESSAGE CHANGES TO A DIFFERENT RST, 190 ; **** ...CHANGE "FATAL" EQUATE 191 ; 192 0030 E3 RST6: XTHL ;SAVE HL, GET ERROR CODE PTR 193 0031 F5 PUSH PSW ;SAVE REGS 194 0032 D5 PUSH D 195 0033 C5 PUSH B 196 0034 C3311C JMP ERROR ;CONTINUE 197 ; 198 IF NOT CPM 199 003B 1 ORG 59 ;LEAVE 3 BYTES FOR DDT 200 ENDIF 201 ; 202 003B 5F RST4A: MOV E,A ;PUT IN LOW 203 003C B7 ORA A ;TEST SIGN 204 003D 1600 MVI D,0 ;DEFAULT POSITIVE 205 003F F24400 JP RST4B ;BRIF + 206 0042 16FF MVI D,0FFH ;ELSE, NEG 207 0044 19 RST4B: DAD D ;BUMP H,L 208 0045 D1 POP D ;RESTORE D,E 209 0046 C9 RET ;RETURN 210 ;PAGE 211 0047 434F5059 DB 'COPYRIGHT (C) 1977 ' 212 004B 52494748 213 004F 54202843 214 0053 29203139 215 0057 373720 216 005A 494D5341 DB 'IMSAI MFG CORP ' 217 005E 49204D46 218 0062 4720434F 219 0066 525020 220 0069 53414E20 DB 'SAN LEANDRO CA 94577 USA' 221 006D 4C45414E 222 0071 44524F20 223 0075 43412039 224 0079 34353737 225 007D 20555341 226 ; 227 ; INITIALIZATION ROUTINE 228 ; DETERMINE MEMORY SIZE. 229 ; (START AT 9K AND TRY 1K INCREMENTS TILL END) 230 ; SETUP POINTERS FOR STACK, DATA, AND PROGRAM 231 ; INIT SIO BOARD 232 ; 2331 234 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 235+ 21:37 05/19/2019 236+ PAGE 5 237 238 239 240 0081 INIT1: IF NOT CPM 241 0081 1 D303 OUT TTY+1 ;INIT TERMINAL 242 0083 1 3E40 MVI A,40H 243 0085 1 D303 OUT TTY+1 244 0087 1 3EBA MVI A,0BAH 245 0089 1 D303 OUT TTY+1 246 008B 1 3E37 MVI A,37H 247 008D 1 D303 OUT TTY+1 248 008F 1 010004 LXI B,1024 ;1K INCR 249 0092 1 7E INIT2: MOV A,M ;GET A BYTE FROM MEMORY 250 0093 1 2F CMA ;COMPLEMENT 251 0094 1 77 MOV M,A ;REPLACE 252 0095 1 BE CMP M ;TEST IF RAM/ROM/END 253 0096 1 C29F00 JNZ INIT3 ;BRIF OUT OF RAM 254 0099 1 2F CMA ;RE-COMPLEMENT 255 009A 1 77 MOV M,A ;PUT ORIG BACK 256 009B 1 09 DAD B ;POINT NEXT BLOCK 257 009C 1 D29200 JNC INIT2 ;LOOP 258 ENDIF 259 ; 260 009F F9 INIT3: SPHL ;SET STACK POINTER TO END OF MEMORY 261 00A0 0100FF LXI B,-256 ;ALLOW 256 BYTES FOR STACK 262 00A3 09 DAD B ;ADD TO ADDRESS 263 00A4 229122 SHLD DATAB ;SAVE ADDR OF START OF DATA 264 ; 265 ; SOFTWARE WRITE PROTECT OF FIRST 9K OF RAM. 266 ; 267 ; BUT NO PROTECT UNDER CPM OR FOR 8K (EPROM) VERSION 268 IF LARGE AND NOT CPM 269 1 MVI A,2 ;SET PROTECT OF FIRST 1K BLOCK 270 1 PROTC: OUT 0FEH ;SEND IT 271 1 ADI 4 ;ADDRESS NEXT 1K BLOCK 272 1 CPI 26H ;STOP AFTER 9 BLOCKS 273 1 JNZ PROTC ;CONTINUE TO PROTECT 274 ENDIF 275 00A7 AF XRA A ;GET A ZERO IN A 276 00A8 F5 PUSH PSW ;SET STACK 1 LEVEL DEEP WITHOUT A GOSUB 277 00A9 210000 LXI H,0 ;CLEAR H,L 278 00AC 39 DAD SP ;SP TO H,L 279 00AD 228B22 SHLD STACK ;SAVE BEG OF STACK 280 00B0 CD5101 CALL IRAM ;INIT RAM 281 00B3 116B1D LXI D,NRNDX ;POINT TO RANDOM # SERIES 282 00B6 0608 MVI B,8 ;LOAD COUNT 283 00B8 CD4D1C CALL COPYD ;COPY TO TRND<X> IN RAM TABLE 284 00BB 3602 MVI M,2 ;SET RANDOM SWITCH 285 IF CPM 286 1 CALL NEW0 ;AUTOMATIC "NEW" 287 ENDIF 288 00BD 21781D LXI H,VERS ;POINT VERSION MESSAGE 289 00C0 CDBD19 RDYM: CALL TERMM ;WRITE IT 290 ; 2911 292 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 293+ 21:37 05/19/2019 294+ PAGE 6 295 296 297 298 00C3 RDY EQU $ 299 ; 300 ; PRINT 'READY' 301 ; 302 00C3 21261E LXI H,READY ;POINT READY MSG 303 00C6 CDBD19 CALL TERMM ;GO PRINT IT 304 ; 305 00C9 GETCM EQU $ 306 ; 307 ; 308 ; COMMAND INPUT ROUTINE 309 ; 310 ; READ A LINE FROM THE TTY 311 ; IF STARTS WITH NUMERIC CH, ASSUME IT'S A BASIC STATEMENT 312 ; IF NOT, IT IS EITHER AN IMMEDIATE STATMENT, OR A COMMAND 313 ; 314 00C9 3E3A MVI A,':' ;PROMPT & ON SET FOR SW 315 00CB 327620 STA EDSW ;SET MODE=EDIT 316 00CE 2A8B22 LHLD STACK ;GET STACK ADDRESS 317 00D1 F9 SPHL ;SET REG SP 318 00D2 CD0419 CALL TERMI ;GET A LINE 319 00D5 CDB51A CALL PACK ;GO PACK THE NUMBER INTO B,C 320 00D8 78 MOV A,B ;GET HI BYTE OF LINE NUMBER 321 00D9 B1 ORA C ;PLUS LOW BYTE 322 00DA CA6401 JZ EXEC ;BRIF EXEC STATEMENT 323 00DD C5 PUSH B ;SAVE LINE NUMBER 324 00DE 117D20 LXI D,IMMED+1 ;POINT SAVE AREA 325 00E1 EB XCHG ;FLIP/FLOP 326 00E2 70 MOV M,B ;PUT LO LINE 327 00E3 23 INX H ;POINT NEXT 328 00E4 71 MOV M,C ;PUT LO LINE 329 00E5 23 INX H ;POINT NEXT 330 00E6 0603 MVI B,3 ;INIT COUNT 331 00E8 1A EDIT1: LDAX D ;GET A BYTE 332 00E9 77 MOV M,A ;PUT IT DOWN 333 00EA 04 INR B ;COUNT IT 334 00EB 23 INX H ;POINT NEXT 335 00EC 13 INX D ;DITTO 336 00ED B7 ORA A ;TEST BYTE JUST MOVED 337 00EE C2E800 JNZ EDIT1 ;LOOP 338 00F1 78 MOV A,B ;GET COUNT 339 00F2 327C20 STA IMMED ;STORE THE COUNT 340 00F5 C1 POP B ;GET LINE NUM 341 00F6 CD5E1F CALL LOCAT ;GO FIND REQUESTED LINE NUMBER 342 00F9 E5 PUSH H ;SAVE H,L 343 00FA DA1401 JC EDIT5 ;BRIF IF LINE NOT FOUND 344 00FD 54 EDIT2: MOV D,H ;COPY ADDR 345 00FE 5D MOV E,L ;TO D,E 346 00FF 0600 MVI B,0 ;GET A ZERO 347 0101 4E MOV C,M ;GET LEN 348 0102 09 DAD B ;POINT NEXT STMT 3491 350 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 351+ 21:37 05/19/2019 352+ PAGE 7 353 354 355 356 0103 7E EDIT3: MOV A,M ;GET LEN NEXT STMT 357 0104 B7 ORA A ;TEST IT 358 0105 CA0F01 JZ EDIT8 ;BRIF END 359 0108 47 MOV B,A ;SET LENGTH 360 0109 CD581C CALL COPYH ;ELSE MOVE LINE 361 010C C30301 JMP EDIT3 ;LOOP 362 010F EB EDIT8: XCHG ;PUT NEW ADDR TO H,L 363 0110 77 MOV M,A ;MARK END 364 0111 229322 SHLD PROGE ;AND UPDATE ADDRESS 365 0114 3A7C20 EDIT5: LDA IMMED ;GET LEN OF INSERT 366 0117 FE04 CPI 4 ;TEST IF DELETE 367 0119 CAC900 JZ GETCM ;BRIF IS 368 011C 4F MOV C,A ;SET LO LEN 369 011D 0600 MVI B,0 ;ZERO HI LEN 370 011F 2A9322 LHLD PROGE ;GET END OF PROG 371 0122 54 MOV D,H ;COPY TO 372 0123 5D MOV E,L ;D,E 373 0124 09 DAD B ;DISP LEN OF INSERT 374 0125 229322 SHLD PROGE ;UPDATE END POINT 375 0128 C1 POP B ;GET ADDR 376 0129 1A EDIT6: LDAX D ;GET A BYTE 377 012A 77 MOV M,A ;COPY IT 378 012B 1B DCX D ;POINT PRIOR 379 012C 2B DCX H ;DITTO 380 012D 7A MOV A,D ;GET HI ADDR 381 012E B8 CMP B ;COMPARE 382 012F CA3501 JZ EDIT7 ;BRIF HI EQUAL 383 0132 D22901 JNC EDIT6 ;BRIF NOT LESS 384 0135 7B EDIT7: MOV A,E ;GET LO ADDR 385 0136 B9 CMP C ;COMPARE 386 0137 D23D01 JNC ED7A ;MUST TEST FOR 00 BOUNDARY 387 013A C34601 JMP ED7B ;GO AROUND BOUNDARY TEST CODE 388 013D 2F ED7A: CMA ;COMPLIMENT LOW LINE NUMBER 389 013E B9 CMP C ;AND COMPARE TO START 390 013F C22901 JNZ EDIT6 ;BRIF NOT = 391 0142 B7 ORA A ;NOT TEST FOR 00 392 0143 C22901 JNZ EDIT6 ;THIS IS USUAL CASE 393 0146 13 ED7B: INX D ;POINT FORWARD 394 0147 217C20 LXI H,IMMED ;POINT INSERT 395 014A 46 MOV B,M ;GET LENGTH 396 014B CD581C CALL COPYH ;GO MOVE IT 397 014E C3C900 JMP GETCM ;GO GET ANOTHER COMMAND 398 ; 399 ; IRAM INITIALIZE RAM 400 ; ZEROES RAM FROM BZERO TO EZERO 401 ; INITS RANDOM # CONSTANTS 402 ; RETURNS H=PTR TO TRND 403 ; 404 0151 210020 IRAM: LXI H,BZERO ;CLEAR BZERO->EZERO 405 0154 0677 MVI B,EZERO-BZERO 406 0156 CD5E1C CALL ZEROM 4071 408 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 409+ 21:37 05/19/2019 410+ PAGE 8 411 412 413 414 0159 116B1D LXI D,NRNDX ;MOVE RANDOM # SERIES TO RNDX 415 015C 217722 LXI H,RNDX 416 015F 0608 MVI B,8 ;COUNT 417 0161 C34D1C JMP COPYD ;MOVE IT & RETURN 418 ;PAGE 419 0164 EXEC EQU $ 420 ; 421 ; 422 ; DECODE COMMAND IN IOBUFF 423 ; EXECUTE IF POSSIBLE 424 ; THEN GOTO GET NEXT COMMAND 425 ; 426 ; 427 0164 327422 STA MULTI ;RESET MULTI SW 428 0167 328822 STA FNMOD ;RESET FN TYPE 429 016A 3C INR A ;GET A ONE 430 016B 327520 STA RUNSW ;SET IMMEDIATE MODE 431 016E 21CF20 LXI H,IOBUF+1 ;POINT SMT 432 0171 117C20 LXI D,IMMED ;POINT NEW AREA 433 0174 7E EXEC1: MOV A,M ;GET A BYTE 434 0175 12 STAX D ;PUT TO (D,L) 435 0176 13 INX D ;POINT NEXT 436 0177 23 INX H ;DITTO 437 0178 B7 ORA A ;TEST BYTE 438 0179 C27401 JNZ EXEC1 ;CONTINUE 439 017C 21EC1D LXI H,NULLI ;POINT NO LINE NUM 440 017F 228922 SHLD LINE ;SAVE ADDR 441 0182 217C20 LXI H,IMMED ;POINT START OF CMMD 442 0185 C33702 JMP RUN3 ;GO INTO RUN PROCESSOR 443 ; 444 0188 NEW EQU $ 445 ; 446 ; NEW COMMAND 447 ; 'NEW'==>CLEAR PROGRAM AND DATA 448 ; 'NEW*'==>CLEAR PROGRAM ONLY 449 ; 450 0188 E5 PUSH H ;SAE PTR 451 0189 21C900 LXI H,GETCM ;MAKE SUBROUTINE 452 018C E3 XTHL ;RESTORE H 453 018D CF RST 1 ;GET 1ST NON-BLANK CHAR AFTER 'NEW' 454 018E DE2A SBI '*' ;TEST 455 0190 CA9801 JZ NEW1 ;BRIF PROGRAM CLEAR ONLY 456 0193 AF NEW0: XRA A ;GET A ZERO 457 0194 2A9122 LHLD DATAB ;POINT DATA AREA 458 0197 77 MOV M,A ;CLEAR IT 459 0198 219622 NEW1: LXI H,BEGPR ;POINT START 460 019B 229322 SHLD PROGE ;RESET PROGRAM END 461 019E 77 MOV M,A ;CLEAR IT 462 019F C9 RET 463 ; 464 01A0 FREE EQU $ 4651 466 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 467+ 21:37 05/19/2019 468+ PAGE 9 469 470 471 472 ; 473 ; FREE COMMAND 474 ; COMPUTE AMOUNT OF AVAILABLE STORAGE (EXCLUDING DATA AREA) 475 ; 476 01A0 2A9122 LHLD DATAB ;GET DATA BEG ADDRESS 477 01A3 EB XCHG ;PUT IN D,E 478 01A4 2A9322 LHLD PROGE ;GET PROGRAM END ADDRESS 479 01A7 7B MOV A,E ;LO ADDR TO REG A 480 01A8 95 SUB L ;SUBTRACT 481 01A9 5F MOV E,A ;SAVE IT 482 01AA 7A MOV A,D ;HI ADDR TO REG A 483 01AB 9C SBB H ;SUBTRACT 484 01AC 57 MOV D,A ;SAVE IT 485 01AD CD891C CALL BINFL ;GO FLOAT D,E 486 01B0 21CE20 LXI H,IOBUF ;POINT BUFFER 487 01B3 CDF014 CALL FOUT ;GO CONVERT TO OUTPUT 488 01B6 3600 MVI M,0 ;MARK END 489 01B8 CDB519 CALL TERMO ;GO WRITE IT 490 01BB C3C900 JMP GETCM ;CONTINUE 491 ; 492 01BE TAPE EQU $ 493 ; 494 ; TAPE COMMAND. DON'T ECHO INPUT. CONTINUE UNTIL KEY 495 ; COMMAND. 496 ; 497 01BE 3E01 MVI A,1 ;SET TAPE INPUT SWITCH 498 01C0 327120 STA TAPES ;STORE IT 499 01C3 3E11 MVI A,11H ;GET DC1 (=READER ON) 500 01C5 CD4F19 CALL TESTO ;WRITE IT 501 01C8 C3C900 JMP GETCM ;GO PROCESS INPUT 502 ; 503 01CB ENDIT EQU $ 504 ; 505 ; END COMMAND. IF TAPE PUNCH SWITCH IS ON, PUNCH 'KEY' THEN 506 ; CONTINUE 507 ; 508 01CB 3A7120 LDA TAPES ;GET PAPER TAPE SWITCH 509 01CE FE02 CPI 2 ;TEST FOR SAVE 510 01D0 C2C300 JNZ RDY ;BRIF NOT 511 01D3 21791E LXI H,KEYL ;POINT 'KEY' 512 01D6 CDBD19 CALL TERMM ;WRITE IT 513 01D9 CDE601 CALL HDRTL ;GO PUT TRAILER 514 ; 515 ; KEY COMMAND. RESET TAPE SWITCH. TURN READER OFF 516 ; 517 01DC AF KEY: XRA A ;RESET TAPE SWITCH 518 01DD 327120 STA TAPES 519 01E0 21621D LXI H,PCHOF ;POINT READER/PUNCH OFF 520 01E3 C3C000 JMP RDYM ;PRINT POFF+READY MESSAGE 521 ; 522 01E6 HDRTL EQU $ 5231 524 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 525+ 21:37 05/19/2019 526+ PAGE 10 527 528 529 530 ; 531 ; PUNCH HEADER OR TRAILER ON PAPER TAPE. 532 ; 533 01E6 0619 MVI B,25 ;LOAD COUNT 534 01E8 3EFF HDR1: MVI A,0FFH ;LOAD RUBOUT 535 01EA CD4F19 CALL TESTO ;WRITE IT 536 01ED 05 DCR B ;DECREMENT COUNT 537 01EE AF XRA A ;ZERO A 538 01EF B8 CMP B ;TEST COUNT 539 01F0 C8 RZ ;RETURN ON ZERO 540 01F1 C3E801 JMP HDR1 ;CONTINUE 541 ;PAGE 542 ; 543 ; RUN PROCESSOR, GET NEXT STATMENT, AND EXECUTE IT 544 ; IF IN IMMEDIATE MODE, THEN RETURN TO GETCMMD 545 ; 546 01F4 AF RUNCM: XRA A ;PUT A ZERO TO A 547 01F5 2A9122 LHLD DATAB ;GET ADDRESS OF DATA POOL 548 01F8 77 MOV M,A ;INITIALIZE TO 0 549 01F9 XEQ EQU $ ;START FOR EXECUTION WITH OLD DATA 550 01F9 CD5101 CALL IRAM ;INITALIZE START OF RAM 551 01FC 219522 LXI H,BEGPR-1 ;POINT 1 PRIOR TO BEGIN 552 01FF 228F22 SHLD DATAP ;RESTORE DATA STMT POINTER 553 0202 3600 MVI M,0 ;RESET DATA STMT POINTER 554 0204 23 INX H ;POINT TO START 555 0205 227022 SHLD STMT ;SAVE IT 556 0208 C32502 JMP RUN2 ;GO PROCESS IT 557 ; 558 ; STATEMENTS RETURN HERE TO CONTINUE PROCESSING 559 020B 217422 RUN: LXI H,MULTI ;POINT MULTIPLE SWITCH 560 020E 7E MOV A,M ;GET SW 561 020F B7 ORA A ;TEST IT 562 0210 CA1B02 JZ RUN1 ;BRIF NOT ON 563 0213 3600 MVI M,0 ;ELSE, RESET IT 564 0215 2A7222 LHLD ENDLI ;GET ADDRESS 565 0218 C33702 JMP RUN3 ;GO PROCESS REMAIN 566 021B 2A7022 RUN1: LHLD STMT ;ELSE, GET ADDR OF PREV STMT 567 021E 5E MOV E,M ;GET LEN CODE 568 021F 1600 MVI D,0 ;CLEAR HIGH BYTE OF ADDR 569 0221 19 DAD D ;INCR STMT POINTER 570 0222 227022 SHLD STMT ;SAVE IT 571 0225 3A7520 RUN2: LDA RUNSW ;GET RUN TYPE 572 0228 B7 ORA A ;TEST IT 573 0229 C2C900 JNZ GETCM ;BRIF IMMEDIATE MODE 574 022C 7E MOV A,M ;GET LEN CODE 575 022D B7 ORA A ;TEST IF END 576 022E CACB01 JZ ENDIT ;BRIF IS 577 0231 23 INX H ;POINT LINE NUMBER 578 0232 228922 SHLD LINE ;SAVE ADDR 579 0235 23 INX H ;POINT 2ND BYTE 580 0236 23 INX H ;POINT 1ST PGM BYTE 5811 582 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 583+ 21:37 05/19/2019 584+ PAGE 11 585 586 587 588 ; 589 ; ENTER HERE TO DO IMMEDIATE COMMAND 590 0237 CF RUN3: RST 1 ;SKIP BLANKS 591 0238 225222 RUN4: SHLD ADDR1 ;SAVE ADDR 592 023B CD3A1A CALL TSTCC ;GO SEE IF CONTROL-C OR O 593 023E 114C1E LXI D,JMPTB ;POINT TO TABLE 594 0241 CD861F CALL SEEK1 ;GO SEARCH COMMAND TABLE 595 0244 CA4F02 JZ RUN7 ;BRIF COMMAND NOT FOUND 596 0247 E5 PUSH H ;SAVE H,L 597 0248 1A LDAX D ;LOAD LOW BYTE 598 0249 6F MOV L,A ;LOW BYTE TO L 599 024A 13 INX D ;POINT NEXT 600 024B 1A LDAX D ;LOAD HIGH BYTE 601 024C 67 MOV H,A ;HIGH BYTE TO H 602 024D E3 XTHL ;COMMAND ADDRESS TO STACK 603 024E C9 RET ;JUMP TO ROUTINE 604 024F 2A5222 RUN7: LHLD ADDR1 ;RESTORE H,L POINTER 605 0252 C3F105 JMP LET ;ASSUME IT'S LET STMT 606 ;PAGE 607 ; 608 ; SAVE COMMAND. TURN THE PUNCH ON THEN LIST PROGRAM 609 ; 610 0255 3E02 SAVE: MVI A,2 ;SET PUNCH MODE 611 0257 327120 STA TAPES 612 025A 3E12 MVI A,12H ;GET DC2 (=PUNCH ON) 613 025C CD4F19 CALL TESTO ;WRITE IT 614 025F CDE601 CALL HDRTL ;GP PUT HEADER 615 ; 616 0262 LIST EQU $ 617 ; 618 ; 619 ; LIST PROCESSOR 620 ; DUMP THE SOURCE PROGRAM TO TTY OR PAPER TAPE 621 ; 622 ; 623 0262 CF RST 1 ;SKIP TO NON BLANK 624 0263 110000 LXI D,0 ;GET A ZERO IN D 625 0266 EB XCHG ;FLIP TO H,L 626 0267 224B22 SHLD LINEL ;SAVE IT 627 026A 219999 LXI H,9999H ;GET HIGH NUMBER IN H,L 628 026D 224D22 SHLD LINEH ;SAVE IT 629 0270 EB XCHG ;FLIP BACK 630 0271 B7 ORA A ;TEST IF EOL 631 0272 CA9202 JZ LIST1 ;BRIF IT IS 632 0275 CDB51A CALL PACK ;GO PACK THE NUMBER, IF ANY 633 0278 50 MOV D,B ;COPY NUMBER TO D,L 634 0279 59 MOV E,C ;SAME 635 027A EB XCHG ;FLIP TO H,L 636 027B 224B22 SHLD LINEL ;SAVE IT 637 027E 224D22 SHLD LINEH ;SAME 638 0281 EB XCHG ;RESTORE H,L 6391 640 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 641+ 21:37 05/19/2019 642+ PAGE 12 643 644 645 646 0282 CF RST 1 ;SKIP TO NON BLANK 647 0283 FE2C CPI ',' ;TEST IF COMMA 648 0285 C29202 JNZ LIST1 ;BRIF NOT 649 0288 23 INX H ;POINT NEXT 650 0289 CF RST 1 ;SKIP TO NON-BLANK 651 028A CDB51A CALL PACK ;ELSE, GO GET THE NUMBER 652 028D 60 MOV H,B ;COPY TO 653 028E 69 MOV L,C ;D,L 654 028F 224D22 SHLD LINEH ;SAVE IT 655 0292 219622 LIST1: LXI H,BEGPR ;POINT BEGINNING OF PROGRAM 656 0295 CD3A1A LIST2: CALL TSTCC ;GO SEE IF CONTROL-C OR CONTROL-O 657 0298 7E MOV A,M ;GET LEN CODE 658 0299 B7 ORA A ;TEST IF END OF PROGRAM 659 029A CACB01 JZ ENDIT ;BRIF END OF PGM 660 029D D603 SUI 3 ;SUBTRACT THREE 661 029F 47 MOV B,A ;SAVE LEN 662 02A0 23 INX H ;POINT HIGH BYTE OF LINE# 663 02A1 EB XCHG ;FLIP H,L TO D,E 664 02A2 2A4B22 LHLD LINEL ;GET LOW LINE TO TEST 665 02A5 EB XCHG ;RESTORE H,L 666 02A6 7E MOV A,M ;GET LOW BYTE OF LINE NUMBER 667 02A7 BA CMP D ;COMP WITH LINEL 668 02A8 DAE502 JC LIST8 ;BRIF LESS 669 02AB C2B502 JNZ LIST4 ;BRIF NOT EQUAL 670 02AE 23 INX H ;POINT NEXT 671 02AF 7E MOV A,M ;GET NEXT BYTE OF LINE# 672 02B0 2B DCX H ;POINT BACK 673 02B1 BB CMP E ;COMP LOW BYTES 674 02B2 DAE502 JC LIST8 ;BRIF LESS 675 02B5 EB LIST4: XCHG ;SAVE H,L IN D,E 676 02B6 2A4D22 LHLD LINEH ;GET HIGH LINE FOR TEST 677 02B9 EB XCHG ;RESTORE H,L 678 02BA 7E MOV A,M ;GET LINE BYTE 679 02BB BA CMP D ;COMPARE HIGH BYTES 680 02BC CAC502 JZ LIST5 ;BRIF EQUAL 681 02BF D2CB01 JNC ENDIT ;BRIF HIGHER 682 02C2 C3CF02 JMP LIST6 ;GO AROUND 683 02C5 23 LIST5: INX H ;POINT NEXT 684 02C6 7E MOV A,M ;GET NEXT BYTE 685 02C7 2B DCX H ;POINT BACK 686 02C8 BB CMP E ;COMPARE LOW BYTES 687 02C9 CACF02 JZ LIST6 ;BRIF EQUAL 688 02CC D2CB01 JNC ENDIT ;BRIF HIGHER 689 02CF 11CE20 LIST6: LXI D,IOBUF ;POINT BUFFER AREA 690 02D2 CD091A CALL LINEO ;CONVERT LINE NUMBER 691 02D5 7E LIST7: MOV A,M ;GET A BYTE 692 02D6 12 STAX D ;PUT IT TO BUFFER 693 02D7 13 INX D ;POINT NEXT BUFF 694 02D8 23 INX H ;POINT NEXT PROG 695 02D9 05 DCR B ;DECR CTR 696 02DA C2D502 JNZ LIST7 ;LOOP 6971 698 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 699+ 21:37 05/19/2019 700+ PAGE 13 701 702 703 704 02DD E5 PUSH H ;SAVE HL ADDR 705 02DE CDB519 CALL TERMO ;GO TYPE IT 706 02E1 E1 POP H ;RETRIEVE H ADDR 707 02E2 C39502 JMP LIST2 ;CONTINUE 708 02E5 58 LIST8: MOV E,B ;PUT LEN IN E 709 02E6 1600 MVI D,0 ;CLEAR D 710 02E8 19 DAD D ;POINT NEXT STMT 711 02E9 23 INX H ;POINT NEXT 712 02EA 23 INX H ;POINT LEN CODE 713 02EB C39502 JMP LIST2 ;GO LIST IT 714 ; 715 ; 716 02EE CONTI EQU $ 717 ; 718 ; CONTINUE EXECUTION AT STATEMENT FOLLOWING STOP OR AT 719 ; STATEMENT THAT WAS INTERRUPTED WHEN CONTROL-C WAS TYPED 720 ; 721 ; 722 02EE 217720 LXI H,LINEN ;POINT LINE NUMBER OF LAST STOP/ERROR/ 723 02F1 7E MOV A,M ;GET 1ST CHAR 724 02F2 B7 ORA A ;TEST IF IMMED CMMD 725 02F3 CAF105 JZ LET ;BRIF IF IMMED CMMD 726 ;PAGE 727 ; 728 ; 729 ; STMT: GOTO NNNN 730 ; 731 ; 732 02F6 AF GOTO: XRA A ;CLEAR REG A 733 02F7 327620 STA EDSW ;RESET IMMED MODE (IF IT WAS SET) 734 02FA 327520 STA RUNSW ;AND RUN TYPE 735 02FD CDAD1A CALL NOTEO ;ERROR IF END-OF-LINE 736 0300 CDB51A CALL PACK ;GO GET LINE NUMBER IN B,C 737 0303 CD941A CALL EOL ;ERROR IF NOT END-OF-LINE 738 0306 CD5E1F GOTO2: CALL LOCAT ;GO SEARCH FOR REQUESTED LINE # 739 0309 DA031C JC ULERR ;BRIF NOT FOUND 740 030C 227022 SHLD STMT ;SAVE ADDR 741 030F AF XRA A ;GET A ZERO 742 0310 327422 STA MULTI ;TURN OFF MULTIPLE STMTS 743 0313 C32502 JMP RUN2 ;GO PROCESS THE STATEMENT 744 ; 745 ; 746 ; STMT: RESTORE 747 ; 748 0316 CD941A RESTO: CALL EOL ;ERROR IF NOT END-OF-LINE 749 0319 219522 LXI H,BEGPR-1 ;POINT 1 BEFORE START OF PROGRAM 750 031C 228F22 SHLD DATAP ;FORCE NEXT DATA TO BE AT START 751 031F C30B02 JMP RUN ;GO NEXT STMT 752 ; 753 ; 754 ; STMT: RETURN 7551 756 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 757+ 21:37 05/19/2019 758+ PAGE 14 759 760 761 762 ; 763 0322 CD941A RETUR: CALL EOL ;ERROR IF NOT END-OF-LINE 764 0325 F1 POP PSW ;POP THE STACK 765 0326 FEFF CPI 0FFH ;TEST IF GOSUB IN EFFECT 766 0328 C2131C JNZ RTERR ;BRIF ERROR 767 032B E1 POP H ;GET RETURNED STATMENT ADDRESS 768 032C 227022 SHLD STMT ;RESTORE 769 032F E1 POP H ;GET ENDLINE VALUE 770 0330 227222 SHLD ENDLI ;RESTORE 771 0333 F1 POP PSW ;GET MULTI SW VALUE 772 0334 327422 STA MULTI ;RESTORE 773 0337 C30B02 JMP RUN ;CONTINUE (AT STMT FOLLOWING GOSUB) 774 ; 775 ; 776 ; STMT: GOSUB NNNN 777 ; 778 033A CDAD1A GOSUB: CALL NOTEO ;ERROR IF END-OF-LINE 779 033D CDB51A CALL PACK ;GET LINE NUMBER 780 0340 CD941A CALL EOL ;ERROR IF NOT END-OF-LINE 781 0343 3A7422 GOSU1: LDA MULTI ;GET SW SETTING 782 0346 F5 PUSH PSW ;SAVE ON STACK 783 0347 2A7222 LHLD ENDLI ;GET ADDR OF END OF STMT 784 034A E5 PUSH H ;SAVE ONE STACK 785 034B 2A7022 LHLD STMT ;GET STATEMENT ADDRESS 786 034E E5 PUSH H ;SAVE RETURN ADDRESS IN STACK 787 034F 3EFF MVI A,0FFH ;MARK AS GOSUB 788 0351 F5 PUSH PSW ;SAVE STATUS 789 0352 C30603 JMP GOTO2 ;GO LOOKUP LINE AND BRANCH 790 ;PAGE 791 ; 792 0355 PRINT EQU $ 793 ; 794 ; 795 ; STMT: PRINT .... 796 ; 797 ; 798 0355 AF XRA A ;CLEAR REG A 799 0356 328D22 PRIN4: STA PRSW ;SET SW TO SAY CRLF AT END OF LINE 800 0359 11CE20 LXI D,IOBUF ;POINT BUFFER 801 035C CF RST 1 ;SKIP TO NEXT FIELD 802 ; 803 035D CDA81A CALL TSTEL ;TEST IF END OF STMT 804 0360 CAD303 JZ PRINC ;BRIF IT IS 805 0363 FE2C CPI ',' ;TEST IF COMMA 806 0365 CAAA03 JZ PRIN8 ;BRIF IT IS 807 0368 FE3B CPI ';' ;TEST IF SEMI-COLON 808 036A CAAD03 JZ PRIN9 ;BRIF IT IS 809 036D D5 PUSH D ;SAVE D,E 810 036E E5 PUSH H ;SAVE H,L 811 036F 11891D LXI D,TABLI ;POINT LITERAL 812 0372 D7 RST 2 ;GO SEE IF TAB(XX) 8131 814 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 815+ 21:37 05/19/2019 816+ PAGE 15 817 818 819 820 0373 CAB303 JZ PRINA ;BRIF IS 821 0376 E1 POP H ;ELSE, RESTORE H,L 822 0377 CD800F CALL EXPR ;GO EVALUATE EXPRESSION 823 037A D1 POP D ;RESTORE D,E 824 037B E5 PUSH H ;SAVE H,L 825 037C EB XCHG ;FLIP/FLOP 826 037D 3A8E22 LDA NS ;GET TYPE OF RESULT 827 0380 FEE7 CPI 0E7H ;TEST IF STRING 828 0382 CA9603 JZ PRIN5 ;BRIF IS 829 0385 CDF014 CALL FOUT ;GO CONVERT OUTPUT 830 0388 23 INX H ;POINT NEXT 831 0389 EB PRIN7: XCHG ;FLIP/FLOP: END ADDR TO DE 832 038A E1 POP H ;RESTORE H,L 833 ;HERE AFTER SETTING UP VALUE TO PRINT IN BUFFER 834 038B 3EFE PRIN2: MVI A,0FEH ;SET END CODE=NO CRLF 835 038D 12 STAX D ;PUT TO BUFFER 836 038E E5 PUSH H ;SAVE H,L 837 038F CDB519 CALL TERMO ;GO PRINT BUFFER 838 0392 E1 POP H ;RESTORE HL 839 0393 C35503 JMP PRINT ;REPEAT FOR NEXT FIELD 840 ; 841 0396 112021 PRIN5: LXI D,STRIN ;POINT STRING 842 0399 1A LDAX D ;GET LEN 843 039A B7 ORA A ;TEST IT 844 039B CA8903 JZ PRIN7 ;BRIF NULL 845 039E 47 MOV B,A ;SAVE LEN 846 039F 13 PRIN6: INX D ;POINT NEXT 847 03A0 1A LDAX D ;GET A BYTE 848 03A1 77 MOV M,A ;STORE IT 849 03A2 23 INX H ;POINT NEXT 850 03A3 05 DCR B ;DECR CTR 851 03A4 C29F03 JNZ PRIN6 ;LOOP 852 03A7 C38903 JMP PRIN7 ;DIDDLE DE, HL AND CONTINUE 853 ; 854 03AA CDDF19 PRIN8: CALL TABST ;GO POSITION NEXT TAB 855 03AD 23 PRIN9: INX H ;PRINT NEXT 856 03AE 3E01 MVI A,1 ;GET SETTTING FOR SW 857 03B0 C35603 JMP PRIN4 ;GO STORE A IN PRSW & DO NEXT FIELD 858 03B3 D1 PRINA: POP D ;GET RID OF STACK ENTRY 859 03B4 CD800F CALL EXPR ;GO EVALUATE 860 03B7 E5 PUSH H ;SAVE H,L 861 03B8 CD661C CALL FBIN ;CONVERT TO BINARY 862 03BB F5 PUSH PSW ;SAVE SPECIFIED COLUMN 863 03BC 217622 LXI H,COLUM ;POINT CURRENT POSITION 864 03BF 96 SUB M ;SUBTRACT (LEAVES NUMBER OF FILLS) 865 03C0 FC5A19 CM CRLF ;NEXT LINE IF ALREADY PAST 866 03C3 F1 POP PSW ;RESTORE COL 867 03C4 96 SUB M ;GET NUMBER FILLS 868 03C5 E1 POP H 869 03C6 D1 POP D 870 03C7 47 MOV B,A ;SAVE COUNT 8711 872 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 873+ 21:37 05/19/2019 874+ PAGE 16 875 876 877 878 03C8 3E20 MVI A,' ' ;GET FILL 879 03CA CA8B03 PRINB: JZ PRIN2 ;BRIF COUNT ZERO 880 03CD 12 STAX D ;PUT ONE SPACE 881 03CE 13 INX D ;POINT NEXT 882 03CF 05 DCR B ;DECR CTR 883 03D0 C3CA03 JMP PRINB ;LOOP 884 ; 885 03D3 CD941A PRINC: CALL EOL ;SAVE EOL POSITION 886 ;HERE TO PRINT FINAL CR/LF (OR NOT) AND GO TO NEXT STATEMENT 887 03D6 3A8D22 LDA PRSW ;GET SWITCH 888 03D9 47 MOV B,A ;SAVE ,; SWITCH 889 03DA 3A7320 LDA OUTSW ;GET CONTROL-O SWITCH 890 03DD B7 ORA A ;TEST IF CONTROL-O IN EFFECT 891 03DE B0 ORA B ;AND IF STATEMENT ENDED IN , OR ; 892 03DF CC5A19 CZ CRLF ;CRLF IF NEITHER 893 03E2 C30B02 JMP RUN ;CONTINUE NEXT STATEMENT 894 ;PAGE 895 ; 896 03E5 FOR EQU $ 897 ; 898 ; 899 ; STMT: FOR VAR = EXPR TO EXPR STEP EXPR 900 ; 901 ; 902 ; FIRST EVALUATE ARGUMENTS AND STORE POINTERS AND VALUES, 903 ; BUT DO NOT MAKE TABLE ENTRY YET 904 03E5 CDC91B CALL VAR ;NEXT WORD MUST BE VARIABLE 905 03E8 EB XCHG ;FLIP/FLOP 906 03E9 222322 SHLD INDX ;SAVE VARIABLE NAME 907 03EC EB XCHG ;FLIP/FLOP AGAIN 908 03ED FE3D CPI '=' ;TEST FOR EQUAL SIGN 909 03EF C20F1C JNZ SNERR ;BRIF NO EQUAL 910 03F2 23 INX H ;POINT NEXT 911 03F3 CD800F CALL EXPR ;GO EVALUATE EXPR, IF ANY 912 03F6 EB XCHG ;FLIP/FLOP AGAIN 913 03F7 2A2322 LHLD INDX ;GET INDEX NAME 914 03FA EB XCHG ;FLIP/FLOP 915 03FB E5 PUSH H ;SAVE H,L 916 03FC CD341B CALL SEARC ;GO LOCATE NAME 917 03FF EB XCHG ;PUT ADDR IN H,L 918 0400 225222 SHLD ADDR1 ;SAVE ADDR 919 0403 DF RST 3 ;GO STORE THE VALUE 920 0404 E1 POP H ;RESTORE POINTER TO STMT 921 0405 11D21E LXI D,TOLIT ;GET LIT ADDR 922 0408 D7 RST 2 ;GO COMPARE 923 0409 C20F1C JNZ SNERR ;BRIF ERROR 924 040C CD800F CALL EXPR ;GO EVALUATE TO-EXPR 925 040F E5 PUSH H ;SAVE H,L 926 0410 212722 LXI H,TVAR1 ;POINT 'TO' VALUE 927 0413 DF RST 3 ;SAVE IT 928 0414 21EA1D LXI H,ONE ;POINT CONSTANT: 1 9291 930 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 931+ 21:37 05/19/2019 932+ PAGE 17 933 934 935 936 0417 EF RST 5 ;LOAD IT 937 0418 E1 POP H ;GET H,L 938 0419 7E MOV A,M ;GET THE CHAR 939 041A B7 ORA A ;TEST FOR END OF STATEMENT 940 041B CA2E04 JZ FOR2 ;BRIF NO STEP 941 041E E5 PUSH H ;RE-SAVE 942 041F 118D1D LXI D,STEPL ;TEST FOR LIT 'STEP' 943 0422 D7 RST 2 ;GO COMPARE 944 0423 CA2A04 JZ FOR1 ;BRIF STEP 945 0426 E1 POP H ;RESTORE H,L 946 0427 C32E04 JMP FOR2 ;GO NO STEP VALUE 947 042A D1 FOR1: POP D ;POP OFF THE STACK 948 042B CD800F CALL EXPR ;GO EVALUATE EXPRESSION 949 042E E5 FOR2: PUSH H ;SAVE H,L TO END OF STATEMENT 950 042F 212B22 LXI H,TVAR2 ;POINT STEP VALUE 951 0432 DF RST 3 ;SAVE IT 952 0433 E1 POP H ;RESTORE H,L 953 0434 CD941A CALL EOL ;ERROR IF NOT END-OF-LINE 954 ; DETERMINE WHETHER LOOP IS TO BE EXECUTED AT ALL 955 ; (IF VALUE > "TO" VALUE AND STEP POSITIVE, 956 ; JUST SKIP TO NEXT, ETC) 957 0437 CDCE18 CALL FTEST ;GET STATUS OF FACC 958 043A F5 PUSH PSW ;SAVE A,STATUS 959 043B 212722 LXI H,TVAR1 ;GET END VALUE 960 043E EF RST 5 ;LOAD IT 961 043F F1 POP PSW ;RESTORE STATUS 962 0440 F25204 JP FOR4 ;BRIF FOR IS POSITIVE 963 0443 2A5222 LHLD ADDR1 ;GET ADDRESS OF INDEX 964 0446 CD0C17 CALL FSUB ;COMPARE THIS AGAINST END VALUE 965 0449 CA5E04 JZ FOR5 ;BRIF START = END 966 044C FA5E04 JM FOR5 ;BRIF START > END 967 044F C3B204 JMP FOR9 ;GO LOCATE MATCHING NEXT 968 0452 2A5222 FOR4: LHLD ADDR1 ;GET ADDRESS OF INDEX 969 0455 CD0C17 CALL FSUB ;COMPARE 970 0458 CA5E04 JZ FOR5 ;BRIF START = END 971 045B FAB204 JM FOR9 ;BRIF START > END: SKIP TO "NEXT" 972 ; LOOP IS TO BE EXECUTED AT LEAST ONCE: 973 ; NEED AN ENTRY IN FOR-NEXT TABLE. 974 ; SEE IF THERE IS ALREADY ENTRY FOR THIS VARIABLE 975 ; (IE PROGRAM JUMPED OUT OF LOOP EARLIER) 976 045E 110020 FOR5: LXI D,FORNE ;POINT TABLE 977 0461 2A2322 LHLD INDX ;GET INDEX VARIABLE NAME 978 0464 EB XCHG ;FLIP/FLOP 979 0465 7E MOV A,M ;GET COUNT OF ENTRIES NOW IN TABLE 980 0466 47 MOV B,A ;STORE IT 981 0467 0E01 MVI C,1 ;NEW CTR 982 0469 B7 ORA A ;TEST IF ZERO 983 046A 23 INX H ;POINT 984 046B CA8104 JZ FOR8 ;BRIF TABLE EMPTY 985 046E 7E FOR6: MOV A,M ;GET 1ST BYTE OF TABLE VARIABLE 986 046F BA CMP D ;TEST IF EQUAL TO THIS FOR'S INDEX 9871 988 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 989+ 21:37 05/19/2019 990+ PAGE 18 991 992 993 994 0470 C27A04 JNZ FOR7 ;BRIF NOT 995 0473 23 INX H ;POINT NEXT 996 0474 7E MOV A,M ;GET NEXT BYTE 997 0475 2B DCX H ;POINT BACK 998 0476 BB CMP E ;TEST IF EQUAL 999 0477 CA8104 JZ FOR8 ;BRIF EQUAL 1000 047A E7 FOR7: RST 4 ;ADJUST H,L 1001 047B 0E DB 14 1002 047C 0C INR C ;COUNT IT 1003 047D 05 DCR B ;DECR CTR 1004 047E C26E04 JNZ FOR6 ;LOOP 1005 ; ENTER THIS FOR IN TABLE (WHERE HL POINTS) 1006 0481 79 FOR8: MOV A,C ;GET UDPATE COUNT 1007 0482 FE09 CPI 9 ;TEST IF TBL EXCEEDED 1008 0484 D21B1C JNC NXERR ;ERROR IF MORE THAN 8 OPEN FOR/NEXT 1009 0487 320020 STA FORNE ;PUT IN TABLE 1010 048A 72 MOV M,D ;HI BYTE INDEX VARIABLE NAME 1011 048B 23 INX H ;POINT NEXT 1012 048C 73 MOV M,E ;STORE LO BYTE 1013 048D 23 INX H ;POINT NEXT 1014 048E E5 PUSH H ;SAVE H,L 1015 048F 212B22 LXI H,TVAR2 ;POINT STEP VALUE 1016 0492 EF RST 5 ;LOAD IT 1017 0493 E1 POP H ;RESTORE H,L 1018 0494 DF RST 3 ;STORE IN STACK 1019 0495 E5 PUSH H ;SAVE H,L 1020 0496 212722 LXI H,TVAR1 ;POINT 'TO' VALUE 1021 0499 EF RST 5 ;LOAD IT 1022 049A E1 POP H ;RESTORE H,L 1023 049B DF RST 3 ;STORE IN STACK 1024 049C EB XCHG ;FLIP/FLOP 1025 049D 2A7222 LHLD ENDLI ;GET END ADDR 1026 04A0 2B DCX H ;POINT ONE PRIOR 1027 04A1 EB XCHG ;FLIP BACK 1028 04A2 72 MOV M,D ;STORE IT 1029 04A3 23 INX H ;POINT NEXT 1030 04A4 73 MOV M,E ;STORE IT 1031 04A5 23 INX H ;POINT NEXT 1032 04A6 3A7122 LDA STMT+1 ;GET HIGH STMT ADDR 1033 04A9 77 MOV M,A ;PUT IT 1034 04AA 23 INX H ;POINT NEXT 1035 04AB 3A7022 LDA STMT ;GET LOW STMT ADDR 1036 04AE 77 MOV M,A ;PUT IT 1037 04AF C30B02 JMP RUN ;CONTINUE 1038 ; 1039 ; IF HERE, THIS LOOP IS TO BE EXECUTED ZERO TIMES: 1040 ; SCAN THRU PROGRAM TO FIND MATCHING "NEXT". 1041 ; THIS CODE WILL FAIL IF USER'S PROGRAM IS TOO 1042 ; COMPLEX SINCE IT WON'T FOLLOW GOTO'S, IF'S, ETC. 1043 04B2 2A7022 FOR9: LHLD STMT ;GET ADDRESS OF STATMENT 1044 04B5 5E MOV E,M ;GET LENGTH CODE 10451 1046 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1047+ 21:37 05/19/2019 1048+ PAGE 19 1049 1050 1051 1052 04B6 1600 MVI D,0 ;INIT INCREMENT 1053 04B8 19 DAD D ;COMPUTE ADDR OF NEXT STATEMENT 1054 04B9 7E MOV A,M ;GET NEW LEN CODE 1055 04BA B7 ORA A ;SEE IF END OF PGM 1056 04BB CA1B1C JZ NXERR ;BRIF IT IS 1057 04BE 227022 SHLD STMT ;SAVE ADDRESS 1058 04C1 E7 RST 4 ;ADJUST H,L 1059 04C2 03 DB 3 1060 04C3 CF RST 1 ;SKIP SPACES 1061 04C4 11A81E LXI D,NEXTL ;POINT 'NEXT' 1062 04C7 D7 RST 2 ;SEE IF IT IS A NEXT STMT 1063 04C8 C2B204 JNZ FOR9 ;LOOP IF NOT 1064 04CB CF RST 1 ;SKIP SPACES 1065 04CC 3A2422 LDA INDX+1 ;GET FIRST CHAR 1066 04CF BE CMP M ;COMPARE 1067 04D0 C2B204 JNZ FOR9 ;BRIF NOT MATCH NEXT 1068 04D3 3A2322 LDA INDX ;GET 2ND CHAR 1069 04D6 23 INX H ;DITTO 1070 04D7 FE20 CPI ' ' ;SEE IF SINGLE CHAR 1071 04D9 CAE004 JZ FORA ;BRIF IT IS 1072 04DC BE CMP M ;COMPARE THE TWO 1073 04DD C2B204 JNZ FOR9 ;BRIF NOT EQUAL 1074 04E0 CF FORA: RST 1 ;SKIP TO END (HOPEFULLY) 1075 04E1 7E MOV A,M ;GET THE NON BLANK 1076 04E2 B7 ORA A ;SEE IF END 1077 04E3 C2B204 JNZ FOR9 ;BRIF END 1078 04E6 C30B02 JMP RUN ;ELSE, GO NEXT STMT 1079 ;PAGE 1080 ; 1081 04E9 IFSTM EQU $ 1082 ; 1083 ; 1084 ; STMT: IF EXPR RELATION EXPR THEN STMT# 1085 ; 1086 ; 1087 04E9 CD800F CALL EXPR ;GO EVALUATE LEFT EXPR 1088 04EC E5 PUSH H ;SAVE H,L 1089 04ED 3A8E22 LDA NS ;GET TYPE CODE 1090 04F0 322622 STA IFTYP ;SAVE IT 1091 04F3 FEE7 CPI 0E7H ;TEST IF STRING 1092 04F5 C20705 JNZ IF1 ;BRIF NOT 1093 04F8 21CE20 LXI H,IOBUF ;POINT BUFFER 1094 04FB 112021 LXI D,STRIN ;POINT RESULT 1095 04FE 1A LDAX D ;GET LEN 1096 04FF 3C INR A ;PLUS ONE 1097 0500 47 MOV B,A ;SAVE IT 1098 0501 CD4D1C CALL COPYD ;GO MOVE IT 1099 0504 C30B05 JMP IF2 ;GO AROUND 1100 0507 212722 IF1: LXI H,TVAR1 ;GET ADDR OF TEMP STORAGE 1101 050A DF RST 3 ;SAVE IT 1102 050B E1 IF2: POP H ;RESTORE H,L 11031 1104 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1105+ 21:37 05/19/2019 1106+ PAGE 20 1107 1108 1109 1110 050C AF XRA A ;CLEAR A 1111 050D 4F MOV C,A ;SAVE IN REG C 1112 050E 47 MOV B,A ;INIT REG 1113 050F 7E IF3: MOV A,M ;GET OPERATOR 1114 0510 04 INR B ;COUNT 1115 0511 FE3D CPI '=' ;TEST FOR EQUAL 1116 0513 C21805 JNZ IF4 ;BRIF IT IS 1117 0516 0C INR C ;ADD 1 TO C 1118 0517 23 INX H ;POINT NEXT 1119 0518 FE3E IF4: CPI '>' ;TEST FOR GREATER THAN 1120 051A C22005 JNZ IF5 ;BRIF IT IS 1121 051D 0C INR C ;ADD TWO 1122 051E 0C INR C ;TO REL CODE 1123 051F 23 INX H ;POINT NEXT 1124 0520 FE3C IF5: CPI '<' ;TEST FOR LESS THAN 1125 0522 C22A05 JNZ IF6 ;BRIF IT IS 1126 0525 79 MOV A,C ;GET REL CODE 1127 0526 C604 ADI 4 ;PLUS FOUR 1128 0528 4F MOV C,A ;PUT BACK 1129 0529 23 INX H ;POINT NEXT 1130 052A 79 IF6: MOV A,C ;GET REL CODE 1131 052B B7 ORA A ;TEST IT 1132 052C C5 PUSH B ;SAVE B,C 1133 052D CA0F1C JZ SNERR ;BRIF SOME ERROR 1134 0530 C1 POP B ;RESTORE B,C 1135 0531 322522 STA REL ;SAVE CODE 1136 0534 78 MOV A,B ;GET COUNT 1137 0535 FE02 CPI 2 ;TEST FOR TWO 1138 0537 C20F05 JNZ IF3 ;SEE IF MULTIPLE RELATION 1139 053A CD800F CALL EXPR ;GO EVALUATE RIGHT SIDE 1140 053D 225222 SHLD ADDR1 ;SAVE LOCATION OF THEN (IF ANY) 1141 0540 3A8E22 LDA NS ;GET TYPE CODE 1142 0543 212622 LXI H,IFTYP ;POINT LEFT TYPE 1143 0546 BE CMP M ;COMPARE 1144 0547 C20F1C JNZ SNERR ;BRIF MIXED 1145 054A FEE7 CPI 0E7H ;TEST IF STRING 1146 054C CAA805 JZ IFF ;BRIF IS 1147 054F 212722 LXI H,TVAR1 ;POINT LEFT 1148 0552 CD0C17 CALL FSUB ;SUBTRACT LEFT FROM RIGHT 1149 0555 3A2522 LDA REL ;GET RELATION 1150 0558 1F RAR ;TEST BIT D0 1151 0559 D26205 JNC IF8 ;BRIF NO EQUAL TEST 1152 055C CDCE18 CALL FTEST ;GET STATUS OF FACC 1153 055F CA8105 JZ TRUE ;BRIF LEFT=RIGHT 1154 0562 3A2522 IF8: LDA REL ;LOAD RELATION 1155 0565 E602 ANI 02H ;MASK IT 1156 0567 CA7005 JZ IF9 ;BRIF NO > 1157 056A CDCE18 CALL FTEST ;GET STATUS OF FACC 1158 056D FA8105 JM TRUE ;BRIF GT 1159 0570 3A2522 IF9: LDA REL ;LOAD RELATION 1160 0573 E604 ANI 04H ;MASK IT 11611 1162 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1163+ 21:37 05/19/2019 1164+ PAGE 21 1165 1166 1167 1168 0575 CA0B02 JZ FALSE ;BRIF NO < 1169 0578 CDCE18 CALL FTEST ;GET STATUS OF FACC 1170 057B FA0B02 JM FALSE ;BRIF GT 1171 057E CA0B02 JZ FALSE ;BRIF ZERO (NOT EQUAL) 1172 0581 2A5222 TRUE: LHLD ADDR1 ;GET POINTER TO STATEMENT 1173 0584 11D01E LXI D,GOTOL ;POINT 'GO TO' 1174 0587 D7 RST 2 ;GO COMPARE 1175 0588 CAF602 JZ GOTO ;BRIF IF ... GOTO NN 1176 058B 2A5222 LHLD ADDR1 ;GET POINTER TO STATEMENT 1177 058E 11AF1E LXI D,GOSBL ;POINT LITERAL 1178 0591 D7 RST 2 ;GO COMAPRE 1179 0592 CA3A03 JZ GOSUB ;BRIF IF ... GOSUB NN 1180 0595 2A5222 LHLD ADDR1 ;GET POINTER TO STATEMENT 1181 0598 11921D LXI D,THENL ;GET ADDR 'THEN' 1182 059B D7 RST 2 ;GO COMPARE 1183 059C C20F1C JNZ SNERR ;BRIF ERROR 1184 059F CD2A1B CALL NUMER ;TEST IF NUMERIC 1185 05A2 CAF602 JZ GOTO ;BRIF IT IS 1186 05A5 C33802 JMP RUN4 ;ELSE, MAY BE ANY STMT 1187 020B FALSE EQU RUN 1188 05A8 21CE20 IFF: LXI H,IOBUF ;POINT PRIOR 1189 05AB 46 MOV B,M ;GET LEN 1190 05AC 112021 LXI D,STRIN ;POINT THIS 1191 05AF 1A LDAX D ;GET LEN 1192 05B0 4F MOV C,A ;SAVE IT 1193 05B1 13 IFG: INX D ;POINT NEXT 1194 05B2 23 INX H ;DITTO 1195 05B3 78 MOV A,B ;GET LEFT LEN 1196 05B4 B7 ORA A ;TEST IT 1197 05B5 C2BA05 JNZ IFH ;BRIF NOT ZERO 1198 05B8 3620 MVI M,' ' ;EXTEND WITH SPACE 1199 05BA 79 IFH: MOV A,C ;GET RIGHT LEN 1200 05BB B7 ORA A ;TEST IT 1201 05BC C2C205 JNZ IFI ;BRIF NOT ZERO 1202 05BF 3E20 MVI A,' ' ;GET SPACE 1203 05C1 12 STAX D ;EXTEND 1204 05C2 1A IFI: LDAX D ;GET RIGHT CHAR 1205 05C3 BE CMP M ;TEST WITH LEFT 1206 05C4 DAE705 JC IFM ;BRIF LEFT>RIGHT 1207 05C7 C2EC05 JNZ IFN ;BRIF LEFT<RIGHT 1208 05CA 78 MOV A,B ;GET LEFT COUNT 1209 05CB 3D DCR A ;SUBT ONE 1210 05CC FAD005 JM IFJ ;BRIF WAS ZERO 1211 05CF 47 MOV B,A ;UPDATE CTR 1212 05D0 79 IFJ: MOV A,C ;GET RIGHT LEN 1213 05D1 3D DCR A ;SUBT ONE 1214 05D2 FAD605 JM IFK ;BRIF WAS ZERO 1215 05D5 4F MOV C,A ;UPDT CTR 1216 05D6 78 IFK: MOV A,B ;GET LEFT LEN 1217 05D7 B1 ORA C ;COMPARE TO RIGHT 1218 05D8 C2B105 JNZ IFG ;BRIF BOTH NOT ZERO 12191 1220 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1221+ 21:37 05/19/2019 1222+ PAGE 22 1223 1224 1225 1226 05DB 0601 MVI B,1 ;SET SW= EQUAL 1227 05DD 3A2522 IFL: LDA REL ;GET RELATION 1228 05E0 A0 ANA B ;AND WITH RESULT 1229 05E1 CA0B02 JZ FALSE ;BRIF FALSE 1230 05E4 C38105 JMP TRUE ;ELSE, TRUE 1231 05E7 0602 IFM: MVI B,2 ;SET CODE 1232 05E9 C3DD05 JMP IFL ;JUMP 1233 05EC 0604 IFN: MVI B,4 ;SET CODE 1234 05EE C3DD05 JMP IFL ;JUMP 1235 ;PAGE 1236 ; 1237 05F1 LET EQU $ 1238 ; 1239 ; 1240 ; STMT: LET VAR = EXPR 1241 ; 1242 ; 1243 05F1 CD4F18 CALL GETS8 ;GO GET ADDRESS OF VARIABLE 1244 05F4 C5 PUSH B ;SAVE NAME 1245 05F5 D5 PUSH D ;SAVE ADDRESS 1246 05F6 CF RST 1 ;GET NEXT CHAR 1247 05F7 FE3D CPI '=' ;TEST FOR EQUAL SIGN 1248 05F9 CA0C06 JZ LET1 ;BRIF IS 1249 05FC 3A7620 LDA EDSW ;GET MODE SW 1250 05FF B7 ORA A ;TEST IT 1251 0600 CA0F1C JZ SNERR ;BRIF LET ERROR 1252 0603 21731D LXI H,WHATL ;POINT LITERAL 1253 0606 CDBD19 CALL TERMM ;GO PRINT IT 1254 0609 C3C900 JMP GETCM ;GO TO COMMAND 1255 060C 23 LET1: INX H ;POINT NEXT 1256 060D CD800F CALL EXPR ;GO EVALUATE EXPRESSION 1257 0610 CD941A CALL EOL ;ERROR IF NOT END-OF-LINE 1258 0613 E1 POP H ;RESTORE ADDRESSS 1259 0614 D1 POP D ;RESTORE NAME 1260 0615 7B MOV A,E ;GET TYPE 1261 0616 B7 ORA A ;TEST IT 1262 0617 3A8E22 LDA NS ;GET RESULT TYPE 1263 061A FA2606 JM LET2 ;BRIF STRING 1264 061D FEE3 CPI 0E3H ;TEST IF NUMERIC 1265 061F C20F1C JNZ SNERR ;BRIF MIXED MODE 1266 0622 DF RST 3 ;GO STORE VARIABLE 1267 0623 C30B02 JMP RUN ;CONTINUE 1268 0626 FEE7 LET2: CPI 0E7H ;TEST IF STRING 1269 0628 C20F1C JNZ SNERR ;BRIF MIXED MODE 1270 062B CD3106 CALL LET2A ;GO STORE IT 1271 062E C30B02 JMP RUN ;CONTINUE 1272 ; 1273 0631 112021 LET2A: LXI D,STRIN ;POINT STRING BUFFER 1274 0634 1A LDAX D ;GET NEW LEN 1275 0635 96 SUB M ;MINUS OLD LEN 1276 0636 CA8606 JZ LET8 ;BRIF SAME LENGTH 12771 1278 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1279+ 21:37 05/19/2019 1280+ PAGE 23 1281 1282 1283 1284 0639 54 MOV D,H ;COPY H,L 1285 063A 5D MOV E,L ;TO D,E 1286 063B 7E MOV A,M ;GET LEN 1287 063C 3C INR A ;TRUE LEN 1288 063D 13 LET3: INX D ;POINT NEXT 1289 063E 3D DCR A ;DECR CTR 1290 063F C23D06 JNZ LET3 ;LOOP 1291 0642 13 INX D ;SKIP 1292 0643 13 INX D ;AGAIN 1293 0644 1A LDAX D ;GET LO NAM 1294 0645 4F MOV C,A ;SAVE 1295 0646 13 INX D ;GET HI NAME 1296 0647 1A LDAX D ;LOAD IT 1297 0648 47 MOV B,A ;SAVE 1298 0649 C5 PUSH B ;SAVE NAME 1299 064A 2B DCX H ;POINT NEXT ENTRY 1300 064B 7E LET4: MOV A,M ;GET NEXT 1301 064C B7 ORA A ;TEST IF END 1302 064D CA6406 JZ LET6 ;BRIF IS 1303 0650 E5 PUSH H ;SAVE H,L 1304 0651 2B DCX H ;SKIP NEXT 1305 0652 2B DCX H ;POINT LEN 1306 0653 46 MOV B,M ;GET HI LEN 1307 0654 2B DCX H ;POINT LO 1308 0655 4E MOV C,M ;GET LO LEN 1309 0656 E1 POP H ;RESTORE H,L 1310 0657 7E LET5: MOV A,M ;GET A BYTE 1311 0658 12 STAX D ;COPY 1312 0659 2B DCX H ;POINT NEXT 1313 065A 1B DCX D ;DITTO 1314 065B 03 INX B ;ADD TO CTR 1315 065C 78 MOV A,B ;GET HI 1316 065D B1 ORA C ;TEST IF ZERO 1317 065E C25706 JNZ LET5 ;LOOP 1318 0661 C34B06 JMP LET4 ;CONTINUE 1319 0664 EB LET6: XCHG ;PUT NEW ADDR TO H,L 1320 0665 C1 POP B ;GET NAME 1321 0666 70 MOV M,B ;STORE HI BYTE 1322 0667 2B DCX H ;POINT NEXT 1323 0668 71 MOV M,C ;STORE LO 1324 0669 112021 LXI D,STRIN ;GET NEW LEN 1325 066C 1A LDAX D ;LOAD IT 1326 066D 06FF MVI B,0FFH ;INIT HI COMPLEMENT 1327 066F C605 ADI 5 ;COMPUTE ENTRY LENGTH 1328 0671 CA7906 JZ LET7 ;BRIF 256 BYTES 1329 0674 D27906 JNC LET7 ;BRIF LESS 256 1330 0677 06FE MVI B,0FEH ;SET BIT OFF 1331 0679 2F LET7: CMA ;1'S COMPLEMENT 1332 067A 3C INR A ;THEN 2'S 1333 067B 4F MOV C,A ;SAVE LO LEN 1334 067C 2B DCX H ;POINT NEXT 13351 1336 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1337+ 21:37 05/19/2019 1338+ PAGE 24 1339 1340 1341 1342 067D 70 MOV M,B ;STORE HI LEN 1343 067E 2B DCX H ;POINT NEXT 1344 067F 71 MOV M,C ;STORE LO LEN 1345 0680 E7 RST 4 ;ADJUST H,L 1346 0681 03 DB 3 1347 0682 09 DAD B ;COMPUTE END OF ENTRY 1348 0683 3600 MVI M,0 ;MARK NEW END 1349 0685 23 INX H ;POINT 1ST BYTE 1350 0686 1A LET8: LDAX D ;GET LEN 1351 0687 3C INR A ;TRUE LEN 1352 0688 47 MOV B,A ;SAVE LEN 1353 0689 1A LET9: LDAX D ;GET A BYTE 1354 068A 77 MOV M,A ;COPY IT 1355 068B 23 INX H ;POINT NEXT 1356 068C 13 INX D ;DITTO 1357 068D 05 DCR B ;SUBT CTR 1358 068E C28906 JNZ LET9 ;LOOP 1359 0691 C9 RET ;RETURN 1360 ;PAGE 1361 ; 1362 ;NEXT EQQU $ 1363 ; 1364 ; 1365 ; STMT: NEXT VAR 1366 ; 1367 ; 1368 0692 CDC91B NEXT: CALL VAR ;GET VARIABLE NAME 1369 0695 CD941A CALL EOL ;ERROR IF NOT END-OF-LNE 1370 0698 EB XCHG ;FLIP/FLOP 1371 0699 222322 SHLD INDX ;SAVE VAR NAME 1372 069C E5 PUSH H ;SAVE VAR NAME 1373 069D 210020 LXI H,FORNE ;POINT FOR/NEXT TABLE 1374 06A0 46 MOV B,M ;GET SIZE 1375 06A1 78 MOV A,B ;LOAD IT 1376 06A2 B7 ORA A ;TEST IT 1377 06A3 CA1B1C JZ NXERR ;BRIF TABLE EMPTY 1378 06A6 23 INX H ;POINT NEXT 1379 06A7 D1 POP D ;RESTORE VAR NAME 1380 06A8 7E NEXT1: MOV A,M ;GET 1ST BYTE 1381 06A9 23 INX H ;POINT NEXT 1382 06AA BA CMP D ;COMPARE 1383 06AB C2B306 JNZ NEXT2 ;BRIF NOT EQUAL 1384 06AE 7E MOV A,M ;GET 2ND BYTE 1385 06AF BB CMP E ;COMPARE 1386 06B0 CABC06 JZ NEXT3 ;BRIF EQUAL 1387 06B3 E7 NEXT2: RST 4 ;ADJUST H,L 1388 06B4 0D DB 13 1389 06B5 05 DCR B ;DECR COUNT 1390 06B6 C2A806 JNZ NEXT1 ;LOOP 1391 06B9 C31B1C JMP NXERR ;GO PUT ERROR MSG 1392 06BC 3A0020 NEXT3: LDA FORNE ;GET ORIG COUNT 13931 1394 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1395+ 21:37 05/19/2019 1396+ PAGE 25 1397 1398 1399 1400 06BF 90 SUB B ;MINUS REMAIN 1401 06C0 3C INR A ;PLUS ONE 1402 06C1 320020 STA FORNE ;STORE NEW COUNT 1403 06C4 23 INX H ;POINT ADDR 1404 06C5 E5 PUSH H ;SAVE H,L ADDR 1405 06C6 CD341B CALL SEARC ;GO GET ADDR OF INDEX 1406 06C9 EB XCHG ;PUT TO H,L 1407 06CA 225222 SHLD ADDR1 ;SAVR IT 1408 06CD EF RST 5 ;LOAD INDEX 1409 06CE E1 POP H ;GET H,L (TBL) 1410 06CF E5 PUSH H ;RE-SAVE 1411 06D0 CD3716 CALL FADD ;ADD STEP VALUE 1412 06D3 212722 LXI H,TVAR1 ;POINT TEMP AREA 1413 06D6 DF RST 3 ;SAVE NEW INDEX 1414 06D7 E1 POP H ;GET H,L (TBL) 1415 06D8 E5 PUSH H ;RE-SAVE 1416 06D9 E7 RST 4 ;GET LEN TO NEXT 1417 06DA 04 DB 4 1418 06DB CD0C17 CALL FSUB ;SUBTRACT TO VALUE 1419 06DE CAFB06 JZ NEXT6 ;BRIF ZERO 1420 06E1 E1 POP H ;GET H,L (PTR TO STEP) 1421 06E2 E5 PUSH H ;RE-SAVE 1422 06E3 7E MOV A,M ;GET SIGN&EXPONENT OF STEP 1423 06E4 B7 ORA A ;TEST IT 1424 06E5 3A5822 LDA FACC ;GET SIGN & EXPON OF DIFF 1425 06E8 FAF706 JM NEXT5 ;BRIF NEGATIVE 1426 06EB B7 ORA A ;TEST SIGN OF DIFF 1427 06EC FAFB06 JM NEXT6 ;BRIF LESS THAN TO-EXPR 1428 06EF 210020 NEXT7: LXI H,FORNE ;GET ADDR TABLE 1429 06F2 35 DCR M ;SUBTRACT ONE FROM COUNT 1430 06F3 D1 POP D ;ADJUST STACK 1431 06F4 C30B02 JMP RUN ;GO STMT AFTER NEXT 1432 06F7 B7 NEXT5: ORA A ;TEST SIGN OF DIFFERENCE 1433 06F8 FAEF06 JM NEXT7 ;BRIF END OF LOOP 1434 06FB E1 NEXT6: POP H ;GET PTR TO TBL 1435 06FC E7 RST 4 ;ADJUST H,L 1436 06FD 08 DB 8 1437 06FE 56 MOV D,M ;GET HI BYTE 1438 06FF 23 INX H ;POINT NEXT 1439 0700 5E MOV E,M ;GET LOW BYTE 1440 0701 23 INX H ;POINT NEXT 1441 0702 7E MOV A,M ;GET HI BYTE 1442 0703 327122 STA STMT+1 ;SAVE 1443 0706 23 INX H ;POINT NEXT 1444 0707 7E MOV A,M ;GET LOW BYTE 1445 0708 327022 STA STMT ;SAVE 1446 070B EB XCHG ;H,L = ADDR OF STMT AFTR FOR 1447 070C CD941A CALL EOL ;SETUP MULTI PTP 1448 070F 2A7022 LHLD STMT ;GET ADDR OF FOR STMT 1449 0712 23 INX H ;POINT LINE NUM 1450 0713 228922 SHLD LINE ;SAVE ADDR LINE 14511 1452 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1453+ 21:37 05/19/2019 1454+ PAGE 26 1455 1456 1457 1458 0716 212722 LXI H,TVAR1 ;POINT UPDTED VALUE 1459 0719 EF RST 5 ;GO LOAD IT 1460 071A 2A5222 LHLD ADDR1 ;GET ADDR OF INDEX 1461 071D DF RST 3 ;GO STORE IT 1462 071E C30B02 JMP RUN ;CONTINUE WITH STMT AFTER FOR 1463 ;PAGE 1464 0721 INPUT EQU $ 1465 ; 1466 ; 1467 ; STMT: INPUT VAR , VAR, VAR 1468 ; 1469 ; 1470 0721 11841D LXI D,LLINE ;POINT 'LINE' 1471 0724 E5 PUSH H ;SAVE H,L ADDR 1472 0725 D7 RST 2 ;GO COMPARE 1473 0726 CAA507 JZ INPL ;BRIF EQUAL 1474 0729 D1 POP D ;ELSE, RESTORE H,L ADDR 1475 072A 21CE20 LXI H,IOBUF ;GET ADDR OF BUFFER 1476 072D 225222 SHLD ADDR1 ;SAVE ADDR 1477 0730 3600 MVI M,0 ;MARK BUFFER EMPTY 1478 0732 EB XCHG ;FLIP/BACK 1479 0733 CF INPU1: RST 1 ;SKIP SPACES 1480 0734 FE27 CPI 27H ;TEST IF QUOTE 1481 0736 CA3E07 JZ INPU2 ;BRIF IS 1482 0739 FE22 CPI '"' ;TEST IF INPUT LITERAL 1483 073B C26107 JNZ INPU6 ;BRIF NOT 1484 073E 4F INPU2: MOV C,A ;SAVE DELIM 1485 073F 11CE20 LXI D,IOBUF ;POINT BUFFER 1486 0742 23 INPU3: INX H ;POINT NEXT 1487 0743 7E MOV A,M ;LOAD IT 1488 0744 B9 CMP C ;TEST IF END 1489 0745 CA4D07 JZ INPU4 ;BRIF IS 1490 0748 12 STAX D ;PUT TO BUFF 1491 0749 13 INX D ;POINT NEXT 1492 074A C34207 JMP INPU3 ;LOOP 1493 074D 23 INPU4: INX H ;SKIP TRAILING QUOTE 1494 074E EB XCHG ;PUT ADDR TO H,L 1495 074F 36FE MVI M,0FEH ;MARK END 1496 0751 CDB519 CALL TERMO ;GO PRINT PROMPT 1497 0754 EB XCHG ;GET H,L 1498 0755 CF RST 1 ;SKIP TO NON BLANK 1499 0756 FE2C CPI ',' ;TEST IF COMMA 1500 0758 CA6007 JZ INPU5 ;BRIF IS 1501 075B FE3B CPI ';' ;TEST IF COMMA 1502 075D C26107 JNZ INPU6 ;BRIF NOT 1503 0760 23 INPU5: INX H ;SKIP IT 1504 0761 CD4F18 INPU6: CALL GETS8 ;GO GET VAR ADDR 1505 0764 E5 PUSH H ;SAVE H ADDR 1506 0765 D5 PUSH D ;SAVE VAR ADDR 1507 0766 2A5222 LHLD ADDR1 ;GET ADDR PREV BUFFER 1508 0769 7E MOV A,M ;LOAD CHAR 15091 1510 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1511+ 21:37 05/19/2019 1512+ PAGE 27 1513 1514 1515 1516 076A FE2C CPI ',' ;TEST IF COMMA 1517 076C 23 INX H ;POINT NEXT 1518 076D CA7507 JZ INPU7 ;BRIF CONTINUE FROM PREV 1519 0770 3E3F MVI A,'?' ;LOAD PROMPT 1520 0772 CD0419 CALL TERMI ;GO READ FROM TTY 1521 0775 CF INPU7: RST 1 ;SKIP SPACES 1522 0776 79 MOV A,C ;GET LO NAME 1523 0777 B7 ORA A ;TEST IT 1524 0778 FA9C07 JM INPUA ;BRIF STRING 1525 077B CD2E14 CALL FIN ;GO CONVERT TO FLOATING 1526 077E CF RST 1 ;SKIP SPACES 1527 077F FE2C CPI ',' ;TEST IF COMMA 1528 0781 CA8807 JZ INPU8 ;BRIF IS 1529 0784 B7 ORA A ;TEST IF END OF LINE 1530 0785 C21F1C JNZ CVERR ;BRIF ERROR 1531 0788 225222 INPU8: SHLD ADDR1 ;SAVE ADDRESS 1532 078B E1 POP H ;GET VAR ADDR 1533 078C DF RST 3 ;GO STORE THE NUMBER 1534 078D E1 INPU9: POP H ;RESTORE STMT POINTER 1535 078E 7E MOV A,M ;GET CHAR 1536 078F FE2C CPI ',' ;TEST FOR COMMA 1537 0791 23 INX H ;POINT NEXT 1538 0792 CA3307 JZ INPU1 ;RECDURSIVE IF COMMA 1539 0795 2B DCX H ;POINT BACK 1540 0796 CD941A INPUB: CALL EOL ;ERROR IF NOT END OF LINE 1541 0799 C30B02 JMP RUN ;CONTINUE NEXT STMT 1542 079C CD0D18 INPUA: CALL GETST ;GO GET THE STRING 1543 079F 225222 SHLD ADDR1 ;SAVE ADDRESS 1544 07A2 C38D07 JMP INPU9 ;CONTINUE 1545 ; 1546 07A5 INPL EQU $ 1547 ; 1548 ; 1549 ; STMT: INPUT LINE A$ 1550 ; 1551 ; 1552 07A5 D1 POP D ;DUMMY POP TO ADJUST STACK 1553 07A6 CDC91B CALL VAR ;GET STRING NAME 1554 07A9 7B MOV A,E ;LOAD LO BYTE 1555 07AA B7 ORA A ;TEST IT 1556 07AB F20F1C JP SNERR ;BRIF NOT STRING VARIABLE 1557 07AE CD341B CALL SEARC ;ELSE, GET ADDRESS 1558 07B1 D5 PUSH D ;SAVE ON STACK 1559 07B2 CD941A CALL EOL ;ERROR IF NOT END-OF-LINE 1560 07B5 3E01 MVI A,1 ;GET ON SETTING 1561 07B7 327420 STA ILSW ;SET INPUT LINE SWITCH 1562 07BA 3E3F MVI A,'?' ;LOAD PROMPT 1563 07BC CD0419 CALL TERMI ;GO READ A LINE 1564 07BF 0600 MVI B,0 ;INIT COUNT 1565 07C1 112121 LXI D,STRIN+1 ;POINT STRING BUFFER 1566 07C4 21CF20 LXI H,IOBUF+1 ;POINT INPUT BUFFER 15671 1568 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1569+ 21:37 05/19/2019 1570+ PAGE 28 1571 1572 1573 1574 07C7 7E INPL1: MOV A,M ;GET NEXT BYTE 1575 07C8 B7 ORA A ;TEST IT 1576 07C9 CAD307 JZ INPL2 ;BRIF END 1577 07CC 04 INR B ;ADD TO COUNT 1578 07CD 12 STAX D ;PUT TO STRING BUFF 1579 07CE 13 INX D ;POINT NEXT 1580 07CF 23 INX H ;DITTO 1581 07D0 C3C707 JMP INPL1 ;LOOP 1582 07D3 327420 INPL2: STA ILSW ;RESET SWITCH 1583 07D6 78 MOV A,B ;GET COUNT 1584 07D7 322021 STA STRIN ;SET STRING LENGTH 1585 07DA E1 POP H ;GET ADDRESS OF VARIABLE 1586 07DB CD3106 CALL LET2A ;GO STORE THE STRING 1587 07DE C30B02 JMP RUN ;GO NEXT STMT 1588 ;PAGE 1589 ; 1590 07E1 READ EQU $ 1591 ; 1592 ; STMT: READ VAR ,VAR ... 1593 ; 1594 07E1 CF RST 1 ;SKIP BLANKS 1595 07E2 CD4F18 CALL GETS8 ;GET VAR ADDR 1596 07E5 E5 PUSH H ;SAVE H,L 1597 07E6 D5 PUSH D ;SAVE D,E 1598 07E7 2A8F22 LHLD DATAP ;GET DATA STMT POINTER 1599 07EA 7E MOV A,M ;LOAD THE CHAR 1600 07EB B7 ORA A ;TEST IF END OF STMT 1601 07EC C20B08 JNZ READ2 ;BRIF NOT END OF STMT 1602 07EF 23 INX H ;POINT START NEXT STMT 1603 07F0 7E READ1: MOV A,M ;LOAD LEN 1604 07F1 228F22 SHLD DATAP ;SAVE ADDR 1605 07F4 B7 ORA A ;TEST IF END OF PGM 1606 07F5 CA171C JZ DAERR ;BRIF OUT OF DATA 1607 07F8 E7 RST 4 ;ADJUST H,L 1608 07F9 03 DB 3 1609 07FA 119B1E LXI D,DATAL ;POINT 'DATA' 1610 07FD D7 RST 2 ;COMPARE 1611 07FE CA0B08 JZ READ2 ;BRIF IT IS DATA STMT 1612 0801 2A8F22 LHLD DATAP ;GET ADDR START 1613 0804 5E MOV E,M ;GET LEN CODE 1614 0805 1600 MVI D,0 ;CLEAR D 1615 0807 19 DAD D ;POINT NEXT STMT 1616 0808 C3F007 JMP READ1 ;LOOP NEXT STMT 1617 080B CF READ2: RST 1 ;SKIP SPACES 1618 080C 79 MOV A,C ;LOAD LO NAME 1619 080D B7 ORA A ;TEST IT 1620 080E FA3308 JM READ6 ;BRIF STRING 1621 0811 CD2E14 CALL FIN ;GO CONVERT VALUE 1622 0814 7E MOV A,M ;GET CHAR WHICH STOPPED US 1623 0815 FE2C CPI ',' ;TEST IF COMMA 1624 0817 C22C08 JNZ READ5 ;BRIF NOT 16251 1626 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1627+ 21:37 05/19/2019 1628+ PAGE 29 1629 1630 1631 1632 081A 23 INX H ;POINT NEXT 1633 081B 228F22 READ3: SHLD DATAP ;SAVE ADDRESS 1634 081E E1 POP H ;RESTORE ADDR OF VAR 1635 081F DF RST 3 ;STORE THE VALUE 1636 0820 E1 READ4: POP H ;RESTORE POINTER TO STM 1637 0821 7E MOV A,M ;GET THE CHAR 1638 0822 FE2C CPI ',' ;TEST IF COMMA 1639 0824 23 INX H ;POINT NEXT 1640 0825 CAE107 JZ READ ;RECURSIVE IF IT IS 1641 0828 2B DCX H ;RESET 1642 0829 C39607 JMP INPUB ;CONTINUE 1643 082C B7 READ5: ORA A ;TEST IF END OF STMT 1644 082D CA1B08 JZ READ3 ;BRIF OK 1645 0830 C31F1C JMP CVERR ;GO PROCESS ERROR 1646 0833 CD0D18 READ6: CALL GETST ;GO GET STRING 1647 0836 7E MOV A,M ;GET CHAR 1648 0837 FE2C CPI ',' ;TEST IF COMMA 1649 0839 CA4308 JZ READ7 ;BRIF IS 1650 083C B7 ORA A ;TEST IF END 1651 083D C22C08 JNZ READ5 ;BRIF NOT 1652 0840 C34408 JMP READ8 ;GO AROUND 1653 0843 23 READ7: INX H ;POINT PAST 1654 0844 228F22 READ8: SHLD DATAP ;SAVE ADDRESS 1655 0847 C32008 JMP READ4 ;CONTINUE 1656 ; 1657 084A OUTP EQU $ 1658 ; 1659 ; STMT; OUT ADDR,VALUE 1660 ; 1661 ; 1662 084A CD800F CALL EXPR ;GO EVALUATE ADDRESS 1663 084D 7E MOV A,M ;GET DELIM 1664 084E FE2C CPI ',' ;TEST IF COMMA 1665 0850 C20F1C JNZ SNERR ;BRIF NOT 1666 0853 23 INX H ;SKIP OVER COMMA 1667 0854 CD661C CALL FBIN ;CONVERT TO BINARY IN A-REG 1668 0857 112022 LXI D,OUTA ;POINT INSTR 1669 085A EB XCHG ;PUT TO H,L 1670 085B 36D3 MVI M,0D3H ;OUT INSTR 1671 085D 23 INX H ;POINT NEXT 1672 085E 77 MOV M,A ;PUT ADDR 1673 085F 23 INX H ;POINT NEXT 1674 0860 36C9 MVI M,0C9H ;RET INSTR 1675 0862 EB XCHG ;RESTORE ORIG H,L 1676 0863 CD800F CALL EXPR ;GO EVAL DATA BYTE 1677 0866 CD941A CALL EOL ;ERROR IF NOT END OF STATEMENT 1678 0869 CD661C CALL FBIN ;CONVERT TO BINARY 1679 086C CD2022 CALL OUTA ;GO PUT THE BYTE 1680 086F C30B02 JMP RUN ;GO NEXT STMT 1681 ;PAGE 1682 ; 16831 1684 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1685+ 21:37 05/19/2019 1686+ PAGE 30 1687 1688 1689 1690 0872 STOP EQU $ 1691 ; 1692 ; STMT: STOP 1693 ; 1694 ; 1695 0872 CD941A CALL EOL ;POINT END OF LINE 1696 0875 212D1E LXI H,STOPM ;POINT MESSAGE: "STOP AT LINE " 1697 0878 CDBD19 CALL TERMM ;GO WRITE IT 1698 087B CDF11B CALL PRLIN ;GO PRINT LINE NUMBER 1699 087E 3A7520 LDA RUNSW ;GET RUN TYPE 1700 0881 B7 ORA A ;TEST IT 1701 0882 C2C300 JNZ RDY ;BRIF IMMED 1702 0885 327422 STA MULTI ;CLEAR MULTI SW 1703 0888 2A7022 LHLD STMT ;GET ADDR OF PREV STMT 1704 088B 5E MOV E,M ;GET LEN 1705 088C 1600 MVI D,0 ;CLEAR HI BYTE 1706 088E 19 DAD D ;POINT NEXT 1707 088F 23 INX H ;POINT LINE NUMBER 1708 0890 228922 SHLD LINE ;SAVE ADDR 1709 0893 117720 LXI D,LINEN ;POINT AREA 1710 0896 CD091A CALL LINEO ;GO CONVERT LINE NUMBER 1711 0899 EB XCHG ;FLIP TO H,L 1712 089A 3600 MVI M,0 ;MARK END 1713 089C C3C300 JMP RDY ;GO TO READY MSG 1714 ; 1715 089F RANDO EQU $ 1716 ; 1717 ; 1718 ; STMT: RANDOMIZE 1719 ; 1720 ; 1721 089F CD941A CALL EOL ;ERROR IF NOT END-OF-LINE 1722 08A2 3E01 MVI A,1 ;LOAD A ONE 1723 08A4 328722 STA RNDSW ;SET SWITCH = TRUE RANDOM 1724 08A7 117F22 LXI D,TRNDX ;POINT 'TRUE' RANDOM NUMBERS 1725 08AA 217722 LXI H,RNDX ;POINT RECEIVE 1726 08AD 0608 MVI B,8 ;LOOP CTR 1727 08AF CD4D1C CALL COPYD ;GO MOVE IT 1728 08B2 C30B02 JMP RUN ;CONTINUE 1729 ; 1730 08B5 ON EQU $ 1731 ; 1732 ; 1733 ; STMT: ON EXPR GOTO NNN NNNN NNNN 1734 ; GOSUB 1735 ; 1736 ; 1737 08B5 CD800F CALL EXPR ;GO EVALUATE EXPRESSION 1738 08B8 CD661C CALL FBIN ;GET BINARY NUMBER IN ACC 1739 08BB B7 ORA A ;TEST RESULT 1740 08BC CA0F1C JZ SNERR ;BRIF ZERO (ERROR) 17411 1742 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1743+ 21:37 05/19/2019 1744+ PAGE 31 1745 1746 1747 1748 08BF 4F MOV C,A ;SAVE VALUE 1749 08C0 0D DCR C ;LESS ONE 1750 08C1 AF XRA A ;GET A ZERO 1751 08C2 322522 STA REL ;TURN OFF SWITCH 1752 08C5 11D01E LXI D,GOTOL ;POINT LITERAL 1753 08C8 E5 PUSH H ;SAVE H,L ADDRESS 1754 08C9 D7 RST 2 ;GO COMPARE 1755 08CA CADB08 JZ ON3 ;BRIF ON...GOTO 1756 08CD E1 POP H ;ELSE, RESTORE H,L 1757 08CE 11AF1E LXI D,GOSBL ;POINT LITERAL 1758 08D1 D7 RST 2 ;GO COMPARE 1759 08D2 C20F1C JNZ SNERR ;BRIF ERROR 1760 08D5 3E01 MVI A,1 ;GET ON SETTING 1761 08D7 322522 STA REL ;SET SWITCH 1762 08DA E5 PUSH H ;DUMMY PUSH 1763 08DB D1 ON3: POP D ;ADJUST STACK 1764 08DC 79 ON3A: MOV A,C ;GET COUNT 1765 08DD B7 ORA A ;TEST IT 1766 08DE CAFD08 JZ ON6 ;BRIF VALUE 1 1767 08E1 CF RST 1 ;ELSE, SKIP BLANKS 1768 08E2 B7 ORA A ;TEST IF END OF LINE 1769 08E3 CA0F1C JZ SNERR ;BRIF IS 1770 08E6 FE2C CPI ',' ;TEST IS COMMA 1771 08E8 C2EF08 JNZ ON4 ;BRIF NOT 1772 08EB 23 INX H ;SKIP COMMA 1773 08EC C3DC08 JMP ON3A ;CONTINUE 1774 08EF CD2A1B ON4: CALL NUMER ;GO TEST IF NUMERIC 1775 08F2 C2F908 JNZ ON5 ;BRIF NOT 1776 08F5 23 INX H ;POINT NEXT 1777 08F6 C3EF08 JMP ON4 ;LOOP 1778 08F9 0D ON5: DCR C ;SUB ONE FROM COUNT 1779 08FA C2DC08 JNZ ON3A ;LOOP TILL JUST BEFORE STMT# 1780 08FD CDAD1A ON6: CALL NOTEO ;ERROR IF NOT END-OF-LINE 1781 0900 FE2C CPI ',' ;TEST IF COMMA 1782 0902 C20909 JNZ ON7 ;BRIF NOT 1783 0905 23 INX H ;POINT NEXT 1784 0906 C3FD08 JMP ON6 ;LOOP 1785 0909 CD2A1B ON7: CALL NUMER ;TEST IF NUMERIC 1786 090C C20F1C JNZ SNERR ;BRIF NOT 1787 090F CDB51A CALL PACK ;GET THE LINE NUMBER 1788 0912 7E ON8: MOV A,M ;GET NEXT CHAR 1789 0913 CDA81A CALL TSTEL ;TEST IF END STMT 1790 0916 CA1D09 JZ ON9 ;BRIF END 1791 0919 23 INX H ;POINT NEXT 1792 091A C31209 JMP ON8 ;LOOP 1793 091D CD941A ON9: CALL EOL ;SET END OF LINE POINTERS 1794 0920 3A2522 LDA REL ;GET TYPE (GOTO OR GOSUB) 1795 0923 B7 ORA A ;TEST IT 1796 0924 C24303 JNZ GOSU1 ;BRIF GOSUB 1797 0927 C30603 JMP GOTO2 ;BR TO GOTO LOOKUP 1798 ;PAGE 17991 1800 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1801+ 21:37 05/19/2019 1802+ PAGE 32 1803 1804 1805 1806 ; 1807 092A CHANG EQU $ 1808 ; 1809 ; STATEMENT: CHANGE A$ TO X - OR - 1810 ; 1811 ; CHANGE X TO A$ 1812 ; 1813 092A CDC91B CALL VAR ;NEXT WORD MUST BE VAR 1814 092D 7B MOV A,E ;TEST TYPE 1815 092E B7 ORA A ;SET FLAGS 1816 092F F26809 JP CHA2 ;BRIF NOT-STRING 1817 0932 CD341B CALL SEARC ;GET ADDR 1818 0935 D5 PUSH D ;SAVE IT 1819 0936 11D21E LXI D,TOLIT ;POINT 'TO' 1820 0939 D7 RST 2 ;COMPARE 1821 093A C20F1C JNZ SNERR ;BRIF ERROR 1822 093D CDC91B CALL VAR ;GET NEXT VARIABLE 1823 0940 7A MOV A,D ;GET HI NAME 1824 0941 F680 ORI 80H ;SET MASK FOR ARRAY 1825 0943 57 MOV D,A ;REPLACE 1826 0944 CD341B CALL SEARC ;GET ADDRESS 1827 0947 E7 RST 4 ;POINT START OF ELEMENT 0,0 1828 0948 F5 DB -11 AND 0FFH 1829 0949 D1 POP D ;GET PTR TO STMT 1830 094A EB XCHG ;FLIP 1831 094B CD941A CALL EOL ;NEXT MUST BE E-O-L 1832 094E EB XCHG ;FLIP AGAIN 1833 094F D1 POP D ;GET ADDR STRING 1834 0950 1A LDAX D ;GET COUNT 1835 0951 47 MOV B,A ;SAVE IT 1836 0952 04 INR B ;BUMP 1837 0953 C5 CHA1: PUSH B ;SAVE CTR 1838 0954 D5 PUSH D ;SAVE ADDR STRING 1839 0955 E5 PUSH H ;SAVE ADDR NUM 1840 0956 CD1A0D CALL FDEC ;CONVERT TO F.P. 1841 0959 E1 POP H ;GET ADDR 1842 095A DF RST 3 ;STORE IT 1843 095B E7 RST 4 ;POINT TO NEXT 1844 095C F8 DB -8 AND 0FFH 1845 095D D1 POP D ;RESTORE STRING 1846 095E C1 POP B ;AND CTR 1847 095F 13 INX D ;POINT NEXT CHAR 1848 0960 1A LDAX D ;LOAD IT 1849 0961 05 DCR B ;DECR CTR 1850 0962 C25309 JNZ CHA1 ;LOOP 1851 0965 C30B02 JMP RUN 1852 ; 1853 ; 1854 0968 7A CHA2: MOV A,D ;GET HI NAME 1855 0969 F680 ORI 80H ;MAKE ARRAY NAME 1856 096B 57 MOV D,A ;SAVE 18571 1858 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1859+ 21:37 05/19/2019 1860+ PAGE 33 1861 1862 1863 1864 096C CD341B CALL SEARC ;GET ADDR 1865 096F E7 RST 4 ;POINT ELEMENT 0,0 1866 0970 F5 DB -11 AND 0FFH 1867 0971 E3 XTHL ;SAVE ON STACK 1868 0972 11D21E LXI D,TOLIT ;POINT 'TO' 1869 0975 D7 RST 2 ;COMPARE 1870 0976 C20F1C JNZ SNERR ;BRIF ERROR 1871 0979 CDC91B CALL VAR ;GET NAME 1872 097C 7B MOV A,E ;GET TYPE 1873 097D B7 ORA A ;SET FLAGS 1874 097E F20F1C JP SNERR ;BRIF NOT STRING 1875 0981 CD941A CALL EOL ;BRIF NOT E-O-L 1876 0984 CD341B CALL SEARC ;GET ADDR 1877 0987 E1 POP H ;GET ADDR VAR 1878 0988 D5 PUSH D ;SAVE D,E 1879 0989 112021 LXI D,STRIN ;POINT STRING BUFFER 1880 098C D5 PUSH D ;SAVE IT 1881 098D EF RST 5 ;LOAD IT 1882 098E E7 RST 4 ;POINT NEXT 1883 098F F8 DB -8 AND 0FFH 1884 0990 E5 PUSH H ;SAVE H,L 1885 0991 CD661C CALL FBIN ;CONVERT 1886 0994 E1 POP H ;RESTORE 1887 0995 D1 POP D ;DITTO 1888 0996 47 MOV B,A ;SAVE COUNT 1889 0997 04 INR B ;BUMP IT 1890 0998 12 CHA3: STAX D ;PUT TO STRING 1891 0999 13 INX D ;POINT NEXT STR LOC. 1892 099A C5 PUSH B ;SAVE CTRS 1893 099B D5 PUSH D ;AND ADDR 1894 099C EF RST 5 ;LOAD NEXT 1895 099D E7 RST 4 ;POINT NEXT 1896 099E F8 DB -8 AND 0FFH 1897 099F E5 PUSH H ;AND H ADDR 1898 09A0 CD661C CALL FBIN ;CONVERT 1899 09A3 E1 POP H ;RESTORE H,L 1900 09A4 D1 POP D ;AND D,E 1901 09A5 C1 POP B ;AND CTRS 1902 09A6 05 DCR B ;DECR CTR 1903 09A7 C29809 JNZ CHA3 ;LOOP 1904 09AA E1 POP H ;GET ADDR OF VAR (STRING) 1905 09AB CD3106 CALL LET2A ;GO STORE IT 1906 09AE C30B02 JMP RUN ;CONTINUE 1907 ;PAGE 1908 ; 1909 09B1 DIM EQU $ 1910 ; 1911 ; STMT: DIM VAR(A,B),... 1912 ; 1913 ; 1914 09B1 CDC91B CALL VAR ;GO GET VAR NAME 19151 1916 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1917+ 21:37 05/19/2019 1918+ PAGE 34 1919 1920 1921 1922 09B4 F20F1C JP SNERR ;BRIF NO ( 1923 09B7 CD341B CALL SEARC ;GO LOCATE THE VAR 1924 09BA E3 XTHL ;PUT ADDR IN STACK, GET PTR TO ( 1925 09BB F5 PUSH PSW ;SAVE STATUS 1926 09BC 3EFF MVI A,0FFH ;TURN ON SW 1927 09BE 327220 STA DIMSW ;SET IT 1928 09C1 CD800F CALL EXPR ;GO EVALUATE 1929 09C4 F1 POP PSW ;GET STATUS 1930 09C5 E3 XTHL ;SWAP PTRS 1931 09C6 D5 PUSH D ;SAVE ROW NUMBER 1932 09C7 C5 PUSH B ;SAVE COL NUMBER 1933 09C8 03 INX B ;INCREMENT COLUMNS 1934 09C9 13 INX D ;AND ROWS 1935 09CA E5 PUSH H ;SAVE H,L 1936 09CB F5 PUSH PSW ;RESAVE STATUS 1937 09CC 210000 LXI H,0 ;GET A ZERO 1938 09CF 19 DIM1: DAD D ;TIMES ONE 1939 09D0 0B DCX B ;DCR COLS 1940 09D1 78 MOV A,B ;GET HI 1941 09D2 B1 ORA C ;PLUS LO 1942 09D3 C2CF09 JNZ DIM1 ;LOOP 1943 09D6 F1 POP PSW ;GET STATUS 1944 09D7 D1 POP D ;GET ADDRESS 1945 09D8 29 DAD H ;TIMES TWO 1946 09D9 29 DAD H ;TIMES FOUR 1947 09DA 010800 LXI B,8 ;PLUS 2 (NAME AND DISP) 1948 09DD FA1D0A JM REDIM ;GO RE-DIMENSION 1949 09E0 E5 PUSH H ;SAVE PRODUCT 1950 09E1 09 DAD B ;ADD IT 1951 09E2 EB XCHG ;FLIP/FLOP 1952 09E3 2B DCX H ;POINT LO NAME 1953 09E4 2B DCX H ;POINT HI DISP 1954 09E5 7B MOV A,E ;GET LO 1955 09E6 2F CMA ;COMPLEMENT 1956 09E7 C601 ADI 1 ;PLUS ONE 1957 09E9 5F MOV E,A ;RESTORE 1958 09EA 7A MOV A,D ;GET HI 1959 09EB 2F CMA ;COMPLEMENT 1960 09EC CE00 ACI 0 ;PLUS CARRY 1961 09EE 77 MOV M,A ;STORE IT 1962 09EF 2B DCX H ;POINT NEXT 1963 09F0 73 MOV M,E ;STORE LO 1964 09F1 EB XCHG ;SAVE IN D,E 1965 09F2 E1 POP H ;GET PRODUCT 1966 09F3 44 MOV B,H ;COPY H,L 1967 09F4 4D MOV C,L ;TO B,C 1968 09F5 EB XCHG ;GET LOCAT 1969 09F6 D1 POP D ;GET COLUMNS 1970 09F7 2B DCX H ;POINT NEXT 1971 09F8 72 MOV M,D ;MOVE LO COL 1972 09F9 2B DCX H ;POINT NEXT 19731 1974 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 1975+ 21:37 05/19/2019 1976+ PAGE 35 1977 1978 1979 1980 09FA 73 MOV M,E ;MOVE HI COL 1981 09FB D1 POP D ;GET ROWS 1982 09FC 2B DCX H ;POINT NEXT 1983 09FD 72 MOV M,D ;MOVE HI ROW 1984 09FE 2B DCX H ;POINT NEXT 1985 09FF 73 MOV M,E ;MOVE LO ROW 1986 0A00 2B DCX H ;POINT NEXT 1987 0A01 3600 DIM2: MVI M,0 ;CLEAR ONE BYTE 1988 0A03 2B DCX H ;POINT NEXT 1989 0A04 0B DCX B ;DECR CTR 1990 0A05 78 MOV A,B ;GET HI 1991 0A06 B1 ORA C ;PLUS LO 1992 0A07 C2010A JNZ DIM2 ;LOOP 1993 0A0A 3600 MVI M,0 ;MARK END 1994 0A0C E1 DIM3: POP H ;GET PTR TO STMT 1995 0A0D 7E MOV A,M ;LOAD CHAR 1996 0A0E FE2C CPI ',' ;TEST IF COMMA 1997 0A10 C2170A JNZ DIM4 ;BRIF NOT 1998 0A13 23 INX H ;SKIP IT 1999 0A14 C3B109 JMP DIM ;CONTINUE 2000 0A17 CD941A DIM4: CALL EOL ;TEST END OF LINE 2001 0A1A C30B02 JMP RUN ;CONTINUE WITH PROGRAM 2002 0A1D 09 REDIM: DAD B ;COMPUTE LEN TO NEXT 2003 0A1E 1B DCX D ;POINT LO NAME 2004 0A1F 1B DCX D ;POINT HI DISP 2005 0A20 1A LDAX D ;GET IT 2006 0A21 47 MOV B,A ;SAVE 2007 0A22 1B DCX D ;POINT LO DISP 2008 0A23 1A LDAX D ;GET IT 2009 0A24 4F MOV C,A ;SAVE 2010 0A25 09 DAD B ;COMPUTE DIFF OR PRIOR DIM AND THIS 2011 0A26 7C MOV A,H ;GET HI DIFF 2012 0A27 B7 ORA A ;TEST IT 2013 0A28 FA330A JM REDM1 ;BRIF PREV > NEW 2014 0A2B C20F1C JNZ SNERR ;BRIF PREV < NEW 2015 0A2E 7D MOV A,L ;GET LO DIFF 2016 0A2F B7 ORA A ;TEST IT 2017 0A30 C20F1C JNZ SNERR ;BRIF PREV < NEW 2018 0A33 EB REDM1: XCHG ;PUT ADDR IN H,L 2019 0A34 2B DCX H ;POINT HI COL 2020 0A35 D1 POP D ;GET COL 2021 0A36 72 MOV M,D ;MOVE HI 2022 0A37 2B DCX H ;POINT LO COL 2023 0A38 73 MOV M,E ;MOVE LO 2024 0A39 D1 POP D ;GET ROW 2025 0A3A 2B DCX H ;POINT HI ROW 2026 0A3B 72 MOV M,D ;MOVE HI 2027 0A3C 2B DCX H ;POINT LO ROW 2028 0A3D 73 MOV M,E ;MOVE LO 2029 0A3E C30C0A JMP DIM3 ;CONTINUE 2030 ;PAGE 20311 2032 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2033+ 21:37 05/19/2019 2034+ PAGE 36 2035 2036 2037 2038 ; 2039 0A41 SIN EQU $ 2040 ; 2041 ; COMPUTE SINE OF X, (X IN RADIANS) 2042 ; 2043 ; USES 4TH DEGREE POLYNOMIAL APPROXIMATION 2044 ; 2045 ; 2046 ; FIRST, REDUCE ANGLE TO RANGE: (-PI/2,PI/2) 2047 ; 2048 0A41 CDCE18 CALL FTEST ;GET STATUS OF ANGLE 2049 0A44 C8 RZ ;SIN(0)=0 2050 0A45 F5 PUSH PSW ;SAVE SIGN OF ANGLE 2051 0A46 CDC70B CALL ABS 2052 0A49 F1 SIN1: POP PSW ;COMPLEMENT SIGN FOR EACH PI SUB'D 2053 0A4A 2F CMA ;.. 2054 0A4B F5 PUSH PSW ;.. 2055 0A4C 21A21D LXI H,PI ;REDUCE TO -PI<X<0 2056 0A4F CD0C17 CALL FSUB 2057 0A52 F2490A JP SIN1 2058 0A55 21D61D LXI H,HALFP ;NOW ADD PI FOR -PI<X<-PI/2 2059 0A58 E5 PUSH H 2060 0A59 CD3716 CALL FADD 2061 0A5C F47A0C CP NEG ;AND JUST NEGATE FOR -PI/2<X<0 2062 0A5F E1 POP H 2063 0A60 CD3716 CALL FADD 2064 0A63 F1 POP PSW ;RESTORE SIGN 2065 0A64 B7 ORA A 2066 0A65 F47A0C CP NEG 2067 ; 2068 ; INIT REGISTERS 2069 ; 2070 0A68 212F22 LXI H,TEMP1 ;POINT IT 2071 0A6B DF RST 3 ;SAVE IT 2072 0A6C 3A5822 LDA FACC ;GET SIGN&EXPONENT 2073 0A6F CDDC18 CALL FEXP ;EXPAND EXPON. 2074 0A72 F2780A JP SIN3A ;BRIF POSITIVE 2075 0A75 FEFD CPI 0FDH ;TEST EXPONENT 2076 0A77 D8 RC ;RETURN IF VERY SMALL RADIAN 2077 ; 2078 ; ABOVE ROUTINE WILL APPROX SIN(X) == X FOR X: (-.06,.06) 2079 ; 2080 0A78 21D61D SIN3A: LXI H,HALFP ;POINT PI/2 2081 0A7B CD9B17 CALL FDIV ;COMPUTE X/PI/2 2082 0A7E 213322 LXI H,TEMP2 ;POINT T2 2083 0A81 DF RST 3 ;STORE IT 2084 0A82 213322 LXI H,TEMP2 ;POINT BACK 2085 0A85 CD1817 CALL FMUL ;COMPUTE SQUARE 2086 0A88 21E61D LXI H,SINCO ;POINT CONSTANTS 2087 ; 2088 ; EVALUATE POWER SERIES 20891 2090 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2091+ 21:37 05/19/2019 2092+ PAGE 37 2093 2094 2095 2096 ; 2097 ; EVALUATE STARTING FROM HIGH ORDER COEFFICIENT: 2098 ; F(X)=(...(CN*FACC+C(N-1))*FACC+...+C1)*FACC*TEMP2+TEMP1 2099 ; 2100 ;ON ENTRY: 2101 ; TEMP1=CONSTANT TERM 2102 ; TEMP2=X OR 1 2103 ; FACC=X 2 OR X 2104 ; (HL)=COEFFICIENT OF LAST TERM 2105 ; 2106 0A8B E5 EVPS: PUSH H ;SAVE POINTER TO COEFFICIENTS 2107 0A8C 213722 LXI H,TEMP3 ;SAVE FACC 2108 0A8F DF RST 3 2109 0A90 E1 POP H ;RESTORE H 2110 0A91 E5 PUSH H 2111 0A92 C39C0A JMP EVPS2 2112 0A95 E5 EVPS1: PUSH H ;SAVE PTR TO NEXT COEFFICIENT 2113 0A96 CD3716 CALL FADD ;FACC+CN->FACC 2114 0A99 213722 LXI H,TEMP3 ;POINTER TO X N 2115 0A9C CD1817 EVPS2: CALL FMUL ;FACC*X N->FACC 2116 0A9F E1 POP H ;COEFFICENT PTR 2117 0AA0 E7 RST 4 ;MOVE TO NEXT COEFFICIENT 2118 0AA1 FC DB -4 AND 0FFH 2119 0AA2 7E MOV A,M ;GET EXPONENT 2120 0AA3 3D DCR A ;TEST FOR 1 2121 0AA4 C2950A JNZ EVPS1 ;BRIF NOT 1 2122 0AA7 213322 LXI H,TEMP2 ;MUL BY TEMP2 2123 0AAA CD1817 CALL FMUL 2124 0AAD 212F22 LXI H,TEMP1 ;POINT TO CONSTANT TERM 2125 0AB0 C33716 JMP FADD ;ADD IT AND RETURN TO CALLER 2126 ; 2127 0AB3 COS EQU $ 2128 ; 2129 ; 2130 ; COMPUTE COSINE OF ANGLE, X EXPRESSED IN RADIANS 2131 ; USES THE TRANSFORMATION: Y = PI/2 +- X 2132 ; AND THEN COMPUTES SIN(Y). 2133 ; 2134 ; 2135 0AB3 21D61D LXI H,HALFP ;COMPUTE PI/2 + X 2136 0AB6 CD3716 CALL FADD ;GO ADD 2137 0AB9 C3410A JMP SIN ;GO COMPUTE SINE 2138 ; 2139 0ABC TAN EQU $ 2140 ; 2141 ; COMPUTE TANGENT OF X, IN RADIANS 2142 ; USES THE RELATION: 2143 ; 2144 ; SIN(X) 2145 ; TAN(X) = ------ 2146 ; COS(X) 21471 2148 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2149+ 21:37 05/19/2019 2150+ PAGE 38 2151 2152 2153 2154 ; 2155 0ABC 213B22 LXI H,TEMP4 ;POINT SAVE AREA 2156 0ABF DF RST 3 ;SAVE ANGLE 2157 0AC0 CDB30A CALL COS ;COMPUTE COS(X) 2158 0AC3 214722 LXI H,TEMP7 ;SAVE COS(X)->TEMP7 2159 0AC6 DF RST 3 2160 0AC7 213B22 LXI H,TEMP4 ;MOVE X->FACC 2161 0ACA EF RST 5 2162 0ACB CD410A CALL SIN ;COMPUTE SINE 2163 0ACE 214722 LXI H,TEMP7 ;POINT COS 2164 0AD1 C39B17 JMP FDIV ;DIVIDE AND RETURN TO CALLER 2165 ; 2166 0AD4 ATN EQU $ 2167 ; 2168 ; COMPUTES THE ARCTANGENT OF X 2169 ; USES A SEVENTH DEGREE POLYNOMIAL APPROXIMATION 2170 ; 2171 0AD4 CDCE18 CALL FTEST ;CHECK SIGN OF ARGUMENT 2172 0AD7 F2E30A JP ATN1 ;BRIF POSITIVE 2173 0ADA CD7A0C CALL NEG ;REVERSE SIGN 2174 0ADD CDE30A CALL ATN1 ;GET POSITIVE ATN 2175 0AE0 C37A0C JMP NEG ;MAKE NEG & RETURN 2176 ; 2177 0AE3 21EA1D ATN1: LXI H,ONE ;POINT: 1 2178 0AE6 CD3716 CALL FADD ;GO ADD 2179 0AE9 212F22 LXI H,TEMP1 ;POINT SAVE 2180 0AEC DF RST 3 ;STORE 2181 0AED 219A1D LXI H,TWO ;POINT: 2 2182 0AF0 CD0C17 CALL FSUB ;GO SUBTRACT 2183 0AF3 212F22 LXI H,TEMP1 ;POINT SAVED 2184 0AF6 CD9B17 CALL FDIV ;DIVIDE 2185 0AF9 213322 LXI H,TEMP2 ;POINT SAVE 2186 0AFC DF RST 3 ;SAVE X'=(X-1)/(X+1) 2187 0AFD 21A61D LXI H,QTRPI ;X'+PI/4 -> TEMP1 2188 0B00 CD3716 CALL FADD 2189 0B03 212F22 LXI H,TEMP1 2190 0B06 DF RST 3 2191 0B07 E5 PUSH H ;SAVE PTR TO TEMP2 2192 0B08 EF RST 5 ;LOAD IT 2193 0B09 E1 POP H 2194 0B0A CD1817 CALL FMUL ;FACC=X'*X' 2195 0B0D 21D21D LXI H,ATNCO ;POINT LIST COEFFICIENTS 2196 0B10 C38B0A JMP EVPS ;GO COMPUTE & RETURN 2197 ; 2198 0B13 LN EQU $ 2199 ; 2200 ; 2201 ; COMPUTES THE NATRUAL LOGRITHM, LN(X) 2202 ; USES A 7TH DEGREE POLYNOMIAL APPROXIMATION 2203 ; 2204 0B13 CDCE18 CALL FTEST ;TEST THE ARGUMENT 22051 2206 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2207+ 21:37 05/19/2019 2208+ PAGE 39 2209 2210 2211 2212 0B16 FA071C JM ZMERR ;LN(-X)=NO NO 2213 0B19 CA071C JZ ZMERR ;LN(0)=NO NO ALSO 2214 0B1C 213322 LXI H,TEMP2 ;POINT SAVE AREA 2215 0B1F DF RST 3 ;STORE IT 2216 0B20 3A5822 LDA FACC ;GET EXPON 2217 0B23 CDDC18 CALL FEXP ;EXPAND TO 8 BITS 2218 0B26 CA2C0B JZ LN0 ;BRIF 0.5 < X < 1.0 2219 0B29 F2380B JP LN1 ;BRIF POSITIVE EXPONENT 2220 0B2C 2F LN0: CMA ;ELSE COMPLIMENT 2221 0B2D C602 ADI 2 ;PLUS TWO 2222 0B2F CD1A0D CALL FDEC ;CONVERT TO FLOAT POINT 2223 0B32 CD7A0C CALL NEG ;THEN NEGATE 2224 0B35 C33D0B JMP LN2 ;GO AROUND 2225 0B38 DE01 LN1: SBI 1 ;MINUS ONE 2226 0B3A CD1A0D CALL FDEC ;CONVERT TO FLOATING POINT 2227 0B3D 21AE1D LN2: LXI H,LN2C ;POINT LN(2) 2228 0B40 CD1817 CALL FMUL ;MULTIPLY 2229 0B43 212F22 LXI H,TEMP1 ;POINT SAVE AREA 2230 0B46 DF RST 3 ;STORE IT 2231 0B47 EF RST 5 ;GET ORIG X 2232 0B48 3E01 MVI A,1 ;GET EXPONENT: 1 2233 0B4A 325822 STA FACC ;ADJUST TO RANGE (1,2) 2234 0B4D 21EA1D LXI H,ONE ;POINT 1 2235 0B50 E5 PUSH H ;SAVE PTR TO ONE 2236 0B51 CD0C17 CALL FSUB ;SUBTRACT ONE 2237 0B54 D1 POP D ;SET TEMP2=1 2238 0B55 213322 LXI H,TEMP2 2239 0B58 CD4B1C CALL CPY4D 2240 0B5B 21061E LXI H,LNCO ;POINT COEFFICIENTS 2241 0B5E C38B0A JMP EVPS ;APPROXIMATE & RETURN 2242 ; 2243 ; X=LOG(X) --- THIS IS LOG BASE 10. 2244 ; 2245 0B61 LOG EQU $ 2246 0B61 CD130B CALL LN ;COMPUTE NATURAL LOG 2247 0B64 21221E LXI H,LNC ;POINT LOG(E) 2248 0B67 C31817 JMP FMUL ;MULTIPLY AND RETURN 2249 ; 2250 0B6A EXP EQU $ 2251 ; 2252 ; COMPUTES EXP(X) USING ALGORITHM EXP(X)=(2 I)*(2 FP) WHERE 2253 ; 2 I=INT(X*LN BASE 2 OF E) AND, 2254 ; 2 FP=5TH DEGREE POLY. APPROXIMATION 2255 ; FP=FRACTIONAL PART OF INT(X*LN2E) 2256 ; 2257 0B6A CDCE18 CALL FTEST ;CHECK SIGN 2258 0B6D F2840B JP EXP1 ;BRIF POSITIVE 2259 0B70 CD7A0C CALL NEG ;ELSE, REVERSE SIGN 2260 0B73 CD840B CALL EXP1 ;COMPUTE POSITIVE EXP 2261 0B76 212F22 LXI H,TEMP1 ;POINT SAVE AREA 2262 0B79 DF RST 3 ;STORE IT 22631 2264 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2265+ 21:37 05/19/2019 2266+ PAGE 40 2267 2268 2269 2270 0B7A 21EA1D LXI H,ONE ;POINT 1 2271 0B7D EF RST 5 ;LOAD IT 2272 0B7E 212F22 LXI H,TEMP1 ;POINT PREV 2273 0B81 C39B17 JMP FDIV ;RECIPRICAL AND RETURN 2274 ; 2275 0B84 210A1E EXP1: LXI H,LN2E ;POINT LN BASE 2 OF E 2276 0B87 CD1817 CALL FMUL ;FACC=X*(LN2E) 2277 0B8A 213722 LXI H,TEMP3 ;POINT SAVE AREA 2278 0B8D DF RST 3 ;TEMP3=X*LN2E 2279 0B8E CDE20B CALL INT ;FACC=INT(X*LN2E) 2280 0B91 213B22 LXI H,TEMP4 ;POINT SAVE AREA 2281 0B94 DF RST 3 ;TEMP4=INT(X*LN2E) 2282 0B95 DF RST 3 ;DITTO FOR TEMP5 2283 0B96 3A5822 LDA FACC ;GET THE EXPONENT COUNT 2284 0B99 47 MOV B,A ;SAVE COUNT IN B 2285 0B9A 3A5922 LDA FACC+1 ;GET MANTISSA 2286 0B9D 07 ELOOP: RLC ;ROTATE LEFT 2287 0B9E 05 DCR B ;REDUCE COUNT 2288 0B9F C29D0B JNZ ELOOP ;CONTINUE SHIFTING 2289 0BA2 3C INR A ;ADJUST EXPONENT 2290 0BA3 323B22 STA TEMP4 ;STORE EXPONENT 2291 0BA6 3E80 MVI A,80H ;LOAD CONSTANT 2292 0BA8 323C22 STA TEMP4+1 ;STORE AS MANTISSA 2293 0BAB 21EA1D LXI H,ONE ;1 -> TEMP1, TEMP2 2294 0BAE EF RST 5 2295 0BAF 212F22 LXI H,TEMP1 2296 0BB2 DF RST 3 2297 0BB3 DF RST 3 2298 0BB4 EF RST 5 ;LOAD TEMP3=INT(X*LN2E) 2299 0BB5 213F22 LXI H,TEMP5 ;GET FACC=FP(X*LN2E) 2300 0BB8 CD0C17 CALL FSUB 2301 0BBB 211E1E LXI H,EXPCO ;POINT CONSTANTS 2302 0BBE CD8B0A CALL EVPS ;COMPUTE POLYNOMIAL 2303 0BC1 213B22 LXI H,TEMP4 ;POINT 2 (INT(X*LN2E)) 2304 0BC4 C31817 JMP FMUL ;MULTIPLY,NORMALIZE AND RETURN 2305 ; 2306 ; 2307 0BC7 ABS EQU $ 2308 ; 2309 ; 2310 ; RETURN THE ABSOLUTE VALUE OF THE FLOATING ACCUMULATOR 2311 ; 2312 ; 2313 0BC7 3A5822 LDA FACC ;GET EXPONENT 2314 0BCA E67F ANI 7FH ;STRIP NEGATIVE SIGN 2315 0BCC 325822 STA FACC ;REPLACE 2316 0BCF C9 RET ;RETURN 2317 ; 2318 0BD0 SGN EQU $ 2319 ; 2320 ; 23211 2322 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2323+ 21:37 05/19/2019 2324+ PAGE 41 2325 2326 2327 2328 ; RETURNS THE SIGN OF THE FLOATING ACCUMULATOR 2329 ; THAT IS: 2330 ; 1 IF FACC > 0 2331 ; 0 IF FACC = 0 2332 ; -1 IF FACC < 0 2333 ; 2334 0BD0 CDCE18 CALL FTEST ;GET STATUS OF FACC 2335 0BD3 C8 RZ ;RETURN IF ZERO 2336 0BD4 E680 ANI 80H ;ISOLATE SIGN 2337 0BD6 F601 SGN1: ORI 1 ;CREATE EXPONENT 2338 0BD8 F5 PUSH PSW ;SAVE IT 2339 0BD9 21EA1D LXI H,ONE ;GET ADDRESS OF CONSTANT 1 2340 0BDC EF RST 5 ;GO LOAD IT 2341 0BDD F1 POP PSW ;RESTORE SIGN 2342 0BDE 325822 STA FACC ;SET THE SIGN 2343 0BE1 C9 RET ;RETURN 2344 ; 2345 0BE2 INT EQU $ 2346 ; 2347 ; 2348 ; RETURNS THE GREATEST INTEGER NOT LARGER THAN VALUE IN FACC 2349 ; E.G.: 2350 ; INT(3.14159) = 3 2351 ; INT(0) = 0 2352 ; INT(-3.1415) = -4 2353 ; 2354 ; 2355 0BE2 215822 LXI H,FACC ;POINT FLOAT ACC 2356 0BE5 7E MOV A,M ;GET EXPONENT 2357 0BE6 E640 ANI 40H ;GET SIGN OF CHARACTERISTIC 2358 0BE8 CAF00B JZ INT2 ;BRIF GE ZERO 2359 0BEB 0604 MVI B,4 ;LOOP CTR 2360 0BED C35E1C JMP ZEROM ;GO ZERO THE FACC 2361 0BF0 7E INT2: MOV A,M ;GET EXPONENT AGAIN 2362 0BF1 B7 ORA A ;TEST SIGN 2363 0BF2 F2FF0B JP INT3 ;BRIF POSITIVE OR ZERO 2364 0BF5 21AA1D LXI H,NEGON ;POINT CONSTANT: -.9999999 2365 0BF8 CD3716 CALL FADD ;ADD TO FACC 2366 0BFB 215822 LXI H,FACC ;POINT EXPONTENT AGAIN 2367 0BFE 7E MOV A,M ;LOAD IT 2368 0BFF E63F INT3: ANI 3FH ;ISOLATE CHARACTERISTIC 2369 0C01 FE18 CPI 24 ;TEST IF ANY FRACTION 2370 0C03 F0 RP ;RETURN IF NOT 2371 0C04 47 MOV B,A ;SAVE EXPONENT 2372 0C05 3E18 MVI A,24 ;GET CONSTANT 2373 0C07 90 SUB B ;MINUS EXPONENT = LOOP CTR 2374 0C08 4F MOV C,A ;SAVE IT 2375 0C09 215922 INT4: LXI H,FACC+1 ;POINT MSB 2376 0C0C AF XRA A ;CLEAR CY FLAG 2377 0C0D 0603 MVI B,3 ;BYTE COUNT 2378 0C0F 7E INT5: MOV A,M ;LOAD A BYTE 23791 2380 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2381+ 21:37 05/19/2019 2382+ PAGE 42 2383 2384 2385 2386 0C10 1F RAR ;SHIFT RIGHT 2387 0C11 77 MOV M,A ;REPLACE 2388 0C12 23 INX H ;POINT NEXT 2389 0C13 05 DCR B ;DECR BYTE CTR 2390 0C14 C20F0C JNZ INT5 ;LOOP 2391 0C17 0D DCR C ;DECR BIT CTR 2392 0C18 C2090C JNZ INT4 ;LOOP 2393 0C1B 215822 LXI H,FACC ;POINT SIGN & EXP 2394 0C1E 7E MOV A,M ;LOAD IT 2395 0C1F E680 ANI 80H ;ISOLATE SIGN 2396 0C21 C618 ADI 24 ;PLUS INTEGER 2397 0C23 77 MOV M,A ;REPLACE IT 2398 0C24 C3DD16 JMP FNORM ;GO NORMALIZE & RETURN 2399 ; 2400 0C27 SQR EQU $ 2401 ; 2402 ; COMPUTE SQAURE ROOT OF ARG IN FACC, PUT RESULT IN FACC 2403 ; 2404 ; USE HERON'S ITERATIVE PROCESS 2405 ; 2406 0C27 CDCE18 CALL FTEST ;TEST THE ARGUMENT 2407 0C2A C8 RZ ;RETURN IF ZERO 2408 0C2B FA071C JM ZMERR ;ERROR IF NEGATIVE 2409 0C2E 327522 STA DEXP ;SAVE ORIG EXPONENT 2410 0C31 AF XRA A ;GET A ZERO 2411 0C32 325822 STA FACC ;PUT ARG IN RANGE .5, 1 2412 0C35 213322 LXI H,TEMP2 ;POINT SAVE AREA 2413 0C38 DF RST 3 ;STORE IT 2414 ; 2415 ; INITIAL APPROXIMATION 0.41730759 + 0.59016206 * MANTISSA 2416 ; 2417 0C39 21B21D LXI H,SQC1 ;POINT .59016 2418 0C3C CD1817 CALL FMUL ;GO MULTIPLY 2419 0C3F 21B61D LXI H,SQC2 ;PINT .4173 2420 0C42 CD3716 CALL FADD ;GO ADD 2421 0C45 212F22 LXI H,TEMP1 ;POINT SAVE AREA 2422 0C48 DF RST 3 ;GO STORE IT 2423 ; 2424 ; NEWTON'S METHOD OF ITERATION TO THE APPROXIMATE 2425 ; VALUE OF THE SQR OF MANTISSA 2426 ; 2427 0C49 CD640C CALL SQR1 ;FIRST ITERATION 2428 0C4C 212F22 LXI H,TEMP1 ;POINT SAVE AREA 2429 0C4F DF RST 3 ;STORE IT 2430 0C50 CD640C CALL SQR1 ;SECOND ITERATION 2431 ; 2432 ; RESTORE RANGE TO OBTAIN THE FINAL RESULT 2433 ; 2434 0C53 3A7522 LDA DEXP ;GET SAVE EXPONENT 2435 0C56 CDDC18 CALL FEXP ;EXPAND IT 2436 0C59 1F RAR ;DIVIDE BY 2 24371 2438 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2439+ 21:37 05/19/2019 2440+ PAGE 43 2441 2442 2443 2444 0C5A 325822 STA FACC ;STORE IT 2445 0C5D D0 RNC ;RETURN IF EXPON EVEN 2446 0C5E 21BA1D LXI H,SQC3 ;ELSE, POINT SQR(2) 2447 0C61 C31817 JMP FMUL ;GO MULTIPLY AND RETURN 2448 ; 2449 ; THIS ROUTINE PERFORMS ONE NEWTON ITERATION 2450 ; TO THE SQUARE ROOT FUNCTION 2451 ; 2452 0C64 213322 SQR1: LXI H,TEMP2 ;POINT MANTISSA 2453 0C67 EF RST 5 ;LOAD IT 2454 0C68 212F22 LXI H,TEMP1 ;POINT PREV GUESS 2455 0C6B CD9B17 CALL FDIV ;FORM MANT/TEMP1 2456 0C6E 212F22 LXI H,TEMP1 ;POINT PREV 2457 0C71 CD3716 CALL FADD ;FORM TEMP1 + MANT/TEMP1 2458 0C74 D601 SUI 1 ;DIVIDE BY 2 2459 0C76 325822 STA FACC ;FORM (TEMP1 + MANT/TEMP1)/2 2460 0C79 C9 RET ;RETURN 2461 ; 2462 0C7A NEG EQU $ 2463 ; 2464 ; 2465 ; REVERSES THE SIGN OF THE FLOATING ACC 2466 ; 2467 ; 2468 0C7A CDCE18 CALL FTEST ;GET STATUS OF FACC 2469 0C7D C8 RZ ;RETURN IF ZERO 2470 0C7E EE80 XRI 80H ;REVERSE SIGN 2471 0C80 325822 STA FACC ;RESTORE EXPONENT 2472 0C83 C9 RET ;CONTINUE EVALUATION 2473 ; 2474 0C84 RND EQU $ 2475 ; 2476 ; 2477 ; PSEUDO RANDOM NUMBER GENERATOR 2478 ; 2479 ; 2480 0C84 214722 LXI H,TEMP7 ;SAVE ARG 2481 0C87 DF RST 3 2482 0C88 0604 MVI B,4 ;LOOP CTR 2483 0C8A 215822 LXI H,FACC ;POINT FLOAT ACCUM 2484 0C8D CD5E1C CALL ZEROM ;GO ZERO THE FACC 2485 0C90 0E03 MVI C,3 ;OUTTER LOP CTR 2486 0C92 215922 LXI H,FACC+1 ;POINT MSB 2487 0C95 E5 PUSH H ;SAVE H,L 2488 0C96 217C22 RND1: LXI H,RNDZ+1 ;POINT X,Y,Z 2489 0C99 0606 MVI B,6 ;LOOP CTR 2490 0C9B B7 ORA A ;TURN OFF CY 2491 0C9C 7E RND2: MOV A,M ;GET A BYTE 2492 0C9D 17 RAL ;SHIFT LEFT (MULT BY 2) 2493 0C9E 77 MOV M,A ;REPLACE THE BYTE 2494 0C9F 2B DCX H ;POINT NEXT 24951 2496 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2497+ 21:37 05/19/2019 2498+ PAGE 44 2499 2500 2501 2502 0CA0 05 DCR B ;DECR CTR 2503 0CA1 C29C0C JNZ RND2 ;LOOP 2504 0CA4 23 INX H ;POINT MSD X,Y,Z 2505 0CA5 11651D LXI D,RNDP ;POINT TO MODULO 2506 0CA8 0603 MVI B,3 ;LOOP CTR 2507 0CAA 1A FND3: LDAX D ;GET BYTE OF P,Q,R 2508 0CAB BE CMP M ;COMPARE WITH X,Y,Z 2509 0CAC 13 INX D ;POINT NEXT 2510 0CAD 23 INX H ;DITTO 2511 0CAE DAB90C JC RND4 ;BRIF P<X 2512 0CB1 C2C50C JNZ RND5 ;BRIF P>X 2513 0CB4 1A LDAX D ;GET LOW BYTE 2514 0CB5 BE CMP M ;CMPARE 2515 0CB6 D2C50C JNC RND5 ;BRIF P>=X 2516 0CB9 EB RND4: XCHG ;FLIP D,E TO H,L 2517 0CBA 1A LDAX D ;GET LOW X BYTE 2518 0CBB 96 SUB M ;SUBTRACT LOW P BYTE 2519 0CBC 12 STAX D ;STORE IT 2520 0CBD 1B DCX D ;POINT HIGH 2521 0CBE 2B DCX H ;DITTO 2522 0CBF 1A LDAX D ;GET HIGH X BYTE 2523 0CC0 9E SBB M ;SUB HIGH P BYTE 2524 0CC1 12 STAX D ;STORE IT 2525 0CC2 13 INX D ;POINT LOW 2526 0CC3 23 INX H ;DITTO 2527 0CC4 EB XCHG ;RESTORE ADDRS 2528 0CC5 13 RND5: INX D ;POINT NEXT 2529 0CC6 23 INX H ;DITTO 2530 0CC7 05 DCR B ;DECR CTR 2531 0CC8 C2AA0C JNZ FND3 ;LOOP 2532 0CCB 0603 MVI B,3 ;LOOP CTR 2533 0CCD 117E22 RND6: LXI D,RNDS+1 ;POINT LOW S 2534 0CD0 1A LDAX D ;GET LOW S 2535 0CD1 86 ADD M ;ADD LOW X,Y,Z 2536 0CD2 12 STAX D ;PUT S 2537 0CD3 1B DCX D ;POINT HIGH 2538 0CD4 2B DCX H ;DITTO 2539 0CD5 1A LDAX D ;GET HIGH S 2540 0CD6 8E ADC M ;ADD HIGH X,Y,Z 2541 0CD7 E63F ANI 3FH ;TURN OFF HIGH BITS 2542 0CD9 12 STAX D ;STORE IT 2543 0CDA 2B DCX H ;POINT NEXT X,Y,Z 2544 0CDB 05 DCR B ;DECR CTR 2545 0CDC C2CD0C JNZ RND6 ;LOOP 2546 0CDF 3E08 MVI A,8 ;CONSTANT 2547 0CE1 91 SUB C ;LESS CTR 2548 0CE2 1F RAR ;DIVIDE BY TWO 2549 0CE3 E1 POP H ;GET H,L ADDR 2550 0CE4 3A7E22 LDA RNDS+1 ;GET LSB OF S 2551 0CE7 77 MOV M,A ;STORE IT 2552 0CE8 23 INX H ;POINT NEXT 25531 2554 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2555+ 21:37 05/19/2019 2556+ PAGE 45 2557 2558 2559 2560 0CE9 E5 PUSH H ;SAVE H,L 2561 0CEA 0D DCR C ;DECR CTR 2562 0CEB C2960C JNZ RND1 ;LOOP 2563 0CEE E1 POP H ;RESTORE SP PTR 2564 0CEF 3A8722 LDA RNDSW ;GET SWITCH 2565 0CF2 B7 ORA A ;TEST IT 2566 0CF3 CA010D JZ RND7 ;BRIF NO RANDOMIZE 2567 0CF6 117F22 LXI D,TRNDX ;POINT SAVED VALUES 2568 0CF9 217722 LXI H,RNDX ;POINT NEXT VALUES 2569 0CFC 0608 MVI B,8 ;LOOP CTR 2570 0CFE CD581C CALL COPYH ;GO COPY 2571 0D01 CDDD16 RND7: CALL FNORM 2572 0D04 214722 LXI H,TEMP7 ;MULTIPLY BY RANGE 2573 0D07 C31817 JMP FMUL 2574 ; 2575 0D0A INP EQU $ 2576 ; 2577 ; 2578 ; INPUT A BYTE FROM THE DEVICE IN FACC 2579 ; 2580 ; PUT THE RESULT IN THE FACC 2581 ; 2582 0D0A CD661C CALL FBIN ;CONVERT FACC TO BINARY 2583 0D0D 212022 LXI H,OUTA ;POINT INSTR BUFFER 2584 0D10 36DB MVI M,0DBH ;IN INSTR 2585 0D12 23 INX H ;POINT NEXT 2586 0D13 77 MOV M,A ;MOVE ADDR 2587 0D14 23 INX H ;POINT NEXT 2588 0D15 36C9 MVI M,0C9H ;RET INSTR 2589 0D17 CD2022 CALL OUTA ;GO INPUT A BYTE 2590 0D1A 5F FDEC: MOV E,A ;MOVE BYTE TO LO D,E 2591 0D1B 1600 MVI D,0 ;ZERO HI D,E 2592 0D1D C3891C JMP BINFL ;GO CONVERT TO DEC & RET 2593 ; 2594 0D20 POS EQU $ 2595 ; 2596 ; 2597 ; RETURNS THE CURRENT POSITION OF THE TTY CURSOR 2598 ; 2599 ; 2600 0D20 3A7622 LDA COLUM ;GET POSITION 2601 0D23 C31A0D JMP FDEC ;CONVERT TO FLOAT AND RETURN 2602 ; 2603 0D26 CONCA EQU $ 2604 ; 2605 ; 2606 ; CONCATONATE TWO STRING TOGETHER 2607 ; COMBINE LENGTH <= 255 2608 ; 2609 0D26 D1 POP D ;ADJUST STACK 2610 0D27 112021 LXI D,STRIN ;POINT STRING BUFFER 26111 2612 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2613+ 21:37 05/19/2019 2614+ PAGE 46 2615 2616 2617 2618 0D2A 1A LDAX D ;GET CURRENT LENGTH 2619 0D2B 4F MOV C,A ;STORE IT 2620 0D2C 0600 MVI B,0 ;CLEAR HI 2621 0D2E EB XCHG ;FLIP FLOP 2622 0D2F 09 DAD B ;COMPUTE NEXT 2623 0D30 EB XCHG ;FLIP BACK 2624 0D31 86 ADD M ;COMPUTE COMBINE LENGTH 2625 0D32 46 MOV B,M ;SAVE LEN2 2626 0D33 D23C0D JNC CONC2 ;BRIF NO OVFLW 2627 0D36 3EFF MVI A,255 ;MAX LEN 2628 0D38 91 SUB C ;MINUS 1ST PART 2629 0D39 47 MOV B,A ;SAVE LEN 2630 0D3A 3EFF MVI A,255 ;UPDATED LENGTH 2631 0D3C 322021 CONC2: STA STRIN ;STORE IT 2632 0D3F 78 MOV A,B ;GET LEN TO MOVE 2633 0D40 B7 ORA A ;TEST IT 2634 0D41 CA4C0D JZ CONC4 ;BRIF NULL 2635 0D44 23 CONC3: INX H ;POINT NEXT 2636 0D45 13 INX D ;DITTO 2637 0D46 7E MOV A,M ;GET NEXT CHAR 2638 0D47 12 STAX D ;PUT IT 2639 0D48 05 DCR B ;DECR COUNT 2640 0D49 C2440D JNZ CONC3 ;LOOP 2641 0D4C E1 CONC4: POP H ;GET H,L 2642 0D4D 2B DCX H ;POINT BACK 2643 0D4E 3A2021 LDA STRIN ;GET LEN 2644 0D51 1F RAR ;DIVIDE BY TWO 2645 0D52 3C INR A ;PLUS ONE 2646 0D53 EB XCHG ;SAVE H,L 2647 0D54 2A6922 LHLD SPCTR ;GET CTR 2648 0D57 4F MOV C,A ;SAVE CTR 2649 0D58 0600 MVI B,0 ;ZERO HI BYTE 2650 0D5A 09 DAD B ;ADD LEN THIS STRING 2651 0D5B 226922 SHLD SPCTR ;SAVE CTR 2652 0D5E C1 POP B 2653 0D5F 210000 LXI H,0 ;GET ADDR ZERO 2654 0D62 E5 CONC5: PUSH H ;2 BYTE WORD 2655 0D63 3D DCR A ;DECR CTR 2656 0D64 C2620D JNZ CONC5 ;CONTINUE 2657 0D67 39 DAD SP ;GET ADDRESS IN H,L 2658 0D68 EB XCHG ;PUT STACK PTR IN D,E 2659 0D69 72 MOV M,D ;MOVE HI ADDR 2660 0D6A 23 INX H ;POINT NEXT 2661 0D6B 73 MOV M,E ;MOVE LO ADDR 2662 0D6C 23 INX H ;POINT NEXT 2663 0D6D 36E7 MVI M,0E7H ;TYPE=STRING 2664 0D6F E5 PUSH H ;SAVE H,L 2665 0D70 212021 LXI H,STRIN ;GET TEMP STR 2666 0D73 7E MOV A,M ;GET LENGTH 2667 0D74 3C INR A ;PLUS ONE 2668 0D75 4F MOV C,A ;SAVE IT 26691 2670 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2671+ 21:37 05/19/2019 2672+ PAGE 47 2673 2674 2675 2676 0D76 7E CONC6: MOV A,M ;GET A BYTE 2677 0D77 12 STAX D ;PUT IT DOWN 2678 0D78 13 INX D ;POINT NEXT 2679 0D79 23 INX H ;DITTO 2680 0D7A 0D DCR C ;SUBT CTR 2681 0D7B C2760D JNZ CONC6 ;LOOP 2682 0D7E E1 POP H ;RESTORE H,L 2683 0D7F E7 RST 4 ;ADJUST H,L 2684 0D80 F9 DB -7 AND 0FFH 2685 0D81 3E04 MVI A,4 ;DELETE 4 BYTES 2686 0D83 CDE21A CALL SQUIS ;GO COMPRESS 2687 0D86 C3BA11 JMP EVAL ;CONTINUE EVALUATION 2688 ; 2689 0D89 LENFN EQU $ 2690 ; 2691 ; X=LEN(A$) 2692 ; 2693 ; RETURN THE LENGTH OF THE STRING 2694 ; 2695 0D89 3A2021 LDA STRIN ;GET LEN IN ACC 2696 0D8C C31A0D JMP FDEC ;GO CONVERT TO DECIMAL & RETURN 2697 ; 2698 0D8F CHRFN EQU $ 2699 ; 2700 ; A$=CHR$(X) 2701 ; 2702 ; RETURNS A ONE CHAR STRING HAVING THE ASCII VALUE - X 2703 ; 2704 0D8F CD661C CALL FBIN ;CONVERT FACC TO BINARY 2705 0D92 212021 LXI H,STRIN ;POINT OUT AREA 2706 0D95 3601 MVI M,1 ;LEN=1 2707 0D97 23 INX H ;POINT NEXT 2708 0D98 77 MOV M,A ;STORE THE CHAR 2709 0D99 C9 RET ;RETURN 2710 ; 2711 0D9A ASCII EQU $ 2712 ; 2713 ; X=ASCII(A$) 2714 ; 2715 ; RETURNS THE ASCII VALUE OF THE FIRST CHAR IN STRING 2716 ; 2717 0D9A 212021 LXI H,STRIN ;POINT STRING 2718 0D9D 7E MOV A,M ;GET LENGTH 2719 0D9E B7 ORA A ;TEST IF > ZERO 2720 0D9F CA1A0D JZ FDEC ;BRIF ZERO & RETURN A ZERO 2721 0DA2 23 INX H ;POINT 1ST CHAR 2722 0DA3 7E MOV A,M ;LOAD IT 2723 0DA4 C31A0D JMP FDEC ;GO CONVERT TO DECIMAL & RETURN 2724 ; 2725 0DA7 NUMFN EQU $ 2726 ; 27271 2728 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2729+ 21:37 05/19/2019 2730+ PAGE 48 2731 2732 2733 2734 ; A$=NUM$(X) 2735 ; 2736 ; RETURNS A STRING REPRESENTING X AS IT WOULD HAVE 2737 ; BEEN PRINTED (INCLUDING TRAILING SPACE) 2738 ; 2739 0DA7 212021 LXI H,STRIN ;POINT STRING AREA 2740 0DAA 3600 MVI M,0 ;INIT COUNT 2741 0DAC 23 INX H ;SKIP TO 1ST POSITION 2742 0DAD CDF014 CALL FOUT ;GO CONVERT TO EXTRN DEC 2743 0DB0 AF XRA A ;GET A ZERO 2744 0DB1 47 MOV B,A ;INIT CTR 2745 0DB2 2B NUM1: DCX H ;POINT PRIOR 2746 0DB3 04 INR B ;COUNT IT 2747 0DB4 BE CMP M ;TEST IF ZERO 2748 0DB5 C2B20D JNZ NUM1 ;LOOP TILL AT START 2749 0DB8 70 MOV M,B ;SET LEN CODE 2750 0DB9 C9 RET ;THEN RETURN 2751 ; 2752 0DBA VAL EQU $ 2753 ; 2754 ; X = VAL(A$) 2755 ; 2756 ; RETURNS THE VALUE OF THE STRING OF NUMERIC CHARACTERS 2757 ; 2758 0DBA 212021 LXI H,STRIN ;POINT STRING AREA 2759 0DBD 7E MOV A,M ;GET LEN 2760 0DBE B7 ORA A ;TEST FOR NULL STRING 2761 0DBF 47 MOV B,A ;SAVE LEN 2762 0DC0 CA1A0D JZ FDEC ;BRIF IS (RETURNS A 0.00) 2763 0DC3 112021 LXI D,STRIN ;POINT BUFFER 2764 0DC6 23 VAL1: INX H ;POINT NEXT 2765 0DC7 7E MOV A,M ;GET A CHAR 2766 0DC8 FE20 CPI ' ' ;TEST IF SPACE 2767 0DCA CACF0D JZ VAL2 ;BRIF IS 2768 0DCD 12 STAX D ;PUT THE CHAR 2769 0DCE 13 INX D ;INCR ADDR 2770 0DCF 05 VAL2: DCR B ;DECR CTR 2771 0DD0 C2C60D JNZ VAL1 ;LOOP 2772 0DD3 AF XRA A ;GET A ZERO 2773 0DD4 12 STAX D ;PUT IN BUFF 2774 0DD5 212021 LXI H,STRIN ;POINT START OF BUFFER 2775 0DD8 CD2E14 CALL FIN ;GO CONVERT 2776 0DDB 7E MOV A,M ;GET NON-NUMERIC 2777 0DDC B7 ORA A ;TEST IT 2778 0DDD C21F1C JNZ CVERR ;BRIF ERROR 2779 0DE0 C9 RET ;ELSE, RETURN 2780 ; 2781 0DE1 SPACE EQU $ 2782 ; 2783 ; A$=SPACE$(X) 2784 ; 27851 2786 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2787+ 21:37 05/19/2019 2788+ PAGE 49 2789 2790 2791 2792 ; CREATES A STRING FO SPACES LENGTH = X 2793 ; 2794 0DE1 CD661C CALL FBIN ;GET BINARY LENGTH 2795 0DE4 212021 LXI H,STRIN ;POINT TEMP STRING 2796 0DE7 77 MOV M,A ;PUT LEN 2797 0DE8 B7 ORA A ;TEST IT 2798 0DE9 C8 SPAC1: RZ ;RETURN IF ZERO 2799 0DEA 23 INX H ;ELSE, POINT NEXT 2800 0DEB 3620 MVI M,' ' ;MOVE 1 SPACE 2801 0DED 3D DCR A ;DECR CTR 2802 0DEE C3E90D JMP SPAC1 ;LOOP 2803 ; 2804 0DF1 STRFN EQU $ 2805 ; 2806 ; A$=STRING$(X,Y) 2807 ; 2808 ; CREATES STRING OF LNGTH X CONTAINING REPETITION OF CHR$(Y) 2809 ; 2810 0DF1 CD661C CALL FBIN ;GET BINARY LENGTH 2811 0DF4 322021 STA STRIN ;PUT TO STRING 2812 0DF7 CD831C CALL ARGNU ;GET NEXT ARGUMENT 2813 0DFA 212021 LXI H,STRIN ;POINT STRING 2814 0DFD 46 MOV B,M ;GET COUNT 2815 0DFE 23 STR11: INX H ;POINT NEXT 2816 0DFF 77 MOV M,A ;STORE THE CHAR 2817 0E00 05 DCR B ;DECR CTR 2818 0E01 C2FE0D JNZ STR11 ;LOOP 2819 0E04 C9 RET ;RETURN 2820 ; 2821 0E05 LEFT EQU $ 2822 ; 2823 ; B$=LEFT$(A$,X) 2824 ; 2825 ; SUBSTRING FROM THE LEFTMOST X CHARACTERS OF A$ 2826 ; 2827 0E05 CD831C CALL ARGNU ;GET 2ND ARGUMENT 2828 0E08 4F MOV C,A ;SAVE LEN 2829 0E09 0601 MVI B,1 ;INIT START 2830 0E0B C3210E JMP MID0 ;CONTINUE 2831 ; 2832 0E0E RIGHT EQU $ 2833 ; 2834 ; B$=RIGHT$(A$,X) 2835 ; 2836 ; SUBSTRING STARTING AT POSITION X TO END OF STRING 2837 ; 2838 0E0E CD831C CALL ARGNU ;GET 2ND ARGUMENT 2839 0E11 47 MOV B,A ;SAVE START 2840 0E12 0EFF MVI C,255 ;MAX LEN 2841 0E14 C3210E JMP MID0 ;CONTINUE 2842 ; 28431 2844 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2845+ 21:37 05/19/2019 2846+ PAGE 50 2847 2848 2849 2850 0E17 MIDFN EQU $ 2851 ; 2852 ; B$=MID$(A$,X,Y) 2853 ; 2854 ; SUBSTRING OF THE STRING A$ STARTING WITH CHARACTER @ X 2855 ; AND Y CHARACTERS LONG 2856 ; 2857 0E17 CD831C CALL ARGNU ;LOAD X 2858 0E1A 47 MOV B,A ;SAVE START 2859 0E1B C5 PUSH B ;PUT ON STACK 2860 0E1C CD831C CALL ARGNU ;GET 3RD ARG 2861 0E1F C1 POP B ;RETREIVE 2862 0E20 4F MOV C,A ;SAVE LEN 2863 0E21 78 MID0: MOV A,B ;LOAD START 2864 0E22 212021 LXI H,STRIN ;POINT STRING 2865 0E25 BE CMP M ;TEST IF X>L 2866 0E26 DA2F0E JC MID1 ;BRIF X>L 2867 0E29 CA2F0E JZ MID1 ;OR EQUAL 2868 0E2C 3600 MVI M,0 ;ELSE, RESULT IS NULL 2869 0E2E C9 RET ;RETURN 2870 0E2F 81 MID1: ADD C ;COMPUTE END POSITION 2871 0E30 DA3C0E JC MID2 ;BRIF OVERFLOW 2872 0E33 DE01 SBI 1 ;COMPUTE X+Y-1 2873 0E35 DA3C0E JC MID2 ;BRIF OVERFLOW 2874 0E38 BE CMP M ;COMPARE TO EXISTING LEN 2875 0E39 DA400E JC MID3 ;BRIF X+Y-1<LEN(A$) 2876 0E3C 7E MID2: MOV A,M ;ELSE GET ORIG LEN 2877 0E3D 90 SUB B ;MINUS X 2878 0E3E 3C INR A ;PLUS ONE 2879 0E3F 4F MOV C,A ;SAVE (REPLACE Y) 2880 0E40 71 MID3: MOV M,C ;PUT NEW LEN 2881 0E41 58 MOV E,B ;PUT START IN LO 2882 0E42 1600 MVI D,0 ;ZERO IN HI 2883 0E44 19 DAD D ;COMPUTE START 2884 0E45 112021 LXI D,STRIN ;GET BEGIN 2885 0E48 7E MID4: MOV A,M ;GET A CHAR 2886 0E49 13 INX D ;POINT NEXT 2887 0E4A 23 INX H ;DITTO 2888 0E4B 12 STAX D ;PUT DOWN 2889 0E4C 0D DCR C ;DECR CTR 2890 0E4D C2480E JNZ MID4 ;LOOP 2891 0E50 C9 RET ;THEN RETURN 2892 ; 2893 0E51 INSTR EQU $ 2894 ; 2895 ; X = INSTR(Y,A$,B$) 2896 ; 2897 ; SEARCH FOR SUBSTRING B$ IN STRING A$ STARTING AT POS Y. 2898 ; RETURN 0 IF B$ IS NOT IN A$ 2899 ; RETURN 1 IF B$ IS NULL 2900 ; ELSE RETURN THE CHARACTER POSITION 29011 2902 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2903+ 21:37 05/19/2019 2904+ PAGE 51 2905 2906 2907 2908 ; 2909 0E51 CD831C CALL ARGNU ;GET A$ 2910 0E54 212021 LXI H,STRIN ;POINT A$ 2911 0E57 B7 ORA A ;TEST Y 2912 0E58 C2600E JNZ INST2 ;BRIF Y NOT ZERO 2913 0E5B 3600 INST1: MVI M,0 ;ELSE A$ IS NULL 2914 0E5D C3670E JMP INST3 ;GO AROUND 2915 0E60 BE INST2: CMP M ;TEST Y TO LEN(A$) 2916 0E61 CA670E JZ INST3 ;BRIF EQUAL 2917 0E64 D25B0E JNC INST1 ;BRIF Y > LEN(A$) 2918 0E67 4F INST3: MOV C,A ;SAVE Y 2919 0E68 0600 MVI B,0 ;ZERO HI INCR 2920 0E6A 7E MOV A,M ;GET LEN(A$) 2921 0E6B 91 SUB C ;MINUS Y 2922 0E6C 3C INR A ;PLUS ONE 2923 0E6D 09 DAD B ;COMPUTE START ADDR 2924 0E6E 47 MOV B,A ;# CHARS REMAIN IN A$ 2925 0E6F E5 PUSH H ;SAVE ADDR 2926 0E70 2A5222 LHLD ADDR1 ;GET ADDR OF ARG 2927 0E73 23 INX H ;POINT NEXT 2928 0E74 56 MOV D,M ;GET HI ADDR 2929 0E75 23 INX H ;POINT NEXT 2930 0E76 5E MOV E,M ;GET LO ADDR 2931 0E77 23 INX H ;POINT NEXT 2932 0E78 225222 SHLD ADDR1 ;UPDATED PTR 2933 0E7B E1 POP H ;RESTORE ADDR 2934 0E7C 1A LDAX D ;GET LEN(B$) 2935 0E7D B7 ORA A ;TEST IF NULL 2936 0E7E C2870E JNZ INST6 ;BRIF NOT 2937 0E81 0E01 MVI C,1 ;SET POSIT = 1 2938 0E83 79 INST5: MOV A,C ;GET POSIT 2939 0E84 C31A0D JMP FDEC ;CONVERT TO DECIMAL & RETURN 2940 0E87 EB INST6: XCHG ;FLIP/FLOP 2941 0E88 78 MOV A,B ;GET LEN OF A$ 2942 0E89 BE CMP M ;COMPARE TO LEN B$ 2943 0E8A DAAC0E JC INSTA ;BRIF LEN(B$)< LEN(REM A$) 2944 0E8D C5 PUSH B ;SAVE CTR, POSIT 2945 0E8E D5 PUSH D ;SAVE ADDR A$ 2946 0E8F E5 PUSH H ;SAVE ADDR B$ 2947 0E90 4E MOV C,M ;GET LEN B$ 2948 0E91 EB XCHG ;FLIP/FLOP 2949 0E92 13 INST8: INX D ;POINT NEXT B$ 2950 0E93 1A LDAX D ;GET B$ CHAR 2951 0E94 BE CMP M ;COMPARE A$ CHAR 2952 0E95 C2A30E JNZ INST9 ;BRIF NOT EQUAL 2953 0E98 23 INX H ;POINT NEXT A$ 2954 0E99 0D DCR C ;DECR CTR (LEN(B$)) 2955 0E9A C2920E JNZ INST8 ;LOOP 2956 0E9D E1 POP H ;DUMMY POP 2957 0E9E E1 POP H ;GET DUMMY STACK 2958 0E9F C1 POP B ;GET POSITION 29591 2960 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 2961+ 21:37 05/19/2019 2962+ PAGE 52 2963 2964 2965 2966 0EA0 C3830E JMP INST5 ;WE FOUND A MATCH 2967 0EA3 D1 INST9: POP D ;GET PTR B$ 2968 0EA4 E1 POP H ;GET PTR A$ 2969 0EA5 C1 POP B ;GET CTRS, POSIT 2970 0EA6 0C INR C ;UP PTR NUM 2971 0EA7 23 INX H ;POINT NEXT A$ 2972 0EA8 05 DCR B ;DECR B 2973 0EA9 C2870E JNZ INST6 ;LOOP 2974 0EAC 0E00 INSTA: MVI C,0 ;ELSE B$ NOT IN A$ 2975 0EAE C3830E JMP INST5 ;RETURN 2976 ; 2977 0EB1 FN EQU $ 2978 ; 2979 ; STMT: DEF FNX(A)=EXPR 2980 ; 2981 ; NOTE: ENTRY FROM EXPR ANALYZER (RECURSIVE) 2982 ; 2983 0EB1 C5 PUSH B ;SAVE B,C 2984 0EB2 D5 PUSH D ;SAVE D,E 2985 0EB3 E5 PUSH H ;SAVE H,L 2986 0EB4 EB XCHG ;PUT H,L TO D,E 2987 0EB5 2A5622 LHLD ADDR3 ;GET ADDR 2988 0EB8 E5 PUSH H ;SAVE IT 2989 0EB9 EB XCHG ;PUT D,E BACK TO H,L 2990 0EBA 225622 SHLD ADDR3 ;UPDATE PTR 2991 0EBD 2A6922 LHLD SPCTR ;GET SP COUNT 2992 0EC0 E5 PUSH H ;SAVE IT 2993 0EC1 3A6822 LDA PARCT ;GET PAREN COUNT 2994 0EC4 47 MOV B,A ;PUT TO B 2995 0EC5 3A8822 LDA FNMOD ;GET FN MODE 2996 0EC8 4F MOV C,A ;PUT TO C 2997 0EC9 C5 PUSH B ;SAVE B,C 2998 0ECA 3A7220 LDA DIMSW ;GET DIM SW 2999 0ECD F5 PUSH PSW ;SAVE IT 3000 0ECE AF XRA A ;CLEAR A 3001 0ECF 327220 STA DIMSW ;RESET DIM SW 3002 0ED2 2A6C22 LHLD FNARG ;GET OLD ARG NAME 3003 0ED5 E5 PUSH H ;SAVE 3004 0ED6 2A6E22 LHLD FNARG+2 ;GET OLD ARG ADDRESS 3005 0ED9 E5 PUSH H ;SAVE 3006 0EDA 2A9322 LHLD PROGE ;GET END OF PROGRAM 3007 0EDD E5 PUSH H ;SAVE IT 3008 0EDE 2A5022 LHLD EXPRS ;GET END OF EXPR 3009 0EE1 E5 PUSH H ;SAVE IT 3010 0EE2 229322 SHLD PROGE ;SAVE NEW 'END' OF PROGRAM 3011 0EE5 3E01 MVI A,1 ;GET ON SETTING 3012 0EE7 328822 STA FNMOD ;SET IN FUNCTION 3013 0EEA 2A5622 LHLD ADDR3 ;POINT TO EXPR 3014 0EED 4E MOV C,M ;GET FN CHAR 3015 0EEE 2B DCX H ;POINT BACK 3016 0EEF 46 MOV B,M ;GET HI NAME 30171 3018 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3019+ 21:37 05/19/2019 3020+ PAGE 53 3021 3022 3023 3024 0EF0 219622 LXI H,BEGPR ;POINT START OF PROGRAM 3025 0EF3 7E FN2: MOV A,M ;LOAD LEN TO NEXT STMT 3026 0EF4 B7 ORA A ;TEST IF AT END 3027 0EF5 CA0F1C JZ SNERR ;BRIF FN NOT FOUND 3028 0EF8 E5 PUSH H ;SAVE PTR 3029 0EF9 E7 RST 4 ;ADJUST H,L 3030 0EFA 03 DB 3 3031 0EFB 111E1F LXI D,DEFLI ;LITERAL 3032 0EFE D7 RST 2 ;GO COMPARE 3033 0EFF C2110F JNZ FN3 ;BRIF NOT EQUAL 3034 0F02 C5 PUSH B ;SAVE TEST NAME 3035 0F03 CDC91B CALL VAR ;GO GET NAME 3036 0F06 C1 POP B ;RESTORE NAME 3037 0F07 7A MOV A,D ;GET HI NAME 3038 0F08 B8 CMP B ;COMPARE 3039 0F09 C2110F JNZ FN3 ;BRIF NOT EQUAL 3040 0F0C 7B MOV A,E ;GET LO 3041 0F0D B9 CMP C ;COMPARE 3042 0F0E CA190F JZ FN4 ;BRIF EQUAL 3043 0F11 E1 FN3: POP H ;GET OLD PTR 3044 0F12 5E MOV E,M ;GET LO LEN 3045 0F13 1600 MVI D,0 ;ZERO HI LEN 3046 0F15 19 DAD D ;POINT NEXT STMT 3047 0F16 C3F30E JMP FN2 ;LOOP 3048 0F19 D1 FN4: POP D ;ADJUST STACK 3049 0F1A CF RST 1 ;SKIP BLANKS 3050 0F1B FE28 CPI '(' ;TEST IF OPEN PAREN 3051 0F1D C20F1C JNZ SNERR ;BRIF NOT 3052 0F20 23 INX H ;SKIP IT 3053 0F21 CDC91B CALL VAR ;GO GET VAR NAME 3054 0F24 E5 PUSH H ;SAVE HL ADDR 3055 0F25 216C22 LXI H,FNARG ;POINT DUMMY ARG TBL 3056 0F28 72 MOV M,D ;STORE LETTER 3057 0F29 23 INX H ;POINT NEXT 3058 0F2A 73 MOV M,E ;STORE DIGIT 3059 0F2B 23 INX H ;POINT NEXT 3060 0F2C EB XCHG ;PUT H,L TO D,E 3061 0F2D 2A5622 LHLD ADDR3 ;POINT TO EXPR STACK 3062 0F30 23 INX H ;POINT CODE 3063 0F31 23 INX H ;POINT HI ADR 3064 0F32 7E MOV A,M ;GET HI 3065 0F33 12 STAX D ;PUT TO TABLE 3066 0F34 13 INX D ;POINT NEXT 3067 0F35 23 INX H ;DITTO 3068 0F36 7E MOV A,M ;GET LO ADDR 3069 0F37 12 STAX D ;PUT TO TABLE 3070 0F38 E1 POP H ;RESTORE PTR TO STMT 3071 0F39 CF RST 1 ;SKIP BLANKS 3072 0F3A FE29 CPI ')' ;TEST IF CLOSE PAREN 3073 0F3C C20F1C JNZ SNERR ;BRIF NOT 3074 0F3F 23 INX H ;SKIP IT 30751 3076 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3077+ 21:37 05/19/2019 3078+ PAGE 54 3079 3080 3081 3082 0F40 CF RST 1 ;SKIP BLANKS 3083 0F41 FE3D CPI '=' ;TEST IF EQUAL SIGN 3084 0F43 C20F1C JNZ SNERR ;BRIF NOT 3085 0F46 23 INX H ;SKIP IT 3086 0F47 CD800F CALL EXPR ;GO EVAL FUNCTION 3087 0F4A CD941A CALL EOL ;MUST BE END OF LINE 3088 0F4D E1 POP H ;GET H,L 3089 0F4E 225022 SHLD EXPRS ;RESTORE START OF EXPR 3090 0F51 E1 POP H ;GET H,L 3091 0F52 229322 SHLD PROGE ;RESTORE 'END' OF PROGRAM 3092 0F55 E1 POP H ;GET H,L 3093 0F56 226E22 SHLD FNARG+2 ;STORE ADDR 3094 0F59 E1 POP H ;GET H,L 3095 0F5A 226C22 SHLD FNARG ;STORE DUMMY ARG 3096 0F5D F1 POP PSW ;GET A,STATUS 3097 0F5E 327220 STA DIMSW ;RESTORE DIM SW 3098 0F61 C1 POP B ;GET B,C 3099 0F62 79 MOV A,C ;LOAD C 3100 0F63 328822 STA FNMOD ;RESTORE MOE 3101 0F66 78 MOV A,B ;LOAD B 3102 0F67 326822 STA PARCT ;RESTORE PAREN COUNT 3103 0F6A E1 POP H ;GET H,L 3104 0F6B 226922 SHLD SPCTR ;RESTORE SP COUNTER 3105 0F6E E1 POP H ;GET H,L 3106 0F6F 225622 SHLD ADDR3 ;RESTORE ADDR OF EVAL 3107 0F72 E1 POP H ;GET H,L 3108 0F73 D1 POP D ;GET D,E 3109 0F74 2B DCX H ;POINT 2ND BYTE FOLLOWING OP 3110 0F75 225422 SHLD ADDR2 ;SAVE IT 3111 0F78 E7 RST 4 ;POINT TO ARG TYPE 3112 0F79 05 DB 5 3113 0F7A 225222 SHLD ADDR1 ;SAVE ADDR 3114 0F7D C30712 JMP EV3 ;GO WRAPUP 3115 ;PAGE 3116 ; 3117 0F80 EXPR EQU $ 3118 ; 3119 ; 3120 ; EVALUATE EXPRESSION ROUTINE 3121 ; LEAVE RESULT IN FACC 3122 ; RETURN WHEN EXPRESSION ENDS (TYPICALLY AT END OF LINE) 3123 ; 3124 ; 3125 0F80 AF XRA A ;CLEAR REG A 3126 0F81 326822 STA PARCT ;SET PAREN CTR 3127 0F84 EB XCHG ;SAVE H,L 3128 0F85 210000 LXI H,0 ;GET A ZERO 3129 0F88 226922 SHLD SPCTR ;INIT CTR 3130 0F8B 2A9322 LHLD PROGE ;POINT END OF PROGRAM AREA 3131 0F8E 23 INX H ;POINT ONE MORE 3132 0F8F 3600 MVI M,0 ;INIT START OF STACK 31331 3134 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3135+ 21:37 05/19/2019 3136+ PAGE 55 3137 3138 3139 3140 0F91 225022 SHLD EXPRS ;SAVE IT 3141 0F94 EB XCHG ;RESTORE H,L 3142 ; 3143 0F95 LOOKD EQU $ ;LOOK FOR CON, VAR, OR FUNCTION 3144 0F95 CF RST 1 ;SKIP TO NON-BLANK 3145 0F96 CD2A1B CALL NUMER ;GO TEST IF NUMERIC 3146 0F99 C2AF0F JNZ LDALP ;BRIF NOT 3147 0F9C CD2E14 LDNUM: CALL FIN ;GO CONVERT NUMERIC (PUT TO FACC) 3148 0F9F 44 LDF: MOV B,H ;COPY H,L TO B,C 3149 0FA0 4D MOV C,L ;SAME 3150 0FA1 2A5022 LHLD EXPRS ;GET ADDR OF EXPR AREA 3151 0FA4 CD001B CALL GTEMP ;GO STORE THE FACC IN TEMP AREA 3152 0FA7 225022 SHLD EXPRS ;SAVE UPDATED ADDRESS 3153 0FAA 60 MOV H,B ;RESTORE H 3154 0FAB 69 MOV L,C ;RESTORE L 3155 0FAC C31D11 JMP LOOKO ;GO GET AN OPERATION CODE 3156 0FAF FE2E LDALP: CPI '.' ;SEE IF LEADING DECIMAL POINT 3157 0FB1 CA9C0F JZ LDNUM ;BRIF IS 3158 0FB4 CD211B CALL ALPHA ;GO SEE IF ALPHA 3159 0FB7 C29110 JNZ LDDTN ;BRIF NOT 3160 0FBA 46 MOV B,M ;SAVE 1ST CHAR 3161 0FBB 23 INX H ;POINT NEXT 3162 0FBC 0E20 MVI C,' ' ;DEFAULT FOR 1 CHAR VAR 3163 0FBE CD2A1B CALL NUMER ;GO SEE IF 2ND IS NUMERIC 3164 0FC1 C2F40F JNZ LDFN ;BRIF NOT 3165 0FC4 23 INX H ;POINT NEXT 3166 0FC5 4F MOV C,A ;SAVE THE CHAR 3167 0FC6 CF LDV1: RST 1 ;GET NEXT CHAR 3168 0FC7 FE24 CPI '$' ;TEST IF STRING 3169 0FC9 F5 PUSH PSW ;SAVE STATUS 3170 0FCA C2D30F JNZ LDV2 ;BRIF NOT 3171 0FCD 79 MOV A,C ;GET LOW CHAR 3172 0FCE F680 ORI 80H ;SET STRING 3173 0FD0 4F MOV C,A ;SAVE IT 3174 0FD1 23 INX H ;SKIP $ 3175 0FD2 CF RST 1 ;SKIP SPACES 3176 0FD3 FE28 LDV2: CPI '(' ;TEST IF PAREN 3177 0FD5 CAD713 JZ LDV2A ;BRIF IS 3178 0FD8 E5 PUSH H ;SAVE H,L 3179 0FD9 50 MOV D,B ;COPY B,C 3180 0FDA 59 MOV E,C ;TO D,E 3181 0FDB CD341B CALL SEARC ;GO GET VAR ADDR IN D,E 3182 0FDE 2A5022 LDV: LHLD EXPRS ;GET EXPR ADDR 3183 0FE1 CD191B CALL SADR ;GO STORE ADDRESS 3184 0FE4 225022 SHLD EXPRS ;SAVE ADDRESS 3185 0FE7 EB XCHG ;H,L TO D,E 3186 0FE8 E1 POP H ;GET OLD H,L 3187 0FE9 F1 POP PSW ;GET STATUS 3188 0FEA C21D11 JNZ LOOKO ;BRIF NOT STRING 3189 0FED EB XCHG ;GET OLD H,L 3190 0FEE 36E7 MVI M,0E7H ;MARK AS STRING ADDRESS 31911 3192 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3193+ 21:37 05/19/2019 3194+ PAGE 56 3195 3196 3197 3198 0FF0 EB XCHG ;RESTORE H,L 3199 0FF1 C31D11 JMP LOOKO ;GO LOOK FOR OPCODE 3200 0FF4 CD211B LDFN: CALL ALPHA ;GO SEE IF FUNCTION 3201 0FF7 C2C60F JNZ LDV1 ;BRIF IT'S NOT 3202 0FFA 2B LDFN1: DCX H ;POINT BACK TO 1ST 3203 0FFB 7E MOV A,M ;GET THAT CHAR 3204 0FFC FE20 CPI ' ' ;TEST IF SPACE 3205 0FFE CAFA0F JZ LDFN1 ;LOOP IF TRUE 3206 1001 E5 PUSH H ;SAVE H,L 3207 1002 11B41C LXI D,RNDLI ;POINT LITERAL 3208 1005 D7 RST 2 ;GO COMPARE 3209 1006 CA6310 JZ LDRND ;BRIF FND 3210 1009 E1 POP H ;GET H,L 3211 100A E5 PUSH H ;RESAVE 3212 100B 11211F LXI D,FNLIT ;POINT LITERAL 3213 100E D7 RST 2 ;GO SEE IF FN X 3214 100F CA3E10 JZ FNL ;BRIF IS 3215 1012 E1 POP H ;GET H,L 3216 1013 E5 PUSH H ;RESAVE 3217 1014 11971D LXI D,PILIT ;POINT LIT 3218 1017 D7 RST 2 ;GO COMPARE 3219 1018 CA7510 JZ LDPI ;BRIF PI 3220 101B E1 FUNC0: POP H ;GET H,L 3221 101C 11981C LXI D,FUNCT ;POINT FUNCTION TABLE 3222 101F E5 PUSH H ;SAVE POINTER 3223 1020 CD861F CALL SEEK1 ;GO SEARCH FUNCTION TABLE 3224 1023 CA3610 JZ FUNC4 ;BRIF FUNCTION NOT FOUND 3225 1026 1A LDAX D ;GET A BYTE LOW 3226 1027 4F MOV C,A ;SAVE IT 3227 1028 13 INX D ;POINT NEXT 3228 1029 1A LDAX D ;GET HI BYTE 3229 102A 47 MOV B,A ;SAVE IT (B,C = ADDR OF FUNC) 3230 102B CF RST 1 ;SKIP BLANKS 3231 102C FE28 CPI '(' ;TEST FOR OPEN PAREN 3232 102E C20F1C JNZ SNERR ;BRIF MISSING PAREN 3233 1031 13 INX D ;POINT TYPE CODE 3234 1032 1A LDAX D ;LOAD IT 3235 1033 C37F10 JMP LDFNC ;CONTINUE 3236 1036 E1 FUNC4: POP H ;GET H,L 3237 1037 46 MOV B,M ;GET 1ST CHAR 3238 1038 0E20 MVI C,' ' ;SPACE 2ND CHAR 3239 103A 23 INX H ;POINT TO NEXT 3240 103B C3C60F JMP LDV1 ;BRIF VARIABLE 3241 103E D1 FNL: POP D ;DUMMY RESET STACK POINTER 3242 103F CDC91B CALL VAR ;GO GET FN NAME 3243 1042 42 MOV B,D ;COPY TO B,C 3244 1043 4B MOV C,E ;SAME 3245 1044 EB XCHG ;SAVE H,L 3246 1045 2A5022 LHLD EXPRS ;POINT EXPR STACK 3247 1048 23 INX H ;POINT NEXT 3248 1049 70 MOV M,B ;MOVE THE LETTER 32491 3250 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3251+ 21:37 05/19/2019 3252+ PAGE 57 3253 3254 3255 3256 104A 23 INX H ;POINT NEXT 3257 104B 71 MOV M,C ;MOVE DIGIT ($??) 3258 104C 23 INX H ;POINT NEXT 3259 104D 36AF MVI M,0AFH ;MOVE CODE 3260 104F 79 MOV A,C ;GET LO NAME 3261 1050 B7 ORA A ;TEST IT 3262 1051 F25610 JP FNL3 ;BRIF NOT STRING 3263 1054 36CF MVI M,0CFH ;MOVE CODE 3264 1056 225022 FNL3: SHLD EXPRS ;SAVE POINTER 3265 1059 EB XCHG ;GET H,L 3266 105A CF RST 1 ;GET NEXT CHAR 3267 105B FE28 CPI '(' ;TEST IF OPEN PAREN 3268 105D C20F1C JNZ SNERR ;BRIF NOT 3269 1060 C3950F JMP LOOKD ;CONTINUE 3270 1063 FE28 LDRND: CPI '(' ;TEST IF RND(X) 3271 1065 CA1B10 JZ FUNC0 ;BRIF IS 3272 1068 E5 PUSH H ;ELSE, SAVE H,L 3273 1069 21EA1D LXI H,ONE ;USE RANGE (0,1) 3274 106C EF RST 5 ;LOAD FACC 3275 106D CD840C CALL RND ;GO GET RANDOM NUMBER 3276 1070 E1 POP H ;RESTORE H,L 3277 1071 D1 POP D ;RESTORE STACK POINTER 3278 1072 C39F0F JMP LDF ;ACT AS IF CONSTANT 3279 1075 3C LDPI: INR A ;SET NON ZERO 3280 1076 D1 POP D ;DUMMY STACK POP 3281 1077 F5 PUSH PSW ;SAVE STATUS 3282 1078 E5 PUSH H ;SAVE H,L 3283 1079 11A21D LXI D,PI ;GET ADDRESS OF 3.1415 3284 107C C3DE0F JMP LDV ;GO ACT LIKE VARIABLE 3285 107F D1 LDFNC: POP D ;POP THE STACK 3286 1080 EB XCHG ;FLIP/FLOP 3287 1081 2A5022 LHLD EXPRS ;GET ADDR 3288 1084 23 INX H ;POINT NEXT 3289 1085 70 MOV M,B ;HIGH ADDR 3290 1086 23 INX H ;POINT NEXT 3291 1087 71 MOV M,C ;LOW ADDR 3292 1088 23 INX H ;POINT NEXT 3293 1089 77 MOV M,A ;CODE 3294 108A 225022 SHLD EXPRS ;SAVE ADDR 3295 108D EB XCHG ;RESTORE H,L 3296 108E C3950F JMP LOOKD ;NEXT MUST BE DATA TOO 3297 1091 FE2D LDDTN: CPI '-' ;TEST IF UNARY MINUS 3298 1093 C2A510 JNZ LDDTP ;BRIF NOT 3299 1096 EB XCHG ;SAVE H,L 3300 1097 2A5022 LHLD EXPRS ;GET EXPR END 3301 109A 23 INX H ;POINT ONE MORE 3302 109B 3661 MVI M,61H ;CODE FOR NEG 3303 109D 225022 SHLD EXPRS ;RESTORE PTR 3304 10A0 EB XCHG ;RESTORE H,L 3305 10A1 23 SKPP: INX H ;POINT PAST THIS BYTE 3306 10A2 C3950F JMP LOOKD ;NEXT MUST BE DATA 33071 3308 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3309+ 21:37 05/19/2019 3310+ PAGE 58 3311 3312 3313 3314 10A5 FE2B LDDTP: CPI '+' ;TEST IF UNARY PLUS 3315 10A7 CAA110 JZ SKPP ;IGNORE IF IS 3316 10AA FE28 CPI '(' ;ELSE, TEST IF OPEN PAREN 3317 10AC CA0B11 JZ CERCE ;BRIF IS 3318 10AF FE27 CPI 27H ;TEST IF LITERAL (SINGLE QUOTE) 3319 10B1 CAB910 JZ LITST ;BRIF IS 3320 10B4 FE22 CPI '"' ;TEST IF LITERAL 3321 10B6 C20F1C JNZ SNERR ;BRIF NOT CON, FUNCTION, OR VAR 3322 10B9 4F LITST: MOV C,A ;SAVE DELIMITER 3323 10BA 112021 LXI D,STRIN ;POINT BUFFER 3324 10BD 06FF MVI B,0FFH ;INIT CTR 3325 10BF 23 LIT1: INX H ;POINT NEXT 3326 10C0 7E MOV A,M ;LOAD NEXT 3327 10C1 13 INX D ;POINT NEXT 3328 10C2 12 STAX D ;STORE IT 3329 10C3 B7 ORA A ;TEST IF END 3330 10C4 CA0F1C JZ SNERR ;BRIF ERROR 3331 10C7 04 INR B ;COUNT IT 3332 10C8 B9 CMP C ;TEST IF END OF STRING 3333 10C9 C2BF10 JNZ LIT1 ;BRIF NOT 3334 10CC 23 INX H ;POINT NEXT 3335 10CD 112021 LXI D,STRIN ;POINT BEGIN 3336 10D0 78 MOV A,B ;GET COUNT 3337 10D1 12 STAX D ;PUT COUNT 3338 10D2 1F RAR ;DIVIDE BY TWO 3339 10D3 3C INR A ;PLUS ONE 3340 10D4 4F MOV C,A ;SAVE IT 3341 10D5 0600 MVI B,0 ;ZERO HIGH 3342 10D7 E5 PUSH H ;SAVE PTR 3343 10D8 2A6922 LHLD SPCTR ;GET CTR 3344 10DB 09 DAD B ;PLUS OLD 3345 10DC 226922 SHLD SPCTR ;UPDATE IT 3346 10DF D1 POP D ;GET OLD H,L 3347 10E0 210000 LXI H,0 ;GET A ZERO 3348 10E3 E5 LIT2: PUSH H ;GET 2 WORK BYTES 3349 10E4 0D DCR C ;SUB 1 FROM COUNT 3350 10E5 C2E310 JNZ LIT2 ;CONTINUE 3351 10E8 39 DAD SP ;GET ADDR OF STACK 3352 10E9 D5 PUSH D ;SAVE PTR TO STMT 3353 10EA EB XCHG ;SAVE H,L IN D,E 3354 10EB 2A5022 LHLD EXPRS ;GET START OF EXPR 3355 10EE 23 INX H ;PLUS ONE 3356 10EF 72 MOV M,D ;HI BYTE 3357 10F0 23 INX H ;POINT NEXT 3358 10F1 73 MOV M,E ;LO BYTE 3359 10F2 23 INX H ;POINT NEXT 3360 10F3 36E7 MVI M,0E7H ;TYPE CODE 3361 10F5 225022 SHLD EXPRS ;SAVE ADDR 3362 10F8 EB XCHG ;D,E BACK TO H,L 3363 10F9 112021 LXI D,STRIN ;POINT STRING AREA 3364 10FC 1A LDAX D ;GET COUNT 33651 3366 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3367+ 21:37 05/19/2019 3368+ PAGE 59 3369 3370 3371 3372 10FD 3C INR A ;ADD ONE TO COUNT 3373 10FE 47 MOV B,A ;SAVE CTR 3374 10FF 1A LIT3: LDAX D ;GET A BYTE 3375 1100 77 MOV M,A ;STORE IT 3376 1101 23 INX H ;POINT NEXT 3377 1102 13 INX D ;DITTO 3378 1103 05 DCR B ;DECR CTR 3379 1104 C2FF10 JNZ LIT3 ;LOOP 3380 1107 E1 POP H ;RESTORE H,L 3381 1108 C31D11 JMP LOOKO ;NEXT IS OP 3382 110B EB CERCE: XCHG ;SAVE H,L 3383 110C 216822 LXI H,PARCT ;POINT PAREN COUNT 3384 110F 34 INR M ;ADD 1 3385 1110 2A5022 LHLD EXPRS ;GET ADDR 3386 1113 23 INX H ;POINT NEXT 3387 1114 3605 MVI M,5 ;PUT CODE 3388 1116 225022 SHLD EXPRS ;SAVE ADDR 3389 1119 EB XCHG ;RESTORE H,L 3390 111A C3A110 JMP SKPP ;GO SKIP CHAR 3391 111D CF LOOKO: RST 1 ;SKIP BLANKS 3392 111E FE2B CPI '+' ;TEST IF PLUS 3393 1120 0621 MVI B,21H ;CODE 3394 1122 CA5811 JZ OP1 ;BRIF IS 3395 1125 FE2D CPI '-' ;TEST IF MINUS 3396 1127 0625 MVI B,25H 3397 1129 CA5811 JZ OP1 ;BRIF IS 3398 112C FE2F CPI '/' ;TEST IF DIVIDE 3399 112E 0645 MVI B,45H ;CODE 3400 1130 CA5811 JZ OP1 ;BRIF IS 3401 ; CPI ' ' ;TEST IF EXPON 3402 1133 FE5E CPI UPARR ;*UM* FIX FOR MACRO-80 3403 1135 0681 MVI B,81H ;CODE 3404 1137 CA5811 JZ OP1 ;BRIF IS 3405 113A FE29 CPI ')' ;TEST IF CLOSE PAREN 3406 113C CAAC11 JZ OP3 ;BRIF IS 3407 113F FE2C CPI ',' ;TEST IF COMMA 3408 1141 CA9711 JZ OP2 ;BRIF IS 3409 1144 FE2A CPI '*' ;TEST IF MULTIPLY 3410 1146 0641 MVI B,41H ;CODE 3411 1148 CA5811 JZ OP1 ;BRIF IS 3412 ; ELSE MUST BE END OF EXPRESSION 3413 114B 3A6822 ENDXP: LDA PARCT ;GET OPEN PAREN COUNT 3414 114E B7 ORA A ;TEST IT 3415 114F C20F1C JNZ SNERR ;BRIF # OF ('S NOT = # OF )'S 3416 1152 225622 SHLD ADDR3 ;SAVE ADDR OF STMT 3417 1155 C3BA11 JMP EVAL ;GO EVALUATE 3418 1158 E5 OP1: PUSH H ;SAVE PLACE IN ASCII EXPRESSION 3419 1159 110501 LXI D,0105H ;D=BYTE COUNT, E=CODE FOR "(" 3420 115C 2A5022 LHLD EXPRS ;POINT TO LAST BYTE 3421 115F 78 MOV A,B ;B&E3 -> C 3422 1160 E6E3 ANI 0E3H 34231 3424 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3425+ 21:37 05/19/2019 3426+ PAGE 60 3427 3428 3429 3430 1162 4F MOV C,A 3431 ; INSERT ( AND EVALUATE IF PRECEDENCE REDUCTION, 3432 ; ELSE INNSERT OP CODE 3433 1163 7E OPLP1: MOV A,M ;GET TYPE CODE FROM EXPRESSION 3434 1164 F5 PUSH PSW ;SAVE 3435 1165 E603 ANI 3 ;GET LENGTH 3436 1167 14 OPLP2: INR D ;BUMP BYTE COUNT 3437 1168 2B DCX H ;EXPRESSION POINTER 3438 1169 3D DCR A ;LOOP MOVES TO NEXT ELEMENT 3439 116A C26711 JNZ OPLP2 3440 116D F1 POP PSW ;RESTORE TYPE CODE 3441 116E E6E3 ANI 0E3H ;MASK FOR VARIABLE 3442 1170 FEE3 CPI 0E3H ;WE SKIP OVER VARIABLES 3443 1172 CA6311 JZ OPLP1 ;BR IF TYPE = E3 OR E7 3444 1175 B9 CMP C ;PRECEDENCE REDUCTION? 3445 1176 D28111 JNC INS ;IF NC, YES, INSERT 05 3446 1179 2A5022 LHLD EXPRS ;NO, INSERT OPCODE BEFORE VAR AT END 3447 117C E7 RST 4 ;SKIP OVER VARIABLE 3448 117D FD DB -3 AND 0FFH 3449 117E 1604 MVI D,4 ;BYTE COUNT 3450 1180 58 MOV E,B ;INSERT THIS OP CODE 3451 1181 43 INS: MOV B,E ;SAVE FOR BRANCH AFTER INSERTION 3452 1182 23 INS1: INX H ;BUMP POINTER 3453 1183 4E MOV C,M ;PICK UP BYTE 3454 1184 70 MOV M,B ;PUT DOWN REPLACEMENT 3455 1185 41 MOV B,C ;SAVE FOR NEXT LOOP 3456 1186 15 DCR D ;DONE? 3457 1187 C28211 JNZ INS1 ;IF NZ, NO 3458 118A 225022 SHLD EXPRS ;STORE POINTER 3459 118D E1 POP H ;RESTORE ASCII EXPRESSION POINTER 3460 118E 7B MOV A,E ;GET FLAG SAVED IN E 3461 118F FE05 CPI 5 ;STORED A "("? 3462 1191 C2A110 JNZ SKPP ;IF NZ, NO, PROCESS NEXT ELEMENT 3463 1194 C3B711 JMP OP4 ;YES, GO EVALUATE 3464 1197 3A6822 OP2: LDA PARCT ;GET OPEN PAREN COUNT 3465 119A B7 ORA A ;TEST IT 3466 119B CA4B11 JZ ENDXP ;BRIF END OF EXPR 3467 119E EB XCHG ;ELSE SAVE H,L 3468 119F 2A5022 LHLD EXPRS ;GET EXPR BEGIN 3469 11A2 23 INX H ;POINT NEXT 3470 11A3 3601 MVI M,1 ;MOVE A COMMA 3471 11A5 225022 SHLD EXPRS ;UPDATE POINTER 3472 11A8 EB XCHG ;FLIP BACK 3473 11A9 C3A110 JMP SKPP 3474 11AC 3A6822 OP3: LDA PARCT ;GET OPEN PAREN COUNT 3475 11AF 3D DCR A ;SUBTRACT ONE 3476 11B0 326822 STA PARCT ;SAVE IT 3477 11B3 FA0F1C JM SNERR ;BRIF TOO MANY )'S 3478 11B6 23 INX H ;POINT NEXT SOURCE 3479 11B7 225622 OP4: SHLD ADDR3 ;SAVE ADDR 3480 11BA 2A5022 EVAL: LHLD EXPRS ;GET END OF EXPR 34811 3482 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3483+ 21:37 05/19/2019 3484+ PAGE 61 3485 3486 3487 3488 11BD 010000 LXI B,0 ;INIT B,C TO ZERO 3489 11C0 04 EV1: INR B ;COUNT EACH BYTE 3490 11C1 7E MOV A,M ;GET CODE IN REG A 3491 11C2 2B DCX H ;POINT NEXT 3492 11C3 FEE3 CPI 0E3H ;TEST IF DATA 3493 11C5 C2D011 JNZ EV2 ;BRIF NOT DATA 3494 11C8 2B EV1A: DCX H ;POINT NEXT 3495 11C9 2B DCX H ;DITTO 3496 11CA 04 INR B ;BUMP CTR 3497 11CB 04 INR B ;BY TWO 3498 11CC 0C INR C ;COUNT THE TERM 3499 11CD C3C011 JMP EV1 ;LOOP 3500 11D0 FEAF EV2: CPI 0AFH ;TEST IF NUMERIC USER FN 3501 11D2 CAB10E JZ FN ;BRIF IS 3502 11D5 FECF CPI 0CFH ;TEST IF STRING USER FN 3503 11D7 CAB10E JZ FN ;BRIF IS 3504 11DA F5 PUSH PSW ;ELSE, SAVE STATUS 3505 11DB E6E3 ANI 0E3H ;MASK IT 3506 11DD FEA3 CPI 0A3H ;TEST IF NUMERIC FUNCTION 3507 11DF CAF011 JZ EV2A ;BRIF IS 3508 11E2 FEC3 CPI 0C3H ;TEST IF STRING FUNCTION 3509 11E4 CAF011 JZ EV2A ;BRIF IS 3510 11E7 F1 POP PSW ;RESTORE CODE 3511 11E8 FEE7 CPI 0E7H ;TEST IF STRING ADDR 3512 11EA CAC811 JZ EV1A ;BRIF IS 3513 11ED C37812 JMP EV5 ;BR AROUND 3514 11F0 23 EV2A: INX H ;RESET TO TYPE CODE 3515 11F1 225222 SHLD ADDR1 ;SAVE ADDR 3516 11F4 D1 POP D ;DUMMY POP 3517 11F5 C5 PUSH B ;SAVE CTRS 3518 11F6 2B DCX H ;POINT TO LOW JMP ADDR 3519 11F7 5E MOV E,M ;LOW BYTE 3520 11F8 2B DCX H ;POINT BACK 3521 11F9 56 MOV D,M ;HIGH BACK 3522 11FA 225422 SHLD ADDR2 ;SAVE LOCATION 3523 11FD 210712 LXI H,EV3 ;GET RETURN ADDRESS 3524 1200 E5 PUSH H ;SAVE ON STACK 3525 1201 D5 PUSH D ;SAVE ADDRESS 3526 1202 CD741C CALL ARG ;GO GET 1ST ARG 3527 1205 E1 POP H ;GET H,L ADDRESS 3528 1206 E9 PCHL ;GO EXECUTE THE FUNCTION 3529 1207 EV3 EQU $ ;FUNCTIONS RETURN HERE 3530 1207 2A5422 LHLD ADDR2 ;GET ADDR FUNC 3531 120A 23 INX H ;POINT LO 3532 120B 23 INX H ;POINT TYPE 3533 120C 7E MOV A,M ;LOAD IT 3534 120D E6E0 ANI 0E0H ;MASK IT 3535 120F FEC0 CPI 0C0H ;TEST IF STRING 3536 1211 CA4C12 JZ EV4 ;BRIF IS 3537 1214 C1 POP B ;GET CTRS 3538 1215 2A6922 LHLD SPCTR ;GET COUNTER 35391 3540 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3541+ 21:37 05/19/2019 3542+ PAGE 62 3543 3544 3545 3546 1218 23 INX H ;PLUS 3547 1219 23 INX H ;TWO WORDS 3548 121A 226922 SHLD SPCTR ;STORE IT 3549 121D 210000 LXI H,0 ;LOAD ZERO TO H,L 3550 1220 E5 PUSH H ;GET BLOCK OF 3551 1221 E5 PUSH H ;BYTES 3552 1222 39 DAD SP ;GET STACK ADDR 3553 1223 C5 PUSH B ;SAVE CTRS 3554 1224 E5 PUSH H ;SAVE ADDR 3555 1225 DF RST 3 ;GO STORE THE VARIABLE 3556 1226 3EE3 MVI A,0E3H ;TYPE=NUM 3557 1228 D1 EV3A: POP D ;GET ADDR IN STACK 3558 1229 2A5222 LHLD ADDR1 ;GET ADDR LST ARG 3559 122C 77 MOV M,A ;STORE TYPE CODE 3560 122D 2B DCX H ;POINT ONE BACK 3561 122E 73 MOV M,E ;STORE LO ADDR 3562 122F 2B DCX H ;POINT BACK 3563 1230 72 MOV M,D ;STORE HI ADDR 3564 1231 2A5422 LHLD ADDR2 ;GET LOCATION FUNCTION 3565 1234 23 INX H ;POINT LO 3566 1235 23 INX H ;POINT TYPE 3567 1236 7E MOV A,M ;LOAD TYPE 3568 1237 46 MOV B,M ;GET TYPE 3569 1238 E7 RST 4 ;ADJUST H,L 3570 1239 FD DB -3 AND 0FFH 3571 123A 78 MOV A,B ;LOAD TYPE 3572 123B C1 POP B ;RESTORE CTRS 3573 123C E618 ANI 18H ;ISOLATE #ARGS 3574 123E 1F RAR ;SHIFT RIGHT 3575 123F 1F RAR ;AGAIN 3576 1240 1F RAR ;ONCE MORE 3577 1241 57 MOV D,A ;SAVE IT 3578 1242 82 ADD D ;TIMES 2 3579 1243 82 ADD D ;TIMES 3 3580 1244 04 INR B ;POINT 3581 1245 04 INR B ;LST POSIT IN LOC 3582 1246 CDE21A CALL SQUIS ;GO COMPRESS STACK 3583 1249 C3BA11 JMP EVAL ;START AT BEGINNING 3584 124C 112021 EV4: LXI D,STRIN ;POINT STRING BUFFER 3585 124F 1A LDAX D ;LOAD IT 3586 1250 1F RAR ;DIVIDE BY TWO 3587 1251 3C INR A ;ADD 1 3588 1252 2A6922 LHLD SPCTR ;GET SP COUNT 3589 1255 4F MOV C,A ;SAVE LO 3590 1256 0600 MVI B,0 ;SET HI 3591 1258 09 DAD B ;ADD NUMBER WORDS 3592 1259 226922 SHLD SPCTR ;SAVE SP COUNT 3593 125C 210000 LXI H,0 ;GET SOME ZEROS 3594 125F C1 POP B ;GET CTRS 3595 1260 E5 EV4A: PUSH H ;GET 1 WORD 3596 1261 3D DCR A ;DECR CTR 35971 3598 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3599+ 21:37 05/19/2019 3600+ PAGE 63 3601 3602 3603 3604 1262 C26012 JNZ EV4A ;LOOP 3605 1265 39 DAD SP ;GET ADDRESS IN H,L 3606 1266 C5 PUSH B ;RE-SAVE CTRS 3607 1267 E5 PUSH H ;SAVE ADDR 3608 1268 1A LDAX D ;GET COUNT 3609 1269 3C INR A ;PLUS ONE 3610 126A 47 MOV B,A ;SAVE IT 3611 126B 1A EV4B: LDAX D ;GET A BYTE 3612 126C 77 MOV M,A ;STORE IT 3613 126D 13 INX D ;POINT NEXT 3614 126E 23 INX H ;DITTO 3615 126F 05 DCR B ;DECR CTR 3616 1270 C26B12 JNZ EV4B ;LOOP 3617 1273 3EE7 MVI A,0E7H ;TYPE CODE 3618 1275 C32812 JMP EV3A ;CONTINUE 3619 1278 FE05 EV5: CPI 5 ;TEST IF OPEN PAREN 3620 127A C29612 JNZ EV6 ;BRIF NOT 3621 127D 3E01 MVI A,1 ;DELETE 1 BYTE 3622 127F CDE21A CALL SQUIS ;GO COMPRESS IT 3623 1282 2A5622 LHLD ADDR3 ;RESTORE STMT POINTER 3624 1285 3A7220 LDA DIMSW ;GET SUBSR SWITCH 3625 1288 B7 ORA A ;TEST IT 3626 1289 CA1D11 JZ LOOKO ;BRIF NOT IN SUBSCRIPT 3627 128C 3A6822 LDA PARCT ;GET OPEN PAREN COUNT 3628 128F B7 ORA A ;TEST 3629 1290 C21D11 JNZ LOOKO ;BRIF NOT ZERO 3630 1293 C3BA11 JMP EVAL ;ELSE EVALUATE COMPLETE SUBSCR 3631 1296 B7 EV6: ORA A ;TEST IF END OF EXPRESSION 3632 1297 C2C712 JNZ EV9 ;BRIF NOT 3633 129A 3A7220 LDA DIMSW ;GET DIM SW 3634 129D B7 ORA A ;TEST IT 3635 129E C49D13 CNZ EDM1 ;BRIF NOT OFF 3636 12A1 79 MOV A,C ;GET TERM COUNT 3637 12A2 FE01 CPI 1 ;TEST IF ONE 3638 12A4 C20B1C JNZ STERR ;ERROR IF NOT ONE 3639 12A7 23 INX H ;POINT HIGH ADDR 3640 12A8 23 INX H ;SAME 3641 12A9 56 MOV D,M ;HIGH TO D 3642 12AA 23 INX H ;POINT LOW 3643 12AB 5E MOV E,M ;LOW TO E 3644 12AC CD8313 CALL EVLD ;GO LOAD VALUE 3645 12AF 2A6922 LHLD SPCTR ;GET STACK CTR 3646 12B2 7D EV7: MOV A,L ;GET LO BYTE 3647 12B3 B4 ORA H ;PLUS HI 3648 12B4 CABC12 JZ DV8 ;BRIF ZERO 3649 12B7 D1 POP D ;RETURN 2 BYTES 3650 12B8 2B DCX H ;DECR CTR 3651 12B9 C3B212 JMP EV7 ;LOOP 3652 12BC 3A7220 DV8: LDA DIMSW ;GET DIM SW 3653 12BF B7 ORA A ;TEST IT 3654 12C0 C4C413 CNZ EDM4 ;BRIF ON 36551 3656 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3657+ 21:37 05/19/2019 3658+ PAGE 64 3659 3660 3661 3662 12C3 2A5622 LHLD ADDR3 ;RESTORE STMT PTR 3663 12C6 C9 RET ;RETURN TO STMT PROCESSOR 3664 12C7 FE21 EV9: CPI 21H ;TEST IF PLUS 3665 12C9 111B13 LXI D,FADDJ ;ADDR 3666 12CC CAF912 JZ EV10 ;BRIF IS 3667 12CF FE25 CPI 25H ;TEST IF MINUS 3668 12D1 110C17 LXI D,FSUB ;ADDR 3669 12D4 CAF912 JZ EV10 ;BRIF IS 3670 12D7 FE41 CPI 41H ;TEST IF MUL 3671 12D9 111817 LXI D,FMUL ;ADDR 3672 12DC CAF912 JZ EV10 ;BRIF IS 3673 12DF FE45 CPI 45H ;TEST IF DIV 3674 12E1 119B17 LXI D,FDIV ;ADDR 3675 12E4 CAF912 JZ EV10 ;BRIF IS 3676 12E7 FE01 CPI 1 ;TEST IF COMMA 3677 12E9 CA7713 JZ EVCOM ;BRIF IS 3678 12EC FE61 CPI 61H ;TEST IF UNARY MINUS 3679 12EE CA6313 JZ EVNEG ;BRIF IS 3680 12F1 FE81 CPI 81H ;TEST IF EXPONENTIAL 3681 12F3 112313 LXI D,POWER ;ADDR 3682 12F6 C20B1C JNZ STERR ;ERROR IF NOT 3683 12F9 23 EV10: INX H ;POINT TO 3684 12FA 23 INX H ;1ST DATA 3685 12FB C5 PUSH B ;SAVE CTRS 3686 12FC D5 PUSH D ;SAVE ROUTINE ADDR 3687 12FD 56 MOV D,M ;HIGH TO D 3688 12FE 23 INX H ;POINT NEXT 3689 12FF 5E MOV E,M ;LOW TO E 3690 1300 E5 PUSH H ;SAVE POINTER 3691 1301 CD8313 CALL EVLD ;GO LOAD VALUE 3692 1304 E1 POP H ;RESTORE H,L 3693 1305 23 INX H ;POINT 2ND DATA 3694 1306 23 INX H ;SAME 3695 1307 56 MOV D,M ;HIGH TO D 3696 1308 23 INX H ;POINT NEXT 3697 1309 5E MOV E,M ;LOW TO E 3698 130A 23 INX H ;POINT NEXT 3699 130B 3A8E22 LDA NS ;GET PREV TYPE 3700 130E BE CMP M ;TEST THIS TYPE 3701 130F C20F1C JNZ SNERR ;BRIF MIXED MODE 3702 1312 2B DCX H ;POINT BACK 3703 1313 E3 XTHL ;POP ADDR FROM STACK, PUSH H ONTO 3704 1314 015213 LXI B,EV11 ;RETURN ADDRESS 3705 1317 C5 PUSH B ;SAVE ON STACK 3706 1318 E5 PUSH H ;SAVE JUMP ADDR 3707 1319 EB XCHG ;PUT VAR ADDR TO H,L 3708 131A C9 RET ;FAKE CALL TO ROUTINE 3709 131B FEE7 FADDJ: CPI 0E7H ;TEST IF STRINGS 3710 131D CA260D JZ CONCA ;BRIF IS 3711 1320 C33716 JMP FADD ;ELSE, GO ADD 3712 1323 E5 POWER: PUSH H ;SAVE ADDR OF VAR 37131 3714 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3715+ 21:37 05/19/2019 3716+ PAGE 65 3717 3718 3719 3720 1324 212F22 LXI H,TEMP1 ;POINT SAVE AREA 3721 1327 DF RST 3 ;SAVE X 3722 1328 E1 POP H ;RESTORE H,L 3723 1329 EF RST 5 ;LOAD IT 3724 132A CDCE18 CALL FTEST ;TEST FOR ZERO 3725 132D CAD60B JZ SGN1 ;GIVE RESULT = 1 IF POWER = 0 3726 1330 214722 LXI H,TEMP7 ;POINT SAVE AREA 3727 1333 DF RST 3 ;SAVE B 3728 1334 212F22 LXI H,TEMP1 ;POINT X 3729 1337 EF RST 5 ;GO LOAD IT 3730 1338 CDCE18 CALL FTEST ;TEST FOR ZERO 3731 133B C8 RZ ;0 X = 0 3732 133C CD130B CALL LN ;GET NATURAL LNRITHM 3733 133F 214722 LXI H,TEMP7 ;POINT B 3734 1342 CD1817 CALL FMUL ;GO MULTIPLY 3735 1345 C36A0B JMP EXP ;GET EXP FUNC 3736 ; X B = EXP(B*LN(X)) 3737 1348 212F22 XSQR: LXI H,TEMP1 ;POINT X 3738 134B EF RST 5 ;LOAD X 3739 134C 212F22 LXI H,TEMP1 ;POINT X 3740 134F C31817 JMP FMUL ;TIMES X 3741 1352 E1 EV11: POP H ;GET H,L 3742 1353 C1 POP B ;GET CTRS 3743 1354 2B DCX H ;POINT BACK 3744 1355 2B DCX H ;AND AGAIN 3745 1356 CD001B CALL GTEMP ;GO SAVE FACC 3746 1359 E7 RST 4 ;ADJUST H,L 3747 135A F9 DB -7 AND 0FFH 3748 135B 3E04 MVI A,4 ;DELETE 4 BYTES 3749 135D CDE21A CALL SQUIS ;GO COMPRESS 3750 1360 C3BA11 JMP EVAL ;CONTINUE 3751 1363 23 EVNEG: INX H ;POINT BACK TO OP 3752 1364 C5 PUSH B ;SAVE CTRS 3753 1365 E5 PUSH H ;SAVE H,L 3754 1366 23 INX H ;DITTO 3755 1367 56 MOV D,M ;GET HI BYTE 3756 1368 23 INX H ;POINT NEXT 3757 1369 5E MOV E,M ;GET LO BYTE 3758 136A CD8313 CALL EVLD ;GO LOAD VAR 3759 136D CD7A0C CALL NEG ;GO NEGATE IT 3760 1370 E1 POP H ;GET LOCATINO 3761 1371 C1 POP B ;GET CTRS 3762 1372 CD001B CALL GTEMP ;GO STORE FACC IN STACK 3763 1375 E7 RST 4 ;ADJUST H,L 3764 1376 FC DB -4 AND 0FFH 3765 1377 3E01 EVCOM: MVI A,1 ;DELETE 1 BYTE 3766 1379 CDE21A CALL SQUIS ;COMPRESS 3767 137C 216B22 LXI H,CMACT ;GET COUNT 3768 137F 34 INR M ;INCR 3769 1380 C3BA11 JMP EVAL ;CONTINUE 3770 1383 23 EVLD: INX H ;POINT TYPE 37711 3772 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3773+ 21:37 05/19/2019 3774+ PAGE 66 3775 3776 3777 3778 1384 7E MOV A,M ;LOAD IT 3779 1385 328E22 STA NS ;SAVE IT 3780 1388 EB XCHG ;SAVE H,L IN D,E 3781 1389 FEE7 CPI 0E7H ;TEST IF STRING 3782 138B C22800 JNZ RST5 ;LOAD FLOATING POINT 3783 138E 112021 LXI D,STRIN ;POINT BUFFER 3784 1391 7E MOV A,M ;GET COUNT 3785 1392 3C INR A ;ADD ONE 3786 1393 47 MOV B,A ;SAVE COUNT 3787 1394 7E EVLD1: MOV A,M ;GET NEXT 3788 1395 12 STAX D ;STORE IT 3789 1396 23 INX H ;POINT NEXT 3790 1397 13 INX D ;DITTO 3791 1398 05 DCR B ;DECR COUNT 3792 1399 C29413 JNZ EVLD1 ;LOOP 3793 139C C9 RET ;RETURN 3794 ; 3795 139D 79 EDM1: MOV A,C ;GET ITEM COUNT 3796 139E E5 PUSH H ;SAVE H,L 3797 139F FE01 CPI 1 ;TEST IF 1 3798 13A1 C2B013 JNZ EDM3 ;BRIF NOT 3799 13A4 0604 MVI B,4 ;GET COUNT 3800 13A6 212F22 LXI H,TEMP1 ;POINT AREA 3801 13A9 CD5E1C CALL ZEROM ;GO ZERO IT 3802 13AC E1 EDM2A: POP H ;RESTORE H,L 3803 13AD 0E01 MVI C,1 ;SET COUNT 3804 13AF C9 RET ;RETURN 3805 13B0 FE02 EDM3: CPI 2 ;TEST IF 2 3806 13B2 C20F1C JNZ SNERR ;ELSE, ERROR 3807 13B5 E7 RST 4 ;POINT 2ND ARG 3808 13B6 05 DB 5 3809 13B7 56 MOV D,M ;GET HI ADDR 3810 13B8 23 INX H ;POINT NEXT 3811 13B9 5E MOV E,M ;GET LO ADDR 3812 13BA CD8313 CALL EVLD ;LOAD THE ARG 3813 13BD 212F22 LXI H,TEMP1 ;POINT AREA 3814 13C0 DF RST 3 ;SAVE THE ARG 3815 13C1 C3AC13 JMP EDM2A ;CONTINUE 3816 13C4 CD351F EDM4: CALL FACDE ;CONVERT FACC TO D,E 3817 13C7 D5 PUSH D ;PUT D,E TO B,C 3818 13C8 C1 POP B 3819 13C9 C5 PUSH B ;SAVE COL 3820 13CA 212F22 LXI H,TEMP1 ;POINT 2ND ARGUMENT 3821 13CD EF RST 5 ;LOAD IT IN FACC 3822 13CE CD351F CALL FACDE ;CONVERT TO D,E 3823 13D1 C1 POP B ;GET COL 3824 13D2 AF XRA A ;GET A ZERO 3825 13D3 327220 STA DIMSW ;RESET SW 3826 13D6 C9 RET ;RETURN 3827 13D7 78 LDV2A: MOV A,B ;GET HI NAME 3828 13D8 F680 ORI 80H ;SET BIT 38291 3830 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3831+ 21:37 05/19/2019 3832+ PAGE 67 3833 3834 3835 3836 13DA 47 MOV B,A ;RESTORE 3837 13DB C5 PUSH B ;SAVE NAME 3838 13DC EB XCHG ;SAVE H,L IN D,E 3839 13DD 3A6822 LDA PARCT ;GET PAREN COUNT 3840 13E0 F5 PUSH PSW ;SAVE 3841 13E1 AF XRA A ;CLEAR REG A 3842 13E2 326822 STA PARCT ;RESET COUNT 3843 13E5 2A6922 LHLD SPCTR ;GET STACK COUNTER 3844 13E8 E5 PUSH H ;SAVE IT 3845 13E9 210000 LXI H,0 ;GET A ZERO 3846 13EC 226922 SHLD SPCTR ;RESET CTR 3847 13EF 2A5022 LHLD EXPRS ;GET EXPRST 3848 13F2 E5 PUSH H ;SAVE IT 3849 13F3 23 INX H ;POINT NEXT 3850 13F4 3600 MVI M,0 ;SET NEW START 3851 13F6 225022 SHLD EXPRS ;SAVE IT 3852 13F9 3A7220 LDA DIMSW ;GET PREV SE 3853 13FC F5 PUSH PSW ;SAVE IT 3854 13FD EB XCHG ;RESTORE H,L 3855 13FE 3EFF MVI A,0FFH ;GET ON VALUE 3856 1400 327220 STA DIMSW ;SET SW 3857 1403 CD950F CALL LOOKD ;RECURSIVE CALL 3858 1406 F1 POP PSW ;GET DIM SW 3859 1407 327220 STA DIMSW ;REPLACE IT 3860 140A 225622 SHLD ADDR3 ;SAVE H,L 3861 140D E1 POP H ;GET EXPRST 3862 140E 225022 SHLD EXPRS ;SAVE IT 3863 1411 E1 POP H ;GET STACK COUNTER 3864 1412 226922 SHLD SPCTR ;RESTORE IT 3865 1415 F1 POP PSW ;GET PAREN COUNT 3866 1416 326822 STA PARCT ;RESTORE IT 3867 1419 E1 POP H ;GET NAME 3868 141A D5 PUSH D ;SAVE ROW 3869 141B C5 PUSH B ;SAVE COL 3870 141C EB XCHG ;PUT NAME IN D,E 3871 141D CD341B CALL SEARC ;GO FIND ADDRESS (PUT IN D,E) 3872 1420 D1 POP D ;GET ADDR 3873 1421 C1 POP B ;RESTORE COL 3874 1422 D1 POP D ;RESTORE ROW 3875 1423 CD8518 CALL SUBSC ;GET SUBSCRIPT (RETURNS ADDR IN H,L) 3876 1426 EB XCHG ;SAVE IN D,E 3877 1427 2A5622 LHLD ADDR3 ;GET H,L 3878 142A E5 PUSH H ;SAVE ON STACK 3879 142B C3DE0F JMP LDV ;CONTINUE 3880 ; PAGE 3881 ; 3882 142E FIN EQU $ 3883 ; 3884 ; FLOATING POINT INPUT CONVERSION ROUTINE 3885 ; 3886 ; THIS SUBROUTINE CONVERTS AN ASCII STRING OF CHARACTERS 38871 3888 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3889+ 21:37 05/19/2019 3890+ PAGE 68 3891 3892 3893 3894 ; TO THE FLOATING POINT ACCUMULATOR. THE INPUT FIELD 3895 ; MAY CONTAIN ANY VALID NUMBER, INCLUDING SCIENTIFIC 3896 ; NOTATION (NNN.NNNNE+NN). 3897 ; THE INPUT STRING IS TERMINATED BY ANY NON-NUMERIC CHAR 3898 ; 3899 ; 3900 142E EB XCHG ;PUT ADDR TO D,E 3901 142F 0E00 MVI C,0 ;INITIAL VALUE EXCESS DIGIT COUNT 3902 1431 CD8814 CALL FIN8 ;GET INTEGER PORTION 3903 1434 0600 MVI B,0 ;CLEAR DIGIT COUNT 3904 1436 FE2E CPI '.' ;TEST IF DEC-POINT 3905 1438 C23E14 JNZ FIN2 ;BRIF NOT 3906 143B CDA214 CALL FIN9 ;GET FRACTION 3907 143E F1 FIN2: POP PSW ;GET SIGN 3908 143F F618 ORI 24 ;SET UP FOR FLOAT 3909 1441 325822 STA FACC 3910 1444 78 MOV A,B ;GET # FRACTION DIGITS 3911 1445 81 ADD C ;+ EXCESS DIGITS 3912 1446 F5 PUSH PSW ;SAVE POWER OF TEN 3913 1447 D5 PUSH D ;SAVE PTR 3914 1448 CDDD16 CALL FNORM ;NORMALIZE NUMBER 3915 144B 1A LDAX D ;GET NEXT CHARACTER 3916 144C FE45 CPI 'E' ;TEST IF EXPONENT 3917 144E C26C14 JNZ FIN4 ;BRIF NOT 3918 1451 215C22 LXI H,FTEMP ;POINT SAVE AREA 3919 1454 DF RST 3 ;SAVE ACC 3920 1455 D1 POP D ;RESTORE PTR 3921 1456 13 INX D ;SKIP 'E' 3922 1457 CD8814 CALL FIN8 ;GET NUMERIC EXP 3923 145A 3A5B22 LDA FACC+3 ;GET EXPONENT 3924 145D C1 POP B ;EXPONENT SIGN 3925 145E 04 INR B ;TEST 3926 145F F26414 JP FIN3 ;BRIF NOT NEG 3927 1462 2F CMA ;NEGATE EXPONENT 3928 1463 3C INR A 3929 1464 C1 FIN3: POP B ;POWER OF TEN 3930 1465 80 ADD B ;ADD EXPONENT 3931 1466 F5 PUSH PSW ;SAVE COUNT 3932 1467 215C22 LXI H,FTEMP ;RESTORE NUMBER 3933 146A D5 PUSH D ;SAVE PTR 3934 146B EF RST 5 ;LOAD IT 3935 146C E1 FIN4: POP H ;RESTORE PTR 3936 146D F1 POP PSW ;RESTORE COUNT 3937 146E C8 FIN5: RZ ;RETURN IF ZERO 3938 146F E5 PUSH H ;SAVE H,L 3939 1470 219E1D LXI H,TEN ;POINT CONSTANT: 10 3940 1473 FA8014 JM FIN7 ;BRIF DIVIDE NEEDED 3941 1476 3D DCR A ;DECR COUNT 3942 1477 F5 PUSH PSW ;SAVE COUNT 3943 1478 CD1817 CALL FMUL ;GO MULTIPLY BY 10 3944 147B F1 FIN6: POP PSW ;RESTORE COUNT 39451 3946 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 3947+ 21:37 05/19/2019 3948+ PAGE 69 3949 3950 3951 3952 147C E1 POP H ;RESTORE H,L 3953 147D C36E14 JMP FIN5 ;CONTINUE 3954 1480 3C FIN7: INR A ;INCR COUNT 3955 1481 F5 PUSH PSW ;SAVE COUNT 3956 1482 CD9B17 CALL FDIV ;GO DIVIDE BY 10 3957 1485 C37B14 JMP FIN6 ;LOOP 3958 ; 3959 ; FIN8 CONVERT NUMBER STRING TO FACC 3960 ; ON ENTRY, C=INIT VALUE EXCESS DIGIT COUNT 3961 ; DE=INPUT STRING 3962 ; ON EXIT, SIGN IS ON STACK 3963 ; B=DIGIT COUNT 3964 ; C=EXCESS DIGIT COUNT 3965 ; 3966 1488 215822 FIN8: LXI H,FACC ;CLEAR FACC 3967 148B 0604 MVI B,4 3968 148D CD5E1C CALL ZEROM 3969 1490 210080 LXI H,8000H ;ASSUME MINUS 3970 1493 1A LDAX D ;GET CHAR 3971 1494 FE2D CPI '-' 3972 1496 CAA014 JZ FIN8A 3973 1499 65 MOV H,L ;NOPE, MUST BE PLUS 3974 ;(B IS CLEARED BY ZEROM) 3975 149A FE2B CPI '+' 3976 149C CAA014 JZ FIN8A 3977 149F 1B DCX D ;NEITHER, BACK UP POINTER 3978 14A0 E3 FIN8A: XTHL ;GET RETURN, PUSH SIGN 3979 14A1 E5 PUSH H ;RESTORE RETURN 3980 14A2 13 FIN9: INX D ;POINT NEXT 3981 14A3 1A LDAX D ;GET CHAR 3982 14A4 FE30 CPI '0' ;TEST IF LESS ZERO 3983 14A6 D8 RC ;RETURN IF IS 3984 14A7 FE3A CPI '9'+1 ;TEST IF GT NINE 3985 14A9 D0 RNC ;RETURN IF IS 3986 14AA 05 DCR B ;DIGIT COUNT 3987 14AB D5 PUSH D ;SAVE PTR 3988 14AC C5 PUSH B ;SAVE COUNTERS 3989 14AD CDD514 CALL FMTEN ;MULTIPLY FACC*TEN 3990 14B0 B7 ORA A ;TEST FOR OVERFLOW 3991 14B1 CABE14 JZ FINB ;BRIF NO OVERFLOW 3992 14B4 216022 LXI H,FTEMP+4 3993 14B7 EF RST 5 ;RESTORE OLD FACC 3994 14B8 C1 POP B ;RESTORE COUNTERS 3995 14B9 0C INR C ;EXCESS DIGIT 3996 14BA D1 POP D 3997 14BB C3A214 JMP FIN9 3998 14BE C1 FINB: POP B ;RSTORE COUNTERS 3999 14BF D1 POP D ;& PTR 4000 14C0 1A LDAX D ;GET THE DIGIT 4001 14C1 E60F ANI 0FH ;MASK OFF ZONE 4002 14C3 215B22 LXI H,FACC+3 ;POINT ACC 40031 4004 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4005+ 21:37 05/19/2019 4006+ PAGE 70 4007 4008 4009 4010 14C6 86 ADD M ;ADD 4011 14C7 77 MOV M,A ;STORE 4012 14C8 2B DCX H ;POINT NEXT 4013 14C9 7E MOV A,M ;LOAD 4014 14CA CE00 ACI 0 ;PLUS CARRY 4015 14CC 77 MOV M,A ;STORE 4016 14CD 2B DCX H ;POINT NEXT 4017 14CE 7E MOV A,M ;LOAD 4018 14CF CE00 ACI 0 ;PLUS CARRY 4019 14D1 77 MOV M,A ;STORE 4020 14D2 C3A214 JMP FIN9 ;LOOP 4021 ; 4022 ; MULTIPLY FACC BY TEN 4023 ; 4024 14D5 216022 FMTEN: LXI H,FTEMP+4 4025 14D8 DF RST 3 ;SAVE FACC 4026 14D9 CDE514 CALL FIND ;*2 4027 14DC CDE514 CALL FIND ;*4 4028 14DF 216322 LXI H,FTEMP+7 4029 14E2 CDE814 CALL FIND0 ;*5 4030 14E5 215B22 FIND: LXI H,FACC+3 ;DOUBLE FACC 4031 14E8 115B22 FIND0: LXI D,FACC+3 4032 14EB 0604 MVI B,4 ;BYTE COUNT 4033 14ED C3F018 JMP FADDT ;ADD & RETURN 4034 ;PAGE 4035 ; 4036 14F0 FOUT EQU $ 4037 ; 4038 ; FLOATING POINT OUTPUT FORMAT ROUTINE 4039 ; 4040 ; THIS SUBROUTINE CONVERTS A NUMBER IN FACC TO A 4041 ; FORMAT SUITABLE FOR PRINTING. THAT IS, THE 4042 ; NUMBER WILL BE IN SCIENTIFIC NOTATION IF EXPONENT 4043 ; IS > 5 OR < -2, OTHERWISE IT WILL BE ZERO SUPRESSED 4044 ; ON BOTH SIDES. 4045 ; 4046 14F0 115B22 LXI D,FACC+3 ;POINT LSB 4047 14F3 1A LDAX D ;LOAD IT 4048 14F4 F607 ORI 7 ;MASK FOR OUTPUT 4049 14F6 12 STAX D ;REPLACE 4050 14F7 CDCE18 CALL FTEST ;GET SIGN OF NUMBER 4051 14FA 3620 MVI M,' ' ;DEFAULT SPACE 4052 14FC F20115 JP FOUT0 ;BRIF NOT MINUS 4053 14FF 362D MVI M,'-' ;MOVE DASH 4054 1501 23 FOUT0: INX H ;POINT NEXT 4055 1502 C20B15 JNZ FOUT2 ;BRIF NOT ZERO 4056 1505 3630 MVI M,'0' ;MOVE THE ZERO 4057 1507 23 INX H ;POINT NEXT 4058 1508 3620 MVI M,' ' ;MOVE SPACE FOLLOWING 4059 150A C9 RET ;RETURN 4060 150B 3A5822 FOUT2: LDA FACC ;GET SIGN & EXP 40611 4062 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4063+ 21:37 05/19/2019 4064+ PAGE 71 4065 4066 4067 4068 150E CDDC18 CALL FEXP ;EXPAND EXPONENT 4069 1511 C21615 JNZ FOUTV ;BRIF NOT ZERO 4070 1514 3E80 MVI A,80H ;SET NEG 4071 1516 E680 FOUTV: ANI 80H ;ISOLATE 4072 1518 327522 STA DEXP ;SAVE SIGN 4073 151B E5 PUSH H ;SAVE H,L 4074 151C 3A5822 FOUT3: LDA FACC ;GET SIGN & EXP 4075 151F CDDC18 CALL FEXP ;EXPAND EXP 4076 1522 FE01 CPI 1 ;TEST RANGE 4077 1524 F23D15 JP FOUT6 ;BRIF IN RANGE 4078 1527 217522 FOUT4: LXI H,DEXP ;POINT DEC.EXP 4079 152A 34 INR M ;INCR IT 4080 152B 219E1D LXI H,TEN ;POINT CONST: 10 4081 152E F23715 JP FOUT5 ;BRIF POS. 4082 1531 CD1817 CALL FMUL ;MULTIPLY 4083 1534 C31C15 JMP FOUT3 ;LOOP 4084 1537 CD9B17 FOUT5: CALL FDIV ;DIVIDE 4085 153A C31C15 JMP FOUT3 ;LOOP 4086 153D FE05 FOUT6: CPI 5 ;TEST HIGH RANGE 4087 153F F22715 JP FOUT4 ;BRIF 5 OR GREATER 4088 1542 215C22 LXI H,FTEMP ;POINT SAVE AREA 4089 1545 DF RST 3 ;STORE IT 4090 1546 3A5822 LDA FACC ;GET EXPONENT 4091 1549 CDDC18 CALL FEXP ;EXPAND 4092 154C 0E06 MVI C,6 ;DIGIT COUNT 4093 154E CD8215 CALL FOUTB ;SHIFT LEFT 4094 1551 FE0A CPI 10 ;TEST IF DECIMAL POINT 4095 1553 FA5D15 JM FOUTU ;BRIF LT 4096 1556 215C22 LXI H,FTEMP ;POINT SAVE AREA 4097 1559 EF RST 5 ;LOAD IT 4098 155A C32715 JMP FOUT4 ;ONCE MORE 4099 155D CD7015 FOUTU: CALL FOUT9 ;PUT DIGIT 4100 1560 AF FOUT7: XRA A ;CLEAR STATUS 4101 1561 325822 STA FACC ;AND OVERFLOW 4102 1564 CDD514 CALL FMTEN ;MULTIPLY BY TEN 4103 1567 CD7015 CALL FOUT9 ;PUT DIGIT 4104 156A C26015 JNZ FOUT7 ;LOOP 4105 156D C39915 JMP FOUTH ;GO AROUND 4106 1570 F630 FOUT9: ORI 30H ;DEC. ZONE 4107 1572 E1 POP H ;GET RETURN ADDR 4108 1573 E3 XTHL ;EXCH WITH TOP (PTR) 4109 1574 77 MOV M,A ;PUT DIGIT 4110 1575 23 INX H ;POINT NEXT 4111 1576 79 MOV A,C ;GET COUNT 4112 1577 FE06 CPI 6 ;TEST IF 1ST 4113 1579 C27F15 JNZ FOUTA ;BRIF NOT 4114 157C 362E MVI M,'.' ;MOVE DEC. PT. 4115 157E 23 INX H ;POINT NEXT 4116 157F E3 FOUTA: XTHL ;EXCH WITH RTN 4117 1580 0D DCR C ;DECR COUNT 4118 1581 E9 PCHL ;RETURN 41191 4120 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4121+ 21:37 05/19/2019 4122+ PAGE 72 4123 4124 4125 4126 1582 5F FOUTB: MOV E,A ;SAVE BIT COUNT 4127 1583 AF XRA A ;CLEAR ACC FLAGS 4128 1584 325822 STA FACC ;AND OVERFLOW 4129 1587 215B22 FOUTC: LXI H,FACC+3 ;POINT LSB 4130 158A 0604 MVI B,4 ;BYTE COUNT 4131 158C 7E FOUTD: MOV A,M ;GET A BYTE 4132 158D 17 RAL ;SHIFT LEFT 4133 158E 77 MOV M,A ;STORE 4134 158F 2B DCX H ;POINT NEXT 4135 1590 05 DCR B ;DECR CTR 4136 1591 C28C15 JNZ FOUTD ;LOOP 4137 1594 1D DCR E ;DECR BIT CTR 4138 1595 C28715 JNZ FOUTC ;LOOP 4139 1598 C9 RET ;RETURN 4140 1599 E1 FOUTH: POP H ;GET PTR 4141 159A 3645 MVI M,'E' ;EXPONENT 4142 159C 23 INX H ;POINT NEXT 4143 159D 3A7522 LDA DEXP ;GET EXPONENT 4144 15A0 362B MVI M,'+' ;DEFAULT 4145 15A2 57 MOV D,A ;SAVE NUMBER 4146 15A3 B7 ORA A ;TEST IT 4147 15A4 F2B015 JP FOUTI ;BRIF POS 4148 15A7 362D MVI M,'-' ;ELSE, DASH 4149 15A9 E67F ANI 7FH ;STRIP DUMB SIGN 4150 15AB 2F CMA ;COMPLEMENT 4151 15AC 3C INR A ;PLUS ONE (TWOS COMP) 4152 15AD 57 MOV D,A ;SAVE IT 4153 15AE 2F CMA ;RE-COMPLEMENT 4154 15AF 3C INR A ;PLUS ONE 4155 15B0 23 FOUTI: INX H ;POINT NEXT 4156 15B1 E5 PUSH H ;SAVE PTR 4157 15B2 1EFF MVI E,-1 AND 0FFH ;INIT CTR (TENS) 4158 15B4 1C FOUTJ: INR E ;ADD ONE 4159 15B5 D60A SUI 10 ;LESS 10 4160 15B7 F2B415 JP FOUTJ ;LOOP 4161 15BA C60A ADI 10 ;CORRECT UNITS 4162 15BC 47 MOV B,A ;SAVE UNITS 4163 15BD 7B MOV A,E ;GET TENS 4164 15BE CD7015 CALL FOUT9 ;OUTPUT 4165 15C1 78 MOV A,B ;GET UNITS 4166 15C2 CD7015 CALL FOUT9 ;OUTPUT 4167 15C5 E1 POP H ;GET PTR 4168 15C6 3620 MVI M,' ' ;SPACE AFTER 4169 15C8 7A MOV A,D ;GET DEC EXPON 4170 15C9 B7 ORA A ;SET FLAGS 4171 15CA F2D315 JP FOUTK ;BRIF POS. 4172 15CD FEFE CPI -2 AND 0FFH ;TEST FOR MIN 4173 15CF D8 RC ;RETURN IF LESS THAN -2 4174 15D0 C3D615 JMP FOUTL ;GO AROUND 4175 15D3 FE06 FOUTK: CPI 6 ;TEST IF TOO BIG 4176 15D5 D0 RNC ;RETURN IF 6 OR GREATER 41771 4178 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4179+ 21:37 05/19/2019 4180+ PAGE 73 4181 4182 4183 4184 15D6 4F FOUTL: MOV C,A ;SAVE EXPONENT 4185 15D7 0605 MVI B,5 ;CTR 4186 15D9 3620 FOUTM: MVI M,' ' ;SPACE OUT EXPONENT 4187 15DB 2B DCX H ;POINT PRIOR 4188 15DC 05 DCR B ;DECR CTR 4189 15DD C2D915 JNZ FOUTM ;LOOP 4190 15E0 EB XCHG ;FLIP/FLOP 4191 15E1 7B MOV A,E ;GET LOW BYTE 4192 15E2 D605 SUI 5 ;POINT TO DOT 4193 15E4 6F MOV L,A ;PUT DOWN 4194 15E5 7A MOV A,D ;GET HIGH 4195 15E6 DE00 SBI 0 ;IN CASE OF BORROW 4196 15E8 67 MOV H,A ;PUT DOWN 4197 15E9 79 MOV A,C ;GET EXPONENT 4198 15EA B7 ORA A ;TEST SIGN 4199 15EB CAFC15 JZ FOUTO ;BRIF ZERO 4200 15EE FA1116 JM FOUTR ;BRIF NEGATIVE 4201 15F1 46 FOUTN: MOV B,M ;GET HIGH BYTE 4202 15F2 23 INX H ;POINT NEXT 4203 15F3 7E MOV A,M ;GET LOW BYTE 4204 15F4 70 MOV M,B ;SHIFT DOT TO RIGHT 4205 15F5 2B DCX H ;POINT BACK 4206 15F6 77 MOV M,A ;MOVE THE DIGIT LEFT 4207 15F7 23 INX H ;POINT NEXT 4208 15F8 0D DCR C ;DECR CTR 4209 15F9 C2F115 JNZ FOUTN ;LOOP 4210 15FC EB FOUTO: XCHG ;POINT END 4211 15FD 7E FOUTP: MOV A,M ;GET A DIGIT/DOT 4212 15FE FE30 CPI '0' ;TEST FOR TRAILING ZERO 4213 1600 C20916 JNZ FOUTQ ;BRIF NOT 4214 1603 3620 MVI M,' ' ;SPACE FILL 4215 1605 2B DCX H ;POINT PRIOR 4216 1606 C3FD15 JMP FOUTP ;LOOP 4217 1609 FE2E FOUTQ: CPI '.' ;TEST FOR TRAILING DOT 4218 160B 23 INX H ;JUST IN CASE NOT 4219 160C C0 RNZ ;RETURN IF NOT 4220 160D 2B DCX H ;RESET PTR 4221 160E 3620 MVI M,' ' ;SPACE IT OUT 4222 1610 C9 RET ;RETURN 4223 1611 FEFF FOUTR: CPI 0FFH ;TEST IF -1 4224 1613 C21F16 JNZ FOUTS ;ELSE -2 4225 1616 2B DCX H ;POINT SIGNIFICANT 4226 1617 7E MOV A,M ;GET THE CHAR 4227 1618 362E MVI M,'.' ;MOVE THE DOT 4228 161A 23 INX H ;POINT NEXT 4229 161B 77 MOV M,A ;SHIFT THE DIGIT 4230 161C C3FC15 JMP FOUTO ;GO ZERO SUPPRESS 4231 161F 2B FOUTS: DCX H ;POINT ONE TO LEFT 4232 1620 7E MOV A,M ;PICK UP DIGIT 4233 1621 3630 MVI M,'0' ;REPLACE 4234 1623 23 INX H ;POINT RIGHT 42351 4236 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4237+ 21:37 05/19/2019 4238+ PAGE 74 4239 4240 4241 4242 1624 77 MOV M,A ;PUT THE DIGIT 4243 1625 62 MOV H,D ;GET LOW ADDR 4244 1626 6B MOV L,E ;POINT LAST DIGIT 4245 1627 0606 MVI B,6 ;CTR 4246 1629 2B FOUTT: DCX H ;POINT PRITO 4247 162A 7E MOV A,M ;GET A DIGIT 4248 162B 23 INX H ;POINT 4249 162C 77 MOV M,A ;PUT IT ONE TO RIGHT 4250 162D 2B DCX H ;POINT 4251 162E 05 DCR B ;DECR CTR 4252 162F C22916 JNZ FOUTT ;LOOP 4253 1632 362E MVI M,'.' ;MOVE THE DOT 4254 1634 C3FC15 JMP FOUTO ;CONTINUE 4255 ; 4256 1637 FADD EQU $ 4257 ; 4258 ; 4259 ; FLOATING POINT ADD THE NUMBER AT (H,L) TO THE FACC 4260 ; 4261 ; 4262 1637 23 INX H ;POINT FIRST DIGIT 4263 1638 7E MOV A,M ;LOAD IT 4264 1639 B7 ORA A ;TEST IT 4265 163A CACE18 JZ FTEST ;BRIF ZERO 4266 163D 2B DCX H ;POINT BACK 4267 163E CDCE18 CALL FTEST ;GO TEST SIGN OF FACC 4268 1641 CA2800 JZ RST5 ;JUST LOAD IF FACC = 0 4269 1644 CDDC18 CALL FEXP ;GO GET EXPONENT 4270 1647 47 MOV B,A ;SAVE EXPONENT 4271 1648 7E MOV A,M ;GET EXPONENT OF ADDR 4272 1649 CDDC18 CALL FEXP ;GO GET EXPONENT 4273 164C 4F MOV C,A ;SAVE THE EXPONENT 4274 164D 90 SUB B ;GET DIFFERENCE OF TWO EXPONENTS 4275 164E CA6316 JZ FADD4 ;BRIF THEY'RE EQ 4276 1651 F25616 JP FADD3 ;BRIF DIFFERENCE IS POSITIVE 4277 1654 2F CMA ;COMPLEMENT ACC 4278 1655 3C INR A ;PLUS ONE (TWO'S COMPLEMENT) 4279 1656 FE18 FADD3: CPI 24 ;COMPARE DIFFERENCE TO MAX 4280 1658 DA6316 JC FADD4 ;BRIF LESS 4281 165B 78 MOV A,B ;GET EXPON OF ADDUEND 4282 165C 91 SUB C ;GET TRUE DIFFERENCE AGAIN 4283 165D F2CE18 JP FTEST ;BRIF FACC > ADDER 4284 1660 C32800 JMP RST5 ;ELSE, ADDER > FACC 4285 1663 F5 FADD4: PUSH PSW ;SAVE DIFFERENCE 4286 1664 C5 PUSH B ;SAVE EXPONENTS 4287 1665 115C22 LXI D,FTEMP ;GET ADDR OF TEMP ACC 4288 1668 CD561C CALL CPY4H 4289 166B C1 POP B ;GET EXPONENTS 4290 166C F1 POP PSW ;GET DIFFERENCE 4291 166D CA9416 JZ FADD9 ;JUST ADD IF ZERO 4292 1670 215D22 LXI H,FTEMP+1 ;DEFAULT 42931 4294 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4295+ 21:37 05/19/2019 4296+ PAGE 75 4297 4298 4299 4300 1673 F5 PUSH PSW ;SAVE DIFFERENCE 4301 1674 78 MOV A,B ;GET FACC EXPON 4302 1675 91 SUB C ;MINUS FTEMP EXPON 4303 1676 F28616 JP FADD6 ;BRIF TEMP MUST BE SHIFTED 4304 1679 215822 LXI H,FACC ;POINT FLOAT ACC 4305 167C 79 MOV A,C ;GET EXPONENT, SIGN 4306 167D E67F ANI 7FH ;STRIP EXP SIGN 4307 167F 4F MOV C,A ;PUT BACK 4308 1680 7E MOV A,M ;GET THE EXP 4309 1681 E680 ANI 80H ;STRIP OFF OLD EXPON 4310 1683 B1 ORA C ;MOVE ADDR EXPON TO IT 4311 1684 77 MOV M,A ;REPLACE 4312 1685 23 INX H ;POINT FIRST DATA BYTE 4313 1686 F1 FADD6: POP PSW ;GET DIFFER 4314 1687 4F MOV C,A ;SAVE IT 4315 1688 0603 FADD7: MVI B,3 ;LOOP CTR (INNER) 4316 168A AF XRA A ;INIT CARRY TO Z 4317 168B E5 PUSH H ;SAVE ADDR 4318 168C CDFB18 CALL FSHFT ;GO SHIFT 4319 168F E1 POP H ;GET ADDR 4320 1690 0D DCR C ;DECR CTR 4321 1691 C28816 JNZ FADD7 ;LOOP 4322 1694 FADD9 EQU $ 4323 1694 215C22 LXI H,FTEMP 4324 1697 3A5822 LDA FACC ;GET EXPONENT 4325 169A AE XRA M ;SEE IF SIGNS THE SAME 4326 169B 115B22 LXI D,FACC+3 ;POINT LEAST SIGN BYTE 4327 169E 215F22 LXI H,FTEMP+3 4328 16A1 FABC16 JM FADDA ;BRIF SIGNS DIFFERENT 4329 16A4 CDEE18 CALL FADT3 ;ADD 3 BYTES 4330 16A7 D2CE18 JNC FTEST ;BRIF NO OVERFLOW 4331 16AA EB XCHG ;POINT HL TO FACC 4332 16AB CD8917 CALL SVSGN ;SAVE SIGN, RETURN EXPONENT 4333 16AE 3C INR A ;INCREMENT EXPONENT 4334 16AF CD9117 CALL RSSGN ;RESTORE SIGN TO EXPONENT 4335 16B2 23 INX H ;POINT DATA 4336 16B3 37 STC ;SET CY 4337 16B4 0603 MVI B,3 ;CTR 4338 16B6 CDFB18 CALL FSHFT ;GO SHIFT IT 4339 16B9 C3CE18 JMP FTEST ;RETURN 4340 16BC FADDA EQU $ 4341 16BC 0603 MVI B,3 4342 16BE CDE318 CALL FSUBT ;SUBTRACT 4343 16C1 D2DD16 JNC FNORM ;BRIF NO BORROW 4344 16C4 215B22 LXI H,FACC+3 ;MUST NEGATE 4345 16C7 0603 MVI B,3 4346 16C9 37 STC 4347 16CA 7E FNEG1: MOV A,M ;GET BYTE 4348 16CB 2F CMA 4349 16CC D2D116 JNC FNEG2 4350 16CF C601 ADI 1 ;INCREMENT + COMPLEMENT=NEGATE 43511 4352 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4353+ 21:37 05/19/2019 4354+ PAGE 76 4355 4356 4357 4358 16D1 77 FNEG2: MOV M,A 4359 16D2 2B DCX H 4360 16D3 05 DCR B 4361 16D4 C2CA16 JNZ FNEG1 4362 16D7 CDDD16 CALL FNORM 4363 16DA C37A0C JMP NEG ;REVERSE SIGN 4364 ;PAGE 4365 ; 4366 16DD FNORM EQU $ 4367 ; 4368 ; 4369 ; NORMALIZE THE FLOATING ACCUMULATOR 4370 ; THAT IS, THE FIRST BIT MUST BE SIGNIFICANT 4371 ; 4372 ; 4373 16DD 215B22 LXI H,FACC+3 ;POINT LSB 4374 16E0 7E MOV A,M ;LOAD IT 4375 16E1 2B DCX H ;POINT PRIOR 4376 16E2 B6 ORA M ;MERGE 4377 16E3 2B DCX H ;POINT PRIOR 4378 16E4 B6 ORA M ;MERGE 4379 16E5 2B DCX H 4380 16E6 46 MOV B,M ;SAVE EXPONENT 4381 16E7 77 MOV M,A ;CLEAR 4382 16E8 C8 RZ ;RETURN ON NOTHING TO NORMALIZE 4383 16E9 70 MOV M,B ;RESTORE EXP 4384 16EA C5 PUSH B ;SAVE C FOR CALLER 4385 16EB CD8917 CALL SVSGN ;SAVE SIGN 4386 16EE 77 MOV M,A ;STORE EXPANDED EXPONENT 4387 16EF 23 FNRM1: INX H ;POINT TO MOST SIGN BYTE 4388 16F0 7E MOV A,M ;GET MSB 4389 16F1 B7 ORA A ;TEST IT 4390 16F2 FA0517 JM FNRM3 ;BRIF NORMALIZED 4391 16F5 23 INX H ;POINT LSB 4392 16F6 23 INX H 4393 16F7 0603 MVI B,3 ;SHIFT COUNT 4394 16F9 7E FNRM2: MOV A,M ;SHIFT LEFT 4395 16FA 17 RAL 4396 16FB 77 MOV M,A 4397 16FC 2B DCX H 4398 16FD 05 DCR B 4399 16FE C2F916 JNZ FNRM2 4400 1701 35 DCR M ;ADJUST EXPONENT 4401 1702 C3EF16 JMP FNRM1 ;LOOP 4402 1705 2B FNRM3: DCX H ;POINT BACK TO EXPONENT 4403 1706 7E MOV A,M 4404 1707 CD9117 CALL RSSGN ;RESTORE SIGN 4405 170A C1 POP B ;RESTORE C 4406 170B C9 RET 4407 ; 4408 170C FSUB EQU $ 44091 4410 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4411+ 21:37 05/19/2019 4412+ PAGE 77 4413 4414 4415 4416 ; 4417 ; 4418 ; FLOATING POINT SUBTRACT THE NUMBER AT (H,L) FROM THE FACC 4419 ; 4420 ; 4421 170C CD7A0C CALL NEG ;NEGATE FACC 4422 170F CD3716 CALL FADD ;ADD 4423 1712 CD7A0C CALL NEG ;NEGATE RESULT 4424 1715 C3CE18 JMP FTEST 4425 ;PAGE 4426 ; 4427 1718 FMUL EQU $ 4428 ; 4429 ; 4430 ; FLOATING POINT MULTIPLY THE NUMBER AT (H,L) TO THE FACC 4431 ; 4432 ; 4433 1718 CDCE18 CALL FTEST ;TEST FACC 4434 171B C8 RZ ;RETURN IF ZERO 4435 171C 23 INX H ;POINT 1ST DIGIT OF MULTIPLIER 4436 171D 7E MOV A,M ;LOAD IT 4437 171E 2B DCX H ;RESTORE 4438 171F B7 ORA A ;TEST IF ZERO 4439 1720 CA2800 JZ RST5 ;GO LOAD TO FACC IF IT IS 4440 1723 E5 PUSH H ;SAVE MULTIPLIER ADDRESS 4441 1724 CD7F17 CALL MDSGN ;GET SIGN PRODUCT, & BOTH EXPONENTS 4442 1727 80 ADD B ;ADD EXPONENTS 4443 1728 CD9117 CALL RSSGN ;RESTORE SIGN 4444 172B E1 POP H ;RESTORE 4445 172C 116522 LXI D,FTEMP+9 ;POINT TEMP STORAGE 4446 172F 0603 MVI B,3 ;BYTE COUNT 4447 1731 23 INX H ;POINT MSD 4448 1732 CD581C CALL COPYH ;MOVE MULTIPLIER 4449 1735 215C22 LXI H,FTEMP ;POINT DIGIT 7 OF RESULT 4450 1738 0606 MVI B,6 ;LOOP CTR 4451 173A CD5E1C CALL ZEROM ;GO ZERO EIGHT BYTES 4452 173D 115922 LXI D,FACC+1 ;POINT 1ST DIGIT OF ACC 4453 1740 0603 MVI B,3 ;LOOP CTR 4454 1742 1A FMUL5: LDAX D ;GET AN ACC DIGIT PAIR 4455 1743 77 MOV M,A ;PUT TO TEMP STORAGE 4456 1744 AF XRA A ;ZERO A 4457 1745 12 STAX D ;CLEAR ACC 4458 1746 13 INX D ;POINT NEXT 4459 1747 23 INX H ;DITTO 4460 1748 05 DCR B ;DECR CTR 4461 1749 C24217 JNZ FMUL5 ;LOOP 4462 174C 0E18 MVI C,24 ;OUTTER LOOP CTR 4463 174E 0603 FMUL6: MVI B,3 ;CTR 4464 1750 216522 LXI H,FTEMP+9 ;POINT MULTIPLIER 4465 1753 AF XRA A ;CLEAR CY 4466 1754 7E FMUL7: MOV A,M ;GET BYTE 44671 4468 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4469+ 21:37 05/19/2019 4470+ PAGE 78 4471 4472 4473 4474 1755 1F RAR ;SHIFT RIGHT 4475 1756 77 MOV M,A ;PUT DOWN 4476 1757 23 INX H ;POINT NEXT 4477 1758 05 DCR B ;DECR CTR 4478 1759 C25417 JNZ FMUL7 ;LOOP 4479 175C D26A17 JNC FMUL8 ;BRIF ZERO BIT 4480 175F 115E22 LXI D,FTEMP+2 ;POINT RESULT 4481 1762 216422 LXI H,FTEMP+8 ;POINT MULTIPLICAND 4482 1765 0606 MVI B,6 ;SIX BYTE ADD 4483 1767 CDF018 CALL FADDT ;GO ADD 4484 176A 0606 FMUL8: MVI B,6 ;SIZ BYTE SHIFT 4485 176C 216422 LXI H,FTEMP+8 ;POINT MULTIPLICAND 4486 176F AF XRA A ;CLEAR CY 4487 1770 7E FMUL9: MOV A,M ;GET BYTE 4488 1771 17 RAL ;SHIFT LEFT 4489 1772 77 MOV M,A ;PUT BACT 4490 1773 2B DCX H ;POINT NEXT BYTE 4491 1774 05 DCR B ;DECR CTR 4492 1775 C27017 JNZ FMUL9 ;LOOP 4493 1778 0D DCR C ;DEC BIT COUNT 4494 1779 C24E17 JNZ FMUL6 ;CONTINUE 4495 177C C3DD16 JMP FNORM ;GO NORMALIZE 4496 ; 4497 ; MDSGN GET SIGN PRODUCT AND EXPONENTS FOR MULT & DIV 4498 ; ON ENTRY: 4499 ; (HL) = ONE NUMBER 4500 ; (FACC)=THE OTHER 4501 ; ON RETURN: 4502 ; A = EXPONENT OF FACC(EXPANDED) 4503 ; B = OTHER EXPONENT 4504 ; C = SIGN PRODUCT 4505 ; HL DESTROYED 4506 ; 4507 177F CD8917 MDSGN: CALL SVSGN ;GET SIGN IN C, EXP IN A 4508 1782 47 MOV B,A ;SAVE EXPONENT 4509 1783 215822 LXI H,FACC 4510 1786 79 MOV A,C ;GET SIGN 4511 1787 86 ADD M ;MULTIPLY SIGNS 4512 1788 77 MOV M,A ;PUT DOWN 4513 ; 4514 ; SVSGN GET SIGN AND EXP 4515 ; ON ENTRY: 4516 ; (HL) = EXPONENT 4517 ; ON RETURN: 4518 ; A = EXPANDED EXPONENT 4519 ; C = SIGN IN HI ORDER BIT 4520 ; 4521 1789 7E SVSGN: MOV A,M ;GET EXPONENT 4522 178A E680 ANI 80H ;ISOLATE SIGN 4523 178C 4F MOV C,A 4524 178D 7E MOV A,M 45251 4526 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4527+ 21:37 05/19/2019 4528+ PAGE 79 4529 4530 4531 4532 178E C3DC18 JMP FEXP ;EXPAND EXP AND RETURN 4533 ; 4534 ; RSSGN RESTORE SIGN TO EXPONENT 4535 ; ON ENTRY: 4536 ; (HL)=EXPONENT 4537 ; A = EXPANDED EXPONENT 4538 ; C = SIGN 4539 ; ON RETURN: 4540 ; A = EXPONENT 4541 ; (HL) = EXPONENT WITH SIGN 4542 ; Z,M BITS SET FOR EXPONENT 4543 ; 4544 1791 CD7118 RSSGN: CALL FOVUN ;CHECK FOR OVER/UNDERFLOW 4545 1794 E67F ANI 7FH ;REMOVE EXPONENT SIGN 4546 1796 B1 ORA C ;ADD SIGN 4547 1797 77 MOV M,A ;SET DOWN 4548 1798 C3CE18 JMP FTEST ;SET Z,M BITS 4549 ;PAGE 4550 ; 4551 179B FDIV EQU $ 4552 ; 4553 ; 4554 ; FLOATING POINT DIVIDE THE NUMBER AT (H,L) INTO THE FACC 4555 ; 4556 ; 4557 179B CDCE18 CALL FTEST ;TEST IF FACC ZERO 4558 179E C8 RZ ;RETURN IF IT IS 4559 179F 23 INX H ;POINT 1ST DIGIT OF DIVISOR 4560 17A0 7E MOV A,M ;LOAD IT 4561 17A1 2B DCX H ;POINT BACK 4562 17A2 B7 ORA A ;TEST IF ZERO 4563 17A3 CA071C JZ ZMERR ;DIVISION BY ZERO = ERROR 4564 17A6 E5 PUSH H ;SAVE DIVISOR PTR 4565 17A7 CD7F17 CALL MDSGN ;GET SIGN ON STACK, EXPS INTO A,B 4566 17AA 90 SUB B ;SUBTRACT EXPONENTS 4567 17AB 3C INR A ;PLUS ONE 4568 17AC CD9117 CALL RSSGN ;SET SIGN/EXPONENT IN FACC 4569 17AF 115922 LXI D,FACC+1 4570 17B2 215C22 LXI H,FTEMP ;POINT TEMPORARY STORAGE 4571 17B5 3600 MVI M,0 ;CLEAR MSB 4572 17B7 23 INX H ;POINT NEXT 4573 17B8 0603 MVI B,3 ;LOOP CTR 4574 17BA 1A FDIV3: LDAX D ;GET BYTE FROM FACC 4575 17BB 77 MOV M,A ;PUT TO FTEMP 4576 17BC AF XRA A ;CLEAR A 4577 17BD 12 STAX D ;ZERO FACC 4578 17BE 23 INX H ;POINT NEXT 4579 17BF 13 INX D ;DITTO 4580 17C0 05 DCR B ;DECR CTR 4581 17C1 C2BA17 JNZ FDIV3 ;LOOP 4582 17C4 D1 POP D ;GET ADDR 45831 4584 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4585+ 21:37 05/19/2019 4586+ PAGE 80 4587 4588 4589 4590 17C5 0603 MVI B,3 ;LOOP CTR 4591 17C7 13 INX D ;POINT MSD OF DIVISOR 4592 17C8 3600 MVI M,0 ;CLEAR MSB 4593 17CA 23 INX H ;POINT NEXT 4594 17CB CD4D1C CALL COPYD ;GO MOVE IT 4595 17CE 0E18 MVI C,24 ;OUTER LOOP CTR 4596 17D0 115F22 FDIV5: LXI D,FTEMP+3 ;POINT DIVIDEND 4597 17D3 216322 LXI H,FTEMP+7 ;AND DIVISOR 4598 17D6 0604 MVI B,4 ;CTR 4599 17D8 CDE318 CALL FSUBT ;GO SUBTRACT 4600 17DB D2EA17 JNC FDIV6 ;BRIF NO GO 4601 17DE 115F22 LXI D,FTEMP+3 ;POINT DIVIDEND 4602 17E1 216322 LXI H,FTEMP+7 ;AND DIVISOR 4603 17E4 0604 MVI B,4 ;CTR 4604 17E6 CDF018 CALL FADDT ;GO RE-ADD 4605 17E9 37 STC ;TURN ON CY 4606 17EA 3F FDIV6: CMC ;REVERSE CY 4607 17EB 0603 MVI B,3 ;CTR 4608 17ED 215B22 LXI H,FACC+3 ;POINT LSB 4609 17F0 7E FDIV7: MOV A,M ;LOAD BYTE 4610 17F1 17 RAL ;SHIFT LEFT 4611 17F2 77 MOV M,A ;REPLACE 4612 17F3 2B DCX H ;POINT NEXT 4613 17F4 05 DCR B ;DECR CTR 4614 17F5 C2F017 JNZ FDIV7 ;LOOP 4615 17F8 AF XRA A ;CLEAR FLAGS 4616 17F9 0604 MVI B,4 ;CTR 4617 17FB 215F22 LXI H,FTEMP+3 ;POINT-DIVIDEND 4618 17FE 7E FDIV8: MOV A,M ;LOAD BYTE 4619 17FF 17 RAL ;SHIFT LEFT 4620 1800 77 MOV M,A ;REPLACE 4621 1801 2B DCX H ;POINT ENXT 4622 1802 05 DCR B ;DECR CTR 4623 1803 C2FE17 JNZ FDIV8 ;LOOP 4624 1806 0D DCR C ;DECR OTR CTR 4625 1807 C2D017 JNZ FDIV5 ;LOOP 4626 180A C3DD16 JMP FNORM ;WRAPUP 4627 ; 4628 ; UTILITY ROUTINE TO GET A VARIABLE'S ADDRESS TO H,L 4629 ; 4630 180D 112021 GETST: LXI D,STRIN ;POINT BUFFER 4631 1810 0600 MVI B,0 ;INIT CTR 4632 1812 7E MOV A,M ;GET THE CHAR 4633 1813 FE22 CPI '"' ;TEST IF LIT TYPE 4634 1815 CA2E18 JZ GETS2 ;BRIF IS 4635 1818 FE27 CPI 27H ;TEST IF QUOTED LITERAL 4636 181A CA2E18 JZ GETS2 ;BRIF IS 4637 181D FE2C GETS1: CPI ',' ;TEST IF COMMA 4638 181F CA4118 JZ GETS5 ;BRIF IS 4639 1822 B7 ORA A ;TEST IF END 4640 1823 CA4118 JZ GETS5 ;BRIF IS 46411 4642 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4643+ 21:37 05/19/2019 4644+ PAGE 81 4645 4646 4647 4648 1826 04 INR B ;COUNT IT 4649 1827 13 INX D ;POINT NEXT 4650 1828 12 STAX D ;PUT CHAR 4651 1829 23 INX H ;POINT NEXT 4652 182A CF RST 1 ;SKIP SPACES 4653 182B C31D18 JMP GETS1 ;LOOP 4654 182E 4F GETS2: MOV C,A ;SAVE DELIM 4655 182F 23 GETS3: INX H ;SKIP THE QUOTE 4656 1830 7E MOV A,M ;GET NEXT CHAR 4657 1831 B9 CMP C ;TEST IF END OF LITERAL 4658 1832 CA3F18 JZ GETS4 ;BRIF IS 4659 1835 B7 ORA A ;TEST IF END OF LINE 4660 1836 CA1F1C JZ CVERR ;BRIF IS 4661 1839 04 INR B ;COUNT IT 4662 183A 13 INX D ;POINT NEXT 4663 183B 12 STAX D ;PUT CHAR 4664 183C C32F18 JMP GETS3 ;LOOP 4665 183F 23 GETS4: INX H ;SKIP END QUOTE 4666 1840 CF RST 1 ;SKIP TRAILING SPACES 4667 1841 112021 GETS5: LXI D,STRIN ;POINT BEGIN BUFFER 4668 1844 78 MOV A,B ;GET COUNT 4669 1845 12 STAX D ;PUT COUNT 4670 1846 D1 POP D ;GET RETURN ADDR 4671 1847 EB XCHG ;FLIP/FLOP 4672 1848 E3 XTHL ;PUT RET ON STACK, HL OF VAR IN HL 4673 1849 D5 PUSH D ;SAVE H,L OF LOC 4674 184A CD3106 CALL LET2A ;GO STORE STRING 4675 184D E1 POP H ;RESTORE LOCATION 4676 184E C9 RET ;RETURN 4677 184F CDC91B GETS8: CALL VAR ;GET VAR NAME 4678 1852 D5 PUSH D ;SAVE ON STACK 4679 1853 7A MOV A,D ;GET HI BYTE 4680 1854 B7 ORA A ;TEST IF ARRAY 4681 1855 F26C18 JP GETS9 ;BRIF NOT 4682 1858 CD341B CALL SEARC ;GO GET ARRAY PARAMS 4683 185B 3EFF MVI A,0FFH ;TURN ON SW 4684 185D 327220 STA DIMSW ;SET IT 4685 1860 E3 XTHL ;SWAP ADDR ON STACK 4686 1861 CD800F CALL EXPR ;GO GET ROW, COL PTRS 4687 1864 E3 XTHL ;SWAP ADDR ON STACK 4688 1865 CD8518 CALL SUBSC ;GO POINT TO ENTRY 4689 1868 EB XCHG ;EXCHANGE 4690 1869 E1 POP H ;GET ADDRESS OF STMT 4691 186A C1 POP B ;GET NAME 4692 186B C9 RET ;RETURN 4693 186C CD341B GETS9: CALL SEARC ;FIND ADDR 4694 186F C1 POP B ;RESTORE NAME 4695 1870 C9 RET ;RETURN 4696 ; 4697 1871 FOVUN EQU $ 4698 ; 46991 4700 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4701+ 21:37 05/19/2019 4702+ PAGE 82 4703 4704 4705 4706 ; TEST EXPONENT FOR OVERFLO OR UNDERFLOW 4707 ; 4708 1871 B7 ORA A ;TEST IT 4709 1872 F27D18 JP FOV1 ;BRIF POS. 4710 1875 FEC1 CPI 0C1H ;TEST FOR MAX NEG 4711 1877 D0 RNC ;RETURN IF NO UNDER. 4712 1878 3EC1 MVI A,0C1H ;SET EXPONENT AT MINIMUM 4713 187A C32C1C JMP UNERR 4714 187D FE40 FOV1: CPI 40H ;TEST MAX POS 4715 187F D8 RC ;RETURN IF NO OVER. 4716 1880 3E3F MVI A,3FH ;SET EXPONENT AT MAXIMUM 4717 1882 C3271C JMP OVERR 4718 ; 4719 1885 SUBSC EQU $ 4720 ; 4721 ; 4722 ; COMPUTES SUBSCR ADDR 4723 ; INPUT: B HAS ROW NUMBER (1ST SUB) 4724 ; D HAS COL NUMBER (2ND SUB) 4725 ; H HAS ADDR NAME 4726 ; 4727 1885 D5 PUSH D ;SAVE COL 4728 1886 E7 RST 4 ;ADJUST H,L 4729 1887 FC DB -4 AND 0FFH ;BY FOUR 4730 1888 56 MOV D,M ;GET HI 4731 1889 2B DCX H ;POINT LO 4732 188A 5E MOV E,M ;GET LO 4733 188B 7A MOV A,D ;GET HI 4734 188C B8 CMP B ;COMPARE 4735 188D DA0F1C JC SNERR ;BRIF EXCESS 4736 1890 C29818 JNZ SUB1 ;BRIF NOT EQUAL 4737 1893 7B MOV A,E ;GET LO 4738 1894 B9 CMP C ;COMPARE 4739 1895 DA0F1C JC SNERR ;BRIF EXCESS 4740 1898 2B SUB1: DCX H ;POINT HI COLS 4741 1899 56 MOV D,M ;LOAD IT 4742 189A 2B DCX H ;POINT LO COLS 4743 189B 5E MOV E,M ;LOAD IT 4744 189C E3 XTHL ;SAVE ADDRESS 4745 189D E5 PUSH H ;SAVE SUB COL 4746 189E D5 PUSH D ;SAVE DIM COLS 4747 189F 13 INX D ;MAKE COLS=MAX+1 (ACCOUNT FOR 0 B??KE 4748 18A0 210000 LXI H,0 ;GET A ZERO 4749 18A3 78 SUB2: MOV A,B ;GET HI 4750 18A4 B1 ORA C ;PLUS LO 4751 18A5 CAAD18 JZ SUB3 ;BRIF ZERO 4752 18A8 19 DAD D ;ADD ONCE 4753 18A9 0B DCX B ;SUB ONCE 4754 18AA C3A318 JMP SUB2 ;LOOP 4755 18AD D1 SUB3: POP D ;GET DIM COL 4756 18AE C1 POP B ;GET SUB COL 47571 4758 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4759+ 21:37 05/19/2019 4760+ PAGE 83 4761 4762 4763 4764 18AF 7A MOV A,D ;GET HI 4765 18B0 B8 CMP B ;COMPARE 4766 18B1 DA0F1C JC SNERR ;BRIF GT 4767 18B4 C2BC18 JNZ SUB4 ;BRIF NOT ZERO 4768 18B7 7B MOV A,E ;GET LO 4769 18B8 B9 CMP C ;COMPARE 4770 18B9 DA0F1C JC SNERR ;BRIF GT 4771 18BC 09 SUB4: DAD B ;ADD TO PROD 4772 18BD 29 DAD H ;TIMES TWO 4773 18BE 29 DAD H ;TIMES FOUR 4774 18BF 7D MOV A,L ;GET LOW 4775 18C0 2F CMA ;COMPLEMENT 4776 18C1 C601 ADI 1 ;PLUS ONE 4777 18C3 5F MOV E,A ;SAVE IT 4778 18C4 7C MOV A,H ;GET HI 4779 18C5 2F CMA ;COMPLEMENT 4780 18C6 CE00 ACI 0 ;PLUS CARRY 4781 18C8 57 MOV D,A ;SAVE 4782 18C9 E1 POP H ;GET ADDR (0,0) 4783 18CA 19 DAD D ;COMPUTE (I,J) RIGHT SIDE 4784 18CB E7 RST 4 ;ADJUST H,L 4785 18CC FC DB -4 AND 0FFH 4786 18CD C9 RET ;RETURN 4787 18CE FTEST EQU $ 4788 ; 4789 ; TEST THE SIGN OF THE NUMBER IN THE FACC 4790 ; RETURN WITH S & Z SET TO SIGN 4791 ; 4792 18CE 3A5922 LDA FACC+1 ;GET MSD 4793 18D1 B7 ORA A ;TEST IT 4794 18D2 C8 RZ ;RETURN IF ZERO 4795 18D3 3A5822 LDA FACC ;GET SIGN&EXPON BYTE 4796 18D6 F67F ORI 7FH ;TEST SIGN BIT ONLY 4797 18D8 3A5822 LDA FACC ;RE-LOAD EXPON BYTE 4798 18DB C9 RET ;THEN RETURN 4799 18DC FEXP EQU $ 4800 ; 4801 ; EXPAND EXPONENT INTO 8 BINARY BITS 4802 ; 4803 18DC E67F ANI 7FH ;MASK MANTISA SIGN 4804 18DE C640 ADI 40H ;PROPAGATE CHAR SIGN TO LEFTMOST BIT 4805 18E0 EE40 XRI 40H ;RESTORE ORIGINAL SIGN BIT 4806 18E2 C9 RET ;RETURN 4807 ; 4808 18E3 FSUBT EQU $ 4809 ; 4810 ; SUBTRACT THE TWO MULTIPRECISION NUMBERS (D,E) & (H,L) 4811 ; 4812 18E3 AF XRA A ;TURN OF CY 4813 18E4 1A FSB1: LDAX D ;GET A BYTE 4814 18E5 9E SBB M ;SUB OTHER BYTE 48151 4816 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4817+ 21:37 05/19/2019 4818+ PAGE 84 4819 4820 4821 4822 18E6 12 STAX D ;PUT DOWN 4823 18E7 1B DCX D ;POINT NEXT 4824 18E8 2B DCX H ;DITTO 4825 18E9 05 DCR B ;DECR CTR 4826 18EA C2E418 JNZ FSB1 ;LOOP 4827 18ED C9 RET ;RETURN 4828 ; 4829 ; ADD TWO MULTI-PRECISION NUMBERS (D,E) & (H,L) 4830 ; 4831 18EE 0603 FADT3: MVI B,3 4832 18F0 AF FADDT: XRA A ;CLEAR STATUS 4833 18F1 1A FAD1: LDAX D ;GET BYTE 4834 18F2 8E ADC M ;ADD OTHER BYTE 4835 18F3 12 STAX D ;PUT DOWN 4836 18F4 1B DCX D ;POINT NEXT 4837 18F5 2B DCX H ;DITTO 4838 18F6 05 DCR B ;DECR LOOP CTR 4839 18F7 C2F118 JNZ FAD1 ;LOOP 4840 18FA C9 RET ;RETURN 4841 ; 4842 18FB FSHFT EQU $ 4843 ; 4844 ; INCREMENTING SHIFT RIGHT 4845 ; 4846 18FB 7E MOV A,M ;GET A BYTE 4847 18FC 1F RAR ;SHIFT RIGHT 4848 18FD 77 MOV M,A ;PUT DOWN 4849 18FE 23 INX H ;POINT NEXT 4850 18FF 05 DCR B ;DECR CTR 4851 1900 C2FB18 JNZ FSHFT ;LOOP 4852 1903 C9 RET ;RETURN 4853 ;PAGE 4854 ; 4855 1904 TERMI EQU $ 4856 ; 4857 ; READ A LINE FROM THE TTY 4858 ; FIRST PROMPT WITH THE CHAR IN THE A REG 4859 ; TERMINATE THE LINE WITH A X'00' 4860 ; IGNORE EMPTY LINES 4861 ; CONTROL C WILL CANCLE THE LINE 4862 ; CONTROL O WILL TOGGLE THE OUTPUT SWITCH 4863 ; RUBOUT WILL DELETE THE LAST CHAR INPUT 4864 ; 4865 ; 4866 1904 324F22 STA PROMP ;SAVE THE PROMPT CHAR 4867 1907 21CE20 REIN: LXI H,IOBUF ;POINT TO INPUT BUFFER 4868 190A 3600 MVI M,0 ;MARK BEGIN 4869 190C 23 INX H ;POINT START 4870 190D 3A4F22 LDA PROMP ;GET THE PROMPT AGAIN 4871 1910 CD4F19 CALL TESTO ;WRITE TO TERMINAL 4872 1913 FE3F CPI '?' ;TEST IF Q.M. 48731 4874 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4875+ 21:37 05/19/2019 4876+ PAGE 85 4877 4878 4879 4880 1915 C21D19 JNZ TREAD ;BRIF NOT 4881 1918 3E20 MVI A,' ' ;GET SPACE 4882 191A CD4F19 CALL TESTO ;WRITE TO TERMINAL 4883 191D TREAD EQU $ 4884 IF NOT CPM 4885 191D 1 DB03 IN TTY+1 ;GET TTY STATUS 4886 191F 1 E602 ANI 2 ;TEST IF RXRDY 4887 1921 1 CA1D19 JZ TREAD ;LOOP TIL CHAR 4888 ENDIF 4889 1924 CD3F1A CALL GETCH ;GO READ THE CHAR 4890 1927 77 MOV M,A ;PUT IN BUFFER 4891 1928 FE0A CPI 0AH ;TEST IF LINE FEED 4892 192A CA1D19 JZ TREAD ;IGNORE IF IT IS 4893 192D FE0D CPI 0DH ;TEST IF CR 4894 192F C27519 JNZ NOTCR ;BRIF NOT 4895 1932 3A7120 LDA TAPES ;GET PAPER TAPE SWITCH 4896 1935 1F RAR ;TEST IF LOAD 4897 1936 D45A19 CNC CRLF ;CR/LF IF NOT 4898 1939 3600 CR1: MVI M,0 ;MARK END 4899 193B 3A7420 LDA ILSW ;GET INPUT LINE SW 4900 193E B7 ORA A ;TEST IT 4901 193F C0 RNZ ;RETURN IF ON 4902 1940 2B DCX H ;POINT PRIOR 4903 1941 7E MOV A,M ;LOAD IT 4904 1942 FE20 CPI 20H ;TEST IF SPACE 4905 1944 CA3919 JZ CR1 ;BRIF SPACE 4906 1947 B7 ORA A ;TEST IF AT BEGINNING 4907 1948 CA0719 JZ REIN ;BRIF IS (NULL LINE) 4908 194B 21CF20 LXI H,IOBUF+1 ;POINT BEGIN 4909 194E C9 RET ;ELSE, RETURN 4910 194F TESTO EQU $ 4911 IF NOT CPM 4912 194F 1 F5 PUSH PSW ;SAVE CHAR 4913 1950 1 DB03 TEST1: IN TTY+1 ;GET STATUS 4914 1952 1 1F RAR ;TEST IF TXRDY 4915 1953 1 D25019 JNC TEST1 ;LOOP TILL READY 4916 1956 1 F1 POP PSW ;GET CHAR 4917 1957 1 D302 OUT TTY ;WRITE IT 4918 ENDIF 4919 IF CPM 4920 1 PUSH B ;BIOS CALLS DESTROYS C,DE 4921 1 PUSH D 4922 1 PUSH H 4923 1 MOV C,A ;OUTPUT BYTE 4924 1 CALL BTOUT ;CALL BIOS 4925 1 POP H 4926 1 POP D ;RESTORE 4927 1 POP B 4928 ENDIF 4929 IF LARGE ;SAVE ROOM ONLY IN 8+K VERSIONS 4930 1 DB 0,0,0 ;SAVE ROOM FOR CALL TO USER ROUTINE 49311 4932 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4933+ 21:37 05/19/2019 4934+ PAGE 86 4935 4936 4937 4938 ENDIF 4939 1959 C9 RET ;RETURN 4940 195A 3E0D CRLF: MVI A,0DH ;LOAD A CR 4941 195C CD4F19 CALL TESTO ;WRITE IT 4942 195F 3E0A MVI A,0AH ;LF 4943 1961 CD4F19 CALL TESTO ;WRITE IT 4944 1964 3EFF MVI A,255 ;GET RUBOUT CHAR 4945 1966 06FA MVI B,0FAH ;LOAD 255-RUBOUT COUNT 4946 1968 CD4F19 PAUZ: CALL TESTO ;SEND RUBOUT 4947 196B 04 INR B ;INCREMENT COUNT 4948 196C B8 CMP B ;COMPARE TO 255 4949 196D C26819 JNZ PAUZ ;SET ANOTHER RUBOUT 4950 1970 AF XRA A ;GET A ZERO 4951 1971 327622 STA COLUM ;RESET COLUMN POINTER 4952 1974 C9 RET ;RETURN 4953 1975 FE15 NOTCR: CPI 15H ;TEST IF CONTROL-U 4954 1977 C28319 JNZ NOTCO ;BRIF NOT 4955 197A CD6D1A CALL PRCNT ;GO PRINT CONTROL-U 4956 197D CD5A19 CALL CRLF ;GET CR/LF 4957 1980 C30719 JMP REIN ;GO RE-ENTER 4958 1983 FE7F NOTCO: CPI 7FH ;TEST IF RUBOUT 4959 1985 C2A619 JNZ NOTBS ;BRIF NOT 4960 1988 3A7120 LDA TAPES ;GET PAPER TAPE SW 4961 198B 1F RAR ;TEST IF LOAD 4962 198C DA1D19 JC TREAD ;IGNORE IF LOAD 4963 198F 2B DCX H ;POINT PRIOR 4964 1990 7E MOV A,M ;LOAD PREV CHAR 4965 1991 B7 ORA A ;TEST IF BEGIN 4966 1992 CAB119 JZ ECHO ;BRIF IS 4967 ; MVI A,' ' ;BACK SLASH 4968 1995 3E5C MVI A,BACKSL;*UM* FIX FOR MACRO-80 4969 1997 CD4F19 CALL TESTO ;WRITE IT 4970 199A 7E MOV A,M ;FETCH CHARACTER TO BE DISCARDED 4971 199B CD4F19 CALL TESTO ;WRITE IT 4972 ; MVI A,' ' ;BACK SLASH 4973 199E 3E5C MVI A,BACKSL;*UM* FIX FOR MACRO-80 4974 19A0 CD4F19 CALL TESTO ;WRITE IT 4975 19A3 C31D19 JMP TREAD ;GET REPLACEMENT CHARACTER 4976 19A6 NOTBS EQU $ 4977 IF LARGE ;CONTROL H WORKS ONLY ON 9K VERSION 4978 1 CPI 8 ;TEST FOR ASCII BACKSPACE 4979 1 JNZ NOTCH ;BRIF NOT CONTROL H 4980 1 DCX H ;POINT PRIOR 4981 1 MOV A,M ;FETCH CHARACTER 4982 1 ORA A ;TEST FOR BEGINNING 4983 1 JZ ECHO ;BRIF IT IS 4984 1 PUSH H ;SAVE POSITION 4985 1 LXI H,RBOUT ;POINT RUBOUT SEQUENCE 4986 1 CALL TERMM ;WRITE IT 4987 1 POP H ;RESTORE H,L 4988 1 JMP TREAD ;GET REPLACEMENT CHARACTER 49891 4990 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 4991+ 21:37 05/19/2019 4992+ PAGE 87 4993 4994 4995 4996 ENDIF 4997 19A6 3A7120 NOTCH: LDA TAPES ;GET PAPER TAPE SWITCH 4998 19A9 1F RAR ;FLAG TO CARRY 4999 19AA DAB119 JC ECHO ;NO ECHO IF TAPE 5000 19AD 7E MOV A,M ;ELSE, LOAD THE CHAR 5001 19AE CD4F19 CALL TESTO ;ECHO THE CHARCTER 5002 19B1 23 ECHO: INX H ;POINT NEXT POSIT 5003 19B2 C31D19 JMP TREAD ;LOOP FOR NEXT 5004 ; 5005 19B5 TERMO EQU $ 5006 ; 5007 ; TTY PRINT ROUTINE 5008 ; 5009 ; OUTPUT STRING OF CHARS 5010 ; STARTING AT IOBUF +0 THRU END (FF OR FE OR 00) 5011 ; FOLLOWING IMBEDDED CHARACTERS ARE INTERPRETED AS CONTROLS: 5012 ; X'00' END OF BUFFER, TYPE CR/LF AND RETURN 5013 ; X'FE' END OF BUFFER, RETURN (NO CR/LF) 5014 ; X'FD' TYPE CR/LF, CONTINUE 5015 ; 5016 ; RETURN WITHOUT OUTPUT IF OUTPUT SW IS OFF 5017 ; 5018 19B5 3A7320 LDA OUTSW ;GET OUTPUT SW 5019 19B8 B7 ORA A ;TEST IT 5020 19B9 C0 RNZ ;RETURN IF NO PRINT 5021 19BA 21CE20 LXI H,IOBUF ;POINT I/O BUFFER 5022 19BD 7E OT1: MOV A,M ;LOAD A BYTE 5023 19BE FEFE CPI 0FEH ;SEE IF END OF LINE (NO CR/LF) 5024 19C0 C8 RZ ;RETURN IF EQUAL 5025 19C1 FEFD CPI 0FDH ;SEE IF IMBEDDED CR/LF 5026 19C3 C2CC19 JNZ OT2 ;BRIF NOT 5027 19C6 CD5A19 CALL CRLF ;LINE FEED 5028 19C9 C3DB19 JMP OT4 ;CONTINUE 5029 19CC B7 OT2: ORA A ;TEST IF END OF OUTPUT 5030 19CD CA5A19 JZ CRLF ;BRIF IS 5031 19D0 7E MOV A,M ;LOAD THE BYTE 5032 19D1 CD4F19 CALL TESTO ;TYPE IT 5033 19D4 3A7622 LDA COLUM ;GET COLUMN POINTER 5034 19D7 3C INR A ;ADD ONE 5035 19D8 327622 STA COLUM ;RESTORE IT 5036 19DB 23 OT4: INX H ;POINT NEXT 5037 19DC C3BD19 JMP OT1 ;LOOP 5038 19BD TERMM EQU OT1 5039 ; 5040 19DF TABST EQU $ 5041 ; 5042 ; 5043 ; POSITION TTY AT NEXT TAB STOP 5044 ; 5045 ; 5046 19DF 3A7320 LDA OUTSW ;GET OUTPUT SWITCH 50471 5048 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5049+ 21:37 05/19/2019 5050+ PAGE 88 5051 5052 5053 5054 19E2 B7 ORA A ;TEST IT 5055 19E3 C0 RNZ ;RETURN IF SUPPRESSED 5056 19E4 3A7622 LDA COLUM ;GET COLUMN POINTER 5057 19E7 FE38 CPI 56 ;COMPARE TO 56 5058 19E9 D25A19 JNC CRLF ;BRIF NO ROOM LEFT 5059 19EC 47 MOV B,A ;SAVE IT 5060 19ED AF XRA A ;INIT POSITION 5061 19EE B8 TBLP: CMP B ;COMPARE 5062 19EF CAF519 JZ TBLP2 5063 19F2 D2FA19 JNC TBON ;BRIF SHY OF TAB 5064 19F5 C60E TBLP2: ADI 14 ;POINT NEXT STOP 5065 19F7 C3EE19 JMP TBLP ;LOOP 5066 19FA 327622 TBON: STA COLUM ;UPDATE CTR 5067 19FD 90 SUB B ;COMPUTE NUMBER OF SPACES 5068 19FE 47 MOV B,A ;SAVE IT 5069 19FF 3E20 TBSPA: MVI A,' ' ;SPACE TO REG A 5070 1A01 CD4F19 CALL TESTO ;OUTPUT IT 5071 1A04 05 DCR B ;SUB 1 FROM CTR 5072 1A05 C8 RZ ;RETURN IF ZERO 5073 1A06 C3FF19 JMP TBSPA ;ELSE, LOOP 5074 ; 5075 1A09 LINEO EQU $ 5076 ; 5077 ; UNPACK LINE NUMBER FROM (H,L) TO (D,E) 5078 ; ZERO SUPPRESS LEADING ZEROS 5079 ; 5080 ; 5081 1A09 C5 PUSH B ;PUSH B,C 5082 1A0A 0601 MVI B,1 ;SET SWITCH 5083 1A0C CD141A CALL LOUT ;GO FORMAT 2 BYTES 5084 1A0F CD141A CALL LOUT ;THEN THE NEXT 2 5085 1A12 C1 POP B ;RESTORE B,C 5086 1A13 C9 RET ;RETURN 5087 ; 5088 1A14 LOUT EQU $ 5089 1A14 7E MOV A,M ;GET BYTE 5090 1A15 E6F0 ANI 0F0H ;ISOLATE LEFT HALF 5091 1A17 1F RAR ;SHIFT RIGHT 1 BIT 5092 1A18 1F RAR ;AGAIN 5093 1A19 1F RAR ;AGAIN 5094 1A1A 1F RAR ;LAST TIME 5095 1A1B C2221A JNZ NOTZ1 ;BRIF NOT ZERO 5096 1A1E B0 ORA B ;MERGE IN B 5097 1A1F C2281A JNZ Z1 ;BRIF ZERO 5098 1A22 0600 NOTZ1: MVI B,0 ;RESET SWITCH 5099 1A24 F630 ORI 30H ;ZONE 5100 1A26 12 STAX D ;PUT TO BUFFER 5101 1A27 13 INX D ;POINT NEXT 5102 1A28 7E Z1: MOV A,M ;LOAD BYTE 5103 1A29 E60F ANI 0FH ;MASK 5104 1A2B C2321A JNZ NOTZ2 ;BRIF NOT ZERO 51051 5106 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5107+ 21:37 05/19/2019 5108+ PAGE 89 5109 5110 5111 5112 1A2E B0 ORA B ;MERGE SWITCH 5113 1A2F C2381A JNZ Z2 ;BRIF ZERO 5114 1A32 0600 NOTZ2: MVI B,0 ;SET SWITCH OFF 5115 1A34 F630 ORI 30H ;ZONE 5116 1A36 12 STAX D ;PUT TO BUFFER 5117 1A37 13 INX D ;POINT TO NEXT 5118 1A38 23 Z2: INX H ;AND NEXT LINE BYTE 5119 1A39 C9 RET ;RETURN 5120 ; 5121 1A3A TSTCC EQU $ 5122 ; 5123 ; TEST IF KEY WAS PRESSED DURING EXECUTION 5124 ; CANCEL IF CONTROL-C 5125 ; TOGGLE OUTPUT SUPPRESS SW IF CONTROL-O 5126 ; 5127 IF NOT CPM 5128 1A3A 1 DB03 IN TTY+1 ;GET TTY STATUS 5129 1A3C 1 E602 ANI 2 ;MASK FOR RXRDY 5130 1A3E 1 C8 RZ ;RETURN IF NO CHAR 5131 1A3F 1 DB02 GETCH: IN TTY ;READ THE CHAR 5132 1A41 1 E67F ANI 7FH ;TURN OFF PARITY 5133 ENDIF 5134 IF CPM 5135 1 ;NOTE: FOLLOWING CLOBBERS REGISTERS, 5136 1 ; PUSH AND POP IF FOUND TO CREATE BUGS. 5137 1 CALL BTSTAT ;CALL BIOS 5138 1 RZ ;RETURN ON NO CHAR 5139 1 GETCH: PUSH B ;SAVE REGS - CPM CAN CLOBBER 5140 1 PUSH D 5141 1 PUSH H 5142 1 CALL BTIN ;CALL BIOS TO INPUT 5143 1 POP H 5144 1 POP D 5145 1 POP B 5146 ENDIF 5147 1A43 FE03 CPI 3 ;TEST IF CONTROL C 5148 1A45 C25E1A JNZ TSTC1 ;BRIF NOT 5149 1A48 CD6D1A CALL PRCNT ;GO PRINT CONTROL-C 5150 1A4B 3A7620 LDA EDSW ;GET MODE SW 5151 1A4E B7 ORA A ;TEST IT 5152 1A4F C2DC01 JNZ KEY ;**;BRIF COMMAND MODE 5153 1A52 212D1E LXI H,STOPM ;POINT MSG 5154 1A55 CDBD19 CALL TERMM ;GO PRINT IT 5155 1A58 CDF11B CALL PRLIN ;GO PRINT LINE 5156 1A5B C3DC01 JMP KEY ;GOTO READY 5157 1A5E FE0F TSTC1: CPI 0FH ;TEST IF CONTROL O 5158 1A60 C0 RNZ ;RETURN IF NOT 5159 1A61 CD6D1A CALL PRCNT ;GO PRINT CONTROL-O 5160 1A64 3A7320 LDA OUTSW ;GET OUTPUT SWTICH 5161 1A67 EE01 XRI 1 ;TOGGLE 5162 1A69 327320 STA OUTSW ;PUT SW 51631 5164 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5165+ 21:37 05/19/2019 5166+ PAGE 90 5167 5168 5169 5170 1A6C C9 RET ;RETURN 5171 ; 5172 1A6D PRCNT EQU $ 5173 ; 5174 ; 5175 ; PRINTS AND CHAR 5176 ; 5177 1A6D F5 PUSH PSW ;SAVE CHAR 5178 ; MVI A,' ' ;GET UP ARROW 5179 1A6E 3E5E MVI A,UPARR ;*UM* FIX FOR MACRO-80 5180 1A70 CD4F19 CALL TESTO ;WRITE IT 5181 1A73 F1 POP PSW ;GET CHAR 5182 1A74 C640 ADI 64 ;TRNSLATE 5183 1A76 C34F19 JMP TESTO ;WRITE IT 5184 ;PAGE 5185 ; 5186 1A79 COMP2 EQU $ 5187 ; 5188 ; CONTINUATION OF COMPARE (RST 2) ROUTINE 5189 ; 5190 1A79 B7 ORA A ;TEST IT 5191 1A7A C2811A JNZ COMP5 ;BRIF NOT END 5192 1A7D AF COMP3: XRA A ;SET EQUAL STATUS 5193 1A7E 7E COMP4: MOV A,M ;GET LAST CHAR 5194 1A7F C1 POP B ;RESTORE B,C 5195 1A80 C9 RET ;RETURN 5196 1A81 BE COMP5: CMP M ;COMPARE THE TWO CHARS 5197 1A82 CA8E1A JZ COMP6 ;BRIF EQUAL 5198 1A85 78 MOV A,B ;GET COUNT 5199 1A86 FE03 CPI 3 ;GET IF >= 3 5200 1A88 D27D1A JNC COMP3 ;BRIF NOT LESS THAN 3 5201 1A8B C37E1A JMP COMP4 ;BRIF LESS THAN 3 AND NOT EQUAL 5202 1A8E 04 COMP6: INR B ;COUNT IT 5203 1A8F 13 INX D ;POINT NEXT LIT 5204 1A90 23 INX H ;POINT NEXT VAR 5205 1A91 C31300 JMP COMP1 ;CONTINUE 5206 ; 5207 1A94 EOL EQU $ 5208 ; 5209 ; TESTS IF (H,L) IS END OF LINE 5210 ; ERROR-DL IF NOT 5211 ; 5212 1A94 CF RST 1 ;SKIP TO NON-BLANK 5213 1A95 CDA81A CALL TSTEL ;TEST IF END LINE 5214 1A98 C20F1C JNZ SNERR ;ERROR IF NOT 5215 1A9B FE3A CPI ':' ;TEST FOR MULTIPLE STATEMENT 5216 1A9D C2A31A JNZ EOL1 ;BRIF NOT 5217 1AA0 327422 STA MULTI ;SET SWITCH 5218 1AA3 23 EOL1: INX H ;POINT NEXT 5219 1AA4 227222 SHLD ENDLI ;SAVE POINTER 5220 1AA7 C9 RET ;RETURN 52211 5222 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5223+ 21:37 05/19/2019 5224+ PAGE 91 5225 5226 5227 5228 ; 5229 1AA8 TSTEL EQU $ 5230 ; 5231 ; TEST (H,L) FOR END OF STATEMENT (00H OR ':') 5232 ; RETURN WITH Z SET IF IT IS 5233 ; 5234 1AA8 B7 ORA A ;TEST FOR ZERO 5235 1AA9 C8 RZ ;RETURN IF IS 5236 1AAA FE3A CPI ':' ;TEST FOR MULTIPLE STATEMENT 5237 1AAC C9 RET ;RETURN 5238 ; 5239 1AAD NOTEO EQU $ 5240 ; 5241 ; 5242 ; TEST IF (H,L) IS END OF LINE 5243 ; RETURN IF NOT, ERROR-DL IF IS 5244 ; 5245 1AAD CF RST 1 ;SKIP TO NON-BLANK 5246 1AAE CDA81A CALL TSTEL ;TEST IF END OF LINE 5247 1AB1 CA0F1C JZ SNERR ;ERROR IF IS 5248 1AB4 C9 RET ;ELSE, RETURN 5249 ; 5250 1AB5 PACK EQU $ 5251 ; 5252 ; PACK LINE NUMBER FROM (H,L) TO B,C 5253 ; 5254 ; 5255 1AB5 010000 LXI B,0 ;CLEAR B AND C 5256 1AB8 3E04 MVI A,4 ;INIT DIGIT COUNTER 5257 1ABA 328D22 STA PRSW ;SAVE A 5258 1ABD 7E PK1: MOV A,M ;GET CHAR 5259 1ABE CD2A1B CALL NUMER ;TEST FOR NUMERIC 5260 1AC1 C0 RNZ ;RETURN IF NOT NUMERIC 5261 1AC2 E60F ANI 0FH ;STRIP OFF ZONE 5262 1AC4 57 MOV D,A ;SAVE IT 5263 1AC5 3A8D22 LDA PRSW ;GET COUNT 5264 1AC8 3D DCR A ;SUBTRACT ONE 5265 1AC9 FA0F1C JM SNERR ;BRIF ERROR 5266 1ACC 328D22 STA PRSW ;SAVE CTR 5267 1ACF 1E04 MVI E,4 ;4 BIT SHIFT LOOP 5268 1AD1 79 PK3: MOV A,C ;GET LOW BYTE 5269 1AD2 17 RAL ;ROTATE LEFT 1 BIT 5270 1AD3 4F MOV C,A ;REPLACE 5271 1AD4 78 MOV A,B ;GET HIGH BYTE 5272 1AD5 17 RAL ;ROTATE LEFT 1 BIT 5273 1AD6 47 MOV B,A ;REPLACE 5274 1AD7 1D DCR E ;DECR CTR 5275 1AD8 C2D11A JNZ PK3 ;LOOP 5276 1ADB 79 MOV A,C ;GET LOW 5277 1ADC B2 ORA D ;PUT DIGIT IN RIGHT HALF OF BYTE 5278 1ADD 4F MOV C,A ;REPLACE 52791 5280 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5281+ 21:37 05/19/2019 5282+ PAGE 92 5283 5284 5285 5286 1ADE 23 INX H ;POINT NEXT BYTE 5287 1ADF C3BD1A JMP PK1 ;LOOP 5288 ; 5289 1AE2 SQUIS EQU $ 5290 ; 5291 ; COMPRESS THE EXPR STACK 5292 ; REG A CONTAINS # OF BYTES TO REMOVE STARTING AT (H,L+1) 5293 ; CONTAINS TOTAL NUMBER OF CHARACTERS IN STACK THUS FAR 5294 ; 5295 1AE2 E5 PUSH H ;SAVE H,L 5296 1AE3 5F MOV E,A ;COUNT TO E 5297 1AE4 1600 MVI D,0 ;ZERO HI BYTE 5298 1AE6 19 DAD D ;COMPUTE START 5299 1AE7 EB XCHG ;PUT TO D,E 5300 1AE8 E1 POP H ;GET H,L 5301 1AE9 2F CMA ;COMPLEMENT COUNT 5302 1AEA 3C INR A ;THEN 2'S COMPLEMENT 5303 1AEB 80 ADD B ;COMPUTE B-A 5304 1AEC 47 MOV B,A ;PUT TO B 5305 1AED 13 SQUI2: INX D ;POINT NEXT SEND 5306 1AEE 23 INX H ;POINT NEXT RECEIVE 5307 1AEF 1A LDAX D ;GET A CHAR 5308 1AF0 77 MOV M,A ;PUT IT DOWN 5309 1AF1 05 DCR B ;DECR CTR 5310 1AF2 C2ED1A JNZ SQUI2 ;LOOP 5311 1AF5 225022 SHLD EXPRS ;UPDATE NEW START OF EXPR 5312 1AF8 C9 RET ;RETURN 5313 ; 5314 1AF9 SKP2Z EQU $ 5315 ; 5316 ; FIND END OF LITERAL IN (D,E) 5317 ; 5318 1AF9 1A LDAX D ;GET BYTE OF LIT 5319 1AFA B7 ORA A ;TEST IT 5320 1AFB C8 RZ ;RETURN IF ZERO (END) 5321 1AFC 13 INX D ;ELSE, POINT NEXT 5322 1AFD C3F91A JMP SKP2Z ;LOOP 5323 ; 5324 1B00 GTEMP EQU $ 5325 ; 5326 ; GETS FOUR BYTE TEMPORARY STORAGE AREA, 5327 ; STORES THE FACC THERE, 5328 ; PUTS ADDR OF AREA IN EXPR STACK (H,L) 5329 ; 5330 1B00 EB XCHG ;SAVE H,L IN D,E 5331 1B01 E3 XTHL ;EXCHANGE 0 AND RET ADDR 5332 1B02 E5 PUSH H ;PUT NEW RET ADDR 5333 1B03 E5 PUSH H ;DOIT IT AGAIN 5334 1B04 210000 LXI H,0 ;ZERO H,L 5335 1B07 39 DAD SP ;GET SP ADDR IN H,L 5336 1B08 23 INX H ;PLUS ONE 53371 5338 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5339+ 21:37 05/19/2019 5340+ PAGE 93 5341 5342 5343 5344 1B09 23 INX H ;PLUS ONE MORE (POINT TO NEW AREA) 5345 1B0A C5 PUSH B ;SAVE CTRS 5346 1B0B D5 PUSH D ;SAVE EXPR ADDR 5347 1B0C E5 PUSH H ;SAVE TEMP ADDR 5348 1B0D DF RST 3 ;GO STORE FACC 5349 1B0E D1 POP D ;RESTORE TEMP ADDR 5350 1B0F 2A6922 LHLD SPCTR ;GET COUNT 5351 1B12 23 INX H ;PLUS ONE 5352 1B13 23 INX H ;ONE MORE 5353 1B14 226922 SHLD SPCTR ;PUT BACK 5354 1B17 E1 POP H ;RESTORE EXPR ADDR 5355 1B18 C1 POP B ;RESTORE CTRS 5356 1B19 23 SADR: INX H ;POINT NEXT BYTE 5357 1B1A 72 MOV M,D ;HIGH BYTE TO EXPRSTK 5358 1B1B 23 INX H ;POINT NEXT 5359 1B1C 73 MOV M,E ;LOW BYTE TO EXPR STK 5360 1B1D 23 INX H ;POINT NEXT 5361 1B1E 36E3 MVI M,0E3H ;CODE = NUMERIC DATA 5362 1B20 C9 RET ;RETURN 5363 ; 5364 1B21 ALPHA EQU $ 5365 ; 5366 ; TESTS THE CHAR AT (H,L) 5367 ; RETURNS WITH Z SET IF CHAR IS ALPHA (A-Z) 5368 ; RETURNS WITH Z OFF IF NOT ALPHA 5369 ; CHAR IS LEFT IN REG A 5370 ; 5371 1B21 7E MOV A,M ;PUT CHAR TO REG A 5372 1B22 FE41 CPI 'A' ;TEST IF A OR HIGHER 5373 1B24 D8 RC ;RETURN IF NOT ALPHA (Z IS OFF) 5374 1B25 FE5A CPI 'Z' ;TEST IF Z OR LESS 5375 1B27 C3301B JMP NUMEN ;GO WRAPUP 5376 ; 5377 1B2A NUMER EQU $ 5378 ; 5379 ; TESTS THE CHAR AT (H,L) 5380 ; RETURNS WITH Z SET IF NUMERIC (0-9) 5381 ; ELSE Z IS OFF 5382 ; CHAR IS LEFT IN THE A REG 5383 ; 5384 1B2A 7E MOV A,M ;GET CHAR TO REG A 5385 1B2B FE30 CPI '0' ;TEST IF ZERO OR GREATER 5386 1B2D D8 RC ;RETURN IF LESS THAN ZERO 5387 1B2E FE39 CPI '9' ;TEST IF 9 OR LESS 5388 1B30 C8 NUMEN: RZ ;RETURN IF 9 5389 1B31 D0 RNC ;RETURN IF NOT NUMERIC 5390 1B32 BF CMP A ;SET Z 5391 1B33 C9 RET ;RETURN 5392 ; 5393 1B34 SEARC EQU $ 5394 ; 53951 5396 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5397+ 21:37 05/19/2019 5398+ PAGE 94 5399 5400 5401 5402 ; SEARCHES FOR THE VARIABLE IN D,E 5403 ; RETURNS WITH ADDR OF DATA AREA FOR VARIABLE 5404 ; 5405 1B34 E5 PUSH H ;SAVE H,L 5406 1B35 3A8822 LDA FNMOD ;GET FUNCTION MODE 5407 1B38 B7 ORA A ;TEST IT 5408 1B39 C28F1B JNZ SCH6 ;BRIF IN A FUNCTION 5409 1B3C 2A9122 SCH0: LHLD DATAB ;GET ADDR OF DATA POOL 5410 1B3F 7E SCH1: MOV A,M ;GET THE BYTE 5411 1B40 B7 ORA A ;TEST IF END 5412 1B41 CA651B JZ SCH3 ;BRIF END 5413 1B44 2B DCX H ;POINT NEXT 5414 1B45 2B DCX H ;DITTO 5415 1B46 46 MOV B,M ;GET HI LEN 5416 1B47 2B DCX H ;POINT NEXT 5417 1B48 4E MOV C,M ;GET LO LEN 5418 1B49 E7 RST 4 ;ADJUST H,L 5419 1B4A 03 DB 3 5420 1B4B 7E MOV A,M ;LOAD 1ST CHAR 5421 1B4C BA CMP D ;COMPARE 1ST CHAR 5422 1B4D C2611B JNZ SCH2 ;BRIF NOT EQUAL 5423 1B50 2B DCX H ;POINT NEXT 5424 1B51 7E MOV A,M ;LOAD 2ND DIGIT 5425 1B52 23 INX H ;POINT BACK 5426 1B53 BB CMP E ;COMPARE 2ND CHAR 5427 1B54 C2611B JNZ SCH2 ;BRIF NOT EQUAL 5428 1B57 7A MOV A,D ;GET HI NAME 5429 1B58 B7 ORA A ;TEST IT 5430 1B59 FAC41B JM SCH9 ;RETURN IF MATRIX 5431 1B5C 09 DAD B ;POINT NEXT ENTRY 5432 1B5D 23 INX H ;PLUS ONE 5433 1B5E EB XCHG ;FLIP/FLOP 5434 1B5F E1 POP H ;RESTORE H 5435 1B60 C9 RET ;RETURN 5436 1B61 09 SCH2: DAD B ;MINUS LEN 5437 1B62 C33F1B JMP SCH1 ;LOOP 5438 1B65 72 SCH3: MOV M,D ;PUT 1ST CHAR 5439 1B66 2B DCX H ;POINT NEXT 5440 1B67 73 MOV M,E ;PUT 2ND CHAR 5441 1B68 2B DCX H ;POINT NEXT 5442 1B69 7A MOV A,D ;GET HI NAME 5443 1B6A B7 ORA A ;TEST IT 5444 1B6B FAA31B JM SCH7 ;BRIF ARRAY 5445 1B6E 36FF MVI M,0FFH ;HI LEN 5446 1B70 2B DCX H ;POINT NEXT 5447 1B71 7B MOV A,E ;GET LO NAME 5448 1B72 B7 ORA A ;TEST TYPE 5449 1B73 FA7D1B JM SCH4 ;BRIF CHAR 5450 1B76 36F8 MVI M,0F8H ;LO LEN 5451 1B78 0604 MVI B,4 ;LOOP CTR 5452 1B7A C3811B JMP SCH5 ;BRARND 54531 5454 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5455+ 21:37 05/19/2019 5456+ PAGE 95 5457 5458 5459 5460 1B7D 36FB SCH4: MVI M,0FBH ;LO LEN 5461 1B7F 0601 MVI B,1 ;LOOP CTR 5462 1B81 2B SCH5: DCX H ;POINT NEXT 5463 1B82 3600 MVI M,0 ;ZERO THE VALUE 5464 1B84 05 DCR B ;DECR CTR 5465 1B85 C2811B JNZ SCH5 ;LOOP 5466 1B88 2B DCX H ;POINT NEXT 5467 1B89 3600 MVI M,0 ;MARK NEW END 5468 1B8B 23 INX H ;POINT ADDR OF VARIABLE 5469 1B8C EB XCHG ;PUT LOCATION TO D,E 5470 1B8D E1 POP H ;RESTORE H,L 5471 1B8E C9 RET ;RETURN 5472 1B8F 216C22 SCH6: LXI H,FNARG ;POINT DUMMY ARG 5473 1B92 7E MOV A,M ;LOAD 1ST CHAR 5474 1B93 BA CMP D ;COMPARE 5475 1B94 C23C1B JNZ SCH0 ;BRIF NOT EQUAL 5476 1B97 23 INX H ;POINT NEXT 5477 1B98 7E MOV A,M ;LOAD 2ND CHAR 5478 1B99 BB CMP E ;COMPARE 5479 1B9A C23C1B JNZ SCH0 ;BRIF NOT EQUAL 5480 1B9D 23 INX H ;POINT NEXT 5481 1B9E 56 MOV D,M ;GET HI ADDR 5482 1B9F 23 INX H ;POINT NEXT 5483 1BA0 5E MOV E,M ;GET LO ADDR 5484 1BA1 E1 POP H ;RESTORE H,L 5485 1BA2 C9 RET ;RETURN 5486 1BA3 E5 SCH7: PUSH H ;SAVE ADDRESS 5487 1BA4 36FE MVI M,0FEH ;MOVE HI DISP 5488 1BA6 2B DCX H ;POINT NEXT 5489 1BA7 3614 MVI M,14H ;MOVE LO DISP 5490 1BA9 2B DCX H 5491 1BAA 3600 MVI M,0 ;MOVE A ZERO 5492 1BAC 2B DCX H ;POINT NEXT 5493 1BAD 360A MVI M,10 ;MOVE 10 5494 1BAF 2B DCX H ;POINT NEXT 5495 1BB0 3600 MVI M,0 ;MOVE A ZERO 5496 1BB2 2B DCX H ;POINT NEXT 5497 1BB3 360A MVI M,10 ;MOVE A 10 (DEFAULT IS 10 X 10) 5498 1BB5 01E501 LXI B,485 ;TOTAL # OF BYTES TAKEN BY ARRAY 5499 1BB8 2B SCH8: DCX H ;POINT NEXT 5500 1BB9 3600 MVI M,0 ;CLEAR ONE BYTE 5501 1BBB 0B DCX B ;DCR CTR 5502 1BBC 78 MOV A,B ;GET HI 5503 1BBD B1 ORA C ;PLUS LO 5504 1BBE C2B81B JNZ SCH8 ;LOOP 5505 1BC1 E1 POP H ;RESTORE PTR TO START 5506 1BC2 23 INX H ;POINT LO NAME 5507 1BC3 23 INX H ;POINT HI NAME 5508 1BC4 C1 SCH9: POP B ;NEED TO XCHANGE LAST 2 STACK ENTRIES 5509 1BC5 D1 POP D ;SO DOIT 5510 1BC6 C5 PUSH B 55111 5512 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5513+ 21:37 05/19/2019 5514+ PAGE 96 5515 5516 5517 5518 1BC7 D5 PUSH D 5519 1BC8 C9 RET ;RETURN 5520 ; 5521 1BC9 VAR EQU $ 5522 ; 5523 ; 5524 ; TEST (H,L) FOR A VARIABLE NAME 5525 ; PUTS THE NAME IN D,E IF FOUND 5526 ; ERROR SN IF NONE FOUND 5527 ; 5528 1BC9 CF RST 1 ;SKIP TO NON-BLANK 5529 1BCA CD211B CALL ALPHA ;TEST IF ALPHA 5530 1BCD C20F1C JNZ SNERR ;BRIF NOT ALPHA 5531 1BD0 57 MOV D,A ;FIRST CHAR 5532 1BD1 1E20 MVI E,' ' ;DEFAULT 5533 1BD3 23 INX H ;POINT NEXT 5534 1BD4 CF RST 1 ;GET 2ND CHAR 5535 1BD5 CD2A1B CALL NUMER ;TEST IF NUMERIC 5536 1BD8 C2DE1B JNZ VAR2 ;BRIF NOT NUMERIC 5537 1BDB 5F MOV E,A ;SAVE 2ND CHAR 5538 1BDC 23 INX H ;POINT NEXT 5539 1BDD CF RST 1 ;GET NON-BLANK FOLLOWING 5540 1BDE FE24 VAR2: CPI '$' ;TEST IF STRING 5541 1BE0 C2E91B JNZ VAR3 ;BRIF NOT 5542 1BE3 7B MOV A,E ;GET 2ND CHAR 5543 1BE4 F680 ORI 80H ;SET TYPE 5544 1BE6 5F MOV E,A ;SAVE IT 5545 1BE7 23 INX H ;SKIP $ 5546 1BE8 C9 RET ;THEN RETURN 5547 1BE9 FE28 VAR3: CPI '(' ;TEST IF ARRAY 5548 1BEB C0 RNZ ;RETURN IF NOT 5549 1BEC 7A MOV A,D ;GET HI NAME 5550 1BED F680 ORI 80H ;TURN ON D7 5551 1BEF 57 MOV D,A ;RESTORE 5552 1BF0 C9 RET ;RETURN 5553 ; 5554 1BF1 PRLIN EQU $ 5555 ; 5556 ; PRINTS LINE NUMBER FOLLOWED BY CR/LF 5557 ; 5558 1BF1 117720 LXI D,LINEN ;POINT AREA 5559 1BF4 2A8922 LHLD LINE ;GET ADDR OF LINE NUMBER 5560 1BF7 CD091A CALL LINEO ;GO UNPACK 5561 1BFA EB XCHG ;PUT TO H,L 5562 1BFB 3600 MVI M,0 ;END OF MSG 5563 1BFD 217720 LXI H,LINEN ;POINT AREA 5564 1C00 C3BD19 JMP TERMM ;GO PRINT IT 5565 ;PAGE 5566 ; 5567 ; ERROR MESSAGE ROUTINES 5568 ; FATAL ERROR MUST BE FIRST 55691 5570 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5571+ 21:37 05/19/2019 5572+ PAGE 97 5573 5574 5575 5576 ; 5577 00FE EM EQU 0FEH 5578 ; 5579 1C03 F7 ULERR: RST 6 5580 1C04 554CFEF7 DB 'UL',EM,FATAL ;NOTE FATAL = CODE FOR RST 6 5581 1C07 ZMERR EQU $-1 ;LOG(X<=0),SQR(-X),0 DIVIDE 5582 1C08 4F46FEF7 DB 'OF',EM,FATAL 5583 1C0B STERR EQU $-1 ;ERROR IN EXPRESSION STACK 5584 1C0C 5354FEF7 DB 'ST',EM,FATAL 5585 1C0F SNERR EQU $-1 ;DELIMITER ERROR 5586 1C10 534EFEF7 DB 'SN',EM,FATAL 5587 1C13 RTERR EQU $-1 ;RETURN & NO GOSUB 5588 1C14 5254FEF7 DB 'RT',EM,FATAL 5589 1C17 DAERR EQU $-1 ;OUT OF DATA 5590 1C18 4441FEF7 DB 'DA',EM,FATAL 5591 1C1B NXERR EQU $-1 ;NEXT & NO FOR / >8 FOR'S 5592 1C1C 4E58FEF7 DB 'NX',EM,FATAL 5593 1C1F CVERR EQU $-1 ;CONVERSION ERROR 5594 1C20 4356FEF7 DB 'CV',EM,FATAL 5595 1C23 CKERR EQU $-1 ;CHECKSUM ERROR 5596 1C24 434BFEF7 DB 'CK',EM,FATAL 5597 ; 5598 ; NON-FATAL ERRORS 5599 ; 5600 1C27 OVERR EQU $-1 ;OVERFLOW ERROR 5601 1C28 4F56FE DB 'OV',EM 5602 1C2B C9 RET ;RETURN TO ROUTINE 5603 1C2C F7 UNERR: RST 6 ;CALL ERROR ROUTINE 5604 1C2D 554EFE DB 'UN',EM 5605 1C30 C9 RET 5606 ; 5607 ; CONTINUATION OF ERROR MESSAGE ROUTINE (RST 6) 5608 ; 5609 1C31 CDBD19 ERROR: CALL TERMM ;PRINT 'XX' 5610 1C34 E5 PUSH H ;SAVE RETURN 5611 1C35 213C1E LXI H,ERRMS ;PRINT 'ERROR IN LINE' 5612 1C38 CDBD19 CALL TERMM 5613 1C3B CDF11B CALL PRLIN ;PRINT LINE # 5614 1C3E E1 POP H 5615 1C3F 23 INX H ;RETURN ADDRESS 5616 1C40 7E MOV A,M ;GET INSTRUCTION 5617 1C41 FEF7 CPI FATAL ;IS IT AN RST 6? 5618 1C43 CADC01 JZ KEY ;IF ZERO, YES, ABORT 5619 1C46 C1 POP B ;RESTORE REGISTERS 5620 1C47 D1 POP D 5621 1C48 F1 POP PSW 5622 1C49 E3 XTHL 5623 1C4A C9 RET 5624 ;PAGE 5625 ; 5626 ; 56271 5628 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5629+ 21:37 05/19/2019 5630+ PAGE 98 5631 5632 5633 5634 ; MOVE THE STRING FROM (D,E) TO (H,L) COUNT IN B 5635 ; 5636 ; 5637 1C4B 0604 CPY4D: MVI B,4 5638 1C4D 1A COPYD: LDAX D ;GET A BYTE 5639 1C4E 77 MOV M,A ;MOVE IT 5640 1C4F 23 INX H ;POINT NEXT 5641 1C50 13 INX D ;DITTO 5642 1C51 05 DCR B ;DECR CTR 5643 1C52 C24D1C JNZ COPYD ;LOOP 5644 1C55 C9 RET ;THEN RETURN 5645 ; 5646 ; 5647 ; MOVE THE STRING FROM (H,L) TO (D,E) COUNT IN B 5648 ; 5649 ; 5650 1C56 0604 CPY4H: MVI B,4 5651 1C58 EB COPYH: XCHG ;FLIP/FLOP 5652 1C59 CD4D1C CALL COPYD ;GO COPY 5653 1C5C EB XCHG ;FLIP/FLOP BACK 5654 1C5D C9 RET ;RETURN 5655 ; 5656 1C5E ZEROM EQU $ 5657 ; 5658 ; MOVES A STRING OF BINARY ZEROS, COUNT IN B 5659 ; 5660 1C5E 3600 MVI M,0 ;MOVE A ZERO 5661 1C60 23 INX H ;POINT NEXT 5662 1C61 05 DCR B ;DECR CTR 5663 1C62 C25E1C JNZ ZEROM ;LOOP 5664 1C65 C9 RET ;RETURN 5665 ; 5666 1C66 FBIN EQU $ 5667 ; 5668 ; 5669 ; CONVERT FLOAT ACC TO UNSIGNED BINARY NUMBER IN A REG 5670 ; RETURNS 0 IN A REG IF FACC<0 OR FACC>255 5671 ; 5672 ; 5673 1C66 E5 PUSH H ;SAVE H,L 5674 1C67 D5 PUSH D ;SAVE D,E 5675 1C68 CD351F CALL FACDE ;CONVERT FACC TO D,E 5676 1C6B AF XRA A ;ZERO A 5677 1C6C B2 ORA D ;TEST HIGH VALUE 5678 1C6D C2711C JNZ FBIN1 ;BRIF NOT ZERO 5679 1C70 7B MOV A,E ;VALUE TO A 5680 1C71 D1 FBIN1: POP D ;RESTORE D,E 5681 1C72 E1 POP H ;RESTORE H,L 5682 1C73 C9 RET ;RETURN 5683 ; 5684 1C74 ARG EQU $ 56851 5686 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5687+ 21:37 05/19/2019 5688+ PAGE 99 5689 5690 5691 5692 ; 5693 ; GET NEXT ARGUMENT FROM POLISH STACK 5694 ; 5695 1C74 2A5222 LHLD ADDR1 ;GET ADDRESS 5696 1C77 23 INX H ;POINT NEXT 5697 1C78 56 MOV D,M ;GET HI ADDRESS 5698 1C79 23 INX H ;POINT NEXT 5699 1C7A 5E MOV E,M ;GET LO ADDRESS 5700 1C7B 23 INX H ;POINT TYPE 5701 1C7C 225222 SHLD ADDR1 ;GET ADDRESS 5702 1C7F 2B DCX H ;POINT BACK 5703 1C80 C38313 JMP EVLD ;CALL EVLOAD AND RETURN 5704 ; 5705 ; 5706 1C83 ARGNU EQU $ 5707 ; 5708 1C83 CD741C CALL ARG ;GET ARGUMENT 5709 1C86 C3661C JMP FBIN ;THEN CONVERT FACC TO BIN 5710 ; 5711 1C89 BINFL EQU $ 5712 ; 5713 ; CONVERT D,E TO FLOATING POINT NUMBER IN FAC 5714 ; 5715 ; 5716 1C89 215822 LXI H,FACC ;POINT ACC 5717 1C8C 3618 MVI M,24 ;MAX BITS 5718 1C8E 23 INX H ;POINT NEXT 5719 1C8F 3600 MVI M,0 ;CLEAR MSB 5720 1C91 23 INX H ;POINT NEXT 5721 1C92 72 MOV M,D ;MOVE MID 5722 1C93 23 INX H ;POINT NEXT 5723 1C94 73 MOV M,E ;MOVE LSB 5724 1C95 C3DD16 JMP FNORM ;GO NORMALIZE & RETURN 5725 ;PAGE 5726 ; 5727 ; FUNCTION TABLE. FORMAT IS: 5728 ; DB <LITERAL>,0 5729 ; DW <ADDRESS> 5730 ; DB <FUNCTION TYPE> 5731 ; 5732 ; TABLE IS TERMINATED WITH A '00' 5733 ; 5734 1C98 FUNCT EQU $ 5735 1C98 41425300 DB 'ABS',0 5736 1C9C C70B DW ABS 5737 1C9E AB DB 0ABH 5738 1C9F 53515200 DB 'SQR',0 5739 1CA3 270C DW SQR 5740 1CA5 AB DB 0ABH 5741 1CA6 494E5400 DB 'INT',0 5742 1CAA E20B DW INT 57431 5744 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5745+ 21:37 05/19/2019 5746+ PAGE 100 5747 5748 5749 5750 1CAC AB DB 0ABH 5751 1CAD 53474E00 DB 'SGN',0 5752 1CB1 D00B DW SGN 5753 1CB3 AB DB 0ABH 5754 1CB4 524E4400 RNDLI: DB 'RND',0 5755 1CB8 840C DW RND 5756 1CBA AB DB 0ABH 5757 1CBB 53494E00 DB 'SIN',0 5758 1CBF 410A DW SIN 5759 1CC1 AB DB 0ABH 5760 1CC2 434F5300 DB 'COS',0 5761 1CC6 B30A DW COS 5762 1CC8 AB DB 0ABH 5763 1CC9 54414E00 DB 'TAN',0 5764 1CCD BC0A DW TAN 5765 1CCF AB DB 0ABH 5766 1CD0 41544E00 DB 'ATN',0 5767 1CD4 D40A DW ATN 5768 1CD6 AB DB 0ABH 5769 1CD7 494E5000 DB 'INP',0 5770 1CDB 0A0D DW INP 5771 1CDD AB DB 0ABH 5772 1CDE 4C4E00 DB 'LN',0 5773 1CE1 130B DW LN 5774 1CE3 AB DB 0ABH 5775 1CE4 4C4F4700 DB 'LOG',0 5776 1CE8 610B DW LOG 5777 1CEA AB DB 0ABH 5778 1CEB 45585000 DB 'EXP',0 5779 1CEF 6A0B DW EXP 5780 1CF1 AB DB 0ABH 5781 1CF2 504F5300 DB 'POS',0 5782 1CF6 200D DW POS 5783 1CF8 AB DB 0ABH 5784 1CF9 4C454E00 DB 'LEN',0 5785 1CFD 890D DW LENFN 5786 1CFF AB DB 0ABH 5787 1D00 43485224 DB 'CHR$',0 5788 1D04 00 5789 1D05 8F0D DW CHRFN 5790 1D07 CB DB 0CBH 5791 1D08 41534349 DB 'ASCII',0 5792 1D0C 4900 5793 1D0E 9A0D DW ASCII 5794 1D10 AB DB 0ABH 5795 1D11 4E554D24 DB 'NUM$',0 5796 1D15 00 5797 1D16 A70D DW NUMFN 5798 1D18 CB DB 0CBH 5799 1D19 56414C00 DB 'VAL',0 5800 1D1D BA0D DW VAL 58011 5802 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5803+ 21:37 05/19/2019 5804+ PAGE 101 5805 5806 5807 5808 1D1F AB DB 0ABH 5809 1D20 53504143 DB 'SPACE$',0 5810 1D24 452400 5811 1D27 E10D DW SPACE 5812 1D29 CB DB 0CBH 5813 1D2A 53545249 DB 'STRING$',0 5814 1D2E 4E472400 5815 1D32 F10D DW STRFN 5816 1D34 D3 DB 0D3H 5817 1D35 4C454654 DB 'LEFT$',0 5818 1D39 2400 5819 1D3B 050E DW LEFT 5820 1D3D D3 DB 0D3H 5821 1D3E 52494748 DB 'RIGHT$',0 5822 1D42 542400 5823 1D45 0E0E DW RIGHT 5824 1D47 D3 DB 0D3H 5825 1D48 4D494424 DB 'MID$',0 5826 1D4C 00 5827 1D4D 170E DW MIDFN 5828 1D4F DB DB 0DBH 5829 1D50 494E5354 DB 'INSTR',0 5830 1D54 5200 5831 1D56 510E DW INSTR 5832 1D58 BB DB 0BBH 5833 1D59 5045454B DB 'PEEK',0 5834 1D5D 00 5835 1D5E AB1F DW PEEK 5836 1D60 AB DB 0ABH 5837 IF LARGE 5838 1 DB 0,0,0,0 ;ROOM FOR ONE MORE FUNCTION 5839 1 DB 0,0,0,0 5840 ENDIF 5841 1D61 00 DB 0 ;END OF FUNCTION TABLE 5842 ;PAGE 5843 ; 5844 ; PROGRAM CONSTANTS 5845 ; 5846 1D62 131400 PCHOF: DB 19,20,0 5847 1D65 3FFD RNDP: DB 3FH,0FDH ;16381 5848 1D67 3FEB DB 3FH,0EBH ;16363 5849 1D69 3FDD DB 3FH,0DDH ;16349 5850 1D6B 1BEC NRNDX: DB 1BH,0ECH 5851 1D6D 33D3 DB 33H,0D3H 5852 1D6F 1A85 DB 1AH,85H 5853 1D71 2B1E DB 2BH,1EH 5854 1D73 57484154 WHATL: DB 'WHAT',0 5855 1D77 00 5856 1D78 VERS EQU $ ;VERSION MESSAGE 5857 IF LARGE 5858 1 DB '9K VERS 1.4',0 58591 5860 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5861+ 21:37 05/19/2019 5862+ PAGE 102 5863 5864 5865 5866 1 5867 1 5868 1 RBOUT: DB 08H,20H,08H,0FEH ;RUBOUT SEQUENCE (9K ONLY) 5869 ENDIF 5870 IF NOT LARGE 5871 1D78 1 384B2056 DB '8K VERS 1.4',0 5872 1D7C 1 45525320 5873 1D80 1 312E3400 5874 ENDIF 5875 1D84 4C494E45 LLINE: DB 'LINE',0 5876 1D88 00 5877 1D89 54414200 TABLI: DB 'TAB',0 5878 1D8D 53544550 STEPL: DB 'STEP',0 5879 1D91 00 5880 1D92 5448454E THENL: DB 'THEN',0 5881 1D96 00 5882 1D97 504900 PILIT: DB 'PI',0 5883 1D9A 02800000 TWO: DB 02H,80H,00H,00H ;CONSTANT: 2 5884 1D9E 04A00000 TEN: DB 04H,0A0H,00H,00H ;CONSTANT: 10 5885 1DA2 02C90FD7 PI: DB 02H,0C9H,0FH,0D7H ;CONSTANT: 3.141593 5886 1DA6 00C90FD7 QTRPI: DB 00H,0C9H,0FH,0D7H ;CONSTANT: 0.7853892 5887 1DAA 80FFFFFF NEGON: DB 80H,0FFH,0FFH,0FFH ;CONSTANT: -0.9999999 5888 1DAE 00B17216 LN2C: DB 00H,0B1H,72H,16H ;CONSTANT: 0.6931472 5889 1DB2 009714EB SQC1: DB 00H,97H,14H,0EBH ;CONSTANT: 0.59016206 5890 1DB6 7FD5A956 SQC2: DB 7FH,0D5H,0A9H,56H ;CONSTANT: 0.41730759 5891 ;PAGE 5892 ; 5893 ; THE FOLLOWING CONSTANTS MUST BE IN THIS ORDER *********** 5894 ; 5895 ; CONSTANT WITH EXPONENT OF 1 5896 ; COEFFICIENT OF FIRST TERM 5897 ; ... 5898 ; COEEFICIENT OF NTH TERM 5899 ; 5900 ; SINCE ALL COEFFICIENTS ARE LESS THAN 1, 5901 ; THE ITERATION LOOP USES THE 5902 ; CONSTANT WITH EXPONENT 1 TO TERMINATE THE EVALUATION. 5903 ; 5904 1DBA 01B504F3 SQC3: DB 01H,0B5H,04H,0F3H ;CONSTANT: 1.41421356 5905 1DBE FFAA95BC DB 0FFH,0AAH,95H,0BCH ;CONSTANT: -0.3331738 5906 1DC2 7ECAD520 DB 7EH,0CAH,0D5H,20H ;CONSTANT: 0.1980787 5907 1DC6 FE8782D6 DB 0FEH,87H,82H,0D6H ;CONSTANT: -0.1323351 5908 1DCA 7DA3131C DB 7DH,0A3H,13H,1CH ;CONSTANT: 0.07962632 5909 1DCE FC89A6B8 DB 0FCH,89H,0A6H,0B8H ;CONSTANT: -0.03360627 5910 1DD2 79DF3A9E ATNCO: DB 79H,0DFH,3AH,9EH ;CONSTANT: 0.006812411 5911 ; 5912 1DD6 01C90FD7 HALFP: DB 01H,0C9H,0FH,0D7H ;CONSTANT: 1.570796 5913 1DDA 80A55DDE DB 80H,0A5H,5DH,0DEH ;CONSTANT: -0.64596371 5914 1DDE 7DA33455 DB 7DH,0A3H,34H,55H ;CONSTANT: 0.076589679 5915 1DE2 F9993860 DB 0F9H,99H,38H,60H ;CONSTANT: -0.0046737656 5916 1DE6 749ED7B6 SINCO: DB 74H,9EH,0D7H,0B6H ;CONSTANT: 0.00015148419 59171 5918 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5919+ 21:37 05/19/2019 5920+ PAGE 103 5921 5922 5923 5924 ; 5925 1DEA 0180 ONE: DB 001H,080H 5926 1DEC 0000 NULLI: DB 00H,00H ;CONSTANT: 1.0 5927 1DEE 00FFFEC1 DB 00H,0FFH,0FEH,0C1H ;CONSTANT: 0.99998103 5928 1DF2 FFFFBAB0 DB 0FFH,0FFH,0BAH,0B0H ;CONSTANT: -0.4994712 5929 1DF6 7FA80E2B DB 7FH,0A8H,0EH,2BH ;CONSTANT: 0.3282331 5930 1DFA FEE74B55 DB 0FEH,0E7H,4BH,55H ;CONSTANT: -0.2258733 5931 1DFE 7E89DEE3 DB 7EH,89H,0DEH,0E3H ;CONSTANT: 0.134693 5932 1E02 FCE1C578 DB 0FCH,0E1H,0C5H,078H ;CONSTANT: -0.05511996 5933 1E06 7AB03FAE LNCO: DB 7AH,0B0H,3FH,0AEH ;CONSTANT: 0.01075737 5934 ; 5935 1E0A 01B8AA3B LN2E: DB 001H,0B8H,0AAH,03BH ;CONSTANT: 1.44269504 5936 1E0E 00B16FE6 DB 000H,0B1H,06FH,0E6H ;C=.69311397 5937 1E12 7EF62F70 DB 07EH,0F6H,02FH,070H ;C=.24041548 5938 1E16 7CE1C2AE DB 07CH,0E1H,0C2H,0AEH ;C=.05511732 5939 1E1A 7AA0BB7E DB 07AH,0A0H,0BBH,07EH ;C=.00981033 5940 1E1E 77CA09CB EXPCO: DB 077H,0CAH,009H,0CBH ;C=.00154143 5941 ; 5942 1E22 7FDE5BD0 LNC: DB 07FH,0DEH,05BH,0D0H ;C=LOG BASE 10 OF E 5943 1E26 READY EQU $ 5944 1E26 FD DB 0FDH 5945 1E27 52454144 DB 'READY',0 5946 1E2B 5900 5947 1E2D STOPM EQU $ 5948 1E2D FD DB 0FDH 5949 1E2E 53544F50 DB 'STOP AT LINE ',254 5950 1E32 20415420 5951 1E36 4C494E45 5952 1E3A 20FE 5953 1E3C 20455252 ERRMS: DB ' ERROR IN LINE ',0FEH 5954 1E40 4F522049 5955 1E44 4E204C49 5956 1E48 4E4520FE 5957 0002 TTY EQU 2 5958 ;PAGE 5959 ; 5960 ; VERB (STATEMENT/COMMAND) TABLE 5961 ; FORMAT IS: DB 'VERB',0 5962 ; DW ADDR 5963 ; DB 'NEXT VERB',0 5964 ; ETC 5965 ; END OF TABLE IS MARKED BY DB 0 5966 ; 5967 1E4C JMPTB EQU $ 5968 1E4C 4C495354 DB 'LIST',0 5969 1E50 00 5970 1E51 6202 DW LIST 5971 1E53 52554E00 DB 'RUN',0 5972 1E57 F401 DW RUNCM 5973 1E59 58455100 DB 'XEQ',0 5974 1E5D F901 DW XEQ 59751 5976 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 5977+ 21:37 05/19/2019 5978+ PAGE 104 5979 5980 5981 5982 1E5F 4E455700 DB 'NEW',0 5983 1E63 8801 DW NEW 5984 1E65 434F4E00 DB 'CON',0 5985 1E69 EE02 DW CONTI 5986 1E6B 54415045 DB 'TAPE',0 5987 1E6F 00 5988 1E70 BE01 DW TAPE 5989 1E72 53415645 DB 'SAVE',0 5990 1E76 00 5991 1E77 5502 DW SAVE 5992 1E79 4B455900 KEYL: DB 'KEY',0 5993 1E7D DC01 DW KEY 5994 1E7F 46524500 DB 'FRE',0 5995 1E83 A001 DW FREE 5996 1E85 494600 DB 'IF',0 5997 1E88 E904 DW IFSTM 5998 1E8A 52454144 DB 'READ',0 5999 1E8E 00 6000 1E8F E107 DW READ 6001 1E91 52455354 DB 'RESTORE',0 6002 1E95 4F524500 6003 1E99 1603 DW RESTO 6004 1E9B 44415441 DATAL: DB 'DATA',0 6005 1E9F 00 6006 1EA0 0B02 DW RUN 6007 1EA2 464F5200 DB 'FOR',0 6008 1EA6 E503 DW FOR 6009 1EA8 4E455854 NEXTL: DB 'NEXT',0 6010 1EAC 00 6011 1EAD 9206 DW NEXT 6012 1EAF 474F5355 GOSBL: DB 'GOSUB',0 6013 1EB3 4200 6014 1EB5 3A03 DW GOSUB 6015 1EB7 52455455 DB 'RETURN',0 6016 1EBB 524E00 6017 1EBE 2203 DW RETUR 6018 1EC0 494E5055 DB 'INPUT',0 6019 1EC4 5400 6020 1EC6 2107 DW INPUT 6021 1EC8 5052494E DB 'PRINT',0 6022 1ECC 5400 6023 1ECE 5503 DW PRINT 6024 1ED0 474F GOTOL: DB 'GO' 6025 1ED2 544F00 TOLIT: DB 'TO',0 6026 1ED5 F602 DW GOTO 6027 1ED7 4C455400 DB 'LET',0 6028 1EDB F105 DW LET 6029 1EDD 53544F50 DB 'STOP',0 6030 1EE1 00 6031 1EE2 7208 DW STOP 6032 1EE4 454E4400 DB 'END',0 60331 6034 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6035+ 21:37 05/19/2019 6036+ PAGE 105 6037 6038 6039 6040 1EE8 CB01 DW ENDIT 6041 1EEA 52454D00 DB 'REM',0 6042 1EEE 0B02 DW RUN 6043 1EF0 2100 DB '!',0 6044 1EF2 0B02 DW RUN 6045 1EF4 3F00 DB '?',0 6046 1EF6 5503 DW PRINT 6047 1EF8 52414E44 DB 'RANDOMIZE',0 6048 1EFC 4F4D495A 6049 1F00 4500 6050 1F02 9F08 DW RANDO 6051 1F04 4F4E00 DB 'ON',0 6052 1F07 B508 DW ON 6053 1F09 4F555400 DB 'OUT',0 6054 1F0D 4A08 DW OUTP 6055 1F0F 44494D00 DB 'DIM',0 6056 1F13 B109 DW DIM 6057 1F15 4348414E DB 'CHANGE',0 6058 1F19 474500 6059 1F1C 2A09 DW CHANG 6060 1F1E 444546 DEFLI: DB 'DEF' 6061 1F21 464E00 FNLIT: DB 'FN',0 6062 1F24 0B02 DW RUN 6063 IF CPM 6064 1 DB 'DDT',0 6065 1 DW DDT 6066 1 DB 'BYE',0 6067 1 DW BOOT 6068 ENDIF 6069 1F26 504F4B45 DB 'POKE',0 6070 1F2A 00 6071 1F2B B61F DW POKE 6072 1F2D 43414C4C DB 'CALL',0 6073 1F31 00 6074 1F32 D41F DW JUMP 6075 IF LARGE ;INCLUDE ONLY IN 8K+ VERSION 6076 1 DB 'EDIT',0 6077 1 6078 1 DW FIX 6079 1 DB 'CLOAD',0 6080 1 6081 1 DW CLOAD 6082 1 DB 'CSAVE',0 6083 1 6084 1 DW CSAVE 6085 ENDIF 6086 IF HUNTER 6087 1 DB 'BAUD',0 6088 1 6089 1 DW BAUD 6090 ENDIF 60911 6092 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6093+ 21:37 05/19/2019 6094+ PAGE 106 6095 6096 6097 6098 1F34 00 DB 0 ;END OF TABLE 6099 ; 6100 ; DDT COMMAND, CPM ONLY 6101 ; 6102 IF CPM 6103 1 DDT: RST 7 6104 1 JMP RDY 6105 ENDIF 6106 ;PAGE 6107 ; 6108 1F35 FACDE EQU $ 6109 ; 6110 ; THIS ROUTINE CONVERTS THE FACC TO AN ADDRESS IN D,E 6111 ; 6112 1F35 CDE20B CALL INT ;INTEGERIZE THE FACC 6113 1F38 3A5822 LDA FACC ;GET THE EXPONENT 6114 1F3B B7 ORA A ;TEST IT 6115 1F3C FA271C JM OVERR ;BRIF NEGATIVE ADDRESS 6116 1F3F D610 SUI 16 ;SUBTRACT MAX EXPONENT 6117 1F41 CA571F JZ FDE2 ;BRIF EQUAL MAX 6118 1F44 F2271C JP OVERR ;BRIF GREATER THAN 64K 6119 1F47 2F CMA ;2'S COMPLIMENT OF A YIELDS.. 6120 1F48 3C INR A ;16-A 6121 1F49 4F MOV C,A ;SAVE SHIFT COUNT 6122 1F4A AF FDE1: XRA A ;CLEAR CARRY 6123 1F4B 215922 LXI H,FACC+1 ;POINT MANTISSA 6124 1F4E 0602 MVI B,2 ;WORDS TO SHIFT 6125 1F50 CDFB18 CALL FSHFT ;GO SHIFT FACC+1 AND FACC+2 6126 1F53 0D DCR C ;REDUCE COUNT 6127 1F54 C24A1F JNZ FDE1 ;LOOP TILL COMPLETE 6128 1F57 215922 FDE2: LXI H,FACC+1 ;POINT HIGH BYTE 6129 1F5A 56 MOV D,M ;LOAD D 6130 1F5B 23 INX H ;POINT LOW BYTE 6131 1F5C 5E MOV E,M ;LOADE E 6132 1F5D C9 RET ;RETURN 6133 ; 6134 ; 6135 1F5E LOCAT EQU $ 6136 ; 6137 ; THIS ROUTINE SEARCHES FOR A LINE IN THE PROGRAM FILE. 6138 ; Z SET, C RESET==>LINE FOUND. ADDRESS IS IN H,L 6139 ; C SET, Z RESET==>NOT FOUND. H,L POINT TO NEXT LINE 6140 ; C SET, Z SET==>NOT FOUND. H,L POINT AT END OF PROGRAM 6141 ; 6142 1F5E 219622 LXI H,BEGPR ;POINT START 6143 1F61 7E FIND1: MOV A,M ;FETCH LENGTH OF LINE 6144 1F62 E5 PUSH H ;SAVE POINTER 6145 1F63 B7 ORA A ;TEST 6146 1F64 CA831F JZ FIND3 ;BRIF END 6147 1F67 23 INX H ;POINT LINE # 6148 1F68 7E MOV A,M ;FETCH HI # 61491 6150 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6151+ 21:37 05/19/2019 6152+ PAGE 107 6153 6154 6155 6156 1F69 B8 CMP B ;COMPARE TO REQUESTED 6157 1F6A DA7B1F JC FIND2 ;BRIF LOW 6158 1F6D C2831F JNZ FIND3 ;BRIF PAST AND NOT FOUND 6159 1F70 23 INX H ;POINT LO # 6160 1F71 7E MOV A,M ;FETCH IT 6161 1F72 B9 CMP C ;COMPARE TO REQUESTED 6162 1F73 DA7B1F JC FIND2 ;BRIF LOW 6163 1F76 C2831F JNZ FIND3 ;BRIF PAST AND NOT FOUND 6164 1F79 E1 POP H ;POINT BEGIN IF MATCH 6165 1F7A C9 RET ;RETURN 6166 ; 6167 ; BUMP H,L TO NEXT LINE 6168 ; 6169 1F7B E1 FIND2: POP H ;POINT START OF LINE 6170 1F7C 5E MOV E,M ;LENGHT TO E 6171 1F7D 1600 MVI D,0 ;CLEAR D 6172 1F7F 19 DAD D ;BUMP H,L 6173 1F80 C3611F JMP FIND1 ;CONTINUE 6174 ; 6175 ; LINE NOT FOUND 6176 ; 6177 1F83 37 FIND3: STC ;SET CARRY 6178 1F84 E1 POP H ;POINT LINE JUST PAST REQUESTED 6179 1F85 C9 RET ;RETURN 6180 ; 6181 ; 6182 1F86 SEEK EQU $ 6183 ; 6184 ; THIS CODE FINDS AN ENTRY IN THE TABLE POINTED TO BY D,E. 6185 ; THE SOUGHT ENTRY IS POINTED TO BY H,L. 6186 ; 6187 1F86 E5 SEEK1: PUSH H ;SAVE ADDRESS OF STRING 6188 1F87 1A LDAX D ;GET BYTE FROM TABLE 6189 1F88 B7 ORA A ;TEST IT 6190 1F89 CAA91F JZ SEEK3 ;BRIF END OF TABLE 6191 1F8C D7 RST 2 ;COMPARE 6192 1F8D C2991F JNZ SEEK2 ;BRIF NOT FOUND 6193 1F90 E3 XTHL ;PUT CURRENT H,L ON STACK 6194 1F91 CDF91A CALL SKP2Z ;FIND END TO LITERAL IN TABLE 6195 1F94 13 INX D ;POINT LOW BYTE 6196 1F95 E1 POP H ;RESTORE LINE POINTER 6197 1F96 3C INR A ;PUT 1 IN A 6198 1F97 B7 ORA A ;RESET Z BIT 6199 1F98 C9 RET ;RETURN 6200 1F99 CDF91A SEEK2: CALL SKP2Z ;FIND END OF TABLE LITERAL 6201 1F9C 13 INX D ; 6202 1F9D 13 INX D ;POINT NEXT LIT IN TABLE 6203 1F9E 13 INX D ; 6204 1F9F E1 POP H ;GET ORIGINAL STRING 6205 1FA0 1A LDAX D ;GET BYTE 6206 1FA1 17 RAL ;HIGH BIT TO CARRY 62071 6208 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6209+ 21:37 05/19/2019 6210+ PAGE 108 6211 6212 6213 6214 1FA2 D2861F JNC SEEK1 ;NOT A FUNCTION SEARCH 6215 1FA5 13 INX D ;POINT NEXT BYTE IN FUNCTION TABLE 6216 1FA6 C3861F JMP SEEK1 ;CONTINUE SEARCH 6217 1FA9 E1 SEEK3: POP H ;RESTORE ORIGINAL STRING 6218 1FAA C9 RET ;RETURN 6219 IF LARGE ;ASSEMBLE THE REMAINDAR ONLY FOR 8+K 6220 1 ; 6221 1 ; 6222 1 ; EDIT COMMAND 6223 1 ; EDIT <LINE #><DELIMITER><OLD TEXT><DELIMITER><NEW TEXT> 6224 1 ; 6225 1 FIX: EQU $ 6226 1 RST 1 ;SKIP BLANKS 6227 1 CALL PACK ;GET LINE # IN B,C 6228 1 RST 1 ;SKIP BLANKS 6229 1 SHLD ADDR2 ;SAVE COMMAND POINTER 6230 1 CALL LOCAT ;SEARCH FOR LINE # IN PROGRAM 6231 1 JC ULERR ;BRIF NOT FOUND 6232 1 PUSH H ;SAVE ADDR OF EXISTING LINE <SOURCE> 6233 1 PUSH B ;SAVE LINE # 6234 1 MOV B,M ;GET LENGTH OF <SOURCE> 6235 1 XCHG ;D,E POINT <SOURCE> 6236 1 LXI H,STRIN ;POINT STRING BUFFER 6237 1 CALL COPYD ;<SOURCE> TO STRING BUFFER 6238 1 LDA STRIN ;LENGTH OF <SOURCE> TO A 6239 1 SUI 2 ;ADJUST 6240 1 STA STRIN ;STORE 6241 1 LXI D,IOBUF+1 ;POINT BUFFER 6242 1 LHLD ADDR2 ;FETCH COMMAND POINTER 6243 1 MOV B,M ;FETCH <DELIMITER> 6244 1 ; 6245 1 ; FIND LENGTH OF <OLD TEXT>. STORE IT IN IOBUF. 6246 1 ; 6247 1 MVI C,0 ;INITIAL LENGTH 6248 1 FIX1: INX H ;POINT NEXT CHARACTER 6249 1 MOV A,M ;FETCH 6250 1 ORA A ;TEST 6251 1 JZ SNERR ;MISSING 2ND <DELIMITER>. 6252 1 CMP B ;TEST 6253 1 JZ FIX2 ;BRIF 2ND <DELIMITER> FOUND 6254 1 INR C ;ELSE, BUMP C 6255 1 STAX D ;STORE CHARACTER IN IOBUF 6256 1 INX D ;BUMP IOBUF POINTER 6257 1 JMP FIX1 ;CONTINUE 6258 1 ; 6259 1 ; GET READY TO SEARCH <SOURCE> FOR <OLD TEXT> 6260 1 ; 6261 1 FIX2: MOV A,C ;LENGTH OF <OT> TO A 6262 1 STA IOBUF ;STORE 6263 1 SHLD ADDR2 ;SAVE COMMAND POINTER 6264 1 MVI A,3 ;SEARCH WILL START IN POS 3. 62651 6266 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6267+ 21:37 05/19/2019 6268+ PAGE 109 6269 6270 6271 6272 1 LHLD PROGE ;POINT END OF PROGRAM 6273 1 INX H ;BUMP TWICE 6274 1 INX H 6275 1 SHLD ADDR1 ;SAVE EXPR. STACK POINTER 6276 1 INX H ;POINT NEXT 6277 1 LXI D,IOBUF ;POINT BUFFER AREA 6278 1 MOV M,D ;STORE ADDRESS 6279 1 INX H 6280 1 MOV M,E 6281 1 LXI H,STRIN ; POINT <SOURCE> 6282 1 ; 6283 1 ; USE THE INSTR ROUTINE TO SEARCH 6284 1 ; 6285 1 CALL INST2 ;GO SEARCH 6286 1 MOV A,E ;RESULT TO A 6287 1 ORA A ;TEST 6288 1 JZ DAERR ;BR IF NOT FOUND 6289 1 MOV C,A ;SAVE POSITION IN C 6290 1 DCR A ;ADJUST 6291 1 MOV B,A ;COPY TO B 6292 1 LXI H,STRIN+1 ;POINT <OLD SOURCE> 6293 1 LXI D,IOBUF+1 ;PIONT <NEW LINE AREA> 6294 1 CALL COPYH ;COPY <OLD SOURCE> UP TO <OLD TEXT> 6295 1 PUSH D ;SAVE DEST POINTER 6296 1 ; 6297 1 ; SKIP OVER <OLD TEXT> IN <SOURCE> 6298 1 ; 6299 1 MVI D,0 ;CLEAR D 6300 1 LDA IOBUF ;GET LENGTH OF <OT> 6301 1 MOV E,A ;LENGTH TO E 6302 1 DAD D ;BUMP H,L PAST <OT> 6303 1 POP D ;RESTORE <DEST> POINTER 6304 1 PUSH H ;SAVE <REMAINING SOURCE> POINTER 6305 1 ; 6306 1 ; APPEND <NEW TEXT> TO <DEST> 6307 1 ; 6308 1 LHLD ADDR2 ;FETCH COMMAND POINTER 6309 1 FIX3: INX H ;POINT NEXT 6310 1 MOV A,M ;FETCH CHARACTER 6311 1 ORA A ;TEST IT 6312 1 JZ FIX4 ;BRIF NO MORE <NEW TEXT> 6313 1 INR C ;BUMP LENGTH COUNT 6314 1 STAX D ;STORE CHARACTER 6315 1 INX D ;BUMP <DEST> POINTER 6316 1 JMP FIX3 ;CONTINUE 6317 1 ; 6318 1 ; APPEND <REMAINING SOURCE> TO <DEST> 6319 1 ; 6320 1 FIX4: POP H ;GET REMAINING SOURCE POINTER 6321 1 FIX4A: MOV A,M ;FETCH CHARACTER 6322 1 ORA A ;TEST 63231 6324 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6325+ 21:37 05/19/2019 6326+ PAGE 110 6327 6328 6329 6330 1 JZ FIX5 ;BRIF DONE 6331 1 STAX D ;STORE CHARACTER 6332 1 INR C ;BUMP CHAR COUNT 6333 1 INX D ;BUMP DEST POINTER 6334 1 INX H ;BUMP <SOURCE> POINTER 6335 1 JMP FIX4A ;CONTINUE 6336 1 ; 6337 1 ; PREPARE <DEST> FOR SUBMISSION AS NEW LINE 6338 1 ; 6339 1 FIX5: STAX D ;BUFFER TERMINATOR 6340 1 INR C ;BUMP LENGTH COUNT 6341 1 MOV A,C ;FETCH COUNT 6342 1 STA IOBUF ;STORE IT 6343 1 MOV B,A ;COPY COUNT TO B 6344 1 LXI H,IMMED ;POINT NEW LINE AREA 6345 1 LXI D,IOBUF ;POINT WHERE IT IS NOW 6346 1 CALL COPYD ;COPY IT 6347 1 POP B ;RESTORE LINE # 6348 1 POP H ;RESTORE PROGRAM POINTER 6349 1 PUSH H ;SAVE IT 6350 1 JMP EDIT2 ;PROCESS AS NEW LINE 6351 1 ;PAGE 6352 1 ; 6353 1 ; TAPE CASSETTE COMMANDS 6354 1 ; 6355 1 ; 6356 1 ; TAPE CASSETTE EQUATES 6357 1 ; 6358 1 SWCH EQU 0FFH ;SWITCH PORT 6359 1 CASC EQU 3 ;STATUS PORT FOR TARBELL 6360 1 CASD EQU 0 ;DATA PORT 6361 1 CFLAG EQU 4 ;DATA FLAG FOR TARBELL ON MIO 6362 1 ; 6363 1 ; CASSETTE FILE FORMAT 6364 1 ; 6365 1 ; EACH RECORD: 6366 1 ; TYPE BYTE: 4 FOR BASIC PROGRAM, 6367 1 ; PLUS BIT 7 ON IF DATA NOT HEADER RECORD 6368 1 ; LENGTH BYTE: # DATA BYTES (1-128) 6369 1 ; 2 BYTES OF CHECKSUM 6370 1 ; 6371 1 ; EACH FILE BEGINS WITH A HEADER RECORD 6372 1 ; TYPE 4 6373 1 ; LENGTH: 7 6374 1 ; 5 CHARS FILENAME, BLANK-FILLED 6375 1 ; 2 BYTES TOTAL LENGTH OF DATA IN FILE 6376 1 ; 2 BYTES OF CHECKSUM 6377 1 ; 6378 1 ; AND HAS N DATA RECORDS 6379 1 ; TYPE: 84 6380 1 ; LENGTH: 128 EXCEPT LAST RECORD MAY BE LESS 63811 6382 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6383+ 21:37 05/19/2019 6384+ PAGE 111 6385 6386 6387 6388 1 ; DATA: NEXT (LENGTH) BYTES OF IMAGE OF PROGRAM AREA 6389 1 ; CHECKSUM: 2 BYTES, 2'S COMPLEMENT OF SUM OF BYTES 6390 1 ; 6391 1 ; FILES OF TYPE OTHER THAN 4 ARE IGNORED BY BASIC 6392 1 ; 6393 1 ; HARDWARE USED: 6394 1 ; IMSAI MIO BOARD, CASSETTE DATA ON PORT 0, 6395 1 ; STATUS ON PORT 3, 6396 1 ; CASSETTE READY JUMPERED TO BIT 2 OF PORT 3. 6397 1 ; 6398 1 ; 6399 1 ; TAPE UTILITY ROUTINE 6400 1 ; 6401 1 ; WATCH WAIT FOR TARBELL READY OR CONTROL-C 6402 1 ; 6403 1 WATCH: PUSH B ;SAVE REGS - CPM STATUS CALL CAN CLOBBER 6404 1 PUSH D 6405 1 PUSH H 6406 1 CALL TSTCC ;TEST FOR CNTRL-C 6407 1 POP H ;RESTORE REGS IN CPM DEBUGGING MODE 6408 1 POP D 6409 1 POP B 6410 1 IN CASC ;READ STATUS PORT 6411 1 ANI CFLAG ;TEST 6412 1 JZ WATCH ;LOOP TILL READY 6413 1 RET 6414 1 ; 6415 1 ; 6416 1 ; CASI CASSETTE INPUT TO A-REGISTER 6417 1 ; 6418 1 CASI: CALL WATCH ;WAIT TIL READY 6419 1 IN CASD ;READ FROM DATA PORT 6420 1 RET 6421 1 ; 6422 1 ; 6423 1 ; RECO WRITE A RECORD TO THE TARBELL. 6424 1 ; D,E==>TYPE, LENGTH BYTES 6425 1 ; H,L==>START OF SOURCE 6426 1 ; RETURNS UPDATED SOURCE POINTER IN DE 6427 1 ; 6428 1 RECO: MOV A,D ;TYPE BYTE 6429 1 CALL CASO ;WRITE IT 6430 1 MOV A,E ;COUNT 6431 1 CALL CASO ;WRITE IT 6432 1 MOV B,E ;COUNT 6433 1 XCHG ;SOURCE NOW IN DE 6434 1 LXI H,0 ;INITIAL CHECKSUM 6435 1 NCHAR: LDAX D ;FETCH NEXT CHAR 6436 1 CALL CASO ;WRITE IT 6437 1 INX D ;PNT NEXT CHAR 6438 1 CALL CKSUM ;ADD TO CKSUM, PUT ADD IN LIGHTS 64391 6440 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6441+ 21:37 05/19/2019 6442+ PAGE 112 6443 6444 6445 6446 1 DCR B ;REDUCE COUNT 6447 1 JNZ NCHAR ;LOOP ON COUNT 6448 1 DCX H ;ADJUST HL FOR COMPLIMENT 6449 1 MOV A,H ;WRITE CHECKSUM 6450 1 CMA 6451 1 CALL CASO 6452 1 MOV A,L 6453 1 CMA 6454 1 ;WRITE LAST BYTE & RETURN 6455 1 ; 6456 1 ; 6457 1 ; CASO CASSETTE OUTPUT BYTE FROM A-REGISTER 6458 1 ; 6459 1 CASO: PUSH PSW 6460 1 CALL WATCH ;WAIT TILL READY 6461 1 POP PSW 6462 1 OUT CASD ;WRITE TO DATA PORT 6463 1 RET 6464 1 ; 6465 1 ; 6466 1 ; CKSUM CALCULATE THE CHECKSUM: 6467 1 ; ADD A TO HL 6468 1 ; ALSO OUTPUS HI ADDR TO SENSE LIGHTS 6469 1 ; 6470 1 CKSUM: ADD L ;ADD PREVIOUS LO 6471 1 MOV L,A ;SAVE NEW LO 6472 1 RNC 6473 1 INR H ;PROPAGATE CARRY 6474 1 ; 6475 1 ; 6476 1 ; SENSE OUTPUT HI ADDR FROM D TO LIGHTS 6477 1 ; 6478 1 SENSE: MOV A,D 6479 1 CMA 6480 1 OUT SWCH 6481 1 RET 6482 1 ; 6483 1 ; 6484 1 ; RECI INPUT A RECORD FROM THE TARBELL 6485 1 ; TAKES A BUFFER POINTER IN HL 6486 1 ; RETURNS UPDATED POINTER IN DE, 6487 1 ; RECORD TYPE IN A, RECORD LENGTH IN C 6488 1 ; CLOBBERS B,H,L 6489 1 ; 6490 1 RECI: CALL CASI ;GET TYPE 6491 1 PUSH PSW ;SAVE TYPE TO RETURN TO CALLER 6492 1 CALL CASI ;GET LENGTH 6493 1 MOV C,A ;STORE LEN 6494 1 MOV B,A ;IN B ALSO 6495 1 XCHG ;PUT DESTINATION PTR IN DE 6496 1 LXI H,0 ;INITIAL CHECKSUM 64971 6498 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6499+ 21:37 05/19/2019 6500+ PAGE 113 6501 6502 6503 6504 1 RECI1: CALL CASI ;INPUT BYTE 6505 1 STAX D ;STORE IT 6506 1 INX D 6507 1 CALL CKSUM ;UPDATE CKSUM, PUT ADDR IN LIGHTS 6508 1 DCR B ;LOOP ON COUNT 6509 1 JNZ RECI1 6510 1 PUSH D ;SAVE DESTINATION PTR 6511 1 CALL CASI ;INPUT CHECKSUM 6512 1 MOV D,A 6513 1 CALL CASI 6514 1 MOV E,A 6515 1 DAD D ;COMPARE 6516 1 MOV A,H 6517 1 ORA L 6518 1 JNZ CKERR ;BRIF CHECKSUM ERROR 6519 1 POP D ;RESTORE DEST PTR 6520 1 POP PSW ;RESTORE RECORD TYPE BYTE 6521 1 RET 6522 1 ; 6523 1 ; 6524 1 ; CSAVE COMMAND 6525 1 ; 6526 1 CSAVE: RST 1 ;SKIP ANY SPACES 6527 1 MVI A,10H ;ENABLE WRITE 6528 1 OUT CASC 6529 1 PUSH H ;SAVE PTR 6530 1 MVI B,255 ;WRITE INITIAL 255 NULLS 6531 1 XRA A 6532 1 NULS: CALL CASO 6533 1 DCR B 6534 1 JNZ NULS 6535 1 MVI A,3CH ;START BYTE 6536 1 CALL CASO 6537 1 MVI B,32 ;32 SYNC BYTES 6538 1 MVI A,0E6H ;SYNC BYTE VALUE 6539 1 SYNCS: CALL CASO 6540 1 DCR B 6541 1 JNZ SYNCS 6542 1 LXI H,IOBUF ;POINT BUFFER 6543 1 MVI B,5 ;FILE NAME LENGTH 6544 1 POP D ;RESTORE CMD PTR 6545 1 FNAME: MVI M,20H ;DEFAULT BLANK 6546 1 LDAX D ;FETCH FILE NAME 6547 1 ORA A ;TEST 6548 1 JZ BLANK 6549 1 MOV M,A ;STORE CHAR 6550 1 INX D ;NAME PTR 6551 1 BLANK: INX H ;BUFFER PTR 6552 1 DCR B ;COUNT 6553 1 JNZ FNAME 6554 1 ; 65551 6556 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6557+ 21:37 05/19/2019 6558+ PAGE 114 6559 6560 6561 6562 1 ; CALCULATE LGTH OF PROGRAM FILE&WRITE IT ON THE HEADER 6563 1 ; 6564 1 LXI D,BEGPR ;BEGINNING OF PROGRAM 6565 1 LHLD PROGE ;END 6566 1 MOV A,L 6567 1 SUB E 6568 1 MOV L,A 6569 1 MOV A,H 6570 1 SBB D 6571 1 MOV H,A 6572 1 INX H ;PLUS 1 TO GET # OF BYTES INCLUSIVE 6573 1 PUSH H ;SAVE FOR LATER 6574 1 SHLD IOBUF+5 ;STUFF LENGTH 6575 1 LXI D,407H ;TYPE AND LEN OF HEADER RECORD 6576 1 ;TYPE 4: BASIC PROG FILE, HEADER RCD 6577 1 LXI H,IOBUF 6578 1 CALL RECO ;WRITE RECORD 6579 1 ; 6580 1 ; WRITE PROGRAM FILE 6581 1 ; 6582 1 LXI H,BEGPR ;POINT START OF PROGRAM 6583 1 NXTRC: XTHL ;GET REMAINING LENGTH 6584 1 MOV A,H ;GET HI REMAINING 6585 1 ORA L ;TEST FOR DONE 6586 1 JZ ERITE ;BRIF DONE 6587 1 LXI D,0FF80H;-128 6588 1 DAD D ;SUBTRACT RECORD LENGTH 6589 1 JC RITE ;IF CARRY, NOT AT END 6590 1 MOV A,L ;GET LOW 6591 1 ANI 7FH ;NUMBER BYTES LEFT 6592 1 MOV E,A ;COUNT 6593 1 LXI H,0 ;REMAINING BYTES 6594 1 RITE: XTHL ;RESTORE H 6595 1 MVI D,084H ;TYPE BYTE: 80=DATA RECORD (NOT 6596 1 ;FILE HDR), 4=BASIC PROGRAM FILE. 6597 1 CALL RECO ;WRITE 6598 1 XCHG ;SAVE SOURCE PTR 6599 1 JMP NXTRC 6600 1 ERITE: POP H ;CLEAN STACK 6601 1 ; 6602 1 ; 6603 1 ; BELL RING USER'S CHIMES 6604 1 ; 6605 1 BELL: MVI A,7 ;CODE FOR BELL 6606 1 CALL TESTO 6607 1 JMP RDY 6608 1 ;PAGE 6609 1 ; CLOAD LOAD A PROGRAM FROM THE TARBELL 6610 1 ; 6611 1 CLOAD: 6612 1 NULL1: MVI A,60H ;MIO CONTROL TO READ BY BITS 66131 6614 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6615+ 21:37 05/19/2019 6616+ PAGE 115 6617 6618 6619 6620 1 OUT CASC ;WRITE TO STATUS PORT 6621 1 NULLS: CALL CASI ;READ LEADING NULLS 6622 1 OUT SWCH ;PUT IN LIGHTS 6623 1 CPI 0E6H ;WAIT FOR FIRST SYNC BYTE 6624 1 JNZ NULLS 6625 1 MVI A,20H ;MIO CONTROL TO READ BY BYTES 6626 1 OUT CASC ;WRITE TO STATUS PORT 6627 1 MVI B,31 ;NUMBER REMAINING SYNC BYTES 6628 1 SYNC: CALL CASI ;READ PAST SYNC 6629 1 OUT SWCH 6630 1 CPI 0E6H 6631 1 JNZ NULL1 ;TRY FOR MORE NULLS 6632 1 DCR B 6633 1 JNZ SYNC 6634 1 LXI H,IOBUF ;POINT BUFFER 6635 1 CALL RECI ;READ A RECORD 6636 1 CPI 4 ;TEST TYPE BYTE: IS IT BASIC PROGRAM 6637 1 ;..FILE HEADER RECORD? 6638 1 JNZ NULL1 ;NO, START OVER, KEEP LOOKING 6639 1 LHLD IOBUF+5 ;LOAD LENGTH OF PROGRAM FILE 6640 1 PUSH H ;SAVE 6641 1 LXI H,BEGPR 6642 1 NXTR: CALL RECI ;READ RECORD 6643 1 CPI 84H ;IS IT BASIC PROGRAM FILE DATA RECORD 6644 1 JNZ CKERR ;NO, SOMETHING'S WRONG. 6645 1 POP H ;LENGTH 6646 1 ;SUBTRACT 0,C FROM HL 6647 1 MOV A,L 6648 1 SUB C 6649 1 MOV L,A 6650 1 MOV A,H 6651 1 MVI C,0 6652 1 SBB C 6653 1 MOV H,A 6654 1 ORA L ;TEST RESULT FOR 0 6655 1 XCHG ;BUFFER ADDR TO HL 6656 1 PUSH D ;SAVE REMAINING LENGTH 6657 1 JNZ NXTR ;JIF NOT DONE READING DATA 6658 1 POP D ;CLEAR STACK 6659 1 ;LOADING DONE. SET POINTER TO END OF PROGRAM. 6660 1 XRA A 6661 1 MOV M,A ;EXTRA 0 FOR PARANOISA 6662 1 DCX H ;POINT LAST RECORD BYTE (SHOULD BE 0) 6663 1 SHLD PROGE ;SAVE END OF PROG FOR EDIT, LIST, &C 6664 1 STA IOBUF+5 ;MARK END OF FILE NAME FOR TYPEOUT 6665 1 ;TYPE FILE NAME 6666 1 LDA IOBUF 6667 1 CPI 20H ;TEST FOR NO NAME 6668 1 CNZ TERMO ;PRINT NAME IF THERE 6669 1 JMP BELL 6670 ENDIF 66711 6672 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6673+ 21:37 05/19/2019 6674+ PAGE 116 6675 6676 6677 6678 ; 6679 1FAB PEEK EQU $ 6680 ; 6681 ; STMT: A=PEEK(X). RETURNS DECIMAL VALUE OF MEMORY ADDRESS X. 6682 ; 6683 1FAB CD351F CALL FACDE ;GET ADDRESS IN D,E 6684 1FAE EB XCHG ;ADDRESS TO H,L 6685 1FAF 110000 LXI D,0 ;CLEAR D,E 6686 1FB2 5E MOV E,M ;PUT MEMORY BYTE IN E 6687 1FB3 C3891C JMP BINFL ;CONVERT D,E TO BINARY AND RETURN 6688 ; 6689 1FB6 POKE EQU $ 6690 ; 6691 ; STMT: POKE <ADDRESS>,<VALUE>. PUTS IN MEMORY ADDRESS. 6692 ; 6693 1FB6 CD800F CALL EXPR ;EVALUATE ADDRESS EXPRESSION 6694 1FB9 7E MOV A,M ;LOAD NEXT CHARACTER 6695 1FBA FE2C CPI ',' ;TEST 6696 1FBC C20F1C JNZ SNERR ;BRIF ERROR 6697 1FBF 23 INX H ;POINT NEXT 6698 1FC0 E5 PUSH H ;SAVE H,L 6699 1FC1 CD351F CALL FACDE ;PUT ADDRESS IN D,E 6700 1FC4 E1 POP H ;RESTORE H,L 6701 1FC5 D5 PUSH D ;SAVE ADDRESS 6702 1FC6 CD800F CALL EXPR ;EVALUATE VALUE EXPRESSION 6703 1FC9 CD941A CALL EOL ;TEST FOR END OF LINE 6704 1FCC CD661C CALL FBIN ;CONVERT FACC TO A REGISTER VALUE 6705 1FCF E1 POP H ;GET D,E ADDRESS IN H,L 6706 1FD0 77 MOV M,A ;MOVE BYTE 6707 1FD1 C30B02 JMP RUN ;CONTINUE 6708 ; 6709 ; 6710 1FD4 JUMP EQU $ 6711 ; 6712 ; STMT: CALL <ADDRESS>. EXECUTES CODE AT MEMORY ADDRESS. 6713 ; 6714 1FD4 CD800F CALL EXPR ;EVALUATE ADDRESS EXPRESSION 6715 1FD7 CD941A CALL EOL ;TEST FOR END OF LINE 6716 1FDA CD351F CALL FACDE ;CONVERT FACC TO ADDRESS IN D,E 6717 1FDD 210B02 LXI H,RUN ;MAKE INTO SUBROUTINE 6718 1FE0 E5 PUSH H 6719 1FE1 EB XCHG ;MOVE ADDRESS TO HL 6720 1FE2 E9 PCHL ;EXECUTE USER'S ROUTINE 6721 ;PAGE 6722 IF HUNTER 6723 1 ; 6724 1 ; 6725 1 BAUD EQU $ 6726 1 ; 6727 1 ; SOFTWARE BAUD SELECTION ON SIO BOARDS MODIFIED BY 6728 1 ; W. HARTER, COYOTE COMPUTERS, DAVIS, CALIF. 67291 6730 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6731+ 21:37 05/19/2019 6732+ PAGE 117 6733 6734 6735 6736 1 ; 6737 1 ; COMMAND 'BAUD <RATE>' WHERE <RATE>=110,300,1200,2400,9600 6738 1 ; 6739 1 RST 1 ;SKIP BLANKS 6740 1 LXI D,BAUDS+6 ;POINT BAUD TABLE 6741 1 CALL SEEK ;GO SEARCH BAUD TABLE 6742 1 JZ CVERR ;BRIF RATE NOT FOUND 6743 1 DCX H ;ADJUST POINTER 6744 1 BAUD1: INX H ;LOOK AT CHARACTER 6745 1 CALL NUMER ;TEST FOR DIGIT 6746 1 JZ BAUD1 ;LOOP PAST RATE 6747 1 CALL EOL ;TEST FOR END OF LINE 6748 1 XCHG ;POINT ADDRESS OF CONTROL BYTES 6749 1 MOV E,M ;LOW BYTE TO E 6750 1 INX H ;POINT NEXT 6751 1 MOV D,M ;HIGH BYTE TO D 6752 1 LDA EDSW ;GET MODE SWITCH 6753 1 ORA A ;TEST IT 6754 1 JNZ SETIT ;BRIF IMMEDIATE MODE 6755 1 LXI H,BAUDS ;POINT 'BAUD' 6756 1 CALL TERMM ;WRITE IT 6757 1 PUSH D ;SAVE ADDRESS OF CONTROL BYTES 6758 1 LXI H,IOBUF ;POINT BUFFER 6759 1 MVI B,4 ;LOAD COUNT 6760 1 CALL COPYD ;COPY RATE TO IOBUF 6761 1 MVI M,0 ;TERMINATE MESSAGE 6762 1 CALL TERMO ;WRITE IT 6763 1 POP D ;RESTORE CONTROL BYTES 6764 1 SETIT: LXI H,4 ;LOAD OFFSET 6765 1 DAD D ;PIONT 1ST CONTROL BYTE 6766 1 MVI A,40H ;LOAD RESET 6767 1 OUT TTY+1 ;WRITE IT 6768 1 MVI A,M ;MODE BYTE 6769 1 OUT TTY+1 ;WRITE IT 6770 1 MVI A,17H ;ENABLE BYTE 6771 1 OUT TTY+1 ;WRITE IT 6772 1 INX H ;POINT SPEED BYTE 6773 1 MOV A,M ;LOAD IT 6774 1 OUT 8 ;WRITE IT 6775 1 BAUD2: IN TTY+1 ;READ STATUS 6776 1 ANI 2 ;TEST 6777 1 JZ BAUD2 ;WAIT FOR ACKNOWLEDGMENT 6778 1 IN TTY ;READ AND DISCARD 6779 1 LDA EDSW ;GET MODE SWITCH 6780 1 ORA A ;TEST IT 6781 1 JZ RUN ;BRIF RUN MODE 6782 1 JMP GETCM ;BRIF IMMEDIATE MODE 6783 1 BAUDS: DB 'BAUD',0FEH ;BAUD MESSAGE 6784 1 6785 1 ; 6786 1 ; BAUD TABLE. 67871 6788 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6789+ 21:37 05/19/2019 6790+ PAGE 118 6791 6792 6793 6794 1 ; 6795 1 B110: DB '110 ',0FAH,2,0 6796 1 6797 1 DW B110 6798 1 B300: DB '300 ',0FBH,0 6799 1 6800 1 DW B300 6801 1 B1200: DB '1200',0FAH,0 6802 1 6803 1 DW B1200 6804 1 B2400: DB '2400',0FAH,32,0 6805 1 6806 1 DW B2400 6807 1 B9600: DB '9600',0FAH,34,0 6808 1 6809 1 DW B9600 6810 1 DB 0 ;END OF BAUD TABLE 6811 1 ; 6812 ENDIF 6813 ; 6814 IF CPM ;CPM INITIALIZATION STORES 6815 1 ;...BIOS JUMP TABLE HERE 6816 1 BTSTAT: DS 3 ;JMP TO BIOS CONSOLE STATUS 6817 1 BTIN: DS 3 ;JMP TO BIOS CONSOLE INPUT 6818 1 BTOUT: DS 3 ;JMP TO BIOS CONSOLE OUTPUT 6819 ENDIF 6820 ;PAGE 6821 1FE2 ROMEN EQU $-1 6822 ; 6823 2000 ORG 8192 ;RAM STARTS OF 8K BOUNDARY 6824 IF LARGE OR CPM ;ADJUST START OF RAM IF 8+K 6825 1 ORG 2400H ;RAM STARTS ON 9K BOUNDARY 6826 ENDIF 6827 ; 6828 ; ALL CODE ABOVE THIS POINT IS READ ONLY AND CAN BE PROM'ED 6829 ; 6830 ; 6831 2000 RAM EQU $ 6832 ; 6833 2000 BZERO EQU $ 6834 2000 FORNE: DS 1 ;# ENTRYS IN TABLE (MUST BE HERE) 6835 2001 DS 112 ;ROOM FOR 8 NESTS (MUST BE HERE) 6836 2071 TAPES: DS 1 ;TAPE SWITCH (MUST BE HERE) 6837 2072 DIMSW: DS 1 ;DIM SWITCH (MUST BE HERE) 6838 2073 OUTSW: DS 1 ;OUTPUT SWITCH (MUST BE HERE) 6839 2074 ILSW: DS 1 ;INPUT LINE SWITCH (MUST BE HERE) 6840 2075 RUNSW: DS 1 ;RUN SWITCH(MUST BE HERE) 6841 2076 EDSW: DS 1 ;MODE SWITCH(MUST BE HERE) 6842 2077 EZERO EQU $ 6843 ; 6844 2077 LINEN: DS 5 68451 6846 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6847+ 21:37 05/19/2019 6848+ PAGE 119 6849 6850 6851 6852 207C IMMED: DS 82 ;IMMEDIATE COMMAND STORAGE AREA 6853 20CE IOBUF: DS 82 ;INPUT/OUTPUT BUFFER 6854 2120 STRIN: DS 256 ;STRING BUFFER AREA 6855 2220 OUTA: DS 3 ;*** FILLED IN AT RUN TIME 6856 2223 INDX: DS 2 ;HOLDS VARIABLE NAME OF FOR/NEXT 6857 2225 REL: DS 1 ;HOLDS THE RELATION IN AN IF STMT 6858 2226 IFTYP: DS 1 ;HOLDS TYPE CODE OF LEFT SIDE 6859 2227 TVAR1: DS 4 ;TEMP STORAGE 6860 222B TVAR2: DS 4 ;DITTO 6861 222F TEMP1: DS 4 ;TEMP STORAGE FOR FUNCTIONS 6862 2233 TEMP2: DS 4 6863 2237 TEMP3: DS 4 6864 223B TEMP4: DS 4 6865 223F TEMP5: DS 4 6866 2243 TEMP6: DS 4 6867 2247 TEMP7: DS 4 6868 224B LINEL: DS 2 ;HOLDS MIN LINE NUMBER IN LIST 6869 224D LINEH: DS 2 ;HOLDS MAX LINE NUMBER IN LIST 6870 224F PROMP: DS 1 ;HOLDS PROMPT CHAR 6871 2250 EXPRS: DS 2 ;HOLDS ADDR OF EXPRESSION 6872 2252 ADDR1: DS 2 ;HOLDS TEMP ADDRESS 6873 2254 ADDR2: DS 2 ;HOLDS TEMP ADDRESS 6874 2256 ADDR3: DS 2 ;HOLDS STMT ADD DURING EXPR EVAL 6875 2258 FACC: DS 4 6876 225C FTEMP: DS 12 6877 2268 PARCT: DS 1 6878 2269 SPCTR: DS 2 6879 226B CMACT: DS 1 ;COUNT OF COMMAS 6880 226C FNARG: DS 4 ;SYMBOLIC ARG & ADDRESS 6881 2270 STMT: DS 2 ;HOLDS ADDR OF CURRENT STATEMENT 6882 2272 ENDLI: DS 2 ;HOLDS ADDR OF MULTI STMT PTR 6883 2274 MULTI: DS 1 ;SWITCH 0=NO, 1=MULTI STMT LINE 6884 2275 DEXP: DS 1 6885 2276 COLUM: DS 1 ;CURRENT TTY COLUMN 6886 2277 RNDX: DS 2 ;RANDOM VARIABLE STORAGE 6887 2279 RNDY: DS 2 ;THE RND<X>,TRND<X>,AND RNDSW 6888 227B RNDZ: DS 2 ;MUST BE KEPT IN ORDER 6889 227D RNDS: DS 2 6890 227F TRNDX: DS 2 6891 2281 TRNDY: DS 2 6892 2283 TRNDZ: DS 2 6893 2285 TRNDS: DS 2 6894 2287 RNDSW: DS 1 6895 2288 FNMOD: DS 1 ;SWITCH, 0=NOT, <>0 = IN DEF FN 6896 2289 LINE: DS 2 ;HOLD ADD OF PREV LINE NUM 6897 228B STACK: DS 2 ;HOLDS ADDR OF START OF RETURN STACK 6898 228D PRSW: DS 1 ;ON=PRINT ENDED WITH , OR ; 6899 228E NS: DS 1 ;HOLDS LAST TYPE (NUMERIC/STRING) 6900 228F DATAP: DS 2 ;ADDRESS OF CURRENT DATA STMT 6901 2291 DATAB: DS 2 ;ADDRESS OF DATA POOL 6902 2293 PROGE: DS 2 ;ADDRESS OF PROGRAM END 69031 6904 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6905+ 21:37 05/19/2019 6906+ PAGE 120 6907 6908 6909 6910 ; 6911 IF CPM 6912 1 ;TEMPORARY CODE FOR INITIALIZATION HERE 6913 1 ; 6914 1 INITC: LHLD BOOT+1 ;PTR TO BIOS TABLE 6915 1 LXI D,CSTAT ;OFFSET OF CONSOLE QUERY ENTRY 6916 1 DAD D ;POINT INTO BIO JUMP TABLE 6917 1 LXI D,BTSTAT;POINT INTO BASIC JMP TABLE 6918 1 MVI B,9 ;COUNT 6919 1 CALL COPYH ;MOE BIOS TABLE INTO BASIC 6920 1 MVI A,0C3H ;JMP OP CODE 6921 1 LXI H,RST1! STA 8H! SHLD 9H 6922 1 6923 1 LXI H,RST2! STA 10H! SHLD 11H 6924 1 6925 1 LXI H,RST3! STA 18H! SHLD 19H 6926 1 6927 1 LXI H,RST4! STA 20H! SHLD 21H 6928 1 6929 1 LXI H,RST5! STA 28H! SHLD 29H 6930 1 6931 1 LXI H,RST6! STA 30H! SHLD 31H 6932 1 6933 1 LHLD BDOS+1 ;LOCATE TOP OF RAM 6934 1 JMP INIT1 ;CONTINUE AS IN NON-CPM VERSION 6935 ENDIF 6936 ; 6937 ; 6938 2295 DS 1 ;DATA STATEMENT FLAG (MUST BE HERE) 6939 2296 BEGPR: 6940 ; 6941 END 6942 NO PROGRAM ERRORS 69431 6944 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 6945+ 21:37 05/19/2019 6946+ PAGE 121 6947 6948 6949 6950 SYMBOL TABLE 6951 6952 * 01 6953 6954 A 0007 ABS 0BC7 ADDR1 2252 ADDR2 2254 6955 ADDR3 2256 ALPHA 1B21 ARG 1C74 ARGNU 1C83 6956 ASCII 0D9A ATN 0AD4 ATN1 0AE3 ATNCO 1DD2 6957 B 0000 BACKS 005C BASIC 0000 * BDOS 0005 6958 BEGPR 2296 BINFL 1C89 BOOT 0000 BZERO 2000 6959 C 0001 CERCE 110B CHA1 0953 CHA2 0968 6960 CHA3 0998 CHANG 092A CHRFN 0D8F CKERR 1C23 6961 CMACT 226B COLUM 2276 COMP1 0013 COMP2 1A79 6962 COMP3 1A7D COMP4 1A7E COMP5 1A81 COMP6 1A8E 6963 CONC2 0D3C CONC3 0D44 CONC4 0D4C CONC5 0D62 6964 CONC6 0D76 CONCA 0D26 CONTI 02EE COPYD 1C4D 6965 COPYH 1C58 COS 0AB3 CPM 0000 CPY4D 1C4B 6966 CPY4H 1C56 CR1 1939 CRLF 195A CSTAT 0003 6967 CVERR 1C1F D 0002 DAERR 1C17 DATAB 2291 6968 DATAL 1E9B DATAP 228F DEFLI 1F1E DEXP 2275 6969 DIM 09B1 DIM1 09CF DIM2 0A01 DIM3 0A0C 6970 DIM4 0A17 DIMSW 2072 DV8 12BC E 0003 6971 ECHO 19B1 ED7A 013D ED7B 0146 EDIT1 00E8 6972 EDIT2 00FD EDIT3 0103 EDIT5 0114 EDIT6 0129 6973 EDIT7 0135 EDIT8 010F EDM1 139D EDM2A 13AC 6974 EDM3 13B0 EDM4 13C4 EDSW 2076 ELOOP 0B9D 6975 EM 00FE ENDIT 01CB ENDLI 2272 ENDXP 114B 6976 EOL 1A94 EOL1 1AA3 ERRMS 1E3C ERROR 1C31 6977 EV1 11C0 EV10 12F9 EV11 1352 EV1A 11C8 6978 EV2 11D0 EV2A 11F0 EV3 1207 EV3A 1228 6979 EV4 124C EV4A 1260 EV4B 126B EV5 1278 6980 EV6 1296 EV7 12B2 EV9 12C7 EVAL 11BA 6981 EVCOM 1377 EVLD 1383 EVLD1 1394 EVNEG 1363 6982 EVPS 0A8B EVPS1 0A95 EVPS2 0A9C EXEC 0164 6983 EXEC1 0174 EXP 0B6A EXP1 0B84 EXPCO 1E1E 6984 EXPR 0F80 EXPRS 2250 EZERO 2077 FACC 2258 6985 FACDE 1F35 FAD1 18F1 FADD 1637 FADD3 1656 6986 FADD4 1663 FADD6 1686 FADD7 1688 FADD9 1694 6987 FADDA 16BC FADDJ 131B FADDT 18F0 FADT3 18EE 6988 FALSE 020B FATAL 00F7 FBIN 1C66 FBIN1 1C71 6989 FDE1 1F4A FDE2 1F57 FDEC 0D1A FDIV 179B 6990 FDIV3 17BA FDIV5 17D0 FDIV6 17EA FDIV7 17F0 6991 FDIV8 17FE FEXP 18DC FIN 142E FIN2 143E 6992 FIN3 1464 FIN4 146C FIN5 146E FIN6 147B 6993 FIN7 1480 FIN8 1488 FIN8A 14A0 FIN9 14A2 6994 FINB 14BE FIND 14E5 FIND0 14E8 FIND1 1F61 6995 FIND2 1F7B FIND3 1F83 FMTEN 14D5 FMUL 1718 6996 FMUL5 1742 FMUL6 174E FMUL7 1754 FMUL8 176A 6997 FMUL9 1770 FN 0EB1 FN2 0EF3 FN3 0F11 6998 FN4 0F19 FNARG 226C FND3 0CAA FNEG1 16CA 6999 FNEG2 16D1 FNL 103E FNL3 1056 FNLIT 1F21 7000 FNMOD 2288 FNORM 16DD FNRM1 16EF FNRM2 16F9 70011 7002 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 7003+ 21:37 05/19/2019 7004+ PAGE 122 7005 SYMBOL TABLE 7006 7007 7008 FNRM3 1705 FOR 03E5 FOR1 042A FOR2 042E 7009 FOR4 0452 FOR5 045E FOR6 046E FOR7 047A 7010 FOR8 0481 FOR9 04B2 FORA 04E0 FORNE 2000 7011 FOUT 14F0 FOUT0 1501 FOUT2 150B FOUT3 151C 7012 FOUT4 1527 FOUT5 1537 FOUT6 153D FOUT7 1560 7013 FOUT9 1570 FOUTA 157F FOUTB 1582 FOUTC 1587 7014 FOUTD 158C FOUTH 1599 FOUTI 15B0 FOUTJ 15B4 7015 FOUTK 15D3 FOUTL 15D6 FOUTM 15D9 FOUTN 15F1 7016 FOUTO 15FC FOUTP 15FD FOUTQ 1609 FOUTR 1611 7017 FOUTS 161F FOUTT 1629 FOUTU 155D FOUTV 1516 7018 FOV1 187D FOVUN 1871 FREE 01A0 FSB1 18E4 7019 FSHFT 18FB FSUB 170C FSUBT 18E3 FTEMP 225C 7020 FTEST 18CE FUNC0 101B FUNC4 1036 FUNCT 1C98 7021 GETCH 1A3F GETCM 00C9 GETS1 181D GETS2 182E 7022 GETS3 182F GETS4 183F GETS5 1841 GETS8 184F 7023 GETS9 186C GETST 180D GOSBL 1EAF GOSU1 0343 7024 GOSUB 033A GOTO 02F6 GOTO2 0306 GOTOL 1ED0 7025 GTEMP 1B00 H 0004 HALFP 1DD6 HDR1 01E8 7026 HDRTL 01E6 HUNTE 0000 IF1 0507 IF2 050B 7027 IF3 050F IF4 0518 IF5 0520 IF6 052A 7028 IF8 0562 IF9 0570 IFF 05A8 IFG 05B1 7029 IFH 05BA IFI 05C2 IFJ 05D0 IFK 05D6 7030 IFL 05DD IFM 05E7 IFN 05EC IFSTM 04E9 7031 IFTYP 2226 ILSW 2074 IMMED 207C INDX 2223 7032 INIT1 0081 INIT2 0092 INIT3 009F INP 0D0A 7033 INPL 07A5 INPL1 07C7 INPL2 07D3 INPU1 0733 7034 INPU2 073E INPU3 0742 INPU4 074D INPU5 0760 7035 INPU6 0761 INPU7 0775 INPU8 0788 INPU9 078D 7036 INPUA 079C INPUB 0796 INPUT 0721 INS 1181 7037 INS1 1182 INST1 0E5B INST2 0E60 INST3 0E67 7038 INST5 0E83 INST6 0E87 INST8 0E92 INST9 0EA3 7039 INSTA 0EAC INSTR 0E51 INT 0BE2 INT2 0BF0 7040 INT3 0BFF INT4 0C09 INT5 0C0F IOBUF 20CE 7041 IRAM 0151 JMPTB 1E4C JUMP 1FD4 KEY 01DC 7042 KEYL 1E79 L 0005 LARGE 0000 LDALP 0FAF 7043 LDDTN 1091 LDDTP 10A5 LDF 0F9F LDFN 0FF4 7044 LDFN1 0FFA LDFNC 107F LDNUM 0F9C LDPI 1075 7045 LDRND 1063 LDV 0FDE LDV1 0FC6 LDV2 0FD3 7046 LDV2A 13D7 LEFT 0E05 LENFN 0D89 LET 05F1 7047 LET1 060C LET2 0626 LET2A 0631 LET3 063D 7048 LET4 064B LET5 0657 LET6 0664 LET7 0679 7049 LET8 0686 LET9 0689 LINE 2289 LINEH 224D 7050 LINEL 224B LINEN 2077 LINEO 1A09 LIST 0262 7051 LIST1 0292 LIST2 0295 LIST4 02B5 LIST5 02C5 7052 LIST6 02CF LIST7 02D5 LIST8 02E5 LIT1 10BF 7053 LIT2 10E3 LIT3 10FF LITST 10B9 LLINE 1D84 7054 LN 0B13 LN0 0B2C LN1 0B38 LN2 0B3D 7055 LN2C 1DAE LN2E 1E0A LNC 1E22 LNCO 1E06 7056 LOCAT 1F5E LOG 0B61 LOOKD 0F95 LOOKO 111D 7057 LOUT 1A14 M 0006 MDSGN 177F MID0 0E21 7058 MID1 0E2F MID2 0E3C MID3 0E40 MID4 0E48 70591 7060 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 7061+ 21:37 05/19/2019 7062+ PAGE 123 7063 SYMBOL TABLE 7064 7065 7066 MIDFN 0E17 MULTI 2274 NEG 0C7A NEGON 1DAA 7067 NEW 0188 NEW0 0193 NEW1 0198 NEXT 0692 7068 NEXT1 06A8 NEXT2 06B3 NEXT3 06BC NEXT5 06F7 7069 NEXT6 06FB NEXT7 06EF NEXTL 1EA8 NOTBS 19A6 7070 NOTCH 19A6 NOTCO 1983 NOTCR 1975 NOTEO 1AAD 7071 NOTZ1 1A22 NOTZ2 1A32 NRNDX 1D6B NS 228E 7072 NULLI 1DEC NUM1 0DB2 NUMEN 1B30 NUMER 1B2A 7073 NUMFN 0DA7 NXERR 1C1B ON 08B5 ON3 08DB 7074 ON3A 08DC ON4 08EF ON5 08F9 ON6 08FD 7075 ON7 0909 ON8 0912 ON9 091D ONE 1DEA 7076 OP1 1158 OP2 1197 OP3 11AC OP4 11B7 7077 OPLP1 1163 OPLP2 1167 OT1 19BD OT2 19CC 7078 OT4 19DB OUTA 2220 OUTP 084A OUTSW 2073 7079 OVERR 1C27 PACK 1AB5 PARCT 2268 PAUZ 1968 7080 PCHOF 1D62 PEEK 1FAB PI 1DA2 PILIT 1D97 7081 PK1 1ABD PK3 1AD1 POKE 1FB6 POS 0D20 7082 POWER 1323 PRCNT 1A6D PRIN2 038B PRIN4 0356 7083 PRIN5 0396 PRIN6 039F PRIN7 0389 PRIN8 03AA 7084 PRIN9 03AD PRINA 03B3 PRINB 03CA PRINC 03D3 7085 PRINT 0355 PRLIN 1BF1 PROGE 2293 PROMP 224F 7086 PRSW 228D PSW 0006 QTRPI 1DA6 RAM 2000 7087 RANDO 089F RDY 00C3 RDYM 00C0 READ 07E1 7088 READ1 07F0 READ2 080B READ3 081B READ4 0820 7089 READ5 082C READ6 0833 READ7 0843 READ8 0844 7090 READY 1E26 REDIM 0A1D REDM1 0A33 REIN 1907 7091 REL 2225 RESTO 0316 RETUR 0322 RIGHT 0E0E 7092 RND 0C84 RND1 0C96 RND2 0C9C RND4 0CB9 7093 RND5 0CC5 RND6 0CCD RND7 0D01 RNDLI 1CB4 7094 RNDP 1D65 RNDS 227D RNDSW 2287 RNDX 2277 7095 RNDY 2279 * RNDZ 227B ROMEN 1FE2 * RSSGN 1791 7096 RST1 0008 RST2 0010 RST3 0018 RST4 0020 7097 RST4A 003B RST4B 0044 RST5 0028 RST6 0030 7098 RTERR 1C13 RUN 020B RUN1 021B RUN2 0225 7099 RUN3 0237 RUN4 0238 RUN7 024F RUNCM 01F4 7100 RUNSW 2075 SADR 1B19 SAVE 0255 SCH0 1B3C 7101 SCH1 1B3F SCH2 1B61 SCH3 1B65 SCH4 1B7D 7102 SCH5 1B81 SCH6 1B8F SCH7 1BA3 SCH8 1BB8 7103 SCH9 1BC4 SEARC 1B34 SEEK 1F86 SEEK1 1F86 7104 SEEK2 1F99 SEEK3 1FA9 SGN 0BD0 SGN1 0BD6 7105 SIN 0A41 SIN1 0A49 SIN3A 0A78 SINCO 1DE6 7106 SKP2Z 1AF9 SKPP 10A1 SNERR 1C0F SP 0006 7107 SPAC1 0DE9 SPACE 0DE1 SPCTR 2269 SQC1 1DB2 7108 SQC2 1DB6 SQC3 1DBA SQR 0C27 SQR1 0C64 7109 SQUI2 1AED SQUIS 1AE2 STACK 228B STEPL 1D8D 7110 STERR 1C0B STMT 2270 STOP 0872 STOPM 1E2D 7111 STR11 0DFE STRFN 0DF1 STRIN 2120 SUB1 1898 7112 SUB2 18A3 SUB3 18AD SUB4 18BC SUBSC 1885 7113 SVSGN 1789 TABLI 1D89 TABST 19DF TAN 0ABC 7114 TAPE 01BE TAPES 2071 TBASE 0100 TBLP 19EE 7115 TBLP2 19F5 TBON 19FA TBSPA 19FF TEMP1 222F 7116 TEMP2 2233 TEMP3 2237 TEMP4 223B TEMP5 223F 71171 7118 8080 MACRO ASSEMBLER, VER 3.0 ERRORS = 0 7119+ 21:37 05/19/2019 7120+ PAGE 124 7121 SYMBOL TABLE 7122 7123 7124 TEMP6 2243 * TEMP7 2247 TEN 1D9E TERMI 1904 7125 TERMM 19BD TERMO 19B5 TEST1 1950 TESTO 194F 7126 THENL 1D92 TOLIT 1ED2 TREAD 191D TRNDS 2285 * 7127 TRNDX 227F TRNDY 2281 * TRNDZ 2283 * TRUE 0581 7128 TSTC1 1A5E TSTCC 1A3A TSTEL 1AA8 TTY 0002 7129 TVAR1 2227 TVAR2 222B TWO 1D9A ULERR 1C03 7130 UNERR 1C2C UPARR 005E VAL 0DBA VAL1 0DC6 7131 VAL2 0DCF VAR 1BC9 VAR2 1BDE VAR3 1BE9 7132 VERS 1D78 WHATL 1D73 XEQ 01F9 XSQR 1348 * 7133 Z1 1A28 Z2 1A38 ZEROM 1C5E ZMERR 1C07 7134 7135