;###S
;MODIFIED BY TONY GOLD FOR NON-MACR0 ASSEMBLER
;CHANGES WITHIN ;###S AND ;###E LINES
;ALL ORIGINAL CODE RETAINED AS COMMENTS
;###E
;
; ////FLOATING POINT PACKAGE FOR THE MCS8
; ////BY DAVID MEAD
; ////MODIFIED BY HAL BRAND 9/6/74
; ////MODIFIED FOR 24 BIT MANTISSAS***********
; ////PLUS ADDED I/O CONVERSION ROUTINES
; ////NEW ROUTINE COMMENTS
; ////ARE PRECEEDED BY /
; ////OTHER CHANGES ARE NOTED BY **
; ////MODIFIED BY FRANK OLKEN 6/28/75
;
;
;###S
; EQUATES FOR RELOCATED PACKAGES
ORG 10DDH
INTERP: EQU 0100H
FPTBL: EQU 1774H
IOJUMP: EQU 1900H
CONIN: EQU IOJUMP+4
STATUS: EQU IOJUMP+0AH
INP: EQU FPTBL+33H
OUTR: EQU FPTBL+36H
OUTL: EQU INTERP+7D9H
INL: EQU INTERP+996H
; ORG 110000Q
;
;
CPM: EQU 5
;CONIN EQU 404Q ; JMP TABLE LOCATION OF CONSOLE INP.
;STATUS EQU 412Q ; JMP TABLE LOC. FOR STATUS PORT INPUT
;OUTR EQU 113775Q ;LINK TO BASIC
;OUTL EQU 103726Q
;INL EQU 104623Q
;INP EQU 113772Q ;LINK TO BASIC
;###E
MINCH EQU 300Q ;MINIMUM CHARACTERISTIC WITH SIGN EXTENDED
MAXCH EQU 077Q ;MAXIMUM CHARACTERISTIC WITH SIGN EXTENDED
;
;
;******************************************************
; //// DIVIDE SUBROUTINE
;******************************************************
;
;
LDIV: CALL CSIGN ;COMPUTE SIGN OF RESULT
CALL ZCHK ;CHECK IF DIVIDEND = ZERO
JNZ DTST2 ;IF DIVIDEND .NE. 0 CHECK DIVISOR
CALL BCHK ;CHECK FOR ZERO/ZERO
JZ INDFC ;ZERO/ZERO = INDEFINITE
JMP WZERC ;ZERO/NONZERO = ZERO
DTST2: CALL BCHK ;COME HERE IF DIVIDEND .NE. 0
JZ OFLWC ;NONZERO/ZERO = OVERFLOW
;IF WE GET HERE, THINGS LOOK OKAY
MOV E,L ;SAVE BASE IN E
MOV L,C ;BASE\6 TO L
CALL DCLR ;CLEAR QUOTIENT MANTISSA SLOT
MOV L,E ;RESTORE BASE IN L
CALL ENT1 ;DO FIRST CYCLE
MOV L,C ;BASE \6 TO L
CALL DLST ;MOVE QUOTIENT OVER ONE PLACE
MVI D,23 ;NUMBER OF ITERATIONS TO D
REP3: MOV L,E
CALL ENT2
DCR D ;DEC D
JZ GOON
MOV A,L
MOV L,C ;BASE\6 TO L
MOV C,A
CALL DLST ;MOVE QUOTIENT MANT OVER
MOV A,L ;CPTR TO A
MOV E,C ;LPTR TO E
MOV C,A ;CPTR TO C
JMP REP3
;
GOON: CALL AORS ;CHECK IF RESULT IS NORMALIZED
JM CRIN
MOV A,L ;LPTR TO A
MOV L,C ;CPTR TO L
MOV C,A ;LPTR TO C
CALL DLST ;SHIFT QUOTIENT LEFT
MOV C,L
MOV L,E
CALL LDCP ;COMPUTE THE CHARACTERISTIC OF RESULT
RET
;
CRIN: CALL CFCHE ;GET A=CHAR(H,L), E=CHAR(H,B)
SUB E ;NEW CHAR = CHAR(DIVIDEND) - CHAR(DVISIOR)
CPI 177Q ;CHECK MAX POSITIVE NUMBER
JZ OFLWC ;JUMP ON OVERFLOW
ADI 1 ;ADD 1 SINCE WE DID NOT LEFTSHIFT
CALL CCHK ;CHECK AND STORE CHARACTERISTIC
RET ;RETURN
;
;
;
;******************************************************
; //// ADDITION SUBROUTINE
;******************************************************
;
;
LADD: XRA A ;/***SET UP TO ADD
JMP LADS ;/NOW DO IT
;
;
;******************************************************
; //// SUBTRACTION SUBROUTINE
;******************************************************
;
;
LSUB: MVI A,200Q ;/****SET UP TO SUBTRACT
; SUBROUTINE LADS
; FLOATING POINT ADD OR SUB
; A[128 ON ENTRY[SUB
; A[0 ON ENTRY[ADD
; F-S[F,FIRST OPER DESTROYED
; BASE \11 USED FOR SCRATCH
LADS: CALL ACPR ;SAVE ENTRY PNT AT BASE \6
CALL BCHK ;CHECK ADDEND/SUBTRAHEND = ZERO
RZ ;IF SO, RESULT=ARG SO RETURN
;THIS WILL PREVENT UNDERFLOW INDICATION ON
;ZERO + OR - ZERO
CALL CCMP
JZ EQ02 ;IF EQUAL, GO ON
MOV D,A ;SAVE LPTR CHAR IN D
JC LLTB
SUB E ;L.GT.B IF HERE
ANI 127
MOV D,A ;DIFFERENCE TO D
MOV E,L ;SAVE BASE IN E
MOV L,C ;C PTR TO L
INR L ;C PTR\1 TO L
MOV M,E ;SAVE BASE IN C PTR\1
MOV L,B ;B PTR TO L
JMP NCHK
LLTB: MOV A,E ;L.LT.B IF HERE,BPTR TO A
SUB D ;SUBTRACT LPTR CHAR FROM BPTR CHAR
ANI 127
MOV D,A ;DIFFERENCE TO D
NCHK: MVI A,24
CMP D
JNC SH10
MVI D,24
SH10: ORA A
CALL DRST
DCR D
JNZ SH10
EQUL: MOV A,L
CMP B
JNZ EQ02 ;F.GT.S IF L.NE.B
MOV L,C ;C PTR TO L
INR L ;C PTR\1 TO L
MOV L,M ;RESTORE L
EQ02: CALL LASD ;CHECK WHAT TO
CALL ACPR ;SAVE ANSWER
CPI 2 ;TEST FOR ZERO ANSWER
JNZ NOT0
JMP WZER ;WRITE FLOATING ZERO AND RETURN
;
NOT0: MVI D,1 ;WILL TEST FOR SUB
ANA D
JZ ADDZ ;LSB[1 INPLIES SUB
CALL TSTR ;CHECK NORMAL/REVERSE
JZ SUBZ ;IF NORMAL,GO SUBZ
MOV A,L ;OTHERWISE REVERSE
MOV L,B ;ROLES
MOV B,A ;OF L AND B
;
SUBZ: CALL DSUB ;SUBTRACT SMALLER FROM BIGGER
CALL MANT ;SET UP SIGN OF RESULT
CALL TSTR ;SEE IF WE NEED TO INTERCHANGE
;BPTR AND LPTR
JZ NORM ;NO INTERCHANGE NECESSARY, SO NORMALIZE
;AND RETURN
MOV A,L ;INTERCHANGE
MOV L,B ;L
MOV B,A ;AND B
MOV A,C ;CPTR TO A
MOV C,B ;BPTR TO C
MOV E,L ;LPTR TO E
MOV B,A ;CPTR TO B
CALL LXFR ;MOVE_BPTR> TO _LPTR>
MOV A,B
MOV B,C
MOV C,A
MOV L,E
JMP NORM ;NORMALIZE RESULT AND RETURN
;
; COPY THE LARGER CHARACTERISTIC TO THE RESULT
;
ADDZ: CALL CCMP ;COMPARE THE CHARACTERISTICS
JNC ADD2 ;IF CHAR(H,L) .GE. CHAR(H,B) CONTINUE
CALL BCTL ;IF CHAR(H,L) .LT. CHAR(H,B) THE COPY
;CHAR(H,B) TO CHAR(H,L)
ADD2: CALL MANT ;COMPUTE SIGN OF RESULT
CALL DADD ;ADD MANTISSAS
JNC SCCFG ;IF THERE IS NO OVFLW - DONE
CALL DRST ;IF OVERFLOW SHIFT RIGHT
CALL INCR ;AND INCREMENT CHARACTERISTIC
RET ;ALL DONE, SO RETURN
;
; THIS ROUTINE STORES THE MANTISSA SIGN IN THE RESULT
; THE SIGN HAS PREVIOUSLY BEEN COMPUTED BY LASD.
;
MANT: MOV E,L ;SAVE L PTR
MOV L,C ;C PTR TO L
MOV A,M ;LOAD INDEX WORD
ANI 128 ;SCARF SIGN
MOV L,E ;RESTORE L PTR
INR L ;L PTR\2
INR L
INR L ;TO L
MOV E,A ;SAVE SIGN IN E
MOV A,M
ANI 127 ;SCARF CHAR
ADD E ;ADD SIGN
MOV M,A ;STORE IT
DCR L ;RESTORE
DCR L
DCR L ;L PTR
RET
;
;
; SUBROUTINE LASD
; UTILITY ROUTINE FOR LADS
; CALCULATES TRUE OPER AND SGN
; RETURNS ANSWER IN
LASD: CALL MSFH ;FETCH MANT SIGNS, F IN A,D
CMP E ;COMPARE SIGNS
JC ABCH ;F\,S- MEANS GO TO A BRANCH
JNZ BBCH ;F- S\ MEANS GO TO B BRANCH
ADD E ;SAME SIGN IF HERE, ADD SIGNS
JC BMIN ;IF BOTH MINUS, WILL OVERFLOW
CALL AORS ;BOTH POS IF HERE
JP L000 ;IF AN ADD, LOAD 0
COM1: CALL DCMP ;COMPARE F WITH S
JC L131 ;S.GT.F,SO LOAD 131
JNZ L001 ;F.GT.S,SO LOAD 1
L002: MVI A,2 ;ERROR CONDITION, ZERO ANSWER
RET
BMIN: CALL AORS ;CHECK FOR ADD OR SUB
JP L128 ;ADD, SO LOAD 128
COM2: CALL DCMP ;COMPARE F WITH S
JC L003 ;S.GT.F,SO LOAD 3
JNZ L129 ;FGT.S.SO LOAD 129
JMP L002 ;ERROR
ABCH: CALL AORS ;FT,S- SO TEST FOR A/S
JM L000 ;SUBTRACT, SO LOAD 0
JMP COM1 ;ADD, SO GO TO DCMP
BBCH: CALL AORS ;F-,S\,SO TEST FOR A/S
JM L128 ;SUB
JMP COM2 ;ADD
L000: XRA A
RET
L001: MVI A,1
RET
L003: MVI A,3
RET
L128: MVI A,128
RET
L129: MVI A,129
RET
L131: MVI A,131
RET
;
; SUBROUTINE LMCM
; COMPARES THE MAGNITUDE OF
; TWO FLOATING PNT NUMBERS
; Z[1 IF [,C[1 IF F.LT.S.
LMCM: CALL CCMP ;CHECK CHARS
RNZ ;RETURN IF NOT EQUAL
CALL DCMP ;IF EQUAL, CHECK MANTS
RET
;
;
;
;***************************************************
; //// MULTIPLY SUBROUTINE
;***************************************************
;
; SUBROUTINE LMUL
; FLOATING POINT MULTIPLY
; L PTR X B PTR TO C PTR
;
LMUL: CALL CSIGN ;COMPUTE SIGN OF RESULT AND STORE IT
CALL ZCHK ;CHECK FIRST OPERAND FOR ZERO
JZ WZERC ;ZERO * ANYTHING = ZERO
CALL BCHK ;CHECK SECOND OPERAND FOR ZERO
JZ WZERC ;ANYTHING * ZERO = ZERO
MOV E,L ;SAVE L PTR
MOV L,C ;C PTR TO L
CALL DCLR ;CLR PRODUCT MANT LOCS
MOV L,E ;L PTR TO L
MVI D,24 ;LOAD NUMBER ITERATIONS
KPGO: CALL DRST ;SHIFT L PTR RIGHT
JC MADD ;WILL ADD B PTR IF C[1
MOV A,L ;INTERCHANGE
MOV L,C ;L AND
MOV C,A ;C PTRS
INTR: CALL DRST ;SHIFT PRODUCT OVER
MOV A,L ;INTERCHANGE
MOV L,C ;L AND C PTRS_BACK TO
MOV C,A ;ORIGINAL>
DCR D
JNZ KPGO ;MORE CYCLES IF Z[0
CALL AORS ;TEST IF RESULT IS NORMALIZED
JM LMCP ;IF NORMALIZED GO COMPUTE CHAR
MOV E,L ;SAVE LPTR IN E
MOV L,C ;SET L=CPTR
CALL DLST ;LEFT SHIFT RESULT TO NORMALIZE
MOV L,E ;RESTORE LPTR
CALL CFCHE ;OTHERWISE SET A=CHAR(H,L), E=CHAR(H,B)
ADD E ;CHAR(RESULT) = CHAR(H,L) + CHAR(H,B)
CPI 200Q ;CHECK FOR SMALLEST NEGATIVE NUMBER
JZ UFLWC ;IF SO THEN UNDERFLOW
SUI 1 ;SUBTRACT 1 TO COMPENSATE FOR NORMALIZE
CALL CCHK ;CHECK CHARACTERISTIC AND STORE IT
RET ;RETURN
;
MADD: MOV A,L ;INTERCHANGE
MOV L,C ;L AND
MOV C,A ;C PTRS
CALL DADD ;ACCUMULATE PRODUCT
JMP INTR
;
; SUBROUTINE NORM
;
; THIS SUBROUTINE WILL NORMALIZE A FLOATING POINT
; NUMBER, PRESERVING ITS ORIGINAL SIGN.
; WE CHECK FOR UNDERFLOW AND SET THE CONDITION
; FLAG APPROPRIATELY. (SEE ERROR RETURNS).
; THER IS AN ENTRY POINT TO FLOAT A SIGNED INTEGER
; (FLOAT) AND AN ENTRY POINT TO FLOAT AN UNSIGNED
; INTEGER.
;
; ENTRY POINTS:
;
; NORM - NORMALIZE FLOATING PT NUMBER AT (H,L)
; FLOAT - FLOAT TRIPLE PRECISION INTEGER AT (H,L)
; PRESERVING SIGN BIT IN (H,L)+3
; DFXL - FLOAT UNSIGNED (POSITIVE) TRIPLE PRECISION
; AT (H,L)
;
;REGISTERS ON EXIT:
;
; A = CONDITION FLAG (SEE ERROR RETURNS)
; D,E = GARBAGE
; B,C,H,L = SAME AS ON ENTRY
;
NORM: MOV E,L ;SAVE L IN E
NORM1: CALL GCHAR ;GET CHAR(H,L) IN A WITH SIGN EXTENDED
MOV D,A ;SAVE CHAR IN D
FXL1: MOV L,E ;RESTORE L
FXL2: CALL ZMCHK ;CHECK FOR ZERO MANTISSA
JZ WZER ;IF ZERO MANTISSA THEN ZERO RESULT
REP6: MOV A,M ;GET MOST SIGNIFICANT BYTE OF
;MANTISSA
ORA A ;SET FLAGS
JM SCHAR ;IF MOST SIGNFICANT BIT = 1 THEN
;NUMBER IS NORMALIZED AND WE GO TO
;STORE THE CHARACTERISTIC
MOV A,D ;OTHERWISE CHECK FOR UNDERFLOW
CPI MINCH ;COMPARE WITH MINIMUM CHAR
JZ WUND ;IF EQUAL THEN UNDERFLOW
CALL DLST ;SHIFT MANTISSA LEFT
DCR D ;DECREMENT CHARACTERSTIC
JMP REP6 ;LOOP AN TEST NEXT BIT
SCHAR: JMP INCR3 ;STORE THE CHARACTERISTIC USING
;THE SAME CODE AS THE INCREMENT
;
DFXL: MOV E,L ;ENTER HERE TO FLOAT UNSIGNED
;INTEGER
;FIRT SAVE L IN E
INR L ;MAKE (H,L) POINT TO CHAR
INR L ;MAKE (H,L) POINT TO CHAR
INR L ;MAKE (H,L) POINT TO CHAR
XRA A ;ZERO ACCUMULATOR
MOV M,A ;STORE A PLUS (+) SIGN
MOV L,E ;RESTORE L
FLOAT: MVI D,24 ;ENTER HERE TO FLOAT INTEGER
;PRESERVING ORIGINAL SIGN IN (H,L)+3
;SET UP CHARACTERISTIC
JMP FXL2 ;GO FLOAT THE NUMBER
;
;
;
;
; SUBROUTINE ZCHK
;
; THIS ROUTINE SETS THE ZERO FLAG IF IT DETECTS
; A FLOATING ZERO AT (H,L).
;
; SUBROUTINE ZMCHK
;
; THIS ROUTINE SETS THE ZERO FLAG IF IT DETECTS A
; ZERO MANTISSA AT (H,L)
;
ZCHK:
ZMCHK: INR L ;SET L TO POINT LAST BYTE OF MANTISSA
INR L ;SET L TO POINT TO LAST BYTE OF MANTISSA
MOV A,M ;LOAD LEAST SIGNIFICANT BYTE
DCR L ;L POINTS TO MIDDLE BYTE
ORA M ;OR WITH LEAST SIGNFICANT BYTE
DCR L ;L POINTS TO MOST SIGNFICANT BYTE
;OF MANTISSA (ORIGINAL VALUE)
ORA M ;OR IN MOST SIGNFICANT BYTE
RET ;RETURNS WITH ZERO FLAG SET APPROPRIATELY
;
; SUBROUTINE BCHK
;
; THIS ROUTINE CHECKS (H,B) FOR FLOATING PT ZERO
;
BCHK: MOV E,L ;SAVE LPTR IN E
MOV L,B ;SET L=BPTR
CALL ZCHK ;CHECK FOR ZERO
MOV L,E ;RESTORE L=LPTR
RET ;RETURN
;
;
; SUBROUTINE DLST
; SHIFTS DBL WORD ONE PLACE LF
DLST: INR L
INR L ;/***TP
MOV A,M ;LOAD IT
ORA A ;KILL CARRY
RAL ;SHIFT IT LEFT
MOV M,A ;STORE IT
DCR L
MOV A,M ;LOAD IT
RAL ;SHIFT IT LEFT
; IF CARRY SET BY FIRST SHIFT
; IT WILL BE IN LSB OF SECOND
MOV M,A
DCR L ;/***TP EXTENSION
MOV A,M
RAL
MOV M,A ;/***ALL DONE TP
RET
; SUBROUTINE DRST
; SHIFTS DOUBLE WORD ONE PLACE
; TO THE RIGHT
; DOES NOT AFFECT D
DRST: MOV E,L ;/***TP MODIFIED RIGHT SHIFT TP
MOV A,M ;LOAD FIRST WORD
RAR ;ROTATE IT RIGHT
MOV M,A ;STORE IT
INR L ;/*** TP
MOV A,M ;LOAD SECOND WORD
RAR ;SHIFT IT RIGHT
MOV M,A ;STORE IT
INR L ;/*** TP EXTENSION
MOV A,M
RAR
MOV M,A
MOV L,E ;/***TP - ALL DONE TP
RET
; SUBROUTINE DADD
; ADDS TWO DOUBLE PRECISION
; WORDS, C[1 IF THERE IS OVRFLW
DADD: MOV E,L ;SAVE BASE IN E
MOV L,B ;BASE \3 TO L
INR L ;BASE \4 TO L
INR L ;/***TP
MOV A,M ;LOAD S MANTB
MOV L,E ;BASE TO L
INR L ;BASE \1 TO L
INR L ;/***TP
ADD M ;ADD TWO MANTB]S
MOV M,A ;STORE ANSWER
MOV L,B ;/***TP EXTENSION
INR L
MOV A,M
MOV L,E
INR L
ADC M
MOV M,A ;/***TP - ALL DONE
MOV L,B ;BASE \3 TO L
MOV A,M ;MANTA OF S TO A
MOV L,E ;BASE TO L
ADC M ;ADD WITH CARRY
MOV M,A ;STORE ANSWER
RET
; SUBROUTINE DCLR
; CLEARS TWO SUCCESSIVE
; LOCATIONS OF MEMORY
DCLR: XRA A
MOV M,A
INR L
MOV M,A
INR L ;/***TP EXTENSION
MOV M,A ;/***TP ZERO 3
DCR L ;/***TP - ALL DONE
DCR L
RET
; /*****ALL NEW DSUB - SHORTER***
; SUBROUTINE DSUB
; DOUBLE PRECISION SUBTRACT
DSUB: MOV E,L ;SAVE BASE IN E
INR L ;/***TP EXTENSION
INR L ;/START WITH LOWS
MOV A,M ;/GET ARG
MOV L,B ;/NOW SET UP TO SUB
INR L
INR L
SUB M ;/NOW DO IT
MOV L,E ;/NOW MUST PUT IT BACK
INR L
INR L
MOV M,A ;/PUT BACK
DCR L ;/***TP - ALL DONE
MOV A,M ;/GET LOW OF LOP
MOV L,B ;/SET TO BOP
INR L ;/SET TO BOP LOW
SBB M ;/GET DIFF. OF LOWS
MOV L,E ;/SAVE IN LOP LOW
INR L ;/TO LOP LOW
MOV M,A ;/INTO RAM
DCR L ;/BACK UP TO LOP HIGH
MOV A,M ;/GET LOP HIGH
MOV L,B ;/SET TO BOP HIGH
SBB M ;/SUB. WITH CARRY
MOV L,E ;/SAVE IN LOP HIGH
MOV M,A ;/INTO RAM
RET ;/ALL DONE - MUCH SHORTER
;
; SUBROUTINE GCHAR
;
; THIS SUBROUTINE RETURNS THE CHARACTERISTIC OF
; THE FLOATING POINT NUMBER POINTED TO BY (H,L)
; IN THE A REGISTER WITH ITS SIGN EXTENDED INTO THE
; LEFTMOST BIT.
;
; REGISTERS ON EXIT:
;
; A = CHARACTERISTIC OF (H,L) WITH SIGN EXTENDED
; L = (ORIGINAL L) + 3
; B,C,D,E,H = SAME AS ON ENTRY
;
GCHAR: INR L ;MAKE (H,L) POINT TO CHAR
INR L ;MAKE (H,L) POINT TO CHAR
INR L ;MAKE (H,L) POINT TO CHAR
MOV A,M ;SET A=CHAR + MANTISSA SIGN
ANI 177Q ;GET RID OF MANTISSA SIGN BIT
ADI 100Q ;PROPAGATE CHAR SIGN INTO LEFTMOST BIT
XRI 100Q ;RESTORE ORIGINAL CHAR SIGN BIT
RET ;RETURN WITH (H,L) POINTING TO THE
;CHAR = ORIGINAL (H,L)+3
;SOMEONE ELSE WILL CLEAN UP
;
;
; SUBROUTINE CFCHE
;
; THIS SUBROUTINE RETURNS THE CHARACTERISTICS OF THE
; FLOATING POINT NUMBERS POINTED TO BY (H,L) AND
; (H,B) IN THE A AND E REGISTERS RESPECTIVELY,
; WITH THEIR SIGNS EXTENDED INTO THE LEFTMOST BIT.
;
; REGISTERS ON EXIT:
;
; A = CHARACTERISTIC OF (H,L) WITH SIGN EXTENDED
; E = CHARACTERISTIC OF (H,B) WITH SIGN EXTENDED
; B,C,H,L = SAME AS ON ENTRY
; D = A
;
CFCHE: MOV E,L ;SAVE LPTR IN E
MOV L,B ;SET L = BPTR
CALL GCHAR ;GET CHAR(H,B) WITH SIGN EXTENDED IN A
MOV L,E ;RESTORE L = LPTR
MOV E,A ;SET E=CHAR(H,B) WITH SIGN EXTENDED
CALL GCHAR ;SET A=CHAR(H,L) WITH SIGN EXTENDED
DCR L ;RESTORE L = LPTR
DCR L ;RESTORE L = LPTR
DCR L ;RESTORE L = LPTR
MOV D,A ;SET D=A=CHAR(H,L) WITH SIGN EXTENDED
RET
;
;
; SUBROUTINE CCMP
;
; THIS SUBROUTINE COMPARES THE CHARACTERISTICS OF
; FLOATING POINT NUMBERS POINTED TO BY (H,L) AND (H,B).
; THE ZERO FLIP-FLOP IS SET IF CHAR(H,L) EQUALS
; CHAR(H,B). IF CHAR(H,L) IS LESS THAN CHAR(H,B) THEN
; THE CARRY BIT WILL BE SET.
;
; REGISTERS ON EXIT:
;
; A = CHARACTERISTIC OF (H,L) WITH SIGN EXTENDED
; E = CHARACTERISTIC OF (H,B) WITH SIGN EXTENDED
; D = A
; B,C,H,L = SAME AS ON ENTRY
;
CCMP: CALL CFCHE ;FETCH CHARACTERTISTICS WITH SIGN EXTENDED
;INTO A (CHAR(H,L)) AND E (CHAR(H,B)) REGISTERS
MOV D,A ;SAVE CHAR (H,L)
SUB E ;SUBTRACT E (CHAR(H,B))
RAL ;ROTATE SIGN BIT INTO CARRY BIT
MOV A,D ;RESTORE A=CHAR(H,L)
RET ;RETURN
;
; ERROR RETURNS
;
; THE FOLLOWING CODE IS USED TO RETURN VARIOUS
; ERROR CONDITIONS. IN EACH CASE A FLOATING POINT
; NUMBER IS STORED IN THE 4 WORDS POINTED TO BY (H,L)
; AND A FLAG IS STORED IN THE ACCUMULATOR.
;
; CONDITION FLAG RESULT (+) RESULT (-)
;
; UNDERFLOW 377 000 000 000 100 000 000 000 300
; OVERFLOW 177 377 377 377 077 377 377 377 277
; INDEFINITE 077 377 377 377 077 377 377 377 277
; NORMAL 000 XXX XXX XXX XXX XXX XXX XXX XXX
; NORMAL ZERO 000 000 000 000 100 (ALWAYS RETURNS +0)
;
; ENTRY POINTS:
;
; WUND - WRITE UNDERFLOW
; WOVR - WRITE OVERFLOW
; WIND - WRITE INDEFINITE
; WZER - WRITE NORMAL ZERO
;
;###S
;WFLT MACRO VMANT,VCHAR,VFLAG,LABEL ;WRITE FLOATING NUMBER
;
; MVI D,VCHAR ;LOAD CHARACTERISTIC INTO D REGISTER
; CALL WCHAR ;WRITE CHARACTERISTIC
;LABEL:: MVI A,VMANT ;LOAD MANTISSA VALUE
; ;WE ASSUME HERE THAT ALL BYTES OF MANTISSA
; ;ARE THE SAME
; CALL WMANT ;WRITE THE MANTISSA
; MVI A,VFLAG ;SET ACCUMULATOR TO FLAG
; ORA A ;SET FLAGS PROPERLY
; RET ;RETURN (WMANT RESTORED (H,L))
; ENDM
;
;WUND: WFLT 0,100Q,377Q,UFLW1 ;WRITE UNDERFLOW
WUND: MVI D,100Q ;LOAD CHARACTERISTIC INTO D REGISTER
CALL WCHAR ;WRITE CHARACTERISTIC
UFLW1: MVI A,0 ;LOAD MANTISSA VALUE
;WE ASSUME HERE THAT ALL BYTES OF MANTISSA
;ARE THE SAME
CALL WMANT ;WRITE THE MANTISSA
MVI A,377Q ;SET ACCUMULATOR TO FLAG
ORA A ;SET FLAGS PROPERLY
RET ;RETURN (WMANT RESTORED (H,L))
;WOVR: WFLT 377Q,77Q,177Q,OFLW1 ;WRITE OVERFLOW
WOVR: MVI D,77Q ;LOAD CHARACTERISTIC INTO D REGISTER
CALL WCHAR ;WRITE CHARACTERISTIC
OFLW1: MVI A,377Q ;LOAD MANTISSA VALUE
;WE ASSUME HERE THAT ALL BYTES OF MANTISSA
;ARE THE SAME
CALL WMANT ;WRITE THE MANTISSA
MVI A,177Q ;SET ACCUMULATOR TO FLAG
ORA A ;SET FLAGS PROPERLY
RET ;RETURN (WMANT RESTORED (H,L))
;WIND: WFLT 377Q,77Q,77Q,INDF1 ;WRITE INDEFINITE
WIND: MVI D,77Q ;LOAD CHARACTERISTIC INTO D REGISTER
CALL WCHAR ;WRITE CHARACTERISTIC
INDF1: MVI A,377Q ;LOAD MANTISSA VALUE
;WE ASSUME HERE THAT ALL BYTES OF MANTISSA
;ARE THE SAME
CALL WMANT ;WRITE THE MANTISSA
MVI A,77Q ;SET ACCUMULATOR TO FLAG
ORA A ;SET FLAGS PROPERLY
RET ;RETURN (WMANT RESTORED (H,L))
;###E
;
WZER: INR L ;WRITE NORMAL ZERO
INR L ;
INR L ;
MVI M,100Q ;STORE CHARACTERISTIC FOR ZERO
XRA A ;ZERO ACCUMULATOR
CALL WMANT ;STORE ZERO MANTISSA
ORA A ;SET FLAGS PROPERLY
RET ;RETURN
;
; ROUTINE TO WRITE MANTISSA FOR ERROR RETURNS
;
WMANT: DCR L ;POINT LEAST SIGNIFICANT BYTE
;OF MANTISSA
MOV M,A ;STORE LSBYTE OF MANTISSA
DCR L ;POINT TO NEXT LEAST SIGNIFICANT BYTE
;OF MANTISSA
MOV M,A ;STORE NLSBYTE OF MANTISSA
DCR L ;POINT TO MOST SIGNIFICANT BYTE
;OF MANTISSA
MOV M,A ;STORE MSBYTE OF MANTISSA
RET ;RETURN (H,L) POINTS TO BEGINNING OF
;FLOATING POINT RESULT
;
; ROUTINE TO WRITE CHARACTERTIC FOR ERROR RETURNS
; NOTE: WE PRESERVE ORIGINAL MANTISSA SIGN
; ON ENTRY D CONTAINS NEW CHARACTERTISTIC TO BE STORED.
;
WCHAR: INR L ;SET (H,L) TO POINT TO CHARACTERISTIC
INR L ;PART OF ABOVE
INR L ;PART OF ABOVE
MOV A,M ;LOAD CHARACTERISTIC A
;AND MANTISSA SIGN
ANI 200Q ;JUST KEEP MANTISSA SIGN
ORA D ;OR IN NEW CHARACTERISTIC
MOV M,A ;STORE IT BACK
RET ;RETURN WITH (H,L) POINT TO CHARACTERISTIC
;OF RESULT
;SOMEONE ELSE WILL FIX UP (H,L)
;
; SUBROUTINE INDFC
;
; THIS ROUTINE WRITES A FLOATING INDEFINITE, SETS
; THIS WRITES WRITES A FLOATING POINT INDEFINITE
; AT (H,C), SETS THE CONDITION FLAG AND RETURNS
;
;
INDFC: MOV E,L ;SAVE LPTR IN E
MOV L,C ;SET L=CPTR SO (H,L)-ADDR OF RESULT
CALL WIND ;WRITE INDEFINITE
MOV L,E ;RESTORE L=LPTR
RET ;RETURN
;
;
; SUBROUTINE WZERC
;
; THIS ROUTINE WRITES A NORMAL FLAOTING POINT ZERO
; AT (H,C), SETS THE CONDITION FLAG AND RETURNS
;
WZERC: MOV E,L ;SAVE LPTR IN E
MOV L,C ;SETL=CPTR SO (H,L)=ADDR OF RESULT
CALL WZER ;WRITE NORMAL ZERO
MOV L,E ;RESTORE L=LPTR
RET ;RETURN
;
; SUBROUTINE INCR
;
; THIS SUBROUTINE INCREMENTS THE CHARACTERISTIC
; OF THE FLOATING POINT NUMBER POINTED TO BY (H,L).
; WE TEST FOR OVERFLOW AND SET APPROPRIATE FLAG.
; (SEE ERRROR RETURNS).
;
; REGISTERS ON EXIT:
;
; A = CONDITION FLAG (SEE ERROR RETURNS)
; D = CLOBBERED
; B,C,H,L = SAME AS ON ENTRY
;
INCR: CALL GCHAR ;GET CHAR WITH SIGN EXTENDED
CPI MAXCH ;COMPARE WITH MAX CHAR PERMITTED
JZ OFLW1 ;INCREMENT WOULD CAUSE OVERFLOW
MOV D,A ;/SAVE IT IN D
INR D ;/INCREMENT IT
JMP INCR2 ;JUMP AROUND ALTERNATE ENTRY POINT
INCR3: INR L ;COME HERE TO STORE CHARACTERISTIC
INR L ;POINT (H,L) TO CHAR
INR L ;POINT (H,L) TO CHAR
INCR2: MVI A,177Q
ANA D ;/KILL SIGN BIT
MOV D,A ;/BACK TO D
MOV A,M ;/NOW SIGN IT
ANI 200Q ;/GET MANTISSA SIGN
ORA D ;/PUT TOGETHER
MOV M,A ;/STORE IT BACK
DCR L ;/NOW BACK TO BASE
DCR L ;/***TP
DCR L
SCCFG: XRA A ;SET SUCCESS FLAG
RET
;
; SUBROUTINE DECR
;
; THIS SUBROUTINE DECREMENTS THE CHARACTERISTIC
; OF THE FLOATING POINT NUMBER POINTED TO BY (H,L).
; WE TEST FOR UNDERFLOW AND SET APPROPRIATE FLAG.
; (SEE ERRROR RETURNS).
;
; REGISTERS ON EXIT:
;
; A = CONDITION FLAG (SEE ERROR RETURNS)
; D = CLOBBERED
; B,C,H,L = SAME AS ON ENTRY
;
DECR: CALL GCHAR ;GET CHAR WITH SIGN EXTENDED
CPI MINCH ;COMPARE WITH MIN CHAR PERMITTED
JZ UFLW1 ;DECREMENT WOULD CAUSE UNDERFLOW
MOV D,A ;SAVE CHARACTERSTIC IN D
DCR D ;DECREMENT CHARACTERISTIC
JMP INCR2 ;GO STORE IT BACK
;
; SUBROUTINE AORS
; RETURN S[1 IF BASE \6
; HAS A 1 IN MSB
AORS: MOV E,L ;SAVE BASE
MOV L,C ;BASE \6 TO L
MOV A,M ;LOAD IT
ORA A ;SET FLAGS
MOV L,E ;RESTORE BASE
RET
; SUBROUTINE TSTR
; CHECKS C PTR TO SEE IF
; NLSB[1
; RETURNS Z[1 IF NOT
; DESTROYS E,D
TSTR: MOV E,L ;SAVE BASE
MOV L,C ;C PTR TO L
MVI D,2 ;MASK TO D
MOV A,M ;LOAD VALUE
MOV L,E ;RESTORE BASE
ANA D ;AND VALUE WITH MASK
RET
; SUBROUTINE ACPR
; STORES A IN LOCATION OF CPTR
; LPTR IN E
ACPR: MOV E,L ;SAVE LPTR
MOV L,C ;CPTR TO L
MOV M,A ;STORE A
MOV L,E ;RESTORE BASE
RET
; SUBROUTINE DCMP
; COMPARES TWO DOUBLE LENGTH
; WORDS
DCMP: MOV A,M ;NUM MANTA TO A
MOV E,L ;SAVE BASE IN E
MOV L,B ;BASE\3 TO L
CMP M ;COMPARE WITH DEN MANTA
MOV L,E ;RETURN BASE TO L
RNZ ;RETURN IF NOT THE SAME
INR L ;L TO NUM MANTB
MOV A,M ;LOAD IT
MOV L,B ;DEN MANTB ADD TO L
INR L ;BASE\ 4 TO L
CMP M
MOV L,E
RNZ ;/***TP EXTENSION
INR L ;/NOW CHECK BYTE 3
INR L
MOV A,M ;/GET FOR COMPARE
MOV L,B
INR L
INR L ;/BYTE 3 NOW
CMP M ;/COMPARE
MOV L,E ;/***TP - ALL DONE
RET
; SUBROUTINE DIVC
; PERFORMS ONE CYCLE OF DOUBLE
; PRECISION FLOATING PT DIVIDE
; ENTER AT ENT1 ON FIRST CYCLE
; ENTER AT ENT2 ALL THEREAFTER
ENT2: CALL DLST ;SHIFT MOVING DIVIDEND
JC OVER ;IF CARRY[1,NUM.GT.D
ENT1: CALL DCMP ;COMPARE NUM WITH DEN
JNC OVER ;IF CARRY NOT SET,NUM.GE.DEN
RET
OVER: CALL DSUB ;CALL DOUBLE SUBTRACT
MOV E,L ;SAVE BASE IN E
MOV L,C ;BASE \6 TO L
INR L ;BASE \7 TO L
INR L ;/***TP
MOV A,M
ADI 1 ;ADD 1
MOV M,A ;PUT IT BACK
MOV L,E ;RESTORE BASE TO L
RET
; SUBROUTINE LXFR
; MOVES CPTR TO EPTR
; MOVES 3 WORDS IF ENTER AT LXFR
LXFR: MVI D,4 ;/MOVE 4 WORDS
REP5: MOV L,C ;CPTR TO L
MOV A,M ;_CPTR> TO A
MOV L,E ;EPTR TO L
MOV M,A
INR C ;/INCREMENT C
INR E ;/INCREMENT E TO NEXT
DCR D ;/TEST FOR DONE
JNZ REP5 ;/GO FOR FOR TILL D=0
MOV A,E ;/NOW RESET C AND E
SUI 4 ;/RESET BACK BY 4
MOV E,A ;/PUT BACK IN E
MOV A,C ;/NOW RESET C
SUI 4 ;/BY 4
MOV C,A ;/BACK TO C
RET ;/DONE
;
; SUBROUTINE LDCP
;
; THIS SUBROUTINE COMPUTES THE CHARACTERISTIC
; FOR THE FLOATING DIVIDE ROUTINE
;
; REGISTERS ON EXIT:
;
; A = CONDITION FLAG (SEE ERROR RETURNS)
; D,E = GARBAGE
; B,C,H,L = SAME AS ON ENTRY
;
; REGISTERS ON ENTRY:
;
; (H,B) = ADDRESS OFF DIVISOR
; (H,C) = ADDRESS OF QUOTIENT
; (H,L) = ADDRESS OF DIVIDEND
;
LDCP: CALL CFCHE ;SET E=CHAR(H,B), A=CHAR(H,L)
SUB E ;SUBTRACT TO GET NEW CHARACTERISTIC
JMP CCHK ;GO CHECK FOR OVER/UNDERFLOW
;AND STORE CHARACTERTISTIC
;
;
; SUBROUTINE LMCP
;
; THIS SUBROUTINE COMPUTES THE CHARACTERISTIC
; FOR THE FLOATING MULTIPLY ROUTINE.
;
; REGISTERS ON EXIT:
;
; A = CONDITION FLAG (SEE ERROR RETURNS)
; D,E = GARBAGE
; B,C,H,L = SAME AS ON ENTRY
;
; REGISTERS ON ENTRY:
;
; (H,B) = ADDRESS OFF MULTIPLICAND
; (H,C) = ADDRESS OF PRODUCT
; (H,L) = ADDRESS OF MULTIPLIER
;
LMCP: CALL CFCHE ;SET E=CHAR(H,B), A=CHAR(H,L)
ADD E ;ADD TO GET NEW CHARACTERISTIC
;NOW FALL INTO THE ROUTINE
;WHICH CHECKS FOR OVER/UNDERFLOW
;AND STORE CHARACTERTISTIC
;
;
; SBUROUTINE CCHK
;
; THIS SUBROUTINE CHECKS A CHARACTERISTIC IN
; THE ACCUMULATOR FOR OVERFLOW OR UNDERFLOW.
; IT THEN STORES THE CHARACTERISTIC, PRESERVING
; THE PREVIOUSLY COMPUTED MANTISSA SIGN.
;
; REGISTERS ON ENTRY:
;
; (H,L) = ADDRESS OF ONE OPERAND
; (H,B) = ADDRESS OF OTHER OPERAND
; (H,C) = ADDRESS OF RESULT
; A = NEW CHARACTERISTIC OF RESULT
;
; REGISTERS ON EXIT:
;
; A = CONDITION FLAG (SEE ERROR RETURNS)
; D,E = GARBAGE
; B,C,H,L = SAME AS ON ENTRY
;
CCHK: ;ENTER HERE TO CHECK CHARACTERISTIC
CPI 100Q ;CHECK FOR 0 TO +63
JC STORC ;JUMP IF OKAY
CPI 200Q ;CHECK FOR +64 TO +127
JC OFLWC ;JUMP IF OVERFLOW
CPI 300Q ;CHECK FOR -128 TO -65
JC UFLWC ;JUMP IF UNDERFLOW
STORC: MOV E,L ;SAVE L IN E
MOV L,C ;LET L POINT TO RESULT
MOV D,A ;SAVE CHARACTERISTIC IN D
CALL INCR3 ;STORE CHARACTERISTIC
MOV L,E ;RESTORE L
RET ;RETURN
;
; SUBROUTINE OFLWC
;
; THIS ROUTINE WRITES A FLOATING POINT OVERFLOW AT (H,C)
; SETS THE CONDITION FLAG, AND RETURNS.
;
OFLWC: MOV E,L ;SAVE L IN E
MOV L,C ;SET L=CPTR, SO (H,L)=ADDR OF RESULT
CALL WOVR ;WRITE OUT OVERFLOW
MOV L,E ;RESTORE L
RET ;RETURN
;
; SUBROUTINE UFLWC
;
; THIS ROUTINE WRITES A FLOATING POINT UNDERFLOW AT (H,C)
; SETS THE CONDITION FLAG, AND RETURNS.
;
UFLWC: MOV E,L ;SAVE L IN E
MOV L,C ;SET L=CPTR, SO (H,L)=ADDR OF RESULT
CALL WUND ;WRITE OUT UNDEFLOW
MOV L,E ;RESTORE L
RET ;RETURN
;
;
; SUBROUTINE CSIGN
;
; THIS SUBROUTINE COMPUTES AND STORE THE MANTISSA
; SIGN FOR THE FLOATING MULTIPLY AND DIVIDE ROUTINES
;
; REGISTERS ON ENTRY:
;
; (H,L) = ADDRESS OF ONE OPERAND
; (H,B) = ADDRESS OF OTHER OPERAND
; (H,C) = ADDRESS OF RESULT
;
; REGISTERS ON EXIT:
;
; A,D,E = GARBAGE
; B,C,H,L = SAME AS ON ENTRY
;
;
CSIGN: CALL MSFH ;SET A=SIGN(H,L), E=SIGN(H,B)
XRA E ;EXCLUSIVE OR SIGNS TO GET NEW SIGN
CALL CSTR ;STORE SIGN INTO RESULT
RET ;RETURN
;
;
; SUBROUTINE CSTR
; STORES VALUE IN A IN
; CPTR\2
; PUTS LPTR IN E
CSTR: MOV E,L ;SAVE LPTR IN E
MOV L,C ;CPTR TO L
INR L ;CPTR\2
INR L ;TO L
INR L ;/***TP
MOV M,A ;STORE ANSWER
MOV L,E ;LPTR BACK TO L
RET
;
; SUBROUTINE MSFH
;
; THIS SUBROUTINE FETCHES THE SIGNS OF THE MANTISSAS
; OF THE FLOATING POINT NUMBERS POINTED TO BY (H,L)
; AND (H,B) INTO THE A AND E REGISTERS RESPECTIVELY.
;
; REGISTERS ON EXIT:
;
; A = SIGN OF MANTISSA OF (H,L)
; E = SIGN OF MANTISSA OF (H,B)
; B,C,D,H,L = SAME AS ON ENTRY
;
MSFH: MOV E,L ;SAVE LPTR
MOV L,B ;BPTR TO L
INR L ;BPTR\2
INR L ;/***TP
INR L ;TO L
MOV A,M ;_BPTR\2>TO A
ANI 128 ;SAVE MANT SIGN
MOV L,E ;LPTR BACK TO L
MOV E,A ;STORE BPTR MANT SIGN
INR L ;LPTR\2
INR L ;/***TP
INR L ;TO L
MOV A,M ;_LPTR\2>TO A
ANI 128 ;SAVE LPTR MANT SIGN
DCR L ;LPTR BACK
DCR L ;TO L
DCR L ;/***TP
RET
; SUBROUTINE BCTL
; MOVES BPTR CHAR TO LPTR CHAR
; DESTROYSE
BCTL: MOV E,L ;LPTR TO E
MOV L,B ;BPTR TO L
INR L ;BPTR \2
INR L ;/***TP
INR L ;TO L
MOV A,M ;BPTR CHAR TO A
MOV L,E ;LPTR TO L
INR L ;LPTR \2
INR L ;TO L
INR L ;/***TP
MOV M,A ;STORE BPTR CHAR IN LPTR CHAR
MOV L,E ;LPTR TO L
RET
;
;
;******************************************************
; //// 5 DIGIT FLOATING PT. OUTPUT
;******************************************************
;
;
;
;
; *******ROUTINE TO CONVERT FLOATING PT.
; ***NUMBERS TO ASCII AND OUTPUT THEM VIA A SUBROUTINE
; ***CALLED OUTR - NOTE: THIS IS CURRENTLY SET
; ***TO ODT'S OUTPUT ROUTINE
;
;
CVRT: CALL ZCHK ;CHECK FOR NEW ZERO
JNZ NNZRO ;NOT ZERO
INR C ;IT WAS, OFFSET C BY 2
INR C
MOV L,C
CALL WZER ;WRITE ZERO
INR L ;PNT TO DECIMAL EXPONENT
INR L
INR L
INR L
XRA A ;SET IT TO ZERO
MOV M,A
JMP MDSKP ;OUTPUT IT
NNZRO: MOV D,M ;/GET THE NUMBER TO CONVERT
INR L
MOV B,M
INR L
MOV E,M
INR L ;/4 WORD***TP
MOV A,M ;/***TP
INR C ;/OFFSET SCRATCH POINTER BY 2
INR C
MOV L,C ;/L NOT NEEDED ANY MORE
MOV M,D ;/SAVE NUMBER IN SCRATCH
INR L
MOV M,B
INR L
MOV M,E ;/***TP
INR L ;/***TP
MOV B,A ;/SAVE COPY OF CHAR & SIGN
ANI 177Q ;GET ONLY CHAR.
MOV M,A ;/SAVE ABS(NUMBER)
CPI 100Q ;CK FOR ZERO
JZ NZRO
SUI 1 ;/GET SIGN OF DEC. EXP
ANI 100Q ;/GET SIGN OF CHAR.
NZRO: RLC ;MOVE IT TO SIGN POSITION
INR L ;/MOVE TO DECIMAL EXP.
MOV M,A ;/SAVE SIGN OF EXP.
MOV A,B ;/GET MANT. SIGH BACK
CALL SIGN ;/OUTPUT SIGN
MVI L,(TEN5 AND 377Q) ;/TRY MULT. OR DIV. BY 100000 FIRST
CALL COPT ;/MAKE A COPY IN RAM
TST8: CALL GCHR ;/GET CHAR. OF NUMBER
MOV B,A ;/SAVE A COPY
ANI 100Q ;/GET ABSOLUTE VALUE OF CHAR
MOV A,B ;/INCASE PLUS
JZ GOTV ;/ALREADY PLUS
MVI A,200Q ;/MAKE MINUS INTO PLUS
SUB B ;/PLUS=200B-CHAR
GOTV: CPI 22Q ;/TEST FOR USE OF 100000
JM TRY1 ;/WONT GO
CALL MORD ;/WILL GO SO DO IT
ADI 5 ;/INCREMENT DEC. EXPONENT BY 5
MOV M,A ;/UPDATE MEM
JMP TST8 ;/GO TRY AGAIN
TRY1: MVI L,(TEN AND 377Q) ;/NOW USE JUST TEN
CALL COPT ;/PUT IT IN RAM
TST1: CALL GCHR ;/GET CHARACTERISTIC
CPI 1 ;/MUST GET IN RANGE 1 TO 6
JP OK1 ;/ATLEAST ITS 1 OR BIGGER
MDGN: CALL MORD ;/MUST MUL OF DIV BY 10
ADI 1 ;/INCREMENT DECIMAL EXP.
MOV M,A ;/UPDATE MEM
JMP TST1 ;/NOW TRY AGAIN
OK1: CPI 7 ;/TEST FOR LESS THAN 7
JP MDGN ;/NOPE - 7 OR GREATER
MDSKP: MOV L,C ;/SET UP DIGIT COUNT
DCR L
DCR L ;/IN 1ST WORD OF SCRATCH
MVI M,5 ;/5 DIGITS
MOV E,A ;/SAVE CHAR. AS LEFT SHIFT COUNT
CALL LSFT ;/SHIFT LEFT PROPER NUMBER
CPI 12Q ;/TEST FOR 2 DIGITS HERE
JP TWOD ;/JMP IF 2 DIGITS TO OUTPUT
CALL DIGO ;/OUTPUT FIRST DIGIT
POPD: CALL MULTT ;/MULTIPLY THE NUMBER BY 10
INPOP: CALL DIGO ;/PRINT DIGIT IN A
JNZ POPD ;/MORE DIGITS?
MVI A,305Q ;/NO SO PRINT E
CALL OUTR ;/BASIC CALL TO OUTPUT
CALL GETEX ;/GET DECIMAL EXP
MOV B,A ;/SAVE A COPY
CALL SIGN ;/OUTPUT SIGN
MOV A,B ;/GET EXP BACK
ANI 77Q ;/GET GOOD BITS
CALL CTWO ;/GO CONVERT 2 DIGITS
DIGO: ADI 260Q ;/MAKE A INTO ASCII
CALL OUTR ;/OUTPUT DIGIT
MOV L,C ;/GET DIGIT COUNT
DCR L ;/BACK UP TO DIGIT COUNT
DCR L
MOV A,M ;/TEST FOR DECIMAL PT
CPI 5 ;/PRINT . AFTER 1ST DIGIT
MVI A,256Q ;/JUST IN CASE
CZ OUTR ;/OUTPUT . IF 1ST DIGIT
MOV D,M ;/NOW DECREMENT DIGIT COUNT
DCR D
MOV M,D ;/UPDATE MEM AND LEAVE FLOPS SET
RET ;/SERVES AS TERM FOR DIGO & CVRT
MULTT: MVI E,1 ;/MULT. BY 10 (START WITH X2)
CALL LSFT ;/LEFT SHIFT 1 = X2
MOV L,C ;/SAVE X2 IN "RESULT"
DCR L ;/SET TO TOP OF NUMBER
MOV A,C ;/SET C TO RESULT
ADI 11Q
MOV C,A ;/NOW C SET RIGHT
MOV A,H ;/SHOW RAM TO RAM TRANSFER
CALL COPY ;/SAVE X2 FINALLY
MOV A,C ;/MUST RESET C
SUI 11Q ;/BACK TO NORMAL
MOV C,A
MVI E,2 ;/NOW GET (X2)X4=X8
MOV L,C ;/BUT MUST SAVE OVERFLOW
DCR L
CALL TLP2 ;/GET X8
MOV L,C ;/SET UP TO CALL DADD
MOV A,C ;/SET B TO X2
ADI 12Q ;/TO X2
MOV B,A
CALL DADD ;/ADD TWO LOW WORDS
DCR L ;/BACK UP TO OVERFLOW
MOV A,M ;/GET IT
MOV L,B ;/NOW SET TO X2 OVERFLOW
DCR L ;/ITS AT B-1
ADC M ;/ADD WITH CARRY - CARRY WAS PRESERVED
RET ;/ALL DONE, RETURN OVERFLOW IN A
LSFT: MOV L,C ;/SET PTR FOR LEFT SHIFT OF NUMBER
DCR L ;/BACK UP TO OVERFLOW
XRA A ;/OVERFLOW=0 1ST TIME
TLOOP: MOV M,A ;/SAVE OVERFLOW
TLP2: DCR E ;/TEST FOR DONE
RM ;/DONE WHEN E MINUS
INR L ;/MOVE TO LOW
INR L
INR L ;/***TP EXTENSION
MOV A,M ;/SHIFT LEFT 4 BYTES
RAL
MOV M,A ;/PUT BACK
DCR L ;/***TP - ALL DONE
MOV A,M ;/GET LOW
RAL ;/SHIFT LEFT 1
MOV M,A ;/RESTORE IT
DCR L ;/BACK UP TO HIGH
MOV A,M ;/GET HIGH
RAL ;/SHIFT IT LEFT WITH CARRY
MOV M,A ;/PUT IT BACK
DCR L ;/BACK UP TO OVERFLOW
MOV A,M ;/GET OVERFLOW
RAL ;/SHIFT IT LEFT
JMP TLOOP ;/GO FOR MORE
SIGN: ANI 200Q ;/GET SIGN BIT
MVI A,240Q ;/SPACE INSTEAD OF PLUS
JZ PLSV ;/TEST FOR +
MVI A,255Q ;/NEGATIVE
PLSV: CALL OUTR ;/OUTPUT SIGN
RET
GCHR: MOV L,C ;/GET CHARCTERISTIC
GETA: INR L ;/MOVE TO IT
INR L
INR L ;/***TP
MOV A,M ;/FETCH INTO A
RET ;/DONE
MORD: CALL GETEX ;/MUL OR DIV DEPENDING ON EXP
MOV E,A ;/SAVE DECIMAL EXP
MOV B,L ;/SET UP TO MULT OR DIV
INR B ;/NOW BOP POINTER SET
MOV L,C ;/L POINTS TO NUMBER TO CONVERT
MOV A,C ;/POINT C AT "RESULT" AREA
ADI 11Q ;/IN SCRATCH
MOV C,A ;/NOW C SET RIGHT
MOV A,E ;/NOW TEST FOR MUL
ANI 200Q ;/TEST NEGATIVE DEC. EXP.
JZ DIVIT ;/IF EXP IS + THEN DIVIDE
CALL LMUL ;/MULT.
FINUP: MOV A,C ;/SAVE LOC. OF RESULT
MOV C,L ;/C=LOC OF NUMBER (IT WAS DESTROYED)
MOV L,A ;/SET L TO LOC. OF RESUTL
MOV A,H ;/SHOW RAM TO RAM TRANSFER
CALL COPY ;/MOVE RESULT TO NUMBER
GETEX: MOV L,C ;/NOW GET DECIMAL EXP
INR L
JMP GETA ;/USE PART OF GCHR
DIVIT: CALL LDIV ;/DIVIDE
JMP FINUP
TWOD: CALL CTWO ;/CONVERT TO 2 DIGITS
MOV B,A ;/SAVE ONES DIGIT
CALL GETEX ;/GET DECIMAL EXP
MOV E,A ;/SAVE A COPY
ANI 200Q ;/TEST FOR NEGATIVE
JZ ADD1 ;/BUMP EXP BY 1 SINCE 2 DIGITS
DCR E ;/DECREMENT NEGATIVE EXP SINCE 2 DIGITS
FINIT: MOV M,E ;/RESTORE EXP WITH NEW VALUE
MOV A,B ;/NOW DO 2ND DIGIT
JMP INPOP ;/GO OUT 2ND AND REST FO DIGITS
ADD1: INR E ;/COMPENSATE FOR 2 DIGITS
JMP FINIT
CTWO: MVI E,377Q ;/CONVERT 2 DIGIT BIN TO BCD
LOOP: INR E ;/ADD UP TENS DIGIT
SUI 12Q ;/SUBTRACT 10
JP LOOP ;/TIIL NEGATIVE RESULT
ADI 12Q ;/RESTORE ONES DIGIT
MOV B,A ;/SAVE ONES DIGIT
MOV A,E ;/GET TENS DIGIT
CALL DIGO ;/OUTPUT IT
MOV A,B ;/SET A TO 2ND DIGIT
RET
COPT: MOV A,C ;/COPY FROM 10N TO RAM
ADI 5
MOV C,A ;/SET C TO PLACE TO PUT
MVI A,(TEN5/256)
CALL COPY ;/COPY IT
MOV A,C ;/NOW RESET C
SUI 5
MOV C,A ;/ITS RESET
RET
COPY: MOV B,H ;/SAVE RAM H
MOV H,A ;/SET TO SOURCE H
MOV A,M ;/GET 4 WORDS INTO THE REGS.
INR L
MOV D,M
INR L
MOV E,M
INR L
MOV L,M ;/LAST ONE ERASES L
MOV H,B ;/SET TO DESTINATION RAM
MOV B,L ;/SAVE 4TH WORD IN B
MOV L,C ;/SET TO DESTINATION
MOV M,A ;/SAVE FIRST WORD
INR L
MOV A,M ;/SAVE THIS WORD IN A (INPUT SAVES C HERE
MOV M,D ;/NOW PUT 2ND WORD
INR L
MOV M,E
INR L
MOV M,B ;/ALL 4 COPIED NOW
RET ;/ALL DONE
;
;
TEN5: DB 303Q,120Q,0Q,21Q ;/303240(8) = 100000.
TEN: DB 240Q,0Q,0Q,4Q ;/12(8) = 10
;
; SCRATCH MAP FOR I/O CONVERSION ROUTINES
;
; RELATIVE TO (C+2)USE
; C-2 DIGIT COUNT
; C-1 OVERFLOW
; C HIGH NUMBER - MANTISSA
; C+1 LOW NUMBER
; C+2 CHARACTERISTIC
; C+3 DECIMAL EXPONEXT (SIGN & MAG.)
; C+4 TEN**N
; C+5 TEN**N
; C+6 TEN**N
; C+7 RESULT OF MULT & DIV
; C+8 AND TEMP FOR X2
; C+9 " "
; C+10 L FOR NUMBER TO GO INTO (INPUT ONLY)
; C+11 DIGIT JUST INPUT (INPUT ONLY)
;
;
; /*****BEGIN INPUT*************
;
;
ERR: STC ;ERROR FLAG
RET ;AND RETURN
;
;********************************************************
; //// 4 1/2 DIGIT INPUT ROUTINE
;*******************************************************
;
;
; /L POINTS TO WHERE TO PUT INPUT NUMBER
; /C POINTS TO 13(10) WORDS OF SCRATCH
;
INPUT: MOV B,L ;/SAVE ADDRESS WHERE DATA IS TO GO
MOV A,C ;/IN SCRATCH
ADI 17Q ;/COMPUTE LOC. IN SCRATCH
MOV L,A
MOV M,B ;/PUT IT
INR C ;/OFFSET SCRATCH POINTER
INR C ;/BY 2
CALL ZROIT ;/ZERO NUMBER
INR L ;/AND ZERO
MOV M,A ;/DECIMAL EXPONENT
CALL GNUM ;/GET INTEGER PART OF NUM
CPI 376Q ;/TERM=.?
JZ DECPT ;/YES
TSTEX: CPI 25Q ;/TEST FOR E
JZ INEXP ;/YES - HANDLE EXP
CPI 360Q ;/TEST FOR SPACE TERM (240B-260B)
JNZ ERR ;/NOT LEGAL TERM
CALL FLTSGN ;/FLOAT # AND SIGN IT
SCALE: CALL GETEX ;/GET DECIMAL EXP
ANI 177Q ;/GET GOOD BITS
MOV E,A ;/SAVE COPY
ANI 100Q ;/GET SIGN OF EXP
RLC ;/INTO SIGN BIT
ORA A ;/SET FLOPS
MOV B,A ;/SAVE SIGN
MOV A,E ;/GET EXP BACK
JZ APLS ;/JMP IS +
MVI A,200Q ;/MAKE MINUS +
SUB E ;/NOW ITS +
APLS: ADD B ;/SIGN NUMBER
MOV M,A ;/SAVE EXP (SIGN & MAG.)
MVI L,(TEN5 AND 377Q) ;/TRY MORD WITH 10**5 FIRST
CALL COPT ;/TRANSFER TO RAM
CALL GETEX ;/GET DECIMAL EXP
INT5: ANI 77Q ;/GET MAG. OF EXP
CPI 5Q ;/TEST FOR USE OF 10**5
JM TRYTN ;/WONT GO - TRY 10
CALL MORD ;/WILL GO SO DO IT
SUI 5Q ;/MAG = MAG -5
MOV M,A ;/UPDATE DEC. EXP IN MEM
JMP INT5 ;/GO TRY AGAIN
TRYTN: MVI L,(TEN AND 377Q) ;/PUT TEN IN RAM
CALL COPT
CALL GETEX ;/SET UP FOR LOOP
INT1: ANI 77Q ;/GET MAGNITUDE
ORA A ;/TEST FOR 0
JZ SAVEN ;/DONE, MOVE NUM OUT AND GET OUT
CALL MORD ;/NOT DONE - DO 10
SUI 1Q ;/EXP = EXP -1
MOV M,A ;/UPDATE MEM
JMP INT1 ;/TRY AGAIN
DECPT: MOV L,C ;/ZERO DIGIT COUNT
DCR L ;/SINCE ITS NECESSARY
DCR L ;/TO COMPUTE EXP.
MVI M,0 ;/ZEROED
CALL EP1 ;/GNUM IN MIDDLE
MOV E,A ;/SAVE TERMINATOR
MOV L,C ;/MOVE DIGIT COUNT TO EXP
DCR L ;/BACK UP TO DIGIT COUNT
DCR L
MOV B,M ;/GOT DIGIT COUNT
CALL GETEX ;/SET L TO DEC. EXP
MOV M,B ;/PUT EXP
MOV A,E ;/TERM BACK TO A
JMP TSTEX ;/TEST FOR E+OR-XX
INEXP: CALL FLTSGN ;/FLOAT AND SIGN NUMBER
CALL SAVEN ;/SAVE NUMBER IN (L) TEMP
CALL ZROIT ;/ZERO OUT NUM. FOR INPUTTING EXP
CALL GNUM ;/NOW INPUT EXPONENT
CPI 360Q ;/TEST FOR SPACE TERM.
JNZ ERR ;/NOT LEGAL - TRY AGAIN
MOV L,C ;/GET EXP OUT OF MEM
INR L ;/***TP
INR L ;/EXP LIMITED TO 5 BITS
MOV A,M ;/GET LOWEST 8 BITS
ANI 37Q ;/GET GOOD BITS
MOV B,A ;/SAVE THEM
INR L ;/GET SIGN OF EXP
MOV A,M ;/INTO A
ORA A ;/SET FLOPS
MOV A,B ;/INCASE NOTHING TO DO
JM USEIT ;/IF NEG. USE AS +
MVI A,0Q ;/IF + MAKE -
SUB B ;/0-X = -X
USEIT: INR L ;/POINT AT EXP
ADD M ;/GET REAL DEC. EXP
MOV M,A ;/PUT IN MEM
MOV A,C ;/NOW GET NUMBER BACK
ADI 15Q ;/GET ADD OF L
MOV L,A ;/L POINTS TO L OF NUMBER
MOV L,M ;/NOW L POINTS TO NUMBER
MOV A,H ;/RAM TO RAM COPY
CALL COPY ;/COPY IT BACK
JMP SCALE ;/NOW ADJUST FOR EXP
GNUM: CALL INP ;/GET A CHAR
CPI 240Q ;/IGNORE LEADING SPACES
JZ GNUM
CPI 255Q ;/TEST FOR -
JNZ TRYP ;/NOT MINUS
MOV L,C ;/MINUS SO SET SIGN
INR L ;/IN CHAR LOC.
INR L ;/***TP
INR L
MVI M,200Q ;/SET - SIGN
JMP GNUM
TRYP: CPI 253Q ;/IGNORE +
JZ GNUM
TSTN: SUI 260Q ;/STRIP ASCII
RM ;/RETURN IF TERM
CPI 12Q ;/TEST FOR NUMBER
RP ;/ILLEGAL
MOV E,A ;/SAVE DIGIT
CALL GETN ;/LOC. OF DIGIT STORAGE TO L
MOV M,E ;/SAVE DIGIT
CALL MULTT ;/MULT NUMBER BY 10
ORA A ;/TEST FOR TOO MANY DIGITS
RNZ ;/TOO MANY DIGITS
CALL GETN ;/GET DIGIT
MOV L,C ;/SET L TO NUMBER
INR L
INR L ;/***TP
ADD M ;/ADD IN THE DIGIT
MOV M,A ;/PUT RESULT BACK
DCR L ;/NOW DO HIGH
MOV A,M ;/GET HIGH TO ADD IN CARRY
ACI 0Q ;/ADD IN CARRY
MOV M,A ;/UPDATE HIGH
DCR L ;/***TP EXTENSION
MOV A,M
ACI 0Q ;/ADD IN CARRY
MOV M,A ;/***TP ALL DONE
RC ;/OVERFLOW ERROR
DCR L ;/BUMP DIGIT COUNT NOW
DCR L
MOV B,M ;/GET DIGIT COUNT
INR B ;/BUMP DIGIT COUNT
MOV M,B ;/UPDATE DIGIT COUNT
EP1: CALL INP ;/GET NEXT CHAR
JMP TSTN ;/MUST BE NUM. OR TERM
FLTSGN: MOV L,C ;POINT L AT NUMBER TO FLOAT
JMP FLOAT ;GO FLOAT IT
SAVEN: MOV A,C ;/PUT NUMBER IN (L)
ADI 15Q ;/GET ADD OF L
MOV L,A
MOV E,M ;/GET L OF RESULT
MOV L,E ;/POINT L AT (L)
INR L ;/SET TO 2ND WORD TO SAVE C
MOV M,C ;/SAVE C IN (L) +1 SINCE IT WILL BE DESTROYED
MOV L,C ;/SET UP TO CALL COPY
MOV C,E ;/NOW L&C SET
MOV A,H ;/RAM TO RAM COPY
CALL COPY ;/COPY TO L
MOV C,A ;/(L)+1 RETURNED HERE SO SET AS C
ORA A ;MAKE SURE CY=0 (NO ERROR)
RET ;/NOW EVERYTHING HUNKY-DORRY
GETN: MOV A,C ;/GET DIGIT
ADI 16Q ;/LAST LOC. IN SCRATCH
MOV L,A ;/PUT IN L
MOV A,M ;/GET DIGIT
RET
ZROIT: MOV L,C ;/ZERO NUMBER
XRA A
MOV M,A ;/***TP
INR L ;/***TP
MOV M,A
INR L
MOV M,A
INR L ;/NOW SET SIGN TO +
MOV M,A
RET ;/DONE
; CONTAIN LOW BYTE OF TWO BYTE VALUE. RETURNS CY=1 IF
; BC>DE, CY=0 IF BC<DE: Z=1 IF BC=DE.
DCOMP: MOV A,E
CMP C
RNZ
MOV A,D
CMP B
RET
; ROUTINE TO INPUT CHAR FROM TTY
CHAR2: PUSH B
CALL CONIN ;INPUT FROM ODT
MOV A,B ;GET CHAR TO A REG.
POP B ;RESTORE B,C
RET
; ROUTINE TO ADJUST VALUES OF BIN, FORWARD PNT. AND
; LINE LENGTH OF SOURCE LINE. PASSED ADD OF TEMP VARIABLE
; CONTAINING ADD OF SOURCE LINE.
PTVAL: PUSH PSW
PUSH D
PUSH H
MVI A,002
MOV E,M
INR L
MOV D,M
INR L
PUSH D
N1: XTHL
MOV E,M
INX H
MOV D,M
INX H
XTHL
MOV M,E
INR L
MOV M,D
INR L
DCR A
JNZ N1
XTHL
MOV D,M
POP H
MOV M,D
POP H
POP D
POP PSW
RET
; ROUTINE TO CHK FLAGS ON INPUT AND OUTPUT.
; PASSED FLAG VALUE IN REG B.
MCHK: PUSH PSW
MCHK1: CALL STATUS
ANA B
JZ MCHK1
POP PSW
RET
; MULTIPLICATION ROUTINE (ADD. VALUES)
MULT: MOV E,M
DCX H
MOV D,M
MVI M,11H
MVI B,0
MOV C,B
TOP: MOV A,E
RAR
MOV E,A
MOV A,D
RAR
DCR M
MOV D,A
RZ
JNC SHIFT
DCX H
DCX H
MOV A,B
ADD M
MOV B,A
INX H
MOV A,C
ADC M
MOV C,A
INX H
SHIFT: MOV A,C
RAR
MOV C,A
MOV A,B
RAR
MOV B,A
JMP TOP
;LINKAGES TO FLOATING POINT ROUTINES
;###S
ORG 1774H
FPTBL:
; ORG 113707Q
;###E
JMP NORM
JMP FLOAT
JMP WZER
JMP LADD
JMP LMUL
JMP LDIV
JMP LSUB
JMP DFXL
JMP LMCM
JMP COPY
JMP CVRT
JMP INPUT
JMP MULT
JMP PTVAL
JMP DCOMP
JMP MCHK
JMP CHAR2
JMP INL
JMP OUTL
END