;Edits: ; 30-Jun-08 KJL ; - Created from IMSAI 8K BASIC Version 1.4 manual ;--------------------------------------------------------- ; BASIC30.ASM 1.4 05/19/77 JRB 8K BASIC ; BASICS2.ASM 1.401 05/11/77 DK 8K BASIC ; BASIC19.ASM 1.401 05/11/77 DH ; BASIC18.ASM 1.401 05/10/77 JRB ; BASIC16.ASM 1.401 05/09/77 DH ; BASIC11.ASM 1.401 05/04/77 DH ; BASIC10.ASM 1.401 05/03/77 DH ; BASIC8.ASM 1.401 05/02/77 DH ; ; IMSAI 8K-9K BASIC ; ; COPYRIGHT (C) 1977 ; IMSAI MANUFACTURING CORPORATION ; 14860 WICKS BLVD, SAN LEANDRO CALIFORNIA 94577 ; ; CORRECTION HISTORY: ; ; 02/25/77 - FIXED BEGPR POINTERS ; - FIXED LOG(X) FOR 0.5 < X < 1.0 ; - FIXED SQR(X) FOR 0.0 < X < 0.5 ; - FIXED SCI NOTATION INPUT ROUTINE ; - FIXED EDIT ROUTINE WHEN PROGRAM ENDS ON ; 00 BOUNDARY (SYSTEM USED TO GO AWAY) ; - ADDED XEQ COMMAND (LIKE RUN BUT KEEPS DATA) ; - SOFTWARE MEMORY PROTECT OF 1ST 9K IMPLIMENTED ; - FIXED TAB FOR BACKWARDS MOVEMENT ; - FIXED OV ERROR FOR SMALL X IN TRIG,LOG & EXP ; - ADDED PROGRAM CHAINING CAPABILITY. ; - FIXED EXP(X) ROUTINE FOR LARGE X. ; - ADDED PEEK(X) COMMAND ; - ADDED POKE A,X COMMAND ; - ADDED CALL A COMMAND ; 04/02/77 - ADDED TARBEL CASSETTE SAVE AND LOAD ; - ADDED FIX LINE EDITOR ; - RENAMED NATURAL LOG TO LN(X) ; - ADDED BASE 10 LOG AS LOG(X) ; - ALLOWED FOR DAZZLER IN OUTPUT ROUTINE ; - ADDED LINE # SEARCH UTILITY (LOCAT EQU $) ; - ADDED TABLE SEARCH UTILITY (SEEK EQU $) ; - ARRAYS CAN NOW HAVE > 256 ELEMENTS PER DIM ; 04/09/77 -ADDED CONDITIONAL ASSY PARAMS FOR 8 AND 9K ; -FIXED POWER ERROR. (X^B WHEN B=0 GAVE X^2.) ; -ADDED CONTROL H AS PHYSICAL RUBOUT OF CHAR ; 04/27/77 -CHANGE RST'S TO RUN UNDER CP/M ; -ADDED EXPRESSION EVALUATER FIX ; -LOAD UNDER CP/M ; 05/02/77 -ADD DDT, BYE COMMANDS, BIOS I/O ; 05/03/77 -OPTIMIZE FUNCTION ITERATION LOOP (SIN5) ; -SO UNDERFLOW CAN BE MADE NON-FATAL ; 05/04/77 -OPTIMIZE SIN(X) ROUTINE ; -ADD NON-FATAL ERRORS ; 05/09/77 -SQUISH TO INCLUDE PEEK,POKE,CALL IN 8K ; 05/11/77 -MAKE RND(X) USE X AS RANGE; X^0->1,0^X->0 ; -TAB(N) GO TO NEXT LINE IF PAST POSITION ; 5/12/77 - BUG IN NESTED FOR'S AND REENTERED FOR'S FIXED ; ; ASSEMBLY PARAMETERS: LARGE EQU 0 ;-1=9K ASSEMBLY, 0=8K CPM EQU 0 ;-1=RUN UNDER CPM HUNTER EQU 0 ;-1= INCLUDE BAUD COMMAND ; ; CPM EQUATES ; BOOT EQU 0 ;WARM BOOT BDOS EQU 5 ;BDOS ENTRY TBASE EQU 0100H ;PROGRAM LOAD UNDER CPM CSTAT EQU 3 ;OFFSET OF CONSOLE STATUS ;...QUERY IN BIOS TABLE ; ; BASIC EQUATES ; FATAL EQU 0F7H ;CODE FOR FATAL IS RST 6 ; BASIC: IF NOT CPM ORG 0 LXI H,RAM+1024 MVI A,0AEH ;START OF INIT SEQUENCE JMP INIT1 ;FINISH INIT ENDIF ; IF CPM ORG TBASE JMP INITC ;USE TEMPORARY CODE AT END ENDIF ; ; ORG 8 ; ; SKIP CHARS POINTED BY H,L UNTIL NON-BLANK, ; LEAVE IN REG A ; RST1: MOV A,M ;LOAD THE BYTE AT (H,L) CPI ' ' ;TEST IF BLANK RNZ ;RETURN IF NOT INX H ;POINT NEXT JMP RST1 ;LOOP ; ; ; ORG 16 ; ; COMPARE STRING AT (H,L) TO STRING AT (D,E) ; RETURN IF EQUAL (THRU X'00' IN D,E) OR ON FIRST NOT EQUAL ; ONLY THE FIRST THREE CHARS NEED BE EQUAL ; IGNORE ALL SPACES ; RST2: PUSH B ;SAVE B,C MVI B,0 ;INIT COUNT COMP1: RST 1 ;SKIP SPACES LDAX D ;GET CHAR TO MATCH WITH JMP COMP2 ;CONTINUE ELSEWHERE ; ; ; ORG 24 ; ; STORE THE FLOATING POINT ACCUMULATOR AT (H,L) ; RST3: LXI D,FACC ;POINT FLOAT ACC MVI B,4 ;BYTE COUNT JMP COPYD ;GO MOVE IT ; ; ; ORG 32 ; ; INCREMENT H,L BY BYTE AT (SP), RETURN TO (SP)+1 ; RST4: XTHL ;GET RETURN ADDRESS IN H,L MOV A,M ;GET THE INCREMENT INX H ;POINT TRUE RETURN XTHL ;PUT BACK TO STACK PUSH D ;SAVE D,E JMP RST4A ;CONTINUE ; ; ; ORG 40 ; ; LOAD THE FLOATING POINT ACCUM WITH THE 4 BYTES AT (H,L) ; RST5: LXI D,FACC ;POINT FLOAT ACC MVI B,4 ;BYTE COUNT JMP COPYH ;GO MOVE IT ; ; ; ORG 48 ; ; PRINT: 'XX ERR & NNN' ; **** IF ERROR MESSAGE CHANGES TO A DIFFERENT RST, ; **** ...CHANGE "FATAL" EQUATE ; RST6: XTHL ;SAVE HL, GET ERROR CODE PTR PUSH PSW ;SAVE REGS PUSH D PUSH B JMP ERROR ;CONTINUE ; IF NOT CPM ORG 59 ;LEAVE 3 BYTES FOR DDT ENDIF ; RST4A: MOV E,A ;PUT IN LOW ORA A ;TEST SIGN MVI D,0 ;DEFAULT POSITIVE JP RST4B ;BRIF + MVI D,0FFH ;ELSE, NEG RST4B: DAD D ;BUMP H,L POP D ;RESTORE D,E RET ;RETURN ;PAGE DB 'COPYRIGHT (C) 1977 ' DB 'IMSAI MFG CORP ' DB 'SAN LEANDRO CA 94577 USA' ; ; INITIALIZATION ROUTINE ; DETERMINE MEMORY SIZE. ; (START AT 9K AND TRY 1K INCREMENTS TILL END) ; SETUP POINTERS FOR STACK, DATA, AND PROGRAM ; INIT SIO BOARD ; INIT1: IF NOT CPM OUT TTY+1 ;INIT TERMINAL MVI A,40H OUT TTY+1 MVI A,0BAH OUT TTY+1 MVI A,37H OUT TTY+1 LXI B,1024 ;1K INCR INIT2: MOV A,M ;GET A BYTE FROM MEMORY CMA ;COMPLEMENT MOV M,A ;REPLACE CMP M ;TEST IF RAM/ROM/END JNZ INIT3 ;BRIF OUT OF RAM CMA ;RE-COMPLEMENT MOV M,A ;PUT ORIG BACK DAD B ;POINT NEXT BLOCK JNC INIT2 ;LOOP ENDIF ; INIT3: SPHL ;SET STACK POINTER TO END OF MEMORY LXI B,-256 ;ALLOW 256 BYTES FOR STACK DAD B ;ADD TO ADDRESS SHLD DATAB ;SAVE ADDR OF START OF DATA ; ; SOFTWARE WRITE PROTECT OF FIRST 9K OF RAM. ; ; BUT NO PROTECT UNDER CPM OR FOR 8K (EPROM) VERSION IF LARGE AND NOT CPM MVI A,2 ;SET PROTECT OF FIRST 1K BLOCK PROTC: OUT 0FEH ;SEND IT ADI 4 ;ADDRESS NEXT 1K BLOCK CPI 26H ;STOP AFTER 9 BLOCKS JNZ PROTC ;CONTINUE TO PROTECT ENDIF XRA A ;GET A ZERO IN A PUSH PSW ;SET STACK 1 LEVEL DEEP WITHOUT A GOSUB LXI H,0 ;CLEAR H,L DAD SP ;SP TO H,L SHLD STACK ;SAVE BEG OF STACK CALL IRAM ;INIT RAM LXI D,NRNDX ;POINT TO RANDOM # SERIES MVI B,8 ;LOAD COUNT CALL COPYD ;COPY TO TRND IN RAM TABLE MVI M,2 ;SET RANDOM SWITCH IF CPM CALL NEW0 ;AUTOMATIC "NEW" ENDIF LXI H,VERS ;POINT VERSION MESSAGE RDYM: CALL TERMM ;WRITE IT ; RDY EQU $ ; ; PRINT 'READY' ; LXI H,READY ;POINT READY MSG CALL TERMM ;GO PRINT IT ; GETCM EQU $ ; ; ; COMMAND INPUT ROUTINE ; ; READ A LINE FROM THE TTY ; IF STARTS WITH NUMERIC CH, ASSUME IT'S A BASIC STATEMENT ; IF NOT, IT IS EITHER AN IMMEDIATE STATMENT, OR A COMMAND ; MVI A,':' ;PROMPT & ON SET FOR SW STA EDSW ;SET MODE=EDIT LHLD STACK ;GET STACK ADDRESS SPHL ;SET REG SP CALL TERMI ;GET A LINE CALL PACK ;GO PACK THE NUMBER INTO B,C MOV A,B ;GET HI BYTE OF LINE NUMBER ORA C ;PLUS LOW BYTE JZ EXEC ;BRIF EXEC STATEMENT PUSH B ;SAVE LINE NUMBER LXI D,IMMED+1 ;POINT SAVE AREA XCHG ;FLIP/FLOP MOV M,B ;PUT LO LINE INX H ;POINT NEXT MOV M,C ;PUT LO LINE INX H ;POINT NEXT MVI B,3 ;INIT COUNT EDIT1: LDAX D ;GET A BYTE MOV M,A ;PUT IT DOWN INR B ;COUNT IT INX H ;POINT NEXT INX D ;DITTO ORA A ;TEST BYTE JUST MOVED JNZ EDIT1 ;LOOP MOV A,B ;GET COUNT STA IMMED ;STORE THE COUNT POP B ;GET LINE NUM CALL LOCAT ;GO FIND REQUESTED LINE NUMBER PUSH H ;SAVE H,L JC EDIT5 ;BRIF IF LINE NOT FOUND EDIT2: MOV D,H ;COPY ADDR MOV E,L ;TO D,E MVI B,0 ;GET A ZERO MOV C,M ;GET LEN DAD B ;POINT NEXT STMT EDIT3: MOV A,M ;GET LEN NEXT STMT ORA A ;TEST IT JZ EDIT8 ;BRIF END MOV B,A ;SET LENGTH CALL COPYH ;ELSE MOVE LINE JMP EDIT3 ;LOOP EDIT8: XCHG ;PUT NEW ADDR TO H,L MOV M,A ;MARK END SHLD PROGE ;AND UPDATE ADDRESS EDIT5: LDA IMMED ;GET LEN OF INSERT CPI 4 ;TEST IF DELETE JZ GETCM ;BRIF IS MOV C,A ;SET LO LEN MVI B,0 ;ZERO HI LEN LHLD PROGE ;GET END OF PROG MOV D,H ;COPY TO MOV E,L ;D,E DAD B ;DISP LEN OF INSERT SHLD PROGE ;UPDATE END POINT POP B ;GET ADDR EDIT6: LDAX D ;GET A BYTE MOV M,A ;COPY IT DCX D ;POINT PRIOR DCX H ;DITTO MOV A,D ;GET HI ADDR CMP B ;COMPARE JZ EDIT7 ;BRIF HI EQUAL JNC EDIT6 ;BRIF NOT LESS EDIT7: MOV A,E ;GET LO ADDR CMP C ;COMPARE JNC ED7A ;MUST TEST FOR 00 BOUNDARY JMP ED7B ;GO AROUND BOUNDARY TEST CODE ED7A: CMA ;COMPLIMENT LOW LINE NUMBER CMP C ;AND COMPARE TO START JNZ EDIT6 ;BRIF NOT = ORA A ;NOT TEST FOR 00 JNZ EDIT6 ;THIS IS USUAL CASE ED7B: INX D ;POINT FORWARD LXI H,IMMED ;POINT INSERT MOV B,M ;GET LENGTH CALL COPYH ;GO MOVE IT JMP GETCM ;GO GET ANOTHER COMMAND ; ; IRAM INITIALIZE RAM ; ZEROES RAM FROM BZERO TO EZERO ; INITS RANDOM # CONSTANTS ; RETURNS H=PTR TO TRND ; IRAM: LXI H,BZERO ;CLEAR BZERO->EZERO MVI B,EZERO-BZERO CALL ZEROM LXI D,NRNDX ;MOVE RANDOM # SERIES TO RNDX LXI H,RNDX MVI B,8 ;COUNT JMP COPYD ;MOVE IT & RETURN ;PAGE EXEC EQU $ ; ; ; DECODE COMMAND IN IOBUFF ; EXECUTE IF POSSIBLE ; THEN GOTO GET NEXT COMMAND ; ; STA MULTI ;RESET MULTI SW STA FNMOD ;RESET FN TYPE INR A ;GET A ONE STA RUNSW ;SET IMMEDIATE MODE LXI H,IOBUF+1 ;POINT SMT LXI D,IMMED ;POINT NEW AREA EXEC1: MOV A,M ;GET A BYTE STAX D ;PUT TO (D,L) INX D ;POINT NEXT INX H ;DITTO ORA A ;TEST BYTE JNZ EXEC1 ;CONTINUE LXI H,NULLI ;POINT NO LINE NUM SHLD LINE ;SAVE ADDR LXI H,IMMED ;POINT START OF CMMD JMP RUN3 ;GO INTO RUN PROCESSOR ; NEW EQU $ ; ; NEW COMMAND ; 'NEW'==>CLEAR PROGRAM AND DATA ; 'NEW*'==>CLEAR PROGRAM ONLY ; PUSH H ;SAE PTR LXI H,GETCM ;MAKE SUBROUTINE XTHL ;RESTORE H RST 1 ;GET 1ST NON-BLANK CHAR AFTER 'NEW' SBI '*' ;TEST JZ NEW1 ;BRIF PROGRAM CLEAR ONLY NEW0: XRA A ;GET A ZERO LHLD DATAB ;POINT DATA AREA MOV M,A ;CLEAR IT NEW1: LXI H,BEGPR ;POINT START SHLD PROGE ;RESET PROGRAM END MOV M,A ;CLEAR IT RET ; FREE EQU $ ; ; FREE COMMAND ; COMPUTE AMOUNT OF AVAILABLE STORAGE (EXCLUDING DATA AREA) ; LHLD DATAB ;GET DATA BEG ADDRESS XCHG ;PUT IN D,E LHLD PROGE ;GET PROGRAM END ADDRESS MOV A,E ;LO ADDR TO REG A SUB L ;SUBTRACT MOV E,A ;SAVE IT MOV A,D ;HI ADDR TO REG A SBB H ;SUBTRACT MOV D,A ;SAVE IT CALL BINFL ;GO FLOAT D,E LXI H,IOBUF ;POINT BUFFER CALL FOUT ;GO CONVERT TO OUTPUT MVI M,0 ;MARK END CALL TERMO ;GO WRITE IT JMP GETCM ;CONTINUE ; TAPE EQU $ ; ; TAPE COMMAND. DON'T ECHO INPUT. CONTINUE UNTIL KEY ; COMMAND. ; MVI A,1 ;SET TAPE INPUT SWITCH STA TAPES ;STORE IT MVI A,11H ;GET DC1 (=READER ON) CALL TESTO ;WRITE IT JMP GETCM ;GO PROCESS INPUT ; ENDIT EQU $ ; ; END COMMAND. IF TAPE PUNCH SWITCH IS ON, PUNCH 'KEY' THEN ; CONTINUE ; LDA TAPES ;GET PAPER TAPE SWITCH CPI 2 ;TEST FOR SAVE JNZ RDY ;BRIF NOT LXI H,KEYL ;POINT 'KEY' CALL TERMM ;WRITE IT CALL HDRTL ;GO PUT TRAILER ; ; KEY COMMAND. RESET TAPE SWITCH. TURN READER OFF ; KEY: XRA A ;RESET TAPE SWITCH STA TAPES LXI H,PCHOF ;POINT READER/PUNCH OFF JMP RDYM ;PRINT POFF+READY MESSAGE ; HDRTL EQU $ ; ; PUNCH HEADER OR TRAILER ON PAPER TAPE. ; MVI B,25 ;LOAD COUNT HDR1: MVI A,0FFH ;LOAD RUBOUT CALL TESTO ;WRITE IT DCR B ;DECREMENT COUNT XRA A ;ZERO A CMP B ;TEST COUNT RZ ;RETURN ON ZERO JMP HDR1 ;CONTINUE ;PAGE ; ; RUN PROCESSOR, GET NEXT STATMENT, AND EXECUTE IT ; IF IN IMMEDIATE MODE, THEN RETURN TO GETCMMD ; RUNCM: XRA A ;PUT A ZERO TO A LHLD DATAB ;GET ADDRESS OF DATA POOL MOV M,A ;INITIALIZE TO 0 XEQ EQU $ ;START FOR EXECUTION WITH OLD DATA CALL IRAM ;INITALIZE START OF RAM LXI H,BEGPR-1 ;POINT 1 PRIOR TO BEGIN SHLD DATAP ;RESTORE DATA STMT POINTER MVI M,0 ;RESET DATA STMT POINTER INX H ;POINT TO START SHLD STMT ;SAVE IT JMP RUN2 ;GO PROCESS IT ; ; STATEMENTS RETURN HERE TO CONTINUE PROCESSING RUN: LXI H,MULTI ;POINT MULTIPLE SWITCH MOV A,M ;GET SW ORA A ;TEST IT JZ RUN1 ;BRIF NOT ON MVI M,0 ;ELSE, RESET IT LHLD ENDLI ;GET ADDRESS JMP RUN3 ;GO PROCESS REMAIN RUN1: LHLD STMT ;ELSE, GET ADDR OF PREV STMT MOV E,M ;GET LEN CODE MVI D,0 ;CLEAR HIGH BYTE OF ADDR DAD D ;INCR STMT POINTER SHLD STMT ;SAVE IT RUN2: LDA RUNSW ;GET RUN TYPE ORA A ;TEST IT JNZ GETCM ;BRIF IMMEDIATE MODE MOV A,M ;GET LEN CODE ORA A ;TEST IF END JZ ENDIT ;BRIF IS INX H ;POINT LINE NUMBER SHLD LINE ;SAVE ADDR INX H ;POINT 2ND BYTE INX H ;POINT 1ST PGM BYTE ; ; ENTER HERE TO DO IMMEDIATE COMMAND RUN3: RST 1 ;SKIP BLANKS RUN4: SHLD ADDR1 ;SAVE ADDR CALL TSTCC ;GO SEE IF CONTROL-C OR O LXI D,JMPTB ;POINT TO TABLE CALL SEEK1 ;GO SEARCH COMMAND TABLE JZ RUN7 ;BRIF COMMAND NOT FOUND PUSH H ;SAVE H,L LDAX D ;LOAD LOW BYTE MOV L,A ;LOW BYTE TO L INX D ;POINT NEXT LDAX D ;LOAD HIGH BYTE MOV H,A ;HIGH BYTE TO H XTHL ;COMMAND ADDRESS TO STACK RET ;JUMP TO ROUTINE RUN7: LHLD ADDR1 ;RESTORE H,L POINTER JMP LET ;ASSUME IT'S LET STMT ;PAGE ; ; SAVE COMMAND. TURN THE PUNCH ON THEN LIST PROGRAM ; SAVE: MVI A,2 ;SET PUNCH MODE STA TAPES MVI A,12H ;GET DC2 (=PUNCH ON) CALL TESTO ;WRITE IT CALL HDRTL ;GP PUT HEADER ; LIST EQU $ ; ; ; LIST PROCESSOR ; DUMP THE SOURCE PROGRAM TO TTY OR PAPER TAPE ; ; RST 1 ;SKIP TO NON BLANK LXI D,0 ;GET A ZERO IN D XCHG ;FLIP TO H,L SHLD LINEL ;SAVE IT LXI H,9999H ;GET HIGH NUMBER IN H,L SHLD LINEH ;SAVE IT XCHG ;FLIP BACK ORA A ;TEST IF EOL JZ LIST1 ;BRIF IT IS CALL PACK ;GO PACK THE NUMBER, IF ANY MOV D,B ;COPY NUMBER TO D,L MOV E,C ;SAME XCHG ;FLIP TO H,L SHLD LINEL ;SAVE IT SHLD LINEH ;SAME XCHG ;RESTORE H,L RST 1 ;SKIP TO NON BLANK CPI ',' ;TEST IF COMMA JNZ LIST1 ;BRIF NOT INX H ;POINT NEXT RST 1 ;SKIP TO NON-BLANK CALL PACK ;ELSE, GO GET THE NUMBER MOV H,B ;COPY TO MOV L,C ;D,L SHLD LINEH ;SAVE IT LIST1: LXI H,BEGPR ;POINT BEGINNING OF PROGRAM LIST2: CALL TSTCC ;GO SEE IF CONTROL-C OR CONTROL-O MOV A,M ;GET LEN CODE ORA A ;TEST IF END OF PROGRAM JZ ENDIT ;BRIF END OF PGM SUI 3 ;SUBTRACT THREE MOV B,A ;SAVE LEN INX H ;POINT HIGH BYTE OF LINE# XCHG ;FLIP H,L TO D,E LHLD LINEL ;GET LOW LINE TO TEST XCHG ;RESTORE H,L MOV A,M ;GET LOW BYTE OF LINE NUMBER CMP D ;COMP WITH LINEL JC LIST8 ;BRIF LESS JNZ LIST4 ;BRIF NOT EQUAL INX H ;POINT NEXT MOV A,M ;GET NEXT BYTE OF LINE# DCX H ;POINT BACK CMP E ;COMP LOW BYTES JC LIST8 ;BRIF LESS LIST4: XCHG ;SAVE H,L IN D,E LHLD LINEH ;GET HIGH LINE FOR TEST XCHG ;RESTORE H,L MOV A,M ;GET LINE BYTE CMP D ;COMPARE HIGH BYTES JZ LIST5 ;BRIF EQUAL JNC ENDIT ;BRIF HIGHER JMP LIST6 ;GO AROUND LIST5: INX H ;POINT NEXT MOV A,M ;GET NEXT BYTE DCX H ;POINT BACK CMP E ;COMPARE LOW BYTES JZ LIST6 ;BRIF EQUAL JNC ENDIT ;BRIF HIGHER LIST6: LXI D,IOBUF ;POINT BUFFER AREA CALL LINEO ;CONVERT LINE NUMBER LIST7: MOV A,M ;GET A BYTE STAX D ;PUT IT TO BUFFER INX D ;POINT NEXT BUFF INX H ;POINT NEXT PROG DCR B ;DECR CTR JNZ LIST7 ;LOOP PUSH H ;SAVE HL ADDR CALL TERMO ;GO TYPE IT POP H ;RETRIEVE H ADDR JMP LIST2 ;CONTINUE LIST8: MOV E,B ;PUT LEN IN E MVI D,0 ;CLEAR D DAD D ;POINT NEXT STMT INX H ;POINT NEXT INX H ;POINT LEN CODE JMP LIST2 ;GO LIST IT ; ; CONTI EQU $ ; ; CONTINUE EXECUTION AT STATEMENT FOLLOWING STOP OR AT ; STATEMENT THAT WAS INTERRUPTED WHEN CONTROL-C WAS TYPED ; ; LXI H,LINEN ;POINT LINE NUMBER OF LAST STOP/ERROR/ MOV A,M ;GET 1ST CHAR ORA A ;TEST IF IMMED CMMD JZ LET ;BRIF IF IMMED CMMD ;PAGE ; ; ; STMT: GOTO NNNN ; ; GOTO: XRA A ;CLEAR REG A STA EDSW ;RESET IMMED MODE (IF IT WAS SET) STA RUNSW ;AND RUN TYPE CALL NOTEO ;ERROR IF END-OF-LINE CALL PACK ;GO GET LINE NUMBER IN B,C CALL EOL ;ERROR IF NOT END-OF-LINE GOTO2: CALL LOCAT ;GO SEARCH FOR REQUESTED LINE # JC ULERR ;BRIF NOT FOUND SHLD STMT ;SAVE ADDR XRA A ;GET A ZERO STA MULTI ;TURN OFF MULTIPLE STMTS JMP RUN2 ;GO PROCESS THE STATEMENT ; ; ; STMT: RESTORE ; RESTO: CALL EOL ;ERROR IF NOT END-OF-LINE LXI H,BEGPR-1 ;POINT 1 BEFORE START OF PROGRAM SHLD DATAP ;FORCE NEXT DATA TO BE AT START JMP RUN ;GO NEXT STMT ; ; ; STMT: RETURN ; RETUR: CALL EOL ;ERROR IF NOT END-OF-LINE POP PSW ;POP THE STACK CPI 0FFH ;TEST IF GOSUB IN EFFECT JNZ RTERR ;BRIF ERROR POP H ;GET RETURNED STATMENT ADDRESS SHLD STMT ;RESTORE POP H ;GET ENDLINE VALUE SHLD ENDLI ;RESTORE POP PSW ;GET MULTI SW VALUE STA MULTI ;RESTORE JMP RUN ;CONTINUE (AT STMT FOLLOWING GOSUB) ; ; ; STMT: GOSUB NNNN ; GOSUB: CALL NOTEO ;ERROR IF END-OF-LINE CALL PACK ;GET LINE NUMBER CALL EOL ;ERROR IF NOT END-OF-LINE GOSU1: LDA MULTI ;GET SW SETTING PUSH PSW ;SAVE ON STACK LHLD ENDLI ;GET ADDR OF END OF STMT PUSH H ;SAVE ONE STACK LHLD STMT ;GET STATEMENT ADDRESS PUSH H ;SAVE RETURN ADDRESS IN STACK MVI A,0FFH ;MARK AS GOSUB PUSH PSW ;SAVE STATUS JMP GOTO2 ;GO LOOKUP LINE AND BRANCH ;PAGE ; PRINT EQU $ ; ; ; STMT: PRINT .... ; ; XRA A ;CLEAR REG A PRIN4: STA PRSW ;SET SW TO SAY CRLF AT END OF LINE LXI D,IOBUF ;POINT BUFFER RST 1 ;SKIP TO NEXT FIELD ; CALL TSTEL ;TEST IF END OF STMT JZ PRINC ;BRIF IT IS CPI ',' ;TEST IF COMMA JZ PRIN8 ;BRIF IT IS CPI ';' ;TEST IF SEMI-COLON JZ PRIN9 ;BRIF IT IS PUSH D ;SAVE D,E PUSH H ;SAVE H,L LXI D,TABLI ;POINT LITERAL RST 2 ;GO SEE IF TAB(XX) JZ PRINA ;BRIF IS POP H ;ELSE, RESTORE H,L CALL EXPR ;GO EVALUATE EXPRESSION POP D ;RESTORE D,E PUSH H ;SAVE H,L XCHG ;FLIP/FLOP LDA NS ;GET TYPE OF RESULT CPI 0E7H ;TEST IF STRING JZ PRIN5 ;BRIF IS CALL FOUT ;GO CONVERT OUTPUT INX H ;POINT NEXT PRIN7: XCHG ;FLIP/FLOP: END ADDR TO DE POP H ;RESTORE H,L ;HERE AFTER SETTING UP VALUE TO PRINT IN BUFFER PRIN2: MVI A,0FEH ;SET END CODE=NO CRLF STAX D ;PUT TO BUFFER PUSH H ;SAVE H,L CALL TERMO ;GO PRINT BUFFER POP H ;RESTORE HL JMP PRINT ;REPEAT FOR NEXT FIELD ; PRIN5: LXI D,STRIN ;POINT STRING LDAX D ;GET LEN ORA A ;TEST IT JZ PRIN7 ;BRIF NULL MOV B,A ;SAVE LEN PRIN6: INX D ;POINT NEXT LDAX D ;GET A BYTE MOV M,A ;STORE IT INX H ;POINT NEXT DCR B ;DECR CTR JNZ PRIN6 ;LOOP JMP PRIN7 ;DIDDLE DE, HL AND CONTINUE ; PRIN8: CALL TABST ;GO POSITION NEXT TAB PRIN9: INX H ;PRINT NEXT MVI A,1 ;GET SETTTING FOR SW JMP PRIN4 ;GO STORE A IN PRSW & DO NEXT FIELD PRINA: POP D ;GET RID OF STACK ENTRY CALL EXPR ;GO EVALUATE PUSH H ;SAVE H,L CALL FBIN ;CONVERT TO BINARY PUSH PSW ;SAVE SPECIFIED COLUMN LXI H,COLUM ;POINT CURRENT POSITION SUB M ;SUBTRACT (LEAVES NUMBER OF FILLS) CM CRLF ;NEXT LINE IF ALREADY PAST POP PSW ;RESTORE COL SUB M ;GET NUMBER FILLS POP H POP D MOV B,A ;SAVE COUNT MVI A,' ' ;GET FILL PRINB: JZ PRIN2 ;BRIF COUNT ZERO STAX D ;PUT ONE SPACE INX D ;POINT NEXT DCR B ;DECR CTR JMP PRINB ;LOOP ; PRINC: CALL EOL ;SAVE EOL POSITION ;HERE TO PRINT FINAL CR/LF (OR NOT) AND GO TO NEXT STATEMENT LDA PRSW ;GET SWITCH MOV B,A ;SAVE ,; SWITCH LDA OUTSW ;GET CONTROL-O SWITCH ORA A ;TEST IF ^O IN EFFECT ORA B ;AND IF STATEMENT ENDED IN , OR ; CZ CRLF ;CRLF IF NEITHER JMP RUN ;CONTINUE NEXT STATEMENT ;PAGE ; FOR EQU $ ; ; ; STMT: FOR VAR = EXPR TO EXPR [STEP EXPR] ; ; ; FIRST EVALUATE ARGUMENTS AND STORE POINTERS AND VALUES, ; BUT DO NOT MAKE TABLE ENTRY YET CALL VAR ;NEXT WORD MUST BE VARIABLE XCHG ;FLIP/FLOP SHLD INDX ;SAVE VARIABLE NAME XCHG ;FLIP/FLOP AGAIN CPI '=' ;TEST FOR EQUAL SIGN JNZ SNERR ;BRIF NO EQUAL INX H ;POINT NEXT CALL EXPR ;GO EVALUATE EXPR, IF ANY XCHG ;FLIP/FLOP AGAIN LHLD INDX ;GET INDEX NAME XCHG ;FLIP/FLOP PUSH H ;SAVE H,L CALL SEARC ;GO LOCATE NAME XCHG ;PUT ADDR IN H,L SHLD ADDR1 ;SAVE ADDR RST 3 ;GO STORE THE VALUE POP H ;RESTORE POINTER TO STMT LXI D,TOLIT ;GET LIT ADDR RST 2 ;GO COMPARE JNZ SNERR ;BRIF ERROR CALL EXPR ;GO EVALUATE TO-EXPR PUSH H ;SAVE H,L LXI H,TVAR1 ;POINT 'TO' VALUE RST 3 ;SAVE IT LXI H,ONE ;POINT CONSTANT: 1 RST 5 ;LOAD IT POP H ;GET H,L MOV A,M ;GET THE CHAR ORA A ;TEST FOR END OF STATEMENT JZ FOR2 ;BRIF NO STEP PUSH H ;RE-SAVE LXI D,STEPL ;TEST FOR LIT 'STEP' RST 2 ;GO COMPARE JZ FOR1 ;BRIF STEP POP H ;RESTORE H,L JMP FOR2 ;GO NO STEP VALUE FOR1: POP D ;POP OFF THE STACK CALL EXPR ;GO EVALUATE EXPRESSION FOR2: PUSH H ;SAVE H,L TO END OF STATEMENT LXI H,TVAR2 ;POINT STEP VALUE RST 3 ;SAVE IT POP H ;RESTORE H,L CALL EOL ;ERROR IF NOT END-OF-LINE ; DETERMINE WHETHER LOOP IS TO BE EXECUTED AT ALL ; (IF VALUE > "TO" VALUE AND STEP POSITIVE, ; JUST SKIP TO NEXT, ETC) CALL FTEST ;GET STATUS OF FACC PUSH PSW ;SAVE A,STATUS LXI H,TVAR1 ;GET END VALUE RST 5 ;LOAD IT POP PSW ;RESTORE STATUS JP FOR4 ;BRIF FOR IS POSITIVE LHLD ADDR1 ;GET ADDRESS OF INDEX CALL FSUB ;COMPARE THIS AGAINST END VALUE JZ FOR5 ;BRIF START = END JM FOR5 ;BRIF START > END JMP FOR9 ;GO LOCATE MATCHING NEXT FOR4: LHLD ADDR1 ;GET ADDRESS OF INDEX CALL FSUB ;COMPARE JZ FOR5 ;BRIF START = END JM FOR9 ;BRIF START > END: SKIP TO "NEXT" ; LOOP IS TO BE EXECUTED AT LEAST ONCE: ; NEED AN ENTRY IN FOR-NEXT TABLE. ; SEE IF THERE IS ALREADY ENTRY FOR THIS VARIABLE ; (IE PROGRAM JUMPED OUT OF LOOP EARLIER) FOR5: LXI D,FORNE ;POINT TABLE LHLD INDX ;GET INDEX VARIABLE NAME XCHG ;FLIP/FLOP MOV A,M ;GET COUNT OF ENTRIES NOW IN TABLE MOV B,A ;STORE IT MVI C,1 ;NEW CTR ORA A ;TEST IF ZERO INX H ;POINT JZ FOR8 ;BRIF TABLE EMPTY FOR6: MOV A,M ;GET 1ST BYTE OF TABLE VARIABLE CMP D ;TEST IF EQUAL TO THIS FOR'S INDEX JNZ FOR7 ;BRIF NOT INX H ;POINT NEXT MOV A,M ;GET NEXT BYTE DCX H ;POINT BACK CMP E ;TEST IF EQUAL JZ FOR8 ;BRIF EQUAL FOR7: RST 4 ;ADJUST H,L DB 14 INR C ;COUNT IT DCR B ;DECR CTR JNZ FOR6 ;LOOP ; ENTER THIS FOR IN TABLE (WHERE HL POINTS) FOR8: MOV A,C ;GET UDPATE COUNT CPI 9 ;TEST IF TBL EXCEEDED JNC NXERR ;ERROR IF MORE THAN 8 OPEN FOR/NEXT STA FORNE ;PUT IN TABLE MOV M,D ;HI BYTE INDEX VARIABLE NAME INX H ;POINT NEXT MOV M,E ;STORE LO BYTE INX H ;POINT NEXT PUSH H ;SAVE H,L LXI H,TVAR2 ;POINT STEP VALUE RST 5 ;LOAD IT POP H ;RESTORE H,L RST 3 ;STORE IN STACK PUSH H ;SAVE H,L LXI H,TVAR1 ;POINT 'TO' VALUE RST 5 ;LOAD IT POP H ;RESTORE H,L RST 3 ;STORE IN STACK XCHG ;FLIP/FLOP LHLD ENDLI ;GET END ADDR DCX H ;POINT ONE PRIOR XCHG ;FLIP BACK MOV M,D ;STORE IT INX H ;POINT NEXT MOV M,E ;STORE IT INX H ;POINT NEXT LDA STMT+1 ;GET HIGH STMT ADDR MOV M,A ;PUT IT INX H ;POINT NEXT LDA STMT ;GET LOW STMT ADDR MOV M,A ;PUT IT JMP RUN ;CONTINUE ; ; IF HERE, THIS LOOP IS TO BE EXECUTED ZERO TIMES: ; SCAN THRU PROGRAM TO FIND MATCHING "NEXT". ; THIS CODE WILL FAIL IF USER'S PROGRAM IS TOO ; COMPLEX SINCE IT WON'T FOLLOW GOTO'S, IF'S, ETC. FOR9: LHLD STMT ;GET ADDRESS OF STATMENT MOV E,M ;GET LENGTH CODE MVI D,0 ;INIT INCREMENT DAD D ;COMPUTE ADDR OF NEXT STATEMENT MOV A,M ;GET NEW LEN CODE ORA A ;SEE IF END OF PGM JZ NXERR ;BRIF IT IS SHLD STMT ;SAVE ADDRESS RST 4 ;ADJUST H,L DB 3 RST 1 ;SKIP SPACES LXI D,NEXTL ;POINT 'NEXT' RST 2 ;SEE IF IT IS A NEXT STMT JNZ FOR9 ;LOOP IF NOT RST 1 ;SKIP SPACES LDA INDX+1 ;GET FIRST CHAR CMP M ;COMPARE JNZ FOR9 ;BRIF NOT MATCH NEXT LDA INDX ;GET 2ND CHAR INX H ;DITTO CPI ' ' ;SEE IF SINGLE CHAR JZ FORA ;BRIF IT IS CMP M ;COMPARE THE TWO JNZ FOR9 ;BRIF NOT EQUAL FORA: RST 1 ;SKIP TO END (HOPEFULLY) MOV A,M ;GET THE NON BLANK ORA A ;SEE IF END JNZ FOR9 ;BRIF END JMP RUN ;ELSE, GO NEXT STMT ;PAGE ; IFSTM EQU $ ; ; ; STMT: IF EXPR RELATION EXPR THEN STMT# ; ; CALL EXPR ;GO EVALUATE LEFT EXPR PUSH H ;SAVE H,L LDA NS ;GET TYPE CODE STA IFTYP ;SAVE IT CPI 0E7H ;TEST IF STRING JNZ IF1 ;BRIF NOT LXI H,IOBUF ;POINT BUFFER LXI D,STRIN ;POINT RESULT LDAX D ;GET LEN INR A ;PLUS ONE MOV B,A ;SAVE IT CALL COPYD ;GO MOVE IT JMP IF2 ;GO AROUND IF1: LXI H,TVAR1 ;GET ADDR OF TEMP STORAGE RST 3 ;SAVE IT IF2: POP H ;RESTORE H,L XRA A ;CLEAR A MOV C,A ;SAVE IN REG C MOV B,A ;INIT REG IF3: MOV A,M ;GET OPERATOR INR B ;COUNT CPI '=' ;TEST FOR EQUAL JNZ IF4 ;BRIF IT IS INR C ;ADD 1 TO C INX H ;POINT NEXT IF4: CPI '>' ;TEST FOR GREATER THAN JNZ IF5 ;BRIF IT IS INR C ;ADD TWO INR C ;TO REL CODE INX H ;POINT NEXT IF5: CPI '<' ;TEST FOR LESS THAN JNZ IF6 ;BRIF IT IS MOV A,C ;GET REL CODE ADI 4 ;PLUS FOUR MOV C,A ;PUT BACK INX H ;POINT NEXT IF6: MOV A,C ;GET REL CODE ORA A ;TEST IT PUSH B ;SAVE B,C JZ SNERR ;BRIF SOME ERROR POP B ;RESTORE B,C STA REL ;SAVE CODE MOV A,B ;GET COUNT CPI 2 ;TEST FOR TWO JNZ IF3 ;SEE IF MULTIPLE RELATION CALL EXPR ;GO EVALUATE RIGHT SIDE SHLD ADDR1 ;SAVE LOCATION OF THEN (IF ANY) LDA NS ;GET TYPE CODE LXI H,IFTYP ;POINT LEFT TYPE CMP M ;COMPARE JNZ SNERR ;BRIF MIXED CPI 0E7H ;TEST IF STRING JZ IFF ;BRIF IS LXI H,TVAR1 ;POINT LEFT CALL FSUB ;SUBTRACT LEFT FROM RIGHT LDA REL ;GET RELATION RAR ;TEST BIT D0 JNC IF8 ;BRIF NO EQUAL TEST CALL FTEST ;GET STATUS OF FACC JZ TRUE ;BRIF LEFT=RIGHT IF8: LDA REL ;LOAD RELATION ANI 02H ;MASK IT JZ IF9 ;BRIF NO > CALL FTEST ;GET STATUS OF FACC JM TRUE ;BRIF GT IF9: LDA REL ;LOAD RELATION ANI 04H ;MASK IT JZ FALSE ;BRIF NO < CALL FTEST ;GET STATUS OF FACC JM FALSE ;BRIF GT JZ FALSE ;BRIF ZERO (NOT EQUAL) TRUE: LHLD ADDR1 ;GET POINTER TO STATEMENT LXI D,GOTOL ;POINT 'GO TO' RST 2 ;GO COMPARE JZ GOTO ;BRIF IF ... GOTO NN LHLD ADDR1 ;GET POINTER TO STATEMENT LXI D,GOSBL ;POINT LITERAL RST 2 ;GO COMAPRE JZ GOSUB ;BRIF IF ... GOSUB NN LHLD ADDR1 ;GET POINTER TO STATEMENT LXI D,THENL ;GET ADDR 'THEN' RST 2 ;GO COMPARE JNZ SNERR ;BRIF ERROR CALL NUMER ;TEST IF NUMERIC JZ GOTO ;BRIF IT IS JMP RUN4 ;ELSE, MAY BE ANY STMT FALSE EQU RUN IFF: LXI H,IOBUF ;POINT PRIOR MOV B,M ;GET LEN LXI D,STRIN ;POINT THIS LDAX D ;GET LEN MOV C,A ;SAVE IT IFG: INX D ;POINT NEXT INX H ;DITTO MOV A,B ;GET LEFT LEN ORA A ;TEST IT JNZ IFH ;BRIF NOT ZERO MVI M,' ' ;EXTEND WITH SPACE IFH: MOV A,C ;GET RIGHT LEN ORA A ;TEST IT JNZ IFI ;BRIF NOT ZERO MVI A,' ' ;GET SPACE STAX D ;EXTEND IFI: LDAX D ;GET RIGHT CHAR CMP M ;TEST WITH LEFT JC IFM ;BRIF LEFT>RIGHT JNZ IFN ;BRIF LEFT NEW JNZ SNERR ;BRIF PREV < NEW MOV A,L ;GET LO DIFF ORA A ;TEST IT JNZ SNERR ;BRIF PREV < NEW REDM1: XCHG ;PUT ADDR IN H,L DCX H ;POINT HI COL POP D ;GET COL MOV M,D ;MOVE HI DCX H ;POINT LO COL MOV M,E ;MOVE LO POP D ;GET ROW DCX H ;POINT HI ROW MOV M,D ;MOVE HI DCX H ;POINT LO ROW MOV M,E ;MOVE LO JMP DIM3 ;CONTINUE ;PAGE ; SIN EQU $ ; ; COMPUTE SINE OF X, (X IN RADIANS) ; ; USES 4TH DEGREE POLYNOMIAL APPROXIMATION ; ; ; FIRST, REDUCE ANGLE TO RANGE: (-PI/2,PI/2) ; CALL FTEST ;GET STATUS OF ANGLE RZ ;SIN(0)=0 PUSH PSW ;SAVE SIGN OF ANGLE CALL ABS SIN1: POP PSW ;COMPLEMENT SIGN FOR EACH PI SUB'D CMA ;.. PUSH PSW ;.. LXI H,PI ;REDUCE TO -PIFACC LXI H,TEMP3 ;POINTER TO X^N EVPS2: CALL FMUL ;FACC*X^N->FACC POP H ;COEFFICENT PTR RST 4 ;MOVE TO NEXT COEFFICIENT DB -4 AND 0FFH MOV A,M ;GET EXPONENT DCR A ;TEST FOR 1 JNZ EVPS1 ;BRIF NOT 1 LXI H,TEMP2 ;MUL BY TEMP2 CALL FMUL LXI H,TEMP1 ;POINT TO CONSTANT TERM JMP FADD ;ADD IT AND RETURN TO CALLER ; COS EQU $ ; ; ; COMPUTE COSINE OF ANGLE, X EXPRESSED IN RADIANS ; USES THE TRANSFORMATION: Y = PI/2 +- X ; AND THEN COMPUTES SIN(Y). ; ; LXI H,HALFP ;COMPUTE PI/2 + X CALL FADD ;GO ADD JMP SIN ;GO COMPUTE SINE ; TAN EQU $ ; ; COMPUTE TANGENT OF X, IN RADIANS ; USES THE RELATION: ; ; SIN(X) ; TAN(X) = ------ ; COS(X) ; LXI H,TEMP4 ;POINT SAVE AREA RST 3 ;SAVE ANGLE CALL COS ;COMPUTE COS(X) LXI H,TEMP7 ;SAVE COS(X)->TEMP7 RST 3 LXI H,TEMP4 ;MOVE X->FACC RST 5 CALL SIN ;COMPUTE SINE LXI H,TEMP7 ;POINT COS JMP FDIV ;DIVIDE AND RETURN TO CALLER ; ATN EQU $ ; ; COMPUTES THE ARCTANGENT OF X ; USES A SEVENTH DEGREE POLYNOMIAL APPROXIMATION ; CALL FTEST ;CHECK SIGN OF ARGUMENT JP ATN1 ;BRIF POSITIVE CALL NEG ;REVERSE SIGN CALL ATN1 ;GET POSITIVE ATN JMP NEG ;MAKE NEG & RETURN ; ATN1: LXI H,ONE ;POINT: 1 CALL FADD ;GO ADD LXI H,TEMP1 ;POINT SAVE RST 3 ;STORE LXI H,TWO ;POINT: 2 CALL FSUB ;GO SUBTRACT LXI H,TEMP1 ;POINT SAVED CALL FDIV ;DIVIDE LXI H,TEMP2 ;POINT SAVE RST 3 ;SAVE X'=(X-1)/(X+1) LXI H,QTRPI ;X'+PI/4 -> TEMP1 CALL FADD LXI H,TEMP1 RST 3 PUSH H ;SAVE PTR TO TEMP2 RST 5 ;LOAD IT POP H CALL FMUL ;FACC=X'*X' LXI H,ATNCO ;POINT LIST COEFFICIENTS JMP EVPS ;GO COMPUTE & RETURN ; LN EQU $ ; ; ; COMPUTES THE NATRUAL LOGRITHM, LN(X) ; USES A 7TH DEGREE POLYNOMIAL APPROXIMATION ; CALL FTEST ;TEST THE ARGUMENT JM ZMERR ;LN(-X)=NO NO JZ ZMERR ;LN(0)=NO NO ALSO LXI H,TEMP2 ;POINT SAVE AREA RST 3 ;STORE IT LDA FACC ;GET EXPON CALL FEXP ;EXPAND TO 8 BITS JZ LN0 ;BRIF 0.5 < X < 1.0 JP LN1 ;BRIF POSITIVE EXPONENT LN0: CMA ;ELSE COMPLIMENT ADI 2 ;PLUS TWO CALL FDEC ;CONVERT TO FLOAT POINT CALL NEG ;THEN NEGATE JMP LN2 ;GO AROUND LN1: SBI 1 ;MINUS ONE CALL FDEC ;CONVERT TO FLOATING POINT LN2: LXI H,LN2C ;POINT LN(2) CALL FMUL ;MULTIPLY LXI H,TEMP1 ;POINT SAVE AREA RST 3 ;STORE IT RST 5 ;GET ORIG X MVI A,1 ;GET EXPONENT: 1 STA FACC ;ADJUST TO RANGE (1,2) LXI H,ONE ;POINT 1 PUSH H ;SAVE PTR TO ONE CALL FSUB ;SUBTRACT ONE POP D ;SET TEMP2=1 LXI H,TEMP2 CALL CPY4D LXI H,LNCO ;POINT COEFFICIENTS JMP EVPS ;APPROXIMATE & RETURN ; ; X=LOG(X) --- THIS IS LOG BASE 10. ; LOG EQU $ CALL LN ;COMPUTE NATURAL LOG LXI H,LNC ;POINT LOG(E) JMP FMUL ;MULTIPLY AND RETURN ; EXP EQU $ ; ; COMPUTES EXP(X) USING ALGORITHM EXP(X)=(2^I)*(2^FP) WHERE ; 2^I=INT(X*LN BASE 2 OF E) AND, ; 2^FP=5TH DEGREE POLY. APPROXIMATION ; FP=FRACTIONAL PART OF INT(X*LN2E) ; CALL FTEST ;CHECK SIGN JP EXP1 ;BRIF POSITIVE CALL NEG ;ELSE, REVERSE SIGN CALL EXP1 ;COMPUTE POSITIVE EXP LXI H,TEMP1 ;POINT SAVE AREA RST 3 ;STORE IT LXI H,ONE ;POINT 1 RST 5 ;LOAD IT LXI H,TEMP1 ;POINT PREV JMP FDIV ;RECIPRICAL AND RETURN ; EXP1: LXI H,LN2E ;POINT LN BASE 2 OF E CALL FMUL ;FACC=X*(LN2E) LXI H,TEMP3 ;POINT SAVE AREA RST 3 ;TEMP3=X*LN2E CALL INT ;FACC=INT(X*LN2E) LXI H,TEMP4 ;POINT SAVE AREA RST 3 ;TEMP4=INT(X*LN2E) RST 3 ;DITTO FOR TEMP5 LDA FACC ;GET THE EXPONENT COUNT MOV B,A ;SAVE COUNT IN B LDA FACC+1 ;GET MANTISSA ELOOP: RLC ;ROTATE LEFT DCR B ;REDUCE COUNT JNZ ELOOP ;CONTINUE SHIFTING INR A ;ADJUST EXPONENT STA TEMP4 ;STORE EXPONENT MVI A,80H ;LOAD CONSTANT STA TEMP4+1 ;STORE AS MANTISSA LXI H,ONE ;1 -> TEMP1, TEMP2 RST 5 LXI H,TEMP1 RST 3 RST 3 RST 5 ;LOAD TEMP3=INT(X*LN2E) LXI H,TEMP5 ;GET FACC=FP(X*LN2E) CALL FSUB LXI H,EXPCO ;POINT CONSTANTS CALL EVPS ;COMPUTE POLYNOMIAL LXI H,TEMP4 ;POINT 2^(INT(X*LN2E)) JMP FMUL ;MULTIPLY,NORMALIZE AND RETURN ; ; ABS EQU $ ; ; ; RETURN THE ABSOLUTE VALUE OF THE FLOATING ACCUMULATOR ; ; LDA FACC ;GET EXPONENT ANI 7FH ;STRIP NEGATIVE SIGN STA FACC ;REPLACE RET ;RETURN ; SGN EQU $ ; ; ; RETURNS THE SIGN OF THE FLOATING ACCUMULATOR ; THAT IS: ; 1 IF FACC > 0 ; 0 IF FACC = 0 ; -1 IF FACC < 0 ; CALL FTEST ;GET STATUS OF FACC RZ ;RETURN IF ZERO ANI 80H ;ISOLATE SIGN SGN1: ORI 1 ;CREATE EXPONENT PUSH PSW ;SAVE IT LXI H,ONE ;GET ADDRESS OF CONSTANT 1 RST 5 ;GO LOAD IT POP PSW ;RESTORE SIGN STA FACC ;SET THE SIGN RET ;RETURN ; INT EQU $ ; ; ; RETURNS THE GREATEST INTEGER NOT LARGER THAN VALUE IN FACC ; E.G.: ; INT(3.14159) = 3 ; INT(0) = 0 ; INT(-3.1415) = -4 ; ; LXI H,FACC ;POINT FLOAT ACC MOV A,M ;GET EXPONENT ANI 40H ;GET SIGN OF CHARACTERISTIC JZ INT2 ;BRIF GE ZERO MVI B,4 ;LOOP CTR JMP ZEROM ;GO ZERO THE FACC INT2: MOV A,M ;GET EXPONENT AGAIN ORA A ;TEST SIGN JP INT3 ;BRIF POSITIVE OR ZERO LXI H,NEGON ;POINT CONSTANT: -.9999999 CALL FADD ;ADD TO FACC LXI H,FACC ;POINT EXPONTENT AGAIN MOV A,M ;LOAD IT INT3: ANI 3FH ;ISOLATE CHARACTERISTIC CPI 24 ;TEST IF ANY FRACTION RP ;RETURN IF NOT MOV B,A ;SAVE EXPONENT MVI A,24 ;GET CONSTANT SUB B ;MINUS EXPONENT = LOOP CTR MOV C,A ;SAVE IT INT4: LXI H,FACC+1 ;POINT MSB XRA A ;CLEAR CY FLAG MVI B,3 ;BYTE COUNT INT5: MOV A,M ;LOAD A BYTE RAR ;SHIFT RIGHT MOV M,A ;REPLACE INX H ;POINT NEXT DCR B ;DECR BYTE CTR JNZ INT5 ;LOOP DCR C ;DECR BIT CTR JNZ INT4 ;LOOP LXI H,FACC ;POINT SIGN & EXP MOV A,M ;LOAD IT ANI 80H ;ISOLATE SIGN ADI 24 ;PLUS INTEGER MOV M,A ;REPLACE IT JMP FNORM ;GO NORMALIZE & RETURN ; SQR EQU $ ; ; COMPUTE SQAURE ROOT OF ARG IN FACC, PUT RESULT IN FACC ; ; USE HERON'S ITERATIVE PROCESS ; CALL FTEST ;TEST THE ARGUMENT RZ ;RETURN IF ZERO JM ZMERR ;ERROR IF NEGATIVE STA DEXP ;SAVE ORIG EXPONENT XRA A ;GET A ZERO STA FACC ;PUT ARG IN RANGE [.5, 1] LXI H,TEMP2 ;POINT SAVE AREA RST 3 ;STORE IT ; ; INITIAL APPROXIMATION 0.41730759 + 0.59016206 * MANTISSA ; LXI H,SQC1 ;POINT .59016 CALL FMUL ;GO MULTIPLY LXI H,SQC2 ;PINT .4173 CALL FADD ;GO ADD LXI H,TEMP1 ;POINT SAVE AREA RST 3 ;GO STORE IT ; ; NEWTON'S METHOD OF ITERATION TO THE APPROXIMATE ; VALUE OF THE SQR OF MANTISSA ; CALL SQR1 ;FIRST ITERATION LXI H,TEMP1 ;POINT SAVE AREA RST 3 ;STORE IT CALL SQR1 ;SECOND ITERATION ; ; RESTORE RANGE TO OBTAIN THE FINAL RESULT ; LDA DEXP ;GET SAVE EXPONENT CALL FEXP ;EXPAND IT RAR ;DIVIDE BY 2 STA FACC ;STORE IT RNC ;RETURN IF EXPON EVEN LXI H,SQC3 ;ELSE, POINT SQR(2) JMP FMUL ;GO MULTIPLY AND RETURN ; ; THIS ROUTINE PERFORMS ONE NEWTON ITERATION ; TO THE SQUARE ROOT FUNCTION ; SQR1: LXI H,TEMP2 ;POINT MANTISSA RST 5 ;LOAD IT LXI H,TEMP1 ;POINT PREV GUESS CALL FDIV ;FORM MANT/TEMP1 LXI H,TEMP1 ;POINT PREV CALL FADD ;FORM TEMP1 + MANT/TEMP1 SUI 1 ;DIVIDE BY 2 STA FACC ;FORM (TEMP1 + MANT/TEMP1)/2 RET ;RETURN ; NEG EQU $ ; ; ; REVERSES THE SIGN OF THE FLOATING ACC ; ; CALL FTEST ;GET STATUS OF FACC RZ ;RETURN IF ZERO XRI 80H ;REVERSE SIGN STA FACC ;RESTORE EXPONENT RET ;CONTINUE EVALUATION ; RND EQU $ ; ; ; PSEUDO RANDOM NUMBER GENERATOR ; ; LXI H,TEMP7 ;SAVE ARG RST 3 MVI B,4 ;LOOP CTR LXI H,FACC ;POINT FLOAT ACCUM CALL ZEROM ;GO ZERO THE FACC MVI C,3 ;OUTTER LOP CTR LXI H,FACC+1 ;POINT MSB PUSH H ;SAVE H,L RND1: LXI H,RNDZ+1 ;POINT X,Y,Z MVI B,6 ;LOOP CTR ORA A ;TURN OFF CY RND2: MOV A,M ;GET A BYTE RAL ;SHIFT LEFT (MULT BY 2) MOV M,A ;REPLACE THE BYTE DCX H ;POINT NEXT DCR B ;DECR CTR JNZ RND2 ;LOOP INX H ;POINT MSD X,Y,Z LXI D,RNDP ;POINT TO MODULO MVI B,3 ;LOOP CTR FND3: LDAX D ;GET BYTE OF P,Q,R CMP M ;COMPARE WITH X,Y,Z INX D ;POINT NEXT INX H ;DITTO JC RND4 ;BRIF PX LDAX D ;GET LOW BYTE CMP M ;CMPARE JNC RND5 ;BRIF P>=X RND4: XCHG ;FLIP D,E TO H,L LDAX D ;GET LOW X BYTE SUB M ;SUBTRACT LOW P BYTE STAX D ;STORE IT DCX D ;POINT HIGH DCX H ;DITTO LDAX D ;GET HIGH X BYTE SBB M ;SUB HIGH P BYTE STAX D ;STORE IT INX D ;POINT LOW INX H ;DITTO XCHG ;RESTORE ADDRS RND5: INX D ;POINT NEXT INX H ;DITTO DCR B ;DECR CTR JNZ FND3 ;LOOP MVI B,3 ;LOOP CTR RND6: LXI D,RNDS+1 ;POINT LOW S LDAX D ;GET LOW S ADD M ;ADD LOW X,Y,Z STAX D ;PUT S DCX D ;POINT HIGH DCX H ;DITTO LDAX D ;GET HIGH S ADC M ;ADD HIGH X,Y,Z ANI 3FH ;TURN OFF HIGH BITS STAX D ;STORE IT DCX H ;POINT NEXT X,Y,Z DCR B ;DECR CTR JNZ RND6 ;LOOP MVI A,8 ;CONSTANT SUB C ;LESS CTR RAR ;DIVIDE BY TWO POP H ;GET H,L ADDR LDA RNDS+1 ;GET LSB OF S MOV M,A ;STORE IT INX H ;POINT NEXT PUSH H ;SAVE H,L DCR C ;DECR CTR JNZ RND1 ;LOOP POP H ;RESTORE SP PTR LDA RNDSW ;GET SWITCH ORA A ;TEST IT JZ RND7 ;BRIF NO RANDOMIZE LXI D,TRNDX ;POINT SAVED VALUES LXI H,RNDX ;POINT NEXT VALUES MVI B,8 ;LOOP CTR CALL COPYH ;GO COPY RND7: CALL FNORM LXI H,TEMP7 ;MULTIPLY BY RANGE JMP FMUL ; INP EQU $ ; ; ; INPUT A BYTE FROM THE DEVICE IN FACC ; ; PUT THE RESULT IN THE FACC ; CALL FBIN ;CONVERT FACC TO BINARY LXI H,OUTA ;POINT INSTR BUFFER MVI M,0DBH ;IN INSTR INX H ;POINT NEXT MOV M,A ;MOVE ADDR INX H ;POINT NEXT MVI M,0C9H ;RET INSTR CALL OUTA ;GO INPUT A BYTE FDEC: MOV E,A ;MOVE BYTE TO LO D,E MVI D,0 ;ZERO HI D,E JMP BINFL ;GO CONVERT TO DEC & RET ; POS EQU $ ; ; ; RETURNS THE CURRENT POSITION OF THE TTY CURSOR ; ; LDA COLUM ;GET POSITION JMP FDEC ;CONVERT TO FLOAT AND RETURN ; CONCA EQU $ ; ; ; CONCATONATE TWO STRING TOGETHER ; COMBINE LENGTH <= 255 ; POP D ;ADJUST STACK LXI D,STRIN ;POINT STRING BUFFER LDAX D ;GET CURRENT LENGTH MOV C,A ;STORE IT MVI B,0 ;CLEAR HI XCHG ;FLIP FLOP DAD B ;COMPUTE NEXT XCHG ;FLIP BACK ADD M ;COMPUTE COMBINE LENGTH MOV B,M ;SAVE LEN2 JNC CONC2 ;BRIF NO OVFLW MVI A,255 ;MAX LEN SUB C ;MINUS 1ST PART MOV B,A ;SAVE LEN MVI A,255 ;UPDATED LENGTH CONC2: STA STRIN ;STORE IT MOV A,B ;GET LEN TO MOVE ORA A ;TEST IT JZ CONC4 ;BRIF NULL CONC3: INX H ;POINT NEXT INX D ;DITTO MOV A,M ;GET NEXT CHAR STAX D ;PUT IT DCR B ;DECR COUNT JNZ CONC3 ;LOOP CONC4: POP H ;GET H,L DCX H ;POINT BACK LDA STRIN ;GET LEN RAR ;DIVIDE BY TWO INR A ;PLUS ONE XCHG ;SAVE H,L LHLD SPCTR ;GET CTR MOV C,A ;SAVE CTR MVI B,0 ;ZERO HI BYTE DAD B ;ADD LEN THIS STRING SHLD SPCTR ;SAVE CTR POP B LXI H,0 ;GET ADDR ZERO CONC5: PUSH H ;2 BYTE WORD DCR A ;DECR CTR JNZ CONC5 ;CONTINUE DAD SP ;GET ADDRESS IN H,L XCHG ;PUT STACK PTR IN D,E MOV M,D ;MOVE HI ADDR INX H ;POINT NEXT MOV M,E ;MOVE LO ADDR INX H ;POINT NEXT MVI M,0E7H ;TYPE=STRING PUSH H ;SAVE H,L LXI H,STRIN ;GET TEMP STR MOV A,M ;GET LENGTH INR A ;PLUS ONE MOV C,A ;SAVE IT CONC6: MOV A,M ;GET A BYTE STAX D ;PUT IT DOWN INX D ;POINT NEXT INX H ;DITTO DCR C ;SUBT CTR JNZ CONC6 ;LOOP POP H ;RESTORE H,L RST 4 ;ADJUST H,L DB -7 AND 0FFH MVI A,4 ;DELETE 4 BYTES CALL SQUIS ;GO COMPRESS JMP EVAL ;CONTINUE EVALUATION ; LENFN EQU $ ; ; X=LEN(A$) ; ; RETURN THE LENGTH OF THE STRING ; LDA STRIN ;GET LEN IN ACC JMP FDEC ;GO CONVERT TO DECIMAL & RETURN ; CHRFN EQU $ ; ; A$=CHR$(X) ; ; RETURNS A ONE CHAR STRING HAVING THE ASCII VALUE - X ; CALL FBIN ;CONVERT FACC TO BINARY LXI H,STRIN ;POINT OUT AREA MVI M,1 ;LEN=1 INX H ;POINT NEXT MOV M,A ;STORE THE CHAR RET ;RETURN ; ASCII EQU $ ; ; X=ASCII(A$) ; ; RETURNS THE ASCII VALUE OF THE FIRST CHAR IN STRING ; LXI H,STRIN ;POINT STRING MOV A,M ;GET LENGTH ORA A ;TEST IF > ZERO JZ FDEC ;BRIF ZERO & RETURN A ZERO INX H ;POINT 1ST CHAR MOV A,M ;LOAD IT JMP FDEC ;GO CONVERT TO DECIMAL & RETURN ; NUMFN EQU $ ; ; A$=NUM$(X) ; ; RETURNS A STRING REPRESENTING X AS IT WOULD HAVE ; BEEN PRINTED (INCLUDING TRAILING SPACE) ; LXI H,STRIN ;POINT STRING AREA MVI M,0 ;INIT COUNT INX H ;SKIP TO 1ST POSITION CALL FOUT ;GO CONVERT TO EXTRN DEC XRA A ;GET A ZERO MOV B,A ;INIT CTR NUM1: DCX H ;POINT PRIOR INR B ;COUNT IT CMP M ;TEST IF ZERO JNZ NUM1 ;LOOP TILL AT START MOV M,B ;SET LEN CODE RET ;THEN RETURN ; VAL EQU $ ; ; X = VAL(A$) ; ; RETURNS THE VALUE OF THE STRING OF NUMERIC CHARACTERS ; LXI H,STRIN ;POINT STRING AREA MOV A,M ;GET LEN ORA A ;TEST FOR NULL STRING MOV B,A ;SAVE LEN JZ FDEC ;BRIF IS (RETURNS A 0.00) LXI D,STRIN ;POINT BUFFER VAL1: INX H ;POINT NEXT MOV A,M ;GET A CHAR CPI ' ' ;TEST IF SPACE JZ VAL2 ;BRIF IS STAX D ;PUT THE CHAR INX D ;INCR ADDR VAL2: DCR B ;DECR CTR JNZ VAL1 ;LOOP XRA A ;GET A ZERO STAX D ;PUT IN BUFF LXI H,STRIN ;POINT START OF BUFFER CALL FIN ;GO CONVERT MOV A,M ;GET NON-NUMERIC ORA A ;TEST IT JNZ CVERR ;BRIF ERROR RET ;ELSE, RETURN ; SPACE EQU $ ; ; A$=SPACE$(X) ; ; CREATES A STRING FO SPACES LENGTH = X ; CALL FBIN ;GET BINARY LENGTH LXI H,STRIN ;POINT TEMP STRING MOV M,A ;PUT LEN ORA A ;TEST IT SPAC1: RZ ;RETURN IF ZERO INX H ;ELSE, POINT NEXT MVI M,' ' ;MOVE 1 SPACE DCR A ;DECR CTR JMP SPAC1 ;LOOP ; STRFN EQU $ ; ; A$=STRING$(X,Y) ; ; CREATES STRING OF LNGTH X CONTAINING REPETITION OF CHR$(Y) ; CALL FBIN ;GET BINARY LENGTH STA STRIN ;PUT TO STRING CALL ARGNU ;GET NEXT ARGUMENT LXI H,STRIN ;POINT STRING MOV B,M ;GET COUNT STR11: INX H ;POINT NEXT MOV M,A ;STORE THE CHAR DCR B ;DECR CTR JNZ STR11 ;LOOP RET ;RETURN ; LEFT EQU $ ; ; B$=LEFT$(A$,X) ; ; SUBSTRING FROM THE LEFTMOST X CHARACTERS OF A$ ; CALL ARGNU ;GET 2ND ARGUMENT MOV C,A ;SAVE LEN MVI B,1 ;INIT START JMP MID0 ;CONTINUE ; RIGHT EQU $ ; ; B$=RIGHT$(A$,X) ; ; SUBSTRING STARTING AT POSITION X TO END OF STRING ; CALL ARGNU ;GET 2ND ARGUMENT MOV B,A ;SAVE START MVI C,255 ;MAX LEN JMP MID0 ;CONTINUE ; MIDFN EQU $ ; ; B$=MID$(A$,X,Y) ; ; SUBSTRING OF THE STRING A$ STARTING WITH CHARACTER @ X ; AND Y CHARACTERS LONG ; CALL ARGNU ;LOAD X MOV B,A ;SAVE START PUSH B ;PUT ON STACK CALL ARGNU ;GET 3RD ARG POP B ;RETREIVE MOV C,A ;SAVE LEN MID0: MOV A,B ;LOAD START LXI H,STRIN ;POINT STRING CMP M ;TEST IF X>L JC MID1 ;BRIF X>L JZ MID1 ;OR EQUAL MVI M,0 ;ELSE, RESULT IS NULL RET ;RETURN MID1: ADD C ;COMPUTE END POSITION JC MID2 ;BRIF OVERFLOW SBI 1 ;COMPUTE X+Y-1 JC MID2 ;BRIF OVERFLOW CMP M ;COMPARE TO EXISTING LEN JC MID3 ;BRIF X+Y-1 LEN(A$) INST3: MOV C,A ;SAVE Y MVI B,0 ;ZERO HI INCR MOV A,M ;GET LEN(A$) SUB C ;MINUS Y INR A ;PLUS ONE DAD B ;COMPUTE START ADDR MOV B,A ;# CHARS REMAIN IN A$ PUSH H ;SAVE ADDR LHLD ADDR1 ;GET ADDR OF ARG INX H ;POINT NEXT MOV D,M ;GET HI ADDR INX H ;POINT NEXT MOV E,M ;GET LO ADDR INX H ;POINT NEXT SHLD ADDR1 ;UPDATED PTR POP H ;RESTORE ADDR LDAX D ;GET LEN(B$) ORA A ;TEST IF NULL JNZ INST6 ;BRIF NOT MVI C,1 ;SET POSIT = 1 INST5: MOV A,C ;GET POSIT JMP FDEC ;CONVERT TO DECIMAL & RETURN INST6: XCHG ;FLIP/FLOP MOV A,B ;GET LEN OF A$ CMP M ;COMPARE TO LEN B$ JC INSTA ;BRIF LEN(B$)< LEN(REM A$) PUSH B ;SAVE CTR, POSIT PUSH D ;SAVE ADDR A$ PUSH H ;SAVE ADDR B$ MOV C,M ;GET LEN B$ XCHG ;FLIP/FLOP INST8: INX D ;POINT NEXT B$ LDAX D ;GET B$ CHAR CMP M ;COMPARE A$ CHAR JNZ INST9 ;BRIF NOT EQUAL INX H ;POINT NEXT A$ DCR C ;DECR CTR (LEN(B$)) JNZ INST8 ;LOOP POP H ;DUMMY POP POP H ;GET DUMMY STACK POP B ;GET POSITION JMP INST5 ;WE FOUND A MATCH INST9: POP D ;GET PTR B$ POP H ;GET PTR A$ POP B ;GET CTRS, POSIT INR C ;UP PTR NUM INX H ;POINT NEXT A$ DCR B ;DECR B JNZ INST6 ;LOOP INSTA: MVI C,0 ;ELSE B$ NOT IN A$ JMP INST5 ;RETURN ; FN EQU $ ; ; STMT: DEF FNX(A)=EXPR ; ; NOTE: ENTRY FROM EXPR ANALYZER (RECURSIVE) ; PUSH B ;SAVE B,C PUSH D ;SAVE D,E PUSH H ;SAVE H,L XCHG ;PUT H,L TO D,E LHLD ADDR3 ;GET ADDR PUSH H ;SAVE IT XCHG ;PUT D,E BACK TO H,L SHLD ADDR3 ;UPDATE PTR LHLD SPCTR ;GET SP COUNT PUSH H ;SAVE IT LDA PARCT ;GET PAREN COUNT MOV B,A ;PUT TO B LDA FNMOD ;GET FN MODE MOV C,A ;PUT TO C PUSH B ;SAVE B,C LDA DIMSW ;GET DIM SW PUSH PSW ;SAVE IT XRA A ;CLEAR A STA DIMSW ;RESET DIM SW LHLD FNARG ;GET OLD ARG NAME PUSH H ;SAVE LHLD FNARG+2 ;GET OLD ARG ADDRESS PUSH H ;SAVE LHLD PROGE ;GET END OF PROGRAM PUSH H ;SAVE IT LHLD EXPRS ;GET END OF EXPR PUSH H ;SAVE IT SHLD PROGE ;SAVE NEW 'END' OF PROGRAM MVI A,1 ;GET ON SETTING STA FNMOD ;SET IN FUNCTION LHLD ADDR3 ;POINT TO EXPR MOV C,M ;GET FN CHAR DCX H ;POINT BACK MOV B,M ;GET HI NAME LXI H,BEGPR ;POINT START OF PROGRAM FN2: MOV A,M ;LOAD LEN TO NEXT STMT ORA A ;TEST IF AT END JZ SNERR ;BRIF FN NOT FOUND PUSH H ;SAVE PTR RST 4 ;ADJUST H,L DB 3 LXI D,DEFLI ;LITERAL RST 2 ;GO COMPARE JNZ FN3 ;BRIF NOT EQUAL PUSH B ;SAVE TEST NAME CALL VAR ;GO GET NAME POP B ;RESTORE NAME MOV A,D ;GET HI NAME CMP B ;COMPARE JNZ FN3 ;BRIF NOT EQUAL MOV A,E ;GET LO CMP C ;COMPARE JZ FN4 ;BRIF EQUAL FN3: POP H ;GET OLD PTR MOV E,M ;GET LO LEN MVI D,0 ;ZERO HI LEN DAD D ;POINT NEXT STMT JMP FN2 ;LOOP FN4: POP D ;ADJUST STACK RST 1 ;SKIP BLANKS CPI '(' ;TEST IF OPEN PAREN JNZ SNERR ;BRIF NOT INX H ;SKIP IT CALL VAR ;GO GET VAR NAME PUSH H ;SAVE HL ADDR LXI H,FNARG ;POINT DUMMY ARG TBL MOV M,D ;STORE LETTER INX H ;POINT NEXT MOV M,E ;STORE DIGIT INX H ;POINT NEXT XCHG ;PUT H,L TO D,E LHLD ADDR3 ;POINT TO EXPR STACK INX H ;POINT CODE INX H ;POINT HI ADR MOV A,M ;GET HI STAX D ;PUT TO TABLE INX D ;POINT NEXT INX H ;DITTO MOV A,M ;GET LO ADDR STAX D ;PUT TO TABLE POP H ;RESTORE PTR TO STMT RST 1 ;SKIP BLANKS CPI ')' ;TEST IF CLOSE PAREN JNZ SNERR ;BRIF NOT INX H ;SKIP IT RST 1 ;SKIP BLANKS CPI '=' ;TEST IF EQUAL SIGN JNZ SNERR ;BRIF NOT INX H ;SKIP IT CALL EXPR ;GO EVAL FUNCTION CALL EOL ;MUST BE END OF LINE POP H ;GET H,L SHLD EXPRS ;RESTORE START OF EXPR POP H ;GET H,L SHLD PROGE ;RESTORE 'END' OF PROGRAM POP H ;GET H,L SHLD FNARG+2 ;STORE ADDR POP H ;GET H,L SHLD FNARG ;STORE DUMMY ARG POP PSW ;GET A,STATUS STA DIMSW ;RESTORE DIM SW POP B ;GET B,C MOV A,C ;LOAD C STA FNMOD ;RESTORE MOE MOV A,B ;LOAD B STA PARCT ;RESTORE PAREN COUNT POP H ;GET H,L SHLD SPCTR ;RESTORE SP COUNTER POP H ;GET H,L SHLD ADDR3 ;RESTORE ADDR OF EVAL POP H ;GET H,L POP D ;GET D,E DCX H ;POINT 2ND BYTE FOLLOWING OP SHLD ADDR2 ;SAVE IT RST 4 ;POINT TO ARG TYPE DB 5 SHLD ADDR1 ;SAVE ADDR JMP EV3 ;GO WRAPUP ;PAGE ; EXPR EQU $ ; ; ; EVALUATE EXPRESSION ROUTINE ; LEAVE RESULT IN FACC ; RETURN WHEN EXPRESSION ENDS (TYPICALLY AT END OF LINE) ; ; XRA A ;CLEAR REG A STA PARCT ;SET PAREN CTR XCHG ;SAVE H,L LXI H,0 ;GET A ZERO SHLD SPCTR ;INIT CTR LHLD PROGE ;POINT END OF PROGRAM AREA INX H ;POINT ONE MORE MVI M,0 ;INIT START OF STACK SHLD EXPRS ;SAVE IT XCHG ;RESTORE H,L ; LOOKD EQU $ ;LOOK FOR CON, VAR, OR FUNCTION RST 1 ;SKIP TO NON-BLANK CALL NUMER ;GO TEST IF NUMERIC JNZ LDALP ;BRIF NOT LDNUM: CALL FIN ;GO CONVERT NUMERIC (PUT TO FACC) LDF: MOV B,H ;COPY H,L TO B,C MOV C,L ;SAME LHLD EXPRS ;GET ADDR OF EXPR AREA CALL GTEMP ;GO STORE THE FACC IN TEMP AREA SHLD EXPRS ;SAVE UPDATED ADDRESS MOV H,B ;RESTORE H MOV L,C ;RESTORE L JMP LOOKO ;GO GET AN OPERATION CODE LDALP: CPI '.' ;SEE IF LEADING DECIMAL POINT JZ LDNUM ;BRIF IS CALL ALPHA ;GO SEE IF ALPHA JNZ LDDTN ;BRIF NOT MOV B,M ;SAVE 1ST CHAR INX H ;POINT NEXT MVI C,' ' ;DEFAULT FOR 1 CHAR VAR CALL NUMER ;GO SEE IF 2ND IS NUMERIC JNZ LDFN ;BRIF NOT INX H ;POINT NEXT MOV C,A ;SAVE THE CHAR LDV1: RST 1 ;GET NEXT CHAR CPI '$' ;TEST IF STRING PUSH PSW ;SAVE STATUS JNZ LDV2 ;BRIF NOT MOV A,C ;GET LOW CHAR ORI 80H ;SET STRING MOV C,A ;SAVE IT INX H ;SKIP $ RST 1 ;SKIP SPACES LDV2: CPI '(' ;TEST IF PAREN JZ LDV2A ;BRIF IS PUSH H ;SAVE H,L MOV D,B ;COPY B,C MOV E,C ;TO D,E CALL SEARC ;GO GET VAR ADDR IN D,E LDV: LHLD EXPRS ;GET EXPR ADDR CALL SADR ;GO STORE ADDRESS SHLD EXPRS ;SAVE ADDRESS XCHG ;H,L TO D,E POP H ;GET OLD H,L POP PSW ;GET STATUS JNZ LOOKO ;BRIF NOT STRING XCHG ;GET OLD H,L MVI M,0E7H ;MARK AS STRING ADDRESS XCHG ;RESTORE H,L JMP LOOKO ;GO LOOK FOR OPCODE LDFN: CALL ALPHA ;GO SEE IF FUNCTION JNZ LDV1 ;BRIF IT'S NOT LDFN1: DCX H ;POINT BACK TO 1ST MOV A,M ;GET THAT CHAR CPI ' ' ;TEST IF SPACE JZ LDFN1 ;LOOP IF TRUE PUSH H ;SAVE H,L LXI D,RNDLI ;POINT LITERAL RST 2 ;GO COMPARE JZ LDRND ;BRIF FND POP H ;GET H,L PUSH H ;RESAVE LXI D,FNLIT ;POINT LITERAL RST 2 ;GO SEE IF FN X JZ FNL ;BRIF IS POP H ;GET H,L PUSH H ;RESAVE LXI D,PILIT ;POINT LIT RST 2 ;GO COMPARE JZ LDPI ;BRIF PI FUNC0: POP H ;GET H,L LXI D,FUNCT ;POINT FUNCTION TABLE PUSH H ;SAVE POINTER CALL SEEK1 ;GO SEARCH FUNCTION TABLE JZ FUNC4 ;BRIF FUNCTION NOT FOUND LDAX D ;GET A BYTE LOW MOV C,A ;SAVE IT INX D ;POINT NEXT LDAX D ;GET HI BYTE MOV B,A ;SAVE IT (B,C = ADDR OF FUNC) RST 1 ;SKIP BLANKS CPI '(' ;TEST FOR OPEN PAREN JNZ SNERR ;BRIF MISSING PAREN INX D ;POINT TYPE CODE LDAX D ;LOAD IT JMP LDFNC ;CONTINUE FUNC4: POP H ;GET H,L MOV B,M ;GET 1ST CHAR MVI C,' ' ;SPACE 2ND CHAR INX H ;POINT TO NEXT JMP LDV1 ;BRIF VARIABLE FNL: POP D ;DUMMY RESET STACK POINTER CALL VAR ;GO GET FN NAME MOV B,D ;COPY TO B,C MOV C,E ;SAME XCHG ;SAVE H,L LHLD EXPRS ;POINT EXPR STACK INX H ;POINT NEXT MOV M,B ;MOVE THE LETTER INX H ;POINT NEXT MOV M,C ;MOVE DIGIT ($??) INX H ;POINT NEXT MVI M,0AFH ;MOVE CODE MOV A,C ;GET LO NAME ORA A ;TEST IT JP FNL3 ;BRIF NOT STRING MVI M,0CFH ;MOVE CODE FNL3: SHLD EXPRS ;SAVE POINTER XCHG ;GET H,L RST 1 ;GET NEXT CHAR CPI '(' ;TEST IF OPEN PAREN JNZ SNERR ;BRIF NOT JMP LOOKD ;CONTINUE LDRND: CPI '(' ;TEST IF RND(X) JZ FUNC0 ;BRIF IS PUSH H ;ELSE, SAVE H,L LXI H,ONE ;USE RANGE (0,1) RST 5 ;LOAD FACC CALL RND ;GO GET RANDOM NUMBER POP H ;RESTORE H,L POP D ;RESTORE STACK POINTER JMP LDF ;ACT AS IF CONSTANT LDPI: INR A ;SET NON ZERO POP D ;DUMMY STACK POP PUSH PSW ;SAVE STATUS PUSH H ;SAVE H,L LXI D,PI ;GET ADDRESS OF 3.1415 JMP LDV ;GO ACT LIKE VARIABLE LDFNC: POP D ;POP THE STACK XCHG ;FLIP/FLOP LHLD EXPRS ;GET ADDR INX H ;POINT NEXT MOV M,B ;HIGH ADDR INX H ;POINT NEXT MOV M,C ;LOW ADDR INX H ;POINT NEXT MOV M,A ;CODE SHLD EXPRS ;SAVE ADDR XCHG ;RESTORE H,L JMP LOOKD ;NEXT MUST BE DATA TOO LDDTN: CPI '-' ;TEST IF UNARY MINUS JNZ LDDTP ;BRIF NOT XCHG ;SAVE H,L LHLD EXPRS ;GET EXPR END INX H ;POINT ONE MORE MVI M,61H ;CODE FOR NEG SHLD EXPRS ;RESTORE PTR XCHG ;RESTORE H,L SKPP: INX H ;POINT PAST THIS BYTE JMP LOOKD ;NEXT MUST BE DATA LDDTP: CPI '+' ;TEST IF UNARY PLUS JZ SKPP ;IGNORE IF IS CPI '(' ;ELSE, TEST IF OPEN PAREN JZ CERCE ;BRIF IS CPI 27H ;TEST IF LITERAL (SINGLE QUOTE) JZ LITST ;BRIF IS CPI '"' ;TEST IF LITERAL JNZ SNERR ;BRIF NOT CON, FUNCTION, OR VAR LITST: MOV C,A ;SAVE DELIMITER LXI D,STRIN ;POINT BUFFER MVI B,0FFH ;INIT CTR LIT1: INX H ;POINT NEXT MOV A,M ;LOAD NEXT INX D ;POINT NEXT STAX D ;STORE IT ORA A ;TEST IF END JZ SNERR ;BRIF ERROR INR B ;COUNT IT CMP C ;TEST IF END OF STRING JNZ LIT1 ;BRIF NOT INX H ;POINT NEXT LXI D,STRIN ;POINT BEGIN MOV A,B ;GET COUNT STAX D ;PUT COUNT RAR ;DIVIDE BY TWO INR A ;PLUS ONE MOV C,A ;SAVE IT MVI B,0 ;ZERO HIGH PUSH H ;SAVE PTR LHLD SPCTR ;GET CTR DAD B ;PLUS OLD SHLD SPCTR ;UPDATE IT POP D ;GET OLD H,L LXI H,0 ;GET A ZERO LIT2: PUSH H ;GET 2 WORK BYTES DCR C ;SUB 1 FROM COUNT JNZ LIT2 ;CONTINUE DAD SP ;GET ADDR OF STACK PUSH D ;SAVE PTR TO STMT XCHG ;SAVE H,L IN D,E LHLD EXPRS ;GET START OF EXPR INX H ;PLUS ONE MOV M,D ;HI BYTE INX H ;POINT NEXT MOV M,E ;LO BYTE INX H ;POINT NEXT MVI M,0E7H ;TYPE CODE SHLD EXPRS ;SAVE ADDR XCHG ;D,E BACK TO H,L LXI D,STRIN ;POINT STRING AREA LDAX D ;GET COUNT INR A ;ADD ONE TO COUNT MOV B,A ;SAVE CTR LIT3: LDAX D ;GET A BYTE MOV M,A ;STORE IT INX H ;POINT NEXT INX D ;DITTO DCR B ;DECR CTR JNZ LIT3 ;LOOP POP H ;RESTORE H,L JMP LOOKO ;NEXT IS OP CERCE: XCHG ;SAVE H,L LXI H,PARCT ;POINT PAREN COUNT INR M ;ADD 1 LHLD EXPRS ;GET ADDR INX H ;POINT NEXT MVI M,5 ;PUT CODE SHLD EXPRS ;SAVE ADDR XCHG ;RESTORE H,L JMP SKPP ;GO SKIP CHAR LOOKO: RST 1 ;SKIP BLANKS CPI '+' ;TEST IF PLUS MVI B,21H ;CODE JZ OP1 ;BRIF IS CPI '-' ;TEST IF MINUS MVI B,25H JZ OP1 ;BRIF IS CPI '/' ;TEST IF DIVIDE MVI B,45H ;CODE JZ OP1 ;BRIF IS CPI '^' ;TEST IF EXPON MVI B,81H ;CODE JZ OP1 ;BRIF IS CPI ')' ;TEST IF CLOSE PAREN JZ OP3 ;BRIF IS CPI ',' ;TEST IF COMMA JZ OP2 ;BRIF IS CPI '*' ;TEST IF MULTIPLY MVI B,41H ;CODE JZ OP1 ;BRIF IS ; ELSE MUST BE END OF EXPRESSION ENDXP: LDA PARCT ;GET OPEN PAREN COUNT ORA A ;TEST IT JNZ SNERR ;BRIF # OF ('S NOT = # OF )'S SHLD ADDR3 ;SAVE ADDR OF STMT JMP EVAL ;GO EVALUATE OP1: PUSH H ;SAVE PLACE IN ASCII EXPRESSION LXI D,0105H ;D=BYTE COUNT, E=CODE FOR "(" LHLD EXPRS ;POINT TO LAST BYTE MOV A,B ;B&E3 -> C ANI 0E3H MOV C,A ; INSERT ( AND EVALUATE IF PRECEDENCE REDUCTION, ; ELSE INNSERT OP CODE OPLP1: MOV A,M ;GET TYPE CODE FROM EXPRESSION PUSH PSW ;SAVE ANI 3 ;GET LENGTH OPLP2: INR D ;BUMP BYTE COUNT DCX H ;EXPRESSION POINTER DCR A ;LOOP MOVES TO NEXT ELEMENT JNZ OPLP2 POP PSW ;RESTORE TYPE CODE ANI 0E3H ;MASK FOR VARIABLE CPI 0E3H ;WE SKIP OVER VARIABLES JZ OPLP1 ;BR IF TYPE = E3 OR E7 CMP C ;PRECEDENCE REDUCTION? JNC INS ;IF NC, YES, INSERT 05 LHLD EXPRS ;NO, INSERT OPCODE BEFORE VAR AT END RST 4 ;SKIP OVER VARIABLE DB -3 AND 0FFH MVI D,4 ;BYTE COUNT MOV E,B ;INSERT THIS OP CODE INS: MOV B,E ;SAVE FOR BRANCH AFTER INSERTION INS1: INX H ;BUMP POINTER MOV C,M ;PICK UP BYTE MOV M,B ;PUT DOWN REPLACEMENT MOV B,C ;SAVE FOR NEXT LOOP DCR D ;DONE? JNZ INS1 ;IF NZ, NO SHLD EXPRS ;STORE POINTER POP H ;RESTORE ASCII EXPRESSION POINTER MOV A,E ;GET FLAG SAVED IN E CPI 5 ;STORED A "("? JNZ SKPP ;IF NZ, NO, PROCESS NEXT ELEMENT JMP OP4 ;YES, GO EVALUATE OP2: LDA PARCT ;GET OPEN PAREN COUNT ORA A ;TEST IT JZ ENDXP ;BRIF END OF EXPR XCHG ;ELSE SAVE H,L LHLD EXPRS ;GET EXPR BEGIN INX H ;POINT NEXT MVI M,1 ;MOVE A COMMA SHLD EXPRS ;UPDATE POINTER XCHG ;FLIP BACK JMP SKPP OP3: LDA PARCT ;GET OPEN PAREN COUNT DCR A ;SUBTRACT ONE STA PARCT ;SAVE IT JM SNERR ;BRIF TOO MANY )'S INX H ;POINT NEXT SOURCE OP4: SHLD ADDR3 ;SAVE ADDR EVAL: LHLD EXPRS ;GET END OF EXPR LXI B,0 ;INIT B,C TO ZERO EV1: INR B ;COUNT EACH BYTE MOV A,M ;GET CODE IN REG A DCX H ;POINT NEXT CPI 0E3H ;TEST IF DATA JNZ EV2 ;BRIF NOT DATA EV1A: DCX H ;POINT NEXT DCX H ;DITTO INR B ;BUMP CTR INR B ;BY TWO INR C ;COUNT THE TERM JMP EV1 ;LOOP EV2: CPI 0AFH ;TEST IF NUMERIC USER FN JZ FN ;BRIF IS CPI 0CFH ;TEST IF STRING USER FN JZ FN ;BRIF IS PUSH PSW ;ELSE, SAVE STATUS ANI 0E3H ;MASK IT CPI 0A3H ;TEST IF NUMERIC FUNCTION JZ EV2A ;BRIF IS CPI 0C3H ;TEST IF STRING FUNCTION JZ EV2A ;BRIF IS POP PSW ;RESTORE CODE CPI 0E7H ;TEST IF STRING ADDR JZ EV1A ;BRIF IS JMP EV5 ;BR AROUND EV2A: INX H ;RESET TO TYPE CODE SHLD ADDR1 ;SAVE ADDR POP D ;DUMMY POP PUSH B ;SAVE CTRS DCX H ;POINT TO LOW JMP ADDR MOV E,M ;LOW BYTE DCX H ;POINT BACK MOV D,M ;HIGH BACK SHLD ADDR2 ;SAVE LOCATION LXI H,EV3 ;GET RETURN ADDRESS PUSH H ;SAVE ON STACK PUSH D ;SAVE ADDRESS CALL ARG ;GO GET 1ST ARG POP H ;GET H,L ADDRESS PCHL ;GO EXECUTE THE FUNCTION EV3 EQU $ ;FUNCTIONS RETURN HERE LHLD ADDR2 ;GET ADDR FUNC INX H ;POINT LO INX H ;POINT TYPE MOV A,M ;LOAD IT ANI 0E0H ;MASK IT CPI 0C0H ;TEST IF STRING JZ EV4 ;BRIF IS POP B ;GET CTRS LHLD SPCTR ;GET COUNTER INX H ;PLUS INX H ;TWO WORDS SHLD SPCTR ;STORE IT LXI H,0 ;LOAD ZERO TO H,L PUSH H ;GET BLOCK OF PUSH H ;BYTES DAD SP ;GET STACK ADDR PUSH B ;SAVE CTRS PUSH H ;SAVE ADDR RST 3 ;GO STORE THE VARIABLE MVI A,0E3H ;TYPE=NUM EV3A: POP D ;GET ADDR IN STACK LHLD ADDR1 ;GET ADDR LST ARG MOV M,A ;STORE TYPE CODE DCX H ;POINT ONE BACK MOV M,E ;STORE LO ADDR DCX H ;POINT BACK MOV M,D ;STORE HI ADDR LHLD ADDR2 ;GET LOCATION FUNCTION INX H ;POINT LO INX H ;POINT TYPE MOV A,M ;LOAD TYPE MOV B,M ;GET TYPE RST 4 ;ADJUST H,L DB -3 AND 0FFH MOV A,B ;LOAD TYPE POP B ;RESTORE CTRS ANI 18H ;ISOLATE #ARGS RAR ;SHIFT RIGHT RAR ;AGAIN RAR ;ONCE MORE MOV D,A ;SAVE IT ADD D ;TIMES 2 ADD D ;TIMES 3 INR B ;POINT INR B ;LST POSIT IN LOC CALL SQUIS ;GO COMPRESS STACK JMP EVAL ;START AT BEGINNING EV4: LXI D,STRIN ;POINT STRING BUFFER LDAX D ;LOAD IT RAR ;DIVIDE BY TWO INR A ;ADD 1 LHLD SPCTR ;GET SP COUNT MOV C,A ;SAVE LO MVI B,0 ;SET HI DAD B ;ADD NUMBER WORDS SHLD SPCTR ;SAVE SP COUNT LXI H,0 ;GET SOME ZEROS POP B ;GET CTRS EV4A: PUSH H ;GET 1 WORD DCR A ;DECR CTR JNZ EV4A ;LOOP DAD SP ;GET ADDRESS IN H,L PUSH B ;RE-SAVE CTRS PUSH H ;SAVE ADDR LDAX D ;GET COUNT INR A ;PLUS ONE MOV B,A ;SAVE IT EV4B: LDAX D ;GET A BYTE MOV M,A ;STORE IT INX D ;POINT NEXT INX H ;DITTO DCR B ;DECR CTR JNZ EV4B ;LOOP MVI A,0E7H ;TYPE CODE JMP EV3A ;CONTINUE EV5: CPI 5 ;TEST IF OPEN PAREN JNZ EV6 ;BRIF NOT MVI A,1 ;DELETE 1 BYTE CALL SQUIS ;GO COMPRESS IT LHLD ADDR3 ;RESTORE STMT POINTER LDA DIMSW ;GET SUBSR SWITCH ORA A ;TEST IT JZ LOOKO ;BRIF NOT IN SUBS^CRIPT LDA PARCT ;GET OPEN PAREN COUNT ORA A ;TEST JNZ LOOKO ;BRIF NOT ZERO JMP EVAL ;ELSE EVALUATE COMPLETE SUBSCR EV6: ORA A ;TEST IF END OF EXPRESSION JNZ EV9 ;BRIF NOT LDA DIMSW ;GET DIM SW ORA A ;TEST IT CNZ EDM1 ;BRIF NOT OFF MOV A,C ;GET TERM COUNT CPI 1 ;TEST IF ONE JNZ STERR ;ERROR IF NOT ONE INX H ;POINT HIGH ADDR INX H ;SAME MOV D,M ;HIGH TO D INX H ;POINT LOW MOV E,M ;LOW TO E CALL EVLD ;GO LOAD VALUE LHLD SPCTR ;GET STACK CTR EV7: MOV A,L ;GET LO BYTE ORA H ;PLUS HI JZ DV8 ;BRIF ZERO POP D ;RETURN 2 BYTES DCX H ;DECR CTR JMP EV7 ;LOOP DV8: LDA DIMSW ;GET DIM SW ORA A ;TEST IT CNZ EDM4 ;BRIF ON LHLD ADDR3 ;RESTORE STMT PTR RET ;RETURN TO STMT PROCESSOR EV9: CPI 21H ;TEST IF PLUS LXI D,FADDJ ;ADDR JZ EV10 ;BRIF IS CPI 25H ;TEST IF MINUS LXI D,FSUB ;ADDR JZ EV10 ;BRIF IS CPI 41H ;TEST IF MUL LXI D,FMUL ;ADDR JZ EV10 ;BRIF IS CPI 45H ;TEST IF DIV LXI D,FDIV ;ADDR JZ EV10 ;BRIF IS CPI 1 ;TEST IF COMMA JZ EVCOM ;BRIF IS CPI 61H ;TEST IF UNARY MINUS JZ EVNEG ;BRIF IS CPI 81H ;TEST IF EXPONENTIAL LXI D,POWER ;ADDR JNZ STERR ;ERROR IF NOT EV10: INX H ;POINT TO INX H ;1ST DATA PUSH B ;SAVE CTRS PUSH D ;SAVE ROUTINE ADDR MOV D,M ;HIGH TO D INX H ;POINT NEXT MOV E,M ;LOW TO E PUSH H ;SAVE POINTER CALL EVLD ;GO LOAD VALUE POP H ;RESTORE H,L INX H ;POINT 2ND DATA INX H ;SAME MOV D,M ;HIGH TO D INX H ;POINT NEXT MOV E,M ;LOW TO E INX H ;POINT NEXT LDA NS ;GET PREV TYPE CMP M ;TEST THIS TYPE JNZ SNERR ;BRIF MIXED MODE DCX H ;POINT BACK XTHL ;POP ADDR FROM STACK, PUSH H ONTO LXI B,EV11 ;RETURN ADDRESS PUSH B ;SAVE ON STACK PUSH H ;SAVE JUMP ADDR XCHG ;PUT VAR ADDR TO H,L RET ;FAKE CALL TO ROUTINE FADDJ: CPI 0E7H ;TEST IF STRINGS JZ CONCA ;BRIF IS JMP FADD ;ELSE, GO ADD POWER: PUSH H ;SAVE ADDR OF VAR LXI H,TEMP1 ;POINT SAVE AREA RST 3 ;SAVE X POP H ;RESTORE H,L RST 5 ;LOAD IT CALL FTEST ;TEST FOR ZERO JZ SGN1 ;GIVE RESULT = 1 IF POWER = 0 LXI H,TEMP7 ;POINT SAVE AREA RST 3 ;SAVE B LXI H,TEMP1 ;POINT X RST 5 ;GO LOAD IT CALL FTEST ;TEST FOR ZERO RZ ;0^X = 0 CALL LN ;GET NATURAL LNRITHM LXI H,TEMP7 ;POINT B CALL FMUL ;GO MULTIPLY JMP EXP ;GET EXP FUNC ; X^B = EXP(B*LN(X)) XSQR: LXI H,TEMP1 ;POINT X RST 5 ;LOAD X LXI H,TEMP1 ;POINT X JMP FMUL ;TIMES X EV11: POP H ;GET H,L POP B ;GET CTRS DCX H ;POINT BACK DCX H ;AND AGAIN CALL GTEMP ;GO SAVE FACC RST 4 ;ADJUST H,L DB -7 AND 0FFH MVI A,4 ;DELETE 4 BYTES CALL SQUIS ;GO COMPRESS JMP EVAL ;CONTINUE EVNEG: INX H ;POINT BACK TO OP PUSH B ;SAVE CTRS PUSH H ;SAVE H,L INX H ;DITTO MOV D,M ;GET HI BYTE INX H ;POINT NEXT MOV E,M ;GET LO BYTE CALL EVLD ;GO LOAD VAR CALL NEG ;GO NEGATE IT POP H ;GET LOCATINO POP B ;GET CTRS CALL GTEMP ;GO STORE FACC IN STACK RST 4 ;ADJUST H,L DB -4 AND 0FFH EVCOM: MVI A,1 ;DELETE 1 BYTE CALL SQUIS ;COMPRESS LXI H,CMACT ;GET COUNT INR M ;INCR JMP EVAL ;CONTINUE EVLD: INX H ;POINT TYPE MOV A,M ;LOAD IT STA NS ;SAVE IT XCHG ;SAVE H,L IN D,E CPI 0E7H ;TEST IF STRING JNZ RST5 ;LOAD FLOATING POINT LXI D,STRIN ;POINT BUFFER MOV A,M ;GET COUNT INR A ;ADD ONE MOV B,A ;SAVE COUNT EVLD1: MOV A,M ;GET NEXT STAX D ;STORE IT INX H ;POINT NEXT INX D ;DITTO DCR B ;DECR COUNT JNZ EVLD1 ;LOOP RET ;RETURN ; EDM1: MOV A,C ;GET ITEM COUNT PUSH H ;SAVE H,L CPI 1 ;TEST IF 1 JNZ EDM3 ;BRIF NOT MVI B,4 ;GET COUNT LXI H,TEMP1 ;POINT AREA CALL ZEROM ;GO ZERO IT EDM2A: POP H ;RESTORE H,L MVI C,1 ;SET COUNT RET ;RETURN EDM3: CPI 2 ;TEST IF 2 JNZ SNERR ;ELSE, ERROR RST 4 ;POINT 2ND ARG DB 5 MOV D,M ;GET HI ADDR INX H ;POINT NEXT MOV E,M ;GET LO ADDR CALL EVLD ;LOAD THE ARG LXI H,TEMP1 ;POINT AREA RST 3 ;SAVE THE ARG JMP EDM2A ;CONTINUE EDM4: CALL FACDE ;CONVERT FACC TO D,E PUSH D ;PUT D,E TO B,C POP B PUSH B ;SAVE COL LXI H,TEMP1 ;POINT 2ND ARGUMENT RST 5 ;LOAD IT IN FACC CALL FACDE ;CONVERT TO D,E POP B ;GET COL XRA A ;GET A ZERO STA DIMSW ;RESET SW RET ;RETURN LDV2A: MOV A,B ;GET HI NAME ORI 80H ;SET BIT MOV B,A ;RESTORE PUSH B ;SAVE NAME XCHG ;SAVE H,L IN D,E LDA PARCT ;GET PAREN COUNT PUSH PSW ;SAVE XRA A ;CLEAR REG A STA PARCT ;RESET COUNT LHLD SPCTR ;GET STACK COUNTER PUSH H ;SAVE IT LXI H,0 ;GET A ZERO SHLD SPCTR ;RESET CTR LHLD EXPRS ;GET EXPRST PUSH H ;SAVE IT INX H ;POINT NEXT MVI M,0 ;SET NEW START SHLD EXPRS ;SAVE IT LDA DIMSW ;GET PREV SE PUSH PSW ;SAVE IT XCHG ;RESTORE H,L MVI A,0FFH ;GET ON VALUE STA DIMSW ;SET SW CALL LOOKD ;RECURSIVE CALL POP PSW ;GET DIM SW STA DIMSW ;REPLACE IT SHLD ADDR3 ;SAVE H,L POP H ;GET EXPRST SHLD EXPRS ;SAVE IT POP H ;GET STACK COUNTER SHLD SPCTR ;RESTORE IT POP PSW ;GET PAREN COUNT STA PARCT ;RESTORE IT POP H ;GET NAME PUSH D ;SAVE ROW PUSH B ;SAVE COL XCHG ;PUT NAME IN D,E CALL SEARC ;GO FIND ADDRESS (PUT IN D,E) POP D ;GET ADDR POP B ;RESTORE COL POP D ;RESTORE ROW CALL SUBSC ;GET SUBSCRIPT (RETURNS ADDR IN H,L) XCHG ;SAVE IN D,E LHLD ADDR3 ;GET H,L PUSH H ;SAVE ON STACK JMP LDV ;CONTINUE ; PAGE ; FIN EQU $ ; ; FLOATING POINT INPUT CONVERSION ROUTINE ; ; THIS SUBROUTINE CONVERTS AN ASCII STRING OF CHARACTERS ; TO THE FLOATING POINT ACCUMULATOR. THE INPUT FIELD ; MAY CONTAIN ANY VALID NUMBER, INCLUDING SCIENTIFIC ; NOTATION (NNN.NNNNE+NN). ; THE INPUT STRING IS TERMINATED BY ANY NON-NUMERIC CHAR ; ; XCHG ;PUT ADDR TO D,E MVI C,0 ;INITIAL VALUE EXCESS DIGIT COUNT CALL FIN8 ;GET INTEGER PORTION MVI B,0 ;CLEAR DIGIT COUNT CPI '.' ;TEST IF DEC-POINT JNZ FIN2 ;BRIF NOT CALL FIN9 ;GET FRACTION FIN2: POP PSW ;GET SIGN ORI 24 ;SET UP FOR FLOAT STA FACC MOV A,B ;GET # FRACTION DIGITS ADD C ;+ EXCESS DIGITS PUSH PSW ;SAVE POWER OF TEN PUSH D ;SAVE PTR CALL FNORM ;NORMALIZE NUMBER LDAX D ;GET NEXT CHARACTER CPI 'E' ;TEST IF EXPONENT JNZ FIN4 ;BRIF NOT LXI H,FTEMP ;POINT SAVE AREA RST 3 ;SAVE ACC POP D ;RESTORE PTR INX D ;SKIP 'E' CALL FIN8 ;GET NUMERIC EXP LDA FACC+3 ;GET EXPONENT POP B ;EXPONENT SIGN INR B ;TEST JP FIN3 ;BRIF NOT NEG CMA ;NEGATE EXPONENT INR A FIN3: POP B ;POWER OF TEN ADD B ;ADD EXPONENT PUSH PSW ;SAVE COUNT LXI H,FTEMP ;RESTORE NUMBER PUSH D ;SAVE PTR RST 5 ;LOAD IT FIN4: POP H ;RESTORE PTR POP PSW ;RESTORE COUNT FIN5: RZ ;RETURN IF ZERO PUSH H ;SAVE H,L LXI H,TEN ;POINT CONSTANT: 10 JM FIN7 ;BRIF DIVIDE NEEDED DCR A ;DECR COUNT PUSH PSW ;SAVE COUNT CALL FMUL ;GO MULTIPLY BY 10 FIN6: POP PSW ;RESTORE COUNT POP H ;RESTORE H,L JMP FIN5 ;CONTINUE FIN7: INR A ;INCR COUNT PUSH PSW ;SAVE COUNT CALL FDIV ;GO DIVIDE BY 10 JMP FIN6 ;LOOP ; ; FIN8 CONVERT NUMBER STRING TO FACC ; ON ENTRY, C=INIT VALUE EXCESS DIGIT COUNT ; DE=INPUT STRING ; ON EXIT, SIGN IS ON STACK ; B=DIGIT COUNT ; C=EXCESS DIGIT COUNT ; FIN8: LXI H,FACC ;CLEAR FACC MVI B,4 CALL ZEROM LXI H,8000H ;ASSUME MINUS LDAX D ;GET CHAR CPI '-' JZ FIN8A MOV H,L ;NOPE, MUST BE PLUS ;(B IS CLEARED BY ZEROM) CPI '+' JZ FIN8A DCX D ;NEITHER, BACK UP POINTER FIN8A: XTHL ;GET RETURN, PUSH SIGN PUSH H ;RESTORE RETURN FIN9: INX D ;POINT NEXT LDAX D ;GET CHAR CPI '0' ;TEST IF LESS ZERO RC ;RETURN IF IS CPI '9'+1 ;TEST IF GT NINE RNC ;RETURN IF IS DCR B ;DIGIT COUNT PUSH D ;SAVE PTR PUSH B ;SAVE COUNTERS CALL FMTEN ;MULTIPLY FACC*TEN ORA A ;TEST FOR OVERFLOW JZ FINB ;BRIF NO OVERFLOW LXI H,FTEMP+4 RST 5 ;RESTORE OLD FACC POP B ;RESTORE COUNTERS INR C ;EXCESS DIGIT POP D JMP FIN9 FINB: POP B ;RSTORE COUNTERS POP D ;& PTR LDAX D ;GET THE DIGIT ANI 0FH ;MASK OFF ZONE LXI H,FACC+3 ;POINT ACC ADD M ;ADD MOV M,A ;STORE DCX H ;POINT NEXT MOV A,M ;LOAD ACI 0 ;PLUS CARRY MOV M,A ;STORE DCX H ;POINT NEXT MOV A,M ;LOAD ACI 0 ;PLUS CARRY MOV M,A ;STORE JMP FIN9 ;LOOP ; ; MULTIPLY FACC BY TEN ; FMTEN: LXI H,FTEMP+4 RST 3 ;SAVE FACC CALL FIND ;*2 CALL FIND ;*4 LXI H,FTEMP+7 CALL FIND0 ;*5 FIND: LXI H,FACC+3 ;DOUBLE FACC FIND0: LXI D,FACC+3 MVI B,4 ;BYTE COUNT JMP FADDT ;ADD & RETURN ;PAGE ; FOUT EQU $ ; ; FLOATING POINT OUTPUT FORMAT ROUTINE ; ; THIS SUBROUTINE CONVERTS A NUMBER IN FACC TO A ; FORMAT SUITABLE FOR PRINTING. THAT IS, THE ; NUMBER WILL BE IN SCIENTIFIC NOTATION IF EXPONENT ; IS > 5 OR < -2, OTHERWISE IT WILL BE ZERO SUPRESSED ; ON BOTH SIDES. ; LXI D,FACC+3 ;POINT LSB LDAX D ;LOAD IT ORI 7 ;MASK FOR OUTPUT STAX D ;REPLACE CALL FTEST ;GET SIGN OF NUMBER MVI M,' ' ;DEFAULT SPACE JP FOUT0 ;BRIF NOT MINUS MVI M,'-' ;MOVE DASH FOUT0: INX H ;POINT NEXT JNZ FOUT2 ;BRIF NOT ZERO MVI M,'0' ;MOVE THE ZERO INX H ;POINT NEXT MVI M,' ' ;MOVE SPACE FOLLOWING RET ;RETURN FOUT2: LDA FACC ;GET SIGN & EXP CALL FEXP ;EXPAND EXPONENT JNZ FOUTV ;BRIF NOT ZERO MVI A,80H ;SET NEG FOUTV: ANI 80H ;ISOLATE STA DEXP ;SAVE SIGN PUSH H ;SAVE H,L FOUT3: LDA FACC ;GET SIGN & EXP CALL FEXP ;EXPAND EXP CPI 1 ;TEST RANGE JP FOUT6 ;BRIF IN RANGE FOUT4: LXI H,DEXP ;POINT DEC.EXP INR M ;INCR IT LXI H,TEN ;POINT CONST: 10 JP FOUT5 ;BRIF POS. CALL FMUL ;MULTIPLY JMP FOUT3 ;LOOP FOUT5: CALL FDIV ;DIVIDE JMP FOUT3 ;LOOP FOUT6: CPI 5 ;TEST HIGH RANGE JP FOUT4 ;BRIF 5 OR GREATER LXI H,FTEMP ;POINT SAVE AREA RST 3 ;STORE IT LDA FACC ;GET EXPONENT CALL FEXP ;EXPAND MVI C,6 ;DIGIT COUNT CALL FOUTB ;SHIFT LEFT CPI 10 ;TEST IF DECIMAL POINT JM FOUTU ;BRIF LT LXI H,FTEMP ;POINT SAVE AREA RST 5 ;LOAD IT JMP FOUT4 ;ONCE MORE FOUTU: CALL FOUT9 ;PUT DIGIT FOUT7: XRA A ;CLEAR STATUS STA FACC ;AND OVERFLOW CALL FMTEN ;MULTIPLY BY TEN CALL FOUT9 ;PUT DIGIT JNZ FOUT7 ;LOOP JMP FOUTH ;GO AROUND FOUT9: ORI 30H ;DEC. ZONE POP H ;GET RETURN ADDR XTHL ;EXCH WITH TOP (PTR) MOV M,A ;PUT DIGIT INX H ;POINT NEXT MOV A,C ;GET COUNT CPI 6 ;TEST IF 1ST JNZ FOUTA ;BRIF NOT MVI M,'.' ;MOVE DEC. PT. INX H ;POINT NEXT FOUTA: XTHL ;EXCH WITH RTN DCR C ;DECR COUNT PCHL ;RETURN FOUTB: MOV E,A ;SAVE BIT COUNT XRA A ;CLEAR ACC FLAGS STA FACC ;AND OVERFLOW FOUTC: LXI H,FACC+3 ;POINT LSB MVI B,4 ;BYTE COUNT FOUTD: MOV A,M ;GET A BYTE RAL ;SHIFT LEFT MOV M,A ;STORE DCX H ;POINT NEXT DCR B ;DECR CTR JNZ FOUTD ;LOOP DCR E ;DECR BIT CTR JNZ FOUTC ;LOOP RET ;RETURN FOUTH: POP H ;GET PTR MVI M,'E' ;EXPONENT INX H ;POINT NEXT LDA DEXP ;GET EXPONENT MVI M,'+' ;DEFAULT MOV D,A ;SAVE NUMBER ORA A ;TEST IT JP FOUTI ;BRIF POS MVI M,'-' ;ELSE, DASH ANI 7FH ;STRIP DUMB SIGN CMA ;COMPLEMENT INR A ;PLUS ONE (TWOS COMP) MOV D,A ;SAVE IT CMA ;RE-COMPLEMENT INR A ;PLUS ONE FOUTI: INX H ;POINT NEXT PUSH H ;SAVE PTR MVI E,-1 AND 0FFH ;INIT CTR (TENS) FOUTJ: INR E ;ADD ONE SUI 10 ;LESS 10 JP FOUTJ ;LOOP ADI 10 ;CORRECT UNITS MOV B,A ;SAVE UNITS MOV A,E ;GET TENS CALL FOUT9 ;OUTPUT MOV A,B ;GET UNITS CALL FOUT9 ;OUTPUT POP H ;GET PTR MVI M,' ' ;SPACE AFTER MOV A,D ;GET DEC EXPON ORA A ;SET FLAGS JP FOUTK ;BRIF POS. CPI -2 AND 0FFH ;TEST FOR MIN RC ;RETURN IF LESS THAN -2 JMP FOUTL ;GO AROUND FOUTK: CPI 6 ;TEST IF TOO BIG RNC ;RETURN IF 6 OR GREATER FOUTL: MOV C,A ;SAVE EXPONENT MVI B,5 ;CTR FOUTM: MVI M,' ' ;SPACE OUT EXPONENT DCX H ;POINT PRIOR DCR B ;DECR CTR JNZ FOUTM ;LOOP XCHG ;FLIP/FLOP MOV A,E ;GET LOW BYTE SUI 5 ;POINT TO DOT MOV L,A ;PUT DOWN MOV A,D ;GET HIGH SBI 0 ;IN CASE OF BORROW MOV H,A ;PUT DOWN MOV A,C ;GET EXPONENT ORA A ;TEST SIGN JZ FOUTO ;BRIF ZERO JM FOUTR ;BRIF NEGATIVE FOUTN: MOV B,M ;GET HIGH BYTE INX H ;POINT NEXT MOV A,M ;GET LOW BYTE MOV M,B ;SHIFT DOT TO RIGHT DCX H ;POINT BACK MOV M,A ;MOVE THE DIGIT LEFT INX H ;POINT NEXT DCR C ;DECR CTR JNZ FOUTN ;LOOP FOUTO: XCHG ;POINT END FOUTP: MOV A,M ;GET A DIGIT/DOT CPI '0' ;TEST FOR TRAILING ZERO JNZ FOUTQ ;BRIF NOT MVI M,' ' ;SPACE FILL DCX H ;POINT PRIOR JMP FOUTP ;LOOP FOUTQ: CPI '.' ;TEST FOR TRAILING DOT INX H ;JUST IN CASE NOT RNZ ;RETURN IF NOT DCX H ;RESET PTR MVI M,' ' ;SPACE IT OUT RET ;RETURN FOUTR: CPI 0FFH ;TEST IF -1 JNZ FOUTS ;ELSE -2 DCX H ;POINT SIGNIFICANT MOV A,M ;GET THE CHAR MVI M,'.' ;MOVE THE DOT INX H ;POINT NEXT MOV M,A ;SHIFT THE DIGIT JMP FOUTO ;GO ZERO SUPPRESS FOUTS: DCX H ;POINT ONE TO LEFT MOV A,M ;PICK UP DIGIT MVI M,'0' ;REPLACE INX H ;POINT RIGHT MOV M,A ;PUT THE DIGIT MOV H,D ;GET LOW ADDR MOV L,E ;POINT LAST DIGIT MVI B,6 ;CTR FOUTT: DCX H ;POINT PRITO MOV A,M ;GET A DIGIT INX H ;POINT MOV M,A ;PUT IT ONE TO RIGHT DCX H ;POINT DCR B ;DECR CTR JNZ FOUTT ;LOOP MVI M,'.' ;MOVE THE DOT JMP FOUTO ;CONTINUE ; FADD EQU $ ; ; ; FLOATING POINT ADD THE NUMBER AT (H,L) TO THE FACC ; ; INX H ;POINT FIRST DIGIT MOV A,M ;LOAD IT ORA A ;TEST IT JZ FTEST ;BRIF ZERO DCX H ;POINT BACK CALL FTEST ;GO TEST SIGN OF FACC JZ RST5 ;JUST LOAD IF FACC = 0 CALL FEXP ;GO GET EXPONENT MOV B,A ;SAVE EXPONENT MOV A,M ;GET EXPONENT OF ADDR CALL FEXP ;GO GET EXPONENT MOV C,A ;SAVE THE EXPONENT SUB B ;GET DIFFERENCE OF TWO EXPONENTS JZ FADD4 ;BRIF THEY'RE EQ JP FADD3 ;BRIF DIFFERENCE IS POSITIVE CMA ;COMPLEMENT ACC INR A ;PLUS ONE (TWO'S COMPLEMENT) FADD3: CPI 24 ;COMPARE DIFFERENCE TO MAX JC FADD4 ;BRIF LESS MOV A,B ;GET EXPON OF ADDUEND SUB C ;GET TRUE DIFFERENCE AGAIN JP FTEST ;BRIF FACC > ADDER JMP RST5 ;ELSE, ADDER > FACC FADD4: PUSH PSW ;SAVE DIFFERENCE PUSH B ;SAVE EXPONENTS LXI D,FTEMP ;GET ADDR OF TEMP ACC CALL CPY4H POP B ;GET EXPONENTS POP PSW ;GET DIFFERENCE JZ FADD9 ;JUST ADD IF ZERO LXI H,FTEMP+1 ;DEFAULT PUSH PSW ;SAVE DIFFERENCE MOV A,B ;GET FACC EXPON SUB C ;MINUS FTEMP EXPON JP FADD6 ;BRIF TEMP MUST BE SHIFTED LXI H,FACC ;POINT FLOAT ACC MOV A,C ;GET EXPONENT, SIGN ANI 7FH ;STRIP EXP SIGN MOV C,A ;PUT BACK MOV A,M ;GET THE EXP ANI 80H ;STRIP OFF OLD EXPON ORA C ;MOVE ADDR EXPON TO IT MOV M,A ;REPLACE INX H ;POINT FIRST DATA BYTE FADD6: POP PSW ;GET DIFFER MOV C,A ;SAVE IT FADD7: MVI B,3 ;LOOP CTR (INNER) XRA A ;INIT CARRY TO Z PUSH H ;SAVE ADDR CALL FSHFT ;GO SHIFT POP H ;GET ADDR DCR C ;DECR CTR JNZ FADD7 ;LOOP FADD9 EQU $ LXI H,FTEMP LDA FACC ;GET EXPONENT XRA M ;SEE IF SIGNS THE SAME LXI D,FACC+3 ;POINT LEAST SIGN BYTE LXI H,FTEMP+3 JM FADDA ;BRIF SIGNS DIFFERENT CALL FADT3 ;ADD 3 BYTES JNC FTEST ;BRIF NO OVERFLOW XCHG ;POINT HL TO FACC CALL SVSGN ;SAVE SIGN, RETURN EXPONENT INR A ;INCREMENT EXPONENT CALL RSSGN ;RESTORE SIGN TO EXPONENT INX H ;POINT DATA STC ;SET CY MVI B,3 ;CTR CALL FSHFT ;GO SHIFT IT JMP FTEST ;RETURN FADDA EQU $ MVI B,3 CALL FSUBT ;SUBTRACT JNC FNORM ;BRIF NO BORROW LXI H,FACC+3 ;MUST NEGATE MVI B,3 STC FNEG1: MOV A,M ;GET BYTE CMA JNC FNEG2 ADI 1 ;INCREMENT + COMPLEMENT=NEGATE FNEG2: MOV M,A DCX H DCR B JNZ FNEG1 CALL FNORM JMP NEG ;REVERSE SIGN ;PAGE ; FNORM EQU $ ; ; ; NORMALIZE THE FLOATING ACCUMULATOR ; THAT IS, THE FIRST BIT MUST BE SIGNIFICANT ; ; LXI H,FACC+3 ;POINT LSB MOV A,M ;LOAD IT DCX H ;POINT PRIOR ORA M ;MERGE DCX H ;POINT PRIOR ORA M ;MERGE DCX H MOV B,M ;SAVE EXPONENT MOV M,A ;CLEAR RZ ;RETURN ON NOTHING TO NORMALIZE MOV M,B ;RESTORE EXP PUSH B ;SAVE C FOR CALLER CALL SVSGN ;SAVE SIGN MOV M,A ;STORE EXPANDED EXPONENT FNRM1: INX H ;POINT TO MOST SIGN BYTE MOV A,M ;GET MSB ORA A ;TEST IT JM FNRM3 ;BRIF NORMALIZED INX H ;POINT LSB INX H MVI B,3 ;SHIFT COUNT FNRM2: MOV A,M ;SHIFT LEFT RAL MOV M,A DCX H DCR B JNZ FNRM2 DCR M ;ADJUST EXPONENT JMP FNRM1 ;LOOP FNRM3: DCX H ;POINT BACK TO EXPONENT MOV A,M CALL RSSGN ;RESTORE SIGN POP B ;RESTORE C RET ; FSUB EQU $ ; ; ; FLOATING POINT SUBTRACT THE NUMBER AT (H,L) FROM THE FACC ; ; CALL NEG ;NEGATE FACC CALL FADD ;ADD CALL NEG ;NEGATE RESULT JMP FTEST ;PAGE ; FMUL EQU $ ; ; ; FLOATING POINT MULTIPLY THE NUMBER AT (H,L) TO THE FACC ; ; CALL FTEST ;TEST FACC RZ ;RETURN IF ZERO INX H ;POINT 1ST DIGIT OF MULTIPLIER MOV A,M ;LOAD IT DCX H ;RESTORE ORA A ;TEST IF ZERO JZ RST5 ;GO LOAD TO FACC IF IT IS PUSH H ;SAVE MULTIPLIER ADDRESS CALL MDSGN ;GET SIGN PRODUCT, & BOTH EXPONENTS ADD B ;ADD EXPONENTS CALL RSSGN ;RESTORE SIGN POP H ;RESTORE LXI D,FTEMP+9 ;POINT TEMP STORAGE MVI B,3 ;BYTE COUNT INX H ;POINT MSD CALL COPYH ;MOVE MULTIPLIER LXI H,FTEMP ;POINT DIGIT 7 OF RESULT MVI B,6 ;LOOP CTR CALL ZEROM ;GO ZERO EIGHT BYTES LXI D,FACC+1 ;POINT 1ST DIGIT OF ACC MVI B,3 ;LOOP CTR FMUL5: LDAX D ;GET AN ACC DIGIT PAIR MOV M,A ;PUT TO TEMP STORAGE XRA A ;ZERO A STAX D ;CLEAR ACC INX D ;POINT NEXT INX H ;DITTO DCR B ;DECR CTR JNZ FMUL5 ;LOOP MVI C,24 ;OUTTER LOOP CTR FMUL6: MVI B,3 ;CTR LXI H,FTEMP+9 ;POINT MULTIPLIER XRA A ;CLEAR CY FMUL7: MOV A,M ;GET BYTE RAR ;SHIFT RIGHT MOV M,A ;PUT DOWN INX H ;POINT NEXT DCR B ;DECR CTR JNZ FMUL7 ;LOOP JNC FMUL8 ;BRIF ZERO BIT LXI D,FTEMP+2 ;POINT RESULT LXI H,FTEMP+8 ;POINT MULTIPLICAND MVI B,6 ;SIX BYTE ADD CALL FADDT ;GO ADD FMUL8: MVI B,6 ;SIZ BYTE SHIFT LXI H,FTEMP+8 ;POINT MULTIPLICAND XRA A ;CLEAR CY FMUL9: MOV A,M ;GET BYTE RAL ;SHIFT LEFT MOV M,A ;PUT BACT DCX H ;POINT NEXT BYTE DCR B ;DECR CTR JNZ FMUL9 ;LOOP DCR C ;DEC BIT COUNT JNZ FMUL6 ;CONTINUE JMP FNORM ;GO NORMALIZE ; ; MDSGN GET SIGN PRODUCT AND EXPONENTS FOR MULT & DIV ; ON ENTRY: ; (HL) = ONE NUMBER ; (FACC)=THE OTHER ; ON RETURN: ; A = EXPONENT OF FACC(EXPANDED) ; B = OTHER EXPONENT ; C = SIGN PRODUCT ; HL DESTROYED ; MDSGN: CALL SVSGN ;GET SIGN IN C, EXP IN A MOV B,A ;SAVE EXPONENT LXI H,FACC MOV A,C ;GET SIGN ADD M ;MULTIPLY SIGNS MOV M,A ;PUT DOWN ; ; SVSGN GET SIGN AND EXP ; ON ENTRY: ; (HL) = EXPONENT ; ON RETURN: ; A = EXPANDED EXPONENT ; C = SIGN IN HI ORDER BIT ; SVSGN: MOV A,M ;GET EXPONENT ANI 80H ;ISOLATE SIGN MOV C,A MOV A,M JMP FEXP ;EXPAND EXP AND RETURN ; ; RSSGN RESTORE SIGN TO EXPONENT ; ON ENTRY: ; (HL)=EXPONENT ; A = EXPANDED EXPONENT ; C = SIGN ; ON RETURN: ; A = EXPONENT ; (HL) = EXPONENT WITH SIGN ; Z,M BITS SET FOR EXPONENT ; RSSGN: CALL FOVUN ;CHECK FOR OVER/UNDERFLOW ANI 7FH ;REMOVE EXPONENT SIGN ORA C ;ADD SIGN MOV M,A ;SET DOWN JMP FTEST ;SET Z,M BITS ;PAGE ; FDIV EQU $ ; ; ; FLOATING POINT DIVIDE THE NUMBER AT (H,L) INTO THE FACC ; ; CALL FTEST ;TEST IF FACC ZERO RZ ;RETURN IF IT IS INX H ;POINT 1ST DIGIT OF DIVISOR MOV A,M ;LOAD IT DCX H ;POINT BACK ORA A ;TEST IF ZERO JZ ZMERR ;DIVISION BY ZERO = ERROR PUSH H ;SAVE DIVISOR PTR CALL MDSGN ;GET SIGN ON STACK, EXPS INTO A,B SUB B ;SUBTRACT EXPONENTS INR A ;PLUS ONE CALL RSSGN ;SET SIGN/EXPONENT IN FACC LXI D,FACC+1 LXI H,FTEMP ;POINT TEMPORARY STORAGE MVI M,0 ;CLEAR MSB INX H ;POINT NEXT MVI B,3 ;LOOP CTR FDIV3: LDAX D ;GET BYTE FROM FACC MOV M,A ;PUT TO FTEMP XRA A ;CLEAR A STAX D ;ZERO FACC INX H ;POINT NEXT INX D ;DITTO DCR B ;DECR CTR JNZ FDIV3 ;LOOP POP D ;GET ADDR MVI B,3 ;LOOP CTR INX D ;POINT MSD OF DIVISOR MVI M,0 ;CLEAR MSB INX H ;POINT NEXT CALL COPYD ;GO MOVE IT MVI C,24 ;OUTER LOOP CTR FDIV5: LXI D,FTEMP+3 ;POINT DIVIDEND LXI H,FTEMP+7 ;AND DIVISOR MVI B,4 ;CTR CALL FSUBT ;GO SUBTRACT JNC FDIV6 ;BRIF NO GO LXI D,FTEMP+3 ;POINT DIVIDEND LXI H,FTEMP+7 ;AND DIVISOR MVI B,4 ;CTR CALL FADDT ;GO RE-ADD STC ;TURN ON CY FDIV6: CMC ;REVERSE CY MVI B,3 ;CTR LXI H,FACC+3 ;POINT LSB FDIV7: MOV A,M ;LOAD BYTE RAL ;SHIFT LEFT MOV M,A ;REPLACE DCX H ;POINT NEXT DCR B ;DECR CTR JNZ FDIV7 ;LOOP XRA A ;CLEAR FLAGS MVI B,4 ;CTR LXI H,FTEMP+3 ;POINT-DIVIDEND FDIV8: MOV A,M ;LOAD BYTE RAL ;SHIFT LEFT MOV M,A ;REPLACE DCX H ;POINT ENXT DCR B ;DECR CTR JNZ FDIV8 ;LOOP DCR C ;DECR OTR CTR JNZ FDIV5 ;LOOP JMP FNORM ;WRAPUP ; ; UTILITY ROUTINE TO GET A VARIABLE'S ADDRESS TO H,L ; GETST: LXI D,STRIN ;POINT BUFFER MVI B,0 ;INIT CTR MOV A,M ;GET THE CHAR CPI '"' ;TEST IF LIT TYPE JZ GETS2 ;BRIF IS CPI 27H ;TEST IF QUOTED LITERAL JZ GETS2 ;BRIF IS GETS1: CPI ',' ;TEST IF COMMA JZ GETS5 ;BRIF IS ORA A ;TEST IF END JZ GETS5 ;BRIF IS INR B ;COUNT IT INX D ;POINT NEXT STAX D ;PUT CHAR INX H ;POINT NEXT RST 1 ;SKIP SPACES JMP GETS1 ;LOOP GETS2: MOV C,A ;SAVE DELIM GETS3: INX H ;SKIP THE QUOTE MOV A,M ;GET NEXT CHAR CMP C ;TEST IF END OF LITERAL JZ GETS4 ;BRIF IS ORA A ;TEST IF END OF LINE JZ CVERR ;BRIF IS INR B ;COUNT IT INX D ;POINT NEXT STAX D ;PUT CHAR JMP GETS3 ;LOOP GETS4: INX H ;SKIP END QUOTE RST 1 ;SKIP TRAILING SPACES GETS5: LXI D,STRIN ;POINT BEGIN BUFFER MOV A,B ;GET COUNT STAX D ;PUT COUNT POP D ;GET RETURN ADDR XCHG ;FLIP/FLOP XTHL ;PUT RET ON STACK, HL OF VAR IN HL PUSH D ;SAVE H,L OF LOC CALL LET2A ;GO STORE STRING POP H ;RESTORE LOCATION RET ;RETURN GETS8: CALL VAR ;GET VAR NAME PUSH D ;SAVE ON STACK MOV A,D ;GET HI BYTE ORA A ;TEST IF ARRAY JP GETS9 ;BRIF NOT CALL SEARC ;GO GET ARRAY PARAMS MVI A,0FFH ;TURN ON SW STA DIMSW ;SET IT XTHL ;SWAP ADDR ON STACK CALL EXPR ;GO GET ROW, COL PTRS XTHL ;SWAP ADDR ON STACK CALL SUBSC ;GO POINT TO ENTRY XCHG ;EXCHANGE POP H ;GET ADDRESS OF STMT POP B ;GET NAME RET ;RETURN GETS9: CALL SEARC ;FIND ADDR POP B ;RESTORE NAME RET ;RETURN ; FOVUN EQU $ ; ; TEST EXPONENT FOR OVERFLO OR UNDERFLOW ; ORA A ;TEST IT JP FOV1 ;BRIF POS. CPI 0C1H ;TEST FOR MAX NEG RNC ;RETURN IF NO UNDER. MVI A,0C1H ;SET EXPONENT AT MINIMUM JMP UNERR FOV1: CPI 40H ;TEST MAX POS RC ;RETURN IF NO OVER. MVI A,3FH ;SET EXPONENT AT MAXIMUM JMP OVERR ; SUBSC EQU $ ; ; ; COMPUTES SUBSCR ADDR ; INPUT: B HAS ROW NUMBER (1ST SUB) ; D HAS COL NUMBER (2ND SUB) ; H HAS ADDR NAME ; PUSH D ;SAVE COL RST 4 ;ADJUST H,L DB -4 AND 0FFH ;BY FOUR MOV D,M ;GET HI DCX H ;POINT LO MOV E,M ;GET LO MOV A,D ;GET HI CMP B ;COMPARE JC SNERR ;BRIF EXCESS JNZ SUB1 ;BRIF NOT EQUAL MOV A,E ;GET LO CMP C ;COMPARE JC SNERR ;BRIF EXCESS SUB1: DCX H ;POINT HI COLS MOV D,M ;LOAD IT DCX H ;POINT LO COLS MOV E,M ;LOAD IT XTHL ;SAVE ADDRESS PUSH H ;SAVE SUB COL PUSH D ;SAVE DIM COLS INX D ;MAKE COLS=MAX+1 (ACCOUNT FOR 0 B??KE LXI H,0 ;GET A ZERO SUB2: MOV A,B ;GET HI ORA C ;PLUS LO JZ SUB3 ;BRIF ZERO DAD D ;ADD ONCE DCX B ;SUB ONCE JMP SUB2 ;LOOP SUB3: POP D ;GET DIM COL POP B ;GET SUB COL MOV A,D ;GET HI CMP B ;COMPARE JC SNERR ;BRIF GT JNZ SUB4 ;BRIF NOT ZERO MOV A,E ;GET LO CMP C ;COMPARE JC SNERR ;BRIF GT SUB4: DAD B ;ADD TO PROD DAD H ;TIMES TWO DAD H ;TIMES FOUR MOV A,L ;GET LOW CMA ;COMPLEMENT ADI 1 ;PLUS ONE MOV E,A ;SAVE IT MOV A,H ;GET HI CMA ;COMPLEMENT ACI 0 ;PLUS CARRY MOV D,A ;SAVE POP H ;GET ADDR (0,0) DAD D ;COMPUTE (I,J) RIGHT SIDE RST 4 ;ADJUST H,L DB -4 AND 0FFH RET ;RETURN FTEST EQU $ ; ; TEST THE SIGN OF THE NUMBER IN THE FACC ; RETURN WITH S & Z SET TO SIGN ; LDA FACC+1 ;GET MSD ORA A ;TEST IT RZ ;RETURN IF ZERO LDA FACC ;GET SIGN&EXPON BYTE ORI 7FH ;TEST SIGN BIT ONLY LDA FACC ;RE-LOAD EXPON BYTE RET ;THEN RETURN FEXP EQU $ ; ; EXPAND EXPONENT INTO 8 BINARY BITS ; ANI 7FH ;MASK MANTISA SIGN ADI 40H ;PROPAGATE CHAR SIGN TO LEFTMOST BIT XRI 40H ;RESTORE ORIGINAL SIGN BIT RET ;RETURN ; FSUBT EQU $ ; ; SUBTRACT THE TWO MULTIPRECISION NUMBERS (D,E) & (H,L) ; XRA A ;TURN OF CY FSB1: LDAX D ;GET A BYTE SBB M ;SUB OTHER BYTE STAX D ;PUT DOWN DCX D ;POINT NEXT DCX H ;DITTO DCR B ;DECR CTR JNZ FSB1 ;LOOP RET ;RETURN ; ; ADD TWO MULTI-PRECISION NUMBERS (D,E) & (H,L) ; FADT3: MVI B,3 FADDT: XRA A ;CLEAR STATUS FAD1: LDAX D ;GET BYTE ADC M ;ADD OTHER BYTE STAX D ;PUT DOWN DCX D ;POINT NEXT DCX H ;DITTO DCR B ;DECR LOOP CTR JNZ FAD1 ;LOOP RET ;RETURN ; FSHFT EQU $ ; ; INCREMENTING SHIFT RIGHT ; MOV A,M ;GET A BYTE RAR ;SHIFT RIGHT MOV M,A ;PUT DOWN INX H ;POINT NEXT DCR B ;DECR CTR JNZ FSHFT ;LOOP RET ;RETURN ;PAGE ; TERMI EQU $ ; ; READ A LINE FROM THE TTY ; FIRST PROMPT WITH THE CHAR IN THE A REG ; TERMINATE THE LINE WITH A X'00' ; IGNORE EMPTY LINES ; CONTROL C WILL CANCLE THE LINE ; CONTROL O WILL TOGGLE THE OUTPUT SWITCH ; RUBOUT WILL DELETE THE LAST CHAR INPUT ; ; STA PROMP ;SAVE THE PROMPT CHAR REIN: LXI H,IOBUF ;POINT TO INPUT BUFFER MVI M,0 ;MARK BEGIN INX H ;POINT START LDA PROMP ;GET THE PROMPT AGAIN CALL TESTO ;WRITE TO TERMINAL CPI '?' ;TEST IF Q.M. JNZ TREAD ;BRIF NOT MVI A,' ' ;GET SPACE CALL TESTO ;WRITE TO TERMINAL TREAD EQU $ IF NOT CPM IN TTY+1 ;GET TTY STATUS ANI 2 ;TEST IF RXRDY JZ TREAD ;LOOP TIL CHAR ENDIF CALL GETCH ;GO READ THE CHAR MOV M,A ;PUT IN BUFFER CPI 0AH ;TEST IF LINE FEED JZ TREAD ;IGNORE IF IT IS CPI 0DH ;TEST IF CR JNZ NOTCR ;BRIF NOT LDA TAPES ;GET PAPER TAPE SWITCH RAR ;TEST IF LOAD CNC CRLF ;CR/LF IF NOT CR1: MVI M,0 ;MARK END LDA ILSW ;GET INPUT LINE SW ORA A ;TEST IT RNZ ;RETURN IF ON DCX H ;POINT PRIOR MOV A,M ;LOAD IT CPI 20H ;TEST IF SPACE JZ CR1 ;BRIF SPACE ORA A ;TEST IF AT BEGINNING JZ REIN ;BRIF IS (NULL LINE) LXI H,IOBUF+1 ;POINT BEGIN RET ;ELSE, RETURN TESTO EQU $ IF NOT CPM PUSH PSW ;SAVE CHAR TEST1: IN TTY+1 ;GET STATUS RAR ;TEST IF TXRDY JNC TEST1 ;LOOP TILL READY POP PSW ;GET CHAR OUT TTY ;WRITE IT ENDIF IF CPM PUSH B ;BIOS CALLS DESTROYS C,DE PUSH D PUSH H MOV C,A ;OUTPUT BYTE CALL BTOUT ;CALL BIOS POP H POP D ;RESTORE POP B ENDIF IF LARGE ;SAVE ROOM ONLY IN 8+K VERSIONS DB 0,0,0 ;SAVE ROOM FOR CALL TO USER ROUTINE ENDIF RET ;RETURN CRLF: MVI A,0DH ;LOAD A CR CALL TESTO ;WRITE IT MVI A,0AH ;LF CALL TESTO ;WRITE IT MVI A,255 ;GET RUBOUT CHAR MVI B,0FAH ;LOAD 255-RUBOUT COUNT PAUZ: CALL TESTO ;SEND RUBOUT INR B ;INCREMENT COUNT CMP B ;COMPARE TO 255 JNZ PAUZ ;SET ANOTHER RUBOUT XRA A ;GET A ZERO STA COLUM ;RESET COLUMN POINTER RET ;RETURN NOTCR: CPI 15H ;TEST IF CONTROL-U JNZ NOTCO ;BRIF NOT CALL PRCNT ;GO PRINT ^U CALL CRLF ;GET CR/LF JMP REIN ;GO RE-ENTER NOTCO: CPI 7FH ;TEST IF RUBOUT JNZ NOTCH ;BRIF NOT LDA TAPES ;GET PAPER TAPE SW RAR ;TEST IF LOAD JC TREAD ;IGNORE IF LOAD DCX H ;POINT PRIOR MOV A,M ;LOAD PREV CHAR ORA A ;TEST IF BEGIN JZ ECHO ;BRIF IS MVI A,'\' ;BACK SLASH CALL TESTO ;WRITE IT MOV A,M ;FETCH CHARACTER TO BE DISCARDED CALL TESTO ;WRITE IT MVI A,'\' ;BACK SLASH CALL TESTO ;WRITE IT JMP TREAD ;GET REPLACEMENT CHARACTER NOTBS EQU $ IF LARGE ;CONTROL H WORKS ONLY ON 9K VERSION CPI 8 ;TEST FOR ASCII BACKSPACE JNZ NOTCH ;BRIF NOT CONTROL H DCX H ;POINT PRIOR MOV A,M ;FETCH CHARACTER ORA A ;TEST FOR BEGINNING JZ ECHO ;BRIF IT IS PUSH H ;SAVE POSITION LXI H,RBOUT ;POINT RUBOUT SEQUENCE CALL TERMM ;WRITE IT POP H ;RESTORE H,L JMP TREAD ;GET REPLACEMENT CHARACTER ENDIF NOTCH: LDA TAPES ;GET PAPER TAPE SWITCH RAR ;FLAG TO CARRY JC ECHO ;NO ECHO IF TAPE MOV A,M ;ELSE, LOAD THE CHAR CALL TESTO ;ECHO THE CHARCTER ECHO: INX H ;POINT NEXT POSIT JMP TREAD ;LOOP FOR NEXT ; TERMO EQU $ ; ; TTY PRINT ROUTINE ; ; OUTPUT STRING OF CHARS ; STARTING AT IOBUF +0 THRU END (FF OR FE OR 00) ; FOLLOWING IMBEDDED CHARACTERS ARE INTERPRETED AS CONTROLS: ; X'00' END OF BUFFER, TYPE CR/LF AND RETURN ; X'FE' END OF BUFFER, RETURN (NO CR/LF) ; X'FD' TYPE CR/LF, CONTINUE ; ; RETURN WITHOUT OUTPUT IF OUTPUT SW IS OFF ; LDA OUTSW ;GET OUTPUT SW ORA A ;TEST IT RNZ ;RETURN IF NO PRINT LXI H,IOBUF ;POINT I/O BUFFER OT1: MOV A,M ;LOAD A BYTE CPI 0FEH ;SEE IF END OF LINE (NO CR/LF) RZ ;RETURN IF EQUAL CPI 0FDH ;SEE IF IMBEDDED CR/LF JNZ OT2 ;BRIF NOT CALL CRLF ;LINE FEED JMP OT4 ;CONTINUE OT2: ORA A ;TEST IF END OF OUTPUT JZ CRLF ;BRIF IS MOV A,M ;LOAD THE BYTE CALL TESTO ;TYPE IT LDA COLUM ;GET COLUMN POINTER INR A ;ADD ONE STA COLUM ;RESTORE IT OT4: INX H ;POINT NEXT JMP OT1 ;LOOP TERMM EQU OT1 ; TABST EQU $ ; ; ; POSITION TTY AT NEXT TAB STOP ; ; LDA OUTSW ;GET OUTPUT SWITCH ORA A ;TEST IT RNZ ;RETURN IF SUPPRESSED LDA COLUM ;GET COLUMN POINTER CPI 56 ;COMPARE TO 56 JNC CRLF ;BRIF NO ROOM LEFT MOV B,A ;SAVE IT XRA A ;INIT POSITION TBLP: CMP B ;COMPARE JZ TBLP2 JNC TBON ;BRIF SHY OF TAB TBLP2: ADI 14 ;POINT NEXT STOP JMP TBLP ;LOOP TBON: STA COLUM ;UPDATE CTR SUB B ;COMPUTE NUMBER OF SPACES MOV B,A ;SAVE IT TBSPA: MVI A,' ' ;SPACE TO REG A CALL TESTO ;OUTPUT IT DCR B ;SUB 1 FROM CTR RZ ;RETURN IF ZERO JMP TBSPA ;ELSE, LOOP ; LINEO EQU $ ; ; UNPACK LINE NUMBER FROM (H,L) TO (D,E) ; ZERO SUPPRESS LEADING ZEROS ; ; PUSH B ;PUSH B,C MVI B,1 ;SET SWITCH CALL LOUT ;GO FORMAT 2 BYTES CALL LOUT ;THEN THE NEXT 2 POP B ;RESTORE B,C RET ;RETURN ; LOUT EQU $ MOV A,M ;GET BYTE ANI 0F0H ;ISOLATE LEFT HALF RAR ;SHIFT RIGHT 1 BIT RAR ;AGAIN RAR ;AGAIN RAR ;LAST TIME JNZ NOTZ1 ;BRIF NOT ZERO ORA B ;MERGE IN B JNZ Z1 ;BRIF ZERO NOTZ1: MVI B,0 ;RESET SWITCH ORI 30H ;ZONE STAX D ;PUT TO BUFFER INX D ;POINT NEXT Z1: MOV A,M ;LOAD BYTE ANI 0FH ;MASK JNZ NOTZ2 ;BRIF NOT ZERO ORA B ;MERGE SWITCH JNZ Z2 ;BRIF ZERO NOTZ2: MVI B,0 ;SET SWITCH OFF ORI 30H ;ZONE STAX D ;PUT TO BUFFER INX D ;POINT TO NEXT Z2: INX H ;AND NEXT LINE BYTE RET ;RETURN ; TSTCC EQU $ ; ; TEST IF KEY WAS PRESSED DURING EXECUTION ; CANCEL IF CONTROL-C ; TOGGLE OUTPUT SUPPRESS SW IF CONTROL-O ; IF NOT CPM IN TTY+1 ;GET TTY STATUS ANI 2 ;MASK FOR RXRDY RZ ;RETURN IF NO CHAR GETCH: IN TTY ;READ THE CHAR ANI 7FH ;TURN OFF PARITY ENDIF IF CPM ;NOTE: FOLLOWING CLOBBERS REGISTERS, ; PUSH AND POP IF FOUND TO CREATE BUGS. CALL BTSTAT ;CALL BIOS RZ ;RETURN ON NO CHAR GETCH: PUSH B ;SAVE REGS - CPM CAN CLOBBER PUSH D PUSH H CALL BTIN ;CALL BIOS TO INPUT POP H POP D POP B ENDIF CPI 3 ;TEST IF CONTROL C JNZ TSTC1 ;BRIF NOT CALL PRCNT ;GO PRINT ^C LDA EDSW ;GET MODE SW ORA A ;TEST IT JNZ KEY ;**;BRIF COMMAND MODE LXI H,STOPM ;POINT MSG CALL TERMM ;GO PRINT IT CALL PRLIN ;GO PRINT LINE JMP KEY ;GOTO READY TSTC1: CPI 0FH ;TEST IF CONTROL O RNZ ;RETURN IF NOT CALL PRCNT ;GO PRINT ^O LDA OUTSW ;GET OUTPUT SWTICH XRI 1 ;TOGGLE STA OUTSW ;PUT SW RET ;RETURN ; PRCNT EQU $ ; ; ; PRINTS ^ AND CHAR ; PUSH PSW ;SAVE CHAR MVI A,'^' ;GET UP ARROW CALL TESTO ;WRITE IT POP PSW ;GET CHAR ADI 64 ;TRNSLATE JMP TESTO ;WRITE IT ;PAGE ; COMP2 EQU $ ; ; CONTINUATION OF COMPARE (RST 2) ROUTINE ; ORA A ;TEST IT JNZ COMP5 ;BRIF NOT END COMP3: XRA A ;SET EQUAL STATUS COMP4: MOV A,M ;GET LAST CHAR POP B ;RESTORE B,C RET ;RETURN COMP5: CMP M ;COMPARE THE TWO CHARS JZ COMP6 ;BRIF EQUAL MOV A,B ;GET COUNT CPI 3 ;GET IF >= 3 JNC COMP3 ;BRIF NOT LESS THAN 3 JMP COMP4 ;BRIF LESS THAN 3 AND NOT EQUAL COMP6: INR B ;COUNT IT INX D ;POINT NEXT LIT INX H ;POINT NEXT VAR JMP COMP1 ;CONTINUE ; EOL EQU $ ; ; TESTS IF (H,L) IS END OF LINE ; ERROR-DL IF NOT ; RST 1 ;SKIP TO NON-BLANK CALL TSTEL ;TEST IF END LINE JNZ SNERR ;ERROR IF NOT CPI ':' ;TEST FOR MULTIPLE STATEMENT JNZ EOL1 ;BRIF NOT STA MULTI ;SET SWITCH EOL1: INX H ;POINT NEXT SHLD ENDLI ;SAVE POINTER RET ;RETURN ; TSTEL EQU $ ; ; TEST (H,L) FOR END OF STATEMENT (00H OR ':') ; RETURN WITH Z SET IF IT IS ; ORA A ;TEST FOR ZERO RZ ;RETURN IF IS CPI ':' ;TEST FOR MULTIPLE STATEMENT RET ;RETURN ; NOTEO EQU $ ; ; ; TEST IF (H,L) IS END OF LINE ; RETURN IF NOT, ERROR-DL IF IS ; RST 1 ;SKIP TO NON-BLANK CALL TSTEL ;TEST IF END OF LINE JZ SNERR ;ERROR IF IS RET ;ELSE, RETURN ; PACK EQU $ ; ; PACK LINE NUMBER FROM (H,L) TO B,C ; ; LXI B,0 ;CLEAR B AND C MVI A,4 ;INIT DIGIT COUNTER STA PRSW ;SAVE A PK1: MOV A,M ;GET CHAR CALL NUMER ;TEST FOR NUMERIC RNZ ;RETURN IF NOT NUMERIC ANI 0FH ;STRIP OFF ZONE MOV D,A ;SAVE IT LDA PRSW ;GET COUNT DCR A ;SUBTRACT ONE JM SNERR ;BRIF ERROR STA PRSW ;SAVE CTR MVI E,4 ;4 BIT SHIFT LOOP PK3: MOV A,C ;GET LOW BYTE RAL ;ROTATE LEFT 1 BIT MOV C,A ;REPLACE MOV A,B ;GET HIGH BYTE RAL ;ROTATE LEFT 1 BIT MOV B,A ;REPLACE DCR E ;DECR CTR JNZ PK3 ;LOOP MOV A,C ;GET LOW ORA D ;PUT DIGIT IN RIGHT HALF OF BYTE MOV C,A ;REPLACE INX H ;POINT NEXT BYTE JMP PK1 ;LOOP ; SQUIS EQU $ ; ; COMPRESS THE EXPR STACK ; REG A CONTAINS # OF BYTES TO REMOVE STARTING AT (H,L+1) ; CONTAINS TOTAL NUMBER OF CHARACTERS IN STACK THUS FAR ; PUSH H ;SAVE H,L MOV E,A ;COUNT TO E MVI D,0 ;ZERO HI BYTE DAD D ;COMPUTE START XCHG ;PUT TO D,E POP H ;GET H,L CMA ;COMPLEMENT COUNT INR A ;THEN 2'S COMPLEMENT ADD B ;COMPUTE B-A MOV B,A ;PUT TO B SQUI2: INX D ;POINT NEXT SEND INX H ;POINT NEXT RECEIVE LDAX D ;GET A CHAR MOV M,A ;PUT IT DOWN DCR B ;DECR CTR JNZ SQUI2 ;LOOP SHLD EXPRS ;UPDATE NEW START OF EXPR RET ;RETURN ; SKP2Z EQU $ ; ; FIND END OF LITERAL IN (D,E) ; LDAX D ;GET BYTE OF LIT ORA A ;TEST IT RZ ;RETURN IF ZERO (END) INX D ;ELSE, POINT NEXT JMP SKP2Z ;LOOP ; GTEMP EQU $ ; ; GETS FOUR BYTE TEMPORARY STORAGE AREA, ; STORES THE FACC THERE, ; PUTS ADDR OF AREA IN EXPR STACK (H,L) ; XCHG ;SAVE H,L IN D,E XTHL ;EXCHANGE 0 AND RET ADDR PUSH H ;PUT NEW RET ADDR PUSH H ;DOIT IT AGAIN LXI H,0 ;ZERO H,L DAD SP ;GET SP ADDR IN H,L INX H ;PLUS ONE INX H ;PLUS ONE MORE (POINT TO NEW AREA) PUSH B ;SAVE CTRS PUSH D ;SAVE EXPR ADDR PUSH H ;SAVE TEMP ADDR RST 3 ;GO STORE FACC POP D ;RESTORE TEMP ADDR LHLD SPCTR ;GET COUNT INX H ;PLUS ONE INX H ;ONE MORE SHLD SPCTR ;PUT BACK POP H ;RESTORE EXPR ADDR POP B ;RESTORE CTRS SADR: INX H ;POINT NEXT BYTE MOV M,D ;HIGH BYTE TO EXPRSTK INX H ;POINT NEXT MOV M,E ;LOW BYTE TO EXPR STK INX H ;POINT NEXT MVI M,0E3H ;CODE = NUMERIC DATA RET ;RETURN ; ALPHA EQU $ ; ; TESTS THE CHAR AT (H,L) ; RETURNS WITH Z SET IF CHAR IS ALPHA (A-Z) ; RETURNS WITH Z OFF IF NOT ALPHA ; CHAR IS LEFT IN REG A ; MOV A,M ;PUT CHAR TO REG A CPI 'A' ;TEST IF A OR HIGHER RC ;RETURN IF NOT ALPHA (Z IS OFF) CPI 'Z' ;TEST IF Z OR LESS JMP NUMEN ;GO WRAPUP ; NUMER EQU $ ; ; TESTS THE CHAR AT (H,L) ; RETURNS WITH Z SET IF NUMERIC (0-9) ; ELSE Z IS OFF ; CHAR IS LEFT IN THE A REG ; MOV A,M ;GET CHAR TO REG A CPI '0' ;TEST IF ZERO OR GREATER RC ;RETURN IF LESS THAN ZERO CPI '9' ;TEST IF 9 OR LESS NUMEN: RZ ;RETURN IF 9 RNC ;RETURN IF NOT NUMERIC CMP A ;SET Z RET ;RETURN ; SEARC EQU $ ; ; SEARCHES FOR THE VARIABLE IN D,E ; RETURNS WITH ADDR OF DATA AREA FOR VARIABLE ; PUSH H ;SAVE H,L LDA FNMOD ;GET FUNCTION MODE ORA A ;TEST IT JNZ SCH6 ;BRIF IN A FUNCTION SCH0: LHLD DATAB ;GET ADDR OF DATA POOL SCH1: MOV A,M ;GET THE BYTE ORA A ;TEST IF END JZ SCH3 ;BRIF END DCX H ;POINT NEXT DCX H ;DITTO MOV B,M ;GET HI LEN DCX H ;POINT NEXT MOV C,M ;GET LO LEN RST 4 ;ADJUST H,L DB 3 MOV A,M ;LOAD 1ST CHAR CMP D ;COMPARE 1ST CHAR JNZ SCH2 ;BRIF NOT EQUAL DCX H ;POINT NEXT MOV A,M ;LOAD 2ND DIGIT INX H ;POINT BACK CMP E ;COMPARE 2ND CHAR JNZ SCH2 ;BRIF NOT EQUAL MOV A,D ;GET HI NAME ORA A ;TEST IT JM SCH9 ;RETURN IF MATRIX DAD B ;POINT NEXT ENTRY INX H ;PLUS ONE XCHG ;FLIP/FLOP POP H ;RESTORE H RET ;RETURN SCH2: DAD B ;MINUS LEN JMP SCH1 ;LOOP SCH3: MOV M,D ;PUT 1ST CHAR DCX H ;POINT NEXT MOV M,E ;PUT 2ND CHAR DCX H ;POINT NEXT MOV A,D ;GET HI NAME ORA A ;TEST IT JM SCH7 ;BRIF ARRAY MVI M,0FFH ;HI LEN DCX H ;POINT NEXT MOV A,E ;GET LO NAME ORA A ;TEST TYPE JM SCH4 ;BRIF CHAR MVI M,0F8H ;LO LEN MVI B,4 ;LOOP CTR JMP SCH5 ;BRARND SCH4: MVI M,0FBH ;LO LEN MVI B,1 ;LOOP CTR SCH5: DCX H ;POINT NEXT MVI M,0 ;ZERO THE VALUE DCR B ;DECR CTR JNZ SCH5 ;LOOP DCX H ;POINT NEXT MVI M,0 ;MARK NEW END INX H ;POINT ADDR OF VARIABLE XCHG ;PUT LOCATION TO D,E POP H ;RESTORE H,L RET ;RETURN SCH6: LXI H,FNARG ;POINT DUMMY ARG MOV A,M ;LOAD 1ST CHAR CMP D ;COMPARE JNZ SCH0 ;BRIF NOT EQUAL INX H ;POINT NEXT MOV A,M ;LOAD 2ND CHAR CMP E ;COMPARE JNZ SCH0 ;BRIF NOT EQUAL INX H ;POINT NEXT MOV D,M ;GET HI ADDR INX H ;POINT NEXT MOV E,M ;GET LO ADDR POP H ;RESTORE H,L RET ;RETURN SCH7: PUSH H ;SAVE ADDRESS MVI M,0FEH ;MOVE HI DISP DCX H ;POINT NEXT MVI M,14H ;MOVE LO DISP DCX H MVI M,0 ;MOVE A ZERO DCX H ;POINT NEXT MVI M,10 ;MOVE 10 DCX H ;POINT NEXT MVI M,0 ;MOVE A ZERO DCX H ;POINT NEXT MVI M,10 ;MOVE A 10 (DEFAULT IS 10 X 10) LXI B,485 ;TOTAL # OF BYTES TAKEN BY ARRAY SCH8: DCX H ;POINT NEXT MVI M,0 ;CLEAR ONE BYTE DCX B ;DCR CTR MOV A,B ;GET HI ORA C ;PLUS LO JNZ SCH8 ;LOOP POP H ;RESTORE PTR TO START INX H ;POINT LO NAME INX H ;POINT HI NAME SCH9: POP B ;NEED TO XCHANGE LAST 2 STACK ENTRIES POP D ;SO DOIT PUSH B PUSH D RET ;RETURN ; VAR EQU $ ; ; ; TEST (H,L) FOR A VARIABLE NAME ; PUTS THE NAME IN D,E IF FOUND ; ERROR SN IF NONE FOUND ; RST 1 ;SKIP TO NON-BLANK CALL ALPHA ;TEST IF ALPHA JNZ SNERR ;BRIF NOT ALPHA MOV D,A ;FIRST CHAR MVI E,' ' ;DEFAULT INX H ;POINT NEXT RST 1 ;GET 2ND CHAR CALL NUMER ;TEST IF NUMERIC JNZ VAR2 ;BRIF NOT NUMERIC MOV E,A ;SAVE 2ND CHAR INX H ;POINT NEXT RST 1 ;GET NON-BLANK FOLLOWING VAR2: CPI '$' ;TEST IF STRING JNZ VAR3 ;BRIF NOT MOV A,E ;GET 2ND CHAR ORI 80H ;SET TYPE MOV E,A ;SAVE IT INX H ;SKIP $ RET ;THEN RETURN VAR3: CPI '(' ;TEST IF ARRAY RNZ ;RETURN IF NOT MOV A,D ;GET HI NAME ORI 80H ;TURN ON D7 MOV D,A ;RESTORE RET ;RETURN ; PRLIN EQU $ ; ; PRINTS LINE NUMBER FOLLOWED BY CR/LF ; LXI D,LINEN ;POINT AREA LHLD LINE ;GET ADDR OF LINE NUMBER CALL LINEO ;GO UNPACK XCHG ;PUT TO H,L MVI M,0 ;END OF MSG LXI H,LINEN ;POINT AREA JMP TERMM ;GO PRINT IT ;PAGE ; ; ERROR MESSAGE ROUTINES ; FATAL ERROR MUST BE FIRST ; EM EQU 0FEH ; ULERR: RST 6 DB 'UL',EM,FATAL ;NOTE FATAL = CODE FOR RST 6 ZMERR EQU $-1 ;LOG(X<=0),SQR(-X),0 DIVIDE DB 'OF',EM,FATAL STERR EQU $-1 ;ERROR IN EXPRESSION STACK DB 'ST',EM,FATAL SNERR EQU $-1 ;DELIMITER ERROR DB 'SN',EM,FATAL RTERR EQU $-1 ;RETURN & NO GOSUB DB 'RT',EM,FATAL DAERR EQU $-1 ;OUT OF DATA DB 'DA',EM,FATAL NXERR EQU $-1 ;NEXT & NO FOR / >8 FOR'S DB 'NX',EM,FATAL CVERR EQU $-1 ;CONVERSION ERROR DB 'CV',EM,FATAL CKERR EQU $-1 ;CHECKSUM ERROR DB 'CK',EM,FATAL ; ; NON-FATAL ERRORS ; OVERR EQU $-1 ;OVERFLOW ERROR DB 'OV',EM RET ;RETURN TO ROUTINE UNERR: RST 6 ;CALL ERROR ROUTINE DB 'UN',EM RET ; ; CONTINUATION OF ERROR MESSAGE ROUTINE (RST 6) ; ERROR: CALL TERMM ;PRINT 'XX' PUSH H ;SAVE RETURN LXI H,ERRMS ;PRINT 'ERROR IN LINE' CALL TERMM CALL PRLIN ;PRINT LINE # POP H INX H ;RETURN ADDRESS MOV A,M ;GET INSTRUCTION CPI FATAL ;IS IT AN RST 6? JZ KEY ;IF ZERO, YES, ABORT POP B ;RESTORE REGISTERS POP D POP PSW XTHL RET ;PAGE ; ; ; MOVE THE STRING FROM (D,E) TO (H,L) COUNT IN B ; ; CPY4D: MVI B,4 COPYD: LDAX D ;GET A BYTE MOV M,A ;MOVE IT INX H ;POINT NEXT INX D ;DITTO DCR B ;DECR CTR JNZ COPYD ;LOOP RET ;THEN RETURN ; ; ; MOVE THE STRING FROM (H,L) TO (D,E) COUNT IN B ; ; CPY4H: MVI B,4 COPYH: XCHG ;FLIP/FLOP CALL COPYD ;GO COPY XCHG ;FLIP/FLOP BACK RET ;RETURN ; ZEROM EQU $ ; ; MOVES A STRING OF BINARY ZEROS, COUNT IN B ; MVI M,0 ;MOVE A ZERO INX H ;POINT NEXT DCR B ;DECR CTR JNZ ZEROM ;LOOP RET ;RETURN ; FBIN EQU $ ; ; ; CONVERT FLOAT ACC TO UNSIGNED BINARY NUMBER IN A REG ; RETURNS 0 IN A REG IF FACC<0 OR FACC>255 ; ; PUSH H ;SAVE H,L PUSH D ;SAVE D,E CALL FACDE ;CONVERT FACC TO D,E XRA A ;ZERO A ORA D ;TEST HIGH VALUE JNZ FBIN1 ;BRIF NOT ZERO MOV A,E ;VALUE TO A FBIN1: POP D ;RESTORE D,E POP H ;RESTORE H,L RET ;RETURN ; ARG EQU $ ; ; GET NEXT ARGUMENT FROM POLISH STACK ; LHLD ADDR1 ;GET ADDRESS INX H ;POINT NEXT MOV D,M ;GET HI ADDRESS INX H ;POINT NEXT MOV E,M ;GET LO ADDRESS INX H ;POINT TYPE SHLD ADDR1 ;GET ADDRESS DCX H ;POINT BACK JMP EVLD ;CALL EVLOAD AND RETURN ; ; ARGNU EQU $ ; CALL ARG ;GET ARGUMENT JMP FBIN ;THEN CONVERT FACC TO BIN ; BINFL EQU $ ; ; CONVERT D,E TO FLOATING POINT NUMBER IN FAC ; ; LXI H,FACC ;POINT ACC MVI M,24 ;MAX BITS INX H ;POINT NEXT MVI M,0 ;CLEAR MSB INX H ;POINT NEXT MOV M,D ;MOVE MID INX H ;POINT NEXT MOV M,E ;MOVE LSB JMP FNORM ;GO NORMALIZE & RETURN ;PAGE ; ; FUNCTION TABLE. FORMAT IS: ; DB ,0 ; DW
; DB ; ; TABLE IS TERMINATED WITH A '00' ; FUNCT EQU $ DB 'ABS',0 DW ABS DB 0ABH DB 'SQR',0 DW SQR DB 0ABH DB 'INT',0 DW INT DB 0ABH DB 'SGN',0 DW SGN DB 0ABH RNDLI: DB 'RND',0 DW RND DB 0ABH DB 'SIN',0 DW SIN DB 0ABH DB 'COS',0 DW COS DB 0ABH DB 'TAN',0 DW TAN DB 0ABH DB 'ATN',0 DW ATN DB 0ABH DB 'INP',0 DW INP DB 0ABH DB 'LN',0 DW LN DB 0ABH DB 'LOG',0 DW LOG DB 0ABH DB 'EXP',0 DW EXP DB 0ABH DB 'POS',0 DW POS DB 0ABH DB 'LEN',0 DW LENFN DB 0ABH DB 'CHR$',0 DW CHRFN DB 0CBH DB 'ASCII',0 DW ASCII DB 0ABH DB 'NUM$',0 DW NUMFN DB 0CBH DB 'VAL',0 DW VAL DB 0ABH DB 'SPACE$',0 DW SPACE DB 0CBH DB 'STRING$',0 DW STRFN DB 0D3H DB 'LEFT$',0 DW LEFT DB 0D3H DB 'RIGHT$',0 DW RIGHT DB 0D3H DB 'MID$',0 DW MIDFN DB 0DBH DB 'INSTR',0 DW INSTR DB 0BBH DB 'PEEK',0 DW PEEK DB 0ABH IF LARGE DB 0,0,0,0 ;ROOM FOR ONE MORE FUNCTION DB 0,0,0,0 ENDIF DB 0 ;END OF FUNCTION TABLE ;PAGE ; ; PROGRAM CONSTANTS ; PCHOF: DB 19,20,0 RNDP: DB 3FH,0FDH ;16381 DB 3FH,0EBH ;16363 DB 3FH,0DDH ;16349 NRNDX: DB 1BH,0ECH DB 33H,0D3H DB 1AH,85H DB 2BH,1EH WHATL: DB 'WHAT',0 VERS EQU $ ;VERSION MESSAGE IF LARGE DB '9K VERS 1.4',0 RBOUT: DB 08H,20H,08H,0FEH ;RUBOUT SEQUENCE (9K ONLY) ENDIF IF NOT LARGE DB '8K VERS 1.4',0 ENDIF LLINE: DB 'LINE',0 TABLI: DB 'TAB',0 STEPL: DB 'STEP',0 THENL: DB 'THEN',0 PILIT: DB 'PI',0 TWO: DB 02H,80H,00H,00H ;CONSTANT: 2 TEN: DB 04H,0A0H,00H,00H ;CONSTANT: 10 PI: DB 02H,0C9H,0FH,0D7H ;CONSTANT: 3.141593 QTRPI: DB 00H,0C9H,0FH,0D7H ;CONSTANT: 0.7853892 NEGON: DB 80H,0FFH,0FFH,0FFH ;CONSTANT: -0.9999999 LN2C: DB 00H,0B1H,72H,16H ;CONSTANT: 0.6931472 SQC1: DB 00H,97H,14H,0EBH ;CONSTANT: 0.59016206 SQC2: DB 7FH,0D5H,0A9H,56H ;CONSTANT: 0.41730759 ;PAGE ; ; THE FOLLOWING CONSTANTS MUST BE IN THIS ORDER *********** ; ; CONSTANT WITH EXPONENT OF 1 ; COEFFICIENT OF FIRST TERM ; ... ; COEEFICIENT OF NTH TERM ; ; SINCE ALL COEFFICIENTS ARE LESS THAN 1, ; THE ITERATION LOOP USES THE ; CONSTANT WITH EXPONENT 1 TO TERMINATE THE EVALUATION. ; SQC3: DB 01H,0B5H,04H,0F3H ;CONSTANT: 1.41421356 DB 0FFH,0AAH,95H,0BCH ;CONSTANT: -0.3331738 DB 7EH,0CAH,0D5H,20H ;CONSTANT: 0.1980787 DB 0FEH,87H,82H,0D6H ;CONSTANT: -0.1323351 DB 7DH,0A3H,13H,1CH ;CONSTANT: 0.07962632 DB 0FCH,89H,0A6H,0B8H ;CONSTANT: -0.03360627 ATNCO: DB 79H,0DFH,3AH,9EH ;CONSTANT: 0.006812411 ; HALFP: DB 01H,0C9H,0FH,0D7H ;CONSTANT: 1.570796 DB 80H,0A5H,5DH,0DEH ;CONSTANT: -0.64596371 DB 7DH,0A3H,34H,55H ;CONSTANT: 0.076589679 DB 0F9H,99H,38H,60H ;CONSTANT: -0.0046737656 SINCO: DB 74H,9EH,0D7H,0B6H ;CONSTANT: 0.00015148419 ; ONE: DB 001H,080H NULLI: DB 00H,00H ;CONSTANT: 1.0 DB 00H,0FFH,0FEH,0C1H ;CONSTANT: 0.99998103 DB 0FFH,0FFH,0BAH,0B0H ;CONSTANT: -0.4994712 DB 7FH,0A8H,0EH,2BH ;CONSTANT: 0.3282331 DB 0FEH,0E7H,4BH,55H ;CONSTANT: -0.2258733 DB 7EH,89H,0DEH,0E3H ;CONSTANT: 0.134693 DB 0FCH,0E1H,0C5H,078H ;CONSTANT: -0.05511996 LNCO: DB 7AH,0B0H,3FH,0AEH ;CONSTANT: 0.01075737 ; LN2E: DB 001H,0B8H,0AAH,03BH ;CONSTANT: 1.44269504 DB 000H,0B1H,06FH,0E6H ;C=.69311397 DB 07EH,0F6H,02FH,070H ;C=.24041548 DB 07CH,0E1H,0C2H,0AEH ;C=.05511732 DB 07AH,0A0H,0BBH,07EH ;C=.00981033 EXPCO: DB 077H,0CAH,009H,0CBH ;C=.00154143 ; LNC: DB 07FH,0DEH,05BH,0D0H ;C=LOG BASE 10 OF E READY EQU $ DB 0FDH DB 'READY',0 STOPM EQU $ DB 0FDH DB 'STOP AT LINE ',254 ERRMS: DB ' ERROR IN LINE ',0FEH TTY EQU 2 ;PAGE ; ; VERB (STATEMENT/COMMAND) TABLE ; FORMAT IS: DB 'VERB',0 ; DW ADDR ; DB 'NEXT VERB',0 ; ETC ; END OF TABLE IS MARKED BY DB 0 ; JMPTB EQU $ DB 'LIST',0 DW LIST DB 'RUN',0 DW RUNCM DB 'XEQ',0 DW XEQ DB 'NEW',0 DW NEW DB 'CON',0 DW CONTI DB 'TAPE',0 DW TAPE DB 'SAVE',0 DW SAVE KEYL: DB 'KEY',0 DW KEY DB 'FRE',0 DW FREE DB 'IF',0 DW IFSTM DB 'READ',0 DW READ DB 'RESTORE',0 DW RESTO DATAL: DB 'DATA',0 DW RUN DB 'FOR',0 DW FOR NEXTL: DB 'NEXT',0 DW NEXT GOSBL: DB 'GOSUB',0 DW GOSUB DB 'RETURN',0 DW RETUR DB 'INPUT',0 DW INPUT DB 'PRINT',0 DW PRINT GOTOL: DB 'GO' TOLIT: DB 'TO',0 DW GOTO DB 'LET',0 DW LET DB 'STOP',0 DW STOP DB 'END',0 DW ENDIT DB 'REM',0 DW RUN DB '!',0 DW RUN DB '?',0 DW PRINT DB 'RANDOMIZE',0 DW RANDO DB 'ON',0 DW ON DB 'OUT',0 DW OUTP DB 'DIM',0 DW DIM DB 'CHANGE',0 DW CHANG DEFLI: DB 'DEF' FNLIT: DB 'FN',0 DW RUN IF CPM DB 'DDT',0 DW DDT DB 'BYE',0 DW BOOT ENDIF DB 'POKE',0 DW POKE DB 'CALL',0 DW JUMP IF LARGE ;INCLUDE ONLY IN 8K+ VERSION DB 'EDIT',0 DW FIX DB 'CLOAD',0 DW CLOAD DB 'CSAVE',0 DW CSAVE ENDIF IF HUNTER DB 'BAUD',0 DW BAUD ENDIF DB 0 ;END OF TABLE ; ; DDT COMMAND, CPM ONLY ; IF CPM DDT: RST 7 JMP RDY ENDIF ;PAGE ; FACDE EQU $ ; ; THIS ROUTINE CONVERTS THE FACC TO AN ADDRESS IN D,E ; CALL INT ;INTEGERIZE THE FACC LDA FACC ;GET THE EXPONENT ORA A ;TEST IT JM OVERR ;BRIF NEGATIVE ADDRESS SUI 16 ;SUBTRACT MAX EXPONENT JZ FDE2 ;BRIF EQUAL MAX JP OVERR ;BRIF GREATER THAN 64K CMA ;2'S COMPLIMENT OF A YIELDS.. INR A ;16-A MOV C,A ;SAVE SHIFT COUNT FDE1: XRA A ;CLEAR CARRY LXI H,FACC+1 ;POINT MANTISSA MVI B,2 ;WORDS TO SHIFT CALL FSHFT ;GO SHIFT FACC+1 AND FACC+2 DCR C ;REDUCE COUNT JNZ FDE1 ;LOOP TILL COMPLETE FDE2: LXI H,FACC+1 ;POINT HIGH BYTE MOV D,M ;LOAD D INX H ;POINT LOW BYTE MOV E,M ;LOADE E RET ;RETURN ; ; LOCAT EQU $ ; ; THIS ROUTINE SEARCHES FOR A LINE IN THE PROGRAM FILE. ; Z SET, C RESET==>LINE FOUND. ADDRESS IS IN H,L ; C SET, Z RESET==>NOT FOUND. H,L POINT TO NEXT LINE ; C SET, Z SET==>NOT FOUND. H,L POINT AT END OF PROGRAM ; LXI H,BEGPR ;POINT START FIND1: MOV A,M ;FETCH LENGTH OF LINE PUSH H ;SAVE POINTER ORA A ;TEST JZ FIND3 ;BRIF END INX H ;POINT LINE # MOV A,M ;FETCH HI # CMP B ;COMPARE TO REQUESTED JC FIND2 ;BRIF LOW JNZ FIND3 ;BRIF PAST AND NOT FOUND INX H ;POINT LO # MOV A,M ;FETCH IT CMP C ;COMPARE TO REQUESTED JC FIND2 ;BRIF LOW JNZ FIND3 ;BRIF PAST AND NOT FOUND POP H ;POINT BEGIN IF MATCH RET ;RETURN ; ; BUMP H,L TO NEXT LINE ; FIND2: POP H ;POINT START OF LINE MOV E,M ;LENGHT TO E MVI D,0 ;CLEAR D DAD D ;BUMP H,L JMP FIND1 ;CONTINUE ; ; LINE NOT FOUND ; FIND3: STC ;SET CARRY POP H ;POINT LINE JUST PAST REQUESTED RET ;RETURN ; ; SEEK EQU $ ; ; THIS CODE FINDS AN ENTRY IN THE TABLE POINTED TO BY D,E. ; THE SOUGHT ENTRY IS POINTED TO BY H,L. ; SEEK1: PUSH H ;SAVE ADDRESS OF STRING LDAX D ;GET BYTE FROM TABLE ORA A ;TEST IT JZ SEEK3 ;BRIF END OF TABLE RST 2 ;COMPARE JNZ SEEK2 ;BRIF NOT FOUND XTHL ;PUT CURRENT H,L ON STACK CALL SKP2Z ;FIND END TO LITERAL IN TABLE INX D ;POINT LOW BYTE POP H ;RESTORE LINE POINTER INR A ;PUT 1 IN A ORA A ;RESET Z BIT RET ;RETURN SEEK2: CALL SKP2Z ;FIND END OF TABLE LITERAL INX D ; INX D ;POINT NEXT LIT IN TABLE INX D ; POP H ;GET ORIGINAL STRING LDAX D ;GET BYTE RAL ;HIGH BIT TO CARRY JNC SEEK1 ;NOT A FUNCTION SEARCH INX D ;POINT NEXT BYTE IN FUNCTION TABLE JMP SEEK1 ;CONTINUE SEARCH SEEK3: POP H ;RESTORE ORIGINAL STRING RET ;RETURN IF LARGE ;ASSEMBLE THE REMAINDAR ONLY FOR 8+K ; ; ; EDIT COMMAND ; EDIT ; FIX: EQU $ RST 1 ;SKIP BLANKS CALL PACK ;GET LINE # IN B,C RST 1 ;SKIP BLANKS SHLD ADDR2 ;SAVE COMMAND POINTER CALL LOCAT ;SEARCH FOR LINE # IN PROGRAM JC ULERR ;BRIF NOT FOUND PUSH H ;SAVE ADDR OF EXISTING LINE PUSH B ;SAVE LINE # MOV B,M ;GET LENGTH OF XCHG ;D,E POINT LXI H,STRIN ;POINT STRING BUFFER CALL COPYD ; TO STRING BUFFER LDA STRIN ;LENGTH OF TO A SUI 2 ;ADJUST STA STRIN ;STORE LXI D,IOBUF+1 ;POINT BUFFER LHLD ADDR2 ;FETCH COMMAND POINTER MOV B,M ;FETCH ; ; FIND LENGTH OF . STORE IT IN IOBUF. ; MVI C,0 ;INITIAL LENGTH FIX1: INX H ;POINT NEXT CHARACTER MOV A,M ;FETCH ORA A ;TEST JZ SNERR ;MISSING 2ND . CMP B ;TEST JZ FIX2 ;BRIF 2ND FOUND INR C ;ELSE, BUMP C STAX D ;STORE CHARACTER IN IOBUF INX D ;BUMP IOBUF POINTER JMP FIX1 ;CONTINUE ; ; GET READY TO SEARCH FOR ; FIX2: MOV A,C ;LENGTH OF TO A STA IOBUF ;STORE SHLD ADDR2 ;SAVE COMMAND POINTER MVI A,3 ;SEARCH WILL START IN POS 3. LHLD PROGE ;POINT END OF PROGRAM INX H ;BUMP TWICE INX H SHLD ADDR1 ;SAVE EXPR. STACK POINTER INX H ;POINT NEXT LXI D,IOBUF ;POINT BUFFER AREA MOV M,D ;STORE ADDRESS INX H MOV M,E LXI H,STRIN ; POINT ; ; USE THE INSTR ROUTINE TO SEARCH ; CALL INST2 ;GO SEARCH MOV A,E ;RESULT TO A ORA A ;TEST JZ DAERR ;BR IF NOT FOUND MOV C,A ;SAVE POSITION IN C DCR A ;ADJUST MOV B,A ;COPY TO B LXI H,STRIN+1 ;POINT LXI D,IOBUF+1 ;PIONT CALL COPYH ;COPY UP TO PUSH D ;SAVE DEST POINTER ; ; SKIP OVER IN ; MVI D,0 ;CLEAR D LDA IOBUF ;GET LENGTH OF MOV E,A ;LENGTH TO E DAD D ;BUMP H,L PAST POP D ;RESTORE POINTER PUSH H ;SAVE POINTER ; ; APPEND TO ; LHLD ADDR2 ;FETCH COMMAND POINTER FIX3: INX H ;POINT NEXT MOV A,M ;FETCH CHARACTER ORA A ;TEST IT JZ FIX4 ;BRIF NO MORE INR C ;BUMP LENGTH COUNT STAX D ;STORE CHARACTER INX D ;BUMP POINTER JMP FIX3 ;CONTINUE ; ; APPEND TO ; FIX4: POP H ;GET REMAINING SOURCE POINTER FIX4A: MOV A,M ;FETCH CHARACTER ORA A ;TEST JZ FIX5 ;BRIF DONE STAX D ;STORE CHARACTER INR C ;BUMP CHAR COUNT INX D ;BUMP DEST POINTER INX H ;BUMP POINTER JMP FIX4A ;CONTINUE ; ; PREPARE FOR SUBMISSION AS NEW LINE ; FIX5: STAX D ;BUFFER TERMINATOR INR C ;BUMP LENGTH COUNT MOV A,C ;FETCH COUNT STA IOBUF ;STORE IT MOV B,A ;COPY COUNT TO B LXI H,IMMED ;POINT NEW LINE AREA LXI D,IOBUF ;POINT WHERE IT IS NOW CALL COPYD ;COPY IT POP B ;RESTORE LINE # POP H ;RESTORE PROGRAM POINTER PUSH H ;SAVE IT JMP EDIT2 ;PROCESS AS NEW LINE ;PAGE ; ; TAPE CASSETTE COMMANDS ; ; ; TAPE CASSETTE EQUATES ; SWCH EQU 0FFH ;SWITCH PORT CASC EQU 3 ;STATUS PORT FOR TARBELL CASD EQU 0 ;DATA PORT CFLAG EQU 4 ;DATA FLAG FOR TARBELL ON MIO ; ; CASSETTE FILE FORMAT ; ; EACH RECORD: ; TYPE BYTE: 4 FOR BASIC PROGRAM, ; PLUS BIT 7 ON IF DATA NOT HEADER RECORD ; LENGTH BYTE: # DATA BYTES (1-128) ; 2 BYTES OF CHECKSUM ; ; EACH FILE BEGINS WITH A HEADER RECORD ; TYPE 4 ; LENGTH: 7 ; 5 CHARS FILENAME, BLANK-FILLED ; 2 BYTES TOTAL LENGTH OF DATA IN FILE ; 2 BYTES OF CHECKSUM ; ; AND HAS N DATA RECORDS ; TYPE: 84 ; LENGTH: 128 EXCEPT LAST RECORD MAY BE LESS ; DATA: NEXT (LENGTH) BYTES OF IMAGE OF PROGRAM AREA ; CHECKSUM: 2 BYTES, 2'S COMPLEMENT OF SUM OF BYTES ; ; FILES OF TYPE OTHER THAN 4 ARE IGNORED BY BASIC ; ; HARDWARE USED: ; IMSAI MIO BOARD, CASSETTE DATA ON PORT 0, ; STATUS ON PORT 3, ; CASSETTE READY JUMPERED TO BIT 2 OF PORT 3. ; ; ; TAPE UTILITY ROUTINE ; ; WATCH WAIT FOR TARBELL READY OR CONTROL-C ; WATCH: PUSH B ;SAVE REGS - CPM STATUS CALL CAN CLOBBER PUSH D PUSH H CALL TSTCC ;TEST FOR CNTRL-C POP H ;RESTORE REGS IN CPM DEBUGGING MODE POP D POP B IN CASC ;READ STATUS PORT ANI CFLAG ;TEST JZ WATCH ;LOOP TILL RE^AADY RET ; ; ; CASI CASSETTE INPUT TO A-REGISTER ; CASI: CALL WATCH ;WAIT TIL READY IN CASD ;READ FROM DATA PORT RET ; ; ; RECO WRITE A RECORD TO THE TARBELL. ; D,E==>TYPE, LENGTH BYTES ; H,L==>START OF SOURCE ; RETURNS UPDATED SOURCE POINTER IN DE ; RECO: MOV A,D ;TYPE BYTE CALL CASO ;WRITE IT MOV A,E ;COUNT CALL CASO ;WRITE IT MOV B,E ;COUNT XCHG ;SOURCE NOW IN DE LXI H,0 ;INITIAL CHECKSUM NCHAR: LDAX D ;FETCH NEXT CHAR CALL CASO ;WRITE IT INX D ;PNT NEXT CHAR CALL CKSUM ;ADD TO CKSUM, PUT ADD IN LIGHTS DCR B ;REDUCE COUNT JNZ NCHAR ;LOOP ON COUNT DCX H ;ADJUST HL FOR COMPLIMENT MOV A,H ;WRITE CHECKSUM CMA CALL CASO MOV A,L CMA ;WRITE LAST BYTE & RETURN ; ; ; CASO CASSETTE OUTPUT BYTE FROM A-REGISTER ; CASO: PUSH PSW CALL WATCH ;WAIT TILL READY POP PSW OUT CASD ;WRITE TO DATA PORT RET ; ; ; CKSUM CALCULATE THE CHECKSUM: ; ADD A TO HL ; ALSO OUTPUS HI ADDR TO SENSE LIGHTS ; CKSUM: ADD L ;ADD PREVIOUS LO MOV L,A ;SAVE NEW LO RNC INR H ;PROPAGATE CARRY ; ; ; SENSE OUTPUT HI ADDR FROM D TO LIGHTS ; SENSE: MOV A,D CMA OUT SWCH RET ; ; ; RECI INPUT A RECORD FROM THE TARBELL ; TAKES A BUFFER POINTER IN HL ; RETURNS UPDATED POINTER IN DE, ; RECORD TYPE IN A, RECORD LENGTH IN C ; CLOBBERS B,H,L ; RECI: CALL CASI ;GET TYPE PUSH PSW ;SAVE TYPE TO RETURN TO CALLER CALL CASI ;GET LENGTH MOV C,A ;STORE LEN MOV B,A ;IN B ALSO XCHG ;PUT DESTINATION PTR IN DE LXI H,0 ;INITIAL CHECKSUM RECI1: CALL CASI ;INPUT BYTE STAX D ;STORE IT CALL CKSUM ;UPDATE CKSUM, PUT ADDR IN LIGHTS DCR B ;LOOP ON COUNT JNZ RECI1 PUSH D ;SAVE DESTINATION PTR CALL CASI ;INPUT CHECKSUM MOV D,A CALL CASI MOV E,A DAD D ;COMPARE MOV A,H ORA L JNZ CKERR ;BRIF CHECKSUM ERROR POP D ;RESTORE DEST PTR POP PSW ;RESTORE RECORD TYPE BYTE RET ; ; ; CSAVE COMMAND ; CSAVE: RST 1 ;SKIP ANY SPACES MVI A,10H ;ENABLE WRITE OUT CASC PUSH H ;SAVE PTR MVI B,255 ;WRITE INITIAL 255 NULLS XRA A NULS: CALL CASO DCR B JNZ NULS MVI A,3CH ;START BYTE CALL CASO MVI B,32 ;32 SYNC BYTES MVI A,0E6H ;SYNC BYTE VALUE SYNCS: CALL CASO DCR B JNZ SYNCS LXI H,IOBUF ;POINT BUFFER MVI B,5 ;FILE NAME LENGTH POP D ;RESTORE CMD PTR FNAME: MVI M,20H ;DEFAULT BLANK LDAX D ;FETCH FILE NAME ORA A ;TEST JZ BLANK MOV M,A ;STORE CHAR INX D ;NAME PTR BLANK: INX H ;BUFFER PTR DCR B ;COUNT JNZ FNAME ; ; CALCULATE LGTH OF PROGRAM FILE&WRITE IT ON THE HEADER ; LXI D,BEGPR ;BEGINNING OF PROGRAM LHLD PROGE ;END MOV A,L SUB E MOV L,A MOV A,H SBB D MOV H,A INX H ;PLUS 1 TO GET # OF BYTES INCLUSIVE PUSH H ;SAVE FOR LATER SHLD IOBUF+5 ;STUFF LENGTH LXI D,407H ;TYPE AND LEN OF HEADER RECORD ;TYPE 4: BASIC PROG FILE, HEADER RCD LXI H,IOBUF CALL RECO ;WRITE RECORD ; ; WRITE PROGRAM FILE ; LXI H,BEGPR ;POINT START OF PROGRAM NXTRC: XTHL ;GET REMAINING LENGTH MOV A,H ;GET HI REMAINING ORA L ;TEST FOR DONE JZ ERITE ;BRIF DONE LXI D,0FF80H;-128 DAD D ;SUBTRACT RECORD LENGTH JC RITE ;IF CARRY, NOT AT END MOV A,L ;GET LOW ANI 7FH ;NUMBER BYTES LEFT MOV E,A ;COUNT LXI H,0 ;REMAINING BYTES RITE: XTHL ;RESTORE H MVI D,084H ;TYPE BYTE: 80=DATA RECORD (NOT ;FILE HDR), 4=BASIC PROGRAM FILE. CALL RECO ;WRITE XCHG ;SAVE SOURCE PTR JMP NXTRC ERITE: POP H ;CLEAN STACK ; ; ; BELL RING USER'S CHIMES ; BELL: MVI A,7 ;CODE FOR BELL CALL TESTO JMP RDY ;PAGE ; CLOAD LOAD A PROGRAM FROM THE TARBELL ; CLOAD: NULL1: MVI A,60H ;MIO CONTROL TO READ BY BITS OUT CASC ;WRITE TO STATUS PORT NULLS: CALL CASI ;READ LEADING NULLS OUT SWCH ;PUT IN LIGHTS CPI 0E6H ;WAIT FOR FIRST SYNC BYTE JNZ NULLS MVI A,20H ;MIO CONTROL TO READ BY BYTES OUT CASC ;WRITE TO STATUS PORT MVI B,31 ;NUMBER REMAINING SYNC BYTES SYNC: CALL CASI ;READ PAST SYNC OUT SWCH CPI 0E6H JNZ NULL1 ;TRY FOR MORE NULLS DCR B JNZ SYNC LXI H,IOBUF ;POINT BUFFER CALL RECI ;READ A RECORD CPI 4 ;TEST TYPE BYTE: IS IT BASIC PROGRAM ;..FILE HEADER RECORD? JNZ NULL1 ;NO, START OVER, KEEP LOOKING LHLD IOBUF+5 ;LOAD LENGTH OF PROGRAM FILE PUSH H ;SAVE LXI H,BEGPR NXTR: CALL RECI ;READ RECORD CPI 84H ;IS IT BASIC PROGRAM FILE DATA RECORD JNZ CKERR ;NO, SOMETHING'S WRONG. POP H ;LENGTH ;SUBTRACT 0,C FROM HL MOV A,L SUB C MOV L,A MOV A,H MVI C,0 SBB C MOV H,A ORA L ;TEST RESULT FOR 0 XCHG ;BUFFER ADDR TO HL PUSH D ;SAVE REMAINING LENGTH JNZ NXTR ;JIF NOT DONE READING DATA POP D ;CLEAR STACK ;LOADING DONE. SET POINTER TO END OF PROGRAM. XRA A MOV M,A ;EXTRA 0 FOR PARANOISA DCX H ;POINT LAST RECORD BYTE (SHOULD BE 0) SHLD PROGE ;SAVE END OF PROG FOR EDIT, LIST, &C STA IOBUF+5 ;MARK END OF FILE NAME FOR TYPEOUT ;TYPE FILE NAME LDA IOBUF CPI 20H ;TEST FOR NO NAME CNZ TERMO ;PRINT NAME IF THERE JMP BELL ENDIF ; PEEK EQU $ ; ; STMT: A=PEEK(X). RETURNS DECIMAL VALUE OF MEMORY ADDRESS X. ; CALL FACDE ;GET ADDRESS IN D,E XCHG ;ADDRESS TO H,L LXI D,0 ;CLEAR D,E MOV E,M ;PUT MEMORY BYTE IN E JMP BINFL ;CONVERT D,E TO BINARY AND RETURN ; POKE EQU $ ; ; STMT: POKE
,. PUTS IN MEMORY ADDRESS. ; CALL EXPR ;EVALUATE ADDRESS EXPRESSION MOV A,M ;LOAD NEXT CHARACTER CPI ',' ;TEST JNZ SNERR ;BRIF ERROR INX H ;POINT NEXT PUSH H ;SAVE H,L CALL FACDE ;PUT ADDRESS IN D,E POP H ;RESTORE H,L PUSH D ;SAVE ADDRESS CALL EXPR ;EVALUATE VALUE EXPRESSION CALL EOL ;TEST FOR END OF LINE CALL FBIN ;CONVERT FACC TO A REGISTER VALUE POP H ;GET D,E ADDRESS IN H,L MOV M,A ;MOVE BYTE JMP RUN ;CONTINUE ; ; JUMP EQU $ ; ; STMT: CALL
. EXECUTES CODE AT MEMORY ADDRESS. ; CALL EXPR ;EVALUATE ADDRESS EXPRESSION CALL EOL ;TEST FOR END OF LINE CALL FACDE ;CONVERT FACC TO ADDRESS IN D,E LXI H,RUN ;MAKE INTO SUBROUTINE PUSH H XCHG ;MOVE ADDRESS TO HL PCHL ;EXECUTE USER'S ROUTINE ;PAGE IF HUNTER ; ; BAUD EQU $ ; ; SOFTWARE BAUD SELECTION ON SIO BOARDS MODIFIED BY ; W. HARTER, COYOTE COMPUTERS, DAVIS, CALIF. ; ; COMMAND 'BAUD ' WHERE =110,300,1200,2400,9600 ; RST 1 ;SKIP BLANKS LXI D,BAUDS+6 ;POINT BAUD TABLE CALL SEEK ;GO SEARCH BAUD TABLE JZ CVERR ;BRIF RATE NOT FOUND DCX H ;ADJUST POINTER BAUD1: INX H ;LOOK AT CHARACTER CALL NUMER ;TEST FOR DIGIT JZ BAUD1 ;LOOP PAST RATE CALL EOL ;TEST FOR END OF LINE XCHG ;POINT ADDRESS OF CONTROL BYTES MOV E,M ;LOW BYTE TO E INX H ;POINT NEXT MOV D,M ;HIGH BYTE TO D LDA EDSW ;GET MODE SWITCH ORA A ;TEST IT JNZ SETIT ;BRIF IMMEDIATE MODE LXI H,BAUDS ;POINT 'BAUD' CALL TERMM ;WRITE IT PUSH D ;SAVE ADDRESS OF CONTROL BYTES LXI H,IOBUF ;POINT BUFFER MVI B,4 ;LOAD COUNT CALL COPYD ;COPY RATE TO IOBUF MVI M,0 ;TERMINATE MESSAGE CALL TERMO ;WRITE IT POP D ;RESTORE CONTROL BYTES SETIT: LXI H,4 ;LOAD OFFSET DAD D ;PIONT 1ST CONTROL BYTE MVI A,40H ;LOAD RESET OUT TTY+1 ;WRITE IT MVI A,M ;MODE BYTE OUT TTY+1 ;WRITE IT MVI A,17H ;ENABLE BYTE OUT TTY+1 ;WRITE IT INX H ;POINT SPEED BYTE MOV A,M ;LOAD IT OUT 8 ;WRITE IT BAUD2: IN TTY+1 ;READ STATUS ANI 2 ;TEST JZ BAUD2 ;WAIT FOR ACKNOWLEDGMENT IN TTY ;READ AND DISCARD LDA EDSW ;GET MODE SWITCH ORA A ;TEST IT JZ RUN ;BRIF RUN MODE JMP GETCM ;BRIF IMMEDIATE MODE BAUDS: DB 'BAUD',0FEH ;BAUD MESSAGE ; ; BAUD TABLE. ; B110: DB '110 ',0FAH,2,0 DW B110 B300: DB '300 ',0FBH,0 DW B300 B1200: DB '1200',0FAH,0 DW B1200 B2400: DB '2400',0FAH,32,0 DW B2400 B9600: DB '9600',0FAH,34,0 DW B9600 DB 0 ;END OF BAUD TABLE ; ENDIF ; IF CPM ;CPM INITIALIZATION STORES ;...BIOS JUMP TABLE HERE BTSTAT: DS 3 ;JMP TO BIOS CONSOLE STATUS BTIN: DS 3 ;JMP TO BIOS CONSOLE INPUT BTOUT: DS 3 ;JMP TO BIOS CONSOLE OUTPUT ENDIF ;PAGE ROMEN EQU $-1 ; ORG 8192 ;RAM STARTS OF 8K BOUNDARY IF LARGE OR CPM ;ADJUST START OF RAM IF 8+K ORG 2400H ;RAM STARTS ON 9K BOUNDARY ENDIF ; ; ALL CODE ABOVE THIS POINT IS READ ONLY AND CAN BE PROM'ED ; ; RAM EQU $ ; BZERO EQU $ FORNE: DS 1 ;# ENTRYS IN TABLE (MUST BE HERE) DS 112 ;ROOM FOR 8 NESTS (MUST BE HERE) TAPES: DS 1 ;TAPE SWITCH (MUST BE HERE) DIMSW: DS 1 ;DIM SWITCH (MUST BE HERE) OUTSW: DS 1 ;OUTPUT SWITCH (MUST BE HERE) ILSW: DS 1 ;INPUT LINE SWITCH (MUST BE HERE) RUNSW: DS 1 ;RUN SWITCH(MUST BE HERE) EDSW: DS 1 ;MODE SWITCH(MUST BE HERE) EZERO EQU $ ; LINEN: DS 5 IMMED: DS 82 ;IMMEDIATE COMMAND STORAGE AREA IOBUF: DS 82 ;INPUT/OUTPUT BUFFER STRIN: DS 256 ;STRING BUFFER AREA OUTA: DS 3 ;*** FILLED IN AT RUN TIME INDX: DS 2 ;HOLDS VARIABLE NAME OF FOR/NEXT REL: DS 1 ;HOLDS THE RELATION IN AN IF STMT IFTYP: DS 1 ;HOLDS TYPE CODE OF LEFT SIDE TVAR1: DS 4 ;TEMP STORAGE TVAR2: DS 4 ;DITTO TEMP1: DS 4 ;TEMP STORAGE FOR FUNCTIONS TEMP2: DS 4 TEMP3: DS 4 TEMP4: DS 4 TEMP5: DS 4 TEMP6: DS 4 TEMP7: DS 4 LINEL: DS 2 ;HOLDS MIN LINE NUMBER IN LIST LINEH: DS 2 ;HOLDS MAX LINE NUMBER IN LIST PROMP: DS 1 ;HOLDS PROMPT CHAR EXPRS: DS 2 ;HOLDS ADDR OF EXPRESSION ADDR1: DS 2 ;HOLDS TEMP ADDRESS ADDR2: DS 2 ;HOLDS TEMP ADDRESS ADDR3: DS 2 ;HOLDS STMT ADD DURING EXPR EVAL FACC: DS 4 FTEMP: DS 12 PARCT: DS 1 SPCTR: DS 2 CMACT: DS 1 ;COUNT OF COMMAS FNARG: DS 4 ;SYMBOLIC ARG & ADDRESS STMT: DS 2 ;HOLDS ADDR OF CURRENT STATEMENT ENDLI: DS 2 ;HOLDS ADDR OF MULTI STMT PTR MULTI: DS 1 ;SWITCH 0=NO, 1=MULTI STMT LINE DEXP: DS 1 COLUM: DS 1 ;CURRENT TTY COLUMN RNDX: DS 2 ;RANDOM VARIABLE STORAGE RNDY: DS 2 ;THE RND,TRND,AND RNDSW RNDZ: DS 2 ;MUST BE KEPT IN ORDER RNDS: DS 2 TRNDX: DS 2 TRNDY: DS 2 TRNDZ: DS 2 TRNDS: DS 2 RNDSW: DS 1 FNMOD: DS 1 ;SWITCH, 0=NOT, <>0 = IN DEF FN LINE: DS 2 ;HOLD ADD OF PREV LINE NUM STACK: DS 2 ;HOLDS ADDR OF START OF RETURN STACK PRSW: DS 1 ;ON=PRINT ENDED WITH , OR ; NS: DS 1 ;HOLDS LAST TYPE (NUMERIC/STRING) DATAP: DS 2 ;ADDRESS OF CURRENT DATA STMT DATAB: DS 2 ;ADDRESS OF DATA POOL PROGE: DS 2 ;ADDRESS OF PROGRAM END ; IF CPM ;TEMPORARY CODE FOR INITIALIZATION HERE ; INITC: LHLD BOOT+1 ;PTR TO BIOS TABLE LXI D,CSTAT ;OFFSET OF CONSOLE QUERY ENTRY DAD D ;POINT INTO BIO JUMP TABLE LXI D,BTSTAT;POINT INTO BASIC JMP TABLE MVI B,9 ;COUNT CALL COPYH ;MOE BIOS TABLE INTO BASIC MVI A,0C3H ;JMP OP CODE LXI H,RST1! STA 8H! SHLD 9H LXI H,RST2! STA 10H! SHLD 11H LXI H,RST3! STA 18H! SHLD 19H LXI H,RST4! STA 20H! SHLD 21H LXI H,RST5! STA 28H! SHLD 29H LXI H,RST6! STA 30H! SHLD 31H LHLD BDOS+1 ;LOCATE TOP OF RAM JMP INIT1 ;CONTINUE AS IN NON-CPM VERSION ENDIF ; ; DS 1 ;DATA STATEMENT FLAG (MUST BE HERE) BEGPR: ; END