1*HEADING IMSAI 8080 4K BASIC 2; 3; MODIFIED TO WORK WITH SIO-2 TTY IDENTICAL TO 8K VERSION 4; OCTOBER 2008, UDO MUNK 5; 6 ORG 0 7; 8; 9BASIC EQU $ 10 LD HL,RAM+1024 ;POINT FIRST POSSIBLE END OF RAM 11; LD A,0FAH ;GET MODE SET 12 LD A,0BAH ;**UM** 13 JP CONTI ;GO CONTINUE 14; 15; 16 ORG 8 17RST1 EQU $ 18; 19;SKIP CHARS POINTED TO BY HL UNTIL NON-BLANK, 20;LEAVE IN REG A 21; 22 LD A,(HL) ;LOAD THE BYTE AT (HL) 23 CP ' ' ;TEST IF BLANK 24 RET NZ ;RETURN IF NOT 25 INC HL ;POINT NEXT 26 JP RST1 ;LOOP 27; 28; 29 ORG 16 30RST2 EQU $ 31; 32;COMPARE STRING AT (HL) TO STRING AT (DE) 33;RETURN IF EQUAL (THRU X'00' IN DE) OR ON FIRST NOT EQUAL 34;IGNORE ALL SPACES 35; 36 RST 8 ;SKIP SPACES 37 LD A,(DE) ;GET CHAR TO MATCH WITH 38 OR A ;TEST IT 39 JP NZ,COMP2 ;BRIF NOT EQUAL 40 LD A,(HL) ;GET CHAR FOLLOWING 41 RET ;RETURN 42; 43; 44 ORG 24 45RST3 EQU $ 46; 47;PRINT: 'XX ERR @ NNNN' 48; 49 LD HL,IOBUF ;POINT BUFFER 50 LD (HL),B ;MOVE HI CHAR 51 INC HL ;POINT NEXT 52 JP ERROR ;CONTINUE ELSEWHERE 53; 54; 55 ORG 32 56RST4 EQU $ 57; 58;SHIFT THE LOW ORDER 4 BITS OF REG A TO THE HIGH 4 BITS 59; 60 AND 0FH ;ISOLATE LOW 4 61 RLA ;SHIFT ONE BIT 62 RLA ;AGAIN 63 RLA ;AGAIN 64 RLA ;ONE LAST TIME 65 RET ;RETURN 66; 67; 68 ORG 40 69RST5 EQU $ 70; 71;LOAD THE FLOATING POINT ACCUMULATOR WITH THE 4 BYTES AT (HL) 72; 73 LD DE,FACC ;POINT FLOAT ACC 74 LD B,4 ;BYTE COUNT 75 JP COPYH ;GO MOVE IT 76; 77; 78 ORG 48 79RST6 EQU $ 80; 81;STORE THE FLOATING POINT ACCUMULATOR AT (HL) 82; 83 LD DE,FACC ;POINT FLOAT ACC 84 LD B,4 ;BYTE COUNT 85 JP COPYD ;GO MOVE IT 86; 87; 88 ORG 56 89RST7 EQU $ 90; 91;INCREMENT HL BY BYTE AT (SP), RETURN TO (SP)+1 92; 93 EX (SP),HL ;GET RETURN ADDR IN HL 94 LD A,(HL) ;GET THE INCREMENT 95 INC HL ;POINT TRUE RETURN 96 EX (SP),HL ;PUT BACK TO STACK 97 PUSH DE ;SAVE DE 98 LD E,A ;PUT IT IN LOW 99 OR A ;TEST SIGN 100 LD D,0 ;DEFAULT POSITIVE 101 JP P,RST7A ;BRIF + 102 LD D,0FFH ;ELSE, NEG 103RST7A ADD HL,DE ;BUMP HL 104 POP DE ;RESTORE DE 105 RET ;RETURN 106; 107; 108; 109CONTI EQU $ 110; 111;INITIALIZATION ROUTINE 112;DETERMINE MEMORY SIZE. (START AT 4K AND TRY 1K INCREMENTS) 113;SETUP POINTERS FOR STACK, DATA, AND PROGRAM 114;INIT SIO BOARD 115; 116; OUT (TTY-1),A ;WRITE TO SIO 117 OUT (TTY+1),A ;**UM** 118; LD A,17H ;CMND: DTR, ENABLE TRNS, & RCVR, 119 LD A,37H ;**UM** 120; OUT (TTY-1),A ;WRITE TO SIO 121 OUT (TTY+1),A ;**UM** 122 LD BC,1024 ;1K INCR 123FINDL EQU $ 124 LD A,(HL) ;GET A BYTE FROM MEMORY 125 CPL ;COMPLEMENT 126 LD (HL),A ;REPLACE 127 CP (HL) ;TEST IF RAM/ROM/END 128 JP NZ,MEMEN ;BRIF OUT OF RAM 129 CPL ;RE-COMPLEMENT 130 LD (HL),A ;PUT ORIG BACK 131 ADD HL,BC ;POINT NEXT 1K BLOCK 132 JP NC,FINDL ;LOOP TILL 64K 133MEMEN LD SP,HL ;SET STACK POINTER TO END OF MEMORY 134 RST RST7 ;GO BUMP HL ADDR 135 DEFB -100 ;ALLOW 100 BYTES 136 LD (DATAB),HL ;SAVE ADDR OF START OF DATA 137 XOR A ;GET A ZERO IN A 138 LD (HL),A ;MARK EMPTY DATA 139 LD (OUTSW),A ;TURN OUTPUT SUPPRESS OFF 140 PUSH AF ;SET STACK 1 LEVEL DEEP WITHOUT 141 LD HL,0 ;CLEAR HL 142 ADD HL,SP ;SP TO HL 143 LD (STACK),HL ;SAVE BEG OF STACK 144 LD HL,BEGPR-1 ;POINT ONE BEFORE START OF PROGRAM 145 LD (HL),A ;MARK EMPTY 146 LD HL,RNDX ;POINT INIT RND NUMBER 147 RST RST5 ;GO LOAD TO FACC 148 LD HL,RNDNU ;POINT RAM AREA 149 RST RST6 ;GO STORE 150 LD HL,RAM ;POINT 1 BEFORE IOBUFF 151 LD (HL),0FFH ;SET HIGH VALUE 152GENRN CALL RND ;GO GENERATE A RANDUM NUMBER 153; IN A,(TTY-1) ;GET TTY STATUS 154; AND 40H ;ISOLATE RXRDY 155 IN A,(TTY+1) ;**UM** 156 AND 2 ;**UM** 157 JP Z,GENRN 158*HEADING IMSAI 8080 4K BASIC 159READY EQU $ 160; 161; 162;COMMAND INPUT ROUTINE 163; 164;READ A LINE FROM THE TTY 165;IF STARTS WITH NUMERIC CHARACTERS, ASSUME IT'S A BASIC STA 166;IF NOT, THEN IT IS EITHER AN IMMEDIATE STATEMENT OR A COM 167; 168GETCM XOR A ;SET NO PROMPT 169 LD HL,(STACK) ;GET STACK ADDRESS 170 LD SP,HL ;SET REG SP 171 CALL TERMI ;GET A LINE 172 CALL PACK ;GO PACK THE NUMBER INTO BC 173 LD A,B ;GET HI BYTE OF LINE NUMBER 174 OR C ;PLUS LOW BYTE 175 JP Z,EXEC ;BRIF EXEC STATEMENT 176 PUSH BC ;SAVE LINE NUMBER 177 LD DE,IMMED+1 ;POINT SAVE AREA 178 EX DE,HL ;FLIP/FLOP 179 LD (HL),B ;PUT LO LINE 180 INC HL ;POINT NEXT 181 LD (HL),C ;PUT LO LINE 182 INC HL ;POINT NEXT 183 LD B,3 ;INIT COUNT 184EDIT1 LD A,(DE) ;GET A BYTE 185 LD (HL),A ;PUT IT DOWN 186 INC B ;COUNT IT 187 INC HL ;POINT NEXT 188 INC DE ;DITTO 189 OR A ;TEST BYTE JUST MOVED 190 JP NZ,EDIT1 ;LOOP 191 LD A,B ;GET COUNT 192 LD (IMMED),A ;STORE THE COUNT 193 POP BC ;GET LINE NUMBER 194 LD HL,BEGPR ;POINT BEGINNING OF PROGRAM 195EDIT2 LD A,(HL) ;GET LEN CODE 196 PUSH HL ;SAVE ADDR 197 OR A ;TEST IT 198 JP Z,EDIT5 ;BRIF END 199 INC HL ;POINT HI LINE 200 LD A,(HL) ;LOAD IT 201 CP B ;COMPARE 202 JP C,EDIT4 ;BRIF LOW 203 JP NZ,EDIT5 ;EDIT5 BRIF HIGH 204 INC HL ;POINT LO LINE 205 LD A,(HL) ;LOAD IT 206 CP C ;COMPARE 207 JP C,EDIT4 ;BRIF LOW 208 JP NZ,EDIT5 ;BRIF HIGH 209 DEC HL ;POINT BACK 210 DEC HL ;TO BEGIN 211 LD D,H ;COPY ADDR 212 LD E,L ;TO DE 213 LD B,0 ;GET A ZERO 214 LD C,(HL) ;GET LEN 215 ADD HL,BC ;POINT NEXT STMT 216EDIT3 LD A,(HL) ;GET LEN NEXT STMT 217 OR A ;TEST IT 218 JP Z,EDITX ;BRIF END 219 LD B,A ;SET LENGTH 220 CALL COPYH ;ELSE MOVE LINE 221 JP EDIT3 ;LOOP 222EDIT4 POP HL ;GET ADDR 223 LD D,0 ;ZERO HI LEN 224 LD E,(HL) ;GET LO LEN 225 ADD HL,DE ;COMPUTE ADDR NEXT LINE 226 JP EDIT2 ;LOOP 227EDITX EX DE,HL ;PUT NEW ADDR TO HL 228 LD (HL),A ;MARK END 229 LD (PROGE),HL ;AND UPDATE ADDRESS 230EDIT5 LD A,(IMMED) ;GET LEN OF INSERT 231 CP 4 ;TEST IF DELETE 232 JP Z,GETCM ;BRIF IS 233 LD C,A ;SET LO LEN 234 LD B,0 ;ZERO HI LEN 235 LD HL,(PROGE) ;GET END OF PROG 236 LD D,H ;COPY TO 237 LD E,L ;DE 238 ADD HL,BC ;DISP LEN OF INSERT 239 LD (PROGE),HL ;UPDATE END POINT 240 POP BC ;GET ADDR 241EDIT6 LD A,(DE) ;GET A BYTE 242 LD (HL),A ;COPY IT 243 DEC DE ;POINT PRIOR 244 DEC HL ;DITTO 245 LD A,D ;GET HI ADDR 246 CP B ;COMPARE 247 JP Z,EDIT7 ;BRIF HI EQUAL 248 JP NC,EDIT6 ;BRIF NOT LESS 249EDIT7 LD A,E ;GET LO ADDR 250 CP C ;COMPARE 251 JP NC,EDIT6 ;BRIF NOT LESS 252 INC DE ;POINT FORWARD 253 LD HL,IMMED ;POINT INSERT 254 LD B,(HL) ;GET LENGTH 255 CALL COPYH ;GO MOVE IT 256 JP GETCM ;GO COMMAND 257*HEADING IMSAI 8080 4K BASIC 258EXEC EQU $ 259; 260; 261; 262;DECODE COMMAND IN IOBUFF 263;EXECUTE IF POSSIBLE 264;THEN GOTO GET NEXT COMMAND 265; 266; 267 LD DE,NEWLI ;POINT "NEW" 268 LD HL,IOBUF ;POINT BUFFER 269 RST RST2 ;GO COMPARE 270 JP NZ,NOTSC ;BRIF NOT 271 LD HL,BEGPR ;POINT BEGINNING OF PGM 272 LD (PROGE),HL ;SAVE END ADDRESS 273 XOR A ;GET A ZERO 274 LD (HL),A ;MARK EMPTY 275 LD HL,(DATAB) ;POINT BEGINNING OF DATA 276 LD (HL),A ;MARK EMPTY 277 JP READY ;GO GET NEXT COMMAND 278NOTSC LD DE,LISTL ;POINT LITERAL 279 LD HL,IOBUF ;POINT BUFFER 280 RST RST2 ;GO COMPARE 281 JP Z,LIST ;BRIF 'LIST' 282 LD DE,RUNLI ;POINT LITERAL 283 LD HL,IOBUF ;POINT BUFFER 284 RST RST2 ;GO COMPARE 285 JP Z,RUNIT ;BRIF 'RUN' 286 LD (RUNSW),A ;SET IMMEDIATE MODE 287 LD HL,IOBUF ;POINT STMT 288 LD DE,IMMED ;POINT NEW AREA 289IMED LD A,(HL) ;GET A BYTE 290 LD (DE),A ;PUT TO D 291 INC DE ;POINT NEXT 292 INC HL ;DITTO 293 OR A ;TEST IF END 294 JP NZ,IMED ;LOOP 295 LD HL,NULLI ;POINT FFFF 296 LD (LINE),HL ;SAVE ADDR 297 LD HL,IMMED ;POINT START OF CMMD 298 JP IMMD ;GO IMMEDIATE 299*HEADING IMSAI 8080 4K BASIC 300RUNIT EQU $ 301; 302; 303;RUN PROCESSOR, GET NEXT STATEMENT, AND EXECUTE IT 304;IF IN IMMEDIATE MODE, THEN RETURN TO GETCMMD 305; 306; 307 XOR A ;CLEAR A REG 308 LD (RUNSW),A ;RESET SWITCH 309 LD (FORNE),A ;INIT FOR/NEXT TABLE 310 LD HL,(DATAB) ;POINT START OF VARIABLES 311 LD (HL),0 ;CLEAR IT 312 LD HL,BEGPR-1 ;GET ADDR OF PROGRAM 313 LD (DATAP),HL ;'RESTORE' 314 INC HL ;POINT 1ST BYTE 315 LD (STMT),HL ;SAVE IT 316 JP NEXTS ;GO PROCESS IT 317; 318RUN LD HL,(STMT) ;GET ADDR OF PREVIOUS STMT 319 LD E,(HL) ;GET LEN CODE 320 LD D,0 ;CLEAR HIGH BYTE OF ADDR 321 ADD HL,DE ;INCR STMT POINTER 322 LD (STMT),HL ;SAVE IT 323; 324NEXTS EQU $ 325 LD A,(RUNSW) ;GET RUN TYPE 326 OR A ;TEST IT 327 JP NZ,GETCM ;BRIF IMMEDIATE MODE 328 LD A,(HL) ;GET LEN CODE 329 OR A ;SEE IF NO MORE STATEMENTS 330 JP Z,READY ;BRIF END 331NOTDO EQU $ 332 INC HL ;POINT LINE NUMBER 333 LD (LINE),HL ;SAVE ADDR 334 INC HL ;POINT 2ND BYTE 335 INC HL ;POINT 1ST PGM BYTE 336IMMD RST RST1 ;SKIP BLANKS 337CONTX LD (ADDR1),HL ;SAVE ADDR 338 CALL TSTCH ;GO SEE IF CONTROL-C 339 LD DE,JMPTB ;POINT TO TABLE 340TABLO LD A,(DE) ;GET FIRST BYTE OF LIT 341 OR A ;TEST IF END OF TABLE 342 JP Z,TABEN ;BRIF IS 343 LD HL,(ADDR1) ;GET ADDRESS OF CMMD 344 RST RST2 ;GO COMPARE 345 JP NZ,NOJMP ;BRIF NOT EQUAL 346 PUSH HL ;SAVE HL 347 INC DE ;POINT NEXT BYTE 348 LD A,(DE) ;LOAD IT 349 LD L,A ;LOW BYTE TOL 350 INC DE ;POINT NEXT BYTE 351 LD A,(DE) ;LOAD IT 352 LD H,A ;HIGH BYTE TO H 353 EX (SP),HL ;HL TO STACK, STACK TO HL 354 RET ;JUMP TO PROPER ROUTINE 355NOJMP INC DE ;POINT NEXT 356 LD A,(DE) ;LOAD IT 357 OR A ;TEST IT 358 JP NZ,NOJMP ;BRIF NOT 359 INC DE ;POINT NEXT 360 INC DE ;DITTO 361 INC DE ;POINT FIRST BYTE NEXT LIT 362 JP TABLO ;LOOP 363; 364TABEN LD HL,(ADDR1) ;RESTORE HL POINTER 365 JP LET ;ASSUME IT'S A LET STATEMENT 366*HEADING IMSAI 8080 4K BASIC 367LIST EQU $ 368; 369; 370;LIST PROCESSOR 371;DUMP THE SOURCE PROGRAM TO TTY OR PAPER TAPE 372; 373; 374 LD HL,BEGPR ;POINT BEGINNING OF PROGRAM 375LISTX LD A,(HL) ;GET LEN CODE 376 OR A ;TEST IF END OF PGM 377 JP Z,READY ;BRIF END OF PGM 378 SUB 3 ;SUBTRACT THREE 379 LD B,A ;SAVE LEN 380 INC HL ;POINT HI BYTE OF LINE # 381 LD DE,IOBUF ;POINT BUFFER AREA 382 CALL LINEO ;CONVERT LINE NUMBER 383 CALL COPYH ;GO MOVE THE LINE 384 CALL TSTCH ;GO SEE IF CONTROL-C 385 PUSH HL ;SAVE HL ADDR 386 CALL TERMO ;GO TYPE IT 387 POP HL ;RETREIVE H ADDR 388 JP LISTX ;CONTINUE 389; 390*HEADING IMSAI 8080 4K BASIC 391GOSUB EQU $ 392; 393; 394; STMT: GOSUB NNNN 395; 396 EX DE,HL ;FLIP/FLOP DE HL 397 LD HL,(STMT) ;GET STATEMENT ADDRESS 398 PUSH HL ;SAVE RETURN ADDRESS IN STACK 399 LD A,0FFH ;MARK AS GOSUB 400 PUSH AF ;SAVE STATUS 401 EX DE,HL ;RESTORE HL 402; 403; 404GOTO EQU $ 405; 406; 407; STMT: GOTO NNNN 408; 409 CALL PACK ;GO GET LINE NUMBER IN BC 410 LD HL,BEGPR ;POINT BEGINNING OF PROGRAM 411GOTO1 LD A,(HL) ;GET LEN 412 OR A ;TEST IF END OF PROGRAM 413 JP Z,ULERR ;BRIF UNDEFIND STATEMENT 414 INC HL ;POINT NEXT 415 LD A,(HL) ;GET THE HIGH LINE NUMBER 416 CP B ;TEST WITH DESIRED 417 JP C,GOTO2 ;BRIF LOW 418 INC HL ;POINT NEXT BYTE 419 LD A,(HL) ;GET LOW LINE NUMBER 420 DEC HL ;POINT BACK 421 CP C ;TEST WITH WANTED 422 JP C,GOTO2 ;BRIF LOW 423 JP NZ,ULERR ;BRIF LINE MISSING 424 DEC HL ;POINT TO START OF STMT 425 LD (STMT),HL ;SAVE ADDR 426 JP NEXTS ;GO PROCESS THE STATEMENT 427GOTO2 DEC HL ;POINT START OF STMT 428 LD E,(HL) ;GET LENGTH 429 LD D,0 ;ZERO MDB 430 ADD HL,DE ;POINT NEXT STMT 431 JP GOTO1 ;LOOP 432*HEADING IMSAI 8080 4K BASIC 433RETUR EQU $ 434; 435; 436; STMT: RETURN 437; 438 POP AF ;POP THE STACK 439 CP 0FFH ;TEST IF GOSUB IN EFFECT 440 JP NZ,RTERR ;BRIF ERROR 441 POP HL ;GET RETURNED STATEMENT ADDRESS 442 LD (STMT),HL ;RESTORE 443 JP RUN ;CONTINUE AT STMT FOLLOWING GOSUB 444*HEADING IMSAI 8080 4K BASIC 445PRINT EQU $ 446; 447; 448; STMT: PRINT . . . . 449; 450; 451 XOR A ;CLEAR REG A 452 LD (PRSW),A ;SET SWITCH 453PR1 LD DE,IOBUF ;POINT BUFFER 454 RST RST1 ;SKIP TO NEXT FIELD 455 CP '"' ;TEST IF QUOTE 456 JP NZ,PR6 ;BRIF NOT LITERAL 457PR2 INC HL ;POINT NEXT 458 LD A,(HL) ;GET THE CHAR 459 OR A ;TEST IF END OF STMT 460 JP Z,SNERR ;BRIF MISSING END OF QUOTE 461PR3 CP '"' ;TEST IF END QUOTE 462 JP NZ,PR5 ;BRIF NOT 463 INC HL ;POINT NEXT 464PRNXT LD A,0FEH ;SET CODE = NO CR/LF 465 LD (DE),A ;PUT TO BUFFER 466 PUSH HL ;SAVE HL 467 CALL TERMO ;GO PRINT IT 468 POP HL ;RESTORE HL 469 JP PRINT ;RECURSIVE TO NEXT FIELD 470PR4 LD A,(PRSW) ;GET SWITCH 471 OR A ;TEST IF STMT ENDED WITH , OR ; 472 CALL Z,CRLF ;CALL IF NOT 473 JP RUN ;CONTINUE NEXT STMT 474PR5 LD (DE),A ;PUT CHAR TO BUFFER 475 INC DE ;POINT NEXT OUT 476 JP PR2 ;LOOP 477PR6 OR A ;TEST IF END OF STMT 478 JP Z,PR4 ;BRIF IT IS 479 CP ',' ;TEST IF COMMA 480 JP Z,PR7 ;BRIF IT IS 481 CP ';' ;TEST IF SEMI-COLON 482 JP Z,PR8 ;BRIF IT IS 483 PUSH DE ;SAVE DE 484 CALL EXPR ;GO EVALUATE EXPRESSION 485 POP DE ;RESTORE DE 486 PUSH HL ;SAVE HL 487 EX DE,HL ;FLIP/FLOP 488 CALL FOUT ;GO CONVERT OUTPUT 489 INC HL ;POINT NEXT 490 LD (HL),' ' ;SPACE FOLLOWS NUMBERS 491 INC HL ;POINT NEXT 492 EX DE,HL ;FLIP/FLOP 493 POP HL ;RESTORE HL 494 JP PRNXT ;CONTINUE 495PR7 LD A,(COLUM) ;GET COLUMN POINTER 496 CP 56 ;COMPARE TO 56 497 JP NC,TBEND ;BRIF NO ROOM LEFT 498 LD B,A ;SAVE IT 499 XOR A ;INIT POSITION 500TBLP CP B ;COMPARE 501 JP Z,TBLP2 ;BRIF ON A TAB STOP 502 JP NC,TBON ;BRIF SHY OF TAB 503TBLP2 ADD A,14 ;POINT NEXT STOP 504 JP TBLP ;LOOP 505TBON LD (COLUM),A ;UPDATE CTR 506 SUB B ;COMPUTE NUMBER OF SPACES 507 LD B,A ;SAVE IT 508TBSPA CALL TESTO ;WAIT TILL READY 509 LD A,' ' ;SPACE TO REG A 510 OUT (TTY),A ;OUTPUT IT 511 DEC B ;SUB 1 FROM CTR 512 JP NZ,TBSPA ;LOOP IF NOT 513PR8 INC HL ;POINT NEXT 514 LD (PRSW),A ;SET THE SWITCH 515 JP PR1 ;GO NEXT FIELD 516TBEND CALL CRLF ;PUT CR/LF 517 JP PR8 ;GO SET SW 518*HEADING IMSAI 8080 4K BASIC 519FOR EQU $ 520; 521; 522; STMT: FOR VAR = EXPR TO EXPR :STEP EXPR: 523; 524; 525 CALL VAR ;NEXT WORD MUST BE VARIABLE 526 EX DE,HL ;FLIP/FLOP 527 LD (INDX),HL ;SAVE VARIABLE NAME 528 EX DE,HL ;FLIP/FLOP AGAIN 529 CP '=' ;TEST FOR EQUAL SIGN 530 JP NZ,SNERR ;BRIF NO EQUAL 531 INC HL ;POINT NEXT 532 CALL EXPR ;GO EVALUATE EXPR IF ANY 533 PUSH HL ;SAVE HL 534 LD HL,(INDX) ;GET INDEX NAME 535 EX DE,HL ;FLIP/FLOP 536 CALL SEARC ;GO LOCATE NAME 537 EX DE,HL ;PUT ADDR IN HL 538 LD (ADDR1),HL ;SAVE ADDR 539 RST RST6 ;GO STORE THE VALUE 540 POP HL ;RESTORE POINTER TO STMT 541 LD DE,TOLIT ;GET LIT ADDR 542 RST RST2 ;GO COMPARE 543 JP NZ,SNERR ;BRIF ERROR 544 CALL EXPR ;GO EVALUATE TO-EXPR 545 PUSH HL ;SAVE HL 546 LD HL,TVAR1 ;POINT SAVE AREA 547 RST RST6 ;SAVE 'TO' EXPR 548 LD HL,ONE ;POINT CONSTANT: 1 549 RST RST5 ;LOAD IT 550 POP HL ;RESTORE HL 551 LD A,(HL) ;GET THAT CHAR 552 OR A ;TEST FOR END OF STATEMENT 553 JP Z,NOSTP ;BRIF NO STEP 554 LD DE,STEPL ;TEST FOR LIT STEP 555 RST RST2 ;GO COMPARE 556 JP NZ,SNERR ;BRIF NOT STEP 557FORST CALL EXPR ;GO EVAL STEP 558NOSTP LD HL,TVAR2 ;GET ADDR OF TEMP VARIABLE 559 RST RST6 ;SAVE END VALUE 560 CALL FTEST ;GET SIGN OF FACC 561 PUSH AF ;SAVE A, STATUS 562 LD HL,TVAR1 ;GET END VALUE 563 RST RST5 ;LOAD IT 564 LD HL,(ADDR1) ;GET ADDR OF INDEX 565 CALL FSUB ;COMPAE TO END VALUE 566 POP AF ;RESTORE STATUS 567 JP P,FORPO ;BRIF FOR IS POS 568FORXE CALL FTEST ;GET SIGN OF DIFFERENCE 569 JP Z,FORTA ;BRIF START = END 570 JP M,FORTA ;BRIF START > END 571 JP LNEXT ;GO LOCATE MATCHING NEXT 572FORPO CALL FTEST ;GET SIGN OF DIFFERENCE 573 JP M,LNEXT ;BRIF START > END 574FORTA LD DE,FORNE ;POINT TABLE 575 LD HL,(INDX) ;GET INDEX NAME 576 EX DE,HL ;FLIP/FLOP 577 LD A,(HL) ;GET COUNT 578 LD B,A ;STORE IT 579 LD C,1 ;NEW CTR 580 OR A ;TEST IF ZERO 581 INC HL ;POINT 582 JP Z,FOREQ ;BRIF TABLE EMPTY 583FORLP LD A,(HL) ;GET 1ST BYTE 584 CP D ;TEST IF EQUAL 585 JP NZ,FORNO ;BRIF NOT 586 INC HL ;POINT NEXT 587 LD A,(HL) ;GET NEXT BYTE 588 DEC HL ;POINT BACK 589 CP E ;TEST IF EQUAL 590 JP NZ,FOREQ ;BRIF EQUAL 591FORNO RST RST7 ;GO BUMP HL 592 DEFB 12 ;BY 12 593 INC C ;COUNT IT 594 DEC B ;DECR CTR 595 JP NZ,FORLP ;LOOP 596FOREQ LD A,C ;GET UPDATED COUNT 597 CP 9 ;TEST IF TBL EXCEEDED 598 JP NC,FOERR ;ERROR IF MORE THAN 8 OPEN FOR/NEXT 599 LD (FORNE),A ;PUT IN TABLE 600 LD (HL),D ;STORE IT 601 INC HL ;POINT NEXT 602 LD (HL),E ;STORE IT TOO 603 INC HL ;POINT NEXT 604 PUSH HL ;SAVE HL 605 LD HL,TVAR2 ;POINT STEP 606 RST RST5 ;GO LOAD IT 607 POP HL ;RESTORE HL 608 RST RST6 ;PUT IN TABLE 609 PUSH HL ;SAVE HL 610 LD HL,TVAR1 ;POINT TO-VAL 611 RST RST5 ;GO LOAD IT 612 POP HL ;RESTORE HL 613 RST RST6 ;PUT IN TABLE 614 LD A,(STMT+1) ;GET HIGH STMT ADDR 615 LD (HL),A ;PUT IT 616 INC HL ;POINT NEXT 617 LD A,(STMT) ;GET LOW STMT ADDR 618 LD (HL),A ;PUT IT 619 JP RUN ;CONTINUE 620LNEXT LD HL,(STMT) ;GET ADDR OF STMT 621 LD E,(HL) ;GET LENGTH CODE 622 LD D,0 ;INIT INCREMENT 623 ADD HL,DE ;COMPUTE ADDR OF NEXT STATEMENT 624 LD A,(HL) ;GET NEW LEN CODE 625 OR A ;SEE IF END OF PGM 626 JP Z,NXERR ;BRIF IT IS 627 LD (STMT),HL ;SAVE ADDRESS 628 RST RST7 ;GO BUMP HL 629 DEFB 3 ;BY THREE 630 RST RST1 ;SKIP SPACES 631 LD DE,NEXTL ;POINT 'NEXT' 632 RST RST2 ;SEE IF IT IS A NEXT STMT 633 JP NZ,LNEXT ;LOOP IF NOT 634 RST RST1 ;SKIP SPACES 635 LD A,(INDX+1) ;GET FIRST CHAR 636 CP (HL) ;COMPARE 637 JP NZ,LNEXT ;BRIF NOT MATCH NEXT 638 LD A,(INDX) ;GET 2ND CHAR 639 INC HL ;DITTO 640 CP ' ' ;SEE IF SINGLE CHAR 641 JP Z,FORN1 ;BRIF IT IS 642 CP (HL) ;COMPARE THE TWO 643 JP NZ,LNEXT ;BRIF NOT EQUAL 644FORN1 RST RST1 ;SKIP TO END (HOPEFULLY) 645 OR A ;SEE IF END 646 JP NZ,LNEXT ;BRIF NOT END 647 JP RUN ;ELSE, GO NEXT STMT 648*HEADING IMSAI 8080 4K BASIC 649IF EQU $ 650; 651; 652; STMT: IF EXPR RELATION EXPR THEN STMT # 653; 654; 655 CALL EXPR ;GO EVALUATE LEFT EXPRESSION 656 PUSH HL ;SAVE HL 657 LD HL,TVAR1 ;GET ADDR OF TEMP STORAGE 658 RST RST6 ;SAVE IT 659 POP HL ;RESTORE HL 660 XOR A ;CLEAR A 661 LD C,A ;SAVE IN REG C 662 LD B,A ;INIT REG 663IFREL LD A,(HL) ;GET OPERATOR 664 INC B ;COUNT 665 CP '=' ;TEST FOR EQUAL 666 JP NZ,IFEQ ;BRIF IT IS 667 INC C ;ADD 1 TO C 668 INC HL ;POINT NEXT 669IFEQ CP '>' ;TEST FOR GREATER THAN 670 JP NZ,IFGT ;BRIF IT IS 671 INC C ;ADD TWO 672 INC C ;TO REL CODE 673 INC HL ;POINT NEXT 674IFGT CP '<' ;TEST FOR LESS THAN 675 JP NZ,IFLT ;BRIF IT IS 676 LD A,C ;GET REL CODE 677 ADD A,4 ;PLUS FOUR 678 LD C,A ;PUT BACK 679 INC HL ;POINT NEXT 680IFLT LD A,C ;GET REL CODE 681 OR A ;TEST IT 682 JP Z,SNERR ;BRIF SOME ERROR 683 LD (REL),A ;SAVE CODE 684 LD A,B ;GET COUNT 685 CP 2 ;TEST FOR TWO 686 JP NZ,IFREL ;SEE IF MULTIPLE RELATION 687 CALL EXPR ;GO EVALUATE RIGHT SIDE 688 PUSH HL ;SAVE STMT LOCATION 689 LD HL,TVAR1 ;POINT LEFT 690 CALL FSUB ;SUBTRACT LEFT FROM RIGHT 691 POP HL ;RESTORE STMT ADDR 692 LD A,(REL) ;GET RELATION 693 RRA ;TEST BIT D0 694 JP NC,IFNOT ;BRIF NO EQUAL TEST 695 CALL FTEST ;GET SIGN OF DIFFERENCE 696 JP Z,TRUE ;BRIF LEFT=RIGHT 697IFNOT LD A,(REL) ;LOAD RELATION 698 AND 02H ;MASK IT 699 JP Z,IFNTX ;BRIF NO > 700 CALL FTEST ;GET SIGN OF DIFFERENCE 701 JP M,TRUE ;BRIF GT 702IFNTX LD A,(REL) ;LOAD RELATION 703 AND 04H ;MASK IT 704 JP Z,RUN ;BRIF NO < 705 CALL FTEST ;GET SIGN OF DIFFERENCE 706 JP M,RUN ;BRIF GT 707 JP Z,RUN ;BRIF EQUAL 708TRUE LD DE,THENL ;GET ADDR 'THEN' 709 RST RST2 ;GO COMPARE 710 JP NZ,SNERR ;BRIF ERROR 711 JP GOTO ;BRIF IT IS 712*HEADING IMSAI 8080 4K BASIC 713LET EQU $ 714; 715; 716; STMT: :LET: VAR = EXPR 717; 718; 719 CALL VAR ;NEXT MUST BE VARIABLE NAME 720 CP '=' ;TEST FOR EQUAL SIGN 721 JP NZ,SNERR ;BRIF MISSING EQUAL 722 CALL SEARC ;GO FIND ADDRESS OF VAR 723 PUSH DE ;SAVE ADDRESS 724 INC HL ;POINT NEXT 725 CALL EXPR ;GO EVALUATE EXPRESSION 726 POP HL ;RESTORE ADDRESS 727 RST RST6 ;GO STORE VARIABLE 728 JP RUN ;CONTINUE 729*HEADING IMSAI 8080 4K BASIC 730NEXT EQU $ 731; 732; 733; STMT: NEXT VAR 734; 735; 736 CALL VAR ;GET VARIABLE NAME 737 EX DE,HL ;FLIP/FLOP 738 LD (INDX),HL ;SAVE VAR NAME 739 PUSH HL ;SAVE VAR NAME 740 LD HL,FORNE ;POINT FOR/NEXT TABLE 741 LD B,(HL) ;GET SIZE 742 LD A,B ;LOAD IT 743 OR A ;TEST IT 744 JP Z,NXERR ;BRIF TABLE EMPTY 745 INC HL ;POINT NEXT 746 POP DE ;RESTORE VAR NAME 747NXLP LD A,(HL) ;GET 1ST BYTE 748 INC HL ;POINT NEXT 749 CP D ;COMPARE 750 JP NZ,NXNE ;BRIF NOT EQUAL 751 LD A,(HL) ;GET 2ND BYTE 752 CP E ;COMPARE 753 JP Z,NXEQ ;BRIF EQUAL 754NXNE RST RST7 ;GO BUMP HL 755 DEFB 11 ;BY ELEVEN 756 DEC B ;DECR COUNT 757 JP NZ,NXLP ;LOOP 758 JP NXERR ;GO PUT ERROR MSG 759NXEQ LD A,(FORNE) ;GET ORIG COUNT 760 SUB B ;MINUS REMAIN 761 INC A ;PLUS ONE 762 LD (FORNE),A ;STORE NEW COUNT 763 INC HL ;POINT STEP 764 PUSH HL ;SAVE HL ADDR 765 CALL SEARC ;GO GET ADDR OF INDEX 766 EX DE,HL ;PUT TO HL 767 LD (ADDR1),HL ;SAVR IT 768 RST RST5 ;LOAD INDEX 769 POP HL ;GET HL (TBL) 770 PUSH HL ;RESAVE 771 CALL FADD ;ADD STEP VALUE 772 LD HL,TVAR1 ;POINT NEW INDEX 773 RST RST6 ;STORE IT 774 POP HL ;GET HL (TBL) 775 PUSH HL ;RESAVE 776 RST RST7 ;GO BUMP HL 777 DEFB 4 ;BY FOUR 778 CALL FSUB ;SUBTRACT TO VALUE 779 CALL FTEST ;GET SIGN OF DIFFERENCE 780 JP Z,NXTZR ;BRIF ZERO 781 POP HL ;GET HL (PTR TO STEP) 782 PUSH HL ;RE-SAVE 783 LD A,(HL) ;GET SIGN & EXPONENT OF STEP 784 OR A ;TEST IT 785 LD A,(FACC) ;GET SIGN & EXPONENT OF DIFFERENCE 786 JP M,NXTNE ;BRIF NEGATIVE 787NXTPO OR A ;TEST IT 788 JP M,NXTZR ;BRIF LESS THAN TO-EXPR 789 JP NEXTZ ;GO PAST NEXT 790NXTNE OR A ;TEST IT 791 JP M,NEXTZ ;BRIF END OF LOOP 792NXTZR POP HL ;POP THE STACK 793 RST RST7 ;GO BUMP HL 794 DEFB 8 ;BY EIGHT 795 LD D,(HL) ;GET HI BYTE 796 INC HL ;POINT NEXT 797 LD E,(HL) ;GET LOW BYTE 798 EX DE,HL ;PUT TO HL 799 LD (STMT),HL ;SAVE ADDR OF FOR 800 LD DE,TVAR1 ;POINT UPDATED INDEX VALUE 801 LD HL,(ADDR1) ;GET ADDR 802 LD B,4 ;LENGTH 803 CALL COPYD ;GO MOVE TO I 804 JP RUN ;CONTINUE STMT AFTER FOR 805NEXTZ EQU $ 806 LD HL,FORNE ;GET ADDR TABLE 807 DEC (HL) ;SUBTRACT ONE FROM COUNT 808 JP RUN ;GO STMT AFTER NEXT 809*HEADING IMSAI 8080 4K BASIC 810INPUT EQU $ 811; 812; 813; STMT: INPUT VAR :, VAR, VAR: 814; 815; 816 LD DE,IOBUF ;GET ADDR OF BUFFER 817 EX DE,HL ;FLIP/FLOP 818 LD (ADDR1),HL ;SAVE ADDR 819 LD (HL),0 ;MARK BUFFER EMPTY 820 EX DE,HL ;FLIP/BACK 821IN1 CALL VAR ;GO GET VAR NAME 822 CALL SEARC ;GO ;LOOK UP ADDRESS 823 PUSH HL ;SAVE HL ADDR 824 PUSH DE ;SAVE VAR ADDRE 825 LD HL,(ADDR1) ;GET ADDR PREV BUFFER 826 LD A,(HL) ;LOAD CHAR 827 CP ',' ;TEST IF COMMA 828 INC HL ;POINT NEXT 829 JP Z,IN2 ;BRIF CONTINUE FROM PREV 830 OR A ;TEST IF END OF LINE 831 JP NZ,SNERR ;BRIF ERROR 832 LD A,'?' ;PROMPT CHAR 833 CALL TERMI ;GO READ FROM TTY 834IN2 CALL FIN ;GO CONVERT TO FLOATING 835 LD (ADDR1),HL ;SAVE ADDRESS 836 POP HL ;GET VAR ADDRESS 837 RST RST6 ;GO STORE THE NUMBER 838 POP HL ;RESTORE STMT POINTER 839 RST RST1 ;SKIP SPACES 840 CP ',' ;TEST FOR COMMA 841 INC HL ;POINT NEXT 842 JP Z,IN1 ;RECURSIVE IF COMMA 843 DEC HL ;POINT BACK 844 JP RUN ;GO NEXT STMT 845*HEADING IMSAI 8080 4K BASIC 846READ EQU $ 847; 848; STMT: READ VAR :,VAR ...: 849; 850 CALL VAR ;GO GET VAR NAME 851 CALL SEARC ;GO GET ADDRESS 852 PUSH HL ;SAVE HL 853 PUSH DE ;SAVE DE 854 LD HL,(DATAP) ;GET DATA STMT POINTER 855 LD A,(HL) ;LOAD THE CHAR 856 OR A ;TEST IF END OF STMT 857 JP NZ,NOTDT ;BRIF NOT END OF STMT 858 INC HL ;POINT START NEXT STMT 859DATAN LD A,(HL) ;LOAD LEN 860 LD (DATAP),HL ;SAVE ADDR 861 OR A ;TEST IF END OF PGM 862 JP Z,DAERR ;BRIF OUT OF DATA 863 INC HL ;POINT NEXT 864 LD (DASTM),HL ;SAVE ADDR OF LINE NUMBER 865 INC HL ;SKIP LINE NUMBER 866 INC HL ;POINT 1ST DATA BYTE 867 RST RST1 ;SKIP BLANKS 868 LD DE,DATAL ;POINT 'DATA' 869 RST RST2 ;COMPARE 870 JP Z,NOTDT ;BRIF IT IS DATA STMT 871 LD HL,(DATAP) ;GET ADDR START 872 LD E,(HL) ;GET LEN CODE 873 LD D,0 ;CLEAR D 874 ADD HL,DE ;POINT NEXT STMT 875 JP DATAN ;LOOP NEXT STMT 876NOTDT CALL FIN ;GO CONVERT VALUE 877 LD A,(HL) ;GET CHAR WHICH STOPPED US 878 CP ',' ;TEST IF COMMA 879 JP NZ,NOTCO ;BRIF NOT 880 INC HL ;POINT NEXT 881DATOK LD (DATAP),HL ;SAVE ADDRESS 882 POP HL ;RESTORE ADDR OF VAR 883 RST RST6 ;STORE THE VALUE 884 POP HL ;RESTORE POINTER TO STM 885 LD A,(HL) ;LOAD THE CHAR 886 CP ',' ;TEST IF COMMA 887 INC HL ;POINT NEXT 888 JP Z,READ ;RECURSIVE IF IT IS 889 DEC HL ;RESET 890 JP RUN ;CONTINUE 891NOTCO OR A ;TEST IF END OF STMT 892 JP Z,DATOK ;BRIF OK 893 LD HL,(DASTM) ;GET DATA STMT LINE NUMBER 894 LD (LINE),HL ;SAVE IN LINE NUMBER 895 JP SNERR ;GO PROCESS ERROR 896; 897*HEADING IMSAI 8080 4K BASIC 898FIN EQU $ 899; 900;FLOATING POINT INPUT CONVERSION ROUTINE 901; 902;THIS SUBROUTINE CONVERTS AN ASCII STRING OF CHARACTERS TO 903;POINT ACCUMULATOR. THE INPUT FIELD MAY CONTAIN ANY VALID 904;INCLUDING SCIENTIFIC (NNN.NNNNE+NN) 905;THE INPUT STRING IS TERMINATED BY ANY NON-NUMERIC CHARACT 906; 907; 908 EX DE,HL ;FLIP/FLOP DE HL 909 LD HL,FACC ;POINT TO FACC 910 LD B,4 ;LOOP CTR 911 CALL ZEROM ;GO CLEAR THE FACC 912 RST RST7 ;GO BUMP HL 913 DEFB -4 ;BY NEG FOUR 914 LD C,B ;INIT DIGIT COUNTER 915 LD A,(DE) ;GET FIRST BYTE 916 CP '+' ;TEST FOR PLUS SIGN 917 JP Z,FIN2 ;BRIF IS 918 CP '-' ;TEST FOR MINUS SIGN 919 JP NZ,FIN3 ;BRIF NOT 920 LD (HL),80H ;SET MINUS MANTISSA 921FIN2 INC DE ;POINT NEXT DIGIT 922 LD A,(DE) ;GET THE BYTE 923FIN3 CP '0' ;TEST FOR LEADING ZERO 924 JP Z,FIN2 ;BRIF IT IS 925FIN4 CP '9'+1 ;TEST FOR NINE 926 JP NC,FIN14 ;BRIF NOT NUMERIC 927 CP '0' ;TEST FOR ZERO 928 JP C,FIN5 ;BRIF NOT NUMERIC 929 INC B ;COUNT EXPONENT 930 CALL FIN9 ;STORE THE DIGIT 931 INC DE ;POINT NEXT 932 LD A,(DE) ;GET THE DIGIT 933 JP FIN4 ;LOOP 934FIN5 CP '.' ;TEST FOR DOT 935 JP NZ,FIN19 ;BRIF NOT 936 LD A,C ;GET DIGIT COUNT 937 OR A ;TEST FOR ZERO 938 JP NZ,FIN7 ;BRIF NOT 939FIN6 INC DE ;POINT NEXT 940 LD A,(DE) ;GET DIGIT 941 CP '0' ;TEST FOR ZERO 942 JP NZ,FIN8 ;BRIF NOT 943 DEC B ;COUNT IT 944 JP FIN6 ;LOOP 945FIN7 INC DE ;POINT NEXT 946 LD A,(DE) ;GET THE DIGIT 947FIN8 CP '0' ;TEST FOR ZERO 948 JP C,FIN19 ;BRIF LOWER 949 CP '9'+1 ;TEST FOR NINE 950 JP NC,FIN14 ;BRIF HIGH 951 CALL FIN9 ;GO STORE DIGIT 952 JP FIN7 ;LOOP 953FIN9 LD A,C ;GET DIGIT COUNT 954 CP 6 ;TEST FOR MAX 955 RET Z ;RETURN IF EQUAL 956 INC A ;ADD ONE 957 LD C,A ;REPLACE PREV COUNT 958 INC A ;PLUS ONE 959 RRA ;DIVIDE BY TWO 960 AND 0FH ;MASK OFF UNUSED BITS 961 ADD A,L ;PLUS LOW BYTE OF H 962 LD L,A ;REPLACE LOW BYTE OF HL 963 LD A,C ;RE-LOAD DIGIT COUNT 964 RRA ;TEST EVEN/ODD 965 LD A,(DE) ;GET THE DIGIT 966 JP C,FIN12 ;BRIF ODD DIGIT 967 AND 0FH ;LOW 4 BITS ONLY 968 OR (HL) ;GET HIGH 4 BITS 969 JP FIN13 ;GO RETURN 970FIN12 RST RST4 ;SHIFT LEFT 971FIN13 LD (HL),A ;REPLACE 972 LD HL,FACC ;POINT TO FACC 973 RET ;RETURN 974FIN14 CP 'E' ;TEST FOR EXPLICIT EXPONENT 975 JP NZ,FIN19 ;BRIF NOT EQUAL 976 INC DE ;POINT NEXT 977 LD A,(DE) ;GET DIGIT 978 LD C,0 ;CLEAR COUNTER 979 CP '+' ;TEST FOR PLUS 980 JP Z,FIN17 ;BRIF EQUAL 981 CP '-' ;TEST FOR MINUS 982 JP NZ,FIN16 ;BRIF NOT EQUAL 983 CALL FIN15 ;GET NUMERIC EXPONENT 984 LD A,C ;LOAD THE NUMBER 985 CPL ;COMPLEMENT 986 INC A ;PLUS ONE (TWOS COMPLEMENT) 987 JP FIN18 ;CONTINUE 988FIN15 INC DE ;POINT NEXT 989 LD A,(DE) ;GET DIGIT 990 CP '0' ;TEST ZERO 991 RET C ;RETURN IF ERROR 992 CP '9'+1 ;TEST NINE 993 RET NC ;RETURN IF NOT NUMERIC 994 LD A,C ;GET PRIOR 995 ADD A,A ;TIMES TWO 996 LD C,A ;SAVE 997 ADD A,A ;TIMES FOUR 998 ADD A,A ;TIMES EIGHT 999 ADD A,C ;TIMES TEN 1000 LD C,A ;SAVE 1001 LD A,(DE) ;GET THIS DIGIT 1002 AND 0FH ;MASK OFF HIGH FOUR BITS 1003 ADD A,C ;PLUS PREV*10 1004 LD C,A ;SAVE 1005 JP FIN15 ;LOOP 1006FIN16 DEC DE ;POINT PRIOR TEMP 1007FIN17 CALL FIN15 ;GO GET NUMERIC EXPONENT 1008 LD A,C ;LOAD THE EXPONENT 1009FIN18 ADD A,B ;PLUS COMPUTED EXPONENT 1010 LD B,A ;SAVE IT 1011 LD A,(DE) ;GET LAST CHAR 1012FIN19 INC HL ;POINT 1ST DIGIT 1013 LD A,(HL) ;LOAD 1014 OR A ;TEST IF ZERO 1015 JP Z,FIN20 ;BRIF ZERO 1016 DEC HL ;POINT EXPONENT 1017 DEC B ;SUB ONE FROM EXPONENT 1018 LD A,B ;GET EXPONENT 1019 AND 7FH ;TURN OFF HIGH BIT 1020 OR (HL) ;OR IN MANTISSA SIGN 1021 LD (HL),A ;STORE IN FACC 1022 XOR A ;TURN CY OFF, CLEAR ACC 1023FIN20 EX DE,HL ;FLIP/FLOP 1024 RET ;RETURN 1025*HEADING IMSAI 8080 4K BASIC 1026FOUT EQU $ 1027; 1028;FLOATING POINT OUTPUT FORMAT ROUTINE 1029; 1030;THIS SUBROUTINE CONVERTS A NUMBER IN THE FLOATING POINT AC 1031;TO A FORMAT SUITABLE FOR PRINTING. THAT IS, THE NUMBER WIL 1032;SCIENTIFIC NOTATION (+N.NNNNNE+NN) IF THE EXPONENT IS > 5 1033;OTHERWISE IT WILL BE ZERO SUPPRESSED BOTH ON THE LEFT OF T 1034;PORTION AND ON THE RIGHT OF THE FRACTION. 1035; 1036 LD DE,FACC ;POINT TO FLOATING POINT ACCUMULATOR 1037 LD A,(DE) ;GET EXPONENT BYTE 1038 LD C,A ;SAVE IT 1039 RLA ;SHIFT (TEST MANTISSA SIGN) 1040 LD (HL),' ' ;DEFAULT POSITIVE 1041 JP NC,FOUT1 ;BRIF POSITIVE 1042 LD (HL),'-' ;MOVE DASH 1043FOUT1 INC DE ;POINT TO FIRST & SECOND DIGITS 1044 INC HL ;AND NEXT OUTPUT POSITION 1045 LD A,(DE) ;PUT TO ACC 1046 CALL RIGHT ;SHIFT RIGHT 1047 OR '0' ;DECIMAL ZONE 1048 LD (HL),A ;PUT OUT 1049 INC HL ;POINT NEXT OUT 1050 LD (HL),'.' ;MOVE DECIMAL POINT 1051 LD B,3 ;INIT LOOP COUNTER 1052 JP FOUT3 ;JUMP INTO MIDDLE OF LOOP 1053FOUT2 INC HL ;POINT NEXT OUT 1054 INC DE ;NEXT 2 DIGITS 1055 LD A,(DE) ;GET HIGH & LOW 1056 CALL RIGHT ;SHIFT RIGHT 1057 OR '0' ;DECIMAL ZONE 1058 LD (HL),A ;PUT TO OUTPUT 1059FOUT3 INC HL ;POINT NEXT OUTPUT 1060 LD A,(DE) ;GET DIGITS AGAIN 1061 AND 0FH ;MASK OFF HIGH 1062 OR '0' ;DECIMAL ZONE 1063 LD (HL),A ;PUT TO OUTPUT 1064 DEC B ;TEST LOOP COUNTER 1065 JP NZ,FOUT2 ;BRIF MORE 1066 INC HL ;POINT NEXT OUTPUT 1067 LD (HL),'E' ;MOVE LIT E 1068 INC HL ;POINT NEXT 1069 LD A,C ;GET EXPONENT BYTE 1070 AND 3FH ;MASK OFF SIGNS 1071 LD B,A ;SAVE IN B 1072 LD A,C ;GET EXPONENT BYTE 1073 RLA ;IGNORE MANTISSA SIGN 1074 RLA ;TEST EXPONENT SIGN 1075 LD (HL),'+' ;DEFAULT POSITIVE 1076 JP NC,FOUT4 ;BRIF POSITIVE 1077 LD (HL),'-' ;ELSE MOVE DASH 1078 LD A,C ;RELOAD EXPONENT BYTE 1079 OR 0C0H ;SET ALL ON 1080 CPL ;COMPLEMENT ACC 1081 INC A ;PLUS 1 (TWOS COMPLEMENT) 1082 LD B,A ;SAVE IN B 1083FOUT4 INC HL ;POINT NEXT OUT 1084 LD A,B ;GET EXPONENT 1085 LD B,2FH ;INIT COUNTER 1086FOUT5 SUB 10 ;SUBTRACT 10 1087 INC B ;COUNT 1 1088 JP NC,FOUT5 ;BRIF NOT NEG 1089 LD (HL),B ;POINT TO OUTPUT 1090 INC HL ;POINT NEXT 1091 ADD A,58 ;ADJUST 1092 LD (HL),A ;MOVE 2ND DIGIT 1093 LD A,C ;GET EXPONENT 1094 RLA ;SHIFT OFF MANTISSA SIGN 1095 OR A ;TEST 1096 JP P,FOUT6 ;BRIF POSITIVE 1097 SCF ;SET CY 1098 RRA ;SHIFT BACK 1099 CP -2 ;TEST FOR MIN 1100 RET C ;RETURN IF LESS THAN -2 1101 JP FOUT7 ;GO AROUND 1102FOUT6 RRA ;SHIFT BACK 1103 CP 6 ;TEST IF TOO BIG 1104 RET NC ;RETURN IF 6 OR GREATER 1105FOUT7 LD C,A ;SAVE EXPONENT 1106 LD B,4 ;CTR 1107FOUT8 LD (HL),' ' ;SPACE OUT EXPONENT 1108 DEC HL ;POINT PRIOR 1109 DEC B ;DECR CTR 1110 JP NZ,FOUT8 ;LOOP 1111 EX DE,HL ;FLIP/FLOP 1112 LD A,E ;GET LOW BYTE 1113 SUB 5 ;POINT TO DOT 1114 LD L,A ;PUT DOWN 1115 LD A,D ;GET HIGH 1116 SBC A,0 ;IN CASE OF BORROW 1117 LD H,A ;PUT DOWN 1118 LD A,C ;GET EXPONENT 1119 OR A ;TEST SIGN 1120 JP Z,FOX1 ;BRIF ZERO 1121 JP M,FOX2 ;BRIF NEGATIVE 1122FOUT9 LD B,(HL) ;GET HIGH BYTE 1123 INC HL ;POINT NEXT 1124 LD A,(HL) ;GET LOW BYTE 1125 LD (HL),B ;SHIFT DOT TO RIGHT 1126 DEC HL ;POINT BACK 1127 LD (HL),A ;MOVE THE DIGIT LEFT 1128 INC HL ;POINT NEXT 1129 DEC C ;DECR CTR 1130 JP NZ,FOUT9 ;LOOP 1131FOX1 EX DE,HL ;POINT END 1132FOX3 LD A,(HL) ;GET A DIGIT/DOT 1133 CP '0' ;TEST FOR A TRAILING ZERO 1134 JP NZ,FOX4 ;BRIF NOT 1135 LD (HL),' ' ;SPACE FILL 1136 DEC HL ;POINT PRIOR 1137 JP FOX3 ;LOOP 1138FOX4 CP '.' ;TEST FOR TRAILING DOT 1139 RET NZ ;RETURN IF NOT 1140 LD (HL),' ' ;SPACE IT OUT 1141 DEC HL ;POINT PRIOR 1142 RET ;RETURN 1143FOX2 CP 0FFH ;TEST IF -1 1144 JP NZ,FOX5 ;ELSE -2 1145 DEC HL ;POINT SIGNIFICANT 1146 LD A,(HL) ;GET THE CHAR 1147 LD (HL),'.' ;MOVE THE DOT 1148 INC HL ;POINT NEXT 1149 LD (HL),A ;SHIFT THE DIGIT 1150 JP FOX1 ;GO ZERO SUPPRESS 1151FOX5 DEC HL ;POINT ONE TO LEFT 1152 LD A,(HL) ;PICK UP DIGIT 1153 LD (HL),'0' ;REPLACE 1154 INC HL ;POINT RIGHT 1155 LD (HL),A ;PUT THE DIGIT 1156 LD H,D ;GET LOW ADDR 1157 LD L,E ;POINT LAST DIGIT 1158 LD B,6 ;CTR 1159FOX6 DEC HL ;POINT PRIOR 1160 LD A,(HL) ;GET A DIGIT 1161 INC HL ;POINT 1162 LD (HL),A ;PUT IT ONE TO RIGHT 1163 DEC HL ;POINT 1164 DEC B ;DECR CTR 1165 JP NZ,FOX6 ;LOOP 1166 LD (HL),'.' ;MOVE THE DOT 1167 JP FOX1 ;CONTINUE 1168*HEADING IMSAI 8080 4K BASIC 1169FADD EQU $ 1170; 1171; 1172;FLOATING POINT ADD THE NUMBER AT (HL) TO THE FACC 1173; 1174; 1175 INC HL ;POINT FIRST DIGIT 1176 LD A,(HL) ;LOAD IT 1177 OR A ;TEST IT 1178 RET Z ;RETURN IF ZERO 1179 DEC HL ;POINT BACK 1180 CALL FTEST ;GO TEST SIGN OF FACC 1181 JP Z,RST5 ;JUST LOAD IF FACC = 0 1182 LD DE,FACC ;POINT FACC 1183 LD A,(DE) ;GET EXPONENT OF FACC 1184 CALL FEXP ;GO GET EXPONENT 1185 LD B,A ;SAVE EXPONENT 1186 LD A,(HL) ;GET EXPONENT OF ADDR 1187 CALL FEXP ;GO GET EXPONENT 1188 LD C,A ;SAVE THE EXPONENT 1189 SUB B ;GET DIFFERENCE OF TWO EXPONENTS 1190 JP Z,FADD4 ;BRIF THEY'RE EQUAL 1191 JP P,FADD3 ;BRIF DIFFERENCE IS POSITIVE 1192 CPL ;COMPLEMENT ACC 1193 INC A ;PLUS ONE (TWO'S COMPLEMENT) 1194FADD3 CP 6 ;COMPARE DIFFERENCE TO SIX 1195 JP C,FADD4 ;BRIF 5 OR LESS 1196 LD A,B ;GET EXPON OF ADDUEND 1197 SUB C ;GET TRUE DIFFERENCE AGAIN 1198 RET P ;RETURN IF FACC > ADDER 1199 JP RST5 ;ELSE, ADDER > FACC 1200FADD4 PUSH AF ;SAVE DIFFERENCE 1201 PUSH BC ;SAVE EXPONENTS 1202 LD DE,FTEMP ;GET ADDR OF TEMP ACC 1203 LD B,4 ;FOUR BYTES 1204 CALL COPYH ;GO COPY 1205 POP BC ;GET EXPONENTS 1206 POP AF ;GET DIFFERENCE 1207 JP Z,FADD9 ;JUST ADD IF ZERO 1208 LD HL,FTEMP+1 ;DEFAULT 1209 PUSH AF ;SAVE DIFFERENCE 1210 LD A,B ;GET FACC EXPON 1211 SUB C ;MINUS FTEMP EXPON 1212 JP P,FADD6 ;BRIF TEMP MUST BE SHIFTED 1213 LD HL,FACC ;POINT FLOAT ACC 1214 LD A,C ;GET EXPONENT, SIGN 1215 AND 7FH ;STRIP EXP SIGN 1216 LD C,A ;PUT BACK 1217 LD A,(HL) ;GET THE EXP 1218 AND 80H ;STRIP OFF OLD EXPON 1219 OR C ;MOVE ADDER EXPON TO IT 1220 LD (HL),A ;REPLACE 1221 INC HL ;POINT FIRST DATA BYTE 1222FADD6 POP AF ;GET DIFFER 1223 LD C,A ;SAVE IT 1224FADD7 LD B,3 ;LOOP CTR (INNER) 1225 LD D,0 ;INIT CARRY OVER TO ZERO 1226 PUSH HL ;SAVE ADDR 1227 CALL FSHFT ;GO SHIFT 1228 POP HL ;GET ADDR 1229 DEC C ;DECR CTR 1230 JP NZ,FADD7 ;LOOP 1231FADD9 EQU $ 1232 LD DE,FACC ;POINT SIGN OF ADDUEND 1233 LD HL,FTEMP ;AND SIGN OF ADDER 1234 LD A,(DE) ;GET SIGN OF ADDUEND 1235 XOR (HL) ;COMPARE THE TWO SIGNS 1236 JP M,FADD1 ;BRIF SIGNS DIFFER 1237 LD DE,FACC+3 ;POINT LOW END 1238 LD HL,FTEMP+3 ;DITTO 1239 LD B,3 ;THREE BYTES 1240 CALL FADDT ;GO ADD TWO TOGETHER 1241 RET NC ;RETURN IF NO CARRY 1242FADX1 LD HL,FACC ;GET ADDR OF ACC 1243 LD A,(HL) ;LOAD THE EXPON 1244 AND 80H ;ISOLATE SIGN 1245 LD B,A ;SAVE SIGN 1246 LD A,(HL) ;GET EXPON 1247 CALL FEXP ;GO GET EXPONENT 1248 INC A ;ADD ONE 1249 AND 7FH ;ISOLATE 1250 OR B ;PUT BACK SIGN 1251 LD (HL),A ;PUT IT DOWN 1252 INC HL ;POINT DATA 1253 LD D,10H ;(THE CARRY) 1254 LD B,3 ;CTR 1255 CALL FSHFT ;GO SHIFT IT 1256 RET ;RETURN 1257FADD1 EQU $ 1258 LD HL,FTEMP+4 ;POINT TEMP2 AREA 1259 LD B,4 ;PREPARE TO SAVE ACC 1260 CALL COPYD ;GO COPY 1261FADX2 LD DE,FACC+3 ;POINT LOW ACC 1262 LD HL,FTEMP+3 ;AND LOW TEMP 1263 LD B,3 ;CTR 1264 CALL FSUBT ;GO SUBTRACT THE TWO 1265 JP NC,FNORM ;BRIF NO BORROW 1266 LD DE,FACC ;POINT ACC 1267 LD HL,FTEMP ;POINT TEMP 1268 LD B,8 ;CTR 1269 CALL COPYH ;GO COPY 1270 LD DE,FACC ;POINT 1271 LD HL,FTEMP ;TEMP 1272 LD A,(HL) ;GET ORIG ACC EXPONENT 1273 XOR 80H ;REVERSE SIGN 1274 LD (DE),A ;PUT TO NEW ACC 1275 JP FADX2 ;GO SUBTRACT AGAIN 1276*HEADING IMSAI 8080 4K BASIC 1277FNORM EQU $ 1278; 1279; 1280;NORMALIZE THE FLOATING ACCUMULATOR 1281;THAT IS, THE FIRST DIGIT MUST BE SIGNIFICANT 1282; 1283; 1284 LD HL,FACC+1 ;POINT TO FIRST BYTE 1285 LD A,(HL) ;LOAD IT 1286 AND 0F0H ;ISOLATE 1287 RET NZ ;RETURN IF ALREADY NORMALIZED 1288 LD A,(HL) ;GET THE BYTE 1289 INC HL ;POINT NEXT 1290 OR (HL) ;OR THE NEXT BYTE 1291 INC HL ;POINT LAST 1292 OR (HL) ;OR THAT BYTE (ACC HAS LOGICAL S 1293 JP NZ,FNOR1 ;BRIF NOT ZERO 1294 LD HL,FACC ;ELSE POINT FLOAT ACC 1295 LD (HL),0 ;CLEAR THE EXPONENT 1296 RET ;RETURN 1297FNOR1 LD HL,FACC+3 ;POINT LST BYTE 1298 LD B,3 ;3 BYTE LOOP 1299 LD D,0 ;INIT CARRY OVER 1300FNOR2 LD A,(HL) ;GET A BYTE 1301 LD C,A ;SAVE IT 1302 RST RST4 ;SHIFT LEFT 4 BITS 1303 OR D ;PLUS PREV SHIFT OUT 1304 LD (HL),A ;PUT BACK 1305 LD A,C ;GET SAVED BYTE 1306 CALL RIGHT ;SHIFT RIGHT 4 BITS 1307 LD D,A ;SAVE FOR NEXT TIME 1308 DEC HL ;POINT NEXT BYTE 1309 DEC B ;DECR CTR 1310 JP NZ,FNOR2 ;LOOP 1311 LD A,(HL) ;GET EXPONENT 1312 AND 80H ;ISOLATE SIGN 1313 LD B,A ;SAVE 1314 LD A,(HL) ;GET AGAIN 1315 CALL FEXP ;GO GET EXPONENT 1316 DEC A ;MINUS ONE 1317 AND 7FH ;TURN OFF HIGH BIT 1318 OR B ;PLUS SAVED SIGN 1319 LD (HL),A ;PUT BACK 1320 JP FNORM ;GO NORMALIZE 1321*HEADING IMSAI 8080 4K BASIC 1322FSUB EQU $ 1323; 1324; 1325;FLOATING POINT SUBTRACT THE NUMBER AT (HL) FROM THE FACC 1326; 1327; 1328 INC HL ;POINT FIRST DATA BYTE OF SUBTRA 1329 LD A,(HL) ;LOAD IT 1330 OR A ;TEST 1331 RET Z ;RETURN IF ZERO 1332 DEC HL ;POINT BACK 1333 LD DE,FTEMP ;GET TEMPORARY STORAGE AREA 1334 LD B,4 ;FOUR BYTES 1335 CALL COPYH ;GO COPY 1336 LD HL,FTEMP ;POINT NEW AREA 1337 LD A,(HL) ;GET EXPONENT 1338 XOR 80H ;REVERSE SIGN 1339 LD (HL),A ;REPLACE 1340 JP FADD ;GO ADD THE TWO 1341*HEADING IMSAI 8080 4K BASIC 1342FMUL EQU $ 1343; 1344; 1345;FLOATING POINT MULTIPLY THE NUMBER AT (HL) TO THE FACC 1346; 1347; 1348 CALL FTEST ;TEST FACC 1349 RET Z ;RETURN IF ZERO 1350 INC HL ;POINT 1ST DIGIT OF MULTIPLIER 1351 LD A,(HL) ;LOAD IT 1352 DEC HL ;RESTORE 1353 OR A ;TEST IF ZERO 1354 JP Z,RST5 ;GO LOAD TO FACC IF IT IS 1355 LD DE,FACC ;POINT EXP OF FACC 1356 LD A,(DE) ;LOAD EXPONENT 1357 OR A ;TEST IF 10 TO 0 1358 JP NZ,FMUL1 ;BRIF NOT 1359 INC DE ;POINT NEXT 1360 LD A,(DE) ;LOAD IT 1361 CP 10H ;TEST IF 1 1362 JP NZ,FMUL1 ;BRIF NOT 1363 INC DE ;POINT NEXT 1364 LD A,(DE) ;LOAD IT 1365 OR A ;TEST IF ZERO 1366 JP NZ,FMUL1 ;BRIF NOT 1367 INC DE ;POINT NEXT 1368 LD A,(DE) ;LOAD IT 1369 OR A ;TEST IF ZERO 1370 JP Z,RST5 ;GO LOAD IF FACC = 1.00000 1371FMUL1 LD DE,FACC ;POINT EXPONENT 1372 LD A,(DE) ;LOAD IT 1373 CALL FEXP ;GO GET EXPONENT 1374 LD B,A ;SAVE IN B 1375 LD A,(HL) ;GET EXPONENT OF MULTIPLIER 1376 CALL FEXP ;GO GET EXPONENT 1377 SCF ;TURN ON CY 1378 ADC A,B ;ADD EXPONENTS TOGETHER 1379 CALL FOVUN ;GO SEE IF OVERFLOW/UNDERFLOW 1380 AND 7FH ;TURN OFF SIGN 1381 LD B,A ;SAVE 1382 LD A,(DE) ;GET SIGN OF FACC 1383 XOR (HL) ;PRODUCT SIGN IS NEG IF TWO SIGN 1384 AND 80H ;MASK 1385 OR B ;PUT SIGN AND EXPONENT TOGETHER 1386 LD (DE),A ;PUT IN FACC 1387 PUSH HL ;SAVE HL 1388 LD HL,FTEMP ;POINT DIGIT 7 OF RESULT 1389 LD B,6 ;LOOP CTR 1390 CALL ZEROM ;GO ZERO 6 BYTES 1391 LD DE,FACC+1 ;POINT 1ST DIGIT OF ACC 1392 LD B,3 ;LOOP CTR 1393FMUL5 LD A,(DE) ;GET AN ACC DIGIT PAIR 1394 LD (HL),A ;PUT TO TEMP STORAGE 1395 XOR A ;ZERO A 1396 LD (DE),A ;CLEAR ACC 1397 INC DE ;POINT NEXT 1398 INC HL ;DITTO 1399 DEC B ;DECR CTR 1400 JP NZ,FMUL5 ;LOOP 1401 LD C,6 ;OUTER LOOP CTR 1402 POP HL ;GET ADDR OF MULTIPLIER 1403 RST RST7 ;GO BUMP HL 1404 DEFB 3 ;BY THREE 1405FMUL6 LD A,C ;GET CTR 1406 RRA ;TEST IF EVEN/ODD 1407 LD A,(HL) ;GET MULTIPLIER DIGIT PAIR 1408 JP C,FMUL7 ;BRIF LEFT NEEDED 1409 AND 0FH ;MASK 1410 JP FMUL8 ;GO AROUND 1411FMUL7 CALL RIGHT ;SHIFT RIGHT 4 BITS 1412FMUL8 LD B,A ;SAVE DIGIT 1413 PUSH HL ;SAVE ADDRESS 1414 PUSH BC ;SAVE COUNTERS 1415 LD C,B ;SWAP B/C 1416 OR A ;TEST MULTIPLIER 1417 JP Z,FMUX1 ;BRIF ZERO 1418FMUL9 LD DE,FTEMP+2 ;POINT PRODUCT 1419 LD HL,FTEMP+8 ;POINT MULTIPLICAND 1420 LD B,6 ;6 DIGITS PARTICIPATE 1421 CALL FADDT ;GO ADD 1422 DEC C ;DECR OUTER LOOP CTR 1423 JP NZ,FMUL9 ;LOOP 1424FMUX1 LD D,0 ;INIT SHIFT DIGIT 1425 LD B,6 ;LOOP CTR 1426 LD HL,FTEMP+8 ;POINT MULTIPLICAND 1427 CALL FSHFX ;GO SHIFT 1428 POP BC ;RESTORE CTRS 1429 POP HL ;ANDADDRESS 1430 DEC C ;DECR CTR 1431 JP Z,FMUX2 ;GO AROUND IF ZERO 1432 LD A,C ;LOAD THE CTR 1433 RRA ;TEST EVEN/ODD 1434 JP C,FMUL6 ;LOOP IF ODD 1435 DEC HL ;ELSE, POINT NEXT 1436 JP FMUL6 ;LOOP 1437FMUX2 LD HL,FACC+1 ;POINT MSD OF PRODUCT 1438 LD A,(HL) ;GET MSD PAIR 1439 AND 0F0H ;ISOLATE LEFT HALF 1440 JP NZ,FMUX3 ;BRIF NORMALIZED 1441 LD B,5 ;CTR 1442 LD D,H ;COPY HL 1443 LD E,L ;TO DE 1444FMUX4 LD A,(HL) ;GET A PAIR OF DIGITS 1445 RST RST4 ;SHIFT RIGHT TO LEFT 1446 LD C,A ;SAVE DIGIT 1447 INC HL ;POINT NEXT PAIR 1448 LD A,(HL) ;GET NEXT PAIR 1449 CALL RIGHT ;SHIFT LEFT TO RIGHT 1450 OR C ;COMBINE 1451 LD (DE),A ;PUT DOWN 1452 INC DE ;POINT NEXT OUTPUT PAIR 1453 DEC B ;DECR CTR 1454 JP NZ,FMUX4 ;LOOP 1455 LD A,(HL) ;GET LAST PAIR 1456 RST RST4 ;SHIFT LEFT 1457 LD (DE),A ;PUT DOWN 1458 LD A,(FACC) ;GET EXPON & SIGN 1459 LD C,A ;SAVE 1460 AND 80H ;ISOLATE SIGN 1461 LD B,A ;SAVE SIGN 1462 LD A,C ;GET EXPON & SIGN 1463 CALL FEXP ;GO GET EXPON 1464 DEC A ;SUBTRACT ONE 1465 AND 7FH ;STRIP 8TH BIT 1466 OR B ;MERGE IN SIGN BIT 1467 LD (FACC),A ;PUT DOWN 1468 JP FMUX2 ;CONTINUE 1469FMUX3 LD A,(FTEMP) ;GET 1ST DIGIT PAIR FOLLOWING FA 1470 ADD A,50H ;ADD 5 1471 DAA ;ADJUST 1472 JP NC,FNORM ;BRIF 4 OR LESS 1473FROUN LD HL,FACC+3 ;ELSE, POINT LSD OF FACC 1474 LD B,3 ;LOOP CTR 1475 SCF ;TURN ON CY INDICATOR 1476FMUX5 LD A,(HL) ;GET A DIGIT PAIR 1477 ADC A,0 ;ADD THE CARRY 1478 DAA ;ADJUST 1479 LD (HL),A ;PUT BACK 1480 DEC HL ;POINT NEXT 1481 DEC B ;DECR CTR 1482 JP NZ,FMUX5 ;LOOP 1483 JP C,FADX1 ;BRIF CARRY INTO 7 DIGITS 1484 JP FNORM ;GO NORMALIZE 1485*HEADING IMSAI 8080 4K BASIC 1486FDIV EQU $ 1487; 1488; 1489;FLOATING POINT DIVIDE THE NUMBER AT (HL) INTO FACC 1490; 1491; 1492 CALL FTEST ;TEST IF FACC ZERO 1493 RET Z ;RETURN IF ZERO 1494 INC HL ;POINT 1ST DIGIT OF DIVISOR 1495 LD A,(HL) ;LOAD IT 1496 DEC HL ;POINT BACK 1497 OR A ;TEST IF ZERO 1498 JP Z,OVERR ;DIVISION BY ZERO = ERROR 1499 LD A,(HL) ;LOAD EXPONENT OF DIVISOR 1500 CALL FEXP ;GO GET EXPON 1501 LD B,A ;SAVE IT 1502 LD DE,FACC ;POINT EXPONENT OF DIVIDEND 1503 LD A,(DE) ;LOAD IT 1504 CALL FEXP ;GO GET EXPON 1505 SUB B ;SUBTRACT THE TWO EXPONENTS 1506 CALL FOVUN ;GO SAE IF OVERFLOW/UNDERFLOW 1507 AND 7FH ;TRUNCATE TO 7 BITS 1508 LD B,A ;SAVE IT 1509 LD A,(DE) ;GET EXPONENT 1510 XOR (HL) ;IF SIGNS ARE EQUAL, RESULT IS P 1511 AND 80H ;MASK OFF UNUSED BITS 1512 OR B ;CREATE SIGN OF QUOTIENT 1513 LD (DE),A ;PUT TO FACC 1514 PUSH HL ;SAVE ADDR 1515 INC DE ;POINT MSD OF DIVIDEND 1516 LD HL,FTEMP ;POINT TEMPORARY STORAGE 1517 LD (HL),0 ;CLEAR HIGH ORDER POSITION 1518 INC HL ;POINT NEXT 1519 LD B,3 ;LOOP CTR 1520FDIV3 LD A,(DE) ;GET BYTE FROM FACC 1521 LD (HL),A ;PUT TO FTEMP 1522 XOR A ;CLEAR A 1523 LD (DE),A ;ZERO FACC 1524 INC HL ;POINT NEXT 1525 INC DE ;DITTO 1526 DEC B ;DECR CTR 1527 JP NZ,FDIV3 ;LOOP 1528 LD (DIVSW),A ;RESET SWITCH 1529 LD (HL),A ;CLEAR HIGH PAIR OF DIVISOR 1530 POP DE ;GET ADDR 1531 LD B,3 ;LOOP CTR 1532 INC DE ;POINT MSD OF DIVISOR 1533 INC HL ;AND OF DIVIDEND 1534 CALL COPYD ;GO MOVE IT 1535 LD C,6 ;OUTER LOOP CTR 1536FDIV5 LD B,-1 ;INIT CTR 1537FDIV7 LD DE,FTEMP+3 ;POINT DIVIDEND 1538 LD HL,FTEMP+7 ;POINT DIVISOR 1539 PUSH BC ;SAVE BC 1540 LD B,4 ;LOOP CTR 1541 CALL FSUBT ;GO SUBTRACT THE TWO 1542 POP BC ;GET COUNTERS 1543 INC B ;COUNT ONE MORE 1544 JP NC,FDIV7 ;LOOP IF NOT TOO FAR 1545 LD A,(DIVSW) ;GET SWITCH 1546 OR A ;TEST IT 1547 JP NZ,FDIV1 ;BRIF SET 1548 PUSH BC ;SAVE BC 1549 LD C,3 ;THREE BYTE LOOP 1550 LD HL,FACC+3 ;POINT LSD OF QUOTIENT 1551FDIX1 LD A,(HL) ;GET DIGIT PAIR 1552 LD D,A ;SAVE IT 1553 RST RST4 ;SHIFT LEFT 1554 OR B ;MERGE WITH PREV 1555 LD (HL),A ;PUT BACK 1556 LD A,D ;GET SAVED PAIR 1557 CALL RIGHT ;SHIFT RIGHT 1558 LD B,A ;SAVE IT 1559 DEC HL ;POINT NEXT 1560 DEC C ;DECR CTR 1561 JP NZ,FDIX1 ;LOOP 1562 POP BC ;GET CTRS 1563 LD DE,FTEMP+3 ;POINT PREV 1564 LD HL,FTEMP+7 ;POINT DIVISOR 1565 LD B,4 ;LOOP CTR 1566 CALL FADDT ;GO ADD 1567 LD B,4 ;INNER CTR 1568 LD HL,FTEMP+3 ;POINT LSD OF DIVIDEND 1569 LD D,0 ;SAVE DIGIT 1570 CALL FSHFX ;GO SHIFT 1571 DEC C ;DECR OUTER CTR 1572 JP NZ,FDIV5 ;LOOP IF NOT ZERO 1573 LD A,(FACC+1) ;GET MSD OF QUOTIENT 1574 AND 0F0H ;ISOLATE LEFT HALF 1575 JP NZ,FDIX2 ;BRIF NORMALIZED 1576 LD A,(FACC) ;GET EXPON & SIGN 1577 LD B,A ;SAVE 1578 AND 80H ;ISOLATE SIGN 1579 LD C,A ;SAVE 1580 LD A,B ;GET EXPON & SIGN 1581 CALL FEXP ;GO GET EXPONENT 1582 DEC A ;SUBTRACT ONE 1583 AND 7FH ;TRUNCATE 8TH BIT 1584 OR C ;MERGE SIGN BIT 1585 LD (FACC),A ;PUT DOWN 1586 LD C,1 ;NEW LOOP CTR 1587 JP FDIV5 ;ONE MORE TIME 1588FDIX2 LD A,1 ;GET A ONE 1589 LD (DIVSW),A ;SET SWITCH 1590 JP FDIV5 ;GO ONE MORE DIGIT 1591FDIV1 LD A,B ;GET THE EXTRA QUOTIENT DIGIT 1592 CP 5 ;COMPARE TO 5 1593 JP C,FNORM ;BRIF LESS 1594 JP FROUN ;ELSE, GO ROUND IT 1595FOVUN EQU $ ;TEST IF EXPONENT OVERFLOW/UNDER 1596 JP P,FOVUX ;BRIF POSITIVE 1597 CP 0C1H ;TEST FOR UNDERFLOW 1598 RET NC ;RETIFNOT UNDERFLOW 1599 JP OVERR ;ELSE, ERROR 1600FOVUX CP 40H ;TEST IF OVERFLOW 1601 RET C ;RETIF LESS 1602 JP OVERR ;ELSE, OVER/UNDEFLOW 1603*HEADING IMSAI 8080 4K BASIC 1604FTEST EQU $ 1605; 1606;TEST THE SIGN OF THE NUMBER IN THE FACC 1607;RETURN WITH S & Z ZET TO SIGN 1608; 1609 LD A,(FACC+1) ;GET MSD 1610 OR A ;TEST IT 1611 RET Z ;RETURN IF ZERO 1612 LD A,(FACC) ;GET SIGN & EXPON BYTE 1613 OR 7FH ;TEST SIGN BIT ONLY 1614 LD A,(FACC) ;RE-LOAD EXPON BYTE 1615 RET ;THEN RETURN 1616*HEADING IMSAI 8080 4K BASIC 1617FEXP EQU $ 1618; 1619;EXPAND EXPONENT INTO 8 BINARY BITS 1620; 1621 RLA ;DROP MANTISSA SIGN 1622 OR A ;TEST SIGN OF EXPON 1623 JP P,FEXP1 ;BRIF POSITIVE 1624 SCF ;ELSE, TURN ON CY 1625FEXP1 RRA ;SHIFT BACK 1626 RET ;RETURN 1627*HEADING IMSAI 8080 4K BASIC 1628FSUBT EQU $ 1629; 1630;DECIMAL SUBTRACT THE TWO 6 DIGIT NUMBERS (DE) & (HL) 1631; 1632 XOR A ;CLEAR STATUS 1633FSUX1 PUSH BC ;SAVE CTR 1634 LD A,(DE) ;GET ACC DIGIT PAIR 1635 SBC A,(HL) ;SUBTRACT PAIR FROM SUBTRAHEND 1636 PUSH AF ;SAVE A, FLAGS 1637 POP BC ;GET A, FLAGS IN BC 1638 LD A,C ;GET FLAGS 1639 AND 10H ;TEST AC STATUS 1640 JP NZ,FSUX2 ;BRIF SET 1641 LD A,B ;GET DIFFERENCE 1642 SUB 06H ;ADJUST RIGHT SIDE 1643 LD B,A ;SAVE 1644FSUX2 LD A,C ;GET FLAGS 1645 RRA ;TEST CY 1646 JP NC,FSUX3 ;BRIF NOT SET 1647 LD A,B ;GET DIFF 1648 SUB 60H ;ADJUST LEFT SIDE 1649 LD B,A ;SAVE 1650FSUX3 PUSH BC ;RESAVE A, FLAGS 1651 POP AF ;RE-LOAD DIFFERENCE, FLAGS 1652 LD (DE),A ;PUT TO ACC 1653 POP BC ;GET BC 1654 DEC DE ;POINT PRIOR 1655 DEC HL ;DITTO 1656 DEC B ;DECR CTR 1657 JP NZ,FSUX1 ;LOOP 1658 RET ;RETURN 1659*HEADING IMSAI 8080 4K BASIC 1660FADDT EQU $ 1661; 1662;ADD TWO DECIMAL NUMBERS (DE) & (HL) 1663; 1664 XOR A ;CLEAR STATUS 1665FADXT LD A,(DE) ;GET PAIR 1666 ADC A,(HL) ;ADD OTHER PAIR 1667 DAA ;ADJUST 1668 LD (DE),A ;PUT DOWN 1669 DEC DE ;POINT NEXT 1670 DEC HL ;DITTO 1671 DEC B ;DECR LOOP CTR 1672 JP NZ,FADXT ;LOOP 1673 RET ;RETURN 1674*HEADING IMSAI 8080 4K BASIC 1675FSHFT EQU $ 1676; 1677;INCREMENTING SHIFT RIGHT 1678; 1679 LD A,(HL) ;GET A BYTE 1680 LD E,A ;SAVE IT 1681 CALL RIGHT ;SHIFT RIGHT 1682 OR D ;PLUS PREV 1683 LD (HL),A ;STORE 1684 LD A,E ;GET PREV 1685 RST RST4 ;SHIFT LEFT 1686 LD D,A ;SAVE FOR NEXT 1687 INC HL ;POINT NEXT 1688 DEC B ;DECR CTR 1689 JP NZ,FSHFT ;LOOP 1690 RET ;RETURN 1691*HEADING IMSAI 8080 4K BASIC 1692FSHFX EQU $ 1693; 1694;DECREMENTING SHIFT RIGHT 1695; 1696 LD A,(HL) ;GET A BYTE 1697 CALL RIGHT ;SHIFT RIGHT 1698 LD E,A ;SAVE IT 1699 LD A,(HL) ;RELOAD 1700 RST RST4 ;SHIFT LEFT 1701 OR D ;MERGE 1702 LD (HL),A ;REPLACE 1703 LD D,E ;UPDATE SAVED 1704 DEC HL ;POINT NEXT 1705 DEC B ;DECR CTR 1706 JP NZ,FSHFX ;LOOP 1707 RET ;RETURN 1708; 1709; 1710*HEADING IMSAI 8080 4K BASIC 1711ABS EQU $ 1712; 1713; 1714;RETURN THE ABSOLUTE VALUE OF THE FLOATING ACCUMULATOR 1715; 1716; 1717 LD A,(FACC) ;GET EXPONENT 1718 AND 7FH ;STRIP NEGATIVE SIGN 1719 LD (FACC),A ;REPLACE 1720 RET ;RETURN 1721*HEADING IMSAI 8080 4K BASIC 1722SGN EQU $ 1723; 1724; 1725;RETURNS THE SIGN OF THE FLOATING ACCUMULATOR 1726;THAT IS: 1727; 1 IF FACC > 0 1728; 0 IF FACC = 0 1729;-1 IF FACC < 0 1730; 1731 CALL FTEST ;GO TEST FACC 1732 RET Z ;RETURN IF ZERO 1733 AND 80H ;ISOLATE IT 1734 PUSH AF ;SAVE IT 1735 LD HL,ONE ;GET ADDRESS OF CONSTANT 1 1736 RST RST5 ;GO LOAD IT 1737 POP AF ;RESTORE SIGN 1738 LD (FACC),A ;SET THE SIGN & EXPONENT 1739 RET ;RETURN 1740*HEADING IMSAI 8080 4K BASIC 1741INT EQU $ 1742; 1743; 1744;RETURNS THE GREATEST INTEGER NOT LARGER THAN THE ABSOLUTE VALUE 1745; 1746; 1747 LD HL,FACC ;POINT FLOAT ACC 1748 LD A,(HL) ;GET EXPONENT 1749 AND 40H ;GET SIGN OF CHARACTERISTIC 1750 JP Z,INT2 ;BRIF GE ZERO 1751 LD B,4 ;FOUR BYTE LOOP 1752 JP ZEROM ;ZERO FACC AND RETURN 1753INT2 LD A,(HL) ;GET EXPONENT 1754 AND 3FH ;ISOLATE CHARACTERISTIC 1755 CP 5 ;TEST FOR FIVE OR LARGER 1756 RET P ;RETURN IF >= 5 1757 LD B,A ;SAVE EXPONENT 1758 LD A,5 ;GET CONSTANT 1759 SUB B ;MINUS EXPONENT = LOOP CTR 1760 LD B,A ;SAVE IT 1761 LD HL,FACC+3 ;POINT LSD 1762INT3 LD A,(HL) ;LOAD A BYTE 1763 AND 0F0H ;DROP RIGHT HALF 1764 LD (HL),A ;PUT BACK 1765 DEC B ;DECR CTR 1766 RET Z ;RETURN IF ZERO 1767 LD (HL),0 ;ZERO LEFT HALF 1768 DEC HL ;POINT NEXT 1769 DEC B ;DECR CTR 1770 JP NZ,INT3 ;LOOP 1771 RET ;CONTINUE EVALUATION 1772*HEADING IMSAI 8080 4K BASIC 1773SQR EQU $ 1774; 1775; 1776;COMPUTE THE SQUARE ROOT OF THE FACC 1777;USES NEWTON'S THIRD ORDER ITERATION 1778; 1779; 1780 CALL FTEST ;GO GET SIGN OF FACC 1781 JP M,OVERR ;BRIF SQUARE ROOT OF NEGATIVE 1782 RET Z ;RETURN IF SQUARE ROOT OF ZERO 1783 LD HL,ORIGS ;POINT TO TEMP AREA 1784 RST RST6 ;SAVE ORIGINAL NUMBER 1785 LD HL,ONE ;POINT CONSTANT 1786 CALL FADD ;ADD ONE 1787 LD HL,TWO ;POINT CONSTANT 1788 CALL FDIV ;DIVIDE BY TWO 1789; 1790;FIRST APPROXIMATION = (X+1)/2 1791; 1792SQRLP LD HL,TSTSQ ;GET ADDR OF TEST 1793 RST RST6 ;SAVE IT 1794 LD HL,TSTSQ ;POINT PREV ITERATION 1795 CALL FMUL ;SQUARE IT 1796 LD HL,TST2S ;POINT SAVE AREA 1797 RST RST6 ;SAVE IT 1798 LD HL,ORIGS ;GET ORIGINAL NUMBER 1799 CALL FSUB ;SUBTRACT FROM PREV**2 1800 CALL FTEST ;GET SIGN OF DIFFERENCE 1801 JP M,SQRGO ;BRIF PREV**2 < ORIGINAL 1802 JP Z,SQRGO ;BRIF PREV**2 = ORIGINAL 1803 LD HL,TST2S ;GET PREV**2 1804 RST RST5 ;GO LOAD IT 1805 LD HL,THREE ;POINT CONSTANT OF 3 1806 CALL FMUL ;MULTIPLY WITH PREV**2 1807 LD HL,ORIGS ;GET ORIGINAL NUMBER 1808 CALL FADD ;GO ADD 1809 LD HL,SQRX ;POINT TEMP AREA 1810 RST RST6 ;SAVE DIVISOR 1811 LD HL,THREE ;POINT CONSTANT OF 3 1812 RST RST5 ;GO LOAD IT 1813 LD HL,ORIGS ;GET ORIGINAL NUMBER 1814 CALL FMUL ;MULTIPLY BY THREE 1815 LD HL,TST2S ;GET SQUARE OF PREV ITERATION 1816 CALL FADD ;GO ADD IT 1817 LD HL,TSTSQ ;GET PREV ITERATION 1818 CALL FMUL ;GO MULTIPLY 1819 LD HL,SQRX ;POINT DIVISOR 1820 CALL FDIV ;GO DIVIDE 1821 LD HL,SQRX ;POINT TEMP AREA 1822 RST RST6 ;SAVE IT 1823 LD HL,TSTSQ ;GET PREV ESTIMATE 1824 CALL FSUB ;GO COMPARE THEM 1825 LD HL,SQRX ;POINT THIS ANSWER 1826 CALL FTEST ;GET SIGN OF DIFFERENCE 1827 JP Z,SQRGX ;BRIF SAME GUESS 1828 RST RST5 ;ELSE, LOAD THIS GUESS 1829;NEXT ITERATION = PREV*(3*X+PREV**2)/(3*PREV**2+X) 1830 JP SQRLP ;LOOP 1831SQRGO LD HL,TSTSQ ;POINT SQUARE ROOT 1832SQRGX RST RST5 ;GO LOAD ACC 1833 RET ;THEN RETURN 1834*HEADING IMSAI 8080 4K BASIC 1835NEG EQU $ 1836; 1837; 1838;REVERSES THE SIGN OF THE FLOATING ACC 1839; 1840; 1841 CALL FTEST ;GET SIGN OF FACC 1842 RET Z ;RETURN IF ZERO 1843 XOR 80H ;REVERSE SIGN 1844 LD (FACC),A ;RESTORE EXPONENT 1845 RET ;CONTINUE EVALUATION 1846*HEADING IMSAI 8080 4K BASIC 1847RND EQU $ 1848; 1849; 1850;PSEUDO RANDOM NUMBER GENERATOR 1851; 1852; 1853 LD HL,RNDNU ;POINT PREV RND 1854 RST RST5 ;LOAD TO FACC 1855 LD HL,RNDX ;POINT MULTIPLIER 1856 CALL FMUL ;GO MULTIPLY 1857 LD HL,FACC ;POINT RESULT 1858 LD (HL),7FH ;DEFAULT . XXXXXX 1859 INC HL ;POINT MSD 1860 LD B,(HL) ;LOAD IT 1861 INC HL ;POINT MSD+2 1862 LD C,(HL) ;LOAD IT 1863 LD (HL),B ;SWAP BYTES 1864 DEC HL ;POINT BACK MSD 1865 LD (HL),C ;MOV MSD+2 1866 CALL FNORM ;GO NORMALIZE 1867 LD HL,RNDNU ;POINT NEW RND NUMBER 1868 RST RST6 ;GO STORE IT 1869 RET ;RETURN 1870*HEADING IMSAI 8080 4K BASIC 1871EXPR EQU $ 1872; 1873; 1874;EVALUATE EXPRESSION ROUTINE 1875;LEAVE RESULT IN FACC 1876;RETURN WHEN EXPRESSION ENDS (TYPICALLY AT END OF LINE) 1877; 1878; 1879 XOR A ;CLEAR REG A 1880 LD (PARCT),A ;SET PAREN CTR 1881 LD (SPCTR),A ;SET STACK CTR 1882 EX DE,HL ;SAVE HL IN DE 1883 LD HL,(PROGE) ;POINT END OF PROGRAM AREA 1884 LD (EXPRS),HL ;SAVE IT 1885 EX DE,HL ;RESTORE HL 1886; 1887LOOKD EQU $ ;LOOK FOR CONSTANT, VARIABLE, OR 1888 CALL NUMER ;GO TEST IF NUMERIC 1889 JP NZ,LDALP ;BRIF NOT 1890LDNUM CALL FIN ;GO CONVERT NUMERIC (PUT TO FACC 1891LDF LD B,H ;COPY HL TO BC 1892 LD C,L ;SAME 1893 LD HL,(EXPRS) ;GET ADDR OF EXPR AREA 1894 CALL GTEMP ;GO STORE THE FACC IN TEMP AREA 1895 LD (EXPRS),HL ;SAVE UPDATED ADDRESS 1896 LD H,B ;RESTORE H 1897 LD L,C ;RESTORE L 1898 JP LOOKO ;GO GET AN OPERATION CODE 1899LDALP CP '.' ;SEE IF LEADING DECIMAL POINT 1900 JP Z,LDNUM ;BRIF IS 1901 CALL ALPHA ;GO SEE IF ALPHA 1902 JP NZ,LDDTN ;BRIF NOT 1903 LD B,(HL) ;SAVE 1ST CHAR 1904 INC HL ;POINT NEXT 1905 LD C,' ' ;DEFAULT FOR 1 CHAR VAR 1906 CALL NUMER ;GO SEE IF 2ND IS NUMERIC 1907 JP NZ,LDFN ;BRIF NOT 1908 INC HL ;POINT NEXT 1909 LD C,A ;SAVE THE CHAR 1910LDVR1 PUSH HL ;SAVE HL 1911 LD D,B ;COPY BC 1912 LD E,C ;TO DE 1913 CALL SEARC ;GO GET VAR ADDR IN DE 1914 LD HL,(EXPRS) ;GET EXPR ADDR 1915 CALL SADR ;GO STORE ADDRESS 1916 LD (EXPRS),HL ;SAVE ADDRESS 1917 POP HL ;RESTORE HL 1918 JP LOOKO ;GO LOOK FOR OPCODE 1919LDFN CALL ALPHA ;GO SEE IF FUNCTION 1920 JP NZ,LDVR1 ;BRIF IT'S NOT 1921LDFN1 DEC HL ;POINT BACK TO 1ST 1922 LD A,(HL) ;GET THAT CHAR 1923 CP ' ' ;TEST IF SPACE 1924 JP Z,LDFN1 ;LOOP IF IS 1925 PUSH HL ;SAVE HL 1926 LD DE,RNDLI ;POINT LITERAL 1927 RST RST2 ;GO COMPARE 1928 JP Z,LDRND ;BRIF RND 1929 POP HL ;GET HL 1930 PUSH HL ;RESAVE IT 1931 LD DE,SQRLI ;POINT LITERAL 1932 RST RST2 ;GO COMPARE 1933 LD BC,SQR ;GET ADDR OF ROUTINE 1934 JP Z,LDFNC ;BRIF IS 1935 POP HL ;GET HL 1936 PUSH HL ;RESAVE 1937 LD DE,INTLI ;POINT 1938 RST RST2 ;GO COMPARE 1939 LD BC,INT ;ROUTINE ADDR 1940 JP Z,LDFNC ;BRIF EQUAL 1941 POP HL ;GET HL 1942 PUSH HL ;SAVE IT 1943 LD DE,ABSLI ;LITERAL 1944 RST RST2 ;COMPARE 1945 LD BC,ABS ;ROUTINE 1946 JP Z,LDFNC ;BRIF EQUAL 1947 POP HL ;GET HL 1948 PUSH HL ;SAVE IT 1949 LD DE,SGNLI ;LITERAL 1950 RST RST2 ;GO COMPARE 1951 LD BC,SGN ;ROUTINE 1952 JP Z,LDFNC ;BRIF EQUAL 1953 POP HL ;GET HL 1954 LD B,(HL) ;GET 1ST CHAR 1955 LD C,' ' ;SPACE 2ND CHAR 1956 INC HL ;POINT NEXT 1957 JP LDVR1 ;BRIF VARIABLE 1958LDRND PUSH HL ;SAVE HL 1959 CALL RND ;GO GET RANDOM NUMBER 1960 POP HL ;RESTORE HL 1961 POP DE ;RESTORE STACK POINTER 1962 JP LDF ;ACT AS IF CONSTANT 1963LDFNC POP DE ;POP THE STACK 1964 EX DE,HL ;FLIP/FLOP 1965 LD HL,(EXPRS) ;GET ADDR 1966 INC HL ;POINT NEXT 1967 LD (HL),B ;HIGH ADDR 1968 INC HL ;POINT NEXT 1969 LD (HL),C ;LOW ADDR 1970 INC HL ;POINT NEXT 1971 LD (HL),1 ;CODE 1972 LD (EXPRS),HL ;SAVE ADDR 1973 EX DE,HL ;RESTORE HL 1974 JP LOOKD ;NEXT MUST BE DATA TOO 1975LDDTN CP '-' ;TEST IF UNARY MINUS 1976 JP NZ,LDDTP ;BRIF NOT 1977 LD BC,NEG ;SET UP CALL 1978 INC HL ;POINT NEXT 1979 PUSH HL ;SAVE HL 1980 JP LDFNC ;GO AS IF FUNCTION 1981LDDTP CP '(' ;TEST IF OPEN PAREN 1982 JP NZ,SNERR ;BRIF NOT CONSTANT, FUNCTION, OR 1983 LD A,(PARCT) ;GET OPEN COUNT 1984 INC A ;ADD ONE 1985 LD (PARCT),A ;STORE IT 1986 EX DE,HL ;SAVE HL 1987 LD HL,(EXPRS) ;GET ADDR 1988 INC HL ;POINT NEXT 1989 LD (HL),'(' ;PUT CODE 1990 LD (EXPRS),HL ;SAVE ADDR 1991 EX DE,HL ;RESTORE HL 1992 INC HL ;POINT NEXT 1993 JP LOOKD ;NEXT HAS TO BE DATA TOO 1994LOOKO RST RST1 ;SKIP BLANKS 1995 CP '+' ;TEST IF PLUS 1996 JP Z,OP1 ;BRIF IS 1997 CP '-' ;TEST IF MINUS 1998 JP Z,OP1 ;BRIF IS 1999 CP '*' ;TEST IF MULTIPLY 2000 JP Z,OP2 ;BRIF IS 2001 CP '/' ;TEST IF DIVIDE 2002 JP Z,OP2 ;BRIF IS 2003 CP ')' ;TEST IF CLOSE PAREN 2004 JP Z,OP3 ;BRIF IS 2005;ELSE MUST BE END OF EXPRESSION 2006 LD A,(PARCT) ;GET OPEN PAREN COUNT 2007 OR A ;TEST IT 2008 JP NZ,SNERR ;BRIF # OF ('S NOT = # OF )'S 2009 LD (ADDR3),HL ;SAVE ADDR OF STMT 2010 JP EVAL ;GO EVALUATE 2011OP1 PUSH HL ;SAVE HL 2012 LD C,(HL) ;SAVE OPERATION 2013 LD B,0 ;INIT CTR 2014 LD HL,(EXPRS) ;GET END POINTER 2015OP1L1 INC B ;COUNT ONE MORE 2016 LD A,(HL) ;LOAD TYPE CODE 2017 CP '(' ;TEST IF OPEN PAREN 2018 JP Z,INSOP ;BRIF IS 2019 OR A ;TEST IF END BUFF 2020 JP Z,INSOP ;BRIF IS 2021 OR A ;TEST IF DATA 2022 JP Z,OP1L2 ;BRIF IS 2023 CP 1 ;TEST IF FUNCT 2024 JP NZ,OP1L3 ;BRIF NOT EQUAL 2025OP1L2 DEC HL ;POINT NEXT 2026 DEC HL ;DITTO 2027 INC B ;COUNT 2028 INC B ;TWO BYTES 2029OP1L3 DEC HL ;POINT NEXT OPCODE 2030 JP OP1L1 ;LOOP 2031INSOP INC HL ;POINT FIRST CHAR 2032 LD A,(HL) ;PICK UP OLD VALUE 2033 LD (HL),C ;PUT PREV 2034 LD C,A ;ROTATE 2035 DEC B ;DECR COUNT 2036 JP NZ,INSOP ;LOOP 2037 LD (EXPRS),HL ;SAVE ADDR 2038 POP HL ;GET STMT POINTER 2039 INC HL ;POINT NEXT 2040 JP LOOKD ;NEXT IS DATA 2041OP2 PUSH HL ;SAV HL 2042 LD C,(HL) ;SAVE OPCODE 2043 LD B,1 ;INIT CTR 2044 LD HL,(EXPRS) ;GET CURRENT END 2045OP2A RST RST7 ;GO BUMP HL 2046 DEFB -3 ;BY NEG THREE 2047 INC B ;ADD 2048 INC B ;THREE 2049 INC B ;TO B 2050 LD A,(HL) ;GET TYPE CODE 2051 CP 1 ;SEE IF FUNCTION 2052 JP Z,OP2A ;BRIF IS 2053 JP INSOP ;GO INSERT OPCODE 2054OP3 LD A,(PARCT) ;GET OPEN PAREN COUNT 2055 DEC A ;SUBTRACT ONE 2056 LD (PARCT),A ;SAVE IT 2057 JP M,SNERR ;BRIF TOO MANY )'S 2058 INC HL ;POINT NEXT SOURCE 2059 LD (ADDR3),HL ;SAVE ADDR 2060EVAL LD HL,(EXPRS) ;GET END OF EXPR 2061EV0 LD BC,0 ;INIT BC TO ZERO 2062EV1 INC B ;COUNT EACH BYTE 2063 LD A,(HL) ;GET CODE IN REG A 2064 DEC HL ;POINT NEXT 2065 CP 0E3H ;TEST IT 2066 JP NZ,EV2 ;BRIF NOT DATA 2067 DEC HL ;POINT NEXT 2068 DEC HL ;DITTO 2069 INC B ;BUMP CTR 2070 INC B ;BY TWO 2071 INC C ;COUNT THE TERM 2072 JP EV1 ;LOOP 2073EV2 CP 1 ;TEST IF FUNCTION 2074 JP NZ,EV5 ;BRIF NOT 2075 INC HL ;RESET TO TYPE CODE 2076 INC HL ;POINT BACK PREV DATA 2077 LD D,(HL) ;MOVE HIGH TO D 2078 INC HL ;POINT ONE MORE 2079 LD E,(HL) ;MOV LOW 2080 PUSH BC ;SAVE CTRS 2081 PUSH HL ;SAVE LOCATION 2082 EX DE,HL ;FLIP/FLOP 2083 RST RST5 ;GO LOAD THE VARIABLE 2084 POP HL ;RESTORE LOCATION 2085 RST RST7 ;GO BUMP HL 2086 DEFB -3 2087 LD E,(HL) ;LOW BYTE 2088 DEC HL ;POINT BACK 2089 LD D,(HL) ;HIGH BYTE 2090 PUSH HL ;SAVE LOCATION 2091 LD HL,EV3 ;GET RETURN ADDRESS 2092 PUSH HL ;SAVE ON STACK 2093 EX DE,HL ;PUT TO HL 2094 JP (HL) ;GO EXECUTE THE FUNCTION 2095EV3 EQU $ ;FUNCTIONS RETURN HERE 2096 POP DE ;GET LOCATION 2097 POP BC ;GET COUNTERS 2098 LD HL,0 ;LOAD ZERO TO HL 2099 PUSH HL ;GET BLOCK OF 2100 PUSH HL ;4 BYTES 2101 LD A,(SPCTR) ;GET TEMP CTR 2102 INC A ;COUNT ONE 2103 LD (SPCTR),A ;SAVE IT 2104 ADD HL,SP ;GET STACK ADDR 2105 PUSH BC ;SAVE CTRS 2106 PUSH DE ;SAVE LOCATION 2107 PUSH HL ;SAVE ADDR 2108 RST RST6 ;GO STORE THE VARIABLE 2109 POP DE ;RESTORE ADDR 2110 POP HL ;RESTORE LOCATION 2111 POP BC ;RESTORE COUNTERS 2112 LD (HL),D ;PUT HIGH ADDR BYTE 2113 INC HL ;POINT NEXT 2114 LD (HL),E ;PUT LOW ADDR BYTE 2115 INC HL ;POINT NEXT 2116 LD (HL),0E3H ;SET CODE = DATA 2117 LD D,H ;COPY 2118 LD E,L ;HL TO DE 2119 DEC B ;SUB 1 FROM BYTE COUNT 2120 INC DE ;POINT 2121 INC DE ;TO 2122 INC DE ;CORRECT 2123 CALL SQUIS ;GO COMPRESS STACK 2124 LD HL,(EXPRS) ;GET ADDR 2125 RST RST7 ;GO DECR HL 2126 DEFB -3 ;BY THREE 2127 LD (EXPRS),HL ;SAVE UPDATED ADDR 2128 JP EVAL ;START AT BEGINNING 2129EV5 CP '(' ;TEST IF OPEN PAREN 2130 JP NZ,EV6 ;BRIF NOT 2131 LD A,C ;GET TERM CT 2132 CP 1 ;TEST IF ONE 2133 JP NZ,STERR ;ERROR IF ONE TERM NOT REMAIN 2134 LD D,H ;COPY HL 2135 LD E,L ;TO DE 2136 INC DE ;POINT SENDING 2137 DEC B ;SUBT ONE FROM COUNT 2138 CALL SQUIS ;GO COMPRESS IT 2139 LD HL,(EXPRS) ;GET POINTER 2140 DEC HL ;LESS ONE 2141 LD (EXPRS),HL ;UPDATE IT 2142 LD HL,(ADDR3) ;RESTORE STMT POINTERS 2143 JP LOOKO ;CONTINUE 2144EV6 OR A ;TEST IF END OF EXPRESSION 2145 JP NZ,EV9 ;BRIF NOT 2146 LD A,C ;GET TERM COUNT 2147 CP 1 ;TEST IF ONE 2148 JP NZ,STERR ;ERROR IF NOT ONE 2149 INC HL ;POINT HIGH ADDR 2150 INC HL ;SAME 2151 LD D,(HL) ;HIGH TO D 2152 INC HL ;POINT LOW 2153 LD E,(HL) ;LOW TO E 2154 EX DE,HL ;PUT DATA ADDRESS IN HL 2155 RST RST5 ;GO LOAD IT 2156 LD HL,(ADDR3) ;RESTORE STMT POINTER 2157 LD A,(SPCTR) ;GET STACK WORD (4BYTE) COUNTER 2158 OR A ;TEST IT 2159 RET Z ;RETURN IF ZERO 2160EV7 POP DE ;RETURN 2 BYTES 2161 POP DE ;RETURN 2 MORE 2162 DEC A ;DECR CTR 2163 JP NZ,EV7 ;LOOP 2164 RET ;RETURN TO STMT PROCESSOR 2165EV9 CP '+' ;TEST IF PLUS 2166 LD DE,FADDJ ;ADDR 2167 JP Z,EV10 ;BRIF IS 2168 CP '-' ;TEST IF MINUS 2169 LD DE,FSUBJ ;ADDR 2170 JP Z,EV10 ;BRIF IS 2171 CP '*' ;TEST IF MUL 2172 LD DE,FMULJ ;ADDR 2173 JP Z,EV10 ;BRIF IS 2174 CP '/' ;TEST IF DIV 2175 LD DE,FDIVJ ;ADDR 2176 JP NZ,STERR ;ERROR IF NOT 2177EV10 INC HL ;POINT TO 2178 INC HL ;1ST DATA 2179 PUSH BC ;SAVE CTRS 2180 PUSH DE ;SAVE ROUTINE ADDR 2181 LD D,(HL) ;HIGH TO D 2182 INC HL ;POINT NEXT 2183 LD E,(HL) ;LOW TO E 2184 PUSH HL ;SAVE POINTER 2185 EX DE,HL ;ADDR TO HL 2186 RST RST5 ;GO LOAD IT 2187 POP HL ;RESTORE HL 2188 INC HL ;POINT 2ND DATA 2189 INC HL ;SAME 2190 LD D,(HL) ;HIGH TO D 2191 INC HL ;POINT NEXT 2192 LD E,(HL) ;LOW TO E 2193 EX (SP),HL ;POP ADDR FROM STACK, PUSH HL ON 2194 JP (HL) ;JUMP TO ROUTINE 2195FADDJ EX DE,HL ;GET HL 2196 CALL FADD ;GO ADD 2197 JP EV11 ;CONTINUE 2198FSUBJ EX DE,HL ;GET HL 2199 CALL FSUB ;GO SUBTRACT 2200 JP EV11 ;CONTINUE 2201FMULJ EX DE,HL ;GET HL 2202 CALL FMUL ;GO MULTIPLY 2203 JP EV11 ;CONTINUE 2204FDIVJ EX DE,HL ;GET HL 2205 CALL FDIV ;GO DIVIDE 2206EV11 POP HL ;GET HL 2207 POP BC ;GET CTRS 2208 RST RST7 ;GO DECR HL 2209 DEFB -6 2210 CALL GTEMP ;GO SAVE FACC 2211 LD D,H ;COPY HL 2212 LD E,L ;TO DE 2213 INC DE ;POSITION 2214 INC DE ;TO 2215 INC DE ;FOUR 2216 INC DE ;BYTES OFFSET 2217 LD A,B ;GET CTR 2218 SUB 3 ;MINUS THREE 2219 LD B,A ;SAVE 2220 CALL SQUIS ;GO COMPRESS 2221 LD HL,(EXPRS) ;GET ADDR 2222 RST RST7 ;GO DECR HL 2223 DEFB -4 ;BY FOUR 2224 LD (EXPRS),HL ;RESTORE 2225 JP EVAL ;CONTINUE 2226; 2227; 2228*HEADING IMSAI 8080 4K BASIC 2229TERMI EQU $ 2230; 2231;READ A LINE FROM THE TTY 2232;FIRST PROMPT WITH THE CHAR IN THE A REG 2233;TERMINATE THE LINE WITH A X'00' 2234;IGNORE EMPTY LINES 2235;CONTROL C WILL CANCEL THE LINE 2236;RUBOUT WILL DELETE THE LAST CHAR INPUT 2237; 2238; 2239 LD (PROMP),A ;SAVE THE PROMPT CHAR 2240 LD A,0FFH ;GET BEGIN MARKER 2241 LD (IOBUF-1),A ;PUT IT 2242REIN LD HL,IOBUF ;POINT TO INPUT BUFFER 2243 LD A,(PROMP) ;GET THE PROMPT AGAIN 2244 OR A ;TEST IT 2245 JP Z,TREAD ;BRIF NULL 2246 CALL TESTO ;GO WRITE IT 2247 LD A,' ' ;GET A SPACE 2248 CALL TESTO ;WRITE SPACE 2249TREAD EQU $ 2250 CALL TESTI ;GO WAIT FOR READY 2251 CALL GETCH ;GO GET THE CHARACTER 2252 LD (HL),A ;PUT IN BUFFER 2253 LD A,(HL) ;RELOAD THE CHAR 2254 CP 0AH ;TEST IF LINE FEED 2255 JP Z,TREAD ;IGNORE IF IT IS 2256 CALL TESTO ;ECHO THE CHARACTER 2257 CP 0DH ;TEST IF CR 2258 JP NZ,NOTCR ;BRIF NOT 2259 CALL CRLF ;GO WRITE CRLF 2260CR1 LD (HL),0 ;MARK END WITH ALL HIGH 2261 DEC HL ;POINT PRIOR 2262 LD A,(HL) ;LOAD IT 2263 CP ' ' ;TEST IF SPACE 2264 JP Z,CR1 ;BRIF SPACE 2265 CP 0FFH ;TEST IF AT BEGINNING 2266 JP Z,REIN ;BRIF IS (NULL LINE) 2267 LD HL,IOBUF ;POINT TO START 2268 RET ;ELSE, RETURN 2269TESTI EQU $ 2270; IN A,(TTY-1) ;GET TERM STATUS 2271; AND 40H ;MASK FOR RXRDY 2272 IN A,(TTY+1) ;**UM** 2273 AND 2 ;**UM** 2274 JP Z,TESTI ;LOOP TILL READY 2275 RET ;RETURN 2276TESTO EQU $ 2277 PUSH AF ;SAVE CHAR TO OUTPUT 2278 LD A,(OUTSW) ;GET OUTPUT SWITCH 2279 OR A ;TEST IF OFF 2280 JP NZ,TOUT2 ;BRIF NOT 2281;TOUT1 IN A,(TTY-1) ;GET STATUS 2282; RLA ;SHIFT LEFT (TEST TXRDY) 2283TOUT1 IN A,(TTY+1) ;**UM** 2284 RRA ;**UM** 2285 JP NC,TOUT1 ;LOOP TILL READY 2286 POP AF ;GET CHAR TO OUTPUT 2287 OUT (TTY),A ;WRITE IT 2288 RET ;RETURN 2289TOUT2 POP AF ;RESTORE CHAR 2290 RET ;RETURN 2291CRLF XOR A ;CLEAR REG A 2292 LD (COLUM),A ;RESET COLUM POINTER 2293 LD A,0DH ;GET CR 2294 CALL TESTO ;WRITE IT 2295 LD A,0AH ;LF 2296 CALL TESTO ;WRITE IT 2297 PUSH BC ;SAVE BC 2298 LD B,2 ;DELAY COUNT 2299DELAY LD A,0FFH ;GET RUBOUT 2300 CALL TESTO ;WRITE IT 2301 DEC B ;DECR LOOP CTR 2302 JP NZ,DELAY ;LOOP 2303 POP BC ;RESTORE BC 2304 RET ;RETURN 2305NOTCR CP 7FH ;TEST IF RUBOUT 2306 JP NZ,NOTBS ;BRIF NOT 2307 DEC HL ;POINT PRIOR 2308 LD A,(HL) ;LOAD PREV CHAR 2309 CP 0FFH ;TEST IF AT BEGIN 2310 JP Z,NOTBS ;BRIF IS 2311 LD A,':' ;BACKSLASH 2312 CALL TESTO ;WRITE IT 2313 LD A,(HL) ;LOAD THE CHAR 2314 CALL TESTO ;WRITE IT 2315 DEC HL ;POINT PRIOR 2316 LD A,':' ;BACKSLASH 2317 CALL TESTO ;WRITE IT 2318NOTBS INC HL ;POINT NEXT BUFFER POSIT 2319 JP TREAD ;LOOP FOR NEXT 2320; 2321; 2322TERMO EQU $ 2323; 2324;TTY PRINT ROUTINE 2325; 2326;OUTPUT STRING OF CHARS STARTING AT IOBUFF THRU END (00 OR 2327;FOLLOWING IMBEDDED CHARACTERS ARE INTERPRETED AS CONTROLS: 2328;X'00' END OF BUFFER, TYPE CR/LF AND RETURN 2329;X'FE' END OF BUFFER, RETURN (NO CR/LF) 2330;X'FD' TYPE CR/LF, CONTINUE 2331; 2332; 2333 LD HL,IOBUF ;GET ADDR OF BUFFER 2334OUT1 LD A,(HL) ;LOAD A BYTE 2335 CP 0FEH ;SEE IF END OF LINE (NO CR/LF) 2336 RET Z ;RETURN IF EQUAL 2337 CP 0FDH ;SEE IF EMBEDDED CR/LF 2338 JP NZ,OUT2 ;BRIF NOT 2339 CALL CRLF ;LINE FEED 2340 JP OUT4 ;CONTINUE 2341OUT2 OR A ;TEST IF END OF OUTPUT 2342 JP Z,CRLF ;BRIF IS 2343 LD A,(HL) ;LOAD THE BYTE 2344 CALL TESTO ;TYPE IT 2345 LD A,(COLUM) ;GET COLUM POINTER 2346 INC A ;ADD ONE 2347 LD (COLUM),A ;RESTORE IT 2348OUT4 INC HL ;POINT NEXT 2349 JP OUT1 ;LOOP 2350; 2351; 2352; 2353LINEO EQU $ 2354; 2355;UNPACK LINE NUMBER FROM (HL) TO (DE) 2356; 2357; 2358 CALL LOUT ;GO FORMAT 2 BYTES 2359LOUT EQU $ 2360 LD A,(HL) ;GET BYTE 2361 CALL RIGHT ;GO SHIFT TO RIGHT 2362 OR 30H ;ZONE 2363 LD (DE),A ;PUT TO BUFFER 2364 INC DE ;POINT NEXT 2365 LD A,(HL) ;LOAD BYTE 2366 AND 0FH ;MASK 2367 OR 30H ;ZONE 2368 LD (DE),A ;PUT TO BUFFER 2369 INC DE ;POINT NEXT 2370 INC HL ;AND NEXT LINE BYTE 2371 RET ;RETURN 2372; 2373; 2374TSTCH EQU $ 2375; 2376;TEST IF INPUT CHAR ON KEYBOARD 2377;IF THERE IS, THEN READ IT 2378;TERMINATE IF CONTROL-C 2379;TOGGLE OUTPUT SW IF CONTROL-O 2380; 2381; IN A,(TTY-1) ;GET STATUS 2382; AND 40H ;MASK FOR RXRDY 2383 IN A,(TTY+1) ;**UM** 2384 AND 2 ;**UM** 2385 RET Z ;RETURN IF NOT 2386GETCH IN A,(TTY) ;ELSE, READ THE CHAR 2387 AND 7FH ;TURN OFF PARITY 2388 CP 0FH ;TEST IF CONTROL-O 2389 JP Z,CONTO ;BRIF IS 2390 CP 03H ;TEST IF CONTROL-C 2391 RET NZ ;RETURN IF NOT 2392 CALL CRLF ;PRINT CR/LF 2393 JP READY ;QUIT WHAT YOU WERE DOING 2394CONTO LD A,(OUTSW) ;GET SWITCH 2395 XOR 01H ;TOGGLE 2396 LD (OUTSW),A ;RESTORE 2397 LD A,0AH ;GET A LF 2398 RET ;RETURN 2399; 2400; 2401ZEROM EQU $ 2402; 2403;MOVE STRING OF ZEROS TO (HL)+... CNT IN B 2404; 2405 LD (HL),0 ;MOVE ONE ZERO 2406 INC HL ;POINT NEXT 2407 DEC B ;DECR CTR 2408 JP NZ,ZEROM ;LOOP 2409 RET ;RETURN 2410; 2411; 2412COPYH EQU $ 2413; 2414;COPY STRING FROM (HL) TO (DE) 2415;COUNT IN B 2416; 2417 LD A,(HL) ;GET A CHAR 2418 LD (DE),A ;PUT IT DOWN 2419 INC HL ;POINT NEXT 2420 INC DE ;DITTO 2421 DEC B ;DECR CTR 2422 JP NZ,COPYH ;LOOP 2423 RET ;RETURN 2424; 2425; 2426COPYD EQU $ 2427; 2428;COPY STRING FROM (DE) TO (HL) 2429;COUNT IN B 2430; 2431 EX DE,HL ;FLIP DE/HL 2432 CALL COPYH ;GO COPY 2433 EX DE,HL ;THEN FLIP BACK 2434 RET ;RETURN 2435; 2436; 2437COMP2 EQU $ 2438; 2439;CONTINUE COMP SUBROUTINE (RST RST2) 2440; 2441 CP (HL) ;COMPARE THE CHAR 2442 RET NZ ;RETURN IF NOT EQUAL 2443 INC DE ;POINT NEXT 2444 INC HL ;DITTO 2445 JP RST2 ;LOOP 2446; 2447; 2448ULERR LD BC,'UL' ;UNDEFINED LINE NUMBER 2449 RST RST3 2450OVERR LD BC,'OV' ;DIV BY ZERO/OVERFLOW/UNDERFLOW 2451 RST RST3 2452STERR LD BC,'ST' ;ERROR IN EXPRESSION STACK 2453 RST RST3 2454SNERR LD BC,'SN' ;SYNTAX ERROR 2455 RST RST3 2456RTERR LD BC,'RT' ;RETURN & NO GOSUB 2457 RST RST3 2458DAERR LD BC,'DA' ;OUT OF DATA 2459 RST RST3 2460FOERR LD BC,'FO' ;MORE THAN 8 NESTED FOR/NEXT OR 2461 RST RST3 2462NXERR LD BC,'NX' ;FOR & NO NEXT / NEXT & NO FOR 2463 RST RST3 2464; 2465; 2466; 2467; 2468PACK EQU $ 2469; 2470;PACK LINE NUMBER FROM (HL) TO BC 2471; 2472; 2473 RST RST1 ;SKIP LEADING SPACES 2474 LD BC,0 ;CLEAR B AND C 2475 LD A,4 ;INIT DIGIT COUNTER 2476 LD (PRSW),A ;SAVE A 2477PK1 LD A,(HL) ;GET CHAR 2478 CALL NUMXR ;TEST FOR NUMERIC 2479 RET NZ ;RETURN IF NOT NUMERIC 2480 AND 0FH ;STRIP OFF ZONE 2481 LD D,A ;SAVE IT 2482 LD A,(PRSW) ;GET COUNT 2483 DEC A ;SUBTRACT ONE 2484 JP M,SNERR ;BRIF MORE THAN 4 DIGITS 2485 LD (PRSW),A ;SAVE CTR 2486 LD E,4 ;4 BIT SHIFT LOOP 2487PK3 LD A,C ;GET LOW BYTE 2488 RLA ;ROTATE LEFT 1 BIT 2489 LD C,A ;REPLACE 2490 LD A,B ;GET HIGH BYTE 2491 RLA ;ROTATE LEFT 1 BIT 2492 LD B,A ;REPLACE 2493 DEC E ;DECR CTR 2494 JP NZ,PK3 ;LOOP 2495 LD A,C ;GET LOW 2496 OR D ;PUT DIGIT IN RIGHT HALF OF BYTE 2497 LD C,A ;REPLACE 2498 INC HL ;POINT NEXT BYTE 2499 JP PK1 ;LOOP 2500; 2501; 2502; 2503SQUIS EQU $ 2504; 2505;COMPRESS THE EXPR STACK 2506;TO ADDR IN HL 2507;FROM ADDR IN DE 2508;COUNT IN B 2509; 2510SQUI2 INC DE ;POINT NEXT SEND 2511 INC HL ;POINT NEXT RECEIVE 2512 LD A,(DE) ;GET A CHAR 2513 LD (HL),A ;PUT IT DOWN 2514 DEC B ;DECR CTR 2515 JP NZ,SQUI2 ;LOOP 2516 RET ;RETURN 2517; 2518; 2519GTEMP EQU $ 2520; 2521;GETS FOUR BYTE TEMPORARY STORAGE AREA, 2522;STORES THE FACC THERE, 2523;PUTS ADDR OF AREA IN EXPR STACK (HL) 2524; 2525 EX DE,HL ;SAVE HL IN DE 2526 EX (SP),HL ;EXCHANGE 0 AND RET ADDR 2527 PUSH HL ;PUT NEW RET ADDR 2528 PUSH HL ;DO IT AGAIN 2529 LD HL,0 ;ZERO HL 2530 ADD HL,SP ;GET SP ADDR IN HL 2531 INC HL ;PLUS ONE 2532 INC HL ;PLUS ONE MORE (POINT TO NEW ARE 2533 PUSH BC ;SAVE CTRS 2534 PUSH DE ;SAVE EXPR ADDR 2535 PUSH HL ;SAVE TEMP ADDR 2536 LD A,(SPCTR) ;GET WORD COUNTER 2537 INC A ;INCR IT 2538 LD (SPCTR),A ;RESTORE IT 2539 RST RST6 ;GO STORE FACC 2540 POP DE ;RESTORE TEMP ADDR 2541 POP HL ;RESTORE EXPR ADDR 2542 POP BC ;RESTORE CTRS 2543SADR INC HL ;POINT NEXT BYTE 2544 LD (HL),D ;HIGH BYTE TO EXPR STACK 2545 INC HL ;POINT NEXT 2546 LD (HL),E ;LOW BYTE TO EXPR STACK 2547 INC HL ;POINT NEXT 2548 LD (HL),0E3H ;CODE = DATA 2549 RET ;RETURN 2550; 2551; 2552ALPHA EQU $ 2553; 2554;TESTS THE CHAR AT (HL) 2555;RETURNS WITH Z SET IF CHAR IS ALPHA (A-Z) 2556;RETURNS WITH Z OFF IF NOT ALPHA 2557;CHAR IS LEFT IN REG A 2558; 2559 RST RST1 ;SKIP LEADING SPACES 2560 CP 'A' ;TEST IF A OR HIGHER 2561 RET C ;RETURN IF NOT ALPHA (Z IS OFF) 2562 CP 'Z'+1 ;TEST IF Z OR LESS 2563 RET NC ;RETURN IF NOT < Z (Z OFF) 2564 CP A ;TURN ON Z 2565 RET ;RETURN 2566; 2567; 2568NUMER EQU $ 2569; 2570;TESTS THE CHAR AT (HL) 2571;RETURNS WITH Z SET IF NUMERIC (0-9) 2572;ELSE, Z IS OFF 2573;CHAR IS LEFT IN THE A REG 2574; 2575 RST RST1 ;SKIP LEADING SPACES 2576NUMXR CP '0' ;TEST IF ZERO OR GREATER 2577 RET C ;RETURN IF LESS THAN ZERO 2578 CP '9'+1 ;TEST IF 9 OR LESS 2579 RET NC ;RETURN IF NOT NUMERIC 2580 CP A ;SET Z 2581 RET ;RETURN 2582; 2583; 2584RIGHT EQU $ 2585; 2586;SHIFT THE LEFTMOST 4 BITS OF REG A RIGHT FOUR BITS 2587; 2588 AND 0F0H ;ISOLATE LEFT 2589 RRA ;SHIFT ONCE 2590 RRA ;AGAIN 2591 RRA ;AGAIN 2592 RRA ;ONE LAST TIME 2593 RET ;RETURN 2594; 2595; 2596SEARC EQU $ 2597; 2598;SEARCES FOR THE VARIABLE IN DE 2599;RETURNS WITH ADDR OF DATA AREA FOR VARIABLE 2600; 2601 PUSH HL ;SAVE HL 2602 LD HL,(DATAB) ;GET ADDR OF DATA POOL 2603 LD BC,-6 ;LENGTH OF EACH ENTRY 2604SCH1 LD A,(HL) ;GET THE BYTE 2605 OR A ;TEST IF END 2606 JP Z,SCH3 ;BRIF END 2607 CP D ;COMPARE 1ST CHAR 2608 JP NZ,SCH2 ;BRIF NOT EQUAL 2609 DEC HL ;POINT NEXT 2610 LD A,(HL) ;LOAD 2ND DIGIT 2611 INC HL ;POINT BACK 2612 CP E ;COMPARE 2ND CHAR 2613 JP NZ,SCH2 ;BRIF NOT EQUAL 2614 ADD HL,BC ;POINT NEXT ENTRY 2615 INC HL ;PLUS ONE 2616 EX DE,HL ;FLIP/FLOP 2617 POP HL ;RESTORE HL 2618 RET ;RETURN 2619SCH2 ADD HL,BC ;MINUS SIX 2620 JP SCH1 ;LOOP 2621SCH3 LD (HL),D ;PUT 1ST CHAR 2622 DEC HL ;POINT NEXT 2623 LD (HL),E ;PUT 2ND CHAR 2624 LD B,4 ;LOOP CTR 2625SCH4 DEC HL ;POINT NEXT 2626 LD (HL),0 ;ZERO THE VALUE 2627 DEC B ;DECR CTR 2628 JP NZ,SCH4 ;LOOP 2629 DEC HL ;POINT NEXT 2630 LD (HL),B ;MOVE ZERO TO NEW END 2631 INC HL ;POINT ADDR OF VARIABLE 2632 EX DE,HL ;PUT LOCATION TO DE 2633 POP HL ;RESTORE HL 2634 RET ;RETURN 2635; 2636; 2637VAR EQU $ 2638; 2639; 2640;TEST (HL) FOR A VARIABLE NAME 2641;PUTS THE NAME IN DE IF FOUND 2642; 2643 CALL ALPHA ;TEST IF ALPHA 2644 JP NZ,SNERR ;BRIF NOT ALPHA 2645 LD D,A ;FIRST CHAR 2646 LD E,' ' ;DEFAULT 2647 INC HL ;POINT NEXT 2648 CALL NUMER ;TEST IF NUMERIC 2649 RET NZ ;RETURN IF NOT NUMERIC 2650 LD E,A ;SAVE 2ND CHAR 2651 INC HL ;POINT NEXT 2652 RST RST1 ;SKIP SPACES 2653 RET ;THEN RETURN 2654; 2655; 2656ERROR EQU $ 2657; 2658;CONTINUE ERROR ROUTINE (RST RST3) 2659; 2660 LD (HL),C ;PUT 2ND CHAR 2661 INC HL ;POINT NEXT 2662 LD (HL),0FEH ;MARK END 2663 CALL TERMO ;GO PRINT IT 2664 LD HL,ERRXR ;POINT MESG 2665 CALL OUT1 ;GO PRINT IT 2666 LD DE,IOBUF ;POINT BUFFER 2667 LD HL,(LINE) ;GET ADDR OF LINE NUMBER 2668 CALL LINEO ;UNPACK LINE NUMBER 2669 XOR A ;GET END CODE 2670 LD (DE),A ;PUT TO BUFFER 2671 CALL TERMO ;PRINT IT 2672 JP GETCM ;GO GET NEXT COMMAND 2673*HEADING IMSAI 8080 4K BASIC 2674LISTL DEFM 'LIS' 2675 DEFB 0 2676NEWLI DEFM 'NEW' 2677 DEFB 0 2678RUNLI DEFM 'RUN' 2679 DEFB 0 2680RNDLI DEFM 'RND' 2681 DEFB 0 2682ABSLI DEFM 'ABS' 2683 DEFB 0 2684SQRLI DEFM 'SQR' 2685 DEFB 0 2686SGNLI DEFM 'SGN' 2687 DEFB 0 2688JMPTB EQU $ 2689IFLIT DEFM 'IF' 2690 DEFB 0 2691 DEFW IF 2692READL DEFM 'READ' 2693 DEFB 0 2694 DEFW READ 2695DATAL DEFM 'DATA' 2696 DEFB 0 2697 DEFW RUN 2698FORLI DEFM 'FOR' 2699 DEFB 0 2700 DEFW FOR 2701NEXTL DEFM 'NEXT' 2702 DEFB 0 2703 DEFW NEXT 2704GOSUX DEFM 'GOSUB' 2705 DEFB 0 2706 DEFW GOSUB 2707RETLI DEFM 'RET' 2708 DEFB 0 2709 DEFW RETUR 2710INPUX DEFM 'INPUT' 2711 DEFB 0 2712 DEFW INPUT 2713PRINX DEFM 'PR' 2714INTLI DEFM 'INT' 2715 DEFB 0 2716 DEFW PRINT 2717 DEFM '?' 2718 DEFB 0 2719 DEFW PRINT 2720GOTOL DEFM 'GO' 2721TOLIT DEFM 'TO' 2722 DEFB 0 2723 DEFW GOTO 2724LETLI DEFM 'LET' 2725 DEFB 0 2726 DEFW LET 2727STOPL DEFM 'STO' 2728 DEFB 0 2729 DEFW READY 2730ENDLI DEFM 'END' 2731 DEFB 0 2732 DEFW RUN 2733REMLI DEFM 'REM' 2734 DEFB 0 2735 DEFW RUN 2736 DEFB 0 ;END OF TABLE 2737STEPL DEFM 'STEP' 2738 DEFB 0 2739THENL DEFM 'THEN' 2740 DEFB 0 2741ERRXR DEFM ' ERR @ ' 2742 DEFB 0FEH 2743ONE DEFW 1000H ;CONSTANT ONE 2744 DEFW 0 2745TWO DEFW 2000H ;CONSTANT TWO 2746 DEFW 0 2747THREE DEFW 3000H ;CONSTANT THREE 2748 DEFW 0 2749RNDX DEFW 837FH ;RANDOMIZER 2750 DEFW 1974H 2751ROMEN EQU $ ;END OF READ-ONLY-MEMORY 2752*HEADING IMSAI 8080 4K BASIC 2753 ORG 1000H ;RAM AREA 2754RAM EQU $ ;ALIGN RAM ON 4K BOUNDARY 2755;TTY EQU 1 ;DEVICE ADDRESS FOR TERMINAL 2756TTY EQU 2 ;**UM** 2757NULLI DEFS 2 2758IOBUF DEFS 40 ;INPUT/OUTPUT BUFFER 2759FACC DEFS 4 2760FTEMP DEFS 10 2761REL DEFS 1 ;HOLDS THE RELATION IN AN IF STMT 2762DIVSW DEFS 1 ;0=NORMAL DIVIDE, 1=DIVIDE FOR R 2763TVAR1 DEFS 4 ;TEMP STORAGE 2764TVAR2 DEFS 4 ;DITTO 2765ORIGS DEFS 4 ;HOLDS ORIG NUMBER FOR SQR 2766TSTSQ DEFS 4 ;HOLDS TRIAL SQUARE ROOT 2767TST2S DEFS 4 ;HOLDS TRIAL SQUARE ROOT ** 2 2768SQRX DEFS 4 ;TEMP STORAGE FOR SQUARE ROOT 2769EXPRS DEFS 2 ;HOLDS ADDR OF EXPR 2770PARCT DEFS 1 2771SPCTR DEFS 1 2772PRSW DEFS 1 2773ADDR1 DEFS 2 ;HOLDS TEMP ADDRESS 2774ADDR2 DEFS 2 ;HOLDS TEMP ADDRESS 2775ADDR3 DEFS 2 ;HOLDS STMT ADDRESS DURING EXPR 2776STMT DEFS 2 ;HOLDS ADDR OF CURRENT STATEMENT 2777INDX DEFS 2 ;HOLDS VARIABLE NAME OF FOR/NEXT 2778OUTSW DEFS 1 ;OUTPUT SUPPRESS IF ON 2779RUNSW DEFS 1 ;0=RUN MODE, 1=IMMEDIATE MODE 2780COLUM DEFS 1 ;CURRENT TTY COLUM 2781RNDNU DEFS 4 2782DASTM DEFS 2 ;HOLDS LINE ADDRESS OF CURRENT D 2783LINE DEFS 2 ;HOLD ADDR OF PREV LINE NUM 2784STACK DEFS 2 ;HOLDS ADDR OF START OF RETURN 2785FORNE DEFS 97 2786PROMP DEFS 1 ;HOLDS PROMPT CHARACTER 2787IMMED DEFS 70 ;IMMEDIATE COMMAND STORAGE AREA 2788DATAP DEFS 2 ;ADDR OF CURRENT DATA STMT 2789DATAB DEFS 2 ;ADDRESS OF DATA POOL 2790PROGE DEFS 2 ;ADDR OF PROG POOL END 2791 DEFS 1 ;THIS HAS LOW VALUE AT RUN TIME 2792BEGPR EQU $ ;PROGRAM AREA STARTS HERE 2793; 2794; 2795 END BASIC 2796