The C Users' Group Library 1994 August/wc-cdrom-cusersgrouplibrary-1994-08.iso/vol_100/135_01/math.csm

Text File | 1985-03-10 | 21KB | 1,458 lines

;
;    MATH.CSM---a high precision (2^2048) integer math package.
;    This version based on the package written by M. G. Dinneley,
;    published in the March 1977 issue of Dr Dobb's Journal.  It
;    has been adapted by Thomas Hill for m80 and CP/M.  Further
;    corrections, additions and adaptions for BDSc by Hugh S. Myers.
;
;    M. G. Dinneley
;    3/77
;
;    Thomas Hill
;    8/10/82
;
;    Hugh S. Myers
;    9/30/83
;    4/2/84
;

    INCLUDE    <BDS.LIB>

;
; AD1---SIGNED ADDITION.
;
    FUNCTION    AD1
    EXTERNAL    GPAS1

    XRA    A    ;CLEAR CARRY
    JMP    GPAS1

    ENDFUNC
;
; SB1---SIGNED SUBTRACTION.
;
    FUNCTION    SB1
    EXTERNAL    GPAS1

    STC        ;SET CARRY
    JMP    GPAS1

    ENDFUNC
;
; GPAS1---GENERAL PURPOSE ADD & SUBTRACT (SIGNED).
;
    FUNCTION    GPAS1
    EXTERNAL    ADD1,SUB1

    PUSH    PSW    ;SAVE FLAGS
    LDAX    D
    XRA    M    ;DIFFERING SIGNS?
    JM    GPAS3
    POP    PSW    ;NO
    JC    GPAS4    ;GO DO SUBTRACTION
GPAS2:
    CALL    ADD1    ;ELSE DO ADDITION.
    RET
GPAS3:
    POP    PSW
    JC    GPAS2    ;DIFFERING SIGNS, IF SUBTRACT (CARRY SET) THEN
            ;DO ADDITION RATHER THAN SUBTRACTION.
GPAS4:
    CALL    SUB1
    RET

    ENDFUNC
;
; ADD1---SIMPLE POSITIVE ADDITION, ADDS (HL) TO (DE) LEAVING
; RESULT AT (DE).
;
    FUNCTION    ADD1
    EXTERNAL    LDC2,LDB1,INRM

    CALL    LDC2    ;GET LENGTH OF (HL) TO C
    PUSH    D
    PUSH    H
    CALL    LDB1    ;GET LENGTH OF (DE) TO B
    SUB    C    ;COMPARE LENGTHS
    XCHG
    JNC    ADD2
    CMA        ;INCREASE AUGEND LENGTH TO
            ;EQUAL LENGTH OF ADDEND
    ADC    M
    MOV    M,A
    XRA    A    ;CLEAR ACCUMULATOR
    ADD    B    ;LENGTH OF (DE)
    JZ    ADD5    ;AUGEND IS ZERO, DON'T ADD
ADD2:
    INX    H
    INX    D
    LDAX    D    ;GET AUGEND BYTE
    ADC    M    ;AND ADD IT TO ADDEND PLUS CARRY IF ANY
    MOV    M,A
    DCR    B
    JZ    ADD6    ;NO MORE AUGEND LEFT TO ADD
    DCR    C
    JNZ    ADD2    ;CONTINUE ADDITION
ADD3:
    INX    H    ;ADDEND EXHAUSTED
    MOV    A,M
    ADC    C
    MOV    M,A
    DCR    B    ;CONTINUE BY ADDING ZEROS TO AUGEND
            ;UNTIL AUGEND EXHAUSTED
    JNZ    ADD3
    JNC    ADD7    ;FINISHED
ADD4:
    INX    H    ;OVERFLOW
    MVI    M,1    ;EXTEND RESULT BY CARRY TO NEW DIGIT
            ;POSITION
    POP    D
    POP    H
    CALL    INRM    ;EXTEND LENGTH BYTE BY ONE
    XCHG
    RET
ADD5:
    INX    H
    INX    D
    LDAX    D
    ADC    B
    MOV    M,A
ADD6:
    DCR    C    ;ADD ZERO TO ADDEND
    JNZ    ADD5
    JC    ADD4    ;FINISHED, CHECK FOR OVERFLOWS
ADD7:
    POP    H
    POP    D
    RET

    ENDFUNC
;
; SUB1---SIMPLE UNSIGNED SUBTRACTION ROUTINE, SUB1 SUBTRACTS
; (HL) FROM (DE) LEAVING THE RESULT AT (DE).
;
    FUNCTION    SUB1
    EXTERNAL    LDC2,LDB1,DCRM

    CALL    LDC2
    PUSH    H
    PUSH    D
    CALL    LDB1    ;GET LENGTHS
    SUB    C    ;COMPARE THEM.
    JNC    SUB2
    XCHG
    CMA
    ADC    M    ;INCREASE MINUEND
            ;LENGTH (PRESERVE SIGN)
    MOV    M,A
    XRA    A
    ADD    B
    XCHG
    JZ    SUB3    ;MINUEND EQUALS ZERO
SUB2:
    INX    H
    INX    D
    LDAX    D
    SBB    M    ;DO THE SUBTRACTION HERE
    STAX    D
    DCR    C
    JZ    SUB7    ;JUMP IF SUBTRAHEND EXHAUSTED
    DCR    B
    JNZ    SUB2
