; ; A FOCAL INTERPRETER FOR THE 8080 ; ; WRITTEN BY ROBERT ARNSTEIN FALL 1975 ; 5628 MEADOW CREST DRIVE ; DALLAS, TEXAS 75230 (214) 368-6820 ; ; XXX EQU 0 PROCT EQU 0 ;ASSEMBLE FOR PROCESSOR TECHNOLOGY INTEL EQU 1 ;ASSEMBLE FOR INTELLEC/80 INTRP EQU 0 IF PROCT ORG 0 JMP RECOVER SPAD: DW 8192 ENDIF IF INTEL ORG 100H JMP SKIPO CALL FIXIO JMP PRNTER SKIPO: CALL FIXIO JMP RECOVER FIXIO: LHLD 1 LXI B,3 DAD B SHLD PTC3+1 ;OVERLAY CALL TO CSTS SHLD PC3+1 DAD B SHLD XI33+1 ;OVERLAY CALL TO CI DAD B SHLD PTC4+1 ;OVERLAY CALL TO CO RET SPAD: DW 1D00H ENDIF IF XXX ORG 0 JMP RECOVER SPAD: DW 8192 ENDIF SBANK EQU $ MULX4: ADI 0 ;ADD OPERAND 3RD FRACTION MULP3 EQU $-1 MOV E,A ;4TH PARTIAL PRODUCT MOV A,D ;3RD PARTIAL PRODUCT ACI 0 ;ADD OPERAND 2ND FRACTION MULP2 EQU $-1 MOV D,A ;3RD PARTIAL PRODUCT MOV A,C ;2ND PARTIAL PRODUCT ACI 0 ;ADD OPERAND 1ST FRACTION MULP1 EQU $-1 JMP MULX5 ; RAM DIVIDE SUBROUTINE DIVX5: SUI 0 ;SUB DIVISOR 4TH FRACTION OP4S EQU $-1 MOV A,L ;REMAINDER 3RD FRACTION SBI 0 ;SUB DIVISOR 3RD FRACTION OP3S EQU $-1 MOV L,A ;REMAINDER 3RD FRACTION MOV A,H ;REMAINDER 2ND FRACTION SBI 0 ;SUB DIVISOR 2ND FRACTION OP2S EQU $-1 MOV H,A ;REMAINDER 2ND FRACTION MOV A,E ;REMAINDER 1ST FRACTION SBI 0 ;SUB DIVISOR 1ST FRACTION OP1S EQU $-1 MOV E,A ;REMAINDER 1ST FRACTION MVI A,0 ;REMAINDER 4TH FRACTION OP4A EQU $-1 RET DIVX6: ADI 0 ;ADD DIVISOR 3RD FRACTION OP3A EQU $-1 MOV L,A ;REMAINDER 3RD FRACTION MOV A,H ;REMAINDER 2ND FRACTION ACI 0 ;ADD DIVISOR 2ND FRACTION OP2A EQU $-1 MOV H,A ;REMAINDER 2ND FRACTION MOV A,E ;REMAINDER 1ST FRACTION ACI 0 ;ADD DIVISOR 1ST FRACTION OP1A EQU $-1 MOV E,A ;REMAINDER 1ST FRACTION MVI A,0 ;REMAINDER 4TH FRACTION OP4X EQU $-1 JMP DIVX2 ; ; RAM LOCATIONS USED BY THE FLOATING POINT SYSTEM ; OVER EQU $ AND 0FFH DB 0 ;INITIALLY CLEAR PREX EQU OVER+1 ;PREVIOUS EXPONENT ACCE EQU PREX+1 ;ACCUMULATOR EXPONENT ACCS EQU ACCE+1 ;ACCUMULATOR SIGN ACC1 EQU ACCS+1 ;ACCUMULATOR 1ST FRACTION ACC2 EQU ACC1+1 ;ACCUMULATOR 2ND FRACTION ACC3 EQU ACC2+1 ;ACCUMULATOR 3RD FRACTION SF EQU ACC3+1 ;SUBTRACTION FLAG DS 20 DS 30 ;SCRATCH FOR FUNCTIONS ; ; CHECKS STACK THEN CALLS ROUTINE POINTED TO BY H,L ; RECURSIVE SUBROUTINE CALL ; PUSHJ: CALL PCHK ;CHECK SP PCHL ;CALL ROUTINE ; ; RECURSIVE SUBROUTINE RETURN ; RETRN: LXI H,FRST SHLD PC ;CORRECTED CODE TO MATCH THIS HARD COPY RET ; ; SAVE DATA ON STACK, H,L POINT TO WHAT'S SAVED AFTER POINT BEHIND IT ; D,E,B,A,H,L DESTROYED ; PUSHF: POP D ;SAVE RETURN ADDRESS MVI B,WORDS ;B IS COUNTER PF1: MOV A,M ;GET A WORD INX H PUSH PSW ;SAVE ON STACK DCR B ;COUNT DOWN JNZ PF1 ;LOOP PUSH D ;RESTORE RETURN ADDRESS JMP PCHK ;CHECK STACK AND RETURN ; ; RESTORE DATA FROM STACK, H,L POINT TO PLACE TO PUT IT, DESTROYS A,D,E ; POPF: POP D ;SAVE RETURN ADDRESS LXI B,WORDS ;SET UP LOOP CONTROL DAD B POPF1: POP PSW ;GET WORD DCX H MOV M,A ;RESTORE IT DCR C ;COUNT DOWN JNZ POPF1 ;CONTINUE PUSH D ;RESTORE RETURN ADDRESS RET ; ; GETS A CHARACTER FROM COMBYF ADDRESS BY AXOUT ; CHECKS FOR TRAN. PUTS CHARACTER IN CHAR ; NO PARAMETERS ; UNPACK A CHARACTER. DESTROYS A,H,L,B,C,D ; GETC: LXI B,DMPSW ;POINT B TO DMP SWITCH GETC2: LHLD AXOUT ;GET BUFFER ADDRESS MOV A,M ;GET CHAR INX H ;BUMP POINTER SHLD AXOUT ;SAVE STA CHAR ;SAVE CHAR CPI '?' ;CHECK FOR ? JNZ UT2 ;NO TRACE LDA DEBGSW ;TEST FOR TRACE ENABLED ANA A ;SET FLAGS RNZ ;RET TRACE DISABLED LDAX B ;GET DUMP SWITCH + FLIP ANA A ;SET FLAG MVI A,0 JNZ UT3 MVI A,1 ;FLIP TO 1 UT3: STAX B JMP GETC2 ;GET NEXT CHARACTER INSTEAD UT2: LDAX B ;GET DMPSW MOV D,A ;SAVE LDA DEBGSW ;LOAD DEBGSW ADD D ;AND DMPSW RNZ ;IF BOTH ARE ZERO CALL PRNTC ;THEN PRINT RET ; ; SAVE CHAR IN BUFFER POINTED TO BY ACTIN ; IF CHAR IS RUBOUT LAST CHAR DELETED ; CHECKS FOR OVERFLOW ; PACK A CHARACTER. DESTROYS H,L,A ; PACKC: LDA CHAR ;GET CHAR LHLD AXIN ;POINT H,L TO BUFFER CPI RUBOUT ;IS CHAR RUBOUT? JZ RUB1 ;JUMP IF SO MOV M,A ;STORE CHAR INX H ;BUMP POINTER SHLD AXIN ;SAVE POINTER INX H ;TEST GOT OVERFLOW MVI A,377Q ;BUFFER ENDS WITH 377 CMP M ;TEST ERM1: CZ ERROR2 ;CALL IF ERROR (OVERFLOW) RET RUB1: DCX H ;BACKUP POINTER MVI A,377Q ;377 BEGIN OF BUFFER CMP M RZ ;RETURN IF BUFFER EMPTY SHLD AXIN ;SAVE POINTER MVI A,134Q ;ECHO RUBOUT CALL PRNTC RET ; ; ROUTINE MATCHES A CHAR WITH ONE IN A LIST AND BRANCHES ; TO CORRESPONDING ROUTINE. RETURNS ON A NO-MATCH. B,C POINT ; TO CHAR LIST. H,L POINT TO ADDRESS LIST UPON ENTRY ; ZERO ENDS CHAR CHECK LIST ; SORT AND BRANCH ON AC OR CHAR. DESTROYS D ; SORTJ: ANA A ;IS AC=0? JNZ SRT2 ;AC <> 0, USE IT LDA CHAR ;ELSE USE CHAR SRT2: MOV D,A ;SAVE CHAR SRT1: LDAX B ;GET 1ST COMPARE CHARACTER ANA A ;SET FLAGS RZ ;ZERO = END OF LIST, NO MATCH CMP D ;MATCH? JZ MATCH ;JUMP IF FOUND INX B ;CHECK NEXT CHAR INX H ;ADVANCE POINTER INX H ;TO NEXT ADDR IN TABLE JMP SRT1 ;CONTINUE SEARCH MATCH: MOV E,M ;MATCH FOUND INX H ;LOAD ADDRESS FROM MOV D,M ;TABLE XCHG ;AND BRANCH TO IT POP D ;REMOVE RET ADDR FROM STACK PCHL ; ; ROUTINE TO CHECK CHAR AGAINST A TABLE ; B,C POINT TO TABLE ; NUMBER STORED IN SRTCN IS DISTANCE IN TABLE ; RETURNS TO PC+3 IF NOT FOUND ; SORT CHAR AGAINST TABLE. DESTROYS B,C,H,L,A,D ; SORTC: LXI H,CHAR ;POINT H,L TO CHAR MVI D,0 ;RESET COUNTER SRC2: LDAX B ;GET 1ST CHAR ANA A ;SET FLAGS JZ SEXC ;ZERO = END OF TABLE CMP M ;TEST JZ SRC1 ;FOUND MATCH INR D ;INCR COUNTER INX B JMP SRC2 ;CHECK NEXT SRC1: MOV A,D ;GET COUNT STA SRTCN ;SAVE COUNT RET SEXC: POP H ;GET RET ADDRESS INX H ;CALCULATE RETURN ADDRESS INX H INX H PCHL ;RETURN ; ; IF A=0, PRINT CHAR, ELSE PRINT A ; PRINT ACCUM OR CHAR. DESTROYS A ; IF XXX PRNTC: ANA A ;SET FLAGS JNZ PTC1 ;ZERO = USE CHAR LDA CHAR PTC1: MOV E,A ;SAVE CHAR CPI LF ;DON'T ECHO LINE FEED RZ CPI CR JNZ XOUTL IN KYBRD ANI 7FH CPI 3 ;CONTROL C? CZ RECOVER ;BREAK MVI A,CR CALL XOUTL MVI E,LF XOUTL: IN TEST ANA A JP XOUTL MOV A,E ;RESTORE CHAR OUT CRT RET ENDIF ; IF INTEL PRNTC: ANA A JNZ PTC1 LDA CHAR PTC1: CPI LF ;DON'T ECHO LINE FEED RZ CPI CR JNZ XOUTL PTC3: CALL 3812H ANA A JP PTC2 CALL XI33 CPI 3 ;CHECK FOR CONTROL C BREAK CZ RECOVER PTC2: MVI A,CR CALL XOUTL MVI A,LF XOUTL: MOV C,A PTC4: CALL 3809H RET ENDIF ; IF PROCT PRNTC: ANA A JNZ PTC1 LDA CHAR PTC1: CPI LF RZ CPI CR JNZ XOUTL CALL STAT ANA A JP PTC2 CALL XI33 CPI 3 CZ RECOVER PTC2: MVI A,CR CALL XOUTL MVI A,LF CALL XOUTL MVI A,0 ; ; XOUTL DRIVER ; XOUTL: MOV C,A ;SAVE TEMP IN C TBE: IN 0 ;CHECK TBF RLC ;PUT IN CARRY NOP ;TO FOOL THE EXPERTS JNC TBE MOV A,C OUT 1 RET ENDIF ; IF INTRP PRNTC: ANA A JNZ PTC1 LDA CHAR PTC1: XOUTL: OUT 3 RET ENDIF ; ; READS A CHAR AND PRINTS ECHO IF NECESSARY ; READ DATA INTO A CHARACTER AND PRINT IT ; READC: CALL XI33 ;READ A CHAR STA CHAR ;SAVE IT LXI B,ECHOLST ;POINT B TO LIST CALL SORTC ;SORTC NOP ;RETURN + 3 NOP RET ;YES, RETURN SUB A ;CLEAR A JMP PRNTC ;ECHO ; ; PRINTS XX.XX ACCORDING TO LINENO ; PRINT C(LINENO) ; PRNTLN: LDA LINENO+1 ;GET LINENO CALL PRNT ;PRINT 2 DIGITS MVI A,'.' CALL PRNTC ;PRINT A "." LDA LINENO CALL PRNT ;PRINT STEP MVI A,SPACE ;PRINT SPACE CALL PRNTC RET PRNT: MOV D,A ;SAVE ANI 0F0H ;GET FIRST DIGIT RRC RRC RRC RRC ADI 60Q ;CONVERT TO ASCII CPI ':' JM $+5 ADI 'A'-'9'-1 CALL PRNTC MOV A,D ;GET SECOND ANI 0FH ADI 60Q CPI ':' JM $+5 ADI 'A'-'9'-1 CALL PRNTC RET ; ; RETURNS NOT FOUND ; RETURNS + 3 FOUND ; THIS LN= FOUND LINE OR NEXT LARGER ; LASTLN = LESSER AND/OR LAST ; TEXTP IS SET ; FINDLN: LXI H,CFRS SHLD LASTLN ;INIT POINTERS F2: SHLD THISLN INX H INX H ;POINT TO # IN LINE INX H LDA LINENO+1 CMP M JC FEND3 JNZ FINDN F3: DCX H LDA LINENO CMP M JC FEND3 JNZ FINDN F4: POP D INX D INX D INX D PUSH D FEND3: LHLD THISLN INX H INX H INX H INX H SHLD AXOUT RET FINDN: LHLD THISLN SHLD LASTLN MOV A,M INX H MOV H,M MOV L,A ORA H JZ FEND3 JMP F2 ; ; TERMINATE BUFFERED LINE ; INSERT LINE POINTERS. H=LASTLN, R=BUFR ; ENDLN: LHLD BUFR MOV B,H MOV C,L LHLD AXIN XCHG LHLD LASTLN MOV A,M STAX B INX H INX B MOV A,M STAX B DCX H DCX B LDA BUFR MOV M,A INX H LDA BUFR+1 MOV M,A E3: XCHG SHLD BUFR SHLD LASTV RET ; ; NO PARAMETERS ; DELETES LEADING SPACES FROM COMMAND ; IGNORE SPACES AND LEADING ZEROES ; SPNOR: LDA CHAR ;GET CHAR CPI ' ' ;IS IT A SPACE RNZ CALL GETC ;GET NEXT CHAR JMP SPNOR ; ; GET A LINE # FROM CHARACTERS ; IF ALL, LINENO IS ; FORM LINENO (TWO BYTES) AS BCD CHAR LINE # ; GROUP # IN BYTES IF LINENO, LINE # IN BYTE 2 ; RETURNS RESULT IN LINENO AND IN D,E ; UNPACK AND FORM A LINE NUMBER. DESTROYS A,E ; GETLN: CALL SPNOR ;IGNORE LEADING SPACES LDA CHAR CPI 'A' ;"ALL" IS SPECIAL JZ ALL CALL TESTN ;TEST1 JMP GZERR ;ILLEGAL GROUP ZERO ISE JMP GZERR ;OTHER LDA CHAR ANI 0FH ;ISOLATE DIGIT MOV E,A ;SAVE DIGIT CALL GETC ;GET NEXT CALL TESTN ;TEST2 JMP GT1 ;PERIOD (ONE DIGIT GROUP #) JMP GZERR ;OTHER MOV A,E ;GET HIGH ORDER OVER DIGIT RLC RLC RLC RLC MOV E,A ;FIX GROUP LDA CHAR ANI 0FH PUSH PSW ;SAVE A CALL GETC ;GET NEXT CHAR POP PSW GT1: ORA E JZ GZERR ;ILLEGAL GROUP ZERO STA LINENO+1 CALL TESTN JMP GT2 ;PERIOD JMP GERR ;OTHER JMP GZERR ;TOO LARGE GROUP GT2: CALL GETC ;GET NEXT CHAR CALL TESTN ;TEST3 JMP GZERR ;PERIOD JMP GERR ;OTHER LDA CHAR ANI 0FH ;GET DIGIT RLC RLC RLC RLC MOV E,A ;SAVE CALL GETC ;READ LAST CHAR CALL TESTN ;TEST4 JMP GERR ;PERIOD JMP GT4 ;OTHER LDA CHAR ;DIGIT ANI 0FH GT3: ORA E MOV E,A CALL GETC ;CHECK SIZE CALL TESTN ;TEST JMP GERR ;PERIOD JMP GT4 ;OK GZERR: CALL ERROR2 ;OTHER :ILLEGAL GROUP ZERO GT4: MOV A,E STA LINENO ;SAVE ANA A JZ GROUP ;STEP IS 0 MVI A,200Q ;STEP STA NAGSW RET GROUP: SUB A ;GROUP STA NAGSW RET ALL: MVI A,1 STA NAGSW ;ALL MVI A,RUBOUT STA CHAR LXI H,1 SHLD LINENO RET GERR: CALL ERROR4 ;BAD LINE @ ; ; RETURNS IF PERIOD ; RETURNS+3 IF NON-DIGIT ; RETURNS+6 IF DIGIT ; NO PARAMETERS ; TEST FOR PERIOD,OTHER,NUMBER. DESTROYS H,L,B,C,A ; TESTN: LXI B,3 ;PC INCREMENT POP H ;GET RETURN ADDRESS LDA CHAR ;GET CHAR TO TEST CPI '.' ;IS IT A PERIOD JZ B1 ;BRANCH IF YES CPI 3AH JP B3 CPI 30H JM B3 DAD B ;IT'S A DIGIT B3: DAD B B1: SUB A ;CLEAR ACCUMULATOR PCHL ; ; TEST SRTCN FOR LEFT PAREN ; RETURN+3 IF SO ; SKIP IF 55? JM T2 ;NO INX H INX H INX H PCHL T2: SUB A PCHL ; ; SKIP IF G(AC)=G(LINENO) ; TSTGRP: MOV B,A LDA LINENO+1 CMP B MOV A,B RNZ XTHL INX H INX H INX H XTHL RET ; ; TEST THE NATURE OF AN ALPHABETIC ; RETURNS TERM ; RETURNS+3 NUMBER ; RETURNS+6 F ; RETURNS+9 ALPHANUMERIC ; TERM: NUMBER: FUNCTION: LETTER AND IGNORE SPACES ; TESTC: PUSH B PUSH D CALL SPNOR ;IGNORE SPACES LXI B,TERMS ;TEST TERMINATIONS CALL SORTC POP D POP B RET ;SORTCN IS SET POP D POP B POP H ;NOT TERM INX H INX H INX H LDA CHAR CPI 'F' ;IS IT "F"? JZ XT3 ;YES PUSH H PUSH B PUSH D CALL TESTN POP D POP B RET ;PERIOD JMP XT2 ;OTHER POP D POP B RET ;NUMBER XT2: POP D POP B POP H INX H INX H INX H XT3: INX H INX H INX H PCHL ;RET: T:N:F:A ; ; UNCHAIN A LINE, RECOVER SPACE ; REMOVE OLD LINE OF TEXT ; DELETE: CALL FINDLN ;FIND THE LINE RET ;ALREADY GONE NOP NOP SUB A STA TEMP+1 MVI E,4 ;COUNT POINTER AND LINE NUMBER MVI A,1 ;DISABLE TRACE STA DEBGSW D1: CALL GETC ;MEASURE LENGTH OF LINE TO DELETE INR E LDA CHAR CPI CR JNZ D1 MOV A,E STA TEMP ;SAVE COUNT CMA ;AND NEGATIVE COUNT INR A STA CNTR LHLD THISLN ;CHECK FOR FINISHED INX H INX H ;POINT TO LINE # MOV A,M INX H ORA M ;CHECK FOR LINE ZERO JZ START ;IGNORE LINE ZERO DELETE LHLD THISLN MOV B,H ;SET UP POINTER MOV C,L LHLD LASTLN ;DISCONNECT LDAX B MOV M,A INX H INX B LDAX B DCX B MOV M,A LXI H,CFRS ;START AT LINE 0 DOK: MOV E,M ;GET NEXT LINE MOV A,E INX H MOV D,M ;D,E POINT TO NEXT LINE ORA D JZ DONE ;CHECK FOR FINISHED DCX H MOV A,D CMP B JC D2 ;THIS LN >? JNZ D3 ;NOT EQUAL MOV A,E CMP C ;TEST LOW ORDER JC D2 ;GREATER D3: PUSH H ;SAVE POINTER LHLD CNTR ;SET DISPLACEMENT D4: DAD D ;ADD DISP 0 SHLD PC MVI A,0C3H ;SET UP RESTART AT 0 STA 0 LXI H,RECOVER SHLD 1 SUB A STA OVER+SCRB ;CLEAR OVERFLOW STA LIST3+1 ;RESET MODIFY STA DEBGSW MVI A,1 STA DMPSW ;INIT UNPACK AND TRACE SWITCH IBAR: LHLD SPAD ;GET STACK START LOC SPHL ;SET STACK POINTER LXI H,COMBUF SHLD AXIN MVI A,'*' CALL PRNTC IGNOR: CALL READC SUB A LXI B,LIST7 LXI H,INLIST CALL SORTJ CALL PACKC JMP IGNOR ; ; COMMAND INPUT PROCESSOR ; IRETN: CALL PACKC ;PUT CR IN BUFFER SUB A CALL PRNTC LXI H,COMBUF ;INITIALIZE TEXTP GONE: SHLD AXOUT ;SAVE IN POINTER CALL GETC ;READ 1ST CHARACTER LHLD SPAD ;GET STACK START LOC SPHL ;SET STACK POINTER CALL SPNOR ;IGNORE LEADING BLANKS CALL TESTN ;IS THERE A LINE # JMP GZERR ;PERIOD. ILLEGAL 1ST CHAR JMP INPTX ;IMMEDIATE COMMAND MVI A,1 STA DEBGSW ;DISABLE TRACE CALL GETLN ;READ LINE NUMBER LDA NAGSW ;TEST FOR SINGLE LINE CPI 200Q ERM6: CNZ ERROR3 ;BAD LINE LHLD BUFR ;SET POINTERS INX H INX H XCHG LHLD LINENO ;SAVE LINE # XCHG MOV M,E INX H MOV M,D INX H SHLD AXIN CALL SPNOR ;IGNORE SPACES AFTER LINE # JMP SRETN CALL GETC ;READ 1ST CHAR AFTER LINE @ SRETN: CALL PACKC ;SAVE TEXT LDA CHAR CPI CR ;TEST END OF LINE JNZ SRETN-3 ;NOT END CALL DELETE ;REMOVE OLD LINE IF ANY CALL ENDLN ;INSERT NEW LINE JMP START ;REINITIALIZE POINTERS INPTX: LXI H,PROC ;CALL PROC CALL PUSHJ LHLD PC ;CHECK NEXT LINE MOV A,M ;END OF PROGRAM? MOV E,A INX H MOV D,M ORA M XCHG JZ START ;YES SHLD PC INX H INX H INX H INX H JMP GONE ;PROCESS NEXT COMMAND ; ; RECURSIVE OPERATE, EXECUTE OR CALL ; DO: CALL GETLN ;EXECUTE ONE LINE,GROUP OR CALL LHLD PC PUSH H ;SAVE PC LHLD TEXTP PUSH H DGRP: LXI H,NAGSW ;SAVE NAGSW, CHAR, LINENO CALL PUSHF LDA NAGSW ;CHECK SW ANA A JM DOONE ;ONE LINE CALL FINDLN ;INIT FOR GROUP, SET THISLN NOP NOP NOP LHLD THISLN SHLD PC INX H INX H INX H MOV A,M ;SET GROUP NO DCX H CALL TSTGRP ;CHECK VALIDITY CALL ERROR2 ;NO SUCH GROUP DGRP1: LXI H,PROCESS ;PROCESS COMMAND CALL PUSHJ LXI H,NAGSW CALL POPF ;RESTORE LHLD PC ;CHECK EOT MOV A,M INX H ORA M JZ DCONT ;DONE DCX H MOV E,M INX H MOV D,M XCHG INX H INX H ;POINT TO LINENO LDA NAGSW ;CHECK FOR GROUP ANA A JZ DR3 JP DR2 ;DO ALL DR3: INX H MOV A,M DCX H CALL TSTGRP JMP DCONT ;NOT IN GROUP DR2: MOV E,M ;GET NEXT LINENO INX H MOV D,M XCHG SHLD LINENO JMP DGRP ;CONTINUE SUBROUTINE DOONE: CALL FINDLN ;FIND THE LINE ERM8: CALL ERROR2 ;NO SUCH LINE LXI H,PROCESS ;EXECUTE IT CALL PUSHJ LXI H,NAGSW ;RESTORE CHAR CALL POPF DCONT: POP H ;RESTORE TEXT POINTERS SHLD TEXTP POP H ;RESTORE PC SHLD PC JMP PROC ;CONTINUE PROCESSING ; ; PRIMARY CONTROL AND TRANSFER ; GOTO: CALL GETLN ;READ LINE # CALL FINDLN ;LOCATE IT ERM9: CALL ERROR2 ;NOT THERE LHLD THISLN ;SET PC SHLD PC PROCESS: CALL GETC ;TEST END OF LINE PROC: LDA CHAR ;FIRST CHAR READY = USE PROC CPI CR JNZ PC2 PC1: RET ;EXIT PROCESS PC2: LXI B,GLIST ;IGNORE SPACE AND : CALL SORTC JMP PROCESS LDA CHAR ;SAVE COMMAND CHARACTER PUSH PSW P4: CALL GETC ;GO TO TERMINATOR LXI B,GLIST CALL SORTC JMP PC3 JMP P4 PC3: IF INTEL CALL 3812H ;CHECK FOR C.C. BREAK ANA A JP PC3A ;NO CHAR AVAIL CALL XI33 ;GET CHAR CPI 3 ;CONTROL C? CZ RECOVER ENDIF IF XXX IN KYBRD ;C.C. BREAK CHECK ANI 07FH CPI 3 ;CONTROL C? CZ RECOVER ;BREAK ENDIF IF PROCT CALL STAT ANA A JP PC3A CALL XI33 CPI 3 CZ RECOVER ENDIF PC3A: POP PSW LXI B,COMLST ;DO COMMAND LXI H,COMGO CALL SORTJ CALL ERROR2 ;ILLEGAL COMMAND ; ; OUTPUT COMMAND TEXT ; WRITE: MVI A,1 STA DEBGSW ;DISABLE TRACE CALL GETLN ;GET LINENO W5: CALL FINDLN ;SEARCH FOR LINE JMP WTESTG ;NOT THERE OR GROUP LHLD LINENO MOV A,H ORA L JZ W3 CALL PRNTLN ;PRINT LINE # AND Q SP W3: CALL GETC SUB A CALL PRNTC ;PRINT LINE TEXT LDA CHAR CPI CR ;TEST END OF LINE JNZ W3 LHLD THISLN MOV A,M MOV E,A INX H MOV D,M ORA M ;TEST END OF TEXT XCHG WTST2: JZ W6 ;EXIT, DO NEXT ????? LINE INX H INX H ;POINT TO LINENO OF NEXT LDA NAGSW ANA A JM W4 INX H MOV A,M DCX H W4: CALL TSTGRP ;TRY NEXT LINENO FOR GROUP JMP WX WALL: XCHG ;SET LINENO LDAX D MOV L,A INX D LDAX D MOV H,A SHLD LINENO JMP W5 WTESTG: LHLD THISLN ;INIT GROUP PRINTOUT MOV A,H ORA L JMP WTST2 W6: STA DEBGSW RET WX: LDA NAGSW ANA A JM W6 JZ W6 SUB A CALL PRNTC ;PRINT CR JMP WALL ; ; COMPUTED TRANSFER ; JUMP: CALL SPNOR ;IGNORE BLANKS CALL EVAL ;EVALUATE INSIDES MVI E,32 CALL FIX ;TAKE INTEGER MOV A,D JMP I3 ;USE IF TO BRANCH ; ; CONDITIONAL TRANSFER PROCESS ; IFX: CALL TESTC ;IGNORE SPACES AND TEST CALL EVAL ;IT NOP ;N- DUMP THE (EFOPE MVI E,0 LXI B,0 ;F- SKIP CALL TST MVI A,0 JZ IZ JP IP IF3: LHLD COMGO+8 ;TRANSFER PCHL IP: INR A IZ: INR A I3: STA TEMP SUB A LXI B,TLIST LXI H,ILIST CALL SORTJ ;SEARCH FOR CR CALL GETC JMP I3+3 IF1: CALL GETC LDA TEMP DCR A JNZ I3 JMP IF3 ; ; LOOP CONTROL AND ASSIGNMENT ; FOR AND SET ; SET IS FOR WITH NO LOOP CONTROL ; SETX: FOR: LXI H,GETVAR ;LOOPS, ETC. CALL PUSHJ ;LOOK FOR "=" NEXT PUSH H CALL SPNOR ;IGNORE SPACES LDA CHAR CPI '=' ERM10: CNZ ERROR4 ;LEFT OF = BAD, FOR OR SET CALL GETC CALL EVAL POP H SHLD PT1 CALL TST LHLD PT1 CALL STR SUB A LXI B,TLIST LXI H,FLST1 CALL SORTJ ;TEST LAST CHAR FROM EVAL CALL ERROR4 ;EXCESS R-PAR FINCR: LHLD PT1 ;SAVE VARIABLE ADDRESS PUSH H LXI H,EVAL-3 ;EVALUATE INCREMENT IF ANY CALL PUSHJ SUB A LXI B,TLIST LXI H,FLST2 CALL SORTJ ;TEST TERMINATORS CALL ERROR4 ;ILLEGAL TERMINATOR IN FOR FLIMIT: CALL TST LXI H,FLARG CALL STR LXI H,FLARG CALL PUSHF LXI H,EVAL-3 ;GET LIMIT (NO ERROR DETECTED) CALL PUSHJ CALL TST LXI H,FLARG CALL STR FCONT: LXI H,FLARG ;SAVE LIMIT CALL PUSHF LXI H,TEXTP CALL PUSHF ;SAVE TEXT OF OBJECT STMTS LXI H,PROCESS CALL PUSHJ ;DO OBJECT LXI H,TEXTP CALL POPF ;RESTORE REMAINING TEXT LXI H,FLARG CALL POPF ;GET LIMIT LXI H,ITER1 CALL POPF ;GET INC POP H SHLD PT1 ;GET VARIABLE ADDRESS CALL LOD LXI H,ITER1 CALL AD LHLD PT1 CALL STR LXI H,ITER1 CALL LOD CALL TST PUSH PSW LHLD PT1 CALL LOD POP PSW LXI H,FLARG JP OLDTST CALL SB RM JMP FORMR OLDTST: CALL SB JZ FORMR RP FORMR: LHLD PT1 PUSH H ;SAVE ADDRESS LXI H,ITER1 CALL PUSHF ;SAVE INC AGAIN JMP FCONT FINFIN: LXI H,FLTONE CALL PUSHF ;SET INC TO ONE CALL TST LXI H,FLARG CALL STR JMP FCONT ; ; INPUT-OUTPUT STATEMENTS ; ASK: SUB A ;REMEMBER WHICH CALL CMA TYPE: STA ATSW TASK: SUB A STA DEBGSW ;RE-ENABLE TRACE LXI B,ALIST ;SPECIAL CHAR? LXI H,ATLIST CALL SORTJ LDA ATSW INR A ;TEST QUOTE SWITCH JNZ TYPE2 ;TYPE LXI H,GETVAR CALL PUSHJ ;DO ASK-SET UP PT1 LDA CHAR ;SAVE IN-LINE CHAR PUSH PSW PUSH H MVI A,':' ;TYPE COLON CALL PRNTC LXI H,IOBUF SHLD AXIN AK2: CALL READC CALL PACKC SUB A LXI B,SPECIAL LXI H,INFIX CALL SORTJ JMP AK2 AK3: CALL PACKC LHLD AXOUT PUSH H LXI H,IOBUF SHLD AXOUT CALL EVAL-3 POP H SHLD AXOUT CALL TST POP H CALL STR AK5: POP PSW STA CHAR JMP ASK ;CONTINUE AK4: POP H JMP AK5 TYPE2: LXI H,EVAL ;DO TYPE CALL PUSHJ LXI H,IOBUF CALL OU LXI H,IOBUF MVI B,13 TYP: MOV A,M ADI 60Q CALL PRNTC DCR B INX H JNZ TYP JMP TYPE TQUOT: MVI A,1 ;DISABLE TRACE STA DEBGSW TQ2: CALL GETC ;TYPE LITERALS SUB A LXI B,TLST2 LXI H,TLST3 CALL SORTJ SUB A CALL PRNTC JMP TQ2 TINTR: CALL GETC ;PASS % CALL GETLN ;READ FORMAT CONTROL LHLD LINENO SHLD FISW ;SAVE FORMAT CODE JMP TASK TCRL2: MVI A,CR ;SPLAR=CR ALONE CALL PRNTC TCRLF: MVI A,CR ;) IS BOTH CALL XOUTL TASK4: CALL GETC ;MOVE TO NEXT CHARACTER JMP TASK ; ; SEARCH ROUTINES ; MODIFY: CALL GETLN ;READ LINENO CALL FINDLN ;LOOK IT UP ERM13: CALL ERROR2 ;NON-EXISTENCE CALL PRNTLN LHLD BUFR ;SET POINTERS INX H INX H LXI D,LINENO ;COPY SAME LINE # LDAX D MOV M,A INX D INX H LDAX D MOV M,A INX H SHLD AXIN ;FOR INPUT SCONT: CALL XI33 ;READ, NO ECHO STA LIST3+1 ;SAVE SEARCH CHAR MVI A,1 STA DEBGSW ;NO BREAKS SCHAR: CALL GETC ;TYPE + TEST -F.F. SUB A CALL PRNTC ;TYPE SUB A LXI B,LIST3 LXI H,LISTGO CALL SORTJ ;LOOK FOR MATCH CALL PACKC ;SAVE NEW LINE JMP SCHAR SBAR: LHLD BUFR ;RESTART BUFFER ADDRESS INX H INX H INX H INX H SHLD AXIN ;SET POINTERS SFOUND: CALL READC ;READ KEYBOARD SUB A LXI B,LIST6 LXI H,SRNLST CALL SORTJ SGOT: CALL PACKC ;PACK CHAR JMP SFOUND ;MORE ; ; GET A VARIABLE FROM VARIABLE LIST ; EXIT H&L POINT TO VALUE PART OF LIST ; PUSHES AXOUT PAST VARNAME ; GETVAR: CALL SPNOR ;IGNORE BLANKS LDA CHAR ;GET FIRST CHARACTER OF NAME MOV B,A ;SAVE PUSH B CALL GETC ;GET SECOND CHARACTER OF NAME POP B CALL TESTC JMP NOTA NOP NOP NOP NOP NOP NOP LDA CHAR MOV C,A ;ALPHA SAVE PUSH B JMP GV2 NOTA: MVI C,'@' ;SUBSTITUTE FOR SECOND CHAR IF MISSING PUSH B JMP GV2B GV2: CALL GETC GV2B: CALL TESTC JMP GV2A ;TERMINATOR JMP GV2 ;N JMP GV2 ;FUNCTION JMP GV2 ;VARIABLE GV2A: CALL TSTLPR JMP NOSUB CALL ECALL LXI H,ACCE+SCRB CALL PUSHF LHLD PT1 CALL LOD MVI E,32 CALL FIX ;CONVERT TO FIXED MOV E,D ;SAVE SUBSCRIPT MOV D,C ;LEAST SIGNIFICANT PORTION XCHG SHLD TEMP LXI H,ACCE+SCRB CALL POPF LHLD TEMP PUSH H LHLD AXOUT ;POINT POINTER PAST VARNAME DCX H GV5: MOV A,M CPI ')' ERM14: CNZ ERROR4 CALL GETC GV6A: CALL TESTC JMP FNOVR-2 ;TERM JMP GV6 ;N JMP GV6 ;FUNCTION GV6: CALL GETC ;VARIABLE JMP GV6A NOSUB: LXI D,0 ;NO SUBSCRIPT MEANS MAKE IT ZERO PUSH D POP D POP B FNOVR: LHLD STRTV ;DCHECK VARLST GV3: LDA LASTV ;FISRT HALF OF END OF VAR CHECK CMP L JZ HC GV4: MOV A,M CMP B ;CHECK VARNAME INX H JNZ NOPE1 MOV A,M CMP C ;CHECK VARNAME 2ND CHAR INX H JNZ NOPE2 MOV A,M CMP D ;CHECK SUBSRCIPT INX H JNZ NOPE3 MOV A,M CMP E ;CHECK 2ND HALF OF SUBSCRIPT INX H RZ ;RETURN IF FOUND JMP NOPE NOPE1: INX H NOPE2: INX H NOPE3: INX H NOPE: INX H INX H INX H INX H JMP GV3 ;TRY NEXT VARIABLE HC: LDA LASTV+1 ;CHECK 2ND HALF OF VARS CMP H JNZ GV4 ;NOT END OF VARS MOV M,B ;NOT CREATED YET INX H MOV M,C INX H MOV M,D INX H MOV M,E INX H ;NOW CREATED PUSH H ;SAVE POINTER TO VALUE SUB A MOV M,A INX H INX H INX H INX H SHLD LASTV ;MADE VARIABLE SAVE NEW END OF LIST POP H RET ;RETURN POINTER TO VALUE ; ECALL: LXI H,ACCE+SCRB ; CALL PUSHF LDA LASTOP PUSH PSW LDA STE PUSH PSW LXI H,EVAL-3 CALL PUSHJ POP PSW STA STE POP PSW STA LASTOP CALL TST LXI H,FLAC SHLD PT1 CALL STR LXI H,ACCE+SCRB CALL POPF RET CALL GETC EVAL: SUB A STA STE LDA CHAR CPI '+' ;TEST FOR UNARY + JZ ENUM CPI '-' ;TEST FOR UNARY - JZ ENUM EVALC: CALL TESTC JMP ETRM1 ;TERM JMP ENUM ;N JMP EFUN ;FUNCTION VARGET: CALL GETVAR ;VARIABLE SHLD PT1 JMP EDO OPNEXT: LDA SRTCN STA LASTOP CALL TESTC JMP ETRMN ;TERM ERM15: CALL ERROR4 ;N ERM16: CALL ERROR4 ;FUNCTION CALL ERROR4 ;VARIABLE ETRM1: LDA SRTCN CPI 6 ;NULL PARFNS JZ ELPAR ETRMN: CALL TSTLPR ;OP MISSING JMP ETR2 CALL ERROR4 ETR2: CALL GETC JMP EVALC ENUM: LXI H,DATBUF PUSH H ENLP: LXI B,TERMS CALL SORTC JMP NUMD ENL3: POP H LDA CHAR SUI 60Q MOV M,A INX H CPI 'E'-60Q JNZ ENL2 PUSH H CALL GETC CALL SPNOR JMP ENL3 ENL2: PUSH H CALL GETC JMP ENLP NUMD: POP H MVI M,0FFH CALL TST LXI H,FLARG CALL STR LXI H,DATBUF CALL INP LXI H,FLAC SHLD PT1 CALL STR LXI H,FLARG CALL LOD JMP EDO EFUN: LXI H,ACCE+SCRB CALL PUSHF ;SAVE ACCUM CALL GETC CALL GETC LDA CHAR PUSH PSW ;SAVE FUNCTION CODE FUN3: CALL GETC ;MOVE TO EXPRESSION CALL TESTC JMP FUN2 ;TERM JMP FUN3 ;N JMP FUN3 ;FUNCTION JMP FUN3 ;VARIABLE FUN2: CALL TSTLPR ;MUST BE A ( CALL ERROR6 ;NO PAREN FUN4: CALL ECALL ;EVALUATE FUNTION INPUT POP PSW ;RESTORE FUNCTION CODE LXI H,EFUN3 ;GET RETURN ADDRESS PUSH H ;SAVE ON STACK LXI B,FNTBL ;GET FUNCTION CODES LXI H,FNTBF ;ADDRESS OF FUNCTIONS CALL SORTJ ;GOTO FUNCTION CALL ERROR6 ;BAD FUNCTION CODE EFUN3: LXI H,ACCE+SCRB CALL POPF ;RETURN FROM FUNCTIONS, RESTORE ACCUM JMP ELPR2 ETERM: EDO: LDA STE ANA A MVI A,1 STA STE JNZ EFST LXI H,LOD SHLD FLOP+1 JMP FLOP-3 EFST: LDA LASTOP LXI H,OPTBL ELP: DCR A INX H INX H JZ EFND JMP ELP EFND: MOV E,M INX H MOV D,M XCHG SHLD FLOP+1 LHLD PT1 FLOP: CALL LOD LDA OVER+SCRB ANA A ERM21: CNZ ERROR6 ;OVERFLOW LDA SRTCN SUI 9 JM OPNEXT RET ELPAR: LDA LASTOP PUSH PSW LDA STE PUSH PSW CALL ECALL POP PSW STA STE POP PSW STA LASTOP ELPR2: CALL GETC CALL TESTC ;SET SRTCN JMP ETERM JMP ETERM JMP ETERM JMP ETERM ; ; ERASE SINGLE LINES,GROUPS,OR VARIABLES ; ERASE: MVI A,1 ;TURN OFF TRACE STA DEBGSW CALL TESTC ;TEST SECOND WORD IF ANY JMP ERVX ;ERASE VARIABLES JMP ERL ;LINES OR GRUOPS ERM22: CALL ERROR3 LDA CHAR ;ALL TEXT CPI 'A' CNZ ERROR3 ;BAD ARG IN ERASE ERT: LXI H,BUFBEG ;ERASE ALL TEXT SHLD BUFR LXI H,CFRS MVI M,0 INX H MVI M,0 ERV: LHLD STRTV ;ERASE VARIABLES SHLD LASTV JMP START ;FIX POINTERS ERL: CALL GETLN ;ERASE LINES LHLD BUFR ;PROTECT REST OF LINE SHLD AXIN ERG: CALL DELETE ;EXTRACT A LINE LHLD THISLN INX H INX H SHLD THISLN LDA NAGSW ANA A JM ER1 INX H MOV A,M ER1: CALL TSTGRP ;SKIP JMP ERV LHLD THISLN ; LXI D,LINENO MOV A,M STAX D INX H INX D MOV A,M STAX D JMP ERG ERVX: LHLD STRTV ;INITIATE VARIABLE BY INDIRECT COMMAND SHLD LASTV RET ; ;SYMBOL TABLE TYPE OUT ROUTINE ; TDUMP: MVI A,'N' CALL PRNTC MVI A,'I' CALL PRNTC RET ; ; FLOATING POINT FUNCTIONS ; INPUT TO FLOATING POINT FUNCTIONS IS POINTED TO BY PT1 (LHLD PT1) ; INPUT IS 4 BYTES LONG. IT USUALLY COMES FROM THE ARGUMENT TO THE FUNCTION. ; OUTPUT FROM FLOATING POINT FUNCTIONS SHOULD BE FOUR BYTES POINTED TO BY ; PT1. ; XUSR: RET ; ; INVERSE DIVIDE ROUTINE ; IDV: PUSH H ; CALL TST ;FLOATING POINT ACCUM TO REGISTERS MVI L,IDVT CALL STR ;DIVISOR TO STORAGE POP H CALL LOD ;DIVIDE TO FLAC MVI L,IDVT ;ADDRESS DIVISOR JMP DIV ;RETURN THROUGH DIVIDE ROUTINE ; ; SUBROUTINE FOR THE EVALUATION OF ELEMENTARY FUNCTION MACLAURIN SERIES ; ; ENTRY FMACE FOR EXPONENTIAL TYPE SERIES,E.G. ; ENTRY FMACL FOR LOGRITHMIC TYPE SERIES,E.G. ; ARCTAN(Z)=Z/1-Z**3/3+Z**5/5 ... ; S(I-1)=(1./A(I)+X*S(I)), S(N)=0. ; ; IN BOTH SERIES DEL**2(A(I)) MUST BE CONSTANT ; ENTER WITH X IN FMACX, A(N) IN D, D(A(N-1)) IN C, D**2(A(1)) IN B ; RESULTS IN FMACS, WHEN A(I)<0. ; ; 2 LEVELS OF STACK USED BEYOND FLOATING POINT PACKAGE FMACL: XRA A ;CLEAR A REG FOR LOG TYPE SERIES LXI H,FMACS ;POINT TO SIGMA MOV M,A ;ZERO STORED LXI H,FMACB ;PRESET BRANCH B JMP FMACC ;JOINT CODE FMACE: LHLD FONE ;MOVE 1.0 TO SIGMA FOR EXP TYPE SERIES SHLD FMACS LHLD FONE+2 SHLD FMACS+2 LXI H,FMACA ;PRESET BRANCH A FMACC: SHLD FMACG ;STORE PRESET BRANCH MVI E,32 ;COUNT FOR FLOATING OF A(I) FMACD: PUSH B ;CHAIN RULE LOOP PUSH D ;SAVE A(I), D(A(I)), D**2(A(1)) XRA A ;ZERO THE LEAD POSITIONS OF A(I) MOV B,A MOV C,A CALL FLT ;FLOAT A(I) MVI L,FMACT ;INTO TEMP CALL STR MVI L,FMACX ;LOAD THE ARGUMENT CALL LOD MVI L,FMACS ;SIGMA SO FAR CALL MUL LHLD FMACG ;CHOOSE THE BRANCH PCHL FMACA: LXI H,FMACT CALL DIV LXI H,FONE ;POINTS TO 1.0 JMP FMACF ;REJOIN COMMON CODE FMACB: LXI H,FMACS CALL STR ;X*SIGMA LXI H,FONE ;LOAD 1.0 CALL LOD MVI L,FMACT CALL DIV ;1/A(I) MVI L,FMACS FMACF: CALL AD MVI L,FMACS CALL STR POP D ;A(I) AND 32 POP B ;D(A) AND D**2(A) MOV A,D SUB C RZ ;DONE IF ZERO RC ;OR NEGATIVE MOV D,A ;A(I-1) MOV A,C ;D(A(I-1)) SUB B MOV C,A ;D(A(I-2)) JMP FMACD ;NEXT ITERATION ; ; ?????????????? ; FONE: DB 81H DB 0 DB 0 DB 0 FPIV2: DB 81H DB 49H DB 0FH DB 0DCH ;PI/2 FLN2: DB 80H DB 31H DB 72H DB 18H ;LN 2 ; ; SINE-COSINE USING MACLAURIN SERIES ; ; ENTRY FSIN FOR SIN(X) ; ENTRY FCOS FOR COS(X) ; ENTER WITH X IN RADIANS IN FLOATING POINT ACCUMULATOR ; (IF ABS(X) > 2**24*PI, OVERFLOW FLAG IS SET ; ; WRITTEN BY O.C. JUELICH, 165-796, B6 ; MISSILE SYSTEMS DIVISION, ROCKWELL INTERNATIONAL CORP. ; APRIL 1975 ; ; ENTRIES TO FLOATING PACKAGE ; ; 3 LEVELS OF STACK USED BEYOND FLOATING POINT PACKAGE ; FCOS: LHLD PT1 CALL LOD FCOS0: CALL CHS ;COMPLEMENT THE ANGLE LXI H,FPIV2 CALL AD JMP FSIN0 FSIN: LHLD PT1 CALL LOD FSIN0: CALL TST ;FETCH ARGUMENT MVI L,FSINX CALL STR LXI H,FPIV2 ;REDUCE X TO REVOLUTIONS * 4 CALL DIV MVI E,26 CALL FIX JC OVERF ;QUIT IF ANGLE TOO LARGE MVI E,26 MVI D,0 ;WIPE OUT FRACTIONAL REVOLUTIONS CALL FLT ;INTEGER PART OF REVOLUTIONS LXI H,FPIV2 ;TO RADIANS CALL MUL CALL CHS ;SUBTRACT INTEGRAL PART FSINA: MVI L,FSINX ;SUM IS REDUCED CALL AD MVI L,FSINX ;SAVE IT CALL STR CALL ABS ;FORCE ANGLE INTO REDUCED RANGE LXI H,FPIV2 CALL SB JM FSINB ;IF NEGATIVE OR ZERO JZ FSINB ;THEN ANGLE IS REDUCED LXI H,FPIV2 ;ABS(X)-PI CALL SB MOV E,A ;SAVE A REGISTER MVI L,FSINX+1 MOV A,M ANI 80H ;SIGN OF X XRI 80H ;INVERTED XRA B ;-SIGN(X)*(ABS(X)-PI) MOV B,A MOV A,E ;RESTORE A REGISTER DCX H ;POINT TO FSINX CALL STR ;REDUCED X CALL ZRO ;CLEAR ACCUMULATOR JMP FSINA ;REPEAT UNTIL ABS(X) <= PI/2 ; FSINB: MVI L,FSINX CALL LOD MVI L,FSINX CALL MUL CALL CHS ;-X**2 MVI L,FMACX CALL STR ;TO MACLAURIN SERIES MVI D,72 ;9*8, I1 TERM DISCARDED, 18 BITS PRECISION MVI C,30 ;9*8-7*6 MVI B,8 ;(9*8-7*6)-(7*6-5*4) CALL FMACE MVI L,FMACS ;SUM OF SERIES/X CALL LOD MVI L,FSINX CALL MUL CPI 81H ;SEE IF TAIL NEEDS CLEANING JC FSINC ;NO, MAGNITUDE IS < 1./ MVI L,ACC2 XRA A ;ZEROES FOR THE TAIL MOV M,A INR L MOV M,A FSINC: CALL TST ;RESTORE FLAGS AND REGISTERS LHLD PT1 CALL STR RET ; ; ARCTAN ROUTINE USING MACLAURIN SERIES ; ENTRY FATAN FOR ARCTAN(X), WITH X IN FLOATING ACCUMULATOR ; RESULT RETURNED IN FLOATING ACCUMULATOR ; WRITTEN BY O.C. JUELICH ; ; FOUR LEVELS OF STACK USED BEYOND FLOATING POINT PACKAGE ; ARTN: LHLD PT1 CALL LOD FATAN: CALL TST ;GET F.P. ACC. INTO REGISTERS RZ CPI 81H ;TEST EXPONENT JC FATN1 ;RETURN TO CALLER FROM FATN1 LXI H,FONE ;1.0 CALL IDV ;1.0/X CALL FATN1 ;GET ARCTAN(1/X) MVI L,FATNU ;SIGN(T)*(PI/2-ABS(T)) CALL STR LXI H,FPIV2 ;PI/2 CALL LOD MOV E,A ;SAVE A-REGISTER MVI L,FATNU+1 MOV A,M ;TO A-REGISTER ANI 80H ORA B ;ATTACH TO PI/2 MOV B,A MOV A,E ;RESTORE A REGISTER MVI L,FATNT ;SAVE SIGN(T)*PI/2 CALL STR MVI L,FATNT CALL LOD MVI L,FATNU ;-SIGN(T) * (PI/2-ABS(T)) CALL SB ;=SIGN(T)*ABS(T)=T LHLD PT1 CALL STR RET ; ; EVALUATE ARCTAN OF ARGUMENTS & 1. ; FATN1: MVI L,FATNT ;POINT TO TEMP CALL STR MVI L,FATNT CALL MUL ;TAN(T)**2 LXI H,FONE CALL AD CALL FSQRT LXI H,FONE CALL AD ;1.0+SQRT(TAN(T)**2+1.0) MVI L,FATNT ;TAN(T) CALL IDV ;TAN(T/2) MVI L,FATNT CALL STR MVI L,FATNU INR A ;2*TAN(T/2) CALL STR MVI L,FATNT CALL MUL CALL CHS ;-TAN(T/2)**2 MVI L,FMACX CALL STR MVI D,11 ;TERM 13 DISCARDED, 16 BITS PRECISION IN RANGE MVI C,2 ;(11-9) MVI B,0 ;(11-9)-(9-7) CALL FMACL MVI L,FMACS ;(T/2)/TAN(T/2) CALL LOD MVI L,FATNU ;*(2*TAN(T/2)) CALL MUL PUSH H LHLD PT1 CALL STR POP H RET ; ; EXPONENTIAL AND HYPERBOLIC SINE ROUTINE ; USING MACLAURIN SERIES FOR SINH ; ENTRY FEXP FOR EXP(X) ; ENTRY FSINH FOR FSINH(X) ; ENTER WITH X IN FLOATING POINT ACCUMULATOR ; RETURNS WITH FUNCTION IN FLOATING POINT ACCUMULATOR ; IF FUNCTION EXCEEDS 2**127, OVERFLOW FLAG IS SET ; WRITTEN BY O.C. JUELICH ; 5 LEVELS OF STACK USED BEYOND FLOATING POINT PACKAGE ; FHYS: LHLD PT1 CALL LOD FSINH: CALL TST ;FETCH FLOATING POINT ACCUM MVI L,FSNHX ;SAVE ARGUMENT CALL STR MVI L,FSNHD ;ADDRESS DOUBLING COUNTER MVI M,0 SUI 80H ;REMOVE OFFSET FROM A JM FSNHA ;DOUBLING COUNT AND X ARE O.K. CPI 8 ;ELIMINATE OVERSIZE DOUBLING JP OVERF ;RETURN THROUGH OVERFLOW ROUTINE MOV M,A ;SAVE THE DOUBLING ARGUMENTS MVI L,FSNHX ;BRING ARGUMENT INTO RANGE MVI M,80H CALL LOD FSNHA: MVI L,FSNHX CALL MUL ;X**2 MVI L,FMACX CALL STR MVI D,42 ;7*6, 9 TERM DISCARDED, 18 BITS PRECISION MVI C,22 ;7*6-5*4 MVI B,8 ;(7*6-5*4)-(5*4-3*2) CALL FMACE MVI L,FMACS CALL LOD MVI L,FSNHX CALL MUL MVI L,FSNHX ;SINH(X) CALL STR MVI L,FSNHX ;SINH(X)**2 CALL MUL LXI H,FONE ;1.0 CALL AD CALL FSQRT ;COSH(X) FOR DOUBLING AND FOR EXP(X) MVI L,FMACX ;TEMP CALL STR FSNHB: MVI L,FSNHD ;ADDRESS DOUBLING COUNT DCR M ;TALLY AT LOOP TOP JM FSNHC ;DONE WHEN NEGATIVE MVI L,FMACX ;COSH(X/2) CALL LOD MVI L,FSNHX ;SINH(X/2) CALL MUL INR A ;2.*SINH(X/2)*COSH(X/2) MVI L,FSNHX ;SINH(X) CALL STR MVI L,FMACX ;COSH(X) CALL LOD MVI L,FMACX CALL MUL MVI L,ACCE ;2.*COSH(X/2)**2 INR M LXI H,FONE ;-1. CALL SB MVI L,FMACX ;=COSH(X) CALL STR JMP FSNHB ;TEST THE DOUBLING COUNT FSNHC: MVI L,FSNHX CALL LOD PUSH H LHLD PT1 CALL STR POP H RET FEXP: LHLD PT1 CALL LOD FEXP0: CALL TST JP FEXPP MVI L,OVER ;SAVE OVERFLOW FLAG MOV E,M MVI M,0 ;CLEAR OVERFLOW FLAG MVI L,FEXOV-SCR MOV M,E ;OLD FLAG TO SAVE CELL CALL ABS CALL FEXPP ;EXP(-X) IN ACC MVI L,FEXOV MOV E,M ;GET OLD OVERFLOW FLAG BACK MVI L,OVER MOV A,M ;PICK UP NEW ONE TO TEST MOV M,E ;RESTORE OLD OVERFLOW FLAG ANA A ;SET FLAGS JNZ ZRO ;RECIPROCALL OF OVERFLOW IS ZERO LXI H,FONE CALL IDV ;1./EXP(-X)=EXP(X) LHLD PT1 CALL STR RET FEXPP: CALL FSINH ;SINH(X) MVI L,FMACX ;+COSH(X) CALL AD ;=EXP(X) PUSH H LHLD PT1 CALL STR POP H RET ; ; NATURAL LOGARITHM ROUTINE USING MACLAURIN SERIES ; ENTRY FLOG FOR LN(ABS(X)), WITH X IN FLOATING POINT ACCUMULATOR ; RESULT IS RETURNED IN FLOATING POINT ACCUMULATOR ; IF X = 0 THE OVERFLOW FLAG IS SET ; 3 LEVELS OF STACK USED ; FLOG: LHLD PT1 CALL LOD FLOG0: CALL ABS ;FORCE ARGUMENT POSITIVE, SET ZERO FLAG JZ OVERF ;RETURN THROUGH OVERFLOW ROUTINE SUI 81H ;REMOVE EXPONENT OFFSET MVI L,FLOGE MOV M,A MVI A,81H ;NORMALIZE ARGUMENT MVI L,FLOGX CALL STR ;CALL IT X MVI L,FLOGX CALL LOD LXI H,FONE CALL AD MVI L,FMACS CALL STR ;X+1.0 MVI L,FLOGX CALL LOD LXI H,FONE CALL SB ;X-1./ MVI L,FMACS CALL DIV MVI L,FLOGX CALL STR ;(X-1.0)/(X+1.0) MVI L,FLOGX CALL MUL MVI L,FMACX CALL STR ;((X-1.0)/(X+1.0)*2 MVI D,9 ;DISCARD 11 TERM FOR 18 BIT PRECISION MVI C,2 ;9-7 MVI B,0 ;(9-7)-(7-5) CALL FMACL MVI L,FMACS INR M ;DOUBLE THE SUM CALL LOD MVI L,FLOGX CALL MUL ;LOGARITHM OF FRACTIONAL PART MVI L,FLOGX CALL STR MVI L,FLOGE MOV A,M ;EXPONENT AS INTEGER MVI B,0 MOV C,B MOV D,B MVI E,8 ;BINARY SCALE FOR EXPONENT CALL FLT LXI H,FLN2 CALL MUL ;LOGARITHM OF 2**EXPONENT MVI L,FLOGX CALL AD LHLD PT1 CALL STR RET XSQT: LHLD PT1 ;POINT TO INPUT CALL LOD ;LOAD IT ; ; ONE LEVEL OF STACK USED BEYOND FLOATING PACKAGE ; FSQRT: CALL ABS ;FORCE ARG POSITIVE, SET ZERO FLAG RZ ;RETURN ON ZERO MVI L,FSQRN ;STORAGE FOR ARGUMENT CALL STR ANA A ;RESET CARRY BIT RAR ;HALVE THE EXPONENT ADI 40H ;RESTORE THE OFFSET MVI L,FSQRX ;STORE THE FIRST ; ; ITERATE ; CALL STR MVI D,5 ;ITERATION COUNT PUSH D ;STACKED FSQRL: MVI L,FSQRN ;LOAD THE ARGUMENT CALL LOD MVI L,FSQRX ;DIVIDE BY ITERATE CALL DIV MVI L,FSQRX ;ADD ITERATE CALL AD SUI 1 ;HALVE THE RESULT MVI L,FSQRX ;RESTORE NEXT ITERATE CALL STR POP D ;RESTORE ITERATION COUNT DCR D ;TALLY JZ FSQRE ;EXIT WHEN COUNT EXHAUSTED PUSH D ;SAVE IT OTHERWISE JMP FSQRL ;TO NEXT ITERATION FSQRE: MVI L,FSQRX ;RESULT TO ACCUMULATOR CALL LOD PUSH H LHLD PT1 ;POINT TO OUTPUT CALL STR POP H RET ; ; PSEUDO RANDOM NUMBER GENERATOR ; XRAN: LXI H,RAN0+3 MVI B,8 MOV A,M RN1: RLC RLC RLC XRA M RAL RAL DCX H DCX H DCX H MVI C,4 RN2: MOV A,M RAL MOV M,A INX H DCR C JNZ RN2 DCX H DCR B JNZ RN1 LXI H,RAN0 CALL LOD LHLD PT1 MVI A,80H CALL STR RET XABS: LHLD PT1 ;GET VALUE TO OPERATE ON CALL LOD CALL ABS LHLD PT1 ;GET ADDRESS TO PUT IT CALL STR RET XINT: LHLD PT1 ;GET VALUE TO OPERATE ON CALL LOD MVI E,32 ;SCALING FACTOR IS 32 CALL FIX ;TAKE INTEGER MVI E,32 CALL FLT ;FLOAT RESULT LHLD PT1 ;GET RESTORE ADDRESS CALL STR RET XSGN: LHLD PT1 ;GET ADDRESS OF OPERAND CALL LOD CALL TST ;TEST IFRT JZ XSG1 ;ZERO JM XSG2 ;LESS THAN ZERO LXI H,FLTONE ;>0, RESULT=1 CALL LOD ;LOAD 1 XSG3: LHLD PT1 ;GET POINTER TO RESULT CALL STR ;STORE RESULT RET XSG1: SUB A ;MAKE EXPONENT ZERO JMP XSG3 ;RESULT IS ZERO XSG2: LXI H,FLTONE ;<0 CALL LOD ;GET ONE CALL CHS ;MAKE IT NEG JMP XSG3 ; ; RAISE TO A POWER ; ARGUMENT MUST BE POSITIVE NUMBER ; (WORKS LIKE A FLOATING POINT PACKAGE ROUTINE) ; FLEX: LXI H,ACCE+SCRB CALL PUSHF LHLD PT1 CALL LOD CALL TST JZ ZFEX MVI E,32 CALL FIX MOV E,D MOV D,C XCHG SHLD TEMP LXI H,ACCE+SCRB CALL POPF SUB A STA ACC3 CALL TST ERM24: CM ERROR6 ;NEGATIVE BASE LXI H,FLAC CALL STR FLLP: LHLD TEMP DCX H MOV A,H ORA L RZ SHLD TEMP LXI H,FLAC CALL MUL JMP FLLP ZFEX: LXI H,FLAC CALL POPF LXI H,FLTONE CALL LOD RET LIBRARY: RET ; ; FLOATING POINT PACKAGE ; ARITH EQU $ ARITHB EQU $ SHR 8 INIT EQU $ ; ; STR ENTRY POINT ; STR0: MOV M,E INR L STR: MOV M,A STR1: INR L MOV M,B INR L MOV M,C INR L MOV M,D RET ; ; FLOATING POINT ZERO SUBROUTINE ; ZRO: MVI H,SCRB ZRO1: MVI L,ACCE XRA A MOV M,A RET ; ; FLOATING POINT CHS ROUTINE ; CHS: MVI A,200Q DB 6 ;MVI B,XX INSTRUCTION TO SKIP NEXT BYTE ; ; FLOATING POINT ABS ROUTINE ; ABS: XRA A MVI H,SCRB MVI L,ACCS ANA M XRI 200Q MOV M,A ; ; FLOATING POINT TST ENTRY POINT ; TST: MVI H,SCRB TST1: MVI L,ACCE MOV A,M ANA A JZ ZRO MOV E,A INR L MOV A,M INR L XRA M INR L MOV C,M INR L MOV D,M JMP ADD12 ; ; FLOATING POINT LOAD ENTRY POINT ; LOD: MOV A,M ANA A JZ ZRO MOV E,A INR L MOV A,M INR L MOV C,M INR L MOV D,M MOV L,A LOD1: ORI 200Q MOV B,A XRA L MVI H,SCRB MVI L,ACCE CALL STR0 XRA B MOV B,A ORI 1 MOV A,E RET ; ; FLOATING POINT MULTIPLY ROUTINE ; MUL: MOV A,M ANA A CNZ MDEX JZ ZRO JC OVERF CALL MULX MOV A,B ANA A JM RNDA MVI L,ACCE MOV A,M SBI 1 MOV M,A RZ CALL LSH RNDA: CALL ROND JC OVERF MOV B,A ORI 1 MOV A,E RET ; ; FLOATING POINT DIVIDE ROUTINE ; DIV: XRA A SUB M CPI 1 CNC MDEX JC OVERF JZ ZRO1 MOV C,A CALL DIVX MVI H,SCRB JC RNDA OVERF: MVI H,SCRB MVI L,OVER MVI A,-1 MOV M,A RLC RET DB 0 ;CHECK SUM WORD ; ; FLOATING POINT SUBTRACT ENTRY POINT ; SB: MVI A,200Q DB 6 ;MVI B,XX INSTRUCTION TO SKIP NEXT BYTE ; ; FLOATING POINT ADD ROUTINE ; AD: XRA A MOV E,M INR L XRA M MOV B,A INR L MOV C,M INR L MOV D,M MVI H,SCRB MVI L,ACCE MOV A,M DCR L MOV M,A MOV A,E ANA A JZ TST1 MOV L,B MOV A,B ORI 200Q MOV B,A XRA L MVI L,ACCS XRA M MVI L,SF MOV M,A MVI L,ACCE MOV A,M ANA A JZ ADD17 SUB E JC ADD2 JM TST1 CPI 31Q JC ADD3 JMP TST1 ADD2: JP ADD17 CPI 347Q JC ADD17 MOV M,E MOV E,A MVI L,SF MOV A,M MVI L,ACCS XRA M MOV M,A XRA A SUB E INR L MOV E,M MOV M,B MOV B,E INR L MOV E,M MOV M,C MOV C,E INR L MOV E,M MOV M,D MOV D,E ADD3: CALL RSH MVI L,SF MOV A,M ANA A MVI L,ACC3 JM ADD9 MOV A,M ADD D MOV D,A DCR L MOV A,M ADC C MOV C,A DCR L MOV A,M ADC B MOV B,A JNC ADD11 RAR MOV B,A MOV A,C RAR MOV C,A MOV A,D RAR MOV D,A RAR MOV E,A MVI L,ACCE MOV A,M ADI 1 JC OVERF MOV M,A JMP ADD11 ADD9: XRA A SUB E MOV E,A MOV A,M SBB D MOV D,A DCR L MOV A,M SBB C MOV C,A DCR L MOV A,M SBB B MOV B,A ADD10: CC COMP CP NORM JP ZRO1 ADD11: CALL ROND JC OVERF ADD12: MOV B,A MVI L,PREX MOV A,E SUB M MOV L,A MOV A,B ORI 1 MOV A,E MOV E,L RET ADD17: MVI L,SF MOV A,M MVI L,ACCS XRA M DCR L CALL STR0 XRA B JMP ADD12 DB 0 ;CHECKSUM WORD MDEX: MOV B,A INR L MOV C,M INR L MOV D,M INR L MOV E,M MVI H,SCRB MVI L,ACCE MOV A,M ANA A RZ ADD B MOV B,A RAR XRA B MOV A,B MVI B,200Q JP OVUN SUB B RZ MOV M,A INR L MOV A,M XRA C ANA B MOV M,A MOV A,C ORA B RET OVUN: RLC RC XRA A RET LSH: MOV A,E RAL MOV E,A LSH1: MOV A,D RAL MOV D,A MOV A,C RAL MOV C,A MOV A,B ADC A MOV B,A RET RSH: MVI E,0 RSH0: MVI L,10Q RSH1: CMP L JM RSH2 MOV E,D MOV D,C MOV C,B MVI B,0 SUB L JNZ RSH1 RSH2: ANA A RZ MOV L,A RSH3: ANA A MOV A,B RAR MOV B,A MOV A,C RAR MOV C,A MOV A,D RAR MOV D,A MOV A,E RAR MOV E,A DCR L JNZ RSH3 RET COMP: DCR L MOV A,M XRI 200Q MOV M,A COMP1: XRA A MOV L,A SUB E MOV E,A MOV A,L SBB D MOV D,A MOV A,L SBB C MOV C,A MOV A,L SBB B MOV B,A RET NORM: MVI L,40Q NORM1: MOV A,B ANA A JNZ NORM3 MOV B,C MOV C,D MOV D,E MOV E,A MOV A,L SUI 10Q MOV L,A JNZ NORM1 RET NORM2: DCR L MOV A,E RAL MOV E,A MOV A,D RAL MOV D,A MOV A,C RAL MOV C,A MOV A,B ADC A MOV B,A NORM3: JP NORM2 MOV A,L SUI 40Q MVI L,ACCE ADD M MOV M,A RZ RAR ANA A RET ROND: MVI L,ACCE MOV A,E ANA A MOV E,M CM RNDR RC MOV A,B INR L XRA M JMP STR1 RNDR: INR D RNZ INR C RNZ INR B RNZ MOV A,E ADI 1 MOV E,A MVI B,200Q MOV M,A RET MULX: MVI L,MULP1 MOV M,A MVI L,MULP2 MOV M,D MVI L,MULP3 MOV M,E XRA A MOV E,A MOV D,A MVI L,ACC3 CALL MULX2 MVI L,ACC2 CALL MULX1 MVI L,ACC1 MULX1: MOV A,D MOV E,C MOV D,B MULX2: MOV B,M MOV L,A XRA A MOV C,A SUB B JC MULX3 MOV C,D MOV D,E RET MULX5: MOV C,A JNC MULX3 INR B ANA A MULX3: MOV A,L ADC A RZ MOV L,A MOV A,E RAL MOV E,A MOV A,D RAL MOV D,A MOV A,C RAL MOV C,A MOV A,B RAL MOV B,A JNC MULX3 MOV A,E JMP MULX4 DIVX: MVI L,ACC3 MOV A,M SUB E MOV M,A DCR L MOV A,M SBB D MOV M,A DCR L MOV A,M SBB C MOV M,A MOV A,C RAL MOV A,C RAR MVI L,OP1S MOV M,A MVI L,OP1A MOV M,A MOV A,D RAR MVI L,OP2S MOV M,A MVI L,OP2A MOV M,A MOV A,E RAR MVI L,OP3S MOV M,A MVI L,OP3A MOV M,A MVI B,0 MOV A,B RAR MVI L,OP4S MOV M,A MVI L,OP4A MOV M,A MVI L,OP4X MOV M,A MVI L,ACC1 MOV A,M INR L MOV D,M INR L MOV E,M ANA A JM DIVX4 MVI L,ACCE MOV C,M INR C RZ MOV M,C MOV L,E MOV H,D MOV E,A MVI D,1 MOV C,B DIVX1: XRA A CALL DIVX5 DIVX2: RLC MOV A,B RAL RC RAR MOV A,L RAL MOV L,A MOV A,H RAL MOV H,A CALL LSH MOV A,D RRC JC DIVX1 DIVX3: MOV A,L JMP DIVX6 DIVX4: MOV L,E MOV H,D MOV E,A MOV D,B MOV C,B JMP DIVX3 DB 0 ;CHECKSUM WORD ; ; FORMAT CONVERSION PACKAGE ; ADRL EQU SF+1 ADRH EQU ADRL+1 TMP1 EQU ADRH+1 TMP2 EQU TMP1+1 TMP3 EQU TMP2+1 VALE EQU TMP3+1 VAL1 EQU VALE+1 VAL2 EQU VAL1+1 VAL3 EQU VAL2+1 TMP4 EQU VAL3+1 ; FLT: MOV L,E MOV E,D MOV D,C MOV C,B MOV B,A MOV A,L XRI 200Q MVI H,SCRB MVI L,ACCE MOV M,A INR L MVI M,200Q INR L MOV A,B ANA A RAL JMP ADD10 FIX: MVI H,SCRB MVI L,ACCE MOV A,M ANA A JZ FIX1 MOV A,E ADI 177Q SUB M RC CPI 37Q JNC FIX1 ADI 1 MVI L,ACC1 MOV B,M INR L MOV C,M INR L MOV D,M CALL RSH MVI L,ACCS MOV A,M ANA A CP COMP MVI A,1 ORA B MOV A,B MOV B,C MOV C,D MOV D,E RET FIX1: XRA A MOV B,A MOV C,A MOV D,A RET DB 0 ;CHECKSUM WORD INP: MOV E,M CALL SVAD INR L MVI M,200Q MVI L,ACCE MOV M,D MOV A,E CPI 360Q JZ INP1 CPI 373Q JZ INP1 CPI 375Q JNZ INP2 MVI L,TMP3 MOV M,D INP1: CALL CHAD MOV A,M MVI H,SCRB INP2: MVI B,0 CPI 376Q JZ INP3 CPI 25Q JZ INP4 CPI 12Q JNC INP8 MVI L,TMP4 MOV M,A LXI H,FTEN CALL MUL MVI L,VALE CALL STR INR L MOV A,M MVI B,0 MOV C,B MOV D,B MVI E,8 CALL FLT MVI L,VALE CALL AD MVI L,TMP2 MOV A,M ANA A JZ INP1 DCR L MOV B,M DCR B MOV M,B JMP INP1 INP3: MVI L,TMP2 XRA M MOV M,A JNZ INP1 JMP INP8 INP4: CALL CHAD MOV A,M MOV B,A SUI 375Q MOV E,A JZ INP5 ADI 2 MOV A,B JNZ INP6 INP5: INR L MOV A,M INP6: MVI B,0 CPI 12Q JNC INP8 MOV B,A INR L MOV A,M CPI 12Q JNC INP7 MOV C,A MOV A,B ADD A ADD A ADD B ADD A ADD C MOV B,A INP7: MOV A,E ANA A JNZ INP8 SUB B MOV B,A INP8: MVI H,SCRB MVI L,TMP3 MOV C,M MVI L,ACCS MOV M,C MOV A,B INP9: MVI L,TMP1 ADD M JZ TST MOV M,A LXI H,FTEN JP INP10 CALL DIV MVI A,1 JMP INP9 INP10: CALL MUL RC MVI A,-1 JMP INP9 OU: DCR L CALL SVAD CALL TST MVI L,VALE CALL STR CALL CHAD MVI M,360Q ANA A JZ OUT3 MOV E,A MOV A,B ANA A MOV A,E JP OUT1 MVI M,375Q OUT1: CPI 176Q OUT2: LXI H,FTEN JC OUT4 CPI 201Q JC OUT5 CALL DIV OUT3: MVI H,SCRB MVI L,TMP2 MOV E,M INR E MOV M,E JMP OUT2 OUT4: CALL MUL MVI L,TMP2 MOV E,M DCR E MOV M,E JMP OUT1 OUT5: CALL ABS LXI H,RND0 CALL AD CPI 201Q JNC OUT2 MVI L,TMP2 MOV A,M MOV E,A CPI 8 JC OUT6 MVI E,1 OUT6: SUB E MOV M,A MVI A,7 SUB E INR L MOV M,A DCR E MOV A,E OUT7: MVI L,TMP1 ADD M MOV M,A JM OUT8 LXI H,FTEN CALL MUL MVI E,8 CALL FIX CALL CHAD MOV M,A XRA A MVI E,8 CALL FLT MVI A,-1 JMP OUT7 OUT8: MVI L,TMP3 MOV A,M MVI M,-1 ANA A JM OUT9 CALL CHAD MVI M,376Q MVI H,SCRB JMP OUT7 OUT9: DCR L ANA M JZ OUT13 MVI B,373Q JP OUT10 MVI B,375Q MOV C,A XRA A SUB C OUT10: MVI C,-1 OUT11: MOV D,A INR C SUI 12Q JNC OUT11 MVI A,25Q OUT12: CALL CHAD CALL STR MVI H,SCRB MVI L,VALE JMP LOD OUT13: MVI A,360Q MOV B,A MOV C,A MOV D,A JMP OUT12 SVAD: MOV A,L MOV B,H MVI C,0 MOV D,C MVI H,SCRB MVI L,ADRL CALL STR RET CHAD: MVI H,SCRB MVI L,ADRL MOV E,M INR E MOV M,E INR L MOV H,M MOV L,E RET FTEN: DB 204Q DB 40Q DB 0,0 RND0: DB 150Q,126Q,277Q,255Q ;.00000005 DB 0 ;CHECKSUM WORD ; ; CONSTANTS, VARIABLES AND TABLES ; WORDS EQU 4 ;LENGTH RUBOUT EQU 7FH TEST EQU 2 ;UART STATUS PORT CRT EQU 3 ;CRT OUTPUT PORT SPACE EQU ' ' CR EQU 15Q ;CARRIAGE RETURN LF EQU 12Q KYBRD EQU 0 AXIN: DW 0 ;STORAGE INDEX TEXTP EQU $ AXOUT: DW FRSTX ;OUTPUT INDEX PC: DW FLTZER ;PROGRAM COUNTER THISLN: DW 0 ;LINE POINTER FROM FINDLN LASTLN: DW 0 ;BACK POINTER FROM FINDL DEBGSW: DB 0 ;DEBUG SWITCH: NONZERO FOR LITERAL PT1: DW 0 ;VARIABLE POINTER LASTV: DW BUFBEG ;ADDRESS OF LAST VARIABLE SRTCN: DB 0 ;RESULT OF SORTDC LASTOP: DB 0 ;LAST OPERATION FOR EVAL EFOP EQU $ ;FUNCTION CODE ATSW: DB 0 ;ASK-TYPE SWITCH CNTR: DB 0F0H ;DELETE AND ERROR COUNTER DB 0FFH STE: DB 0 STRTV EQU $ BUFR: DW BUFBEG ;NEXT LOC NAGSW: DB 1 ;SWITCH (200=ONE, 1=ALL, 0=GROUP) CHAR: DB 15Q LINENO: DW 0 ;LINE NO FROM GETLN (BCD) LIST6 EQU $ ;INPUT LIST FOR SFOUND DB 14Q ;F.F. DB 7 ;BELL LIST7 EQU $ DB 3 ;CONTROL C FOR DEBUGGING DB 137Q ;LEFT ARROW DB LF LIST3 EQU $ ;EXCRETION LIST DB 15Q ;LIST BRANCHER DB 0 DB 0 ;END OF LIST OPTBL EQU $ ;FLOATING POINT CALL ADDRESSES DW RECOVER DW AD DW SB DW DIV DW MUL DW FLEX DW RECOVER DMPSW: DB 0 ;SEARCH CHAR-VARIABLE: 0-TRACE FNTBF EQU $ ;FUNCTION ADDRESSES DW XABS DW XSGN DW XINT DW XRAN DW ARTN DW FEXP DW FLOG DW FSIN DW FCOS DW XSQT DW XUSR DW FHYS FNTBL EQU $ ;LIST OF CODED FUNCTION NAMES DB 'B' DB 'G' DB 'N' DB 'A' DB 'T' DB 'X' DB 'L' DB 'I' DB 'O' DB 'Q' DB 'S' DB 'Y' DB 0 ;END INLIST EQU $ ;INPUT CONTROL CHARACTERS DW RECOVER ;C.C. = BREAK DW IBAR ;B.A.= RESTART DW IGNOR ;L.F.= IGNORE DW IRETN ;C.R. = TERMINATE STRING FLST2: DW FLIMIT ;=STANDARD DW FINFIN ;=SHORT DW ERROR5 ;CR=DUMB FLST1: DW FINCR ;=STANDARD FORMAT DW PROCESS ;=SET: PLUS,... DW PC1 ;C.R. = SET COMMAND COMMENTS EQU PC1 ILIST: DW IF1 ;, DW PROCESS ;; DW PC1 ;CR COMLST EQU $ ;COMMAND DECODE LIST-SPEED OPTIMIZED DB 'S' ;SET DB 'F' ;FOR DB 'I' ;IF DB 'D' ;DO DB 'G' ;GOTO DB 'C' ;COMMENT DB 'A' ;ASK DB 'T' ;TYPE DB 'L' ;LIBRARY DB 'E' ;ERASE DB 'W' ;WRITE DB 'M' ;MODIFY DB 'Q' ;QUIT DB 'R' ;RETURN DB 'J' ;JUMP DB 0 ;END COMGO EQU $ DW SETX DW FOR DW IFX DW DO DW GOTO DW COMMENTS DW ASK DW TYPE DW LIBRARY DW ERASE DW WRITE DW MODIFY DW START ;QUIT DW RETRN DW JUMP ;COMPUTED TRANSFER SRNLST EQU $ DW SCHAR ;F.F. = CONTINUE DW SCONT ;BELL = CHANGE SEARCH CHAR DW RECOVER ;C.C. = BREAK DW SBAR ;B.A. = RESTART DW SCONT+3 ;L.F. = FINISH LINE AS WAS LISTGO EQU $ DW SRETN ;C.R. = END LINE HERE, AS IS DW SGOT ;CHAR = SEARCH CHAR ALIST EQU $ ;ASK-TYPE LIST OF CONTROLS DB '%' DB '"' DB 21H ;) DB 43Q DB '$' GLIST: DB ' ' TLIST: DB ',' DB ';' DB CR DB 0 RAN0: DW 1234H DW 1234H ATLIST EQU $ ;ASK-TYPE CONTROL CHAR TABLE DW TINTR ;%-FORMAT DELIMITER DW TQUOT ;"-LITERAL DELIMITER DW TCRL2 ;)-CR&LF DW TCRLF ;#-CR ONLY DW TDUMP ;$-DUMP SYMBOL TABLE DW TASK4 ;SP-TERMINATOR FOR NAMES DW TASK4 ;,-TERMINATOR FOR EXPRESSIONS DW PROCESS ;;-TERMINATOR FOR COMMAND DW PC1 ;CR-TERMINATOR FOR STRINGS ECHOLST: DB CR DB RUBOUT DB 0 TERMS EQU $ DB ' ' DB '+' DB '-' DB '/' DB '*' DB '^' DB '(' DB '[' DB '<' DB ')' DB ']' DB '>' DB ',' DB ';' DB CR DB '=' DB 0 FLARG: DW 0 ;DATA STORAGE DW 0 TLST3 EQU $ ;LITERAL TERMINATORS DW TASK4 ;" DW PC1 ;CR=AUTOMATIC QUOTE MATCH INFIX EQU $ ;DATA CONTROL CHARACTERS DW ERROR4 ;LEFT ARROW = KILL DW AK2 ;RUBOUT = IGNORE DW AK2 ;LF = IGNORE DW AK4 ;ALTMODE DW AK3 ;CR INFIN DW RECOVER ;C.C. FLTONE: DB 81H DB 0 FLTZER: DW 0 DW 0 FLTTWO: DB 82H DB 0 DW 0 FLAC: DS 4 FISW: DB 104Q ;FLOATING OUTPUT FORMAT SPECIAL EQU $ ;INPUT CHARACTERS DB 137Q ;LEFT ARROW DB RUBOUT DB LF DB 33Q ;ALT MODE DB CR DB 3 ;C.C. DB 0 ;END ITER1: DW 0 TEMP: DW 0 TEMP2: DW 0 TLST2: DB '"' ;QUOTE DB CR ;FUNCTION OR NUMBER NOT AN ARG DB 0 DB 0FFH DATBUF: DB ' ' DB 0FFH IOBUF: DB ' ' COMEIN: DB 0FFH DB ' ' DB ' ' COMEOUT EQU $ DB 0FFH FRST: DW 0 ;TEXT POINTER DW 0 ;DUMMY LINE NUMBER FRSTX: DB CR ;DUMMY END OF LINE BUFBEG EQU $ COMBUF EQU COMEIN+1 ;COMMAND BUFFER START CFRS EQU FRST ;ADDRESS OF FIRST LINE (DUMMY) CFRSX EQU FLTZER ;POINTER TO ZERO DATA OPTR0 EQU IOBUF ;OUTPUT POINTERS SCR EQU SBANK AND 0FFH SCRB EQU SBANK SHR 8 FSQRN EQU SCR+40H FSQRX EQU SCR+44H IDVT EQU SCR+40H FMACX EQU SCR+40H FMACS EQU SCR+44H FMACT EQU SCR+48H FMACG EQU SCR+4CH FSINX EQU SCR+50H FATNT EQU SCR+50H FATNU EQU SCR+54H FSNHD EQU SCR+4EH FEXOV EQU SCR+4FH FSNHX EQU SCR+50H FLOGE EQU SCR+4EH FLOGX EQU SCR+50H ; PRNTER: LXI H,ERRMS PERR4: MOV E,M INX H MOV D,M INX H XCHG SHLD LINENO PUSH D CALL PRNTLN POP H PERR1: MOV A,M INX H CPI CR JZ PERR2 CALL XOUTL JMP PERR1 PERR2: CALL XOUTL MOV A,M INX H ORA A JZ PERR3 CALL XOUTL JMP PERR4 PERR3: MVI A,LF CALL XOUTL RST 0 ; ERRMS: DW 0 DB ' RESTART (CONTROL C)',CR,LF DW ERM1+3 DB ' INPUT BUFFER FULL',CR,LF DW GZERR+3 DB ' BAD LINE NUMBER',CR,LF DW GERR+3 DB ' BAD LINE NUMBER',CR,LF DW ERM4+3 DB ' IRRECOVERABLE MEMORY OVERFLOW (RELOAD)',CR,LF DW PCHK2 DB ' RECOVERABLE MEMORY OVERFLOW (ENTER ERASE)',CR,LF DW ERM6+3 DB ' BAD LINE NUMBER',CR,LF DW DGRP1 DB ' NO SUCH GROUP (LINE NUMBER)',CR,LF DW ERM8+3 DB ' -DO- REFERENCES MISSING LINE',CR,LF DW ERM9+3 DB ' -GO TO- REFERENCES MISSING LINE',CR,LF DW WRITE DB ' INVALID COMMAND',CR,LF DW ERM10+3 DB ' LEFT OF EQUAL BAD, FOR OR SET',CR,LF DW FINCR DB ' BAD EXPRESSION IN FOR',CR,LF DW FLIMIT DB ' BAD EXPRESSION IN FOR',CR,LF DW ERM13+3 DB ' MISSING LINE REFERENCED BY MODIFY',CR,LF DW ERM14+3 DB ' MISSING ) IN SUBSCRIPT',CR,LF DW ERM15+3 DB ' BAD EXPRESSION',CR,LF DW ERM16+3 DB ' BAD EXPRESSION',CR,LF DW ETRM1 DB ' BAD EXPRESSION',CR,LF DW ETR2 DB ' MISSING OPERATOR IN EXPRESSION',CR,LF DW FUN4 DB ' MISSING (',CR,LF DW EFUN3 DB ' BAD FUNCTION NAME',CR,LF DW ERM21+3 DB ' ARITHMETIC OVERFLOW',CR,LF DW ERM22+3 DB ' BAD ARGUMENT TO ERASE',CR,LF DW ERT DB ' BAD ARGUMENT TO ERASE',CR,LF DW ERM24+3 DB ' NEGATIVE ARGUMENT TO RAISE TO A POWER',CR,0 ; END PRNTER