1;EDITS: 2; 30-JUN-08 KJL 3; - CREATED FROM IMSAI 8K BASIC VERSION 1.4 MANUAL 4; 5; 07-FEB-14 UM 6; - FIXED TYPOS, MATCHES MANUAL NOW 7; 8; 19-JUN-19 UM 9; - FIXED CHARACTER LITERALS NOT WORKING WITH MACRO-80 10; - FIXED COMMENTS 11;--------------------------------------------------------- 12; BASIC30.ASM 1.4 05/19/77 JRB 8K BASIC 13; BASICS2.ASM 1.401 05/11/77 DK 8K BASIC 14; BASIC19.ASM 1.401 05/11/77 DH 15; BASIC18.ASM 1.401 05/10/77 JRB 16; BASIC16.ASM 1.401 05/09/77 DH 17; BASIC11.ASM 1.401 05/04/77 DH 18; BASIC10.ASM 1.401 05/03/77 DH 19; BASIC8.ASM 1.401 05/02/77 DH 20; 21; IMSAI 8K-9K BASIC 22; 23; COPYRIGHT (C) 1977 24; IMSAI MANUFACTURING CORPORATION 25; 14860 WICKS BLVD, SAN LEANDRO CALIFORNIA 94577 26; 27; CORRECTION HISTORY: 28; 29; 02/25/77 - FIXED BEGPR POINTERS 30; - FIXED LOG(X) FOR 0.5 < X < 1.0 31; - FIXED SQR(X) FOR 0.0 < X < 0.5 32; - FIXED SCI NOTATION INPUT ROUTINE 33; - FIXED EDIT ROUTINE WHEN PROGRAM ENDS ON 34; 00 BOUNDARY (SYSTEM USED TO GO AWAY) 35; - ADDED XEQ COMMAND (LIKE RUN BUT KEEPS DATA) 36; - SOFTWARE MEMORY PROTECT OF 1ST 9K IMPLIMENTED 37; - FIXED TAB FOR BACKWARDS MOVEMENT 38; - FIXED OV ERROR FOR SMALL X IN TRIG,LOG & EXP 39; - ADDED PROGRAM CHAINING CAPABILITY. 40; - FIXED EXP(X) ROUTINE FOR LARGE X. 41; - ADDED PEEK(X) COMMAND 42; - ADDED POKE A,X COMMAND 43; - ADDED CALL A COMMAND 44; 04/02/77 - ADDED TARBEL CASSETTE SAVE AND LOAD 45; - ADDED FIX LINE EDITOR 46; - RENAMED NATURAL LOG TO LN(X) 47; - ADDED BASE 10 LOG AS LOG(X) 48; - ALLOWED FOR DAZZLER IN OUTPUT ROUTINE 49; - ADDED LINE # SEARCH UTILITY (LOCAT EQU $) 50; - ADDED TABLE SEARCH UTILITY (SEEK EQU $) 51; - ARRAYS CAN NOW HAVE > 256 ELEMENTS PER DIM 52; 04/09/77 -ADDED CONDITIONAL ASSY PARAMS FOR 8 AND 9K 53; -FIXED POWER ERROR. (X^B WHEN B=0 GAVE X^2.) 54; -ADDED CONTROL H AS PHYSICAL RUBOUT OF CHAR 55; 04/27/77 -CHANGE RST'S TO RUN UNDER CP/M 56; -ADDED EXPRESSION EVALUATER FIX 57; -LOAD UNDER CP/M 58; 05/02/77 -ADD DDT, BYE COMMANDS, BIOS I/O 59; 05/03/77 -OPTIMIZE FUNCTION ITERATION LOOP (SIN5) 60; -SO UNDERFLOW CAN BE MADE NON-FATAL 61; 05/04/77 -OPTIMIZE SIN(X) ROUTINE 62; -ADD NON-FATAL ERRORS 63; 05/09/77 -SQUISH TO INCLUDE PEEK,POKE,CALL IN 8K 64; 05/11/77 -MAKE RND(X) USE X AS RANGE; X^0->1,0^X->0 65; -TAB(N) GO TO NEXT LINE IF PAST POSITION 66; 5/12/77 - BUG IN NESTED FOR'S AND REENTERED FOR'S FIXED 67; 68; ASSEMBLY PARAMETERS: 69 LARGE EQU 0 ;-1=9K ASSEMBLY, 0=8K 70 CPM EQU 0 ;-1=RUN UNDER CPM 71 HUNTER EQU 0 ;-1= INCLUDE BAUD COMMAND 72; 73; CPM EQUATES 74; 75 BOOT EQU 0 ;WARM BOOT 76 BDOS EQU 5 ;BDOS ENTRY 77 TBASE EQU 0100H ;PROGRAM LOAD UNDER CPM 78 CSTAT EQU 3 ;OFFSET OF CONSOLE STATUS 79 ;...QUERY IN BIOS TABLE 80; 81; ASCII EQUATES, CHARACTER LITERALS NOT WORKING WITH MACRO-80 82; 83 UPARR EQU 05EH 84 BACKSL EQU 05CH 85; 86; BASIC EQUATES 87; 88 FATAL EQU 0F7H ;CODE FOR FATAL IS RST 6 89; 90BASIC: IF NOT CPM 91 ORG 0 92 LXI H,RAM+1024 93 MVI A,0AEH ;START OF INIT SEQUENCE 94 JMP INIT1 ;FINISH INIT 95 ENDIF 96; 97 IF CPM 98 ORG TBASE 99 JMP INITC ;USE TEMPORARY CODE AT END 100 ENDIF 101; 102; ORG 8 103; 104; SKIP CHARS POINTED BY H,L UNTIL NON-BLANK, 105; LEAVE IN REG A 106; 107RST1: MOV A,M ;LOAD THE BYTE AT (H,L) 108 CPI ' ' ;TEST IF BLANK 109 RNZ ;RETURN IF NOT 110 INX H ;POINT NEXT 111 JMP RST1 ;LOOP 112; 113; 114; ORG 16 115; 116; COMPARE STRING AT (H,L) TO STRING AT (D,E) 117; RETURN IF EQUAL (THRU X'00' IN D,E) OR ON FIRST NOT EQUAL 118; ONLY THE FIRST THREE CHARS NEED BE EQUAL 119; IGNORE ALL SPACES 120; 121RST2: PUSH B ;SAVE B,C 122 MVI B,0 ;INIT COUNT 123COMP1: RST 1 ;SKIP SPACES 124 LDAX D ;GET CHAR TO MATCH WITH 125 JMP COMP2 ;CONTINUE ELSEWHERE 126; 127; 128; ORG 24 129; 130; STORE THE FLOATING POINT ACCUMULATOR AT (H,L) 131; 132RST3: LXI D,FACC ;POINT FLOAT ACC 133 MVI B,4 ;BYTE COUNT 134 JMP COPYD ;GO MOVE IT 135; 136; 137; ORG 32 138; 139; INCREMENT H,L BY BYTE AT (SP), RETURN TO (SP)+1 140; 141RST4: XTHL ;GET RETURN ADDRESS IN H,L 142 MOV A,M ;GET THE INCREMENT 143 INX H ;POINT TRUE RETURN 144 XTHL ;PUT BACK TO STACK 145 PUSH D ;SAVE D,E 146 JMP RST4A ;CONTINUE 147; 148; 149; ORG 40 150; 151; LOAD THE FLOATING POINT ACCUM WITH THE 4 BYTES AT (H,L) 152; 153RST5: LXI D,FACC ;POINT FLOAT ACC 154 MVI B,4 ;BYTE COUNT 155 JMP COPYH ;GO MOVE IT 156; 157; 158; ORG 48 159; 160; PRINT: 'XX ERR & NNN' 161; **** IF ERROR MESSAGE CHANGES TO A DIFFERENT RST, 162; **** ...CHANGE "FATAL" EQUATE 163; 164RST6: XTHL ;SAVE HL, GET ERROR CODE PTR 165 PUSH PSW ;SAVE REGS 166 PUSH D 167 PUSH B 168 JMP ERROR ;CONTINUE 169; 170 IF NOT CPM 171 ORG 59 ;LEAVE 3 BYTES FOR DDT 172 ENDIF 173; 174RST4A: MOV E,A ;PUT IN LOW 175 ORA A ;TEST SIGN 176 MVI D,0 ;DEFAULT POSITIVE 177 JP RST4B ;BRIF + 178 MVI D,0FFH ;ELSE, NEG 179RST4B: DAD D ;BUMP H,L 180 POP D ;RESTORE D,E 181 RET ;RETURN 182;PAGE 183 DB 'COPYRIGHT (C) 1977 ' 184 DB 'IMSAI MFG CORP ' 185 DB 'SAN LEANDRO CA 94577 USA' 186; 187; INITIALIZATION ROUTINE 188; DETERMINE MEMORY SIZE. 189; (START AT 9K AND TRY 1K INCREMENTS TILL END) 190; SETUP POINTERS FOR STACK, DATA, AND PROGRAM 191; INIT SIO BOARD 192; 193INIT1: IF NOT CPM 194 OUT TTY+1 ;INIT TERMINAL 195 MVI A,40H 196 OUT TTY+1 197 MVI A,0BAH 198 OUT TTY+1 199 MVI A,37H 200 OUT TTY+1 201 LXI B,1024 ;1K INCR 202INIT2: MOV A,M ;GET A BYTE FROM MEMORY 203 CMA ;COMPLEMENT 204 MOV M,A ;REPLACE 205 CMP M ;TEST IF RAM/ROM/END 206 JNZ INIT3 ;BRIF OUT OF RAM 207 CMA ;RE-COMPLEMENT 208 MOV M,A ;PUT ORIG BACK 209 DAD B ;POINT NEXT BLOCK 210 JNC INIT2 ;LOOP 211 ENDIF 212; 213INIT3: SPHL ;SET STACK POINTER TO END OF MEMORY 214 LXI B,-256 ;ALLOW 256 BYTES FOR STACK 215 DAD B ;ADD TO ADDRESS 216 SHLD DATAB ;SAVE ADDR OF START OF DATA 217; 218; SOFTWARE WRITE PROTECT OF FIRST 9K OF RAM. 219; 220; BUT NO PROTECT UNDER CPM OR FOR 8K (EPROM) VERSION 221 IF LARGE AND NOT CPM 222 MVI A,2 ;SET PROTECT OF FIRST 1K BLOCK 223PROTC: OUT 0FEH ;SEND IT 224 ADI 4 ;ADDRESS NEXT 1K BLOCK 225 CPI 26H ;STOP AFTER 9 BLOCKS 226 JNZ PROTC ;CONTINUE TO PROTECT 227 ENDIF 228 XRA A ;GET A ZERO IN A 229 PUSH PSW ;SET STACK 1 LEVEL DEEP WITHOUT A GOSUB 230 LXI H,0 ;CLEAR H,L 231 DAD SP ;SP TO H,L 232 SHLD STACK ;SAVE BEG OF STACK 233 CALL IRAM ;INIT RAM 234 LXI D,NRNDX ;POINT TO RANDOM # SERIES 235 MVI B,8 ;LOAD COUNT 236 CALL COPYD ;COPY TO TRND<X> IN RAM TABLE 237 MVI M,2 ;SET RANDOM SWITCH 238 IF CPM 239 CALL NEW0 ;AUTOMATIC "NEW" 240 ENDIF 241 LXI H,VERS ;POINT VERSION MESSAGE 242RDYM: CALL TERMM ;WRITE IT 243; 244RDY EQU $ 245; 246; PRINT 'READY' 247; 248 LXI H,READY ;POINT READY MSG 249 CALL TERMM ;GO PRINT IT 250; 251GETCM EQU $ 252; 253; 254; COMMAND INPUT ROUTINE 255; 256; READ A LINE FROM THE TTY 257; IF STARTS WITH NUMERIC CH, ASSUME IT'S A BASIC STATEMENT 258; IF NOT, IT IS EITHER AN IMMEDIATE STATMENT, OR A COMMAND 259; 260 MVI A,':' ;PROMPT & ON SET FOR SW 261 STA EDSW ;SET MODE=EDIT 262 LHLD STACK ;GET STACK ADDRESS 263 SPHL ;SET REG SP 264 CALL TERMI ;GET A LINE 265 CALL PACK ;GO PACK THE NUMBER INTO B,C 266 MOV A,B ;GET HI BYTE OF LINE NUMBER 267 ORA C ;PLUS LOW BYTE 268 JZ EXEC ;BRIF EXEC STATEMENT 269 PUSH B ;SAVE LINE NUMBER 270 LXI D,IMMED+1 ;POINT SAVE AREA 271 XCHG ;FLIP/FLOP 272 MOV M,B ;PUT LO LINE 273 INX H ;POINT NEXT 274 MOV M,C ;PUT LO LINE 275 INX H ;POINT NEXT 276 MVI B,3 ;INIT COUNT 277EDIT1: LDAX D ;GET A BYTE 278 MOV M,A ;PUT IT DOWN 279 INR B ;COUNT IT 280 INX H ;POINT NEXT 281 INX D ;DITTO 282 ORA A ;TEST BYTE JUST MOVED 283 JNZ EDIT1 ;LOOP 284 MOV A,B ;GET COUNT 285 STA IMMED ;STORE THE COUNT 286 POP B ;GET LINE NUM 287 CALL LOCAT ;GO FIND REQUESTED LINE NUMBER 288 PUSH H ;SAVE H,L 289 JC EDIT5 ;BRIF IF LINE NOT FOUND 290EDIT2: MOV D,H ;COPY ADDR 291 MOV E,L ;TO D,E 292 MVI B,0 ;GET A ZERO 293 MOV C,M ;GET LEN 294 DAD B ;POINT NEXT STMT 295EDIT3: MOV A,M ;GET LEN NEXT STMT 296 ORA A ;TEST IT 297 JZ EDIT8 ;BRIF END 298 MOV B,A ;SET LENGTH 299 CALL COPYH ;ELSE MOVE LINE 300 JMP EDIT3 ;LOOP 301EDIT8: XCHG ;PUT NEW ADDR TO H,L 302 MOV M,A ;MARK END 303 SHLD PROGE ;AND UPDATE ADDRESS 304EDIT5: LDA IMMED ;GET LEN OF INSERT 305 CPI 4 ;TEST IF DELETE 306 JZ GETCM ;BRIF IS 307 MOV C,A ;SET LO LEN 308 MVI B,0 ;ZERO HI LEN 309 LHLD PROGE ;GET END OF PROG 310 MOV D,H ;COPY TO 311 MOV E,L ;D,E 312 DAD B ;DISP LEN OF INSERT 313 SHLD PROGE ;UPDATE END POINT 314 POP B ;GET ADDR 315EDIT6: LDAX D ;GET A BYTE 316 MOV M,A ;COPY IT 317 DCX D ;POINT PRIOR 318 DCX H ;DITTO 319 MOV A,D ;GET HI ADDR 320 CMP B ;COMPARE 321 JZ EDIT7 ;BRIF HI EQUAL 322 JNC EDIT6 ;BRIF NOT LESS 323EDIT7: MOV A,E ;GET LO ADDR 324 CMP C ;COMPARE 325 JNC ED7A ;MUST TEST FOR 00 BOUNDARY 326 JMP ED7B ;GO AROUND BOUNDARY TEST CODE 327ED7A: CMA ;COMPLIMENT LOW LINE NUMBER 328 CMP C ;AND COMPARE TO START 329 JNZ EDIT6 ;BRIF NOT = 330 ORA A ;NOT TEST FOR 00 331 JNZ EDIT6 ;THIS IS USUAL CASE 332ED7B: INX D ;POINT FORWARD 333 LXI H,IMMED ;POINT INSERT 334 MOV B,M ;GET LENGTH 335 CALL COPYH ;GO MOVE IT 336 JMP GETCM ;GO GET ANOTHER COMMAND 337; 338; IRAM INITIALIZE RAM 339; ZEROES RAM FROM BZERO TO EZERO 340; INITS RANDOM # CONSTANTS 341; RETURNS H=PTR TO TRND 342; 343IRAM: LXI H,BZERO ;CLEAR BZERO->EZERO 344 MVI B,EZERO-BZERO 345 CALL ZEROM 346 LXI D,NRNDX ;MOVE RANDOM # SERIES TO RNDX 347 LXI H,RNDX 348 MVI B,8 ;COUNT 349 JMP COPYD ;MOVE IT & RETURN 350;PAGE 351EXEC EQU $ 352; 353; 354; DECODE COMMAND IN IOBUFF 355; EXECUTE IF POSSIBLE 356; THEN GOTO GET NEXT COMMAND 357; 358; 359 STA MULTI ;RESET MULTI SW 360 STA FNMOD ;RESET FN TYPE 361 INR A ;GET A ONE 362 STA RUNSW ;SET IMMEDIATE MODE 363 LXI H,IOBUF+1 ;POINT SMT 364 LXI D,IMMED ;POINT NEW AREA 365EXEC1: MOV A,M ;GET A BYTE 366 STAX D ;PUT TO (D,L) 367 INX D ;POINT NEXT 368 INX H ;DITTO 369 ORA A ;TEST BYTE 370 JNZ EXEC1 ;CONTINUE 371 LXI H,NULLI ;POINT NO LINE NUM 372 SHLD LINE ;SAVE ADDR 373 LXI H,IMMED ;POINT START OF CMMD 374 JMP RUN3 ;GO INTO RUN PROCESSOR 375; 376NEW EQU $ 377; 378; NEW COMMAND 379; 'NEW'==>CLEAR PROGRAM AND DATA 380; 'NEW*'==>CLEAR PROGRAM ONLY 381; 382 PUSH H ;SAE PTR 383 LXI H,GETCM ;MAKE SUBROUTINE 384 XTHL ;RESTORE H 385 RST 1 ;GET 1ST NON-BLANK CHAR AFTER 'NEW' 386 SBI '*' ;TEST 387 JZ NEW1 ;BRIF PROGRAM CLEAR ONLY 388NEW0: XRA A ;GET A ZERO 389 LHLD DATAB ;POINT DATA AREA 390 MOV M,A ;CLEAR IT 391NEW1: LXI H,BEGPR ;POINT START 392 SHLD PROGE ;RESET PROGRAM END 393 MOV M,A ;CLEAR IT 394 RET 395; 396FREE EQU $ 397; 398; FREE COMMAND 399; COMPUTE AMOUNT OF AVAILABLE STORAGE (EXCLUDING DATA AREA) 400; 401 LHLD DATAB ;GET DATA BEG ADDRESS 402 XCHG ;PUT IN D,E 403 LHLD PROGE ;GET PROGRAM END ADDRESS 404 MOV A,E ;LO ADDR TO REG A 405 SUB L ;SUBTRACT 406 MOV E,A ;SAVE IT 407 MOV A,D ;HI ADDR TO REG A 408 SBB H ;SUBTRACT 409 MOV D,A ;SAVE IT 410 CALL BINFL ;GO FLOAT D,E 411 LXI H,IOBUF ;POINT BUFFER 412 CALL FOUT ;GO CONVERT TO OUTPUT 413 MVI M,0 ;MARK END 414 CALL TERMO ;GO WRITE IT 415 JMP GETCM ;CONTINUE 416; 417TAPE EQU $ 418; 419; TAPE COMMAND. DON'T ECHO INPUT. CONTINUE UNTIL KEY 420; COMMAND. 421; 422 MVI A,1 ;SET TAPE INPUT SWITCH 423 STA TAPES ;STORE IT 424 MVI A,11H ;GET DC1 (=READER ON) 425 CALL TESTO ;WRITE IT 426 JMP GETCM ;GO PROCESS INPUT 427; 428ENDIT EQU $ 429; 430; END COMMAND. IF TAPE PUNCH SWITCH IS ON, PUNCH 'KEY' THEN 431; CONTINUE 432; 433 LDA TAPES ;GET PAPER TAPE SWITCH 434 CPI 2 ;TEST FOR SAVE 435 JNZ RDY ;BRIF NOT 436 LXI H,KEYL ;POINT 'KEY' 437 CALL TERMM ;WRITE IT 438 CALL HDRTL ;GO PUT TRAILER 439; 440; KEY COMMAND. RESET TAPE SWITCH. TURN READER OFF 441; 442KEY: XRA A ;RESET TAPE SWITCH 443 STA TAPES 444 LXI H,PCHOF ;POINT READER/PUNCH OFF 445 JMP RDYM ;PRINT POFF+READY MESSAGE 446; 447HDRTL EQU $ 448; 449; PUNCH HEADER OR TRAILER ON PAPER TAPE. 450; 451 MVI B,25 ;LOAD COUNT 452HDR1: MVI A,0FFH ;LOAD RUBOUT 453 CALL TESTO ;WRITE IT 454 DCR B ;DECREMENT COUNT 455 XRA A ;ZERO A 456 CMP B ;TEST COUNT 457 RZ ;RETURN ON ZERO 458 JMP HDR1 ;CONTINUE 459;PAGE 460; 461; RUN PROCESSOR, GET NEXT STATMENT, AND EXECUTE IT 462; IF IN IMMEDIATE MODE, THEN RETURN TO GETCMMD 463; 464RUNCM: XRA A ;PUT A ZERO TO A 465 LHLD DATAB ;GET ADDRESS OF DATA POOL 466 MOV M,A ;INITIALIZE TO 0 467XEQ EQU $ ;START FOR EXECUTION WITH OLD DATA 468 CALL IRAM ;INITALIZE START OF RAM 469 LXI H,BEGPR-1 ;POINT 1 PRIOR TO BEGIN 470 SHLD DATAP ;RESTORE DATA STMT POINTER 471 MVI M,0 ;RESET DATA STMT POINTER 472 INX H ;POINT TO START 473 SHLD STMT ;SAVE IT 474 JMP RUN2 ;GO PROCESS IT 475; 476; STATEMENTS RETURN HERE TO CONTINUE PROCESSING 477RUN: LXI H,MULTI ;POINT MULTIPLE SWITCH 478 MOV A,M ;GET SW 479 ORA A ;TEST IT 480 JZ RUN1 ;BRIF NOT ON 481 MVI M,0 ;ELSE, RESET IT 482 LHLD ENDLI ;GET ADDRESS 483 JMP RUN3 ;GO PROCESS REMAIN 484RUN1: LHLD STMT ;ELSE, GET ADDR OF PREV STMT 485 MOV E,M ;GET LEN CODE 486 MVI D,0 ;CLEAR HIGH BYTE OF ADDR 487 DAD D ;INCR STMT POINTER 488 SHLD STMT ;SAVE IT 489RUN2: LDA RUNSW ;GET RUN TYPE 490 ORA A ;TEST IT 491 JNZ GETCM ;BRIF IMMEDIATE MODE 492 MOV A,M ;GET LEN CODE 493 ORA A ;TEST IF END 494 JZ ENDIT ;BRIF IS 495 INX H ;POINT LINE NUMBER 496 SHLD LINE ;SAVE ADDR 497 INX H ;POINT 2ND BYTE 498 INX H ;POINT 1ST PGM BYTE 499; 500; ENTER HERE TO DO IMMEDIATE COMMAND 501RUN3: RST 1 ;SKIP BLANKS 502RUN4: SHLD ADDR1 ;SAVE ADDR 503 CALL TSTCC ;GO SEE IF CONTROL-C OR O 504 LXI D,JMPTB ;POINT TO TABLE 505 CALL SEEK1 ;GO SEARCH COMMAND TABLE 506 JZ RUN7 ;BRIF COMMAND NOT FOUND 507 PUSH H ;SAVE H,L 508 LDAX D ;LOAD LOW BYTE 509 MOV L,A ;LOW BYTE TO L 510 INX D ;POINT NEXT 511 LDAX D ;LOAD HIGH BYTE 512 MOV H,A ;HIGH BYTE TO H 513 XTHL ;COMMAND ADDRESS TO STACK 514 RET ;JUMP TO ROUTINE 515RUN7: LHLD ADDR1 ;RESTORE H,L POINTER 516 JMP LET ;ASSUME IT'S LET STMT 517;PAGE 518; 519; SAVE COMMAND. TURN THE PUNCH ON THEN LIST PROGRAM 520; 521SAVE: MVI A,2 ;SET PUNCH MODE 522 STA TAPES 523 MVI A,12H ;GET DC2 (=PUNCH ON) 524 CALL TESTO ;WRITE IT 525 CALL HDRTL ;GP PUT HEADER 526; 527LIST EQU $ 528; 529; 530; LIST PROCESSOR 531; DUMP THE SOURCE PROGRAM TO TTY OR PAPER TAPE 532; 533; 534 RST 1 ;SKIP TO NON BLANK 535 LXI D,0 ;GET A ZERO IN D 536 XCHG ;FLIP TO H,L 537 SHLD LINEL ;SAVE IT 538 LXI H,9999H ;GET HIGH NUMBER IN H,L 539 SHLD LINEH ;SAVE IT 540 XCHG ;FLIP BACK 541 ORA A ;TEST IF EOL 542 JZ LIST1 ;BRIF IT IS 543 CALL PACK ;GO PACK THE NUMBER, IF ANY 544 MOV D,B ;COPY NUMBER TO D,L 545 MOV E,C ;SAME 546 XCHG ;FLIP TO H,L 547 SHLD LINEL ;SAVE IT 548 SHLD LINEH ;SAME 549 XCHG ;RESTORE H,L 550 RST 1 ;SKIP TO NON BLANK 551 CPI ',' ;TEST IF COMMA 552 JNZ LIST1 ;BRIF NOT 553 INX H ;POINT NEXT 554 RST 1 ;SKIP TO NON-BLANK 555 CALL PACK ;ELSE, GO GET THE NUMBER 556 MOV H,B ;COPY TO 557 MOV L,C ;D,L 558 SHLD LINEH ;SAVE IT 559LIST1: LXI H,BEGPR ;POINT BEGINNING OF PROGRAM 560LIST2: CALL TSTCC ;GO SEE IF CONTROL-C OR CONTROL-O 561 MOV A,M ;GET LEN CODE 562 ORA A ;TEST IF END OF PROGRAM 563 JZ ENDIT ;BRIF END OF PGM 564 SUI 3 ;SUBTRACT THREE 565 MOV B,A ;SAVE LEN 566 INX H ;POINT HIGH BYTE OF LINE# 567 XCHG ;FLIP H,L TO D,E 568 LHLD LINEL ;GET LOW LINE TO TEST 569 XCHG ;RESTORE H,L 570 MOV A,M ;GET LOW BYTE OF LINE NUMBER 571 CMP D ;COMP WITH LINEL 572 JC LIST8 ;BRIF LESS 573 JNZ LIST4 ;BRIF NOT EQUAL 574 INX H ;POINT NEXT 575 MOV A,M ;GET NEXT BYTE OF LINE# 576 DCX H ;POINT BACK 577 CMP E ;COMP LOW BYTES 578 JC LIST8 ;BRIF LESS 579LIST4: XCHG ;SAVE H,L IN D,E 580 LHLD LINEH ;GET HIGH LINE FOR TEST 581 XCHG ;RESTORE H,L 582 MOV A,M ;GET LINE BYTE 583 CMP D ;COMPARE HIGH BYTES 584 JZ LIST5 ;BRIF EQUAL 585 JNC ENDIT ;BRIF HIGHER 586 JMP LIST6 ;GO AROUND 587LIST5: INX H ;POINT NEXT 588 MOV A,M ;GET NEXT BYTE 589 DCX H ;POINT BACK 590 CMP E ;COMPARE LOW BYTES 591 JZ LIST6 ;BRIF EQUAL 592 JNC ENDIT ;BRIF HIGHER 593LIST6: LXI D,IOBUF ;POINT BUFFER AREA 594 CALL LINEO ;CONVERT LINE NUMBER 595LIST7: MOV A,M ;GET A BYTE 596 STAX D ;PUT IT TO BUFFER 597 INX D ;POINT NEXT BUFF 598 INX H ;POINT NEXT PROG 599 DCR B ;DECR CTR 600 JNZ LIST7 ;LOOP 601 PUSH H ;SAVE HL ADDR 602 CALL TERMO ;GO TYPE IT 603 POP H ;RETRIEVE H ADDR 604 JMP LIST2 ;CONTINUE 605LIST8: MOV E,B ;PUT LEN IN E 606 MVI D,0 ;CLEAR D 607 DAD D ;POINT NEXT STMT 608 INX H ;POINT NEXT 609 INX H ;POINT LEN CODE 610 JMP LIST2 ;GO LIST IT 611; 612; 613CONTI EQU $ 614; 615; CONTINUE EXECUTION AT STATEMENT FOLLOWING STOP OR AT 616; STATEMENT THAT WAS INTERRUPTED WHEN CONTROL-C WAS TYPED 617; 618; 619 LXI H,LINEN ;POINT LINE NUMBER OF LAST STOP/ERROR/ 620 MOV A,M ;GET 1ST CHAR 621 ORA A ;TEST IF IMMED CMMD 622 JZ LET ;BRIF IF IMMED CMMD 623;PAGE 624; 625; 626; STMT: GOTO NNNN 627; 628; 629GOTO: XRA A ;CLEAR REG A 630 STA EDSW ;RESET IMMED MODE (IF IT WAS SET) 631 STA RUNSW ;AND RUN TYPE 632 CALL NOTEO ;ERROR IF END-OF-LINE 633 CALL PACK ;GO GET LINE NUMBER IN B,C 634 CALL EOL ;ERROR IF NOT END-OF-LINE 635GOTO2: CALL LOCAT ;GO SEARCH FOR REQUESTED LINE # 636 JC ULERR ;BRIF NOT FOUND 637 SHLD STMT ;SAVE ADDR 638 XRA A ;GET A ZERO 639 STA MULTI ;TURN OFF MULTIPLE STMTS 640 JMP RUN2 ;GO PROCESS THE STATEMENT 641; 642; 643; STMT: RESTORE 644; 645RESTO: CALL EOL ;ERROR IF NOT END-OF-LINE 646 LXI H,BEGPR-1 ;POINT 1 BEFORE START OF PROGRAM 647 SHLD DATAP ;FORCE NEXT DATA TO BE AT START 648 JMP RUN ;GO NEXT STMT 649; 650; 651; STMT: RETURN 652; 653RETUR: CALL EOL ;ERROR IF NOT END-OF-LINE 654 POP PSW ;POP THE STACK 655 CPI 0FFH ;TEST IF GOSUB IN EFFECT 656 JNZ RTERR ;BRIF ERROR 657 POP H ;GET RETURNED STATMENT ADDRESS 658 SHLD STMT ;RESTORE 659 POP H ;GET ENDLINE VALUE 660 SHLD ENDLI ;RESTORE 661 POP PSW ;GET MULTI SW VALUE 662 STA MULTI ;RESTORE 663 JMP RUN ;CONTINUE (AT STMT FOLLOWING GOSUB) 664; 665; 666; STMT: GOSUB NNNN 667; 668GOSUB: CALL NOTEO ;ERROR IF END-OF-LINE 669 CALL PACK ;GET LINE NUMBER 670 CALL EOL ;ERROR IF NOT END-OF-LINE 671GOSU1: LDA MULTI ;GET SW SETTING 672 PUSH PSW ;SAVE ON STACK 673 LHLD ENDLI ;GET ADDR OF END OF STMT 674 PUSH H ;SAVE ONE STACK 675 LHLD STMT ;GET STATEMENT ADDRESS 676 PUSH H ;SAVE RETURN ADDRESS IN STACK 677 MVI A,0FFH ;MARK AS GOSUB 678 PUSH PSW ;SAVE STATUS 679 JMP GOTO2 ;GO LOOKUP LINE AND BRANCH 680;PAGE 681; 682PRINT EQU $ 683; 684; 685; STMT: PRINT .... 686; 687; 688 XRA A ;CLEAR REG A 689PRIN4: STA PRSW ;SET SW TO SAY CRLF AT END OF LINE 690 LXI D,IOBUF ;POINT BUFFER 691 RST 1 ;SKIP TO NEXT FIELD 692; 693 CALL TSTEL ;TEST IF END OF STMT 694 JZ PRINC ;BRIF IT IS 695 CPI ',' ;TEST IF COMMA 696 JZ PRIN8 ;BRIF IT IS 697 CPI ';' ;TEST IF SEMI-COLON 698 JZ PRIN9 ;BRIF IT IS 699 PUSH D ;SAVE D,E 700 PUSH H ;SAVE H,L 701 LXI D,TABLI ;POINT LITERAL 702 RST 2 ;GO SEE IF TAB(XX) 703 JZ PRINA ;BRIF IS 704 POP H ;ELSE, RESTORE H,L 705 CALL EXPR ;GO EVALUATE EXPRESSION 706 POP D ;RESTORE D,E 707 PUSH H ;SAVE H,L 708 XCHG ;FLIP/FLOP 709 LDA NS ;GET TYPE OF RESULT 710 CPI 0E7H ;TEST IF STRING 711 JZ PRIN5 ;BRIF IS 712 CALL FOUT ;GO CONVERT OUTPUT 713 INX H ;POINT NEXT 714PRIN7: XCHG ;FLIP/FLOP: END ADDR TO DE 715 POP H ;RESTORE H,L 716;HERE AFTER SETTING UP VALUE TO PRINT IN BUFFER 717PRIN2: MVI A,0FEH ;SET END CODE=NO CRLF 718 STAX D ;PUT TO BUFFER 719 PUSH H ;SAVE H,L 720 CALL TERMO ;GO PRINT BUFFER 721 POP H ;RESTORE HL 722 JMP PRINT ;REPEAT FOR NEXT FIELD 723; 724PRIN5: LXI D,STRIN ;POINT STRING 725 LDAX D ;GET LEN 726 ORA A ;TEST IT 727 JZ PRIN7 ;BRIF NULL 728 MOV B,A ;SAVE LEN 729PRIN6: INX D ;POINT NEXT 730 LDAX D ;GET A BYTE 731 MOV M,A ;STORE IT 732 INX H ;POINT NEXT 733 DCR B ;DECR CTR 734 JNZ PRIN6 ;LOOP 735 JMP PRIN7 ;DIDDLE DE, HL AND CONTINUE 736; 737PRIN8: CALL TABST ;GO POSITION NEXT TAB 738PRIN9: INX H ;PRINT NEXT 739 MVI A,1 ;GET SETTTING FOR SW 740 JMP PRIN4 ;GO STORE A IN PRSW & DO NEXT FIELD 741PRINA: POP D ;GET RID OF STACK ENTRY 742 CALL EXPR ;GO EVALUATE 743 PUSH H ;SAVE H,L 744 CALL FBIN ;CONVERT TO BINARY 745 PUSH PSW ;SAVE SPECIFIED COLUMN 746 LXI H,COLUM ;POINT CURRENT POSITION 747 SUB M ;SUBTRACT (LEAVES NUMBER OF FILLS) 748 CM CRLF ;NEXT LINE IF ALREADY PAST 749 POP PSW ;RESTORE COL 750 SUB M ;GET NUMBER FILLS 751 POP H 752 POP D 753 MOV B,A ;SAVE COUNT 754 MVI A,' ' ;GET FILL 755PRINB: JZ PRIN2 ;BRIF COUNT ZERO 756 STAX D ;PUT ONE SPACE 757 INX D ;POINT NEXT 758 DCR B ;DECR CTR 759 JMP PRINB ;LOOP 760; 761PRINC: CALL EOL ;SAVE EOL POSITION 762;HERE TO PRINT FINAL CR/LF (OR NOT) AND GO TO NEXT STATEMENT 763 LDA PRSW ;GET SWITCH 764 MOV B,A ;SAVE ,; SWITCH 765 LDA OUTSW ;GET CONTROL-O SWITCH 766 ORA A ;TEST IF CONTROL-O IN EFFECT 767 ORA B ;AND IF STATEMENT ENDED IN , OR ; 768 CZ CRLF ;CRLF IF NEITHER 769 JMP RUN ;CONTINUE NEXT STATEMENT 770;PAGE 771; 772FOR EQU $ 773; 774; 775; STMT: FOR VAR = EXPR TO EXPR [STEP EXPR] 776; 777; 778; FIRST EVALUATE ARGUMENTS AND STORE POINTERS AND VALUES, 779; BUT DO NOT MAKE TABLE ENTRY YET 780 CALL VAR ;NEXT WORD MUST BE VARIABLE 781 XCHG ;FLIP/FLOP 782 SHLD INDX ;SAVE VARIABLE NAME 783 XCHG ;FLIP/FLOP AGAIN 784 CPI '=' ;TEST FOR EQUAL SIGN 785 JNZ SNERR ;BRIF NO EQUAL 786 INX H ;POINT NEXT 787 CALL EXPR ;GO EVALUATE EXPR, IF ANY 788 XCHG ;FLIP/FLOP AGAIN 789 LHLD INDX ;GET INDEX NAME 790 XCHG ;FLIP/FLOP 791 PUSH H ;SAVE H,L 792 CALL SEARC ;GO LOCATE NAME 793 XCHG ;PUT ADDR IN H,L 794 SHLD ADDR1 ;SAVE ADDR 795 RST 3 ;GO STORE THE VALUE 796 POP H ;RESTORE POINTER TO STMT 797 LXI D,TOLIT ;GET LIT ADDR 798 RST 2 ;GO COMPARE 799 JNZ SNERR ;BRIF ERROR 800 CALL EXPR ;GO EVALUATE TO-EXPR 801 PUSH H ;SAVE H,L 802 LXI H,TVAR1 ;POINT 'TO' VALUE 803 RST 3 ;SAVE IT 804 LXI H,ONE ;POINT CONSTANT: 1 805 RST 5 ;LOAD IT 806 POP H ;GET H,L 807 MOV A,M ;GET THE CHAR 808 ORA A ;TEST FOR END OF STATEMENT 809 JZ FOR2 ;BRIF NO STEP 810 PUSH H ;RE-SAVE 811 LXI D,STEPL ;TEST FOR LIT 'STEP' 812 RST 2 ;GO COMPARE 813 JZ FOR1 ;BRIF STEP 814 POP H ;RESTORE H,L 815 JMP FOR2 ;GO NO STEP VALUE 816FOR1: POP D ;POP OFF THE STACK 817 CALL EXPR ;GO EVALUATE EXPRESSION 818FOR2: PUSH H ;SAVE H,L TO END OF STATEMENT 819 LXI H,TVAR2 ;POINT STEP VALUE 820 RST 3 ;SAVE IT 821 POP H ;RESTORE H,L 822 CALL EOL ;ERROR IF NOT END-OF-LINE 823; DETERMINE WHETHER LOOP IS TO BE EXECUTED AT ALL 824; (IF VALUE > "TO" VALUE AND STEP POSITIVE, 825; JUST SKIP TO NEXT, ETC) 826 CALL FTEST ;GET STATUS OF FACC 827 PUSH PSW ;SAVE A,STATUS 828 LXI H,TVAR1 ;GET END VALUE 829 RST 5 ;LOAD IT 830 POP PSW ;RESTORE STATUS 831 JP FOR4 ;BRIF FOR IS POSITIVE 832 LHLD ADDR1 ;GET ADDRESS OF INDEX 833 CALL FSUB ;COMPARE THIS AGAINST END VALUE 834 JZ FOR5 ;BRIF START = END 835 JM FOR5 ;BRIF START > END 836 JMP FOR9 ;GO LOCATE MATCHING NEXT 837FOR4: LHLD ADDR1 ;GET ADDRESS OF INDEX 838 CALL FSUB ;COMPARE 839 JZ FOR5 ;BRIF START = END 840 JM FOR9 ;BRIF START > END: SKIP TO "NEXT" 841; LOOP IS TO BE EXECUTED AT LEAST ONCE: 842; NEED AN ENTRY IN FOR-NEXT TABLE. 843; SEE IF THERE IS ALREADY ENTRY FOR THIS VARIABLE 844; (IE PROGRAM JUMPED OUT OF LOOP EARLIER) 845FOR5: LXI D,FORNE ;POINT TABLE 846 LHLD INDX ;GET INDEX VARIABLE NAME 847 XCHG ;FLIP/FLOP 848 MOV A,M ;GET COUNT OF ENTRIES NOW IN TABLE 849 MOV B,A ;STORE IT 850 MVI C,1 ;NEW CTR 851 ORA A ;TEST IF ZERO 852 INX H ;POINT 853 JZ FOR8 ;BRIF TABLE EMPTY 854FOR6: MOV A,M ;GET 1ST BYTE OF TABLE VARIABLE 855 CMP D ;TEST IF EQUAL TO THIS FOR'S INDEX 856 JNZ FOR7 ;BRIF NOT 857 INX H ;POINT NEXT 858 MOV A,M ;GET NEXT BYTE 859 DCX H ;POINT BACK 860 CMP E ;TEST IF EQUAL 861 JZ FOR8 ;BRIF EQUAL 862FOR7: RST 4 ;ADJUST H,L 863 DB 14 864 INR C ;COUNT IT 865 DCR B ;DECR CTR 866 JNZ FOR6 ;LOOP 867; ENTER THIS FOR IN TABLE (WHERE HL POINTS) 868FOR8: MOV A,C ;GET UDPATE COUNT 869 CPI 9 ;TEST IF TBL EXCEEDED 870 JNC NXERR ;ERROR IF MORE THAN 8 OPEN FOR/NEXT 871 STA FORNE ;PUT IN TABLE 872 MOV M,D ;HI BYTE INDEX VARIABLE NAME 873 INX H ;POINT NEXT 874 MOV M,E ;STORE LO BYTE 875 INX H ;POINT NEXT 876 PUSH H ;SAVE H,L 877 LXI H,TVAR2 ;POINT STEP VALUE 878 RST 5 ;LOAD IT 879 POP H ;RESTORE H,L 880 RST 3 ;STORE IN STACK 881 PUSH H ;SAVE H,L 882 LXI H,TVAR1 ;POINT 'TO' VALUE 883 RST 5 ;LOAD IT 884 POP H ;RESTORE H,L 885 RST 3 ;STORE IN STACK 886 XCHG ;FLIP/FLOP 887 LHLD ENDLI ;GET END ADDR 888 DCX H ;POINT ONE PRIOR 889 XCHG ;FLIP BACK 890 MOV M,D ;STORE IT 891 INX H ;POINT NEXT 892 MOV M,E ;STORE IT 893 INX H ;POINT NEXT 894 LDA STMT+1 ;GET HIGH STMT ADDR 895 MOV M,A ;PUT IT 896 INX H ;POINT NEXT 897 LDA STMT ;GET LOW STMT ADDR 898 MOV M,A ;PUT IT 899 JMP RUN ;CONTINUE 900; 901; IF HERE, THIS LOOP IS TO BE EXECUTED ZERO TIMES: 902; SCAN THRU PROGRAM TO FIND MATCHING "NEXT". 903; THIS CODE WILL FAIL IF USER'S PROGRAM IS TOO 904; COMPLEX SINCE IT WON'T FOLLOW GOTO'S, IF'S, ETC. 905FOR9: LHLD STMT ;GET ADDRESS OF STATMENT 906 MOV E,M ;GET LENGTH CODE 907 MVI D,0 ;INIT INCREMENT 908 DAD D ;COMPUTE ADDR OF NEXT STATEMENT 909 MOV A,M ;GET NEW LEN CODE 910 ORA A ;SEE IF END OF PGM 911 JZ NXERR ;BRIF IT IS 912 SHLD STMT ;SAVE ADDRESS 913 RST 4 ;ADJUST H,L 914 DB 3 915 RST 1 ;SKIP SPACES 916 LXI D,NEXTL ;POINT 'NEXT' 917 RST 2 ;SEE IF IT IS A NEXT STMT 918 JNZ FOR9 ;LOOP IF NOT 919 RST 1 ;SKIP SPACES 920 LDA INDX+1 ;GET FIRST CHAR 921 CMP M ;COMPARE 922 JNZ FOR9 ;BRIF NOT MATCH NEXT 923 LDA INDX ;GET 2ND CHAR 924 INX H ;DITTO 925 CPI ' ' ;SEE IF SINGLE CHAR 926 JZ FORA ;BRIF IT IS 927 CMP M ;COMPARE THE TWO 928 JNZ FOR9 ;BRIF NOT EQUAL 929FORA: RST 1 ;SKIP TO END (HOPEFULLY) 930 MOV A,M ;GET THE NON BLANK 931 ORA A ;SEE IF END 932 JNZ FOR9 ;BRIF END 933 JMP RUN ;ELSE, GO NEXT STMT 934;PAGE 935; 936IFSTM EQU $ 937; 938; 939; STMT: IF EXPR RELATION EXPR THEN STMT# 940; 941; 942 CALL EXPR ;GO EVALUATE LEFT EXPR 943 PUSH H ;SAVE H,L 944 LDA NS ;GET TYPE CODE 945 STA IFTYP ;SAVE IT 946 CPI 0E7H ;TEST IF STRING 947 JNZ IF1 ;BRIF NOT 948 LXI H,IOBUF ;POINT BUFFER 949 LXI D,STRIN ;POINT RESULT 950 LDAX D ;GET LEN 951 INR A ;PLUS ONE 952 MOV B,A ;SAVE IT 953 CALL COPYD ;GO MOVE IT 954 JMP IF2 ;GO AROUND 955IF1: LXI H,TVAR1 ;GET ADDR OF TEMP STORAGE 956 RST 3 ;SAVE IT 957IF2: POP H ;RESTORE H,L 958 XRA A ;CLEAR A 959 MOV C,A ;SAVE IN REG C 960 MOV B,A ;INIT REG 961IF3: MOV A,M ;GET OPERATOR 962 INR B ;COUNT 963 CPI '=' ;TEST FOR EQUAL 964 JNZ IF4 ;BRIF IT IS 965 INR C ;ADD 1 TO C 966 INX H ;POINT NEXT 967IF4: CPI '>' ;TEST FOR GREATER THAN 968 JNZ IF5 ;BRIF IT IS 969 INR C ;ADD TWO 970 INR C ;TO REL CODE 971 INX H ;POINT NEXT 972IF5: CPI '<' ;TEST FOR LESS THAN 973 JNZ IF6 ;BRIF IT IS 974 MOV A,C ;GET REL CODE 975 ADI 4 ;PLUS FOUR 976 MOV C,A ;PUT BACK 977 INX H ;POINT NEXT 978IF6: MOV A,C ;GET REL CODE 979 ORA A ;TEST IT 980 PUSH B ;SAVE B,C 981 JZ SNERR ;BRIF SOME ERROR 982 POP B ;RESTORE B,C 983 STA REL ;SAVE CODE 984 MOV A,B ;GET COUNT 985 CPI 2 ;TEST FOR TWO 986 JNZ IF3 ;SEE IF MULTIPLE RELATION 987 CALL EXPR ;GO EVALUATE RIGHT SIDE 988 SHLD ADDR1 ;SAVE LOCATION OF THEN (IF ANY) 989 LDA NS ;GET TYPE CODE 990 LXI H,IFTYP ;POINT LEFT TYPE 991 CMP M ;COMPARE 992 JNZ SNERR ;BRIF MIXED 993 CPI 0E7H ;TEST IF STRING 994 JZ IFF ;BRIF IS 995 LXI H,TVAR1 ;POINT LEFT 996 CALL FSUB ;SUBTRACT LEFT FROM RIGHT 997 LDA REL ;GET RELATION 998 RAR ;TEST BIT D0 999 JNC IF8 ;BRIF NO EQUAL TEST 1000 CALL FTEST ;GET STATUS OF FACC 1001 JZ TRUE ;BRIF LEFT=RIGHT 1002IF8: LDA REL ;LOAD RELATION 1003 ANI 02H ;MASK IT 1004 JZ IF9 ;BRIF NO > 1005 CALL FTEST ;GET STATUS OF FACC 1006 JM TRUE ;BRIF GT 1007IF9: LDA REL ;LOAD RELATION 1008 ANI 04H ;MASK IT 1009 JZ FALSE ;BRIF NO < 1010 CALL FTEST ;GET STATUS OF FACC 1011 JM FALSE ;BRIF GT 1012 JZ FALSE ;BRIF ZERO (NOT EQUAL) 1013TRUE: LHLD ADDR1 ;GET POINTER TO STATEMENT 1014 LXI D,GOTOL ;POINT 'GO TO' 1015 RST 2 ;GO COMPARE 1016 JZ GOTO ;BRIF IF ... GOTO NN 1017 LHLD ADDR1 ;GET POINTER TO STATEMENT 1018 LXI D,GOSBL ;POINT LITERAL 1019 RST 2 ;GO COMAPRE 1020 JZ GOSUB ;BRIF IF ... GOSUB NN 1021 LHLD ADDR1 ;GET POINTER TO STATEMENT 1022 LXI D,THENL ;GET ADDR 'THEN' 1023 RST 2 ;GO COMPARE 1024 JNZ SNERR ;BRIF ERROR 1025 CALL NUMER ;TEST IF NUMERIC 1026 JZ GOTO ;BRIF IT IS 1027 JMP RUN4 ;ELSE, MAY BE ANY STMT 1028FALSE EQU RUN 1029IFF: LXI H,IOBUF ;POINT PRIOR 1030 MOV B,M ;GET LEN 1031 LXI D,STRIN ;POINT THIS 1032 LDAX D ;GET LEN 1033 MOV C,A ;SAVE IT 1034IFG: INX D ;POINT NEXT 1035 INX H ;DITTO 1036 MOV A,B ;GET LEFT LEN 1037 ORA A ;TEST IT 1038 JNZ IFH ;BRIF NOT ZERO 1039 MVI M,' ' ;EXTEND WITH SPACE 1040IFH: MOV A,C ;GET RIGHT LEN 1041 ORA A ;TEST IT 1042 JNZ IFI ;BRIF NOT ZERO 1043 MVI A,' ' ;GET SPACE 1044 STAX D ;EXTEND 1045IFI: LDAX D ;GET RIGHT CHAR 1046 CMP M ;TEST WITH LEFT 1047 JC IFM ;BRIF LEFT>RIGHT 1048 JNZ IFN ;BRIF LEFT<RIGHT 1049 MOV A,B ;GET LEFT COUNT 1050 DCR A ;SUBT ONE 1051 JM IFJ ;BRIF WAS ZERO 1052 MOV B,A ;UPDATE CTR 1053IFJ: MOV A,C ;GET RIGHT LEN 1054 DCR A ;SUBT ONE 1055 JM IFK ;BRIF WAS ZERO 1056 MOV C,A ;UPDT CTR 1057IFK: MOV A,B ;GET LEFT LEN 1058 ORA C ;COMPARE TO RIGHT 1059 JNZ IFG ;BRIF BOTH NOT ZERO 1060 MVI B,1 ;SET SW= EQUAL 1061IFL: LDA REL ;GET RELATION 1062 ANA B ;AND WITH RESULT 1063 JZ FALSE ;BRIF FALSE 1064 JMP TRUE ;ELSE, TRUE 1065IFM: MVI B,2 ;SET CODE 1066 JMP IFL ;JUMP 1067IFN: MVI B,4 ;SET CODE 1068 JMP IFL ;JUMP 1069;PAGE 1070; 1071LET EQU $ 1072; 1073; 1074; STMT: [LET] VAR = EXPR 1075; 1076; 1077 CALL GETS8 ;GO GET ADDRESS OF VARIABLE 1078 PUSH B ;SAVE NAME 1079 PUSH D ;SAVE ADDRESS 1080 RST 1 ;GET NEXT CHAR 1081 CPI '=' ;TEST FOR EQUAL SIGN 1082 JZ LET1 ;BRIF IS 1083 LDA EDSW ;GET MODE SW 1084 ORA A ;TEST IT 1085 JZ SNERR ;BRIF LET ERROR 1086 LXI H,WHATL ;POINT LITERAL 1087 CALL TERMM ;GO PRINT IT 1088 JMP GETCM ;GO TO COMMAND 1089LET1: INX H ;POINT NEXT 1090 CALL EXPR ;GO EVALUATE EXPRESSION 1091 CALL EOL ;ERROR IF NOT END-OF-LINE 1092 POP H ;RESTORE ADDRESSS 1093 POP D ;RESTORE NAME 1094 MOV A,E ;GET TYPE 1095 ORA A ;TEST IT 1096 LDA NS ;GET RESULT TYPE 1097 JM LET2 ;BRIF STRING 1098 CPI 0E3H ;TEST IF NUMERIC 1099 JNZ SNERR ;BRIF MIXED MODE 1100 RST 3 ;GO STORE VARIABLE 1101 JMP RUN ;CONTINUE 1102LET2: CPI 0E7H ;TEST IF STRING 1103 JNZ SNERR ;BRIF MIXED MODE 1104 CALL LET2A ;GO STORE IT 1105 JMP RUN ;CONTINUE 1106; 1107LET2A: LXI D,STRIN ;POINT STRING BUFFER 1108 LDAX D ;GET NEW LEN 1109 SUB M ;MINUS OLD LEN 1110 JZ LET8 ;BRIF SAME LENGTH 1111 MOV D,H ;COPY H,L 1112 MOV E,L ;TO D,E 1113 MOV A,M ;GET LEN 1114 INR A ;TRUE LEN 1115LET3: INX D ;POINT NEXT 1116 DCR A ;DECR CTR 1117 JNZ LET3 ;LOOP 1118 INX D ;SKIP 1119 INX D ;AGAIN 1120 LDAX D ;GET LO NAM 1121 MOV C,A ;SAVE 1122 INX D ;GET HI NAME 1123 LDAX D ;LOAD IT 1124 MOV B,A ;SAVE 1125 PUSH B ;SAVE NAME 1126 DCX H ;POINT NEXT ENTRY 1127LET4: MOV A,M ;GET NEXT 1128 ORA A ;TEST IF END 1129 JZ LET6 ;BRIF IS 1130 PUSH H ;SAVE H,L 1131 DCX H ;SKIP NEXT 1132 DCX H ;POINT LEN 1133 MOV B,M ;GET HI LEN 1134 DCX H ;POINT LO 1135 MOV C,M ;GET LO LEN 1136 POP H ;RESTORE H,L 1137LET5: MOV A,M ;GET A BYTE 1138 STAX D ;COPY 1139 DCX H ;POINT NEXT 1140 DCX D ;DITTO 1141 INX B ;ADD TO CTR 1142 MOV A,B ;GET HI 1143 ORA C ;TEST IF ZERO 1144 JNZ LET5 ;LOOP 1145 JMP LET4 ;CONTINUE 1146LET6: XCHG ;PUT NEW ADDR TO H,L 1147 POP B ;GET NAME 1148 MOV M,B ;STORE HI BYTE 1149 DCX H ;POINT NEXT 1150 MOV M,C ;STORE LO 1151 LXI D,STRIN ;GET NEW LEN 1152 LDAX D ;LOAD IT 1153 MVI B,0FFH ;INIT HI COMPLEMENT 1154 ADI 5 ;COMPUTE ENTRY LENGTH 1155 JZ LET7 ;BRIF 256 BYTES 1156 JNC LET7 ;BRIF LESS 256 1157 MVI B,0FEH ;SET BIT OFF 1158LET7: CMA ;1'S COMPLEMENT 1159 INR A ;THEN 2'S 1160 MOV C,A ;SAVE LO LEN 1161 DCX H ;POINT NEXT 1162 MOV M,B ;STORE HI LEN 1163 DCX H ;POINT NEXT 1164 MOV M,C ;STORE LO LEN 1165 RST 4 ;ADJUST H,L 1166 DB 3 1167 DAD B ;COMPUTE END OF ENTRY 1168 MVI M,0 ;MARK NEW END 1169 INX H ;POINT 1ST BYTE 1170LET8: LDAX D ;GET LEN 1171 INR A ;TRUE LEN 1172 MOV B,A ;SAVE LEN 1173LET9: LDAX D ;GET A BYTE 1174 MOV M,A ;COPY IT 1175 INX H ;POINT NEXT 1176 INX D ;DITTO 1177 DCR B ;SUBT CTR 1178 JNZ LET9 ;LOOP 1179 RET ;RETURN 1180;PAGE 1181; 1182;NEXT EQQU $ 1183; 1184; 1185; STMT: NEXT VAR 1186; 1187; 1188NEXT: CALL VAR ;GET VARIABLE NAME 1189 CALL EOL ;ERROR IF NOT END-OF-LNE 1190 XCHG ;FLIP/FLOP 1191 SHLD INDX ;SAVE VAR NAME 1192 PUSH H ;SAVE VAR NAME 1193 LXI H,FORNE ;POINT FOR/NEXT TABLE 1194 MOV B,M ;GET SIZE 1195 MOV A,B ;LOAD IT 1196 ORA A ;TEST IT 1197 JZ NXERR ;BRIF TABLE EMPTY 1198 INX H ;POINT NEXT 1199 POP D ;RESTORE VAR NAME 1200NEXT1: MOV A,M ;GET 1ST BYTE 1201 INX H ;POINT NEXT 1202 CMP D ;COMPARE 1203 JNZ NEXT2 ;BRIF NOT EQUAL 1204 MOV A,M ;GET 2ND BYTE 1205 CMP E ;COMPARE 1206 JZ NEXT3 ;BRIF EQUAL 1207NEXT2: RST 4 ;ADJUST H,L 1208 DB 13 1209 DCR B ;DECR COUNT 1210 JNZ NEXT1 ;LOOP 1211 JMP NXERR ;GO PUT ERROR MSG 1212NEXT3: LDA FORNE ;GET ORIG COUNT 1213 SUB B ;MINUS REMAIN 1214 INR A ;PLUS ONE 1215 STA FORNE ;STORE NEW COUNT 1216 INX H ;POINT ADDR 1217 PUSH H ;SAVE H,L ADDR 1218 CALL SEARC ;GO GET ADDR OF INDEX 1219 XCHG ;PUT TO H,L 1220 SHLD ADDR1 ;SAVR IT 1221 RST 5 ;LOAD INDEX 1222 POP H ;GET H,L (TBL) 1223 PUSH H ;RE-SAVE 1224 CALL FADD ;ADD STEP VALUE 1225 LXI H,TVAR1 ;POINT TEMP AREA 1226 RST 3 ;SAVE NEW INDEX 1227 POP H ;GET H,L (TBL) 1228 PUSH H ;RE-SAVE 1229 RST 4 ;GET LEN TO NEXT 1230 DB 4 1231 CALL FSUB ;SUBTRACT TO VALUE 1232 JZ NEXT6 ;BRIF ZERO 1233 POP H ;GET H,L (PTR TO STEP) 1234 PUSH H ;RE-SAVE 1235 MOV A,M ;GET SIGN&EXPONENT OF STEP 1236 ORA A ;TEST IT 1237 LDA FACC ;GET SIGN & EXPON OF DIFF 1238 JM NEXT5 ;BRIF NEGATIVE 1239 ORA A ;TEST SIGN OF DIFF 1240 JM NEXT6 ;BRIF LESS THAN TO-EXPR 1241NEXT7: LXI H,FORNE ;GET ADDR TABLE 1242 DCR M ;SUBTRACT ONE FROM COUNT 1243 POP D ;ADJUST STACK 1244 JMP RUN ;GO STMT AFTER NEXT 1245NEXT5: ORA A ;TEST SIGN OF DIFFERENCE 1246 JM NEXT7 ;BRIF END OF LOOP 1247NEXT6: POP H ;GET PTR TO TBL 1248 RST 4 ;ADJUST H,L 1249 DB 8 1250 MOV D,M ;GET HI BYTE 1251 INX H ;POINT NEXT 1252 MOV E,M ;GET LOW BYTE 1253 INX H ;POINT NEXT 1254 MOV A,M ;GET HI BYTE 1255 STA STMT+1 ;SAVE 1256 INX H ;POINT NEXT 1257 MOV A,M ;GET LOW BYTE 1258 STA STMT ;SAVE 1259 XCHG ;H,L = ADDR OF STMT AFTR FOR 1260 CALL EOL ;SETUP MULTI PTP 1261 LHLD STMT ;GET ADDR OF FOR STMT 1262 INX H ;POINT LINE NUM 1263 SHLD LINE ;SAVE ADDR LINE 1264 LXI H,TVAR1 ;POINT UPDTED VALUE 1265 RST 5 ;GO LOAD IT 1266 LHLD ADDR1 ;GET ADDR OF INDEX 1267 RST 3 ;GO STORE IT 1268 JMP RUN ;CONTINUE WITH STMT AFTER FOR 1269;PAGE 1270INPUT EQU $ 1271; 1272; 1273; STMT: INPUT VAR [, VAR, VAR] 1274; 1275; 1276 LXI D,LLINE ;POINT 'LINE' 1277 PUSH H ;SAVE H,L ADDR 1278 RST 2 ;GO COMPARE 1279 JZ INPL ;BRIF EQUAL 1280 POP D ;ELSE, RESTORE H,L ADDR 1281 LXI H,IOBUF ;GET ADDR OF BUFFER 1282 SHLD ADDR1 ;SAVE ADDR 1283 MVI M,0 ;MARK BUFFER EMPTY 1284 XCHG ;FLIP/BACK 1285INPU1: RST 1 ;SKIP SPACES 1286 CPI 27H ;TEST IF QUOTE 1287 JZ INPU2 ;BRIF IS 1288 CPI '"' ;TEST IF INPUT LITERAL 1289 JNZ INPU6 ;BRIF NOT 1290INPU2: MOV C,A ;SAVE DELIM 1291 LXI D,IOBUF ;POINT BUFFER 1292INPU3: INX H ;POINT NEXT 1293 MOV A,M ;LOAD IT 1294 CMP C ;TEST IF END 1295 JZ INPU4 ;BRIF IS 1296 STAX D ;PUT TO BUFF 1297 INX D ;POINT NEXT 1298 JMP INPU3 ;LOOP 1299INPU4: INX H ;SKIP TRAILING QUOTE 1300 XCHG ;PUT ADDR TO H,L 1301 MVI M,0FEH ;MARK END 1302 CALL TERMO ;GO PRINT PROMPT 1303 XCHG ;GET H,L 1304 RST 1 ;SKIP TO NON BLANK 1305 CPI ',' ;TEST IF COMMA 1306 JZ INPU5 ;BRIF IS 1307 CPI ';' ;TEST IF COMMA 1308 JNZ INPU6 ;BRIF NOT 1309INPU5: INX H ;SKIP IT 1310INPU6: CALL GETS8 ;GO GET VAR ADDR 1311 PUSH H ;SAVE H ADDR 1312 PUSH D ;SAVE VAR ADDR 1313 LHLD ADDR1 ;GET ADDR PREV BUFFER 1314 MOV A,M ;LOAD CHAR 1315 CPI ',' ;TEST IF COMMA 1316 INX H ;POINT NEXT 1317 JZ INPU7 ;BRIF CONTINUE FROM PREV 1318 MVI A,'?' ;LOAD PROMPT 1319 CALL TERMI ;GO READ FROM TTY 1320INPU7: RST 1 ;SKIP SPACES 1321 MOV A,C ;GET LO NAME 1322 ORA A ;TEST IT 1323 JM INPUA ;BRIF STRING 1324 CALL FIN ;GO CONVERT TO FLOATING 1325 RST 1 ;SKIP SPACES 1326 CPI ',' ;TEST IF COMMA 1327 JZ INPU8 ;BRIF IS 1328 ORA A ;TEST IF END OF LINE 1329 JNZ CVERR ;BRIF ERROR 1330INPU8: SHLD ADDR1 ;SAVE ADDRESS 1331 POP H ;GET VAR ADDR 1332 RST 3 ;GO STORE THE NUMBER 1333INPU9: POP H ;RESTORE STMT POINTER 1334 MOV A,M ;GET CHAR 1335 CPI ',' ;TEST FOR COMMA 1336 INX H ;POINT NEXT 1337 JZ INPU1 ;RECDURSIVE IF COMMA 1338 DCX H ;POINT BACK 1339INPUB: CALL EOL ;ERROR IF NOT END OF LINE 1340 JMP RUN ;CONTINUE NEXT STMT 1341INPUA: CALL GETST ;GO GET THE STRING 1342 SHLD ADDR1 ;SAVE ADDRESS 1343 JMP INPU9 ;CONTINUE 1344; 1345INPL EQU $ 1346; 1347; 1348; STMT: INPUT LINE A$ 1349; 1350; 1351 POP D ;DUMMY POP TO ADJUST STACK 1352 CALL VAR ;GET STRING NAME 1353 MOV A,E ;LOAD LO BYTE 1354 ORA A ;TEST IT 1355 JP SNERR ;BRIF NOT STRING VARIABLE 1356 CALL SEARC ;ELSE, GET ADDRESS 1357 PUSH D ;SAVE ON STACK 1358 CALL EOL ;ERROR IF NOT END-OF-LINE 1359 MVI A,1 ;GET ON SETTING 1360 STA ILSW ;SET INPUT LINE SWITCH 1361 MVI A,'?' ;LOAD PROMPT 1362 CALL TERMI ;GO READ A LINE 1363 MVI B,0 ;INIT COUNT 1364 LXI D,STRIN+1 ;POINT STRING BUFFER 1365 LXI H,IOBUF+1 ;POINT INPUT BUFFER 1366INPL1: MOV A,M ;GET NEXT BYTE 1367 ORA A ;TEST IT 1368 JZ INPL2 ;BRIF END 1369 INR B ;ADD TO COUNT 1370 STAX D ;PUT TO STRING BUFF 1371 INX D ;POINT NEXT 1372 INX H ;DITTO 1373 JMP INPL1 ;LOOP 1374INPL2: STA ILSW ;RESET SWITCH 1375 MOV A,B ;GET COUNT 1376 STA STRIN ;SET STRING LENGTH 1377 POP H ;GET ADDRESS OF VARIABLE 1378 CALL LET2A ;GO STORE THE STRING 1379 JMP RUN ;GO NEXT STMT 1380;PAGE 1381; 1382READ EQU $ 1383; 1384; STMT: READ VAR [,VAR ...] 1385; 1386 RST 1 ;SKIP BLANKS 1387 CALL GETS8 ;GET VAR ADDR 1388 PUSH H ;SAVE H,L 1389 PUSH D ;SAVE D,E 1390 LHLD DATAP ;GET DATA STMT POINTER 1391 MOV A,M ;LOAD THE CHAR 1392 ORA A ;TEST IF END OF STMT 1393 JNZ READ2 ;BRIF NOT END OF STMT 1394 INX H ;POINT START NEXT STMT 1395READ1: MOV A,M ;LOAD LEN 1396 SHLD DATAP ;SAVE ADDR 1397 ORA A ;TEST IF END OF PGM 1398 JZ DAERR ;BRIF OUT OF DATA 1399 RST 4 ;ADJUST H,L 1400 DB 3 1401 LXI D,DATAL ;POINT 'DATA' 1402 RST 2 ;COMPARE 1403 JZ READ2 ;BRIF IT IS DATA STMT 1404 LHLD DATAP ;GET ADDR START 1405 MOV E,M ;GET LEN CODE 1406 MVI D,0 ;CLEAR D 1407 DAD D ;POINT NEXT STMT 1408 JMP READ1 ;LOOP NEXT STMT 1409READ2: RST 1 ;SKIP SPACES 1410 MOV A,C ;LOAD LO NAME 1411 ORA A ;TEST IT 1412 JM READ6 ;BRIF STRING 1413 CALL FIN ;GO CONVERT VALUE 1414 MOV A,M ;GET CHAR WHICH STOPPED US 1415 CPI ',' ;TEST IF COMMA 1416 JNZ READ5 ;BRIF NOT 1417 INX H ;POINT NEXT 1418READ3: SHLD DATAP ;SAVE ADDRESS 1419 POP H ;RESTORE ADDR OF VAR 1420 RST 3 ;STORE THE VALUE 1421READ4: POP H ;RESTORE POINTER TO STM 1422 MOV A,M ;GET THE CHAR 1423 CPI ',' ;TEST IF COMMA 1424 INX H ;POINT NEXT 1425 JZ READ ;RECURSIVE IF IT IS 1426 DCX H ;RESET 1427 JMP INPUB ;CONTINUE 1428READ5: ORA A ;TEST IF END OF STMT 1429 JZ READ3 ;BRIF OK 1430 JMP CVERR ;GO PROCESS ERROR 1431READ6: CALL GETST ;GO GET STRING 1432 MOV A,M ;GET CHAR 1433 CPI ',' ;TEST IF COMMA 1434 JZ READ7 ;BRIF IS 1435 ORA A ;TEST IF END 1436 JNZ READ5 ;BRIF NOT 1437 JMP READ8 ;GO AROUND 1438READ7: INX H ;POINT PAST 1439READ8: SHLD DATAP ;SAVE ADDRESS 1440 JMP READ4 ;CONTINUE 1441; 1442OUTP EQU $ 1443; 1444; STMT; OUT ADDR,VALUE 1445; 1446; 1447 CALL EXPR ;GO EVALUATE ADDRESS 1448 MOV A,M ;GET DELIM 1449 CPI ',' ;TEST IF COMMA 1450 JNZ SNERR ;BRIF NOT 1451 INX H ;SKIP OVER COMMA 1452 CALL FBIN ;CONVERT TO BINARY IN A-REG 1453 LXI D,OUTA ;POINT INSTR 1454 XCHG ;PUT TO H,L 1455 MVI M,0D3H ;OUT INSTR 1456 INX H ;POINT NEXT 1457 MOV M,A ;PUT ADDR 1458 INX H ;POINT NEXT 1459 MVI M,0C9H ;RET INSTR 1460 XCHG ;RESTORE ORIG H,L 1461 CALL EXPR ;GO EVAL DATA BYTE 1462 CALL EOL ;ERROR IF NOT END OF STATEMENT 1463 CALL FBIN ;CONVERT TO BINARY 1464 CALL OUTA ;GO PUT THE BYTE 1465 JMP RUN ;GO NEXT STMT 1466;PAGE 1467; 1468STOP EQU $ 1469; 1470; STMT: STOP 1471; 1472; 1473 CALL EOL ;POINT END OF LINE 1474 LXI H,STOPM ;POINT MESSAGE: "STOP AT LINE " 1475 CALL TERMM ;GO WRITE IT 1476 CALL PRLIN ;GO PRINT LINE NUMBER 1477 LDA RUNSW ;GET RUN TYPE 1478 ORA A ;TEST IT 1479 JNZ RDY ;BRIF IMMED 1480 STA MULTI ;CLEAR MULTI SW 1481 LHLD STMT ;GET ADDR OF PREV STMT 1482 MOV E,M ;GET LEN 1483 MVI D,0 ;CLEAR HI BYTE 1484 DAD D ;POINT NEXT 1485 INX H ;POINT LINE NUMBER 1486 SHLD LINE ;SAVE ADDR 1487 LXI D,LINEN ;POINT AREA 1488 CALL LINEO ;GO CONVERT LINE NUMBER 1489 XCHG ;FLIP TO H,L 1490 MVI M,0 ;MARK END 1491 JMP RDY ;GO TO READY MSG 1492; 1493RANDO EQU $ 1494; 1495; 1496; STMT: RANDOMIZE 1497; 1498; 1499 CALL EOL ;ERROR IF NOT END-OF-LINE 1500 MVI A,1 ;LOAD A ONE 1501 STA RNDSW ;SET SWITCH = TRUE RANDOM 1502 LXI D,TRNDX ;POINT 'TRUE' RANDOM NUMBERS 1503 LXI H,RNDX ;POINT RECEIVE 1504 MVI B,8 ;LOOP CTR 1505 CALL COPYD ;GO MOVE IT 1506 JMP RUN ;CONTINUE 1507; 1508ON EQU $ 1509; 1510; 1511; STMT: ON EXPR GOTO NNN NNNN NNNN 1512; GOSUB 1513; 1514; 1515 CALL EXPR ;GO EVALUATE EXPRESSION 1516 CALL FBIN ;GET BINARY NUMBER IN ACC 1517 ORA A ;TEST RESULT 1518 JZ SNERR ;BRIF ZERO (ERROR) 1519 MOV C,A ;SAVE VALUE 1520 DCR C ;LESS ONE 1521 XRA A ;GET A ZERO 1522 STA REL ;TURN OFF SWITCH 1523 LXI D,GOTOL ;POINT LITERAL 1524 PUSH H ;SAVE H,L ADDRESS 1525 RST 2 ;GO COMPARE 1526 JZ ON3 ;BRIF ON...GOTO 1527 POP H ;ELSE, RESTORE H,L 1528 LXI D,GOSBL ;POINT LITERAL 1529 RST 2 ;GO COMPARE 1530 JNZ SNERR ;BRIF ERROR 1531 MVI A,1 ;GET ON SETTING 1532 STA REL ;SET SWITCH 1533 PUSH H ;DUMMY PUSH 1534ON3: POP D ;ADJUST STACK 1535ON3A: MOV A,C ;GET COUNT 1536 ORA A ;TEST IT 1537 JZ ON6 ;BRIF VALUE 1 1538 RST 1 ;ELSE, SKIP BLANKS 1539 ORA A ;TEST IF END OF LINE 1540 JZ SNERR ;BRIF IS 1541 CPI ',' ;TEST IS COMMA 1542 JNZ ON4 ;BRIF NOT 1543 INX H ;SKIP COMMA 1544 JMP ON3A ;CONTINUE 1545ON4: CALL NUMER ;GO TEST IF NUMERIC 1546 JNZ ON5 ;BRIF NOT 1547 INX H ;POINT NEXT 1548 JMP ON4 ;LOOP 1549ON5: DCR C ;SUB ONE FROM COUNT 1550 JNZ ON3A ;LOOP TILL JUST BEFORE STMT# 1551ON6: CALL NOTEO ;ERROR IF NOT END-OF-LINE 1552 CPI ',' ;TEST IF COMMA 1553 JNZ ON7 ;BRIF NOT 1554 INX H ;POINT NEXT 1555 JMP ON6 ;LOOP 1556ON7: CALL NUMER ;TEST IF NUMERIC 1557 JNZ SNERR ;BRIF NOT 1558 CALL PACK ;GET THE LINE NUMBER 1559ON8: MOV A,M ;GET NEXT CHAR 1560 CALL TSTEL ;TEST IF END STMT 1561 JZ ON9 ;BRIF END 1562 INX H ;POINT NEXT 1563 JMP ON8 ;LOOP 1564ON9: CALL EOL ;SET END OF LINE POINTERS 1565 LDA REL ;GET TYPE (GOTO OR GOSUB) 1566 ORA A ;TEST IT 1567 JNZ GOSU1 ;BRIF GOSUB 1568 JMP GOTO2 ;BR TO GOTO LOOKUP 1569;PAGE 1570; 1571CHANG EQU $ 1572; 1573; STATEMENT: CHANGE A$ TO X - OR - 1574; 1575; CHANGE X TO A$ 1576; 1577 CALL VAR ;NEXT WORD MUST BE VAR 1578 MOV A,E ;TEST TYPE 1579 ORA A ;SET FLAGS 1580 JP CHA2 ;BRIF NOT-STRING 1581 CALL SEARC ;GET ADDR 1582 PUSH D ;SAVE IT 1583 LXI D,TOLIT ;POINT 'TO' 1584 RST 2 ;COMPARE 1585 JNZ SNERR ;BRIF ERROR 1586 CALL VAR ;GET NEXT VARIABLE 1587 MOV A,D ;GET HI NAME 1588 ORI 80H ;SET MASK FOR ARRAY 1589 MOV D,A ;REPLACE 1590 CALL SEARC ;GET ADDRESS 1591 RST 4 ;POINT START OF ELEMENT 0,0 1592 DB -11 AND 0FFH 1593 POP D ;GET PTR TO STMT 1594 XCHG ;FLIP 1595 CALL EOL ;NEXT MUST BE E-O-L 1596 XCHG ;FLIP AGAIN 1597 POP D ;GET ADDR STRING 1598 LDAX D ;GET COUNT 1599 MOV B,A ;SAVE IT 1600 INR B ;BUMP 1601CHA1: PUSH B ;SAVE CTR 1602 PUSH D ;SAVE ADDR STRING 1603 PUSH H ;SAVE ADDR NUM 1604 CALL FDEC ;CONVERT TO F.P. 1605 POP H ;GET ADDR 1606 RST 3 ;STORE IT 1607 RST 4 ;POINT TO NEXT 1608 DB -8 AND 0FFH 1609 POP D ;RESTORE STRING 1610 POP B ;AND CTR 1611 INX D ;POINT NEXT CHAR 1612 LDAX D ;LOAD IT 1613 DCR B ;DECR CTR 1614 JNZ CHA1 ;LOOP 1615 JMP RUN 1616; 1617; 1618CHA2: MOV A,D ;GET HI NAME 1619 ORI 80H ;MAKE ARRAY NAME 1620 MOV D,A ;SAVE 1621 CALL SEARC ;GET ADDR 1622 RST 4 ;POINT ELEMENT 0,0 1623 DB -11 AND 0FFH 1624 XTHL ;SAVE ON STACK 1625 LXI D,TOLIT ;POINT 'TO' 1626 RST 2 ;COMPARE 1627 JNZ SNERR ;BRIF ERROR 1628 CALL VAR ;GET NAME 1629 MOV A,E ;GET TYPE 1630 ORA A ;SET FLAGS 1631 JP SNERR ;BRIF NOT STRING 1632 CALL EOL ;BRIF NOT E-O-L 1633 CALL SEARC ;GET ADDR 1634 POP H ;GET ADDR VAR 1635 PUSH D ;SAVE D,E 1636 LXI D,STRIN ;POINT STRING BUFFER 1637 PUSH D ;SAVE IT 1638 RST 5 ;LOAD IT 1639 RST 4 ;POINT NEXT 1640 DB -8 AND 0FFH 1641 PUSH H ;SAVE H,L 1642 CALL FBIN ;CONVERT 1643 POP H ;RESTORE 1644 POP D ;DITTO 1645 MOV B,A ;SAVE COUNT 1646 INR B ;BUMP IT 1647CHA3: STAX D ;PUT TO STRING 1648 INX D ;POINT NEXT STR LOC. 1649 PUSH B ;SAVE CTRS 1650 PUSH D ;AND ADDR 1651 RST 5 ;LOAD NEXT 1652 RST 4 ;POINT NEXT 1653 DB -8 AND 0FFH 1654 PUSH H ;AND H ADDR 1655 CALL FBIN ;CONVERT 1656 POP H ;RESTORE H,L 1657 POP D ;AND D,E 1658 POP B ;AND CTRS 1659 DCR B ;DECR CTR 1660 JNZ CHA3 ;LOOP 1661 POP H ;GET ADDR OF VAR (STRING) 1662 CALL LET2A ;GO STORE IT 1663 JMP RUN ;CONTINUE 1664;PAGE 1665; 1666DIM EQU $ 1667; 1668; STMT: DIM VAR(A,B),... 1669; 1670; 1671 CALL VAR ;GO GET VAR NAME 1672 JP SNERR ;BRIF NO ( 1673 CALL SEARC ;GO LOCATE THE VAR 1674 XTHL ;PUT ADDR IN STACK, GET PTR TO ( 1675 PUSH PSW ;SAVE STATUS 1676 MVI A,0FFH ;TURN ON SW 1677 STA DIMSW ;SET IT 1678 CALL EXPR ;GO EVALUATE 1679 POP PSW ;GET STATUS 1680 XTHL ;SWAP PTRS 1681 PUSH D ;SAVE ROW NUMBER 1682 PUSH B ;SAVE COL NUMBER 1683 INX B ;INCREMENT COLUMNS 1684 INX D ;AND ROWS 1685 PUSH H ;SAVE H,L 1686 PUSH PSW ;RESAVE STATUS 1687 LXI H,0 ;GET A ZERO 1688DIM1: DAD D ;TIMES ONE 1689 DCX B ;DCR COLS 1690 MOV A,B ;GET HI 1691 ORA C ;PLUS LO 1692 JNZ DIM1 ;LOOP 1693 POP PSW ;GET STATUS 1694 POP D ;GET ADDRESS 1695 DAD H ;TIMES TWO 1696 DAD H ;TIMES FOUR 1697 LXI B,8 ;PLUS 2 (NAME AND DISP) 1698 JM REDIM ;GO RE-DIMENSION 1699 PUSH H ;SAVE PRODUCT 1700 DAD B ;ADD IT 1701 XCHG ;FLIP/FLOP 1702 DCX H ;POINT LO NAME 1703 DCX H ;POINT HI DISP 1704 MOV A,E ;GET LO 1705 CMA ;COMPLEMENT 1706 ADI 1 ;PLUS ONE 1707 MOV E,A ;RESTORE 1708 MOV A,D ;GET HI 1709 CMA ;COMPLEMENT 1710 ACI 0 ;PLUS CARRY 1711 MOV M,A ;STORE IT 1712 DCX H ;POINT NEXT 1713 MOV M,E ;STORE LO 1714 XCHG ;SAVE IN D,E 1715 POP H ;GET PRODUCT 1716 MOV B,H ;COPY H,L 1717 MOV C,L ;TO B,C 1718 XCHG ;GET LOCAT 1719 POP D ;GET COLUMNS 1720 DCX H ;POINT NEXT 1721 MOV M,D ;MOVE LO COL 1722 DCX H ;POINT NEXT 1723 MOV M,E ;MOVE HI COL 1724 POP D ;GET ROWS 1725 DCX H ;POINT NEXT 1726 MOV M,D ;MOVE HI ROW 1727 DCX H ;POINT NEXT 1728 MOV M,E ;MOVE LO ROW 1729 DCX H ;POINT NEXT 1730DIM2: MVI M,0 ;CLEAR ONE BYTE 1731 DCX H ;POINT NEXT 1732 DCX B ;DECR CTR 1733 MOV A,B ;GET HI 1734 ORA C ;PLUS LO 1735 JNZ DIM2 ;LOOP 1736 MVI M,0 ;MARK END 1737DIM3: POP H ;GET PTR TO STMT 1738 MOV A,M ;LOAD CHAR 1739 CPI ',' ;TEST IF COMMA 1740 JNZ DIM4 ;BRIF NOT 1741 INX H ;SKIP IT 1742 JMP DIM ;CONTINUE 1743DIM4: CALL EOL ;TEST END OF LINE 1744 JMP RUN ;CONTINUE WITH PROGRAM 1745REDIM: DAD B ;COMPUTE LEN TO NEXT 1746 DCX D ;POINT LO NAME 1747 DCX D ;POINT HI DISP 1748 LDAX D ;GET IT 1749 MOV B,A ;SAVE 1750 DCX D ;POINT LO DISP 1751 LDAX D ;GET IT 1752 MOV C,A ;SAVE 1753 DAD B ;COMPUTE DIFF OR PRIOR DIM AND THIS 1754 MOV A,H ;GET HI DIFF 1755 ORA A ;TEST IT 1756 JM REDM1 ;BRIF PREV > NEW 1757 JNZ SNERR ;BRIF PREV < NEW 1758 MOV A,L ;GET LO DIFF 1759 ORA A ;TEST IT 1760 JNZ SNERR ;BRIF PREV < NEW 1761REDM1: XCHG ;PUT ADDR IN H,L 1762 DCX H ;POINT HI COL 1763 POP D ;GET COL 1764 MOV M,D ;MOVE HI 1765 DCX H ;POINT LO COL 1766 MOV M,E ;MOVE LO 1767 POP D ;GET ROW 1768 DCX H ;POINT HI ROW 1769 MOV M,D ;MOVE HI 1770 DCX H ;POINT LO ROW 1771 MOV M,E ;MOVE LO 1772 JMP DIM3 ;CONTINUE 1773;PAGE 1774; 1775SIN EQU $ 1776; 1777; COMPUTE SINE OF X, (X IN RADIANS) 1778; 1779; USES 4TH DEGREE POLYNOMIAL APPROXIMATION 1780; 1781; 1782; FIRST, REDUCE ANGLE TO RANGE: (-PI/2,PI/2) 1783; 1784 CALL FTEST ;GET STATUS OF ANGLE 1785 RZ ;SIN(0)=0 1786 PUSH PSW ;SAVE SIGN OF ANGLE 1787 CALL ABS 1788SIN1: POP PSW ;COMPLEMENT SIGN FOR EACH PI SUB'D 1789 CMA ;.. 1790 PUSH PSW ;.. 1791 LXI H,PI ;REDUCE TO -PI<X<0 1792 CALL FSUB 1793 JP SIN1 1794 LXI H,HALFP ;NOW ADD PI FOR -PI<X<-PI/2 1795 PUSH H 1796 CALL FADD 1797 CP NEG ;AND JUST NEGATE FOR -PI/2<X<0 1798 POP H 1799 CALL FADD 1800 POP PSW ;RESTORE SIGN 1801 ORA A 1802 CP NEG 1803; 1804; INIT REGISTERS 1805; 1806 LXI H,TEMP1 ;POINT IT 1807 RST 3 ;SAVE IT 1808 LDA FACC ;GET SIGN&EXPONENT 1809 CALL FEXP ;EXPAND EXPON. 1810 JP SIN3A ;BRIF POSITIVE 1811 CPI 0FDH ;TEST EXPONENT 1812 RC ;RETURN IF VERY SMALL RADIAN 1813; 1814; ABOVE ROUTINE WILL APPROX SIN(X) == X FOR X: (-.06,.06) 1815; 1816SIN3A: LXI H,HALFP ;POINT PI/2 1817 CALL FDIV ;COMPUTE X/PI/2 1818 LXI H,TEMP2 ;POINT T2 1819 RST 3 ;STORE IT 1820 LXI H,TEMP2 ;POINT BACK 1821 CALL FMUL ;COMPUTE SQUARE 1822 LXI H,SINCO ;POINT CONSTANTS 1823; 1824; EVALUATE POWER SERIES 1825; 1826; EVALUATE STARTING FROM HIGH ORDER COEFFICIENT: 1827; F(X)=(...(CN*FACC+C(N-1))*FACC+...+C1)*FACC*TEMP2+TEMP1 1828; 1829;ON ENTRY: 1830; TEMP1=CONSTANT TERM 1831; TEMP2=X OR 1 1832; FACC=X^2 OR X 1833; (HL)=COEFFICIENT OF LAST TERM 1834; 1835EVPS: PUSH H ;SAVE POINTER TO COEFFICIENTS 1836 LXI H,TEMP3 ;SAVE FACC 1837 RST 3 1838 POP H ;RESTORE H 1839 PUSH H 1840 JMP EVPS2 1841EVPS1: PUSH H ;SAVE PTR TO NEXT COEFFICIENT 1842 CALL FADD ;FACC+CN->FACC 1843 LXI H,TEMP3 ;POINTER TO X^N 1844EVPS2: CALL FMUL ;FACC*X^N->FACC 1845 POP H ;COEFFICENT PTR 1846 RST 4 ;MOVE TO NEXT COEFFICIENT 1847 DB -4 AND 0FFH 1848 MOV A,M ;GET EXPONENT 1849 DCR A ;TEST FOR 1 1850 JNZ EVPS1 ;BRIF NOT 1 1851 LXI H,TEMP2 ;MUL BY TEMP2 1852 CALL FMUL 1853 LXI H,TEMP1 ;POINT TO CONSTANT TERM 1854 JMP FADD ;ADD IT AND RETURN TO CALLER 1855; 1856COS EQU $ 1857; 1858; 1859; COMPUTE COSINE OF ANGLE, X EXPRESSED IN RADIANS 1860; USES THE TRANSFORMATION: Y = PI/2 +- X 1861; AND THEN COMPUTES SIN(Y). 1862; 1863; 1864 LXI H,HALFP ;COMPUTE PI/2 + X 1865 CALL FADD ;GO ADD 1866 JMP SIN ;GO COMPUTE SINE 1867; 1868TAN EQU $ 1869; 1870; COMPUTE TANGENT OF X, IN RADIANS 1871; USES THE RELATION: 1872; 1873; SIN(X) 1874; TAN(X) = ------ 1875; COS(X) 1876; 1877 LXI H,TEMP4 ;POINT SAVE AREA 1878 RST 3 ;SAVE ANGLE 1879 CALL COS ;COMPUTE COS(X) 1880 LXI H,TEMP7 ;SAVE COS(X)->TEMP7 1881 RST 3 1882 LXI H,TEMP4 ;MOVE X->FACC 1883 RST 5 1884 CALL SIN ;COMPUTE SINE 1885 LXI H,TEMP7 ;POINT COS 1886 JMP FDIV ;DIVIDE AND RETURN TO CALLER 1887; 1888ATN EQU $ 1889; 1890; COMPUTES THE ARCTANGENT OF X 1891; USES A SEVENTH DEGREE POLYNOMIAL APPROXIMATION 1892; 1893 CALL FTEST ;CHECK SIGN OF ARGUMENT 1894 JP ATN1 ;BRIF POSITIVE 1895 CALL NEG ;REVERSE SIGN 1896 CALL ATN1 ;GET POSITIVE ATN 1897 JMP NEG ;MAKE NEG & RETURN 1898; 1899ATN1: LXI H,ONE ;POINT: 1 1900 CALL FADD ;GO ADD 1901 LXI H,TEMP1 ;POINT SAVE 1902 RST 3 ;STORE 1903 LXI H,TWO ;POINT: 2 1904 CALL FSUB ;GO SUBTRACT 1905 LXI H,TEMP1 ;POINT SAVED 1906 CALL FDIV ;DIVIDE 1907 LXI H,TEMP2 ;POINT SAVE 1908 RST 3 ;SAVE X'=(X-1)/(X+1) 1909 LXI H,QTRPI ;X'+PI/4 -> TEMP1 1910 CALL FADD 1911 LXI H,TEMP1 1912 RST 3 1913 PUSH H ;SAVE PTR TO TEMP2 1914 RST 5 ;LOAD IT 1915 POP H 1916 CALL FMUL ;FACC=X'*X' 1917 LXI H,ATNCO ;POINT LIST COEFFICIENTS 1918 JMP EVPS ;GO COMPUTE & RETURN 1919; 1920LN EQU $ 1921; 1922; 1923; COMPUTES THE NATRUAL LOGRITHM, LN(X) 1924; USES A 7TH DEGREE POLYNOMIAL APPROXIMATION 1925; 1926 CALL FTEST ;TEST THE ARGUMENT 1927 JM ZMERR ;LN(-X)=NO NO 1928 JZ ZMERR ;LN(0)=NO NO ALSO 1929 LXI H,TEMP2 ;POINT SAVE AREA 1930 RST 3 ;STORE IT 1931 LDA FACC ;GET EXPON 1932 CALL FEXP ;EXPAND TO 8 BITS 1933 JZ LN0 ;BRIF 0.5 < X < 1.0 1934 JP LN1 ;BRIF POSITIVE EXPONENT 1935LN0: CMA ;ELSE COMPLIMENT 1936 ADI 2 ;PLUS TWO 1937 CALL FDEC ;CONVERT TO FLOAT POINT 1938 CALL NEG ;THEN NEGATE 1939 JMP LN2 ;GO AROUND 1940LN1: SBI 1 ;MINUS ONE 1941 CALL FDEC ;CONVERT TO FLOATING POINT 1942LN2: LXI H,LN2C ;POINT LN(2) 1943 CALL FMUL ;MULTIPLY 1944 LXI H,TEMP1 ;POINT SAVE AREA 1945 RST 3 ;STORE IT 1946 RST 5 ;GET ORIG X 1947 MVI A,1 ;GET EXPONENT: 1 1948 STA FACC ;ADJUST TO RANGE (1,2) 1949 LXI H,ONE ;POINT 1 1950 PUSH H ;SAVE PTR TO ONE 1951 CALL FSUB ;SUBTRACT ONE 1952 POP D ;SET TEMP2=1 1953 LXI H,TEMP2 1954 CALL CPY4D 1955 LXI H,LNCO ;POINT COEFFICIENTS 1956 JMP EVPS ;APPROXIMATE & RETURN 1957; 1958; X=LOG(X) --- THIS IS LOG BASE 10. 1959; 1960LOG EQU $ 1961 CALL LN ;COMPUTE NATURAL LOG 1962 LXI H,LNC ;POINT LOG(E) 1963 JMP FMUL ;MULTIPLY AND RETURN 1964; 1965EXP EQU $ 1966; 1967; COMPUTES EXP(X) USING ALGORITHM EXP(X)=(2^I)*(2^FP) WHERE 1968; 2^I=INT(X*LN BASE 2 OF E) AND, 1969; 2^FP=5TH DEGREE POLY. APPROXIMATION 1970; FP=FRACTIONAL PART OF INT(X*LN2E) 1971; 1972 CALL FTEST ;CHECK SIGN 1973 JP EXP1 ;BRIF POSITIVE 1974 CALL NEG ;ELSE, REVERSE SIGN 1975 CALL EXP1 ;COMPUTE POSITIVE EXP 1976 LXI H,TEMP1 ;POINT SAVE AREA 1977 RST 3 ;STORE IT 1978 LXI H,ONE ;POINT 1 1979 RST 5 ;LOAD IT 1980 LXI H,TEMP1 ;POINT PREV 1981 JMP FDIV ;RECIPRICAL AND RETURN 1982; 1983EXP1: LXI H,LN2E ;POINT LN BASE 2 OF E 1984 CALL FMUL ;FACC=X*(LN2E) 1985 LXI H,TEMP3 ;POINT SAVE AREA 1986 RST 3 ;TEMP3=X*LN2E 1987 CALL INT ;FACC=INT(X*LN2E) 1988 LXI H,TEMP4 ;POINT SAVE AREA 1989 RST 3 ;TEMP4=INT(X*LN2E) 1990 RST 3 ;DITTO FOR TEMP5 1991 LDA FACC ;GET THE EXPONENT COUNT 1992 MOV B,A ;SAVE COUNT IN B 1993 LDA FACC+1 ;GET MANTISSA 1994ELOOP: RLC ;ROTATE LEFT 1995 DCR B ;REDUCE COUNT 1996 JNZ ELOOP ;CONTINUE SHIFTING 1997 INR A ;ADJUST EXPONENT 1998 STA TEMP4 ;STORE EXPONENT 1999 MVI A,80H ;LOAD CONSTANT 2000 STA TEMP4+1 ;STORE AS MANTISSA 2001 LXI H,ONE ;1 -> TEMP1, TEMP2 2002 RST 5 2003 LXI H,TEMP1 2004 RST 3 2005 RST 3 2006 RST 5 ;LOAD TEMP3=INT(X*LN2E) 2007 LXI H,TEMP5 ;GET FACC=FP(X*LN2E) 2008 CALL FSUB 2009 LXI H,EXPCO ;POINT CONSTANTS 2010 CALL EVPS ;COMPUTE POLYNOMIAL 2011 LXI H,TEMP4 ;POINT 2^(INT(X*LN2E)) 2012 JMP FMUL ;MULTIPLY,NORMALIZE AND RETURN 2013; 2014; 2015ABS EQU $ 2016; 2017; 2018; RETURN THE ABSOLUTE VALUE OF THE FLOATING ACCUMULATOR 2019; 2020; 2021 LDA FACC ;GET EXPONENT 2022 ANI 7FH ;STRIP NEGATIVE SIGN 2023 STA FACC ;REPLACE 2024 RET ;RETURN 2025; 2026SGN EQU $ 2027; 2028; 2029; RETURNS THE SIGN OF THE FLOATING ACCUMULATOR 2030; THAT IS: 2031; 1 IF FACC > 0 2032; 0 IF FACC = 0 2033; -1 IF FACC < 0 2034; 2035 CALL FTEST ;GET STATUS OF FACC 2036 RZ ;RETURN IF ZERO 2037 ANI 80H ;ISOLATE SIGN 2038SGN1: ORI 1 ;CREATE EXPONENT 2039 PUSH PSW ;SAVE IT 2040 LXI H,ONE ;GET ADDRESS OF CONSTANT 1 2041 RST 5 ;GO LOAD IT 2042 POP PSW ;RESTORE SIGN 2043 STA FACC ;SET THE SIGN 2044 RET ;RETURN 2045; 2046INT EQU $ 2047; 2048; 2049; RETURNS THE GREATEST INTEGER NOT LARGER THAN VALUE IN FACC 2050; E.G.: 2051; INT(3.14159) = 3 2052; INT(0) = 0 2053; INT(-3.1415) = -4 2054; 2055; 2056 LXI H,FACC ;POINT FLOAT ACC 2057 MOV A,M ;GET EXPONENT 2058 ANI 40H ;GET SIGN OF CHARACTERISTIC 2059 JZ INT2 ;BRIF GE ZERO 2060 MVI B,4 ;LOOP CTR 2061 JMP ZEROM ;GO ZERO THE FACC 2062INT2: MOV A,M ;GET EXPONENT AGAIN 2063 ORA A ;TEST SIGN 2064 JP INT3 ;BRIF POSITIVE OR ZERO 2065 LXI H,NEGON ;POINT CONSTANT: -.9999999 2066 CALL FADD ;ADD TO FACC 2067 LXI H,FACC ;POINT EXPONTENT AGAIN 2068 MOV A,M ;LOAD IT 2069INT3: ANI 3FH ;ISOLATE CHARACTERISTIC 2070 CPI 24 ;TEST IF ANY FRACTION 2071 RP ;RETURN IF NOT 2072 MOV B,A ;SAVE EXPONENT 2073 MVI A,24 ;GET CONSTANT 2074 SUB B ;MINUS EXPONENT = LOOP CTR 2075 MOV C,A ;SAVE IT 2076INT4: LXI H,FACC+1 ;POINT MSB 2077 XRA A ;CLEAR CY FLAG 2078 MVI B,3 ;BYTE COUNT 2079INT5: MOV A,M ;LOAD A BYTE 2080 RAR ;SHIFT RIGHT 2081 MOV M,A ;REPLACE 2082 INX H ;POINT NEXT 2083 DCR B ;DECR BYTE CTR 2084 JNZ INT5 ;LOOP 2085 DCR C ;DECR BIT CTR 2086 JNZ INT4 ;LOOP 2087 LXI H,FACC ;POINT SIGN & EXP 2088 MOV A,M ;LOAD IT 2089 ANI 80H ;ISOLATE SIGN 2090 ADI 24 ;PLUS INTEGER 2091 MOV M,A ;REPLACE IT 2092 JMP FNORM ;GO NORMALIZE & RETURN 2093; 2094SQR EQU $ 2095; 2096; COMPUTE SQAURE ROOT OF ARG IN FACC, PUT RESULT IN FACC 2097; 2098; USE HERON'S ITERATIVE PROCESS 2099; 2100 CALL FTEST ;TEST THE ARGUMENT 2101 RZ ;RETURN IF ZERO 2102 JM ZMERR ;ERROR IF NEGATIVE 2103 STA DEXP ;SAVE ORIG EXPONENT 2104 XRA A ;GET A ZERO 2105 STA FACC ;PUT ARG IN RANGE [.5, 1] 2106 LXI H,TEMP2 ;POINT SAVE AREA 2107 RST 3 ;STORE IT 2108; 2109; INITIAL APPROXIMATION 0.41730759 + 0.59016206 * MANTISSA 2110; 2111 LXI H,SQC1 ;POINT .59016 2112 CALL FMUL ;GO MULTIPLY 2113 LXI H,SQC2 ;PINT .4173 2114 CALL FADD ;GO ADD 2115 LXI H,TEMP1 ;POINT SAVE AREA 2116 RST 3 ;GO STORE IT 2117; 2118; NEWTON'S METHOD OF ITERATION TO THE APPROXIMATE 2119; VALUE OF THE SQR OF MANTISSA 2120; 2121 CALL SQR1 ;FIRST ITERATION 2122 LXI H,TEMP1 ;POINT SAVE AREA 2123 RST 3 ;STORE IT 2124 CALL SQR1 ;SECOND ITERATION 2125; 2126; RESTORE RANGE TO OBTAIN THE FINAL RESULT 2127; 2128 LDA DEXP ;GET SAVE EXPONENT 2129 CALL FEXP ;EXPAND IT 2130 RAR ;DIVIDE BY 2 2131 STA FACC ;STORE IT 2132 RNC ;RETURN IF EXPON EVEN 2133 LXI H,SQC3 ;ELSE, POINT SQR(2) 2134 JMP FMUL ;GO MULTIPLY AND RETURN 2135; 2136; THIS ROUTINE PERFORMS ONE NEWTON ITERATION 2137; TO THE SQUARE ROOT FUNCTION 2138; 2139SQR1: LXI H,TEMP2 ;POINT MANTISSA 2140 RST 5 ;LOAD IT 2141 LXI H,TEMP1 ;POINT PREV GUESS 2142 CALL FDIV ;FORM MANT/TEMP1 2143 LXI H,TEMP1 ;POINT PREV 2144 CALL FADD ;FORM TEMP1 + MANT/TEMP1 2145 SUI 1 ;DIVIDE BY 2 2146 STA FACC ;FORM (TEMP1 + MANT/TEMP1)/2 2147 RET ;RETURN 2148; 2149NEG EQU $ 2150; 2151; 2152; REVERSES THE SIGN OF THE FLOATING ACC 2153; 2154; 2155 CALL FTEST ;GET STATUS OF FACC 2156 RZ ;RETURN IF ZERO 2157 XRI 80H ;REVERSE SIGN 2158 STA FACC ;RESTORE EXPONENT 2159 RET ;CONTINUE EVALUATION 2160; 2161RND EQU $ 2162; 2163; 2164; PSEUDO RANDOM NUMBER GENERATOR 2165; 2166; 2167 LXI H,TEMP7 ;SAVE ARG 2168 RST 3 2169 MVI B,4 ;LOOP CTR 2170 LXI H,FACC ;POINT FLOAT ACCUM 2171 CALL ZEROM ;GO ZERO THE FACC 2172 MVI C,3 ;OUTTER LOP CTR 2173 LXI H,FACC+1 ;POINT MSB 2174 PUSH H ;SAVE H,L 2175RND1: LXI H,RNDZ+1 ;POINT X,Y,Z 2176 MVI B,6 ;LOOP CTR 2177 ORA A ;TURN OFF CY 2178RND2: MOV A,M ;GET A BYTE 2179 RAL ;SHIFT LEFT (MULT BY 2) 2180 MOV M,A ;REPLACE THE BYTE 2181 DCX H ;POINT NEXT 2182 DCR B ;DECR CTR 2183 JNZ RND2 ;LOOP 2184 INX H ;POINT MSD X,Y,Z 2185 LXI D,RNDP ;POINT TO MODULO 2186 MVI B,3 ;LOOP CTR 2187FND3: LDAX D ;GET BYTE OF P,Q,R 2188 CMP M ;COMPARE WITH X,Y,Z 2189 INX D ;POINT NEXT 2190 INX H ;DITTO 2191 JC RND4 ;BRIF P<X 2192 JNZ RND5 ;BRIF P>X 2193 LDAX D ;GET LOW BYTE 2194 CMP M ;CMPARE 2195 JNC RND5 ;BRIF P>=X 2196RND4: XCHG ;FLIP D,E TO H,L 2197 LDAX D ;GET LOW X BYTE 2198 SUB M ;SUBTRACT LOW P BYTE 2199 STAX D ;STORE IT 2200 DCX D ;POINT HIGH 2201 DCX H ;DITTO 2202 LDAX D ;GET HIGH X BYTE 2203 SBB M ;SUB HIGH P BYTE 2204 STAX D ;STORE IT 2205 INX D ;POINT LOW 2206 INX H ;DITTO 2207 XCHG ;RESTORE ADDRS 2208RND5: INX D ;POINT NEXT 2209 INX H ;DITTO 2210 DCR B ;DECR CTR 2211 JNZ FND3 ;LOOP 2212 MVI B,3 ;LOOP CTR 2213RND6: LXI D,RNDS+1 ;POINT LOW S 2214 LDAX D ;GET LOW S 2215 ADD M ;ADD LOW X,Y,Z 2216 STAX D ;PUT S 2217 DCX D ;POINT HIGH 2218 DCX H ;DITTO 2219 LDAX D ;GET HIGH S 2220 ADC M ;ADD HIGH X,Y,Z 2221 ANI 3FH ;TURN OFF HIGH BITS 2222 STAX D ;STORE IT 2223 DCX H ;POINT NEXT X,Y,Z 2224 DCR B ;DECR CTR 2225 JNZ RND6 ;LOOP 2226 MVI A,8 ;CONSTANT 2227 SUB C ;LESS CTR 2228 RAR ;DIVIDE BY TWO 2229 POP H ;GET H,L ADDR 2230 LDA RNDS+1 ;GET LSB OF S 2231 MOV M,A ;STORE IT 2232 INX H ;POINT NEXT 2233 PUSH H ;SAVE H,L 2234 DCR C ;DECR CTR 2235 JNZ RND1 ;LOOP 2236 POP H ;RESTORE SP PTR 2237 LDA RNDSW ;GET SWITCH 2238 ORA A ;TEST IT 2239 JZ RND7 ;BRIF NO RANDOMIZE 2240 LXI D,TRNDX ;POINT SAVED VALUES 2241 LXI H,RNDX ;POINT NEXT VALUES 2242 MVI B,8 ;LOOP CTR 2243 CALL COPYH ;GO COPY 2244RND7: CALL FNORM 2245 LXI H,TEMP7 ;MULTIPLY BY RANGE 2246 JMP FMUL 2247; 2248INP EQU $ 2249; 2250; 2251; INPUT A BYTE FROM THE DEVICE IN FACC 2252; 2253; PUT THE RESULT IN THE FACC 2254; 2255 CALL FBIN ;CONVERT FACC TO BINARY 2256 LXI H,OUTA ;POINT INSTR BUFFER 2257 MVI M,0DBH ;IN INSTR 2258 INX H ;POINT NEXT 2259 MOV M,A ;MOVE ADDR 2260 INX H ;POINT NEXT 2261 MVI M,0C9H ;RET INSTR 2262 CALL OUTA ;GO INPUT A BYTE 2263FDEC: MOV E,A ;MOVE BYTE TO LO D,E 2264 MVI D,0 ;ZERO HI D,E 2265 JMP BINFL ;GO CONVERT TO DEC & RET 2266; 2267POS EQU $ 2268; 2269; 2270; RETURNS THE CURRENT POSITION OF THE TTY CURSOR 2271; 2272; 2273 LDA COLUM ;GET POSITION 2274 JMP FDEC ;CONVERT TO FLOAT AND RETURN 2275; 2276CONCA EQU $ 2277; 2278; 2279; CONCATONATE TWO STRING TOGETHER 2280; COMBINE LENGTH <= 255 2281; 2282 POP D ;ADJUST STACK 2283 LXI D,STRIN ;POINT STRING BUFFER 2284 LDAX D ;GET CURRENT LENGTH 2285 MOV C,A ;STORE IT 2286 MVI B,0 ;CLEAR HI 2287 XCHG ;FLIP FLOP 2288 DAD B ;COMPUTE NEXT 2289 XCHG ;FLIP BACK 2290 ADD M ;COMPUTE COMBINE LENGTH 2291 MOV B,M ;SAVE LEN2 2292 JNC CONC2 ;BRIF NO OVFLW 2293 MVI A,255 ;MAX LEN 2294 SUB C ;MINUS 1ST PART 2295 MOV B,A ;SAVE LEN 2296 MVI A,255 ;UPDATED LENGTH 2297CONC2: STA STRIN ;STORE IT 2298 MOV A,B ;GET LEN TO MOVE 2299 ORA A ;TEST IT 2300 JZ CONC4 ;BRIF NULL 2301CONC3: INX H ;POINT NEXT 2302 INX D ;DITTO 2303 MOV A,M ;GET NEXT CHAR 2304 STAX D ;PUT IT 2305 DCR B ;DECR COUNT 2306 JNZ CONC3 ;LOOP 2307CONC4: POP H ;GET H,L 2308 DCX H ;POINT BACK 2309 LDA STRIN ;GET LEN 2310 RAR ;DIVIDE BY TWO 2311 INR A ;PLUS ONE 2312 XCHG ;SAVE H,L 2313 LHLD SPCTR ;GET CTR 2314 MOV C,A ;SAVE CTR 2315 MVI B,0 ;ZERO HI BYTE 2316 DAD B ;ADD LEN THIS STRING 2317 SHLD SPCTR ;SAVE CTR 2318 POP B 2319 LXI H,0 ;GET ADDR ZERO 2320CONC5: PUSH H ;2 BYTE WORD 2321 DCR A ;DECR CTR 2322 JNZ CONC5 ;CONTINUE 2323 DAD SP ;GET ADDRESS IN H,L 2324 XCHG ;PUT STACK PTR IN D,E 2325 MOV M,D ;MOVE HI ADDR 2326 INX H ;POINT NEXT 2327 MOV M,E ;MOVE LO ADDR 2328 INX H ;POINT NEXT 2329 MVI M,0E7H ;TYPE=STRING 2330 PUSH H ;SAVE H,L 2331 LXI H,STRIN ;GET TEMP STR 2332 MOV A,M ;GET LENGTH 2333 INR A ;PLUS ONE 2334 MOV C,A ;SAVE IT 2335CONC6: MOV A,M ;GET A BYTE 2336 STAX D ;PUT IT DOWN 2337 INX D ;POINT NEXT 2338 INX H ;DITTO 2339 DCR C ;SUBT CTR 2340 JNZ CONC6 ;LOOP 2341 POP H ;RESTORE H,L 2342 RST 4 ;ADJUST H,L 2343 DB -7 AND 0FFH 2344 MVI A,4 ;DELETE 4 BYTES 2345 CALL SQUIS ;GO COMPRESS 2346 JMP EVAL ;CONTINUE EVALUATION 2347; 2348LENFN EQU $ 2349; 2350; X=LEN(A$) 2351; 2352; RETURN THE LENGTH OF THE STRING 2353; 2354 LDA STRIN ;GET LEN IN ACC 2355 JMP FDEC ;GO CONVERT TO DECIMAL & RETURN 2356; 2357CHRFN EQU $ 2358; 2359; A$=CHR$(X) 2360; 2361; RETURNS A ONE CHAR STRING HAVING THE ASCII VALUE - X 2362; 2363 CALL FBIN ;CONVERT FACC TO BINARY 2364 LXI H,STRIN ;POINT OUT AREA 2365 MVI M,1 ;LEN=1 2366 INX H ;POINT NEXT 2367 MOV M,A ;STORE THE CHAR 2368 RET ;RETURN 2369; 2370ASCII EQU $ 2371; 2372; X=ASCII(A$) 2373; 2374; RETURNS THE ASCII VALUE OF THE FIRST CHAR IN STRING 2375; 2376 LXI H,STRIN ;POINT STRING 2377 MOV A,M ;GET LENGTH 2378 ORA A ;TEST IF > ZERO 2379 JZ FDEC ;BRIF ZERO & RETURN A ZERO 2380 INX H ;POINT 1ST CHAR 2381 MOV A,M ;LOAD IT 2382 JMP FDEC ;GO CONVERT TO DECIMAL & RETURN 2383; 2384NUMFN EQU $ 2385; 2386; A$=NUM$(X) 2387; 2388; RETURNS A STRING REPRESENTING X AS IT WOULD HAVE 2389; BEEN PRINTED (INCLUDING TRAILING SPACE) 2390; 2391 LXI H,STRIN ;POINT STRING AREA 2392 MVI M,0 ;INIT COUNT 2393 INX H ;SKIP TO 1ST POSITION 2394 CALL FOUT ;GO CONVERT TO EXTRN DEC 2395 XRA A ;GET A ZERO 2396 MOV B,A ;INIT CTR 2397NUM1: DCX H ;POINT PRIOR 2398 INR B ;COUNT IT 2399 CMP M ;TEST IF ZERO 2400 JNZ NUM1 ;LOOP TILL AT START 2401 MOV M,B ;SET LEN CODE 2402 RET ;THEN RETURN 2403; 2404VAL EQU $ 2405; 2406; X = VAL(A$) 2407; 2408; RETURNS THE VALUE OF THE STRING OF NUMERIC CHARACTERS 2409; 2410 LXI H,STRIN ;POINT STRING AREA 2411 MOV A,M ;GET LEN 2412 ORA A ;TEST FOR NULL STRING 2413 MOV B,A ;SAVE LEN 2414 JZ FDEC ;BRIF IS (RETURNS A 0.00) 2415 LXI D,STRIN ;POINT BUFFER 2416VAL1: INX H ;POINT NEXT 2417 MOV A,M ;GET A CHAR 2418 CPI ' ' ;TEST IF SPACE 2419 JZ VAL2 ;BRIF IS 2420 STAX D ;PUT THE CHAR 2421 INX D ;INCR ADDR 2422VAL2: DCR B ;DECR CTR 2423 JNZ VAL1 ;LOOP 2424 XRA A ;GET A ZERO 2425 STAX D ;PUT IN BUFF 2426 LXI H,STRIN ;POINT START OF BUFFER 2427 CALL FIN ;GO CONVERT 2428 MOV A,M ;GET NON-NUMERIC 2429 ORA A ;TEST IT 2430 JNZ CVERR ;BRIF ERROR 2431 RET ;ELSE, RETURN 2432; 2433SPACE EQU $ 2434; 2435; A$=SPACE$(X) 2436; 2437; CREATES A STRING FO SPACES LENGTH = X 2438; 2439 CALL FBIN ;GET BINARY LENGTH 2440 LXI H,STRIN ;POINT TEMP STRING 2441 MOV M,A ;PUT LEN 2442 ORA A ;TEST IT 2443SPAC1: RZ ;RETURN IF ZERO 2444 INX H ;ELSE, POINT NEXT 2445 MVI M,' ' ;MOVE 1 SPACE 2446 DCR A ;DECR CTR 2447 JMP SPAC1 ;LOOP 2448; 2449STRFN EQU $ 2450; 2451; A$=STRING$(X,Y) 2452; 2453; CREATES STRING OF LNGTH X CONTAINING REPETITION OF CHR$(Y) 2454; 2455 CALL FBIN ;GET BINARY LENGTH 2456 STA STRIN ;PUT TO STRING 2457 CALL ARGNU ;GET NEXT ARGUMENT 2458 LXI H,STRIN ;POINT STRING 2459 MOV B,M ;GET COUNT 2460STR11: INX H ;POINT NEXT 2461 MOV M,A ;STORE THE CHAR 2462 DCR B ;DECR CTR 2463 JNZ STR11 ;LOOP 2464 RET ;RETURN 2465; 2466LEFT EQU $ 2467; 2468; B$=LEFT$(A$,X) 2469; 2470; SUBSTRING FROM THE LEFTMOST X CHARACTERS OF A$ 2471; 2472 CALL ARGNU ;GET 2ND ARGUMENT 2473 MOV C,A ;SAVE LEN 2474 MVI B,1 ;INIT START 2475 JMP MID0 ;CONTINUE 2476; 2477RIGHT EQU $ 2478; 2479; B$=RIGHT$(A$,X) 2480; 2481; SUBSTRING STARTING AT POSITION X TO END OF STRING 2482; 2483 CALL ARGNU ;GET 2ND ARGUMENT 2484 MOV B,A ;SAVE START 2485 MVI C,255 ;MAX LEN 2486 JMP MID0 ;CONTINUE 2487; 2488MIDFN EQU $ 2489; 2490; B$=MID$(A$,X,Y) 2491; 2492; SUBSTRING OF THE STRING A$ STARTING WITH CHARACTER @ X 2493; AND Y CHARACTERS LONG 2494; 2495 CALL ARGNU ;LOAD X 2496 MOV B,A ;SAVE START 2497 PUSH B ;PUT ON STACK 2498 CALL ARGNU ;GET 3RD ARG 2499 POP B ;RETREIVE 2500 MOV C,A ;SAVE LEN 2501MID0: MOV A,B ;LOAD START 2502 LXI H,STRIN ;POINT STRING 2503 CMP M ;TEST IF X>L 2504 JC MID1 ;BRIF X>L 2505 JZ MID1 ;OR EQUAL 2506 MVI M,0 ;ELSE, RESULT IS NULL 2507 RET ;RETURN 2508MID1: ADD C ;COMPUTE END POSITION 2509 JC MID2 ;BRIF OVERFLOW 2510 SBI 1 ;COMPUTE X+Y-1 2511 JC MID2 ;BRIF OVERFLOW 2512 CMP M ;COMPARE TO EXISTING LEN 2513 JC MID3 ;BRIF X+Y-1<LEN(A$) 2514MID2: MOV A,M ;ELSE GET ORIG LEN 2515 SUB B ;MINUS X 2516 INR A ;PLUS ONE 2517 MOV C,A ;SAVE (REPLACE Y) 2518MID3: MOV M,C ;PUT NEW LEN 2519 MOV E,B ;PUT START IN LO 2520 MVI D,0 ;ZERO IN HI 2521 DAD D ;COMPUTE START 2522 LXI D,STRIN ;GET BEGIN 2523MID4: MOV A,M ;GET A CHAR 2524 INX D ;POINT NEXT 2525 INX H ;DITTO 2526 STAX D ;PUT DOWN 2527 DCR C ;DECR CTR 2528 JNZ MID4 ;LOOP 2529 RET ;THEN RETURN 2530; 2531INSTR EQU $ 2532; 2533; X = INSTR(Y,A$,B$) 2534; 2535; SEARCH FOR SUBSTRING B$ IN STRING A$ STARTING AT POS Y. 2536; RETURN 0 IF B$ IS NOT IN A$ 2537; RETURN 1 IF B$ IS NULL 2538; ELSE RETURN THE CHARACTER POSITION 2539; 2540 CALL ARGNU ;GET A$ 2541 LXI H,STRIN ;POINT A$ 2542 ORA A ;TEST Y 2543 JNZ INST2 ;BRIF Y NOT ZERO 2544INST1: MVI M,0 ;ELSE A$ IS NULL 2545 JMP INST3 ;GO AROUND 2546INST2: CMP M ;TEST Y TO LEN(A$) 2547 JZ INST3 ;BRIF EQUAL 2548 JNC INST1 ;BRIF Y > LEN(A$) 2549INST3: MOV C,A ;SAVE Y 2550 MVI B,0 ;ZERO HI INCR 2551 MOV A,M ;GET LEN(A$) 2552 SUB C ;MINUS Y 2553 INR A ;PLUS ONE 2554 DAD B ;COMPUTE START ADDR 2555 MOV B,A ;# CHARS REMAIN IN A$ 2556 PUSH H ;SAVE ADDR 2557 LHLD ADDR1 ;GET ADDR OF ARG 2558 INX H ;POINT NEXT 2559 MOV D,M ;GET HI ADDR 2560 INX H ;POINT NEXT 2561 MOV E,M ;GET LO ADDR 2562 INX H ;POINT NEXT 2563 SHLD ADDR1 ;UPDATED PTR 2564 POP H ;RESTORE ADDR 2565 LDAX D ;GET LEN(B$) 2566 ORA A ;TEST IF NULL 2567 JNZ INST6 ;BRIF NOT 2568 MVI C,1 ;SET POSIT = 1 2569INST5: MOV A,C ;GET POSIT 2570 JMP FDEC ;CONVERT TO DECIMAL & RETURN 2571INST6: XCHG ;FLIP/FLOP 2572 MOV A,B ;GET LEN OF A$ 2573 CMP M ;COMPARE TO LEN B$ 2574 JC INSTA ;BRIF LEN(B$)< LEN(REM A$) 2575 PUSH B ;SAVE CTR, POSIT 2576 PUSH D ;SAVE ADDR A$ 2577 PUSH H ;SAVE ADDR B$ 2578 MOV C,M ;GET LEN B$ 2579 XCHG ;FLIP/FLOP 2580INST8: INX D ;POINT NEXT B$ 2581 LDAX D ;GET B$ CHAR 2582 CMP M ;COMPARE A$ CHAR 2583 JNZ INST9 ;BRIF NOT EQUAL 2584 INX H ;POINT NEXT A$ 2585 DCR C ;DECR CTR (LEN(B$)) 2586 JNZ INST8 ;LOOP 2587 POP H ;DUMMY POP 2588 POP H ;GET DUMMY STACK 2589 POP B ;GET POSITION 2590 JMP INST5 ;WE FOUND A MATCH 2591INST9: POP D ;GET PTR B$ 2592 POP H ;GET PTR A$ 2593 POP B ;GET CTRS, POSIT 2594 INR C ;UP PTR NUM 2595 INX H ;POINT NEXT A$ 2596 DCR B ;DECR B 2597 JNZ INST6 ;LOOP 2598INSTA: MVI C,0 ;ELSE B$ NOT IN A$ 2599 JMP INST5 ;RETURN 2600; 2601FN EQU $ 2602; 2603; STMT: DEF FNX(A)=EXPR 2604; 2605; NOTE: ENTRY FROM EXPR ANALYZER (RECURSIVE) 2606; 2607 PUSH B ;SAVE B,C 2608 PUSH D ;SAVE D,E 2609 PUSH H ;SAVE H,L 2610 XCHG ;PUT H,L TO D,E 2611 LHLD ADDR3 ;GET ADDR 2612 PUSH H ;SAVE IT 2613 XCHG ;PUT D,E BACK TO H,L 2614 SHLD ADDR3 ;UPDATE PTR 2615 LHLD SPCTR ;GET SP COUNT 2616 PUSH H ;SAVE IT 2617 LDA PARCT ;GET PAREN COUNT 2618 MOV B,A ;PUT TO B 2619 LDA FNMOD ;GET FN MODE 2620 MOV C,A ;PUT TO C 2621 PUSH B ;SAVE B,C 2622 LDA DIMSW ;GET DIM SW 2623 PUSH PSW ;SAVE IT 2624 XRA A ;CLEAR A 2625 STA DIMSW ;RESET DIM SW 2626 LHLD FNARG ;GET OLD ARG NAME 2627 PUSH H ;SAVE 2628 LHLD FNARG+2 ;GET OLD ARG ADDRESS 2629 PUSH H ;SAVE 2630 LHLD PROGE ;GET END OF PROGRAM 2631 PUSH H ;SAVE IT 2632 LHLD EXPRS ;GET END OF EXPR 2633 PUSH H ;SAVE IT 2634 SHLD PROGE ;SAVE NEW 'END' OF PROGRAM 2635 MVI A,1 ;GET ON SETTING 2636 STA FNMOD ;SET IN FUNCTION 2637 LHLD ADDR3 ;POINT TO EXPR 2638 MOV C,M ;GET FN CHAR 2639 DCX H ;POINT BACK 2640 MOV B,M ;GET HI NAME 2641 LXI H,BEGPR ;POINT START OF PROGRAM 2642FN2: MOV A,M ;LOAD LEN TO NEXT STMT 2643 ORA A ;TEST IF AT END 2644 JZ SNERR ;BRIF FN NOT FOUND 2645 PUSH H ;SAVE PTR 2646 RST 4 ;ADJUST H,L 2647 DB 3 2648 LXI D,DEFLI ;LITERAL 2649 RST 2 ;GO COMPARE 2650 JNZ FN3 ;BRIF NOT EQUAL 2651 PUSH B ;SAVE TEST NAME 2652 CALL VAR ;GO GET NAME 2653 POP B ;RESTORE NAME 2654 MOV A,D ;GET HI NAME 2655 CMP B ;COMPARE 2656 JNZ FN3 ;BRIF NOT EQUAL 2657 MOV A,E ;GET LO 2658 CMP C ;COMPARE 2659 JZ FN4 ;BRIF EQUAL 2660FN3: POP H ;GET OLD PTR 2661 MOV E,M ;GET LO LEN 2662 MVI D,0 ;ZERO HI LEN 2663 DAD D ;POINT NEXT STMT 2664 JMP FN2 ;LOOP 2665FN4: POP D ;ADJUST STACK 2666 RST 1 ;SKIP BLANKS 2667 CPI '(' ;TEST IF OPEN PAREN 2668 JNZ SNERR ;BRIF NOT 2669 INX H ;SKIP IT 2670 CALL VAR ;GO GET VAR NAME 2671 PUSH H ;SAVE HL ADDR 2672 LXI H,FNARG ;POINT DUMMY ARG TBL 2673 MOV M,D ;STORE LETTER 2674 INX H ;POINT NEXT 2675 MOV M,E ;STORE DIGIT 2676 INX H ;POINT NEXT 2677 XCHG ;PUT H,L TO D,E 2678 LHLD ADDR3 ;POINT TO EXPR STACK 2679 INX H ;POINT CODE 2680 INX H ;POINT HI ADR 2681 MOV A,M ;GET HI 2682 STAX D ;PUT TO TABLE 2683 INX D ;POINT NEXT 2684 INX H ;DITTO 2685 MOV A,M ;GET LO ADDR 2686 STAX D ;PUT TO TABLE 2687 POP H ;RESTORE PTR TO STMT 2688 RST 1 ;SKIP BLANKS 2689 CPI ')' ;TEST IF CLOSE PAREN 2690 JNZ SNERR ;BRIF NOT 2691 INX H ;SKIP IT 2692 RST 1 ;SKIP BLANKS 2693 CPI '=' ;TEST IF EQUAL SIGN 2694 JNZ SNERR ;BRIF NOT 2695 INX H ;SKIP IT 2696 CALL EXPR ;GO EVAL FUNCTION 2697 CALL EOL ;MUST BE END OF LINE 2698 POP H ;GET H,L 2699 SHLD EXPRS ;RESTORE START OF EXPR 2700 POP H ;GET H,L 2701 SHLD PROGE ;RESTORE 'END' OF PROGRAM 2702 POP H ;GET H,L 2703 SHLD FNARG+2 ;STORE ADDR 2704 POP H ;GET H,L 2705 SHLD FNARG ;STORE DUMMY ARG 2706 POP PSW ;GET A,STATUS 2707 STA DIMSW ;RESTORE DIM SW 2708 POP B ;GET B,C 2709 MOV A,C ;LOAD C 2710 STA FNMOD ;RESTORE MOE 2711 MOV A,B ;LOAD B 2712 STA PARCT ;RESTORE PAREN COUNT 2713 POP H ;GET H,L 2714 SHLD SPCTR ;RESTORE SP COUNTER 2715 POP H ;GET H,L 2716 SHLD ADDR3 ;RESTORE ADDR OF EVAL 2717 POP H ;GET H,L 2718 POP D ;GET D,E 2719 DCX H ;POINT 2ND BYTE FOLLOWING OP 2720 SHLD ADDR2 ;SAVE IT 2721 RST 4 ;POINT TO ARG TYPE 2722 DB 5 2723 SHLD ADDR1 ;SAVE ADDR 2724 JMP EV3 ;GO WRAPUP 2725;PAGE 2726; 2727EXPR EQU $ 2728; 2729; 2730; EVALUATE EXPRESSION ROUTINE 2731; LEAVE RESULT IN FACC 2732; RETURN WHEN EXPRESSION ENDS (TYPICALLY AT END OF LINE) 2733; 2734; 2735 XRA A ;CLEAR REG A 2736 STA PARCT ;SET PAREN CTR 2737 XCHG ;SAVE H,L 2738 LXI H,0 ;GET A ZERO 2739 SHLD SPCTR ;INIT CTR 2740 LHLD PROGE ;POINT END OF PROGRAM AREA 2741 INX H ;POINT ONE MORE 2742 MVI M,0 ;INIT START OF STACK 2743 SHLD EXPRS ;SAVE IT 2744 XCHG ;RESTORE H,L 2745; 2746LOOKD EQU $ ;LOOK FOR CON, VAR, OR FUNCTION 2747 RST 1 ;SKIP TO NON-BLANK 2748 CALL NUMER ;GO TEST IF NUMERIC 2749 JNZ LDALP ;BRIF NOT 2750LDNUM: CALL FIN ;GO CONVERT NUMERIC (PUT TO FACC) 2751LDF: MOV B,H ;COPY H,L TO B,C 2752 MOV C,L ;SAME 2753 LHLD EXPRS ;GET ADDR OF EXPR AREA 2754 CALL GTEMP ;GO STORE THE FACC IN TEMP AREA 2755 SHLD EXPRS ;SAVE UPDATED ADDRESS 2756 MOV H,B ;RESTORE H 2757 MOV L,C ;RESTORE L 2758 JMP LOOKO ;GO GET AN OPERATION CODE 2759LDALP: CPI '.' ;SEE IF LEADING DECIMAL POINT 2760 JZ LDNUM ;BRIF IS 2761 CALL ALPHA ;GO SEE IF ALPHA 2762 JNZ LDDTN ;BRIF NOT 2763 MOV B,M ;SAVE 1ST CHAR 2764 INX H ;POINT NEXT 2765 MVI C,' ' ;DEFAULT FOR 1 CHAR VAR 2766 CALL NUMER ;GO SEE IF 2ND IS NUMERIC 2767 JNZ LDFN ;BRIF NOT 2768 INX H ;POINT NEXT 2769 MOV C,A ;SAVE THE CHAR 2770LDV1: RST 1 ;GET NEXT CHAR 2771 CPI '$' ;TEST IF STRING 2772 PUSH PSW ;SAVE STATUS 2773 JNZ LDV2 ;BRIF NOT 2774 MOV A,C ;GET LOW CHAR 2775 ORI 80H ;SET STRING 2776 MOV C,A ;SAVE IT 2777 INX H ;SKIP $ 2778 RST 1 ;SKIP SPACES 2779LDV2: CPI '(' ;TEST IF PAREN 2780 JZ LDV2A ;BRIF IS 2781 PUSH H ;SAVE H,L 2782 MOV D,B ;COPY B,C 2783 MOV E,C ;TO D,E 2784 CALL SEARC ;GO GET VAR ADDR IN D,E 2785LDV: LHLD EXPRS ;GET EXPR ADDR 2786 CALL SADR ;GO STORE ADDRESS 2787 SHLD EXPRS ;SAVE ADDRESS 2788 XCHG ;H,L TO D,E 2789 POP H ;GET OLD H,L 2790 POP PSW ;GET STATUS 2791 JNZ LOOKO ;BRIF NOT STRING 2792 XCHG ;GET OLD H,L 2793 MVI M,0E7H ;MARK AS STRING ADDRESS 2794 XCHG ;RESTORE H,L 2795 JMP LOOKO ;GO LOOK FOR OPCODE 2796LDFN: CALL ALPHA ;GO SEE IF FUNCTION 2797 JNZ LDV1 ;BRIF IT'S NOT 2798LDFN1: DCX H ;POINT BACK TO 1ST 2799 MOV A,M ;GET THAT CHAR 2800 CPI ' ' ;TEST IF SPACE 2801 JZ LDFN1 ;LOOP IF TRUE 2802 PUSH H ;SAVE H,L 2803 LXI D,RNDLI ;POINT LITERAL 2804 RST 2 ;GO COMPARE 2805 JZ LDRND ;BRIF FND 2806 POP H ;GET H,L 2807 PUSH H ;RESAVE 2808 LXI D,FNLIT ;POINT LITERAL 2809 RST 2 ;GO SEE IF FN X 2810 JZ FNL ;BRIF IS 2811 POP H ;GET H,L 2812 PUSH H ;RESAVE 2813 LXI D,PILIT ;POINT LIT 2814 RST 2 ;GO COMPARE 2815 JZ LDPI ;BRIF PI 2816FUNC0: POP H ;GET H,L 2817 LXI D,FUNCT ;POINT FUNCTION TABLE 2818 PUSH H ;SAVE POINTER 2819 CALL SEEK1 ;GO SEARCH FUNCTION TABLE 2820 JZ FUNC4 ;BRIF FUNCTION NOT FOUND 2821 LDAX D ;GET A BYTE LOW 2822 MOV C,A ;SAVE IT 2823 INX D ;POINT NEXT 2824 LDAX D ;GET HI BYTE 2825 MOV B,A ;SAVE IT (B,C = ADDR OF FUNC) 2826 RST 1 ;SKIP BLANKS 2827 CPI '(' ;TEST FOR OPEN PAREN 2828 JNZ SNERR ;BRIF MISSING PAREN 2829 INX D ;POINT TYPE CODE 2830 LDAX D ;LOAD IT 2831 JMP LDFNC ;CONTINUE 2832FUNC4: POP H ;GET H,L 2833 MOV B,M ;GET 1ST CHAR 2834 MVI C,' ' ;SPACE 2ND CHAR 2835 INX H ;POINT TO NEXT 2836 JMP LDV1 ;BRIF VARIABLE 2837FNL: POP D ;DUMMY RESET STACK POINTER 2838 CALL VAR ;GO GET FN NAME 2839 MOV B,D ;COPY TO B,C 2840 MOV C,E ;SAME 2841 XCHG ;SAVE H,L 2842 LHLD EXPRS ;POINT EXPR STACK 2843 INX H ;POINT NEXT 2844 MOV M,B ;MOVE THE LETTER 2845 INX H ;POINT NEXT 2846 MOV M,C ;MOVE DIGIT ($??) 2847 INX H ;POINT NEXT 2848 MVI M,0AFH ;MOVE CODE 2849 MOV A,C ;GET LO NAME 2850 ORA A ;TEST IT 2851 JP FNL3 ;BRIF NOT STRING 2852 MVI M,0CFH ;MOVE CODE 2853FNL3: SHLD EXPRS ;SAVE POINTER 2854 XCHG ;GET H,L 2855 RST 1 ;GET NEXT CHAR 2856 CPI '(' ;TEST IF OPEN PAREN 2857 JNZ SNERR ;BRIF NOT 2858 JMP LOOKD ;CONTINUE 2859LDRND: CPI '(' ;TEST IF RND(X) 2860 JZ FUNC0 ;BRIF IS 2861 PUSH H ;ELSE, SAVE H,L 2862 LXI H,ONE ;USE RANGE (0,1) 2863 RST 5 ;LOAD FACC 2864 CALL RND ;GO GET RANDOM NUMBER 2865 POP H ;RESTORE H,L 2866 POP D ;RESTORE STACK POINTER 2867 JMP LDF ;ACT AS IF CONSTANT 2868LDPI: INR A ;SET NON ZERO 2869 POP D ;DUMMY STACK POP 2870 PUSH PSW ;SAVE STATUS 2871 PUSH H ;SAVE H,L 2872 LXI D,PI ;GET ADDRESS OF 3.1415 2873 JMP LDV ;GO ACT LIKE VARIABLE 2874LDFNC: POP D ;POP THE STACK 2875 XCHG ;FLIP/FLOP 2876 LHLD EXPRS ;GET ADDR 2877 INX H ;POINT NEXT 2878 MOV M,B ;HIGH ADDR 2879 INX H ;POINT NEXT 2880 MOV M,C ;LOW ADDR 2881 INX H ;POINT NEXT 2882 MOV M,A ;CODE 2883 SHLD EXPRS ;SAVE ADDR 2884 XCHG ;RESTORE H,L 2885 JMP LOOKD ;NEXT MUST BE DATA TOO 2886LDDTN: CPI '-' ;TEST IF UNARY MINUS 2887 JNZ LDDTP ;BRIF NOT 2888 XCHG ;SAVE H,L 2889 LHLD EXPRS ;GET EXPR END 2890 INX H ;POINT ONE MORE 2891 MVI M,61H ;CODE FOR NEG 2892 SHLD EXPRS ;RESTORE PTR 2893 XCHG ;RESTORE H,L 2894SKPP: INX H ;POINT PAST THIS BYTE 2895 JMP LOOKD ;NEXT MUST BE DATA 2896LDDTP: CPI '+' ;TEST IF UNARY PLUS 2897 JZ SKPP ;IGNORE IF IS 2898 CPI '(' ;ELSE, TEST IF OPEN PAREN 2899 JZ CERCE ;BRIF IS 2900 CPI 27H ;TEST IF LITERAL (SINGLE QUOTE) 2901 JZ LITST ;BRIF IS 2902 CPI '"' ;TEST IF LITERAL 2903 JNZ SNERR ;BRIF NOT CON, FUNCTION, OR VAR 2904LITST: MOV C,A ;SAVE DELIMITER 2905 LXI D,STRIN ;POINT BUFFER 2906 MVI B,0FFH ;INIT CTR 2907LIT1: INX H ;POINT NEXT 2908 MOV A,M ;LOAD NEXT 2909 INX D ;POINT NEXT 2910 STAX D ;STORE IT 2911 ORA A ;TEST IF END 2912 JZ SNERR ;BRIF ERROR 2913 INR B ;COUNT IT 2914 CMP C ;TEST IF END OF STRING 2915 JNZ LIT1 ;BRIF NOT 2916 INX H ;POINT NEXT 2917 LXI D,STRIN ;POINT BEGIN 2918 MOV A,B ;GET COUNT 2919 STAX D ;PUT COUNT 2920 RAR ;DIVIDE BY TWO 2921 INR A ;PLUS ONE 2922 MOV C,A ;SAVE IT 2923 MVI B,0 ;ZERO HIGH 2924 PUSH H ;SAVE PTR 2925 LHLD SPCTR ;GET CTR 2926 DAD B ;PLUS OLD 2927 SHLD SPCTR ;UPDATE IT 2928 POP D ;GET OLD H,L 2929 LXI H,0 ;GET A ZERO 2930LIT2: PUSH H ;GET 2 WORK BYTES 2931 DCR C ;SUB 1 FROM COUNT 2932 JNZ LIT2 ;CONTINUE 2933 DAD SP ;GET ADDR OF STACK 2934 PUSH D ;SAVE PTR TO STMT 2935 XCHG ;SAVE H,L IN D,E 2936 LHLD EXPRS ;GET START OF EXPR 2937 INX H ;PLUS ONE 2938 MOV M,D ;HI BYTE 2939 INX H ;POINT NEXT 2940 MOV M,E ;LO BYTE 2941 INX H ;POINT NEXT 2942 MVI M,0E7H ;TYPE CODE 2943 SHLD EXPRS ;SAVE ADDR 2944 XCHG ;D,E BACK TO H,L 2945 LXI D,STRIN ;POINT STRING AREA 2946 LDAX D ;GET COUNT 2947 INR A ;ADD ONE TO COUNT 2948 MOV B,A ;SAVE CTR 2949LIT3: LDAX D ;GET A BYTE 2950 MOV M,A ;STORE IT 2951 INX H ;POINT NEXT 2952 INX D ;DITTO 2953 DCR B ;DECR CTR 2954 JNZ LIT3 ;LOOP 2955 POP H ;RESTORE H,L 2956 JMP LOOKO ;NEXT IS OP 2957CERCE: XCHG ;SAVE H,L 2958 LXI H,PARCT ;POINT PAREN COUNT 2959 INR M ;ADD 1 2960 LHLD EXPRS ;GET ADDR 2961 INX H ;POINT NEXT 2962 MVI M,5 ;PUT CODE 2963 SHLD EXPRS ;SAVE ADDR 2964 XCHG ;RESTORE H,L 2965 JMP SKPP ;GO SKIP CHAR 2966LOOKO: RST 1 ;SKIP BLANKS 2967 CPI '+' ;TEST IF PLUS 2968 MVI B,21H ;CODE 2969 JZ OP1 ;BRIF IS 2970 CPI '-' ;TEST IF MINUS 2971 MVI B,25H 2972 JZ OP1 ;BRIF IS 2973 CPI '/' ;TEST IF DIVIDE 2974 MVI B,45H ;CODE 2975 JZ OP1 ;BRIF IS 2976; CPI '^' ;TEST IF EXPON 2977 CPI UPARR ;*UM* FIX FOR MACRO-80 2978 MVI B,81H ;CODE 2979 JZ OP1 ;BRIF IS 2980 CPI ')' ;TEST IF CLOSE PAREN 2981 JZ OP3 ;BRIF IS 2982 CPI ',' ;TEST IF COMMA 2983 JZ OP2 ;BRIF IS 2984 CPI '*' ;TEST IF MULTIPLY 2985 MVI B,41H ;CODE 2986 JZ OP1 ;BRIF IS 2987; ELSE MUST BE END OF EXPRESSION 2988ENDXP: LDA PARCT ;GET OPEN PAREN COUNT 2989 ORA A ;TEST IT 2990 JNZ SNERR ;BRIF # OF ('S NOT = # OF )'S 2991 SHLD ADDR3 ;SAVE ADDR OF STMT 2992 JMP EVAL ;GO EVALUATE 2993OP1: PUSH H ;SAVE PLACE IN ASCII EXPRESSION 2994 LXI D,0105H ;D=BYTE COUNT, E=CODE FOR "(" 2995 LHLD EXPRS ;POINT TO LAST BYTE 2996 MOV A,B ;B&E3 -> C 2997 ANI 0E3H 2998 MOV C,A 2999; INSERT ( AND EVALUATE IF PRECEDENCE REDUCTION, 3000; ELSE INNSERT OP CODE 3001OPLP1: MOV A,M ;GET TYPE CODE FROM EXPRESSION 3002 PUSH PSW ;SAVE 3003 ANI 3 ;GET LENGTH 3004OPLP2: INR D ;BUMP BYTE COUNT 3005 DCX H ;EXPRESSION POINTER 3006 DCR A ;LOOP MOVES TO NEXT ELEMENT 3007 JNZ OPLP2 3008 POP PSW ;RESTORE TYPE CODE 3009 ANI 0E3H ;MASK FOR VARIABLE 3010 CPI 0E3H ;WE SKIP OVER VARIABLES 3011 JZ OPLP1 ;BR IF TYPE = E3 OR E7 3012 CMP C ;PRECEDENCE REDUCTION? 3013 JNC INS ;IF NC, YES, INSERT 05 3014 LHLD EXPRS ;NO, INSERT OPCODE BEFORE VAR AT END 3015 RST 4 ;SKIP OVER VARIABLE 3016 DB -3 AND 0FFH 3017 MVI D,4 ;BYTE COUNT 3018 MOV E,B ;INSERT THIS OP CODE 3019INS: MOV B,E ;SAVE FOR BRANCH AFTER INSERTION 3020INS1: INX H ;BUMP POINTER 3021 MOV C,M ;PICK UP BYTE 3022 MOV M,B ;PUT DOWN REPLACEMENT 3023 MOV B,C ;SAVE FOR NEXT LOOP 3024 DCR D ;DONE? 3025 JNZ INS1 ;IF NZ, NO 3026 SHLD EXPRS ;STORE POINTER 3027 POP H ;RESTORE ASCII EXPRESSION POINTER 3028 MOV A,E ;GET FLAG SAVED IN E 3029 CPI 5 ;STORED A "("? 3030 JNZ SKPP ;IF NZ, NO, PROCESS NEXT ELEMENT 3031 JMP OP4 ;YES, GO EVALUATE 3032OP2: LDA PARCT ;GET OPEN PAREN COUNT 3033 ORA A ;TEST IT 3034 JZ ENDXP ;BRIF END OF EXPR 3035 XCHG ;ELSE SAVE H,L 3036 LHLD EXPRS ;GET EXPR BEGIN 3037 INX H ;POINT NEXT 3038 MVI M,1 ;MOVE A COMMA 3039 SHLD EXPRS ;UPDATE POINTER 3040 XCHG ;FLIP BACK 3041 JMP SKPP 3042OP3: LDA PARCT ;GET OPEN PAREN COUNT 3043 DCR A ;SUBTRACT ONE 3044 STA PARCT ;SAVE IT 3045 JM SNERR ;BRIF TOO MANY )'S 3046 INX H ;POINT NEXT SOURCE 3047OP4: SHLD ADDR3 ;SAVE ADDR 3048EVAL: LHLD EXPRS ;GET END OF EXPR 3049 LXI B,0 ;INIT B,C TO ZERO 3050EV1: INR B ;COUNT EACH BYTE 3051 MOV A,M ;GET CODE IN REG A 3052 DCX H ;POINT NEXT 3053 CPI 0E3H ;TEST IF DATA 3054 JNZ EV2 ;BRIF NOT DATA 3055EV1A: DCX H ;POINT NEXT 3056 DCX H ;DITTO 3057 INR B ;BUMP CTR 3058 INR B ;BY TWO 3059 INR C ;COUNT THE TERM 3060 JMP EV1 ;LOOP 3061EV2: CPI 0AFH ;TEST IF NUMERIC USER FN 3062 JZ FN ;BRIF IS 3063 CPI 0CFH ;TEST IF STRING USER FN 3064 JZ FN ;BRIF IS 3065 PUSH PSW ;ELSE, SAVE STATUS 3066 ANI 0E3H ;MASK IT 3067 CPI 0A3H ;TEST IF NUMERIC FUNCTION 3068 JZ EV2A ;BRIF IS 3069 CPI 0C3H ;TEST IF STRING FUNCTION 3070 JZ EV2A ;BRIF IS 3071 POP PSW ;RESTORE CODE 3072 CPI 0E7H ;TEST IF STRING ADDR 3073 JZ EV1A ;BRIF IS 3074 JMP EV5 ;BR AROUND 3075EV2A: INX H ;RESET TO TYPE CODE 3076 SHLD ADDR1 ;SAVE ADDR 3077 POP D ;DUMMY POP 3078 PUSH B ;SAVE CTRS 3079 DCX H ;POINT TO LOW JMP ADDR 3080 MOV E,M ;LOW BYTE 3081 DCX H ;POINT BACK 3082 MOV D,M ;HIGH BACK 3083 SHLD ADDR2 ;SAVE LOCATION 3084 LXI H,EV3 ;GET RETURN ADDRESS 3085 PUSH H ;SAVE ON STACK 3086 PUSH D ;SAVE ADDRESS 3087 CALL ARG ;GO GET 1ST ARG 3088 POP H ;GET H,L ADDRESS 3089 PCHL ;GO EXECUTE THE FUNCTION 3090EV3 EQU $ ;FUNCTIONS RETURN HERE 3091 LHLD ADDR2 ;GET ADDR FUNC 3092 INX H ;POINT LO 3093 INX H ;POINT TYPE 3094 MOV A,M ;LOAD IT 3095 ANI 0E0H ;MASK IT 3096 CPI 0C0H ;TEST IF STRING 3097 JZ EV4 ;BRIF IS 3098 POP B ;GET CTRS 3099 LHLD SPCTR ;GET COUNTER 3100 INX H ;PLUS 3101 INX H ;TWO WORDS 3102 SHLD SPCTR ;STORE IT 3103 LXI H,0 ;LOAD ZERO TO H,L 3104 PUSH H ;GET BLOCK OF 3105 PUSH H ;BYTES 3106 DAD SP ;GET STACK ADDR 3107 PUSH B ;SAVE CTRS 3108 PUSH H ;SAVE ADDR 3109 RST 3 ;GO STORE THE VARIABLE 3110 MVI A,0E3H ;TYPE=NUM 3111EV3A: POP D ;GET ADDR IN STACK 3112 LHLD ADDR1 ;GET ADDR LST ARG 3113 MOV M,A ;STORE TYPE CODE 3114 DCX H ;POINT ONE BACK 3115 MOV M,E ;STORE LO ADDR 3116 DCX H ;POINT BACK 3117 MOV M,D ;STORE HI ADDR 3118 LHLD ADDR2 ;GET LOCATION FUNCTION 3119 INX H ;POINT LO 3120 INX H ;POINT TYPE 3121 MOV A,M ;LOAD TYPE 3122 MOV B,M ;GET TYPE 3123 RST 4 ;ADJUST H,L 3124 DB -3 AND 0FFH 3125 MOV A,B ;LOAD TYPE 3126 POP B ;RESTORE CTRS 3127 ANI 18H ;ISOLATE #ARGS 3128 RAR ;SHIFT RIGHT 3129 RAR ;AGAIN 3130 RAR ;ONCE MORE 3131 MOV D,A ;SAVE IT 3132 ADD D ;TIMES 2 3133 ADD D ;TIMES 3 3134 INR B ;POINT 3135 INR B ;LST POSIT IN LOC 3136 CALL SQUIS ;GO COMPRESS STACK 3137 JMP EVAL ;START AT BEGINNING 3138EV4: LXI D,STRIN ;POINT STRING BUFFER 3139 LDAX D ;LOAD IT 3140 RAR ;DIVIDE BY TWO 3141 INR A ;ADD 1 3142 LHLD SPCTR ;GET SP COUNT 3143 MOV C,A ;SAVE LO 3144 MVI B,0 ;SET HI 3145 DAD B ;ADD NUMBER WORDS 3146 SHLD SPCTR ;SAVE SP COUNT 3147 LXI H,0 ;GET SOME ZEROS 3148 POP B ;GET CTRS 3149EV4A: PUSH H ;GET 1 WORD 3150 DCR A ;DECR CTR 3151 JNZ EV4A ;LOOP 3152 DAD SP ;GET ADDRESS IN H,L 3153 PUSH B ;RE-SAVE CTRS 3154 PUSH H ;SAVE ADDR 3155 LDAX D ;GET COUNT 3156 INR A ;PLUS ONE 3157 MOV B,A ;SAVE IT 3158EV4B: LDAX D ;GET A BYTE 3159 MOV M,A ;STORE IT 3160 INX D ;POINT NEXT 3161 INX H ;DITTO 3162 DCR B ;DECR CTR 3163 JNZ EV4B ;LOOP 3164 MVI A,0E7H ;TYPE CODE 3165 JMP EV3A ;CONTINUE 3166EV5: CPI 5 ;TEST IF OPEN PAREN 3167 JNZ EV6 ;BRIF NOT 3168 MVI A,1 ;DELETE 1 BYTE 3169 CALL SQUIS ;GO COMPRESS IT 3170 LHLD ADDR3 ;RESTORE STMT POINTER 3171 LDA DIMSW ;GET SUBSR SWITCH 3172 ORA A ;TEST IT 3173 JZ LOOKO ;BRIF NOT IN SUBSCRIPT 3174 LDA PARCT ;GET OPEN PAREN COUNT 3175 ORA A ;TEST 3176 JNZ LOOKO ;BRIF NOT ZERO 3177 JMP EVAL ;ELSE EVALUATE COMPLETE SUBSCR 3178EV6: ORA A ;TEST IF END OF EXPRESSION 3179 JNZ EV9 ;BRIF NOT 3180 LDA DIMSW ;GET DIM SW 3181 ORA A ;TEST IT 3182 CNZ EDM1 ;BRIF NOT OFF 3183 MOV A,C ;GET TERM COUNT 3184 CPI 1 ;TEST IF ONE 3185 JNZ STERR ;ERROR IF NOT ONE 3186 INX H ;POINT HIGH ADDR 3187 INX H ;SAME 3188 MOV D,M ;HIGH TO D 3189 INX H ;POINT LOW 3190 MOV E,M ;LOW TO E 3191 CALL EVLD ;GO LOAD VALUE 3192 LHLD SPCTR ;GET STACK CTR 3193EV7: MOV A,L ;GET LO BYTE 3194 ORA H ;PLUS HI 3195 JZ DV8 ;BRIF ZERO 3196 POP D ;RETURN 2 BYTES 3197 DCX H ;DECR CTR 3198 JMP EV7 ;LOOP 3199DV8: LDA DIMSW ;GET DIM SW 3200 ORA A ;TEST IT 3201 CNZ EDM4 ;BRIF ON 3202 LHLD ADDR3 ;RESTORE STMT PTR 3203 RET ;RETURN TO STMT PROCESSOR 3204EV9: CPI 21H ;TEST IF PLUS 3205 LXI D,FADDJ ;ADDR 3206 JZ EV10 ;BRIF IS 3207 CPI 25H ;TEST IF MINUS 3208 LXI D,FSUB ;ADDR 3209 JZ EV10 ;BRIF IS 3210 CPI 41H ;TEST IF MUL 3211 LXI D,FMUL ;ADDR 3212 JZ EV10 ;BRIF IS 3213 CPI 45H ;TEST IF DIV 3214 LXI D,FDIV ;ADDR 3215 JZ EV10 ;BRIF IS 3216 CPI 1 ;TEST IF COMMA 3217 JZ EVCOM ;BRIF IS 3218 CPI 61H ;TEST IF UNARY MINUS 3219 JZ EVNEG ;BRIF IS 3220 CPI 81H ;TEST IF EXPONENTIAL 3221 LXI D,POWER ;ADDR 3222 JNZ STERR ;ERROR IF NOT 3223EV10: INX H ;POINT TO 3224 INX H ;1ST DATA 3225 PUSH B ;SAVE CTRS 3226 PUSH D ;SAVE ROUTINE ADDR 3227 MOV D,M ;HIGH TO D 3228 INX H ;POINT NEXT 3229 MOV E,M ;LOW TO E 3230 PUSH H ;SAVE POINTER 3231 CALL EVLD ;GO LOAD VALUE 3232 POP H ;RESTORE H,L 3233 INX H ;POINT 2ND DATA 3234 INX H ;SAME 3235 MOV D,M ;HIGH TO D 3236 INX H ;POINT NEXT 3237 MOV E,M ;LOW TO E 3238 INX H ;POINT NEXT 3239 LDA NS ;GET PREV TYPE 3240 CMP M ;TEST THIS TYPE 3241 JNZ SNERR ;BRIF MIXED MODE 3242 DCX H ;POINT BACK 3243 XTHL ;POP ADDR FROM STACK, PUSH H ONTO 3244 LXI B,EV11 ;RETURN ADDRESS 3245 PUSH B ;SAVE ON STACK 3246 PUSH H ;SAVE JUMP ADDR 3247 XCHG ;PUT VAR ADDR TO H,L 3248 RET ;FAKE CALL TO ROUTINE 3249FADDJ: CPI 0E7H ;TEST IF STRINGS 3250 JZ CONCA ;BRIF IS 3251 JMP FADD ;ELSE, GO ADD 3252POWER: PUSH H ;SAVE ADDR OF VAR 3253 LXI H,TEMP1 ;POINT SAVE AREA 3254 RST 3 ;SAVE X 3255 POP H ;RESTORE H,L 3256 RST 5 ;LOAD IT 3257 CALL FTEST ;TEST FOR ZERO 3258 JZ SGN1 ;GIVE RESULT = 1 IF POWER = 0 3259 LXI H,TEMP7 ;POINT SAVE AREA 3260 RST 3 ;SAVE B 3261 LXI H,TEMP1 ;POINT X 3262 RST 5 ;GO LOAD IT 3263 CALL FTEST ;TEST FOR ZERO 3264 RZ ;0^X = 0 3265 CALL LN ;GET NATURAL LNRITHM 3266 LXI H,TEMP7 ;POINT B 3267 CALL FMUL ;GO MULTIPLY 3268 JMP EXP ;GET EXP FUNC 3269; X^B = EXP(B*LN(X)) 3270XSQR: LXI H,TEMP1 ;POINT X 3271 RST 5 ;LOAD X 3272 LXI H,TEMP1 ;POINT X 3273 JMP FMUL ;TIMES X 3274EV11: POP H ;GET H,L 3275 POP B ;GET CTRS 3276 DCX H ;POINT BACK 3277 DCX H ;AND AGAIN 3278 CALL GTEMP ;GO SAVE FACC 3279 RST 4 ;ADJUST H,L 3280 DB -7 AND 0FFH 3281 MVI A,4 ;DELETE 4 BYTES 3282 CALL SQUIS ;GO COMPRESS 3283 JMP EVAL ;CONTINUE 3284EVNEG: INX H ;POINT BACK TO OP 3285 PUSH B ;SAVE CTRS 3286 PUSH H ;SAVE H,L 3287 INX H ;DITTO 3288 MOV D,M ;GET HI BYTE 3289 INX H ;POINT NEXT 3290 MOV E,M ;GET LO BYTE 3291 CALL EVLD ;GO LOAD VAR 3292 CALL NEG ;GO NEGATE IT 3293 POP H ;GET LOCATINO 3294 POP B ;GET CTRS 3295 CALL GTEMP ;GO STORE FACC IN STACK 3296 RST 4 ;ADJUST H,L 3297 DB -4 AND 0FFH 3298EVCOM: MVI A,1 ;DELETE 1 BYTE 3299 CALL SQUIS ;COMPRESS 3300 LXI H,CMACT ;GET COUNT 3301 INR M ;INCR 3302 JMP EVAL ;CONTINUE 3303EVLD: INX H ;POINT TYPE 3304 MOV A,M ;LOAD IT 3305 STA NS ;SAVE IT 3306 XCHG ;SAVE H,L IN D,E 3307 CPI 0E7H ;TEST IF STRING 3308 JNZ RST5 ;LOAD FLOATING POINT 3309 LXI D,STRIN ;POINT BUFFER 3310 MOV A,M ;GET COUNT 3311 INR A ;ADD ONE 3312 MOV B,A ;SAVE COUNT 3313EVLD1: MOV A,M ;GET NEXT 3314 STAX D ;STORE IT 3315 INX H ;POINT NEXT 3316 INX D ;DITTO 3317 DCR B ;DECR COUNT 3318 JNZ EVLD1 ;LOOP 3319 RET ;RETURN 3320; 3321EDM1: MOV A,C ;GET ITEM COUNT 3322 PUSH H ;SAVE H,L 3323 CPI 1 ;TEST IF 1 3324 JNZ EDM3 ;BRIF NOT 3325 MVI B,4 ;GET COUNT 3326 LXI H,TEMP1 ;POINT AREA 3327 CALL ZEROM ;GO ZERO IT 3328EDM2A: POP H ;RESTORE H,L 3329 MVI C,1 ;SET COUNT 3330 RET ;RETURN 3331EDM3: CPI 2 ;TEST IF 2 3332 JNZ SNERR ;ELSE, ERROR 3333 RST 4 ;POINT 2ND ARG 3334 DB 5 3335 MOV D,M ;GET HI ADDR 3336 INX H ;POINT NEXT 3337 MOV E,M ;GET LO ADDR 3338 CALL EVLD ;LOAD THE ARG 3339 LXI H,TEMP1 ;POINT AREA 3340 RST 3 ;SAVE THE ARG 3341 JMP EDM2A ;CONTINUE 3342EDM4: CALL FACDE ;CONVERT FACC TO D,E 3343 PUSH D ;PUT D,E TO B,C 3344 POP B 3345 PUSH B ;SAVE COL 3346 LXI H,TEMP1 ;POINT 2ND ARGUMENT 3347 RST 5 ;LOAD IT IN FACC 3348 CALL FACDE ;CONVERT TO D,E 3349 POP B ;GET COL 3350 XRA A ;GET A ZERO 3351 STA DIMSW ;RESET SW 3352 RET ;RETURN 3353LDV2A: MOV A,B ;GET HI NAME 3354 ORI 80H ;SET BIT 3355 MOV B,A ;RESTORE 3356 PUSH B ;SAVE NAME 3357 XCHG ;SAVE H,L IN D,E 3358 LDA PARCT ;GET PAREN COUNT 3359 PUSH PSW ;SAVE 3360 XRA A ;CLEAR REG A 3361 STA PARCT ;RESET COUNT 3362 LHLD SPCTR ;GET STACK COUNTER 3363 PUSH H ;SAVE IT 3364 LXI H,0 ;GET A ZERO 3365 SHLD SPCTR ;RESET CTR 3366 LHLD EXPRS ;GET EXPRST 3367 PUSH H ;SAVE IT 3368 INX H ;POINT NEXT 3369 MVI M,0 ;SET NEW START 3370 SHLD EXPRS ;SAVE IT 3371 LDA DIMSW ;GET PREV SE 3372 PUSH PSW ;SAVE IT 3373 XCHG ;RESTORE H,L 3374 MVI A,0FFH ;GET ON VALUE 3375 STA DIMSW ;SET SW 3376 CALL LOOKD ;RECURSIVE CALL 3377 POP PSW ;GET DIM SW 3378 STA DIMSW ;REPLACE IT 3379 SHLD ADDR3 ;SAVE H,L 3380 POP H ;GET EXPRST 3381 SHLD EXPRS ;SAVE IT 3382 POP H ;GET STACK COUNTER 3383 SHLD SPCTR ;RESTORE IT 3384 POP PSW ;GET PAREN COUNT 3385 STA PARCT ;RESTORE IT 3386 POP H ;GET NAME 3387 PUSH D ;SAVE ROW 3388 PUSH B ;SAVE COL 3389 XCHG ;PUT NAME IN D,E 3390 CALL SEARC ;GO FIND ADDRESS (PUT IN D,E) 3391 POP D ;GET ADDR 3392 POP B ;RESTORE COL 3393 POP D ;RESTORE ROW 3394 CALL SUBSC ;GET SUBSCRIPT (RETURNS ADDR IN H,L) 3395 XCHG ;SAVE IN D,E 3396 LHLD ADDR3 ;GET H,L 3397 PUSH H ;SAVE ON STACK 3398 JMP LDV ;CONTINUE 3399; PAGE 3400; 3401FIN EQU $ 3402; 3403; FLOATING POINT INPUT CONVERSION ROUTINE 3404; 3405; THIS SUBROUTINE CONVERTS AN ASCII STRING OF CHARACTERS 3406; TO THE FLOATING POINT ACCUMULATOR. THE INPUT FIELD 3407; MAY CONTAIN ANY VALID NUMBER, INCLUDING SCIENTIFIC 3408; NOTATION (NNN.NNNNE+NN). 3409; THE INPUT STRING IS TERMINATED BY ANY NON-NUMERIC CHAR 3410; 3411; 3412 XCHG ;PUT ADDR TO D,E 3413 MVI C,0 ;INITIAL VALUE EXCESS DIGIT COUNT 3414 CALL FIN8 ;GET INTEGER PORTION 3415 MVI B,0 ;CLEAR DIGIT COUNT 3416 CPI '.' ;TEST IF DEC-POINT 3417 JNZ FIN2 ;BRIF NOT 3418 CALL FIN9 ;GET FRACTION 3419FIN2: POP PSW ;GET SIGN 3420 ORI 24 ;SET UP FOR FLOAT 3421 STA FACC 3422 MOV A,B ;GET # FRACTION DIGITS 3423 ADD C ;+ EXCESS DIGITS 3424 PUSH PSW ;SAVE POWER OF TEN 3425 PUSH D ;SAVE PTR 3426 CALL FNORM ;NORMALIZE NUMBER 3427 LDAX D ;GET NEXT CHARACTER 3428 CPI 'E' ;TEST IF EXPONENT 3429 JNZ FIN4 ;BRIF NOT 3430 LXI H,FTEMP ;POINT SAVE AREA 3431 RST 3 ;SAVE ACC 3432 POP D ;RESTORE PTR 3433 INX D ;SKIP 'E' 3434 CALL FIN8 ;GET NUMERIC EXP 3435 LDA FACC+3 ;GET EXPONENT 3436 POP B ;EXPONENT SIGN 3437 INR B ;TEST 3438 JP FIN3 ;BRIF NOT NEG 3439 CMA ;NEGATE EXPONENT 3440 INR A 3441FIN3: POP B ;POWER OF TEN 3442 ADD B ;ADD EXPONENT 3443 PUSH PSW ;SAVE COUNT 3444 LXI H,FTEMP ;RESTORE NUMBER 3445 PUSH D ;SAVE PTR 3446 RST 5 ;LOAD IT 3447FIN4: POP H ;RESTORE PTR 3448 POP PSW ;RESTORE COUNT 3449FIN5: RZ ;RETURN IF ZERO 3450 PUSH H ;SAVE H,L 3451 LXI H,TEN ;POINT CONSTANT: 10 3452 JM FIN7 ;BRIF DIVIDE NEEDED 3453 DCR A ;DECR COUNT 3454 PUSH PSW ;SAVE COUNT 3455 CALL FMUL ;GO MULTIPLY BY 10 3456FIN6: POP PSW ;RESTORE COUNT 3457 POP H ;RESTORE H,L 3458 JMP FIN5 ;CONTINUE 3459FIN7: INR A ;INCR COUNT 3460 PUSH PSW ;SAVE COUNT 3461 CALL FDIV ;GO DIVIDE BY 10 3462 JMP FIN6 ;LOOP 3463; 3464; FIN8 CONVERT NUMBER STRING TO FACC 3465; ON ENTRY, C=INIT VALUE EXCESS DIGIT COUNT 3466; DE=INPUT STRING 3467; ON EXIT, SIGN IS ON STACK 3468; B=DIGIT COUNT 3469; C=EXCESS DIGIT COUNT 3470; 3471FIN8: LXI H,FACC ;CLEAR FACC 3472 MVI B,4 3473 CALL ZEROM 3474 LXI H,8000H ;ASSUME MINUS 3475 LDAX D ;GET CHAR 3476 CPI '-' 3477 JZ FIN8A 3478 MOV H,L ;NOPE, MUST BE PLUS 3479 ;(B IS CLEARED BY ZEROM) 3480 CPI '+' 3481 JZ FIN8A 3482 DCX D ;NEITHER, BACK UP POINTER 3483FIN8A: XTHL ;GET RETURN, PUSH SIGN 3484 PUSH H ;RESTORE RETURN 3485FIN9: INX D ;POINT NEXT 3486 LDAX D ;GET CHAR 3487 CPI '0' ;TEST IF LESS ZERO 3488 RC ;RETURN IF IS 3489 CPI '9'+1 ;TEST IF GT NINE 3490 RNC ;RETURN IF IS 3491 DCR B ;DIGIT COUNT 3492 PUSH D ;SAVE PTR 3493 PUSH B ;SAVE COUNTERS 3494 CALL FMTEN ;MULTIPLY FACC*TEN 3495 ORA A ;TEST FOR OVERFLOW 3496 JZ FINB ;BRIF NO OVERFLOW 3497 LXI H,FTEMP+4 3498 RST 5 ;RESTORE OLD FACC 3499 POP B ;RESTORE COUNTERS 3500 INR C ;EXCESS DIGIT 3501 POP D 3502 JMP FIN9 3503FINB: POP B ;RSTORE COUNTERS 3504 POP D ;& PTR 3505 LDAX D ;GET THE DIGIT 3506 ANI 0FH ;MASK OFF ZONE 3507 LXI H,FACC+3 ;POINT ACC 3508 ADD M ;ADD 3509 MOV M,A ;STORE 3510 DCX H ;POINT NEXT 3511 MOV A,M ;LOAD 3512 ACI 0 ;PLUS CARRY 3513 MOV M,A ;STORE 3514 DCX H ;POINT NEXT 3515 MOV A,M ;LOAD 3516 ACI 0 ;PLUS CARRY 3517 MOV M,A ;STORE 3518 JMP FIN9 ;LOOP 3519; 3520; MULTIPLY FACC BY TEN 3521; 3522FMTEN: LXI H,FTEMP+4 3523 RST 3 ;SAVE FACC 3524 CALL FIND ;*2 3525 CALL FIND ;*4 3526 LXI H,FTEMP+7 3527 CALL FIND0 ;*5 3528FIND: LXI H,FACC+3 ;DOUBLE FACC 3529FIND0: LXI D,FACC+3 3530 MVI B,4 ;BYTE COUNT 3531 JMP FADDT ;ADD & RETURN 3532;PAGE 3533; 3534FOUT EQU $ 3535; 3536; FLOATING POINT OUTPUT FORMAT ROUTINE 3537; 3538; THIS SUBROUTINE CONVERTS A NUMBER IN FACC TO A 3539; FORMAT SUITABLE FOR PRINTING. THAT IS, THE 3540; NUMBER WILL BE IN SCIENTIFIC NOTATION IF EXPONENT 3541; IS > 5 OR < -2, OTHERWISE IT WILL BE ZERO SUPRESSED 3542; ON BOTH SIDES. 3543; 3544 LXI D,FACC+3 ;POINT LSB 3545 LDAX D ;LOAD IT 3546 ORI 7 ;MASK FOR OUTPUT 3547 STAX D ;REPLACE 3548 CALL FTEST ;GET SIGN OF NUMBER 3549 MVI M,' ' ;DEFAULT SPACE 3550 JP FOUT0 ;BRIF NOT MINUS 3551 MVI M,'-' ;MOVE DASH 3552FOUT0: INX H ;POINT NEXT 3553 JNZ FOUT2 ;BRIF NOT ZERO 3554 MVI M,'0' ;MOVE THE ZERO 3555 INX H ;POINT NEXT 3556 MVI M,' ' ;MOVE SPACE FOLLOWING 3557 RET ;RETURN 3558FOUT2: LDA FACC ;GET SIGN & EXP 3559 CALL FEXP ;EXPAND EXPONENT 3560 JNZ FOUTV ;BRIF NOT ZERO 3561 MVI A,80H ;SET NEG 3562FOUTV: ANI 80H ;ISOLATE 3563 STA DEXP ;SAVE SIGN 3564 PUSH H ;SAVE H,L 3565FOUT3: LDA FACC ;GET SIGN & EXP 3566 CALL FEXP ;EXPAND EXP 3567 CPI 1 ;TEST RANGE 3568 JP FOUT6 ;BRIF IN RANGE 3569FOUT4: LXI H,DEXP ;POINT DEC.EXP 3570 INR M ;INCR IT 3571 LXI H,TEN ;POINT CONST: 10 3572 JP FOUT5 ;BRIF POS. 3573 CALL FMUL ;MULTIPLY 3574 JMP FOUT3 ;LOOP 3575FOUT5: CALL FDIV ;DIVIDE 3576 JMP FOUT3 ;LOOP 3577FOUT6: CPI 5 ;TEST HIGH RANGE 3578 JP FOUT4 ;BRIF 5 OR GREATER 3579 LXI H,FTEMP ;POINT SAVE AREA 3580 RST 3 ;STORE IT 3581 LDA FACC ;GET EXPONENT 3582 CALL FEXP ;EXPAND 3583 MVI C,6 ;DIGIT COUNT 3584 CALL FOUTB ;SHIFT LEFT 3585 CPI 10 ;TEST IF DECIMAL POINT 3586 JM FOUTU ;BRIF LT 3587 LXI H,FTEMP ;POINT SAVE AREA 3588 RST 5 ;LOAD IT 3589 JMP FOUT4 ;ONCE MORE 3590FOUTU: CALL FOUT9 ;PUT DIGIT 3591FOUT7: XRA A ;CLEAR STATUS 3592 STA FACC ;AND OVERFLOW 3593 CALL FMTEN ;MULTIPLY BY TEN 3594 CALL FOUT9 ;PUT DIGIT 3595 JNZ FOUT7 ;LOOP 3596 JMP FOUTH ;GO AROUND 3597FOUT9: ORI 30H ;DEC. ZONE 3598 POP H ;GET RETURN ADDR 3599 XTHL ;EXCH WITH TOP (PTR) 3600 MOV M,A ;PUT DIGIT 3601 INX H ;POINT NEXT 3602 MOV A,C ;GET COUNT 3603 CPI 6 ;TEST IF 1ST 3604 JNZ FOUTA ;BRIF NOT 3605 MVI M,'.' ;MOVE DEC. PT. 3606 INX H ;POINT NEXT 3607FOUTA: XTHL ;EXCH WITH RTN 3608 DCR C ;DECR COUNT 3609 PCHL ;RETURN 3610FOUTB: MOV E,A ;SAVE BIT COUNT 3611 XRA A ;CLEAR ACC FLAGS 3612 STA FACC ;AND OVERFLOW 3613FOUTC: LXI H,FACC+3 ;POINT LSB 3614 MVI B,4 ;BYTE COUNT 3615FOUTD: MOV A,M ;GET A BYTE 3616 RAL ;SHIFT LEFT 3617 MOV M,A ;STORE 3618 DCX H ;POINT NEXT 3619 DCR B ;DECR CTR 3620 JNZ FOUTD ;LOOP 3621 DCR E ;DECR BIT CTR 3622 JNZ FOUTC ;LOOP 3623 RET ;RETURN 3624FOUTH: POP H ;GET PTR 3625 MVI M,'E' ;EXPONENT 3626 INX H ;POINT NEXT 3627 LDA DEXP ;GET EXPONENT 3628 MVI M,'+' ;DEFAULT 3629 MOV D,A ;SAVE NUMBER 3630 ORA A ;TEST IT 3631 JP FOUTI ;BRIF POS 3632 MVI M,'-' ;ELSE, DASH 3633 ANI 7FH ;STRIP DUMB SIGN 3634 CMA ;COMPLEMENT 3635 INR A ;PLUS ONE (TWOS COMP) 3636 MOV D,A ;SAVE IT 3637 CMA ;RE-COMPLEMENT 3638 INR A ;PLUS ONE 3639FOUTI: INX H ;POINT NEXT 3640 PUSH H ;SAVE PTR 3641 MVI E,-1 AND 0FFH ;INIT CTR (TENS) 3642FOUTJ: INR E ;ADD ONE 3643 SUI 10 ;LESS 10 3644 JP FOUTJ ;LOOP 3645 ADI 10 ;CORRECT UNITS 3646 MOV B,A ;SAVE UNITS 3647 MOV A,E ;GET TENS 3648 CALL FOUT9 ;OUTPUT 3649 MOV A,B ;GET UNITS 3650 CALL FOUT9 ;OUTPUT 3651 POP H ;GET PTR 3652 MVI M,' ' ;SPACE AFTER 3653 MOV A,D ;GET DEC EXPON 3654 ORA A ;SET FLAGS 3655 JP FOUTK ;BRIF POS. 3656 CPI -2 AND 0FFH ;TEST FOR MIN 3657 RC ;RETURN IF LESS THAN -2 3658 JMP FOUTL ;GO AROUND 3659FOUTK: CPI 6 ;TEST IF TOO BIG 3660 RNC ;RETURN IF 6 OR GREATER 3661FOUTL: MOV C,A ;SAVE EXPONENT 3662 MVI B,5 ;CTR 3663FOUTM: MVI M,' ' ;SPACE OUT EXPONENT 3664 DCX H ;POINT PRIOR 3665 DCR B ;DECR CTR 3666 JNZ FOUTM ;LOOP 3667 XCHG ;FLIP/FLOP 3668 MOV A,E ;GET LOW BYTE 3669 SUI 5 ;POINT TO DOT 3670 MOV L,A ;PUT DOWN 3671 MOV A,D ;GET HIGH 3672 SBI 0 ;IN CASE OF BORROW 3673 MOV H,A ;PUT DOWN 3674 MOV A,C ;GET EXPONENT 3675 ORA A ;TEST SIGN 3676 JZ FOUTO ;BRIF ZERO 3677 JM FOUTR ;BRIF NEGATIVE 3678FOUTN: MOV B,M ;GET HIGH BYTE 3679 INX H ;POINT NEXT 3680 MOV A,M ;GET LOW BYTE 3681 MOV M,B ;SHIFT DOT TO RIGHT 3682 DCX H ;POINT BACK 3683 MOV M,A ;MOVE THE DIGIT LEFT 3684 INX H ;POINT NEXT 3685 DCR C ;DECR CTR 3686 JNZ FOUTN ;LOOP 3687FOUTO: XCHG ;POINT END 3688FOUTP: MOV A,M ;GET A DIGIT/DOT 3689 CPI '0' ;TEST FOR TRAILING ZERO 3690 JNZ FOUTQ ;BRIF NOT 3691 MVI M,' ' ;SPACE FILL 3692 DCX H ;POINT PRIOR 3693 JMP FOUTP ;LOOP 3694FOUTQ: CPI '.' ;TEST FOR TRAILING DOT 3695 INX H ;JUST IN CASE NOT 3696 RNZ ;RETURN IF NOT 3697 DCX H ;RESET PTR 3698 MVI M,' ' ;SPACE IT OUT 3699 RET ;RETURN 3700FOUTR: CPI 0FFH ;TEST IF -1 3701 JNZ FOUTS ;ELSE -2 3702 DCX H ;POINT SIGNIFICANT 3703 MOV A,M ;GET THE CHAR 3704 MVI M,'.' ;MOVE THE DOT 3705 INX H ;POINT NEXT 3706 MOV M,A ;SHIFT THE DIGIT 3707 JMP FOUTO ;GO ZERO SUPPRESS 3708FOUTS: DCX H ;POINT ONE TO LEFT 3709 MOV A,M ;PICK UP DIGIT 3710 MVI M,'0' ;REPLACE 3711 INX H ;POINT RIGHT 3712 MOV M,A ;PUT THE DIGIT 3713 MOV H,D ;GET LOW ADDR 3714 MOV L,E ;POINT LAST DIGIT 3715 MVI B,6 ;CTR 3716FOUTT: DCX H ;POINT PRITO 3717 MOV A,M ;GET A DIGIT 3718 INX H ;POINT 3719 MOV M,A ;PUT IT ONE TO RIGHT 3720 DCX H ;POINT 3721 DCR B ;DECR CTR 3722 JNZ FOUTT ;LOOP 3723 MVI M,'.' ;MOVE THE DOT 3724 JMP FOUTO ;CONTINUE 3725; 3726FADD EQU $ 3727; 3728; 3729; FLOATING POINT ADD THE NUMBER AT (H,L) TO THE FACC 3730; 3731; 3732 INX H ;POINT FIRST DIGIT 3733 MOV A,M ;LOAD IT 3734 ORA A ;TEST IT 3735 JZ FTEST ;BRIF ZERO 3736 DCX H ;POINT BACK 3737 CALL FTEST ;GO TEST SIGN OF FACC 3738 JZ RST5 ;JUST LOAD IF FACC = 0 3739 CALL FEXP ;GO GET EXPONENT 3740 MOV B,A ;SAVE EXPONENT 3741 MOV A,M ;GET EXPONENT OF ADDR 3742 CALL FEXP ;GO GET EXPONENT 3743 MOV C,A ;SAVE THE EXPONENT 3744 SUB B ;GET DIFFERENCE OF TWO EXPONENTS 3745 JZ FADD4 ;BRIF THEY'RE EQ 3746 JP FADD3 ;BRIF DIFFERENCE IS POSITIVE 3747 CMA ;COMPLEMENT ACC 3748 INR A ;PLUS ONE (TWO'S COMPLEMENT) 3749FADD3: CPI 24 ;COMPARE DIFFERENCE TO MAX 3750 JC FADD4 ;BRIF LESS 3751 MOV A,B ;GET EXPON OF ADDUEND 3752 SUB C ;GET TRUE DIFFERENCE AGAIN 3753 JP FTEST ;BRIF FACC > ADDER 3754 JMP RST5 ;ELSE, ADDER > FACC 3755FADD4: PUSH PSW ;SAVE DIFFERENCE 3756 PUSH B ;SAVE EXPONENTS 3757 LXI D,FTEMP ;GET ADDR OF TEMP ACC 3758 CALL CPY4H 3759 POP B ;GET EXPONENTS 3760 POP PSW ;GET DIFFERENCE 3761 JZ FADD9 ;JUST ADD IF ZERO 3762 LXI H,FTEMP+1 ;DEFAULT 3763 PUSH PSW ;SAVE DIFFERENCE 3764 MOV A,B ;GET FACC EXPON 3765 SUB C ;MINUS FTEMP EXPON 3766 JP FADD6 ;BRIF TEMP MUST BE SHIFTED 3767 LXI H,FACC ;POINT FLOAT ACC 3768 MOV A,C ;GET EXPONENT, SIGN 3769 ANI 7FH ;STRIP EXP SIGN 3770 MOV C,A ;PUT BACK 3771 MOV A,M ;GET THE EXP 3772 ANI 80H ;STRIP OFF OLD EXPON 3773 ORA C ;MOVE ADDR EXPON TO IT 3774 MOV M,A ;REPLACE 3775 INX H ;POINT FIRST DATA BYTE 3776FADD6: POP PSW ;GET DIFFER 3777 MOV C,A ;SAVE IT 3778FADD7: MVI B,3 ;LOOP CTR (INNER) 3779 XRA A ;INIT CARRY TO Z 3780 PUSH H ;SAVE ADDR 3781 CALL FSHFT ;GO SHIFT 3782 POP H ;GET ADDR 3783 DCR C ;DECR CTR 3784 JNZ FADD7 ;LOOP 3785FADD9 EQU $ 3786 LXI H,FTEMP 3787 LDA FACC ;GET EXPONENT 3788 XRA M ;SEE IF SIGNS THE SAME 3789 LXI D,FACC+3 ;POINT LEAST SIGN BYTE 3790 LXI H,FTEMP+3 3791 JM FADDA ;BRIF SIGNS DIFFERENT 3792 CALL FADT3 ;ADD 3 BYTES 3793 JNC FTEST ;BRIF NO OVERFLOW 3794 XCHG ;POINT HL TO FACC 3795 CALL SVSGN ;SAVE SIGN, RETURN EXPONENT 3796 INR A ;INCREMENT EXPONENT 3797 CALL RSSGN ;RESTORE SIGN TO EXPONENT 3798 INX H ;POINT DATA 3799 STC ;SET CY 3800 MVI B,3 ;CTR 3801 CALL FSHFT ;GO SHIFT IT 3802 JMP FTEST ;RETURN 3803FADDA EQU $ 3804 MVI B,3 3805 CALL FSUBT ;SUBTRACT 3806 JNC FNORM ;BRIF NO BORROW 3807 LXI H,FACC+3 ;MUST NEGATE 3808 MVI B,3 3809 STC 3810FNEG1: MOV A,M ;GET BYTE 3811 CMA 3812 JNC FNEG2 3813 ADI 1 ;INCREMENT + COMPLEMENT=NEGATE 3814FNEG2: MOV M,A 3815 DCX H 3816 DCR B 3817 JNZ FNEG1 3818 CALL FNORM 3819 JMP NEG ;REVERSE SIGN 3820;PAGE 3821; 3822FNORM EQU $ 3823; 3824; 3825; NORMALIZE THE FLOATING ACCUMULATOR 3826; THAT IS, THE FIRST BIT MUST BE SIGNIFICANT 3827; 3828; 3829 LXI H,FACC+3 ;POINT LSB 3830 MOV A,M ;LOAD IT 3831 DCX H ;POINT PRIOR 3832 ORA M ;MERGE 3833 DCX H ;POINT PRIOR 3834 ORA M ;MERGE 3835 DCX H 3836 MOV B,M ;SAVE EXPONENT 3837 MOV M,A ;CLEAR 3838 RZ ;RETURN ON NOTHING TO NORMALIZE 3839 MOV M,B ;RESTORE EXP 3840 PUSH B ;SAVE C FOR CALLER 3841 CALL SVSGN ;SAVE SIGN 3842 MOV M,A ;STORE EXPANDED EXPONENT 3843FNRM1: INX H ;POINT TO MOST SIGN BYTE 3844 MOV A,M ;GET MSB 3845 ORA A ;TEST IT 3846 JM FNRM3 ;BRIF NORMALIZED 3847 INX H ;POINT LSB 3848 INX H 3849 MVI B,3 ;SHIFT COUNT 3850FNRM2: MOV A,M ;SHIFT LEFT 3851 RAL 3852 MOV M,A 3853 DCX H 3854 DCR B 3855 JNZ FNRM2 3856 DCR M ;ADJUST EXPONENT 3857 JMP FNRM1 ;LOOP 3858FNRM3: DCX H ;POINT BACK TO EXPONENT 3859 MOV A,M 3860 CALL RSSGN ;RESTORE SIGN 3861 POP B ;RESTORE C 3862 RET 3863; 3864FSUB EQU $ 3865; 3866; 3867; FLOATING POINT SUBTRACT THE NUMBER AT (H,L) FROM THE FACC 3868; 3869; 3870 CALL NEG ;NEGATE FACC 3871 CALL FADD ;ADD 3872 CALL NEG ;NEGATE RESULT 3873 JMP FTEST 3874;PAGE 3875; 3876FMUL EQU $ 3877; 3878; 3879; FLOATING POINT MULTIPLY THE NUMBER AT (H,L) TO THE FACC 3880; 3881; 3882 CALL FTEST ;TEST FACC 3883 RZ ;RETURN IF ZERO 3884 INX H ;POINT 1ST DIGIT OF MULTIPLIER 3885 MOV A,M ;LOAD IT 3886 DCX H ;RESTORE 3887 ORA A ;TEST IF ZERO 3888 JZ RST5 ;GO LOAD TO FACC IF IT IS 3889 PUSH H ;SAVE MULTIPLIER ADDRESS 3890 CALL MDSGN ;GET SIGN PRODUCT, & BOTH EXPONENTS 3891 ADD B ;ADD EXPONENTS 3892 CALL RSSGN ;RESTORE SIGN 3893 POP H ;RESTORE 3894 LXI D,FTEMP+9 ;POINT TEMP STORAGE 3895 MVI B,3 ;BYTE COUNT 3896 INX H ;POINT MSD 3897 CALL COPYH ;MOVE MULTIPLIER 3898 LXI H,FTEMP ;POINT DIGIT 7 OF RESULT 3899 MVI B,6 ;LOOP CTR 3900 CALL ZEROM ;GO ZERO EIGHT BYTES 3901 LXI D,FACC+1 ;POINT 1ST DIGIT OF ACC 3902 MVI B,3 ;LOOP CTR 3903FMUL5: LDAX D ;GET AN ACC DIGIT PAIR 3904 MOV M,A ;PUT TO TEMP STORAGE 3905 XRA A ;ZERO A 3906 STAX D ;CLEAR ACC 3907 INX D ;POINT NEXT 3908 INX H ;DITTO 3909 DCR B ;DECR CTR 3910 JNZ FMUL5 ;LOOP 3911 MVI C,24 ;OUTTER LOOP CTR 3912FMUL6: MVI B,3 ;CTR 3913 LXI H,FTEMP+9 ;POINT MULTIPLIER 3914 XRA A ;CLEAR CY 3915FMUL7: MOV A,M ;GET BYTE 3916 RAR ;SHIFT RIGHT 3917 MOV M,A ;PUT DOWN 3918 INX H ;POINT NEXT 3919 DCR B ;DECR CTR 3920 JNZ FMUL7 ;LOOP 3921 JNC FMUL8 ;BRIF ZERO BIT 3922 LXI D,FTEMP+2 ;POINT RESULT 3923 LXI H,FTEMP+8 ;POINT MULTIPLICAND 3924 MVI B,6 ;SIX BYTE ADD 3925 CALL FADDT ;GO ADD 3926FMUL8: MVI B,6 ;SIZ BYTE SHIFT 3927 LXI H,FTEMP+8 ;POINT MULTIPLICAND 3928 XRA A ;CLEAR CY 3929FMUL9: MOV A,M ;GET BYTE 3930 RAL ;SHIFT LEFT 3931 MOV M,A ;PUT BACT 3932 DCX H ;POINT NEXT BYTE 3933 DCR B ;DECR CTR 3934 JNZ FMUL9 ;LOOP 3935 DCR C ;DEC BIT COUNT 3936 JNZ FMUL6 ;CONTINUE 3937 JMP FNORM ;GO NORMALIZE 3938; 3939; MDSGN GET SIGN PRODUCT AND EXPONENTS FOR MULT & DIV 3940; ON ENTRY: 3941; (HL) = ONE NUMBER 3942; (FACC)=THE OTHER 3943; ON RETURN: 3944; A = EXPONENT OF FACC(EXPANDED) 3945; B = OTHER EXPONENT 3946; C = SIGN PRODUCT 3947; HL DESTROYED 3948; 3949MDSGN: CALL SVSGN ;GET SIGN IN C, EXP IN A 3950 MOV B,A ;SAVE EXPONENT 3951 LXI H,FACC 3952 MOV A,C ;GET SIGN 3953 ADD M ;MULTIPLY SIGNS 3954 MOV M,A ;PUT DOWN 3955; 3956; SVSGN GET SIGN AND EXP 3957; ON ENTRY: 3958; (HL) = EXPONENT 3959; ON RETURN: 3960; A = EXPANDED EXPONENT 3961; C = SIGN IN HI ORDER BIT 3962; 3963SVSGN: MOV A,M ;GET EXPONENT 3964 ANI 80H ;ISOLATE SIGN 3965 MOV C,A 3966 MOV A,M 3967 JMP FEXP ;EXPAND EXP AND RETURN 3968; 3969; RSSGN RESTORE SIGN TO EXPONENT 3970; ON ENTRY: 3971; (HL)=EXPONENT 3972; A = EXPANDED EXPONENT 3973; C = SIGN 3974; ON RETURN: 3975; A = EXPONENT 3976; (HL) = EXPONENT WITH SIGN 3977; Z,M BITS SET FOR EXPONENT 3978; 3979RSSGN: CALL FOVUN ;CHECK FOR OVER/UNDERFLOW 3980 ANI 7FH ;REMOVE EXPONENT SIGN 3981 ORA C ;ADD SIGN 3982 MOV M,A ;SET DOWN 3983 JMP FTEST ;SET Z,M BITS 3984;PAGE 3985; 3986FDIV EQU $ 3987; 3988; 3989; FLOATING POINT DIVIDE THE NUMBER AT (H,L) INTO THE FACC 3990; 3991; 3992 CALL FTEST ;TEST IF FACC ZERO 3993 RZ ;RETURN IF IT IS 3994 INX H ;POINT 1ST DIGIT OF DIVISOR 3995 MOV A,M ;LOAD IT 3996 DCX H ;POINT BACK 3997 ORA A ;TEST IF ZERO 3998 JZ ZMERR ;DIVISION BY ZERO = ERROR 3999 PUSH H ;SAVE DIVISOR PTR 4000 CALL MDSGN ;GET SIGN ON STACK, EXPS INTO A,B 4001 SUB B ;SUBTRACT EXPONENTS 4002 INR A ;PLUS ONE 4003 CALL RSSGN ;SET SIGN/EXPONENT IN FACC 4004 LXI D,FACC+1 4005 LXI H,FTEMP ;POINT TEMPORARY STORAGE 4006 MVI M,0 ;CLEAR MSB 4007 INX H ;POINT NEXT 4008 MVI B,3 ;LOOP CTR 4009FDIV3: LDAX D ;GET BYTE FROM FACC 4010 MOV M,A ;PUT TO FTEMP 4011 XRA A ;CLEAR A 4012 STAX D ;ZERO FACC 4013 INX H ;POINT NEXT 4014 INX D ;DITTO 4015 DCR B ;DECR CTR 4016 JNZ FDIV3 ;LOOP 4017 POP D ;GET ADDR 4018 MVI B,3 ;LOOP CTR 4019 INX D ;POINT MSD OF DIVISOR 4020 MVI M,0 ;CLEAR MSB 4021 INX H ;POINT NEXT 4022 CALL COPYD ;GO MOVE IT 4023 MVI C,24 ;OUTER LOOP CTR 4024FDIV5: LXI D,FTEMP+3 ;POINT DIVIDEND 4025 LXI H,FTEMP+7 ;AND DIVISOR 4026 MVI B,4 ;CTR 4027 CALL FSUBT ;GO SUBTRACT 4028 JNC FDIV6 ;BRIF NO GO 4029 LXI D,FTEMP+3 ;POINT DIVIDEND 4030 LXI H,FTEMP+7 ;AND DIVISOR 4031 MVI B,4 ;CTR 4032 CALL FADDT ;GO RE-ADD 4033 STC ;TURN ON CY 4034FDIV6: CMC ;REVERSE CY 4035 MVI B,3 ;CTR 4036 LXI H,FACC+3 ;POINT LSB 4037FDIV7: MOV A,M ;LOAD BYTE 4038 RAL ;SHIFT LEFT 4039 MOV M,A ;REPLACE 4040 DCX H ;POINT NEXT 4041 DCR B ;DECR CTR 4042 JNZ FDIV7 ;LOOP 4043 XRA A ;CLEAR FLAGS 4044 MVI B,4 ;CTR 4045 LXI H,FTEMP+3 ;POINT-DIVIDEND 4046FDIV8: MOV A,M ;LOAD BYTE 4047 RAL ;SHIFT LEFT 4048 MOV M,A ;REPLACE 4049 DCX H ;POINT ENXT 4050 DCR B ;DECR CTR 4051 JNZ FDIV8 ;LOOP 4052 DCR C ;DECR OTR CTR 4053 JNZ FDIV5 ;LOOP 4054 JMP FNORM ;WRAPUP 4055; 4056; UTILITY ROUTINE TO GET A VARIABLE'S ADDRESS TO H,L 4057; 4058GETST: LXI D,STRIN ;POINT BUFFER 4059 MVI B,0 ;INIT CTR 4060 MOV A,M ;GET THE CHAR 4061 CPI '"' ;TEST IF LIT TYPE 4062 JZ GETS2 ;BRIF IS 4063 CPI 27H ;TEST IF QUOTED LITERAL 4064 JZ GETS2 ;BRIF IS 4065GETS1: CPI ',' ;TEST IF COMMA 4066 JZ GETS5 ;BRIF IS 4067 ORA A ;TEST IF END 4068 JZ GETS5 ;BRIF IS 4069 INR B ;COUNT IT 4070 INX D ;POINT NEXT 4071 STAX D ;PUT CHAR 4072 INX H ;POINT NEXT 4073 RST 1 ;SKIP SPACES 4074 JMP GETS1 ;LOOP 4075GETS2: MOV C,A ;SAVE DELIM 4076GETS3: INX H ;SKIP THE QUOTE 4077 MOV A,M ;GET NEXT CHAR 4078 CMP C ;TEST IF END OF LITERAL 4079 JZ GETS4 ;BRIF IS 4080 ORA A ;TEST IF END OF LINE 4081 JZ CVERR ;BRIF IS 4082 INR B ;COUNT IT 4083 INX D ;POINT NEXT 4084 STAX D ;PUT CHAR 4085 JMP GETS3 ;LOOP 4086GETS4: INX H ;SKIP END QUOTE 4087 RST 1 ;SKIP TRAILING SPACES 4088GETS5: LXI D,STRIN ;POINT BEGIN BUFFER 4089 MOV A,B ;GET COUNT 4090 STAX D ;PUT COUNT 4091 POP D ;GET RETURN ADDR 4092 XCHG ;FLIP/FLOP 4093 XTHL ;PUT RET ON STACK, HL OF VAR IN HL 4094 PUSH D ;SAVE H,L OF LOC 4095 CALL LET2A ;GO STORE STRING 4096 POP H ;RESTORE LOCATION 4097 RET ;RETURN 4098GETS8: CALL VAR ;GET VAR NAME 4099 PUSH D ;SAVE ON STACK 4100 MOV A,D ;GET HI BYTE 4101 ORA A ;TEST IF ARRAY 4102 JP GETS9 ;BRIF NOT 4103 CALL SEARC ;GO GET ARRAY PARAMS 4104 MVI A,0FFH ;TURN ON SW 4105 STA DIMSW ;SET IT 4106 XTHL ;SWAP ADDR ON STACK 4107 CALL EXPR ;GO GET ROW, COL PTRS 4108 XTHL ;SWAP ADDR ON STACK 4109 CALL SUBSC ;GO POINT TO ENTRY 4110 XCHG ;EXCHANGE 4111 POP H ;GET ADDRESS OF STMT 4112 POP B ;GET NAME 4113 RET ;RETURN 4114GETS9: CALL SEARC ;FIND ADDR 4115 POP B ;RESTORE NAME 4116 RET ;RETURN 4117; 4118FOVUN EQU $ 4119; 4120; TEST EXPONENT FOR OVERFLO OR UNDERFLOW 4121; 4122 ORA A ;TEST IT 4123 JP FOV1 ;BRIF POS. 4124 CPI 0C1H ;TEST FOR MAX NEG 4125 RNC ;RETURN IF NO UNDER. 4126 MVI A,0C1H ;SET EXPONENT AT MINIMUM 4127 JMP UNERR 4128FOV1: CPI 40H ;TEST MAX POS 4129 RC ;RETURN IF NO OVER. 4130 MVI A,3FH ;SET EXPONENT AT MAXIMUM 4131 JMP OVERR 4132; 4133SUBSC EQU $ 4134; 4135; 4136; COMPUTES SUBSCR ADDR 4137; INPUT: B HAS ROW NUMBER (1ST SUB) 4138; D HAS COL NUMBER (2ND SUB) 4139; H HAS ADDR NAME 4140; 4141 PUSH D ;SAVE COL 4142 RST 4 ;ADJUST H,L 4143 DB -4 AND 0FFH ;BY FOUR 4144 MOV D,M ;GET HI 4145 DCX H ;POINT LO 4146 MOV E,M ;GET LO 4147 MOV A,D ;GET HI 4148 CMP B ;COMPARE 4149 JC SNERR ;BRIF EXCESS 4150 JNZ SUB1 ;BRIF NOT EQUAL 4151 MOV A,E ;GET LO 4152 CMP C ;COMPARE 4153 JC SNERR ;BRIF EXCESS 4154SUB1: DCX H ;POINT HI COLS 4155 MOV D,M ;LOAD IT 4156 DCX H ;POINT LO COLS 4157 MOV E,M ;LOAD IT 4158 XTHL ;SAVE ADDRESS 4159 PUSH H ;SAVE SUB COL 4160 PUSH D ;SAVE DIM COLS 4161 INX D ;MAKE COLS=MAX+1 (ACCOUNT FOR 0 B??KE 4162 LXI H,0 ;GET A ZERO 4163SUB2: MOV A,B ;GET HI 4164 ORA C ;PLUS LO 4165 JZ SUB3 ;BRIF ZERO 4166 DAD D ;ADD ONCE 4167 DCX B ;SUB ONCE 4168 JMP SUB2 ;LOOP 4169SUB3: POP D ;GET DIM COL 4170 POP B ;GET SUB COL 4171 MOV A,D ;GET HI 4172 CMP B ;COMPARE 4173 JC SNERR ;BRIF GT 4174 JNZ SUB4 ;BRIF NOT ZERO 4175 MOV A,E ;GET LO 4176 CMP C ;COMPARE 4177 JC SNERR ;BRIF GT 4178SUB4: DAD B ;ADD TO PROD 4179 DAD H ;TIMES TWO 4180 DAD H ;TIMES FOUR 4181 MOV A,L ;GET LOW 4182 CMA ;COMPLEMENT 4183 ADI 1 ;PLUS ONE 4184 MOV E,A ;SAVE IT 4185 MOV A,H ;GET HI 4186 CMA ;COMPLEMENT 4187 ACI 0 ;PLUS CARRY 4188 MOV D,A ;SAVE 4189 POP H ;GET ADDR (0,0) 4190 DAD D ;COMPUTE (I,J) RIGHT SIDE 4191 RST 4 ;ADJUST H,L 4192 DB -4 AND 0FFH 4193 RET ;RETURN 4194FTEST EQU $ 4195; 4196; TEST THE SIGN OF THE NUMBER IN THE FACC 4197; RETURN WITH S & Z SET TO SIGN 4198; 4199 LDA FACC+1 ;GET MSD 4200 ORA A ;TEST IT 4201 RZ ;RETURN IF ZERO 4202 LDA FACC ;GET SIGN&EXPON BYTE 4203 ORI 7FH ;TEST SIGN BIT ONLY 4204 LDA FACC ;RE-LOAD EXPON BYTE 4205 RET ;THEN RETURN 4206FEXP EQU $ 4207; 4208; EXPAND EXPONENT INTO 8 BINARY BITS 4209; 4210 ANI 7FH ;MASK MANTISA SIGN 4211 ADI 40H ;PROPAGATE CHAR SIGN TO LEFTMOST BIT 4212 XRI 40H ;RESTORE ORIGINAL SIGN BIT 4213 RET ;RETURN 4214; 4215FSUBT EQU $ 4216; 4217; SUBTRACT THE TWO MULTIPRECISION NUMBERS (D,E) & (H,L) 4218; 4219 XRA A ;TURN OF CY 4220FSB1: LDAX D ;GET A BYTE 4221 SBB M ;SUB OTHER BYTE 4222 STAX D ;PUT DOWN 4223 DCX D ;POINT NEXT 4224 DCX H ;DITTO 4225 DCR B ;DECR CTR 4226 JNZ FSB1 ;LOOP 4227 RET ;RETURN 4228; 4229; ADD TWO MULTI-PRECISION NUMBERS (D,E) & (H,L) 4230; 4231FADT3: MVI B,3 4232FADDT: XRA A ;CLEAR STATUS 4233FAD1: LDAX D ;GET BYTE 4234 ADC M ;ADD OTHER BYTE 4235 STAX D ;PUT DOWN 4236 DCX D ;POINT NEXT 4237 DCX H ;DITTO 4238 DCR B ;DECR LOOP CTR 4239 JNZ FAD1 ;LOOP 4240 RET ;RETURN 4241; 4242FSHFT EQU $ 4243; 4244; INCREMENTING SHIFT RIGHT 4245; 4246 MOV A,M ;GET A BYTE 4247 RAR ;SHIFT RIGHT 4248 MOV M,A ;PUT DOWN 4249 INX H ;POINT NEXT 4250 DCR B ;DECR CTR 4251 JNZ FSHFT ;LOOP 4252 RET ;RETURN 4253;PAGE 4254; 4255TERMI EQU $ 4256; 4257; READ A LINE FROM THE TTY 4258; FIRST PROMPT WITH THE CHAR IN THE A REG 4259; TERMINATE THE LINE WITH A X'00' 4260; IGNORE EMPTY LINES 4261; CONTROL C WILL CANCLE THE LINE 4262; CONTROL O WILL TOGGLE THE OUTPUT SWITCH 4263; RUBOUT WILL DELETE THE LAST CHAR INPUT 4264; 4265; 4266 STA PROMP ;SAVE THE PROMPT CHAR 4267REIN: LXI H,IOBUF ;POINT TO INPUT BUFFER 4268 MVI M,0 ;MARK BEGIN 4269 INX H ;POINT START 4270 LDA PROMP ;GET THE PROMPT AGAIN 4271 CALL TESTO ;WRITE TO TERMINAL 4272 CPI '?' ;TEST IF Q.M. 4273 JNZ TREAD ;BRIF NOT 4274 MVI A,' ' ;GET SPACE 4275 CALL TESTO ;WRITE TO TERMINAL 4276TREAD EQU $ 4277 IF NOT CPM 4278 IN TTY+1 ;GET TTY STATUS 4279 ANI 2 ;TEST IF RXRDY 4280 JZ TREAD ;LOOP TIL CHAR 4281 ENDIF 4282 CALL GETCH ;GO READ THE CHAR 4283 MOV M,A ;PUT IN BUFFER 4284 CPI 0AH ;TEST IF LINE FEED 4285 JZ TREAD ;IGNORE IF IT IS 4286 CPI 0DH ;TEST IF CR 4287 JNZ NOTCR ;BRIF NOT 4288 LDA TAPES ;GET PAPER TAPE SWITCH 4289 RAR ;TEST IF LOAD 4290 CNC CRLF ;CR/LF IF NOT 4291CR1: MVI M,0 ;MARK END 4292 LDA ILSW ;GET INPUT LINE SW 4293 ORA A ;TEST IT 4294 RNZ ;RETURN IF ON 4295 DCX H ;POINT PRIOR 4296 MOV A,M ;LOAD IT 4297 CPI 20H ;TEST IF SPACE 4298 JZ CR1 ;BRIF SPACE 4299 ORA A ;TEST IF AT BEGINNING 4300 JZ REIN ;BRIF IS (NULL LINE) 4301 LXI H,IOBUF+1 ;POINT BEGIN 4302 RET ;ELSE, RETURN 4303TESTO EQU $ 4304 IF NOT CPM 4305 PUSH PSW ;SAVE CHAR 4306TEST1: IN TTY+1 ;GET STATUS 4307 RAR ;TEST IF TXRDY 4308 JNC TEST1 ;LOOP TILL READY 4309 POP PSW ;GET CHAR 4310 OUT TTY ;WRITE IT 4311 ENDIF 4312 IF CPM 4313 PUSH B ;BIOS CALLS DESTROYS C,DE 4314 PUSH D 4315 PUSH H 4316 MOV C,A ;OUTPUT BYTE 4317 CALL BTOUT ;CALL BIOS 4318 POP H 4319 POP D ;RESTORE 4320 POP B 4321 ENDIF 4322 IF LARGE ;SAVE ROOM ONLY IN 8+K VERSIONS 4323 DB 0,0,0 ;SAVE ROOM FOR CALL TO USER ROUTINE 4324 ENDIF 4325 RET ;RETURN 4326CRLF: MVI A,0DH ;LOAD A CR 4327 CALL TESTO ;WRITE IT 4328 MVI A,0AH ;LF 4329 CALL TESTO ;WRITE IT 4330 MVI A,255 ;GET RUBOUT CHAR 4331 MVI B,0FAH ;LOAD 255-RUBOUT COUNT 4332PAUZ: CALL TESTO ;SEND RUBOUT 4333 INR B ;INCREMENT COUNT 4334 CMP B ;COMPARE TO 255 4335 JNZ PAUZ ;SET ANOTHER RUBOUT 4336 XRA A ;GET A ZERO 4337 STA COLUM ;RESET COLUMN POINTER 4338 RET ;RETURN 4339NOTCR: CPI 15H ;TEST IF CONTROL-U 4340 JNZ NOTCO ;BRIF NOT 4341 CALL PRCNT ;GO PRINT CONTROL-U 4342 CALL CRLF ;GET CR/LF 4343 JMP REIN ;GO RE-ENTER 4344NOTCO: CPI 7FH ;TEST IF RUBOUT 4345 JNZ NOTBS ;BRIF NOT 4346 LDA TAPES ;GET PAPER TAPE SW 4347 RAR ;TEST IF LOAD 4348 JC TREAD ;IGNORE IF LOAD 4349 DCX H ;POINT PRIOR 4350 MOV A,M ;LOAD PREV CHAR 4351 ORA A ;TEST IF BEGIN 4352 JZ ECHO ;BRIF IS 4353; MVI A,'\' ;BACK SLASH 4354 MVI A,BACKSL;*UM* FIX FOR MACRO-80 4355 CALL TESTO ;WRITE IT 4356 MOV A,M ;FETCH CHARACTER TO BE DISCARDED 4357 CALL TESTO ;WRITE IT 4358; MVI A,'\' ;BACK SLASH 4359 MVI A,BACKSL;*UM* FIX FOR MACRO-80 4360 CALL TESTO ;WRITE IT 4361 JMP TREAD ;GET REPLACEMENT CHARACTER 4362NOTBS EQU $ 4363 IF LARGE ;CONTROL H WORKS ONLY ON 9K VERSION 4364 CPI 8 ;TEST FOR ASCII BACKSPACE 4365 JNZ NOTCH ;BRIF NOT CONTROL H 4366 DCX H ;POINT PRIOR 4367 MOV A,M ;FETCH CHARACTER 4368 ORA A ;TEST FOR BEGINNING 4369 JZ ECHO ;BRIF IT IS 4370 PUSH H ;SAVE POSITION 4371 LXI H,RBOUT ;POINT RUBOUT SEQUENCE 4372 CALL TERMM ;WRITE IT 4373 POP H ;RESTORE H,L 4374 JMP TREAD ;GET REPLACEMENT CHARACTER 4375 ENDIF 4376NOTCH: LDA TAPES ;GET PAPER TAPE SWITCH 4377 RAR ;FLAG TO CARRY 4378 JC ECHO ;NO ECHO IF TAPE 4379 MOV A,M ;ELSE, LOAD THE CHAR 4380 CALL TESTO ;ECHO THE CHARCTER 4381ECHO: INX H ;POINT NEXT POSIT 4382 JMP TREAD ;LOOP FOR NEXT 4383; 4384TERMO EQU $ 4385; 4386; TTY PRINT ROUTINE 4387; 4388; OUTPUT STRING OF CHARS 4389; STARTING AT IOBUF +0 THRU END (FF OR FE OR 00) 4390; FOLLOWING IMBEDDED CHARACTERS ARE INTERPRETED AS CONTROLS: 4391; X'00' END OF BUFFER, TYPE CR/LF AND RETURN 4392; X'FE' END OF BUFFER, RETURN (NO CR/LF) 4393; X'FD' TYPE CR/LF, CONTINUE 4394; 4395; RETURN WITHOUT OUTPUT IF OUTPUT SW IS OFF 4396; 4397 LDA OUTSW ;GET OUTPUT SW 4398 ORA A ;TEST IT 4399 RNZ ;RETURN IF NO PRINT 4400 LXI H,IOBUF ;POINT I/O BUFFER 4401OT1: MOV A,M ;LOAD A BYTE 4402 CPI 0FEH ;SEE IF END OF LINE (NO CR/LF) 4403 RZ ;RETURN IF EQUAL 4404 CPI 0FDH ;SEE IF IMBEDDED CR/LF 4405 JNZ OT2 ;BRIF NOT 4406 CALL CRLF ;LINE FEED 4407 JMP OT4 ;CONTINUE 4408OT2: ORA A ;TEST IF END OF OUTPUT 4409 JZ CRLF ;BRIF IS 4410 MOV A,M ;LOAD THE BYTE 4411 CALL TESTO ;TYPE IT 4412 LDA COLUM ;GET COLUMN POINTER 4413 INR A ;ADD ONE 4414 STA COLUM ;RESTORE IT 4415OT4: INX H ;POINT NEXT 4416 JMP OT1 ;LOOP 4417TERMM EQU OT1 4418; 4419TABST EQU $ 4420; 4421; 4422; POSITION TTY AT NEXT TAB STOP 4423; 4424; 4425 LDA OUTSW ;GET OUTPUT SWITCH 4426 ORA A ;TEST IT 4427 RNZ ;RETURN IF SUPPRESSED 4428 LDA COLUM ;GET COLUMN POINTER 4429 CPI 56 ;COMPARE TO 56 4430 JNC CRLF ;BRIF NO ROOM LEFT 4431 MOV B,A ;SAVE IT 4432 XRA A ;INIT POSITION 4433TBLP: CMP B ;COMPARE 4434 JZ TBLP2 4435 JNC TBON ;BRIF SHY OF TAB 4436TBLP2: ADI 14 ;POINT NEXT STOP 4437 JMP TBLP ;LOOP 4438TBON: STA COLUM ;UPDATE CTR 4439 SUB B ;COMPUTE NUMBER OF SPACES 4440 MOV B,A ;SAVE IT 4441TBSPA: MVI A,' ' ;SPACE TO REG A 4442 CALL TESTO ;OUTPUT IT 4443 DCR B ;SUB 1 FROM CTR 4444 RZ ;RETURN IF ZERO 4445 JMP TBSPA ;ELSE, LOOP 4446; 4447LINEO EQU $ 4448; 4449; UNPACK LINE NUMBER FROM (H,L) TO (D,E) 4450; ZERO SUPPRESS LEADING ZEROS 4451; 4452; 4453 PUSH B ;PUSH B,C 4454 MVI B,1 ;SET SWITCH 4455 CALL LOUT ;GO FORMAT 2 BYTES 4456 CALL LOUT ;THEN THE NEXT 2 4457 POP B ;RESTORE B,C 4458 RET ;RETURN 4459; 4460LOUT EQU $ 4461 MOV A,M ;GET BYTE 4462 ANI 0F0H ;ISOLATE LEFT HALF 4463 RAR ;SHIFT RIGHT 1 BIT 4464 RAR ;AGAIN 4465 RAR ;AGAIN 4466 RAR ;LAST TIME 4467 JNZ NOTZ1 ;BRIF NOT ZERO 4468 ORA B ;MERGE IN B 4469 JNZ Z1 ;BRIF ZERO 4470NOTZ1: MVI B,0 ;RESET SWITCH 4471 ORI 30H ;ZONE 4472 STAX D ;PUT TO BUFFER 4473 INX D ;POINT NEXT 4474Z1: MOV A,M ;LOAD BYTE 4475 ANI 0FH ;MASK 4476 JNZ NOTZ2 ;BRIF NOT ZERO 4477 ORA B ;MERGE SWITCH 4478 JNZ Z2 ;BRIF ZERO 4479NOTZ2: MVI B,0 ;SET SWITCH OFF 4480 ORI 30H ;ZONE 4481 STAX D ;PUT TO BUFFER 4482 INX D ;POINT TO NEXT 4483Z2: INX H ;AND NEXT LINE BYTE 4484 RET ;RETURN 4485; 4486TSTCC EQU $ 4487; 4488; TEST IF KEY WAS PRESSED DURING EXECUTION 4489; CANCEL IF CONTROL-C 4490; TOGGLE OUTPUT SUPPRESS SW IF CONTROL-O 4491; 4492 IF NOT CPM 4493 IN TTY+1 ;GET TTY STATUS 4494 ANI 2 ;MASK FOR RXRDY 4495 RZ ;RETURN IF NO CHAR 4496GETCH: IN TTY ;READ THE CHAR 4497 ANI 7FH ;TURN OFF PARITY 4498 ENDIF 4499 IF CPM 4500 ;NOTE: FOLLOWING CLOBBERS REGISTERS, 4501 ; PUSH AND POP IF FOUND TO CREATE BUGS. 4502 CALL BTSTAT ;CALL BIOS 4503 RZ ;RETURN ON NO CHAR 4504GETCH: PUSH B ;SAVE REGS - CPM CAN CLOBBER 4505 PUSH D 4506 PUSH H 4507 CALL BTIN ;CALL BIOS TO INPUT 4508 POP H 4509 POP D 4510 POP B 4511 ENDIF 4512 CPI 3 ;TEST IF CONTROL C 4513 JNZ TSTC1 ;BRIF NOT 4514 CALL PRCNT ;GO PRINT CONTROL-C 4515 LDA EDSW ;GET MODE SW 4516 ORA A ;TEST IT 4517 JNZ KEY ;**;BRIF COMMAND MODE 4518 LXI H,STOPM ;POINT MSG 4519 CALL TERMM ;GO PRINT IT 4520 CALL PRLIN ;GO PRINT LINE 4521 JMP KEY ;GOTO READY 4522TSTC1: CPI 0FH ;TEST IF CONTROL O 4523 RNZ ;RETURN IF NOT 4524 CALL PRCNT ;GO PRINT CONTROL-O 4525 LDA OUTSW ;GET OUTPUT SWTICH 4526 XRI 1 ;TOGGLE 4527 STA OUTSW ;PUT SW 4528 RET ;RETURN 4529; 4530PRCNT EQU $ 4531; 4532; 4533; PRINTS ^ AND CHAR 4534; 4535 PUSH PSW ;SAVE CHAR 4536; MVI A,'^' ;GET UP ARROW 4537 MVI A,UPARR ;*UM* FIX FOR MACRO-80 4538 CALL TESTO ;WRITE IT 4539 POP PSW ;GET CHAR 4540 ADI 64 ;TRNSLATE 4541 JMP TESTO ;WRITE IT 4542;PAGE 4543; 4544COMP2 EQU $ 4545; 4546; CONTINUATION OF COMPARE (RST 2) ROUTINE 4547; 4548 ORA A ;TEST IT 4549 JNZ COMP5 ;BRIF NOT END 4550COMP3: XRA A ;SET EQUAL STATUS 4551COMP4: MOV A,M ;GET LAST CHAR 4552 POP B ;RESTORE B,C 4553 RET ;RETURN 4554COMP5: CMP M ;COMPARE THE TWO CHARS 4555 JZ COMP6 ;BRIF EQUAL 4556 MOV A,B ;GET COUNT 4557 CPI 3 ;GET IF >= 3 4558 JNC COMP3 ;BRIF NOT LESS THAN 3 4559 JMP COMP4 ;BRIF LESS THAN 3 AND NOT EQUAL 4560COMP6: INR B ;COUNT IT 4561 INX D ;POINT NEXT LIT 4562 INX H ;POINT NEXT VAR 4563 JMP COMP1 ;CONTINUE 4564; 4565EOL EQU $ 4566; 4567; TESTS IF (H,L) IS END OF LINE 4568; ERROR-DL IF NOT 4569; 4570 RST 1 ;SKIP TO NON-BLANK 4571 CALL TSTEL ;TEST IF END LINE 4572 JNZ SNERR ;ERROR IF NOT 4573 CPI ':' ;TEST FOR MULTIPLE STATEMENT 4574 JNZ EOL1 ;BRIF NOT 4575 STA MULTI ;SET SWITCH 4576EOL1: INX H ;POINT NEXT 4577 SHLD ENDLI ;SAVE POINTER 4578 RET ;RETURN 4579; 4580TSTEL EQU $ 4581; 4582; TEST (H,L) FOR END OF STATEMENT (00H OR ':') 4583; RETURN WITH Z SET IF IT IS 4584; 4585 ORA A ;TEST FOR ZERO 4586 RZ ;RETURN IF IS 4587 CPI ':' ;TEST FOR MULTIPLE STATEMENT 4588 RET ;RETURN 4589; 4590NOTEO EQU $ 4591; 4592; 4593; TEST IF (H,L) IS END OF LINE 4594; RETURN IF NOT, ERROR-DL IF IS 4595; 4596 RST 1 ;SKIP TO NON-BLANK 4597 CALL TSTEL ;TEST IF END OF LINE 4598 JZ SNERR ;ERROR IF IS 4599 RET ;ELSE, RETURN 4600; 4601PACK EQU $ 4602; 4603; PACK LINE NUMBER FROM (H,L) TO B,C 4604; 4605; 4606 LXI B,0 ;CLEAR B AND C 4607 MVI A,4 ;INIT DIGIT COUNTER 4608 STA PRSW ;SAVE A 4609PK1: MOV A,M ;GET CHAR 4610 CALL NUMER ;TEST FOR NUMERIC 4611 RNZ ;RETURN IF NOT NUMERIC 4612 ANI 0FH ;STRIP OFF ZONE 4613 MOV D,A ;SAVE IT 4614 LDA PRSW ;GET COUNT 4615 DCR A ;SUBTRACT ONE 4616 JM SNERR ;BRIF ERROR 4617 STA PRSW ;SAVE CTR 4618 MVI E,4 ;4 BIT SHIFT LOOP 4619PK3: MOV A,C ;GET LOW BYTE 4620 RAL ;ROTATE LEFT 1 BIT 4621 MOV C,A ;REPLACE 4622 MOV A,B ;GET HIGH BYTE 4623 RAL ;ROTATE LEFT 1 BIT 4624 MOV B,A ;REPLACE 4625 DCR E ;DECR CTR 4626 JNZ PK3 ;LOOP 4627 MOV A,C ;GET LOW 4628 ORA D ;PUT DIGIT IN RIGHT HALF OF BYTE 4629 MOV C,A ;REPLACE 4630 INX H ;POINT NEXT BYTE 4631 JMP PK1 ;LOOP 4632; 4633SQUIS EQU $ 4634; 4635; COMPRESS THE EXPR STACK 4636; REG A CONTAINS # OF BYTES TO REMOVE STARTING AT (H,L+1) 4637; CONTAINS TOTAL NUMBER OF CHARACTERS IN STACK THUS FAR 4638; 4639 PUSH H ;SAVE H,L 4640 MOV E,A ;COUNT TO E 4641 MVI D,0 ;ZERO HI BYTE 4642 DAD D ;COMPUTE START 4643 XCHG ;PUT TO D,E 4644 POP H ;GET H,L 4645 CMA ;COMPLEMENT COUNT 4646 INR A ;THEN 2'S COMPLEMENT 4647 ADD B ;COMPUTE B-A 4648 MOV B,A ;PUT TO B 4649SQUI2: INX D ;POINT NEXT SEND 4650 INX H ;POINT NEXT RECEIVE 4651 LDAX D ;GET A CHAR 4652 MOV M,A ;PUT IT DOWN 4653 DCR B ;DECR CTR 4654 JNZ SQUI2 ;LOOP 4655 SHLD EXPRS ;UPDATE NEW START OF EXPR 4656 RET ;RETURN 4657; 4658SKP2Z EQU $ 4659; 4660; FIND END OF LITERAL IN (D,E) 4661; 4662 LDAX D ;GET BYTE OF LIT 4663 ORA A ;TEST IT 4664 RZ ;RETURN IF ZERO (END) 4665 INX D ;ELSE, POINT NEXT 4666 JMP SKP2Z ;LOOP 4667; 4668GTEMP EQU $ 4669; 4670; GETS FOUR BYTE TEMPORARY STORAGE AREA, 4671; STORES THE FACC THERE, 4672; PUTS ADDR OF AREA IN EXPR STACK (H,L) 4673; 4674 XCHG ;SAVE H,L IN D,E 4675 XTHL ;EXCHANGE 0 AND RET ADDR 4676 PUSH H ;PUT NEW RET ADDR 4677 PUSH H ;DOIT IT AGAIN 4678 LXI H,0 ;ZERO H,L 4679 DAD SP ;GET SP ADDR IN H,L 4680 INX H ;PLUS ONE 4681 INX H ;PLUS ONE MORE (POINT TO NEW AREA) 4682 PUSH B ;SAVE CTRS 4683 PUSH D ;SAVE EXPR ADDR 4684 PUSH H ;SAVE TEMP ADDR 4685 RST 3 ;GO STORE FACC 4686 POP D ;RESTORE TEMP ADDR 4687 LHLD SPCTR ;GET COUNT 4688 INX H ;PLUS ONE 4689 INX H ;ONE MORE 4690 SHLD SPCTR ;PUT BACK 4691 POP H ;RESTORE EXPR ADDR 4692 POP B ;RESTORE CTRS 4693SADR: INX H ;POINT NEXT BYTE 4694 MOV M,D ;HIGH BYTE TO EXPRSTK 4695 INX H ;POINT NEXT 4696 MOV M,E ;LOW BYTE TO EXPR STK 4697 INX H ;POINT NEXT 4698 MVI M,0E3H ;CODE = NUMERIC DATA 4699 RET ;RETURN 4700; 4701ALPHA EQU $ 4702; 4703; TESTS THE CHAR AT (H,L) 4704; RETURNS WITH Z SET IF CHAR IS ALPHA (A-Z) 4705; RETURNS WITH Z OFF IF NOT ALPHA 4706; CHAR IS LEFT IN REG A 4707; 4708 MOV A,M ;PUT CHAR TO REG A 4709 CPI 'A' ;TEST IF A OR HIGHER 4710 RC ;RETURN IF NOT ALPHA (Z IS OFF) 4711 CPI 'Z' ;TEST IF Z OR LESS 4712 JMP NUMEN ;GO WRAPUP 4713; 4714NUMER EQU $ 4715; 4716; TESTS THE CHAR AT (H,L) 4717; RETURNS WITH Z SET IF NUMERIC (0-9) 4718; ELSE Z IS OFF 4719; CHAR IS LEFT IN THE A REG 4720; 4721 MOV A,M ;GET CHAR TO REG A 4722 CPI '0' ;TEST IF ZERO OR GREATER 4723 RC ;RETURN IF LESS THAN ZERO 4724 CPI '9' ;TEST IF 9 OR LESS 4725NUMEN: RZ ;RETURN IF 9 4726 RNC ;RETURN IF NOT NUMERIC 4727 CMP A ;SET Z 4728 RET ;RETURN 4729; 4730SEARC EQU $ 4731; 4732; SEARCHES FOR THE VARIABLE IN D,E 4733; RETURNS WITH ADDR OF DATA AREA FOR VARIABLE 4734; 4735 PUSH H ;SAVE H,L 4736 LDA FNMOD ;GET FUNCTION MODE 4737 ORA A ;TEST IT 4738 JNZ SCH6 ;BRIF IN A FUNCTION 4739SCH0: LHLD DATAB ;GET ADDR OF DATA POOL 4740SCH1: MOV A,M ;GET THE BYTE 4741 ORA A ;TEST IF END 4742 JZ SCH3 ;BRIF END 4743 DCX H ;POINT NEXT 4744 DCX H ;DITTO 4745 MOV B,M ;GET HI LEN 4746 DCX H ;POINT NEXT 4747 MOV C,M ;GET LO LEN 4748 RST 4 ;ADJUST H,L 4749 DB 3 4750 MOV A,M ;LOAD 1ST CHAR 4751 CMP D ;COMPARE 1ST CHAR 4752 JNZ SCH2 ;BRIF NOT EQUAL 4753 DCX H ;POINT NEXT 4754 MOV A,M ;LOAD 2ND DIGIT 4755 INX H ;POINT BACK 4756 CMP E ;COMPARE 2ND CHAR 4757 JNZ SCH2 ;BRIF NOT EQUAL 4758 MOV A,D ;GET HI NAME 4759 ORA A ;TEST IT 4760 JM SCH9 ;RETURN IF MATRIX 4761 DAD B ;POINT NEXT ENTRY 4762 INX H ;PLUS ONE 4763 XCHG ;FLIP/FLOP 4764 POP H ;RESTORE H 4765 RET ;RETURN 4766SCH2: DAD B ;MINUS LEN 4767 JMP SCH1 ;LOOP 4768SCH3: MOV M,D ;PUT 1ST CHAR 4769 DCX H ;POINT NEXT 4770 MOV M,E ;PUT 2ND CHAR 4771 DCX H ;POINT NEXT 4772 MOV A,D ;GET HI NAME 4773 ORA A ;TEST IT 4774 JM SCH7 ;BRIF ARRAY 4775 MVI M,0FFH ;HI LEN 4776 DCX H ;POINT NEXT 4777 MOV A,E ;GET LO NAME 4778 ORA A ;TEST TYPE 4779 JM SCH4 ;BRIF CHAR 4780 MVI M,0F8H ;LO LEN 4781 MVI B,4 ;LOOP CTR 4782 JMP SCH5 ;BRARND 4783SCH4: MVI M,0FBH ;LO LEN 4784 MVI B,1 ;LOOP CTR 4785SCH5: DCX H ;POINT NEXT 4786 MVI M,0 ;ZERO THE VALUE 4787 DCR B ;DECR CTR 4788 JNZ SCH5 ;LOOP 4789 DCX H ;POINT NEXT 4790 MVI M,0 ;MARK NEW END 4791 INX H ;POINT ADDR OF VARIABLE 4792 XCHG ;PUT LOCATION TO D,E 4793 POP H ;RESTORE H,L 4794 RET ;RETURN 4795SCH6: LXI H,FNARG ;POINT DUMMY ARG 4796 MOV A,M ;LOAD 1ST CHAR 4797 CMP D ;COMPARE 4798 JNZ SCH0 ;BRIF NOT EQUAL 4799 INX H ;POINT NEXT 4800 MOV A,M ;LOAD 2ND CHAR 4801 CMP E ;COMPARE 4802 JNZ SCH0 ;BRIF NOT EQUAL 4803 INX H ;POINT NEXT 4804 MOV D,M ;GET HI ADDR 4805 INX H ;POINT NEXT 4806 MOV E,M ;GET LO ADDR 4807 POP H ;RESTORE H,L 4808 RET ;RETURN 4809SCH7: PUSH H ;SAVE ADDRESS 4810 MVI M,0FEH ;MOVE HI DISP 4811 DCX H ;POINT NEXT 4812 MVI M,14H ;MOVE LO DISP 4813 DCX H 4814 MVI M,0 ;MOVE A ZERO 4815 DCX H ;POINT NEXT 4816 MVI M,10 ;MOVE 10 4817 DCX H ;POINT NEXT 4818 MVI M,0 ;MOVE A ZERO 4819 DCX H ;POINT NEXT 4820 MVI M,10 ;MOVE A 10 (DEFAULT IS 10 X 10) 4821 LXI B,485 ;TOTAL # OF BYTES TAKEN BY ARRAY 4822SCH8: DCX H ;POINT NEXT 4823 MVI M,0 ;CLEAR ONE BYTE 4824 DCX B ;DCR CTR 4825 MOV A,B ;GET HI 4826 ORA C ;PLUS LO 4827 JNZ SCH8 ;LOOP 4828 POP H ;RESTORE PTR TO START 4829 INX H ;POINT LO NAME 4830 INX H ;POINT HI NAME 4831SCH9: POP B ;NEED TO XCHANGE LAST 2 STACK ENTRIES 4832 POP D ;SO DOIT 4833 PUSH B 4834 PUSH D 4835 RET ;RETURN 4836; 4837VAR EQU $ 4838; 4839; 4840; TEST (H,L) FOR A VARIABLE NAME 4841; PUTS THE NAME IN D,E IF FOUND 4842; ERROR SN IF NONE FOUND 4843; 4844 RST 1 ;SKIP TO NON-BLANK 4845 CALL ALPHA ;TEST IF ALPHA 4846 JNZ SNERR ;BRIF NOT ALPHA 4847 MOV D,A ;FIRST CHAR 4848 MVI E,' ' ;DEFAULT 4849 INX H ;POINT NEXT 4850 RST 1 ;GET 2ND CHAR 4851 CALL NUMER ;TEST IF NUMERIC 4852 JNZ VAR2 ;BRIF NOT NUMERIC 4853 MOV E,A ;SAVE 2ND CHAR 4854 INX H ;POINT NEXT 4855 RST 1 ;GET NON-BLANK FOLLOWING 4856VAR2: CPI '$' ;TEST IF STRING 4857 JNZ VAR3 ;BRIF NOT 4858 MOV A,E ;GET 2ND CHAR 4859 ORI 80H ;SET TYPE 4860 MOV E,A ;SAVE IT 4861 INX H ;SKIP $ 4862 RET ;THEN RETURN 4863VAR3: CPI '(' ;TEST IF ARRAY 4864 RNZ ;RETURN IF NOT 4865 MOV A,D ;GET HI NAME 4866 ORI 80H ;TURN ON D7 4867 MOV D,A ;RESTORE 4868 RET ;RETURN 4869; 4870PRLIN EQU $ 4871; 4872; PRINTS LINE NUMBER FOLLOWED BY CR/LF 4873; 4874 LXI D,LINEN ;POINT AREA 4875 LHLD LINE ;GET ADDR OF LINE NUMBER 4876 CALL LINEO ;GO UNPACK 4877 XCHG ;PUT TO H,L 4878 MVI M,0 ;END OF MSG 4879 LXI H,LINEN ;POINT AREA 4880 JMP TERMM ;GO PRINT IT 4881;PAGE 4882; 4883; ERROR MESSAGE ROUTINES 4884; FATAL ERROR MUST BE FIRST 4885; 4886EM EQU 0FEH 4887; 4888ULERR: RST 6 4889 DB 'UL',EM,FATAL ;NOTE FATAL = CODE FOR RST 6 4890ZMERR EQU $-1 ;LOG(X<=0),SQR(-X),0 DIVIDE 4891 DB 'OF',EM,FATAL 4892STERR EQU $-1 ;ERROR IN EXPRESSION STACK 4893 DB 'ST',EM,FATAL 4894SNERR EQU $-1 ;DELIMITER ERROR 4895 DB 'SN',EM,FATAL 4896RTERR EQU $-1 ;RETURN & NO GOSUB 4897 DB 'RT',EM,FATAL 4898DAERR EQU $-1 ;OUT OF DATA 4899 DB 'DA',EM,FATAL 4900NXERR EQU $-1 ;NEXT & NO FOR / >8 FOR'S 4901 DB 'NX',EM,FATAL 4902CVERR EQU $-1 ;CONVERSION ERROR 4903 DB 'CV',EM,FATAL 4904CKERR EQU $-1 ;CHECKSUM ERROR 4905 DB 'CK',EM,FATAL 4906; 4907; NON-FATAL ERRORS 4908; 4909OVERR EQU $-1 ;OVERFLOW ERROR 4910 DB 'OV',EM 4911 RET ;RETURN TO ROUTINE 4912UNERR: RST 6 ;CALL ERROR ROUTINE 4913 DB 'UN',EM 4914 RET 4915; 4916; CONTINUATION OF ERROR MESSAGE ROUTINE (RST 6) 4917; 4918ERROR: CALL TERMM ;PRINT 'XX' 4919 PUSH H ;SAVE RETURN 4920 LXI H,ERRMS ;PRINT 'ERROR IN LINE' 4921 CALL TERMM 4922 CALL PRLIN ;PRINT LINE # 4923 POP H 4924 INX H ;RETURN ADDRESS 4925 MOV A,M ;GET INSTRUCTION 4926 CPI FATAL ;IS IT AN RST 6? 4927 JZ KEY ;IF ZERO, YES, ABORT 4928 POP B ;RESTORE REGISTERS 4929 POP D 4930 POP PSW 4931 XTHL 4932 RET 4933 ;PAGE 4934; 4935; 4936; MOVE THE STRING FROM (D,E) TO (H,L) COUNT IN B 4937; 4938; 4939CPY4D: MVI B,4 4940COPYD: LDAX D ;GET A BYTE 4941 MOV M,A ;MOVE IT 4942 INX H ;POINT NEXT 4943 INX D ;DITTO 4944 DCR B ;DECR CTR 4945 JNZ COPYD ;LOOP 4946 RET ;THEN RETURN 4947; 4948; 4949; MOVE THE STRING FROM (H,L) TO (D,E) COUNT IN B 4950; 4951; 4952CPY4H: MVI B,4 4953COPYH: XCHG ;FLIP/FLOP 4954 CALL COPYD ;GO COPY 4955 XCHG ;FLIP/FLOP BACK 4956 RET ;RETURN 4957; 4958ZEROM EQU $ 4959; 4960; MOVES A STRING OF BINARY ZEROS, COUNT IN B 4961; 4962 MVI M,0 ;MOVE A ZERO 4963 INX H ;POINT NEXT 4964 DCR B ;DECR CTR 4965 JNZ ZEROM ;LOOP 4966 RET ;RETURN 4967; 4968FBIN EQU $ 4969; 4970; 4971; CONVERT FLOAT ACC TO UNSIGNED BINARY NUMBER IN A REG 4972; RETURNS 0 IN A REG IF FACC<0 OR FACC>255 4973; 4974; 4975 PUSH H ;SAVE H,L 4976 PUSH D ;SAVE D,E 4977 CALL FACDE ;CONVERT FACC TO D,E 4978 XRA A ;ZERO A 4979 ORA D ;TEST HIGH VALUE 4980 JNZ FBIN1 ;BRIF NOT ZERO 4981 MOV A,E ;VALUE TO A 4982FBIN1: POP D ;RESTORE D,E 4983 POP H ;RESTORE H,L 4984 RET ;RETURN 4985; 4986ARG EQU $ 4987; 4988; GET NEXT ARGUMENT FROM POLISH STACK 4989; 4990 LHLD ADDR1 ;GET ADDRESS 4991 INX H ;POINT NEXT 4992 MOV D,M ;GET HI ADDRESS 4993 INX H ;POINT NEXT 4994 MOV E,M ;GET LO ADDRESS 4995 INX H ;POINT TYPE 4996 SHLD ADDR1 ;GET ADDRESS 4997 DCX H ;POINT BACK 4998 JMP EVLD ;CALL EVLOAD AND RETURN 4999; 5000; 5001ARGNU EQU $ 5002; 5003 CALL ARG ;GET ARGUMENT 5004 JMP FBIN ;THEN CONVERT FACC TO BIN 5005; 5006BINFL EQU $ 5007; 5008; CONVERT D,E TO FLOATING POINT NUMBER IN FAC 5009; 5010; 5011 LXI H,FACC ;POINT ACC 5012 MVI M,24 ;MAX BITS 5013 INX H ;POINT NEXT 5014 MVI M,0 ;CLEAR MSB 5015 INX H ;POINT NEXT 5016 MOV M,D ;MOVE MID 5017 INX H ;POINT NEXT 5018 MOV M,E ;MOVE LSB 5019 JMP FNORM ;GO NORMALIZE & RETURN 5020;PAGE 5021; 5022; FUNCTION TABLE. FORMAT IS: 5023; DB <LITERAL>,0 5024; DW <ADDRESS> 5025; DB <FUNCTION TYPE> 5026; 5027; TABLE IS TERMINATED WITH A '00' 5028; 5029FUNCT EQU $ 5030 DB 'ABS',0 5031 DW ABS 5032 DB 0ABH 5033 DB 'SQR',0 5034 DW SQR 5035 DB 0ABH 5036 DB 'INT',0 5037 DW INT 5038 DB 0ABH 5039 DB 'SGN',0 5040 DW SGN 5041 DB 0ABH 5042RNDLI: DB 'RND',0 5043 DW RND 5044 DB 0ABH 5045 DB 'SIN',0 5046 DW SIN 5047 DB 0ABH 5048 DB 'COS',0 5049 DW COS 5050 DB 0ABH 5051 DB 'TAN',0 5052 DW TAN 5053 DB 0ABH 5054 DB 'ATN',0 5055 DW ATN 5056 DB 0ABH 5057 DB 'INP',0 5058 DW INP 5059 DB 0ABH 5060 DB 'LN',0 5061 DW LN 5062 DB 0ABH 5063 DB 'LOG',0 5064 DW LOG 5065 DB 0ABH 5066 DB 'EXP',0 5067 DW EXP 5068 DB 0ABH 5069 DB 'POS',0 5070 DW POS 5071 DB 0ABH 5072 DB 'LEN',0 5073 DW LENFN 5074 DB 0ABH 5075 DB 'CHR$',0 5076 DW CHRFN 5077 DB 0CBH 5078 DB 'ASCII',0 5079 DW ASCII 5080 DB 0ABH 5081 DB 'NUM$',0 5082 DW NUMFN 5083 DB 0CBH 5084 DB 'VAL',0 5085 DW VAL 5086 DB 0ABH 5087 DB 'SPACE$',0 5088 DW SPACE 5089 DB 0CBH 5090 DB 'STRING$',0 5091 DW STRFN 5092 DB 0D3H 5093 DB 'LEFT$',0 5094 DW LEFT 5095 DB 0D3H 5096 DB 'RIGHT$',0 5097 DW RIGHT 5098 DB 0D3H 5099 DB 'MID$',0 5100 DW MIDFN 5101 DB 0DBH 5102 DB 'INSTR',0 5103 DW INSTR 5104 DB 0BBH 5105 DB 'PEEK',0 5106 DW PEEK 5107 DB 0ABH 5108 IF LARGE 5109 DB 0,0,0,0 ;ROOM FOR ONE MORE FUNCTION 5110 DB 0,0,0,0 5111 ENDIF 5112 DB 0 ;END OF FUNCTION TABLE 5113;PAGE 5114; 5115; PROGRAM CONSTANTS 5116; 5117PCHOF: DB 19,20,0 5118RNDP: DB 3FH,0FDH ;16381 5119 DB 3FH,0EBH ;16363 5120 DB 3FH,0DDH ;16349 5121NRNDX: DB 1BH,0ECH 5122 DB 33H,0D3H 5123 DB 1AH,85H 5124 DB 2BH,1EH 5125WHATL: DB 'WHAT',0 5126VERS EQU $ ;VERSION MESSAGE 5127 IF LARGE 5128 DB '9K VERS 1.4',0 5129RBOUT: DB 08H,20H,08H,0FEH ;RUBOUT SEQUENCE (9K ONLY) 5130 ENDIF 5131 IF NOT LARGE 5132 DB '8K VERS 1.4',0 5133 ENDIF 5134LLINE: DB 'LINE',0 5135TABLI: DB 'TAB',0 5136STEPL: DB 'STEP',0 5137THENL: DB 'THEN',0 5138PILIT: DB 'PI',0 5139TWO: DB 02H,80H,00H,00H ;CONSTANT: 2 5140TEN: DB 04H,0A0H,00H,00H ;CONSTANT: 10 5141PI: DB 02H,0C9H,0FH,0D7H ;CONSTANT: 3.141593 5142QTRPI: DB 00H,0C9H,0FH,0D7H ;CONSTANT: 0.7853892 5143NEGON: DB 80H,0FFH,0FFH,0FFH ;CONSTANT: -0.9999999 5144LN2C: DB 00H,0B1H,72H,16H ;CONSTANT: 0.6931472 5145SQC1: DB 00H,97H,14H,0EBH ;CONSTANT: 0.59016206 5146SQC2: DB 7FH,0D5H,0A9H,56H ;CONSTANT: 0.41730759 5147;PAGE 5148; 5149; THE FOLLOWING CONSTANTS MUST BE IN THIS ORDER *********** 5150; 5151; CONSTANT WITH EXPONENT OF 1 5152; COEFFICIENT OF FIRST TERM 5153; ... 5154; COEEFICIENT OF NTH TERM 5155; 5156; SINCE ALL COEFFICIENTS ARE LESS THAN 1, 5157; THE ITERATION LOOP USES THE 5158; CONSTANT WITH EXPONENT 1 TO TERMINATE THE EVALUATION. 5159; 5160SQC3: DB 01H,0B5H,04H,0F3H ;CONSTANT: 1.41421356 5161 DB 0FFH,0AAH,95H,0BCH ;CONSTANT: -0.3331738 5162 DB 7EH,0CAH,0D5H,20H ;CONSTANT: 0.1980787 5163 DB 0FEH,87H,82H,0D6H ;CONSTANT: -0.1323351 5164 DB 7DH,0A3H,13H,1CH ;CONSTANT: 0.07962632 5165 DB 0FCH,89H,0A6H,0B8H ;CONSTANT: -0.03360627 5166ATNCO: DB 79H,0DFH,3AH,9EH ;CONSTANT: 0.006812411 5167; 5168HALFP: DB 01H,0C9H,0FH,0D7H ;CONSTANT: 1.570796 5169 DB 80H,0A5H,5DH,0DEH ;CONSTANT: -0.64596371 5170 DB 7DH,0A3H,34H,55H ;CONSTANT: 0.076589679 5171 DB 0F9H,99H,38H,60H ;CONSTANT: -0.0046737656 5172SINCO: DB 74H,9EH,0D7H,0B6H ;CONSTANT: 0.00015148419 5173; 5174ONE: DB 001H,080H 5175NULLI: DB 00H,00H ;CONSTANT: 1.0 5176 DB 00H,0FFH,0FEH,0C1H ;CONSTANT: 0.99998103 5177 DB 0FFH,0FFH,0BAH,0B0H ;CONSTANT: -0.4994712 5178 DB 7FH,0A8H,0EH,2BH ;CONSTANT: 0.3282331 5179 DB 0FEH,0E7H,4BH,55H ;CONSTANT: -0.2258733 5180 DB 7EH,89H,0DEH,0E3H ;CONSTANT: 0.134693 5181 DB 0FCH,0E1H,0C5H,078H ;CONSTANT: -0.05511996 5182LNCO: DB 7AH,0B0H,3FH,0AEH ;CONSTANT: 0.01075737 5183; 5184LN2E: DB 001H,0B8H,0AAH,03BH ;CONSTANT: 1.44269504 5185 DB 000H,0B1H,06FH,0E6H ;C=.69311397 5186 DB 07EH,0F6H,02FH,070H ;C=.24041548 5187 DB 07CH,0E1H,0C2H,0AEH ;C=.05511732 5188 DB 07AH,0A0H,0BBH,07EH ;C=.00981033 5189EXPCO: DB 077H,0CAH,009H,0CBH ;C=.00154143 5190; 5191LNC: DB 07FH,0DEH,05BH,0D0H ;C=LOG BASE 10 OF E 5192READY EQU $ 5193 DB 0FDH 5194 DB 'READY',0 5195STOPM EQU $ 5196 DB 0FDH 5197 DB 'STOP AT LINE ',254 5198ERRMS: DB ' ERROR IN LINE ',0FEH 5199TTY EQU 2 5200;PAGE 5201; 5202; VERB (STATEMENT/COMMAND) TABLE 5203; FORMAT IS: DB 'VERB',0 5204; DW ADDR 5205; DB 'NEXT VERB',0 5206; ETC 5207; END OF TABLE IS MARKED BY DB 0 5208; 5209JMPTB EQU $ 5210 DB 'LIST',0 5211 DW LIST 5212 DB 'RUN',0 5213 DW RUNCM 5214 DB 'XEQ',0 5215 DW XEQ 5216 DB 'NEW',0 5217 DW NEW 5218 DB 'CON',0 5219 DW CONTI 5220 DB 'TAPE',0 5221 DW TAPE 5222 DB 'SAVE',0 5223 DW SAVE 5224KEYL: DB 'KEY',0 5225 DW KEY 5226 DB 'FRE',0 5227 DW FREE 5228 DB 'IF',0 5229 DW IFSTM 5230 DB 'READ',0 5231 DW READ 5232 DB 'RESTORE',0 5233 DW RESTO 5234DATAL: DB 'DATA',0 5235 DW RUN 5236 DB 'FOR',0 5237 DW FOR 5238NEXTL: DB 'NEXT',0 5239 DW NEXT 5240GOSBL: DB 'GOSUB',0 5241 DW GOSUB 5242 DB 'RETURN',0 5243 DW RETUR 5244 DB 'INPUT',0 5245 DW INPUT 5246 DB 'PRINT',0 5247 DW PRINT 5248GOTOL: DB 'GO' 5249TOLIT: DB 'TO',0 5250 DW GOTO 5251 DB 'LET',0 5252 DW LET 5253 DB 'STOP',0 5254 DW STOP 5255 DB 'END',0 5256 DW ENDIT 5257 DB 'REM',0 5258 DW RUN 5259 DB '!',0 5260 DW RUN 5261 DB '?',0 5262 DW PRINT 5263 DB 'RANDOMIZE',0 5264 DW RANDO 5265 DB 'ON',0 5266 DW ON 5267 DB 'OUT',0 5268 DW OUTP 5269 DB 'DIM',0 5270 DW DIM 5271 DB 'CHANGE',0 5272 DW CHANG 5273DEFLI: DB 'DEF' 5274FNLIT: DB 'FN',0 5275 DW RUN 5276 IF CPM 5277 DB 'DDT',0 5278 DW DDT 5279 DB 'BYE',0 5280 DW BOOT 5281 ENDIF 5282 DB 'POKE',0 5283 DW POKE 5284 DB 'CALL',0 5285 DW JUMP 5286 IF LARGE ;INCLUDE ONLY IN 8K+ VERSION 5287 DB 'EDIT',0 5288 DW FIX 5289 DB 'CLOAD',0 5290 DW CLOAD 5291 DB 'CSAVE',0 5292 DW CSAVE 5293 ENDIF 5294 IF HUNTER 5295 DB 'BAUD',0 5296 DW BAUD 5297 ENDIF 5298 DB 0 ;END OF TABLE 5299; 5300; DDT COMMAND, CPM ONLY 5301; 5302 IF CPM 5303DDT: RST 7 5304 JMP RDY 5305 ENDIF 5306;PAGE 5307; 5308FACDE EQU $ 5309; 5310; THIS ROUTINE CONVERTS THE FACC TO AN ADDRESS IN D,E 5311; 5312 CALL INT ;INTEGERIZE THE FACC 5313 LDA FACC ;GET THE EXPONENT 5314 ORA A ;TEST IT 5315 JM OVERR ;BRIF NEGATIVE ADDRESS 5316 SUI 16 ;SUBTRACT MAX EXPONENT 5317 JZ FDE2 ;BRIF EQUAL MAX 5318 JP OVERR ;BRIF GREATER THAN 64K 5319 CMA ;2'S COMPLIMENT OF A YIELDS.. 5320 INR A ;16-A 5321 MOV C,A ;SAVE SHIFT COUNT 5322FDE1: XRA A ;CLEAR CARRY 5323 LXI H,FACC+1 ;POINT MANTISSA 5324 MVI B,2 ;WORDS TO SHIFT 5325 CALL FSHFT ;GO SHIFT FACC+1 AND FACC+2 5326 DCR C ;REDUCE COUNT 5327 JNZ FDE1 ;LOOP TILL COMPLETE 5328FDE2: LXI H,FACC+1 ;POINT HIGH BYTE 5329 MOV D,M ;LOAD D 5330 INX H ;POINT LOW BYTE 5331 MOV E,M ;LOADE E 5332 RET ;RETURN 5333; 5334; 5335LOCAT EQU $ 5336; 5337; THIS ROUTINE SEARCHES FOR A LINE IN THE PROGRAM FILE. 5338; Z SET, C RESET==>LINE FOUND. ADDRESS IS IN H,L 5339; C SET, Z RESET==>NOT FOUND. H,L POINT TO NEXT LINE 5340; C SET, Z SET==>NOT FOUND. H,L POINT AT END OF PROGRAM 5341; 5342 LXI H,BEGPR ;POINT START 5343FIND1: MOV A,M ;FETCH LENGTH OF LINE 5344 PUSH H ;SAVE POINTER 5345 ORA A ;TEST 5346 JZ FIND3 ;BRIF END 5347 INX H ;POINT LINE # 5348 MOV A,M ;FETCH HI # 5349 CMP B ;COMPARE TO REQUESTED 5350 JC FIND2 ;BRIF LOW 5351 JNZ FIND3 ;BRIF PAST AND NOT FOUND 5352 INX H ;POINT LO # 5353 MOV A,M ;FETCH IT 5354 CMP C ;COMPARE TO REQUESTED 5355 JC FIND2 ;BRIF LOW 5356 JNZ FIND3 ;BRIF PAST AND NOT FOUND 5357 POP H ;POINT BEGIN IF MATCH 5358 RET ;RETURN 5359; 5360; BUMP H,L TO NEXT LINE 5361; 5362FIND2: POP H ;POINT START OF LINE 5363 MOV E,M ;LENGHT TO E 5364 MVI D,0 ;CLEAR D 5365 DAD D ;BUMP H,L 5366 JMP FIND1 ;CONTINUE 5367; 5368; LINE NOT FOUND 5369; 5370FIND3: STC ;SET CARRY 5371 POP H ;POINT LINE JUST PAST REQUESTED 5372 RET ;RETURN 5373; 5374; 5375SEEK EQU $ 5376; 5377; THIS CODE FINDS AN ENTRY IN THE TABLE POINTED TO BY D,E. 5378; THE SOUGHT ENTRY IS POINTED TO BY H,L. 5379; 5380SEEK1: PUSH H ;SAVE ADDRESS OF STRING 5381 LDAX D ;GET BYTE FROM TABLE 5382 ORA A ;TEST IT 5383 JZ SEEK3 ;BRIF END OF TABLE 5384 RST 2 ;COMPARE 5385 JNZ SEEK2 ;BRIF NOT FOUND 5386 XTHL ;PUT CURRENT H,L ON STACK 5387 CALL SKP2Z ;FIND END TO LITERAL IN TABLE 5388 INX D ;POINT LOW BYTE 5389 POP H ;RESTORE LINE POINTER 5390 INR A ;PUT 1 IN A 5391 ORA A ;RESET Z BIT 5392 RET ;RETURN 5393SEEK2: CALL SKP2Z ;FIND END OF TABLE LITERAL 5394 INX D ; 5395 INX D ;POINT NEXT LIT IN TABLE 5396 INX D ; 5397 POP H ;GET ORIGINAL STRING 5398 LDAX D ;GET BYTE 5399 RAL ;HIGH BIT TO CARRY 5400 JNC SEEK1 ;NOT A FUNCTION SEARCH 5401 INX D ;POINT NEXT BYTE IN FUNCTION TABLE 5402 JMP SEEK1 ;CONTINUE SEARCH 5403SEEK3: POP H ;RESTORE ORIGINAL STRING 5404 RET ;RETURN 5405 IF LARGE ;ASSEMBLE THE REMAINDAR ONLY FOR 8+K 5406; 5407; 5408; EDIT COMMAND 5409; EDIT <LINE #><DELIMITER><OLD TEXT><DELIMITER><NEW TEXT> 5410; 5411FIX: EQU $ 5412 RST 1 ;SKIP BLANKS 5413 CALL PACK ;GET LINE # IN B,C 5414 RST 1 ;SKIP BLANKS 5415 SHLD ADDR2 ;SAVE COMMAND POINTER 5416 CALL LOCAT ;SEARCH FOR LINE # IN PROGRAM 5417 JC ULERR ;BRIF NOT FOUND 5418 PUSH H ;SAVE ADDR OF EXISTING LINE <SOURCE> 5419 PUSH B ;SAVE LINE # 5420 MOV B,M ;GET LENGTH OF <SOURCE> 5421 XCHG ;D,E POINT <SOURCE> 5422 LXI H,STRIN ;POINT STRING BUFFER 5423 CALL COPYD ;<SOURCE> TO STRING BUFFER 5424 LDA STRIN ;LENGTH OF <SOURCE> TO A 5425 SUI 2 ;ADJUST 5426 STA STRIN ;STORE 5427 LXI D,IOBUF+1 ;POINT BUFFER 5428 LHLD ADDR2 ;FETCH COMMAND POINTER 5429 MOV B,M ;FETCH <DELIMITER> 5430; 5431; FIND LENGTH OF <OLD TEXT>. STORE IT IN IOBUF. 5432; 5433 MVI C,0 ;INITIAL LENGTH 5434FIX1: INX H ;POINT NEXT CHARACTER 5435 MOV A,M ;FETCH 5436 ORA A ;TEST 5437 JZ SNERR ;MISSING 2ND <DELIMITER>. 5438 CMP B ;TEST 5439 JZ FIX2 ;BRIF 2ND <DELIMITER> FOUND 5440 INR C ;ELSE, BUMP C 5441 STAX D ;STORE CHARACTER IN IOBUF 5442 INX D ;BUMP IOBUF POINTER 5443 JMP FIX1 ;CONTINUE 5444; 5445; GET READY TO SEARCH <SOURCE> FOR <OLD TEXT> 5446; 5447FIX2: MOV A,C ;LENGTH OF <OT> TO A 5448 STA IOBUF ;STORE 5449 SHLD ADDR2 ;SAVE COMMAND POINTER 5450 MVI A,3 ;SEARCH WILL START IN POS 3. 5451 LHLD PROGE ;POINT END OF PROGRAM 5452 INX H ;BUMP TWICE 5453 INX H 5454 SHLD ADDR1 ;SAVE EXPR. STACK POINTER 5455 INX H ;POINT NEXT 5456 LXI D,IOBUF ;POINT BUFFER AREA 5457 MOV M,D ;STORE ADDRESS 5458 INX H 5459 MOV M,E 5460 LXI H,STRIN ; POINT <SOURCE> 5461; 5462; USE THE INSTR ROUTINE TO SEARCH 5463; 5464 CALL INST2 ;GO SEARCH 5465 MOV A,E ;RESULT TO A 5466 ORA A ;TEST 5467 JZ DAERR ;BR IF NOT FOUND 5468 MOV C,A ;SAVE POSITION IN C 5469 DCR A ;ADJUST 5470 MOV B,A ;COPY TO B 5471 LXI H,STRIN+1 ;POINT <OLD SOURCE> 5472 LXI D,IOBUF+1 ;PIONT <NEW LINE AREA> 5473 CALL COPYH ;COPY <OLD SOURCE> UP TO <OLD TEXT> 5474 PUSH D ;SAVE DEST POINTER 5475; 5476; SKIP OVER <OLD TEXT> IN <SOURCE> 5477; 5478 MVI D,0 ;CLEAR D 5479 LDA IOBUF ;GET LENGTH OF <OT> 5480 MOV E,A ;LENGTH TO E 5481 DAD D ;BUMP H,L PAST <OT> 5482 POP D ;RESTORE <DEST> POINTER 5483 PUSH H ;SAVE <REMAINING SOURCE> POINTER 5484; 5485; APPEND <NEW TEXT> TO <DEST> 5486; 5487 LHLD ADDR2 ;FETCH COMMAND POINTER 5488FIX3: INX H ;POINT NEXT 5489 MOV A,M ;FETCH CHARACTER 5490 ORA A ;TEST IT 5491 JZ FIX4 ;BRIF NO MORE <NEW TEXT> 5492 INR C ;BUMP LENGTH COUNT 5493 STAX D ;STORE CHARACTER 5494 INX D ;BUMP <DEST> POINTER 5495 JMP FIX3 ;CONTINUE 5496; 5497; APPEND <REMAINING SOURCE> TO <DEST> 5498; 5499FIX4: POP H ;GET REMAINING SOURCE POINTER 5500FIX4A: MOV A,M ;FETCH CHARACTER 5501 ORA A ;TEST 5502 JZ FIX5 ;BRIF DONE 5503 STAX D ;STORE CHARACTER 5504 INR C ;BUMP CHAR COUNT 5505 INX D ;BUMP DEST POINTER 5506 INX H ;BUMP <SOURCE> POINTER 5507 JMP FIX4A ;CONTINUE 5508; 5509; PREPARE <DEST> FOR SUBMISSION AS NEW LINE 5510; 5511FIX5: STAX D ;BUFFER TERMINATOR 5512 INR C ;BUMP LENGTH COUNT 5513 MOV A,C ;FETCH COUNT 5514 STA IOBUF ;STORE IT 5515 MOV B,A ;COPY COUNT TO B 5516 LXI H,IMMED ;POINT NEW LINE AREA 5517 LXI D,IOBUF ;POINT WHERE IT IS NOW 5518 CALL COPYD ;COPY IT 5519 POP B ;RESTORE LINE # 5520 POP H ;RESTORE PROGRAM POINTER 5521 PUSH H ;SAVE IT 5522 JMP EDIT2 ;PROCESS AS NEW LINE 5523;PAGE 5524; 5525; TAPE CASSETTE COMMANDS 5526; 5527; 5528; TAPE CASSETTE EQUATES 5529; 5530SWCH EQU 0FFH ;SWITCH PORT 5531CASC EQU 3 ;STATUS PORT FOR TARBELL 5532CASD EQU 0 ;DATA PORT 5533CFLAG EQU 4 ;DATA FLAG FOR TARBELL ON MIO 5534; 5535; CASSETTE FILE FORMAT 5536; 5537; EACH RECORD: 5538; TYPE BYTE: 4 FOR BASIC PROGRAM, 5539; PLUS BIT 7 ON IF DATA NOT HEADER RECORD 5540; LENGTH BYTE: # DATA BYTES (1-128) 5541; 2 BYTES OF CHECKSUM 5542; 5543; EACH FILE BEGINS WITH A HEADER RECORD 5544; TYPE 4 5545; LENGTH: 7 5546; 5 CHARS FILENAME, BLANK-FILLED 5547; 2 BYTES TOTAL LENGTH OF DATA IN FILE 5548; 2 BYTES OF CHECKSUM 5549; 5550; AND HAS N DATA RECORDS 5551; TYPE: 84 5552; LENGTH: 128 EXCEPT LAST RECORD MAY BE LESS 5553; DATA: NEXT (LENGTH) BYTES OF IMAGE OF PROGRAM AREA 5554; CHECKSUM: 2 BYTES, 2'S COMPLEMENT OF SUM OF BYTES 5555; 5556; FILES OF TYPE OTHER THAN 4 ARE IGNORED BY BASIC 5557; 5558; HARDWARE USED: 5559; IMSAI MIO BOARD, CASSETTE DATA ON PORT 0, 5560; STATUS ON PORT 3, 5561; CASSETTE READY JUMPERED TO BIT 2 OF PORT 3. 5562; 5563; 5564; TAPE UTILITY ROUTINE 5565; 5566; WATCH WAIT FOR TARBELL READY OR CONTROL-C 5567; 5568WATCH: PUSH B ;SAVE REGS - CPM STATUS CALL CAN CLOBBER 5569 PUSH D 5570 PUSH H 5571 CALL TSTCC ;TEST FOR CNTRL-C 5572 POP H ;RESTORE REGS IN CPM DEBUGGING MODE 5573 POP D 5574 POP B 5575 IN CASC ;READ STATUS PORT 5576 ANI CFLAG ;TEST 5577 JZ WATCH ;LOOP TILL READY 5578 RET 5579; 5580; 5581; CASI CASSETTE INPUT TO A-REGISTER 5582; 5583CASI: CALL WATCH ;WAIT TIL READY 5584 IN CASD ;READ FROM DATA PORT 5585 RET 5586; 5587; 5588; RECO WRITE A RECORD TO THE TARBELL. 5589; D,E==>TYPE, LENGTH BYTES 5590; H,L==>START OF SOURCE 5591; RETURNS UPDATED SOURCE POINTER IN DE 5592; 5593RECO: MOV A,D ;TYPE BYTE 5594 CALL CASO ;WRITE IT 5595 MOV A,E ;COUNT 5596 CALL CASO ;WRITE IT 5597 MOV B,E ;COUNT 5598 XCHG ;SOURCE NOW IN DE 5599 LXI H,0 ;INITIAL CHECKSUM 5600NCHAR: LDAX D ;FETCH NEXT CHAR 5601 CALL CASO ;WRITE IT 5602 INX D ;PNT NEXT CHAR 5603 CALL CKSUM ;ADD TO CKSUM, PUT ADD IN LIGHTS 5604 DCR B ;REDUCE COUNT 5605 JNZ NCHAR ;LOOP ON COUNT 5606 DCX H ;ADJUST HL FOR COMPLIMENT 5607 MOV A,H ;WRITE CHECKSUM 5608 CMA 5609 CALL CASO 5610 MOV A,L 5611 CMA 5612 ;WRITE LAST BYTE & RETURN 5613; 5614; 5615; CASO CASSETTE OUTPUT BYTE FROM A-REGISTER 5616; 5617CASO: PUSH PSW 5618 CALL WATCH ;WAIT TILL READY 5619 POP PSW 5620 OUT CASD ;WRITE TO DATA PORT 5621 RET 5622; 5623; 5624; CKSUM CALCULATE THE CHECKSUM: 5625; ADD A TO HL 5626; ALSO OUTPUS HI ADDR TO SENSE LIGHTS 5627; 5628CKSUM: ADD L ;ADD PREVIOUS LO 5629 MOV L,A ;SAVE NEW LO 5630 RNC 5631 INR H ;PROPAGATE CARRY 5632; 5633; 5634; SENSE OUTPUT HI ADDR FROM D TO LIGHTS 5635; 5636SENSE: MOV A,D 5637 CMA 5638 OUT SWCH 5639 RET 5640; 5641; 5642; RECI INPUT A RECORD FROM THE TARBELL 5643; TAKES A BUFFER POINTER IN HL 5644; RETURNS UPDATED POINTER IN DE, 5645; RECORD TYPE IN A, RECORD LENGTH IN C 5646; CLOBBERS B,H,L 5647; 5648RECI: CALL CASI ;GET TYPE 5649 PUSH PSW ;SAVE TYPE TO RETURN TO CALLER 5650 CALL CASI ;GET LENGTH 5651 MOV C,A ;STORE LEN 5652 MOV B,A ;IN B ALSO 5653 XCHG ;PUT DESTINATION PTR IN DE 5654 LXI H,0 ;INITIAL CHECKSUM 5655RECI1: CALL CASI ;INPUT BYTE 5656 STAX D ;STORE IT 5657 INX D 5658 CALL CKSUM ;UPDATE CKSUM, PUT ADDR IN LIGHTS 5659 DCR B ;LOOP ON COUNT 5660 JNZ RECI1 5661 PUSH D ;SAVE DESTINATION PTR 5662 CALL CASI ;INPUT CHECKSUM 5663 MOV D,A 5664 CALL CASI 5665 MOV E,A 5666 DAD D ;COMPARE 5667 MOV A,H 5668 ORA L 5669 JNZ CKERR ;BRIF CHECKSUM ERROR 5670 POP D ;RESTORE DEST PTR 5671 POP PSW ;RESTORE RECORD TYPE BYTE 5672 RET 5673; 5674; 5675; CSAVE COMMAND 5676; 5677CSAVE: RST 1 ;SKIP ANY SPACES 5678 MVI A,10H ;ENABLE WRITE 5679 OUT CASC 5680 PUSH H ;SAVE PTR 5681 MVI B,255 ;WRITE INITIAL 255 NULLS 5682 XRA A 5683NULS: CALL CASO 5684 DCR B 5685 JNZ NULS 5686 MVI A,3CH ;START BYTE 5687 CALL CASO 5688 MVI B,32 ;32 SYNC BYTES 5689 MVI A,0E6H ;SYNC BYTE VALUE 5690SYNCS: CALL CASO 5691 DCR B 5692 JNZ SYNCS 5693 LXI H,IOBUF ;POINT BUFFER 5694 MVI B,5 ;FILE NAME LENGTH 5695 POP D ;RESTORE CMD PTR 5696FNAME: MVI M,20H ;DEFAULT BLANK 5697 LDAX D ;FETCH FILE NAME 5698 ORA A ;TEST 5699 JZ BLANK 5700 MOV M,A ;STORE CHAR 5701 INX D ;NAME PTR 5702BLANK: INX H ;BUFFER PTR 5703 DCR B ;COUNT 5704 JNZ FNAME 5705; 5706; CALCULATE LGTH OF PROGRAM FILE&WRITE IT ON THE HEADER 5707; 5708 LXI D,BEGPR ;BEGINNING OF PROGRAM 5709 LHLD PROGE ;END 5710 MOV A,L 5711 SUB E 5712 MOV L,A 5713 MOV A,H 5714 SBB D 5715 MOV H,A 5716 INX H ;PLUS 1 TO GET # OF BYTES INCLUSIVE 5717 PUSH H ;SAVE FOR LATER 5718 SHLD IOBUF+5 ;STUFF LENGTH 5719 LXI D,407H ;TYPE AND LEN OF HEADER RECORD 5720 ;TYPE 4: BASIC PROG FILE, HEADER RCD 5721 LXI H,IOBUF 5722 CALL RECO ;WRITE RECORD 5723; 5724; WRITE PROGRAM FILE 5725; 5726 LXI H,BEGPR ;POINT START OF PROGRAM 5727NXTRC: XTHL ;GET REMAINING LENGTH 5728 MOV A,H ;GET HI REMAINING 5729 ORA L ;TEST FOR DONE 5730 JZ ERITE ;BRIF DONE 5731 LXI D,0FF80H;-128 5732 DAD D ;SUBTRACT RECORD LENGTH 5733 JC RITE ;IF CARRY, NOT AT END 5734 MOV A,L ;GET LOW 5735 ANI 7FH ;NUMBER BYTES LEFT 5736 MOV E,A ;COUNT 5737 LXI H,0 ;REMAINING BYTES 5738RITE: XTHL ;RESTORE H 5739 MVI D,084H ;TYPE BYTE: 80=DATA RECORD (NOT 5740 ;FILE HDR), 4=BASIC PROGRAM FILE. 5741 CALL RECO ;WRITE 5742 XCHG ;SAVE SOURCE PTR 5743 JMP NXTRC 5744ERITE: POP H ;CLEAN STACK 5745; 5746; 5747; BELL RING USER'S CHIMES 5748; 5749BELL: MVI A,7 ;CODE FOR BELL 5750 CALL TESTO 5751 JMP RDY 5752 ;PAGE 5753; CLOAD LOAD A PROGRAM FROM THE TARBELL 5754; 5755CLOAD: 5756NULL1: MVI A,60H ;MIO CONTROL TO READ BY BITS 5757 OUT CASC ;WRITE TO STATUS PORT 5758NULLS: CALL CASI ;READ LEADING NULLS 5759 OUT SWCH ;PUT IN LIGHTS 5760 CPI 0E6H ;WAIT FOR FIRST SYNC BYTE 5761 JNZ NULLS 5762 MVI A,20H ;MIO CONTROL TO READ BY BYTES 5763 OUT CASC ;WRITE TO STATUS PORT 5764 MVI B,31 ;NUMBER REMAINING SYNC BYTES 5765SYNC: CALL CASI ;READ PAST SYNC 5766 OUT SWCH 5767 CPI 0E6H 5768 JNZ NULL1 ;TRY FOR MORE NULLS 5769 DCR B 5770 JNZ SYNC 5771 LXI H,IOBUF ;POINT BUFFER 5772 CALL RECI ;READ A RECORD 5773 CPI 4 ;TEST TYPE BYTE: IS IT BASIC PROGRAM 5774 ;..FILE HEADER RECORD? 5775 JNZ NULL1 ;NO, START OVER, KEEP LOOKING 5776 LHLD IOBUF+5 ;LOAD LENGTH OF PROGRAM FILE 5777 PUSH H ;SAVE 5778 LXI H,BEGPR 5779NXTR: CALL RECI ;READ RECORD 5780 CPI 84H ;IS IT BASIC PROGRAM FILE DATA RECORD 5781 JNZ CKERR ;NO, SOMETHING'S WRONG. 5782 POP H ;LENGTH 5783 ;SUBTRACT 0,C FROM HL 5784 MOV A,L 5785 SUB C 5786 MOV L,A 5787 MOV A,H 5788 MVI C,0 5789 SBB C 5790 MOV H,A 5791 ORA L ;TEST RESULT FOR 0 5792 XCHG ;BUFFER ADDR TO HL 5793 PUSH D ;SAVE REMAINING LENGTH 5794 JNZ NXTR ;JIF NOT DONE READING DATA 5795 POP D ;CLEAR STACK 5796;LOADING DONE. SET POINTER TO END OF PROGRAM. 5797 XRA A 5798 MOV M,A ;EXTRA 0 FOR PARANOISA 5799 DCX H ;POINT LAST RECORD BYTE (SHOULD BE 0) 5800 SHLD PROGE ;SAVE END OF PROG FOR EDIT, LIST, &C 5801 STA IOBUF+5 ;MARK END OF FILE NAME FOR TYPEOUT 5802;TYPE FILE NAME 5803 LDA IOBUF 5804 CPI 20H ;TEST FOR NO NAME 5805 CNZ TERMO ;PRINT NAME IF THERE 5806 JMP BELL 5807 ENDIF 5808; 5809PEEK EQU $ 5810; 5811; STMT: A=PEEK(X). RETURNS DECIMAL VALUE OF MEMORY ADDRESS X. 5812; 5813 CALL FACDE ;GET ADDRESS IN D,E 5814 XCHG ;ADDRESS TO H,L 5815 LXI D,0 ;CLEAR D,E 5816 MOV E,M ;PUT MEMORY BYTE IN E 5817 JMP BINFL ;CONVERT D,E TO BINARY AND RETURN 5818; 5819POKE EQU $ 5820; 5821; STMT: POKE <ADDRESS>,<VALUE>. PUTS IN MEMORY ADDRESS. 5822; 5823 CALL EXPR ;EVALUATE ADDRESS EXPRESSION 5824 MOV A,M ;LOAD NEXT CHARACTER 5825 CPI ',' ;TEST 5826 JNZ SNERR ;BRIF ERROR 5827 INX H ;POINT NEXT 5828 PUSH H ;SAVE H,L 5829 CALL FACDE ;PUT ADDRESS IN D,E 5830 POP H ;RESTORE H,L 5831 PUSH D ;SAVE ADDRESS 5832 CALL EXPR ;EVALUATE VALUE EXPRESSION 5833 CALL EOL ;TEST FOR END OF LINE 5834 CALL FBIN ;CONVERT FACC TO A REGISTER VALUE 5835 POP H ;GET D,E ADDRESS IN H,L 5836 MOV M,A ;MOVE BYTE 5837 JMP RUN ;CONTINUE 5838; 5839; 5840JUMP EQU $ 5841; 5842; STMT: CALL <ADDRESS>. EXECUTES CODE AT MEMORY ADDRESS. 5843; 5844 CALL EXPR ;EVALUATE ADDRESS EXPRESSION 5845 CALL EOL ;TEST FOR END OF LINE 5846 CALL FACDE ;CONVERT FACC TO ADDRESS IN D,E 5847 LXI H,RUN ;MAKE INTO SUBROUTINE 5848 PUSH H 5849 XCHG ;MOVE ADDRESS TO HL 5850 PCHL ;EXECUTE USER'S ROUTINE 5851;PAGE 5852 IF HUNTER 5853; 5854; 5855BAUD EQU $ 5856; 5857; SOFTWARE BAUD SELECTION ON SIO BOARDS MODIFIED BY 5858; W. HARTER, COYOTE COMPUTERS, DAVIS, CALIF. 5859; 5860; COMMAND 'BAUD <RATE>' WHERE <RATE>=110,300,1200,2400,9600 5861; 5862 RST 1 ;SKIP BLANKS 5863 LXI D,BAUDS+6 ;POINT BAUD TABLE 5864 CALL SEEK ;GO SEARCH BAUD TABLE 5865 JZ CVERR ;BRIF RATE NOT FOUND 5866 DCX H ;ADJUST POINTER 5867BAUD1: INX H ;LOOK AT CHARACTER 5868 CALL NUMER ;TEST FOR DIGIT 5869 JZ BAUD1 ;LOOP PAST RATE 5870 CALL EOL ;TEST FOR END OF LINE 5871 XCHG ;POINT ADDRESS OF CONTROL BYTES 5872 MOV E,M ;LOW BYTE TO E 5873 INX H ;POINT NEXT 5874 MOV D,M ;HIGH BYTE TO D 5875 LDA EDSW ;GET MODE SWITCH 5876 ORA A ;TEST IT 5877 JNZ SETIT ;BRIF IMMEDIATE MODE 5878 LXI H,BAUDS ;POINT 'BAUD' 5879 CALL TERMM ;WRITE IT 5880 PUSH D ;SAVE ADDRESS OF CONTROL BYTES 5881 LXI H,IOBUF ;POINT BUFFER 5882 MVI B,4 ;LOAD COUNT 5883 CALL COPYD ;COPY RATE TO IOBUF 5884 MVI M,0 ;TERMINATE MESSAGE 5885 CALL TERMO ;WRITE IT 5886 POP D ;RESTORE CONTROL BYTES 5887SETIT: LXI H,4 ;LOAD OFFSET 5888 DAD D ;PIONT 1ST CONTROL BYTE 5889 MVI A,40H ;LOAD RESET 5890 OUT TTY+1 ;WRITE IT 5891 MVI A,M ;MODE BYTE 5892 OUT TTY+1 ;WRITE IT 5893 MVI A,17H ;ENABLE BYTE 5894 OUT TTY+1 ;WRITE IT 5895 INX H ;POINT SPEED BYTE 5896 MOV A,M ;LOAD IT 5897 OUT 8 ;WRITE IT 5898BAUD2: IN TTY+1 ;READ STATUS 5899 ANI 2 ;TEST 5900 JZ BAUD2 ;WAIT FOR ACKNOWLEDGMENT 5901 IN TTY ;READ AND DISCARD 5902 LDA EDSW ;GET MODE SWITCH 5903 ORA A ;TEST IT 5904 JZ RUN ;BRIF RUN MODE 5905 JMP GETCM ;BRIF IMMEDIATE MODE 5906BAUDS: DB 'BAUD',0FEH ;BAUD MESSAGE 5907; 5908; BAUD TABLE. 5909; 5910B110: DB '110 ',0FAH,2,0 5911 DW B110 5912B300: DB '300 ',0FBH,0 5913 DW B300 5914B1200: DB '1200',0FAH,0 5915 DW B1200 5916B2400: DB '2400',0FAH,32,0 5917 DW B2400 5918B9600: DB '9600',0FAH,34,0 5919 DW B9600 5920 DB 0 ;END OF BAUD TABLE 5921; 5922 ENDIF 5923; 5924 IF CPM ;CPM INITIALIZATION STORES 5925 ;...BIOS JUMP TABLE HERE 5926BTSTAT: DS 3 ;JMP TO BIOS CONSOLE STATUS 5927BTIN: DS 3 ;JMP TO BIOS CONSOLE INPUT 5928BTOUT: DS 3 ;JMP TO BIOS CONSOLE OUTPUT 5929 ENDIF 5930;PAGE 5931ROMEN EQU $-1 5932; 5933 ORG 8192 ;RAM STARTS OF 8K BOUNDARY 5934 IF LARGE OR CPM ;ADJUST START OF RAM IF 8+K 5935 ORG 2400H ;RAM STARTS ON 9K BOUNDARY 5936 ENDIF 5937; 5938; ALL CODE ABOVE THIS POINT IS READ ONLY AND CAN BE PROM'ED 5939; 5940; 5941RAM EQU $ 5942; 5943BZERO EQU $ 5944FORNE: DS 1 ;# ENTRYS IN TABLE (MUST BE HERE) 5945 DS 112 ;ROOM FOR 8 NESTS (MUST BE HERE) 5946TAPES: DS 1 ;TAPE SWITCH (MUST BE HERE) 5947DIMSW: DS 1 ;DIM SWITCH (MUST BE HERE) 5948OUTSW: DS 1 ;OUTPUT SWITCH (MUST BE HERE) 5949ILSW: DS 1 ;INPUT LINE SWITCH (MUST BE HERE) 5950RUNSW: DS 1 ;RUN SWITCH(MUST BE HERE) 5951EDSW: DS 1 ;MODE SWITCH(MUST BE HERE) 5952EZERO EQU $ 5953; 5954LINEN: DS 5 5955IMMED: DS 82 ;IMMEDIATE COMMAND STORAGE AREA 5956IOBUF: DS 82 ;INPUT/OUTPUT BUFFER 5957STRIN: DS 256 ;STRING BUFFER AREA 5958OUTA: DS 3 ;*** FILLED IN AT RUN TIME 5959INDX: DS 2 ;HOLDS VARIABLE NAME OF FOR/NEXT 5960REL: DS 1 ;HOLDS THE RELATION IN AN IF STMT 5961IFTYP: DS 1 ;HOLDS TYPE CODE OF LEFT SIDE 5962TVAR1: DS 4 ;TEMP STORAGE 5963TVAR2: DS 4 ;DITTO 5964TEMP1: DS 4 ;TEMP STORAGE FOR FUNCTIONS 5965TEMP2: DS 4 5966TEMP3: DS 4 5967TEMP4: DS 4 5968TEMP5: DS 4 5969TEMP6: DS 4 5970TEMP7: DS 4 5971LINEL: DS 2 ;HOLDS MIN LINE NUMBER IN LIST 5972LINEH: DS 2 ;HOLDS MAX LINE NUMBER IN LIST 5973PROMP: DS 1 ;HOLDS PROMPT CHAR 5974EXPRS: DS 2 ;HOLDS ADDR OF EXPRESSION 5975ADDR1: DS 2 ;HOLDS TEMP ADDRESS 5976ADDR2: DS 2 ;HOLDS TEMP ADDRESS 5977ADDR3: DS 2 ;HOLDS STMT ADD DURING EXPR EVAL 5978FACC: DS 4 5979FTEMP: DS 12 5980PARCT: DS 1 5981SPCTR: DS 2 5982CMACT: DS 1 ;COUNT OF COMMAS 5983FNARG: DS 4 ;SYMBOLIC ARG & ADDRESS 5984STMT: DS 2 ;HOLDS ADDR OF CURRENT STATEMENT 5985ENDLI: DS 2 ;HOLDS ADDR OF MULTI STMT PTR 5986MULTI: DS 1 ;SWITCH 0=NO, 1=MULTI STMT LINE 5987DEXP: DS 1 5988COLUM: DS 1 ;CURRENT TTY COLUMN 5989RNDX: DS 2 ;RANDOM VARIABLE STORAGE 5990RNDY: DS 2 ;THE RND<X>,TRND<X>,AND RNDSW 5991RNDZ: DS 2 ;MUST BE KEPT IN ORDER 5992RNDS: DS 2 5993TRNDX: DS 2 5994TRNDY: DS 2 5995TRNDZ: DS 2 5996TRNDS: DS 2 5997RNDSW: DS 1 5998FNMOD: DS 1 ;SWITCH, 0=NOT, <>0 = IN DEF FN 5999LINE: DS 2 ;HOLD ADD OF PREV LINE NUM 6000STACK: DS 2 ;HOLDS ADDR OF START OF RETURN STACK 6001PRSW: DS 1 ;ON=PRINT ENDED WITH , OR ; 6002NS: DS 1 ;HOLDS LAST TYPE (NUMERIC/STRING) 6003DATAP: DS 2 ;ADDRESS OF CURRENT DATA STMT 6004DATAB: DS 2 ;ADDRESS OF DATA POOL 6005PROGE: DS 2 ;ADDRESS OF PROGRAM END 6006; 6007 IF CPM 6008;TEMPORARY CODE FOR INITIALIZATION HERE 6009; 6010INITC: LHLD BOOT+1 ;PTR TO BIOS TABLE 6011 LXI D,CSTAT ;OFFSET OF CONSOLE QUERY ENTRY 6012 DAD D ;POINT INTO BIO JUMP TABLE 6013 LXI D,BTSTAT;POINT INTO BASIC JMP TABLE 6014 MVI B,9 ;COUNT 6015 CALL COPYH ;MOE BIOS TABLE INTO BASIC 6016 MVI A,0C3H ;JMP OP CODE 6017 LXI H,RST1! STA 8H! SHLD 9H 6018 LXI H,RST2! STA 10H! SHLD 11H 6019 LXI H,RST3! STA 18H! SHLD 19H 6020 LXI H,RST4! STA 20H! SHLD 21H 6021 LXI H,RST5! STA 28H! SHLD 29H 6022 LXI H,RST6! STA 30H! SHLD 31H 6023 LHLD BDOS+1 ;LOCATE TOP OF RAM 6024 JMP INIT1 ;CONTINUE AS IN NON-CPM VERSION 6025 ENDIF 6026; 6027; 6028 DS 1 ;DATA STATEMENT FLAG (MUST BE HERE) 6029BEGPR: 6030; 6031 END 6032