SUB3:
    INX    H    ;IF HERE THEN MINUEND EXHAUSTED
    INX    D
    MOV    A,B
    SBB    M    ;SUBTRACT ZEROS
    STAX    D
    DCR    C
    JNZ    SUB3    ;CONTINUE UNTIL DONE
SUB4:
    POP    H
    PUSH    H    ;IF RESULT IS NEGATIVE, FORM TWO'S
            ;COMPLIMENT.
    PUSH    D
    MOV    A,M
    RAL
    CMC
    RAR
    MOV    M,A
    ANI    7FH
    MOV    C,A    ;LENGTH TO C
    STC
SUB5:
    INX    H
    MOV    A,M
    CMA
    ADC    B
    MOV    M,A
    DCR    C
    JNZ    SUB5
    POP    D
    JMP    SUB8
SUB6:
    INX    D
    LDAX    D
    SBB    C
    STAX    D
SUB7:
    DCR    B
    JNZ    SUB6
    JC    SUB4
SUB8:
    POP    H
SUB9:
    LDAX    D
    CMP    C    ;ANY REDUCTION IN PRECISION?
    JNZ    SUB11    ;NOPE.
    DCX    D
SUB10:
    CALL    DCRM    ;REDUCE PRECISION
    JNZ    SUB9
SUB11:
    XCHG
    POP    H
    RET

    ENDFUNC
;
; MULT---GENERAL PURPOSE MULTIPLY ROUTINE.  MULTIPLIES (DE) BY (HL)
; WITH RESULT STORED AT (DE).  THIS ROUTINE HANDLES BOTH NEGATIVE AND
; AND POSITIVE VALUES.  NOTE...THIS VERSION HAS BEEN PATCHED TO ALLOW
; (DE) AND (HL) TO POINT AT THE SAME INITIAL NUMBER.
;
    FUNCTION    MULT
    EXTERNAL    LDB2,MOOV,LEFT,RIGHT,ADD1

    CALL    LDB2
    PUSH    H
    LDAX    D
    XRA    M    ;CHECK SIGNS
    PUSH    PSW    ;SAVE RESULT
    PUSH    D
    PUSH    H
    LXI    H,T1
    CALL    MOOV    ;PUT MULTIPLICAND IN T1 WORK AREA
    POP    D
    LXI    H,T2
    CALL    MOOV    ;PUT MULTIPLIER IN T2 WORK AREA
    POP    D
    XRA    A
    STAX    D    ;SET RESULT TO ZERO FOR START
MULT1:
    LXI    H,T2
    MOV    A,M    ;START MULTIPLICATION
    ORA    A
    JZ    MULT3    ;FINISHED
    CALL    RIGHT
    LXI    H,T1
    JNC    MULT2    ;LEAST SIGNIFICANT BIT NOT SET, SO DON'T
            ;ADD
    CALL    ADD1
MULT2:
    CALL    LEFT    ;LEFT SHIFT MULTIPLICAND
    JMP    MULT1
MULT3:
    POP    PSW
    POP    H
    RP        ;IF PLUS THEN NO SIGN DIFFERENCE
    LDAX    D
    XRI    80H    ;CHANGE SIGN
    STAX    D
    RET

T1:        DS    128
T2:        DS    128

    ENDFUNC
;
; MODULUS---GENERAL PURPOSE MODULO ROUTINE.
; DIVIDES (DE) BY (HL) WITH REMAINDER TO (DE).
;
    FUNCTION    MODULUS
    EXTERNAL    DDIV

    XRA    A
    ADI    80H    ;CLEAR CARRY AND SET SIGN BIT
    JMP    DDIV

    ENDFUNC
;
; DIVR---DIVIDE AND ROUND.  DIVIDES (DE) BY (HL) WITH RESULT TO (DE)
; AFTER ROUNDING.
;
    FUNCTION    DIVR
    EXTERNAL    DDIV

    XRA    A
    STC        ;SET CARRY AND CLEAR SIGN
    JMP    DDIV

    ENDFUNC
;
; DIV---DIVIDE ROUTINE.  DIVIDES (DE) BY (HL) WITH RESULT TO (DE).
;
    FUNCTION    DIV
    EXTERNAL    DDIV

    XRA    A    ;CLEAR CARRY AND CLEAR SIGN
    JMP    DDIV

    ENDFUNC
;
; DDIV---GENERAL PURPOSE WORKHORSE FOR DIV, MODULUS AND DIVR.
;
    FUNCTION    DDIV
    EXTERNAL    LDC1,LDB1,MOOV,PSHL,SUB1,INCR,RIGHT
    EXTERNAL    LEFT,PARE

    PUSH    H
    PUSH    PSW    ;SAVE VECTOR FLAGS
    LDAX    D
    XRA    M    ;SIGN DIFFERENCE?
    RLC
    JNC    DDIV2    ;NO SIGN DIFFERENCES
    POP    PSW
    INR    A    ;SIGN DIFFERENCE IN BIT 0
    PUSH    PSW
DDIV2:
    CALL    LDC1    ;GET LENGTH OF DIVISOR
    JZ    RETN    ;BAIL OUT IF DIVISOR IS ZERO
    CALL    LDB1
    SUB    C
    JM    RETN    ;DIVISOR IS GREATER THAN DIVIDEND
    PUSH    D
    INR    A
    MOV    B,A
    MOV    C,A    ;SAVE LENGTH DIFFERENCE
    PUSH    B
    LDAX    D
    ANI    7FH    ;CLEAR SIGN OF DIVIDEND
    STAX    D
    MOV    A,M
    ANI    7FH    ;CLEAR SIGN OF PARTIAL DIVISOR
    MOV    M,A
    XCHG
    LXI    H,T1    ;SET TO T1
    CALL    MOOV    ;MOVE DIVISOR FROM (DE) TO T1 (HL)
    XRA    A
    STA    T2    ;ZERO OUT DIVIDEND (T2)
    POP    D
DDIV3:
    CALL    PSHL
    DCR    E
    JNZ    DDIV3
    MOV    C,A
    MOV    B,D
DDIV4:
    POP    D
    PUSH    D
    PUSH    B
    LXI    H,T1
    CALL    PARE    ;PARTIAL DIVIDEND >= PARTIAL DIVISOR?
    JC    DDIV5    ;NO
    CALL    SUB1    ;YES, SUBTRACT
    LXI    H,T2
    CALL    INCR    ;INCREMENT QUOTIENT
DDIV5:
    LXI    H,T1
    CALL    RIGHT    ;RIGHT SHIFT PARTIAL DIVISOR
    POP    B
    DCR    C    ;LOOP COUNT
    JP    DDIV6
    MVI    C,7
    DCR    B
    JM    DDIV7    ;END
DDIV6:
    PUSH    B
    LXI    H,T2
    CALL    LEFT    ;LEFT SHIFT PARTIAL RESULT
    POP    B
    JMP    DDIV4    ;CONTINUE DIVISION
DDIV7:
    POP    D
    POP    PSW    ;(DE)-> REMAINDER
    JM    DDIV11    ;MODULO FUNCTION
    JNC    DDIV9    ;NO ROUNDING
    PUSH    PSW
    CALL    PARE    ;PARTIAL DIVISOR/2 < REMAINDER?
    JC    DDIV8
    JZ    DDIV8    ;NO
    LXI    H,T2
    CALL    INCR    ;YES, INCREMENT ANSWER FOR ROUNDING
DDIV8:
    POP    PSW
DDIV9:
    XCHG
    LXI    D,T2
    ANI    1
    JZ    DDIV10    ;NO CHANGE OF SIGN
    LDAX    D
    ORI    80H    ;CHANGE SIGN
    STAX    D
DDIV10:
    CALL    MOOV    ;MOVE RESULT TO (DE)
    XCHG
DDIV11:
    XRA    A
    POP    H
    LXI    H,T2    ;(DE)-> MODULUS, (HL)->QUOTIENT
    RET
RETN:
    POP    PSW
    STC        ;CARRY SET INDICATES NO
            ;DIVISION
    POP    H
    RET

T1:        DS    128
T2:        DS    128

    ENDFUNC
;
; SQRTR---SQUARE ROOT ROUNDED OF (DE).
; RETURNS RESULT AT (DE).
;
    FUNCTION    SQRTR
    EXTERNAL    SQRT1

    ORA    A    ;CLEAR CARRY FOR ROUNDING
    JMP    SQRT1

    ENDFUNC
;
; SQRT---SQUARE ROOT OF (DE) RETURNED AT (DE).
;
    FUNCTION    SQRT
    EXTERNAL    SQRT1

    STC        ;SET CARRY FOR NO ROUNDING
    JMP    SQRT1

    ENDFUNC
;
; SQRT1---WORKHORSE FOR SQRT AND SQRTR.
;
    FUNCTION    SQRT1
    EXTERNAL    PSHL,ADD1,PARE,SUB1,RIGHT,INCR,MOOV

    PUSH    PSW    ;SAVE OPERATION TYPE
    LDAX    D
    ORA    A
    STC
    JP    SQRT2
    POP    B
    RET        ;RETURN NO OP IF NEGATIVE OR ZERO
SQRT2:
    MVI    C,1
    LXI    H,T2
    MOV    M,C
    INX    H
    MOV    M,C    ;INITIALIZE T2 TO 1
    PUSH    D
    MOV    D,A
    MVI    A,0
    DCX    H
SQRT3:
    CALL    PSHL
    DCR    D    ;MAKE T2 >N (T2 MUST BE A SQUARE NUMBER)
    JNZ    SQRT3
    LXI    D,T1
    STAX    D    ;CLEAR T1
SQRT4:
    CALL    ADD1    ;T1 = T1 + T2
    XCHG
    POP    D
    CALL    PARE    ;N >= T1?
    PUSH    PSW
    CNC    SUB1    ;YES, N = N -T1
    POP    PSW
    PUSH    D
    XCHG
    LXI    H,T2
    PUSH    PSW
    CNC    ADD1    ;YES, T1 = T1 + T2
    POP    PSW
    CC    SUB1    ;NO, T1 = T1 - T2
    XCHG
    CALL    RIGHT    ;T1 = T1 / 2
    XCHG
    CALL    RIGHT
    CALL    RIGHT    ;T2 = T2 / 4
    MOV    A,M
    ORA    A    ;T2 = ZERO?
    JNZ    SQRT4    ;NO
    POP    H
    POP    PSW    ;WAS IT ROUND?
    JC    SQRT5    ;NO
    CALL    PARE    ;N > T1?
    JNC    SQRT5
    XCHG
    CALL    INCR    ;YES SO T1 = T1 + 1
    XCHG
SQRT5:
    CALL    MOOV    ;PUT RESULT BACK TO (DE)
    XCHG
    ORA    A    ;CLEAR CARRY FOR GOOD RESULT
    RET

T1:        DS    128
T2:        DS    128

    ENDFUNC
;
; FACT---COMPUTE THE FACTORIAL OF (HL) AND RETURN
; RESULT AT (HL).
;
    FUNCTION    FACT
    EXTERNAL    MOOV,DECR,MULT

    MOV    A,M
    ANI    7FH    ;N=ABS(N).
    MOV    M,A
    ORA    A
    RZ        ;F(0)=0 SO RETURN IF ZERO.
    CPI    1    ;CHECK FOR SPECIAL CASE OF N=1
            ;AND N=2.
    JNZ    FAC1
    INX    H
    MOV    A,M
    DCX    H
    CPI    1
    RZ        ;F(1)=1 SO RETURN ONE.
    CPI    2
    RZ        ;F(2)=2 SO RETURN TWO.
FAC1:
    PUSH    D    ;SAVE DE FOR RETURN.
    XCHG
    LXI    H,FVAR
    CALL    MOOV    ;FVAR=N.
    CALL    DECR    ;FVAR=FVAR-1.
FAC2:
    CALL    MULT    ;N=N*FVAR.
    CALL    DECR    ;FVAR=FVAR-1.
    MOV    A,M
    CPI    1
    JNZ    FAC2
    INX    H
    MOV    A,M
    DCX    H
    CPI    1    ;DECREASE FVAR TO 1 STEP -1.
    JNZ    FAC2
    XCHG        ;(HL)->N!, (DE)->FVAR.
    POP    D    ;RESTORE D.
    RET

FVAR:        DS    128

    ENDFUNC
;
; POW---GIVEN (HL)=X AND (DE)=N, RETURN P(X,N) AT (DE), WHERE
; N IS A POSITIVE INTEGER.  THIS ROUTINE USES ALGORITHM A, PAGE
; 442 OF SEMINUMERICAL ALGORITHMS, BY D. KNUTH.
;
    FUNCTION    POW
    EXTERNAL    MOOV,RIGHT,MULT

    PUSH    H    ;SAVE FOR ALL RETURNS.
    PUSH    D    ;SAVE FOR ALL RETURNS.
    XRA    A
    STA    PNEG    ;CLEAR NEGATIVE RETURN FLAG.
    MOV    A,M
    ORA    A
    JZ    RET0    ;P(0,N)=0.
    ANI    80    ;IS X <0?
    JZ    POW0    ;NO.
    INX    D
    LDAX    D    ;GET N.
    DCX    D
    ANI    1    ;IS N ODD OR EVEN?
    JZ    POW0    ;N IS EVEN SO SKIP.
    STA    PNEG    ;SET SIGN FOR RETURN.
POW0:
    MOV    A,M
    ANI    7FH    ;IGNORE SIGN FOR NOW.
    CPI    1
    JNZ    POW1
    INX    H
    MOV    A,M
    DCX    H
    CPI    1
    JZ    RET1    ;P(1,N)=1.
POW1:
    XCHG
    MOV    A,M
    ANI    7FH    ;N=ABS(N).
    MOV    M,A
    ORA    A
    JZ    RET1    ;P(X,0)=1.
    CPI    1
    JNZ    POW2
    INX    H
    MOV    A,M
    DCX    H
    CPI    1
    JZ    RETX    ;P(X,1)=X.
POW2:
    PUSH    H
    LXI    H,Y
    MVI    M,1
    INX    H
    MVI    M,1    ;Y=1.
    LXI    H,Z
    CALL    MOOV    ;Z=X.
    POP    H
POW3:
    INX    H
    MOV    A,M
    DCX    H
    ANI    1
    PUSH    PSW    ;TEST FOR ODD/EVEN AND SAVE RESULT.
    CALL    RIGHT    ;SHIFT RIGHT ONE BIT, N=N/2.
    POP    PSW
    JZ    POW4    ;SEE STEP A2...POW4 CORRESPONDS TO A5.
    PUSH    H
    PUSH    D
    LXI    D,Y
    LXI    H,Z
    CALL    MULT
    POP    D
    POP    H
    MOV    A,M
    ORA    A
    JZ    RETY
POW4:
    PUSH    H
    PUSH    D
    LXI    D,Z
    LXI    H,Z
    CALL    MULT
    POP    D
    POP    H
    JMP    POW3
RET0:
    POP    D
    POP    H
    MVI    A,0
    STAX    D
    RET
RET1:
    POP    D
    POP    H
    MVI    A,1
    STAX    D
    INX    D
    STAX    D
    DCX    D
    RET
RETX:
    POP    D
    POP    H
    XCHG
    CALL    MOOV
    XCHG
    RET
RETY:
    LDA    PNEG
    ORA    A
    JZ    RETY1
    LDA    Y
    XRI    80H
    STA    Y
RETY1:
    POP    D
    XCHG
    LXI    D,Y
    CALL    MOOV
    POP    H
    RET

PNEG:        DB    0
Y:        DS    128
Z:        DS    128

    ENDFUNC
;
; GCD---GIVEN (DE)=A AND (HL)=B, RETURN THE GREATEST COMMON
; DIVISOR AT (DE).
;
    FUNCTION    GCD
    EXTERNAL    MOOV,DIV,MULT,SB1

    MOV    B,M
    LDAX    D
    ORA    B
    RZ        ;BOTH ARE ZERO.
    MOV    A,M
    ANI    7FH
    MOV    M,A    ;B=ABS(B).
    LDAX    D
    ANI    7FH
    STAX    D    ;A=ABS(A).
GCD1:
    PUSH    H
    LXI    H,R
    CALL    MOOV    ;R=A.
    POP    H
    PUSH    H    ;SAVE BECAUSE DIV RETURNS QUOTIENT IN HL
    CALL    DIV    ;A=A\B.
    POP    H
    CALL    MULT    ;A=A*B.
    XCHG        ;HL=A, DE=B.
    PUSH    D
    LXI    D,R
    CALL    SB1    ;R=R-A.
    POP    D
    LDA    R
    ORA    A
    JZ    RETB    ;IF R=0 THEN RETURN B.
    CALL    MOOV    ;A=B.
    XCHG        ;HL=B, DE=A.
    PUSH    D
    LXI    D,R
    CALL    MOOV    ;B=R.
    POP    D
    JMP    GCD1
RETB:
    CALL    MOOV    ;A=B.
    XCHG        ;HL=B, DE=A.
    RET

R:        DS    128

    ENDFUNC
;
; LCM---GIVEN (DE)=A AND (HL)=B, RETURN THE LEAST COMMON MULTIPLE
; OF A AND B AT (DE).  LCM(A,B)=A*B/GCD(A,B).
;
    FUNCTION    LCM
    EXTERNAL    MOOV,MULT,GCD,DIV

    MOV    B,M
    LDAX    D
    ORA    B
    RZ        ;BOTH ARE ZERO.
    MOV    A,M
    ANI    7FH
    MOV    M,A    ;B=ABS(B).
    LDAX    D
    ANI    7FH
    STAX    D    ;A=ABS(A).
    PUSH    H
    LXI    H,LCMV
    CALL    MOOV    ;LCMV=A.
    POP    H
    PUSH    D
    LXI    D,LCMV
    CALL    MULT    ;LCMV=LCMV*B.
    POP    D
    CALL    GCD    ;A=GCD(A,B)
    PUSH    H
    XCHG
    LXI    D,LCMV
    CALL    DIV
    CALL    MOOV
    XCHG
    POP    H
    RET

LCMV:        DS    128

    ENDFUNC
;
; RAND---RANDOM NUMBER GENERATOR.  IF HL=0 THEN RETURN R(N) ELSE
; RETURN R(1).  NUMBER IS RETURNED AT (DE).
;
    FUNCTION    RAND
    EXTERNAL    AD1,MOOV,MULT,MODULUS

    MOV    A,H
    ORA    L
    JZ    RAND1
    LXI    H,XN
    MVI    M,1
    INX    H
    MVI    M,1
RAND1:
    PUSH    D
    LXI    D,XN
    LXI    H,RMULT
    CALL    MULT
    CALL    AD1
    LXI    H,RMOD
    PUSH    H
    CALL    MODULUS
    POP    H
    POP    D
    XCHG
    LXI    D,XN
    CALL    MOOV
    XCHG
    RET

XN:        DS    128
RMULT:        DB    3,1,0,1
RMOD:        DB    10H,0FFH,0FFH,0FFH,0FFH
        DB    0FFH,0FFH,0FFH,0FFH
        DB    0FFH,0FFH,0FFH,0FFH
        DB    0FFH,0FFH,0FFH,7FH

    ENDFUNC
;
; AUXILLIARY ROUTINES
;
;
; LDB1---LOADS REGISTER B WITH LENGTH INDICATOR OF VALUE AT (DE).
;
    FUNCTION    LDB1

    LDAX    D
    RAL
    ORA    A
    RAR
    MOV    B,A
    ORA    A
    RET

    ENDFUNC
;
; LDB2---AS LDB1, BUT RETURNS TO CALLER'S CALLER ON LENGTH ZERO.
;
    FUNCTION    LDB2
    EXTERNAL    LDB1,ABRT

    CALL    LDB1
    JZ    ABRT
    RET

    ENDFUNC
;
; LDC1---LOADS REGISTER C WITH LENGTH INDICATOR OF MULTI-VALUE AT (HL).
;
    FUNCTION    LDC1

    MOV    A,M
    RAL
    ORA    A
    RAR
    MOV    C,A
    ORA    A
    RET

    ENDFUNC
;
; LDC2---AS LDC1, BUT RETURNS TO CALLER'S CALLER ON LENGTH ZERO.
;
    FUNCTION    LDC2
    EXTERNAL    LDC1,ABRT

    CALL    LDC1
    JZ    ABRT
    RET

    ENDFUNC
;
; ABRT---ABORT ROUTINE USED BY LDC2 AND LDB2.   ADJUSTS STACK TO RETURN TO
; CALLER'S CALLER.
;
    FUNCTION    ABRT

    INX    SP
    INX    SP
    RET

    ENDFUNC
;
; OVFLW---OVERFLOW RECOVERY ROUTINE.  CURRENTLY THIS ROUTINE PERFORMS
; AN UNCONDITIONAL RETURN TO CP/M WITH A JUMP TO LOCATION ZERO.
;
    FUNCTION    OVFLW

    LXI    D,OVER
    MVI    C,PSTRNG
    CALL    BDOS
    JMP    BASE

OVER:        DB    'overflow error$'

    ENDFUNC
;
; UNFLW---UNDERFLOW RECOVERY ROUTINE.  CURRENTLY THIS ROUTINE PERFORMS
; AND UNCONDITIONAL RETURN TO CP/M WITH A JUMP TO LOCATION ZERO.
;
    FUNCTION    UNFLW

    LXI    D,UNDER
    MVI    C,PSTRNG
    CALL    BDOS
    JMP    BASE

UNDER:        DB    'underflow error$'

    ENDFUNC
;
; INRM---INCREMENT LENGTH INDICATOR OF VALUE AT (HL).
;
    FUNCTION    INRM
    EXTERNAL    OVFLW

    MOV    A,M
    INR    M
    XRA    M
    RP        ;CHECK FOR SIGN CHANGE
    JMP    OVFLW    ;IF NEGATIVE, THEN SIZE LIMIT EXCEEDED.

    ENDFUNC
;
; DCRM---DECREMENT LENGTH INDICATOR OF VALUE AT (DE).
;
    FUNCTION    DCRM
    EXTERNAL    UNFLW

    MOV    A,M
    CPI    81H    ;IS IT ZERO PLUS ONE?
    JZ    LABB
    DCR    M
    RZ        ;RETURN WITH ZERO SET FOR
            ;ZERO
    XRA    M    ;SIGN CHANGE?
    RP        ;NO, ELSE
    JMP    UNFLW    ;UNDERFLOW CONDITION HERE
LABB:
    MVI    M,0    ;SPECIAL CASE OF ZERO AS LENGTH AND
    RET        ;VALUE.

    ENDFUNC
;
; INCR---ADD ONE TO (HL)
;
    FUNCTION    INCR
    EXTERNAL    LDC1,INCR2,INCR3

    PUSH    H
    CALL    LDC1    ;GET LENGTH
    JZ    INCR2
INCR1:
    INX    H
    INR    M    ;INCREMENT DATA
    JNZ    INCR3    ;OVERFLOW?
    DCR    C
    JNZ    INCR1    ;LOOP TILL DONE
    JMP    INCR2

    ENDFUNC
;
; INCR2---PART OF INCR
;
    FUNCTION    INCR2
    EXTERNAL    INRM

INCR2:
    INX    H
    MVI    M,1    ;EXTEND PRECISION
    POP    H
    CALL    INRM    ;EXTEND LENGTH
    RET
    ENDFUNC
;
; INCR3---PART OF INCR
;
    FUNCTION    INCR3

    POP    H
    RET

    ENDFUNC
;
; DECR---SUBTRACT ONE FROM (HL).
;
    FUNCTION    DECR
    EXTERNAL    INCR,LDC2,MOOV,DCRM

    MOV    A,M
    ORA    A
    JZ    DECR3
    ANI    80H
    JNZ    INCR
    PUSH    H
    CALL    LDC2
    INX    H
    MOV    A,M
    SBI    1
    MOV    M,A
    DCR    C
    JZ    DECR2
DECR1:
    INX    H
    MOV    A,M
    SBI    0
    MOV    M,A
    DCR    C
    JNZ    DECR1
DECR2:
    POP    H
    ORA    A
    RNZ
    CALL    DCRM
    RET
DECR3:
    MVI    M,81H
    INX    H
    MVI    M,1
    DCX    H
    RET

    ENDFUNC
;
; LEFT---SHIFT (HL) LEFT ONE BIT, MULTIPLY BY 2.
;
    FUNCTION    LEFT
    EXTERNAL    LDC2,INCR2

    CALL    LDC2
    PUSH    H
LEFT1:
    INX    H
    MOV    A,M    ;GET BYTE
    RAL
    MOV    M,A    ;RESTORE SHIFTED
    DCR    C    ;DECREMENT COUNTER
    JNZ    LEFT1
    JC    INCR2    ;EXTEND PRECISION IF OVERFLOW OFF END
    POP    H
    RET

    ENDFUNC
;
; RIGHT---SHIFT (HL) RIGHT ONE BIT, DIVIDE BY 2.
;
    FUNCTION    RIGHT
    EXTERNAL    LDC2,DCRM

    CALL    LDC2
    MVI    B,0
    DAD    B    ;GO TO TO HIGH END
    MOV    A,M
    RAR
    MOV    M,A    ;ROTATE RIGHT
    MOV    B,A    ;SAVE NEW TOP BYTE
RIGHT1:
    DCX    H
    DCR    C
    JZ    RIGHT2
    MOV    A,M
    RAR
    MOV    M,A
    JMP    RIGHT1    ;HANDLE REST OF DATA
RIGHT2:
    DCR    B    ;WAS NEW TOP EQUAL TO ZERO?
    RP        ;NO.
    PUSH    PSW    ;IF YES, THEN SAVE CARRY (= LOST BIT)
    CALL    DCRM    ;CHANGE LENGTH
    POP    PSW
    RET

    ENDFUNC
;
; MOOV---MOVE VALUE FROM (DE) TO (HL)
;
    FUNCTION    MOOV
    EXTERNAL    LDB1

    CALL    LDB1
    MOV    M,A
    RZ        ;WAS LENGTH EQUAL TO ZERO?
    LDAX    D    ;NO, THEN MOVE THINGS
    MOV    M,A    ;STORE PROPER LENGTH COUNT
    PUSH    D
    PUSH    H    ;SAVE POINTERS
MOOV1:
    INX    D
    INX    H
    LDAX    D
    MOV    M,A
    DCR    B
    JNZ    MOOV1
    POP    H
    POP    D
    RET

    ENDFUNC
;
; PARE---COMPARE TWO MULTI-BYTE VALUES (DE) TO (HL).
; RETURNS ZERO SET IF EQUAL, CARRY SET IF (DE)<(HL).
;
    FUNCTION    PARE
    EXTERNAL    LDC1

    MOV    A,M
    RAL        ;SIGN TO CARRY
    CMC        ;SET TO TRUE
    RAR        ;PUT IT BACK
    MOV    B,A
    LDAX    D
    RAL        ;SAME TO (DE)
    CMC
    RAR
    CMP    B    ;COMPARE LENGTHS
    RNZ        ;LENGTHS NOT EQUAL
    CALL    LDC1    ;GET LENGTH OF (HL)
    PUSH    H
    PUSH    D
    MVI    B,0
    DAD    B    ;POINT TO HIGH BYTE OF (HL)
    XCHG
    DAD    B    ;POINT TO HIGH BYTE OF (DE)
    XCHG
PARE1:
    LDAX    D
    CMP    M    ;COMPARE BYTES
    JNZ    PARE2    ;NOT EQUAL
    DCX    H
    DCX    D    ;TRY NEXT BYTE DOWN
    DCR    C
    JNZ    PARE1
PARE2:
    POP    D
    POP    H
    RET

    ENDFUNC
;
; PSHL---DEQUEUE UTILITY, PUSH VALUE TO BEGINING OF (HL).
;
    FUNCTION    PSHL
    EXTERNAL    OVFLW

    PUSH    PSW    ;SAVE VALUE
    MVI    B,0
    MOV    A,M    ;GET LENGTH
    ORA    A
    MOV    C,A    ;MOVE LENGTH TO C AS A COUNTER
    JZ    PSHL2    ;IF ZERO, NO NEED TO SHUFFLE DATA AROUND
    DAD    B    ;GOTO HIGH END OF DATA
PSHL1:
    MOV    A,M
    INX    H
    MOV    M,A
    DCX    H
    DCX    H
    DCR    C
    JNZ    PSHL1
PSHL2:
    INR    M    ;ADVANCE LENGTH
    JZ    OVFLW    ;OVERFLOW CONDITION
    POP    PSW
    INX    H
    MOV    M,A    ;PUT NEW BYTE AWAY
    DCX    H
    RET

    ENDFUNC
;
; POPL---DEQUEUE UTILITY, POP FROM BEGINING OF (HL).
;
    FUNCTION    POPL

    MOV    A,M    ;GET LENGTH
    ORA    A
    RZ        ;NOTHING TO GET
    MOV    C,A
    PUSH    H
    INX    H
    MOV    B,M    ;GET DATA BYTE
POPL1:
    INX    H
    MOV    A,M
    DCX    H
    MOV    M,A
    INX    H
    DCR    C
    JNZ    POPL1
    POP    H
    DCR    M    ;LENGTH EQUALS LENGTH MINUS ONE
    MOV    A,B    ;DATA REMOVED TO ACCUMULATOR
    RET

    ENDFUNC
;
; PSHH---DEQUEUE UTILITY, PUSH DATA ONTO END OF (HL).
;
    FUNCTION    PSHH
    EXTERNAL    OVFLW

    PUSH    H
    PUSH    PSW    ;SAVE DATA BYTE AND LENGTH BYTE
    INR    M    ;EXTEND LENGTH
    JZ    OVFLW    ;OVERFLOW CONDITION
    MOV    C,M    ;LENGTH
    MVI    B,0
    DAD    B    ;GOTO HIGH END OF DATA
    POP    PSW
    MOV    M,A    ;PUT DATA IN POSITION
    POP    H
    RET

    ENDFUNC
;
; POPH---DEQUEUE UTILITY, POP DATA FROM END OF (HL).
;
    FUNCTION    POPH

    MOV    A,M    ;LENGTH
    ORA    A
    RZ        ;NOTHING TO GET
    MOV    C,A
    PUSH    H
    MVI    B,0
    DAD    B    ;GOTO HIGH END OF DATA
    MOV    A,M    ;GET BYTE
    POP    H
    PUSH    PSW    ;SAVE IT
    DCR    M    ;LENGTH EQUALS LENGTH MINUS ONE
    POP    PSW
    RET

    ENDFUNC
;
; DECTOHEX---GIVEN A STRING AT (HL) IN STANDARD FORM,
; N BYTES, FOLLOWED BY A NULL CHAR, CONVERT TO HEX NUMBER
; IN VERY LONG INTEGER FORMAT AT (DE).
;
    FUNCTION    DECTOHEX
    EXTERNAL    MULT,AD1

    XRA    A
    STAX    D
    STA    NFLAG
    MOV    A,M
    CPI    '-'
    JNZ    DTH11
    MVI    A,1
    STA    NFLAG
    INX    H
DTH1:
    MOV    A,M
DTH11:
    ANI    0FH
    ORA    A
    JZ    DTH2    ;SKIP IF DIGIT IS ZERO
    STA    DIGIT+1
    PUSH    H
    LXI    H,DIGIT
    CALL    AD1
    POP    H
DTH2:
    INX    H    ;GET NEXT DIGIT IF ANY
    MOV    A,M
    ORA    A    ;IS IT A NULL?
    JZ    DTH3    ;YES, THEN FINISHED
    PUSH    H
    LXI    H,TEN
    CALL    MULT    ;SHIFT TO NEXT DIGIT POSITION
    POP    H
    JMP    DTH1
DTH3:
    LDA    NFLAG
    ORA    A
    RZ
    LDAX    D
    ORI    80H
    STAX    D
    RET

TEN:        DB    1,10
DIGIT:        DB    1,0
NFLAG:        DB    0

    ENDFUNC
;
; HEXTODEC---CONVERT HEX NUMBER IN VERY LONG INTEGER FORMAT
; AT (DE) TO A DECIMAL NUMBER (STRING), RETURN ADDRESS IN HL.
; FOR MORE INFORMATION ON RADIX CONVERSION SEE KNUTH, VOL 2,
; "SEMINUMERICAL ALGORITHMS" PP 302-310.
;
    FUNCTION    HEXTODEC
    EXTERNAL    MODULUS,MOOV

EXP:    EQU    12    ;FOR RADIX 10^12 CONVERSION

    LDAX    D
    CPI    80H
    JZ    HTD0    ;HANDLE CASE OF "-0"
    ORA    A
    JNZ    HTD1    ;HANDLE CASE OF "0"
HTD0:
    LXI    H,ANSWER
    MVI    M,30H
    INX    H
    MVI    M,0
    DCX    H
    RET
HTD1:
    XRA    A
    STA    NFLAG
    LXI    H,INDEX
    SHLD    INDEXPTR
    LXI    H,TEMPARRAY
    SHLD    TEMPPTR
    LXI    H,ANSEND
    SHLD    ANSPTR
    LDAX    D
    ORA    A
    JP    HTD2
    MVI    A,'-'    ;NUMBER IS NEGATIVE
    STA    NFLAG
HTD2:
    LXI    H,RADIX
    CALL    MODULUS
    CALL    HTD14    ;MOVE RESULT TO T2
    JC    HTD3
    LHLD    TEMPPTR
    CALL    MOOV
    PUSH    D
    XCHG
    LHLD    INDEXPTR
    MOV    M,E
    INX    H
    MOV    M,D
    INX    H
    SHLD    INDEXPTR
    XCHG
    POP    D
    LDAX    D
    MOV    C,A
    MVI    B,0
    DAD    B
    INX    H
    SHLD    TEMPPTR
    XCHG
    LXI    D,T2
    CALL    MOOV
    XCHG
    JMP    HTD2
HTD3:
    LHLD    TEMPPTR
    CALL    MOOV
    XCHG
    LHLD    INDEXPTR
    MOV    M,E
    INX    H
    MOV    M,D
    INX    H
    MVI    M,0
    INX    H
    MVI    M,0
HTD4:
    LXI    H,INDEX
    SHLD    INDEXPTR
HTD5:
    LHLD    INDEXPTR
    MOV    E,M
    INX    H
    MOV    A,M
    ORA    E
    JZ    HTD9
    MOV    D,M
    INX    H
    SHLD    INDEXPTR
    LXI    H,TEMP
    CALL    MOOV
    LDA    TEMP
    ORA    A
    JZ    HTD7
HTD6:
    MVI    A,EXP
    STA    RCNT
HTD61:
    LXI    D,TEMP
    LXI    H,TEN
    LDAX    D
    ORA    A
    JZ    HTD62
    CALL    MODULUS
    CALL    HTD14    ;MOVE RESULT TO T2
    INX    D
    LDAX    D
    DCX    D
    CALL    HTD13
    LDA    RCNT
    DCR    A
    JZ    HTD5
    STA    RCNT
    XCHG
    LXI    D,T2
    CALL    MOOV
    XCHG
    JMP    HTD61
HTD62:
    LDA    RCNT
    ORA    A
    JZ    HTD5
    DCR    A
    STA    RCNT
    MVI    A,0
    CALL    HTD13
    JMP    HTD62
HTD7:
    MVI    B,EXP
HTD8:
    MVI    A,0
    CALL    HTD13
    DCR    B
    JNZ    HTD8
    JMP    HTD5
HTD9:
    LHLD    ANSPTR
HTD10:
    INX    H
    MOV    A,M
    CPI    30H
    JZ    HTD10
    LDA    NFLAG
    ORA    A
    RZ
    DCX    H
    MOV    M,A
    RET
HTD13:
    PUSH    H
    LHLD    ANSPTR
    ADI    30H
    MOV    M,A
    DCX    H
    SHLD    ANSPTR
    POP    H
    RET
HTD14:
    PUSH    PSW
    PUSH    H
    PUSH    D
    LXI    D,T2
    XCHG        ;MOVE QUOTIENT TO T2
    CALL    MOOV
    POP    D
    POP    H
    POP    PSW
    RET

RCNT:        DB    0
T2:        DS    128
NFLAG:        DB    0
DIGIT:        DB    1,0
TEN:        DB    1,10
RADIX:        DB    05,00
        DB    10H,0A5H,0D4H,0E8H
INDEXPTR:    DW    0
TEMPPTR:    DW    0
ANSPTR:        DW    0
INDEX:        DS    128
TEMP:        DS    128
TEMPARRAY:    DS    512
ANSWER:        DS    320
ANSEND:        DS    1
        DB    0    ;NULL TERMINATOR.

    ENDFUNC
    END