home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The C Users' Group Library 1994 August
/
wc-cdrom-cusersgrouplibrary-1994-08.iso
/
vol_100
/
135_01
/
vli.csm
< prev
next >
Wrap
Text File
|
1985-03-10
|
13KB
|
718 lines
;
; VLI.CSM---VERY LONG INTEGER MATH ROUTINES FOR BDSc.
;
; BY HUGH S. MYERS
; 11/3/83
; 3/21/84
;
INCLUDE <BDS.LIB>
;
; FUNCTIONS WRITTEN:
;
; s string
; n integer
; s1,s2 string
;
; incrl(s) increment a string by one.
; decrl(s) decrement a string by one.
; saddl(s,n) short add, add an integer to a string.
; ssubl(s,n) short subtract, subtract an integer from a string.
; addl(s1,s2) add string one to string two.
; subl(s1,s2) subtract string two from string one.
; smull(s,n) short multiply, multiply a string by an integer.
; sdivl(s,n) short divide, divide a string by an integer.
; sdivlr(s,n) short divide rounded, as above with rounded result.
; smodl(s,n) short modulus, return remainder of a string divided by
; an integer.
; mull(s1,s2) multiply string one by string two.
; divl(s1,s2) divide string one by string two.
; divrl(s1,s2) divide string one by string two with rounded result.
; modl(s1,s2) return remainder of string one divided by string two.
; sqrtl(s) square root of a string.
; sqrtlr(s) square root of a string rounded.
; facl(s) string factorial.
; spowl(s,n) return string to the power of an integer.
; powl(s1,s2) return string one to the power of string two.
; gcdl(s1,s2) greatest common divisor of string one and string two.
; sgcd(s,n) greatest common divisor of a string and an integer.
; lcm(s1,s2) least common multiple of string one and string two.
; slcm(s,n) least common multiple of a string and an integer.
; randl(n) random number generator. if n == 0 return r(memory)
; else return r(1).
; minl(s1,s2) floor function, return smaller of s1 and s2.
; maxl(s1,s2) ceiling function, return larger of s1 and s2.
; absl(s) return the absolute value of a string.
;
; iszero(s) boolean truth function, test s == 0?
; isneg(s) boolean truth function, test s < 0?
; ispos(s) boolean truth function, test s >= 0?
; iseven(s) boolean truth function, test least significat bit = 0?
; isequal(s1,s2) boolean truth function, test s1 == s2?
; sisequal(s,n) boolean truth function, test s == n?
; isltl(s1,s2) boolean truth function, test s1 < s2?
; sisltl(s,n) boolean truth function, test s < n?
; isgtl(s1,s2) boolean truth function, test s1 > s2?
; sisgtl(s,n) boolean truth function, test s > n?
;
;
; INCRL---INCREMENT A STRING BY ONE.
;
FUNCTION INCRL
EXTERNAL GETS1,INCR,RETHL
CALL GETS1 ;DE-> S1 OR S
XCHG ;HL=DE. NORMALLY S1 IS NEEDED IN DE
;BUT NOT FOR INCR
PUSH B ;SAVE FOR BDSc.
CALL INCR
JMP RETHL ;HL-> RESULT
ENDFUNC
;
; DECRL---DECREMENT A STRING BY ONE.
;
FUNCTION DECRL
EXTERNAL GETS1,DECR,RETHL
CALL GETS1 ;DE-> S1 OR S
XCHG ;HL=DE. NORMALLY S1 IS NEEDED IN DE
;BUT NOT FOR DECR.
PUSH B ;SAVE FOR BDSc.
CALL DECR
JMP RETHL ;HL-> RESULT
ENDFUNC
;
; SADDL---SHORT ADD. ADD AN INTEGER TO A STRING
; RETURN RESULT.
;
FUNCTION SADDL
EXTERNAL GETS1,GETN,RETDE,AD1
CALL GETS1 ;DE-> S1 OR S
CALL GETN ;HL-> N
PUSH B ;SAVE FOR BDSc.
CALL AD1
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; SSUBL---SHORT SUBTRACT. SUBTRACT AN INTEGER FROM A STRING
; AND RETURN RESULT.
;
FUNCTION SSUBL
EXTERNAL GETS1,GETN,RETDE,SB1
CALL GETS1 ;DE-> S1 OR S
CALL GETN ;HL-> N
PUSH B ;SAVE FOR BDSc.
CALL SB1
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; ADDL---ADD STRING ONE TO STRING TWO AND RETURN RESULT
; STRING ADDRESS IN HL TO C.
;
FUNCTION ADDL
EXTERNAL GETS1,GETS2,RETDE,AD1
CALL GETS1 ;DE-> S1 OR S
CALL GETS2 ;HL-> S2
PUSH B ;SAVE FOR BDSc.
CALL AD1
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; SUBL---SUBTRACT STRING TWO FROM STRING ONE RETURNING RESULT
; STRING ADDRESS IN HL TO C.
;
FUNCTION SUBL
EXTERNAL GETS1,GETS2,RETDE,SB1
CALL GETS1 ;DE-> S1 OR S
CALL GETS2 ;HL-> S2
PUSH B ;SAVE FOR BDSc.
CALL SB1
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; SMULL---SHORT MULTIPLY. MULITPLY A STRING BY AN INTEGER
; AND RETURN THE RESULT AS STRING.
;
FUNCTION SMULL
EXTERNAL GETS1,GETN,MULT,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETN ;HL-> N
PUSH B ;SAVE FOR BDSc.
CALL MULT
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; SDIVL---SHORT DIVIDE. DIVIDE A STRING BY AN INTEGER
; AND RETURN THE RESULT AS STRING.
;
FUNCTION SDIVL
EXTERNAL GETS1,GETN,DIV,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETN ;HL-> N
PUSH B ;SAVE FOR BDSc.
CALL DIV
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; SDIVRL---SHORT DIVIDE. DIVIDE A STRING BY AN INTEGER
; AND RETURN THE RESULT, ROUNDED, AS A STRING.
;
FUNCTION SDIVRL
EXTERNAL GETS1,GETN,DIVR,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETN ;HL-> N
PUSH B ;SAVE FOR BDSc
CALL DIVR
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; SMODL---SHORT MODULUS. DIVIDE A STRING BY AN INTEGER
; AND RETURN THE MODULUS (REMAINDER) AS A STRING.
;
FUNCTION SMODL
EXTERNAL GETS1,GETN,MODULUS,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETN ;HL-> N
PUSH B ;SAVE FOR BDSc
CALL MODULUS
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; MULL---MULTIPLY. MULTIPLY STRING ONE BY STRING TWO. RETURN THE RESULT
; AS A STRING.
;
FUNCTION MULL
EXTERNAL GETS1,GETS2,MULT,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETS2 ;HL-> S2
PUSH B ;SAVE FOR BDSc
CALL MULT
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; DIVL---DIVIDE. DIVIDE STRING ONE BY STRING TWO. RETURN THE RESULT
; AS A STRING.
;
FUNCTION DIVL
EXTERNAL GETS1,GETS2,DIV,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETS2 ;HL-> S2
PUSH B ;SAVE FOR BDSc
CALL DIV
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; DIVRL---DIVIDE AND ROUND. DIVIDE STRING ONE BY STRING TWO. RETURN
; THE RESULT, ROUNDED, AS A STRING.
;
FUNCTION DIVRL
EXTERNAL GETS1,GETS2,DIVR,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETS2 ;HL-> S2
PUSH B ;SAVE FOR BDSc
CALL DIVR
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; MODL---MODULUS. DIVIDE STRING ONE BY STRING TWO. RETURN THE
; MODULUS (REMAINDER) AS A STRING.
;
FUNCTION MODL
EXTERNAL GETS1,GETS2,MODULUS,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETS2 ;HL-> S2
PUSH B ;SAVE FOR BDSc
CALL MODULUS
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; SQRTL---SQUARE ROOT. RETURN THE SQUARE ROOT OF A STRING.
;
FUNCTION SQRTL
EXTERNAL GETS1,SQRT,RETDE
CALL GETS1 ;DE-> S1 OR S
PUSH B ;SAVE FOR BDSc
CALL SQRT
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; SQRTRL---SQUARE ROOT ROUNDED. RETURN THE ROUNDED SQUARE ROOT OF A STRING.
;
FUNCTION SQRTRL
EXTERNAL GETS1,SQRTR,RETDE
CALL GETS1 ;DE-> S1 OR S
PUSH B ;SAVE FOR BDSc
CALL SQRTR
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; FACL---FACTORIAL. RETURN A STRING FACTORIAL.
;
FUNCTION FACL
EXTERNAL GETS1,FACT,RETHL
CALL GETS1 ;DE-> S1 OR S
XCHG ;HL=DE. NORMALLY S1 IS NEEDED IN DE
;BUT NOT FOR FACL.
PUSH B ;SAVE FOR BDSc
CALL FACT
JMP RETHL ;HL-> RESULT
ENDFUNC
;
; SPOWL---SHORT POWER. RETURN A STRING TO THE POWER OF AN INTEGER.
;
FUNCTION SPOWL
EXTERNAL GETS1,GETN,POW,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETN ;HL-> N
XCHG ;HL=DE, DE=HL. POW IS A LITTLE SCREWED UP.
PUSH B ;SAVE FOR BDSc
CALL POW
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; POWL---POWER. RETURN STRING ONE TO THE POWER OF STRING TWO.
;
FUNCTION POWL
EXTERNAL GETS1,GETS2,POW,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETS2 ;HL-> S2
XCHG ;HL=DE, DE=HL. POW IS A LITTLE SCREWED UP.
PUSH B ;SAVE FOR BDSc
CALL POW
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; GCDL---GREATEST COMMON DIVISOR OF STRING ONE AND STRING TWO.
;
FUNCTION GCDL
EXTERNAL GETS1,GETS2,GCD,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETS2 ;HL-> S2
PUSH B ;SAVE FOR BDSc
CALL GCD
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; SGCDL---GREATEST COMMON DIVISOR OF A STRING AND AN INTEGER.
;
FUNCTION SGCDL
EXTERNAL GETS1,GETN,GCD,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETN ;HL-> N
PUSH B ;SAVE FOR BDSc
CALL GCD
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; LCML---LEAST COMMON MULTIPLE OF STRING ONE AND STRING TWO.
;
FUNCTION LCML
EXTERNAL GETS1,GETS2,LCM,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETS2 ;HL-> S2
PUSH B ;SAVE FOR BDSc
CALL LCM
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; SLCML---LEAST COMMON MULTIPLE OF A STRING AND AN INTEGER.
;
FUNCTION SLCML
EXTERNAL GETS1,GETN,LCM,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETN ;HL-> N
PUSH B ;SAVE FOR BDSc
CALL LCM
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
;
; RANDL---RANDOM NUMBER GENERATOR. RETURN R(MEMORY) IF N=0 ELSE
; RETURN R(1).
;
FUNCTION RANDL
EXTERNAL RAND,RETDE
CALL MA1TOH
LXI D,VAR
PUSH B ;SAVE FOR BDSc
CALL RAND
JMP RETDE ;HL->DE-> RESULT
VAR: DS 256
ENDFUNC
;
; MINL---FLOOR FUNCTION, RETURN SMALLER OF S1 AND S2.
;
FUNCTION MINL
EXTERNAL GETS1,GETS2,PARE,RETHL,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETS2 ;HL-> S2
PUSH B ;SAVE FOR BDSc
CALL PARE
JNC RETHL
JMP RETDE
ENDFUNC
;
; MAXL---CEILING FUNCTION, RETURN LARGER OF S1 AND S2.
;
FUNCTION MAXL
EXTERNAL GETS1,GETS2,PARE,RETHL,RETDE
CALL GETS1 ;DE-> S1 OR S
CALL GETS2 ;HL-> S2
PUSH B ;SAVE FOR BDSc
CALL PARE
JC RETHL
JMP RETDE
ENDFUNC
;
; ABSL---RETURN THE ABSOLUTE VALUE OF A STRING.
;
FUNCTION ABSL
EXTERNAL GETS1,RETDE
CALL GETS1 ;DE-> S1 OR S
PUSH B ;SAVE FOR BDSc
LDAX D ;GET SIGN&LENGTH BYTE
ANI 7FH ;STRIP SIGN BIT
STAX D ;RESTORE SIGN&LENGTH BYTE
JMP RETDE
ENDFUNCTION
END
;
; ISZERO---BOOLEAN TRUTH FUNCTION, TEST STRING == 0?
;
FUNCTION ISZERO
EXTERNAL GETS1
CALL GETS1 ;DE-> S1 OR S
LDAX D
ORA A
JZ TRUE
LXI H,0
RET
TRUE:
LXI H,1
RET
ENDFUNC
;
; ISNEG---BOOLEAN TRUTH FUNCTION, TEST STRING < 0?
;
FUNCTION ISNEG
EXTERNAL GETS1
CALL GETS1 ;DE-> S1 OR S
LDAX D
ORA A
JZ NOTNEG
ANI 80H
ORA A
JZ NOTNEG
LXI H,1
RET
NOTNEG:
LXI H,0
RET
ENDFUNC
;
; ISPOS---BOOLEAN TRUTH FUNCTION, TEST STRING >= 0?
;
FUNCTION ISPOS
EXTERNAL GETS1
CALL GETS1 ;DE-> S1 OR S
LDAX D
ORA A
JZ POS
ANI 80H
ORA A
JNZ NEG
POS:
LXI H,1
RET
NEG:
LXI H,0
RET
ENDFUNC
;
; ISEVEN---BOOLEAN TRUTH FUNCTION, TEST IF MOD(STRING,2) == 0?
;
FUNCTION ISEVEN
EXTERNAL GETS1
CALL GETS1 ;DE-> S1 OR S
INX D
LDAX D
ANI 1
ORA A
JZ EVEN
LXI H,0
RET
EVEN:
LXI H,1
RET
ENDFUNC
;
; ISEQUAL---BOOLEAN TRUTH FUNCTION, TEST S1 == S2?
;
FUNCTION ISEQUAL
EXTERNAL GETS1,GETS2,PARE
CALL GETS1 ;DE-> S1 OR S
CALL GETS2 ;HL-> S2
PUSH B ;SAVE FOR BDSc
CALL PARE
POP B
LXI H,0
RNZ ;PARE RETURNS Z FLAG SET IF S1 == S2
INX H
RET
ENDFUNC
;
; SISEQUAL---BOOLEAN TRUTH FUNCTION, TEST S == N?
;
FUNCTION SISEQUAL
EXTERNAL GETS1,GETN,PARE
CALL GETS1 ;DE-> S1 OR S
CALL GETN ;HL-> N
PUSH B ;SAVE FOR BDSc
CALL PARE
POP B
LXI H,0
RNZ ;PARE RETURNS Z FLAG SET IF S == N
INX H
RET
ENDFUNC
;
; ISLTL---BOOLEAN TRUTH FUNCTION, TEST S1 < S2?
;
FUNCTION ISLTL
EXTERNAL GETS1,GETS2,PARE
CALL GETS1 ;DE-> S1 OR S
CALL GETS2 ;HL-> S2
PUSH B ;SAVE FOR BDSc
CALL PARE
POP B
LXI H,0
RZ
RNC
INX H
RET
ENDFUNC
;
; SISLTL---BOOLEAN TRUTH FUNCTION, TEST S < N?
;
FUNCTION SISLTL
EXTERNAL GETS1,GETN,PARE
CALL GETS1 ;DE-> S1 OR S
CALL GETN ;HL-> N
PUSH B ;SAVE FOR BDSc
CALL PARE
POP B
LXI H,0
RZ
RNC
INX H
RET
ENDFUNC
;
; ISGTL---BOOLEAN TRUTH FUNCTION, TEST S1 > S2?
;
FUNCTION ISGTL
EXTERNAL GETS1,GETS2,PARE
CALL GETS1 ;DE-> S1 OR S
CALL GETS2 ;HL-> S2
PUSH B ;SAVE FOR BDSc
CALL PARE
POP B
LXI H,0
RZ
RC
INX H
RET
ENDFUNC
;
; SISGTL---BOOLEAN TRUTH FUNCTION, TEST S > N?
;
FUNCTION SISGTL
EXTERNAL GETS1,GETN,PARE
CALL GETS1 ;DE-> S1 OR S
CALL GETN ;HL-> N
PUSH B ;SAVE FOR BDSc
CALL PARE
POP B
LXI H,0
RZ
RC
INX H
RET
ENDFUNC
;
; -----------------------
; C INTERFACE SUBROUTINES.
; ------------------------
;
; GETS1---CONVERT S1 TO VLI INTERNAL FORMAT AND RETURN
; THE ADDRESS IN DE.
;
FUNCTION GETS1
EXTERNAL DECTOHEX
CALL MA2TOH
LXI D,VAR
PUSH D
PUSH B ;SAVE FOR BDSc
CALL DECTOHEX
POP B
POP D
RET
VAR: DS 256
ENDFUNC
;
; GETS2---CONVERT S2 TO VLI INTERNAL FORMAT AND RETURN
; THE ADDRESS IN HL.
;
FUNCTION GETS2
EXTERNAL DECTOHEX
CALL MA3TOH
PUSH D
PUSH B ;SAVE FOR BDSc
LXI D,VAR
CALL DECTOHEX
POP B
POP D
LXI H,VAR
RET
VAR: DS 256
ENDFUNC
;
; GETN---CONVERT N TO VLI INTERNAL FORMAT. RETURN ADDRESS
; IN HL.
;
FUNCTION GETN
CALL MA3TOH ;GET S2 OFFSET BY 1.
MOV A,H
ORA A
JZ L1
CPI 80H
JC L2
CALL CMH+1 ;COMPLIMENT HL.
MOV A,H
ORA A
MVI A,81H
JZ L3
INR A
L3:
STA VAR
SHLD VAR+1
LXI H,VAR
RET
L1:
MVI A,1
JMP L3
L2:
MVI A,2
JMP L3
VAR: DB 0,0,0
ENDFUNC
;
; RETDE---CONVERT (DE) TO STRING AND RETURN WITH
; THAT ADDRESS IN HL TO C.
;
FUNCTION RETDE
EXTERNAL HEXTODEC
CALL HEXTODEC ;CONVERT (DE) TO $ AND
;RETURN $ADDR IN HL.
POP B
RET
ENDFUNC
;
; RETHL---CONVERT (HL) TO STRING AND RETURN WITH
; THAT ADDRESS IN HL TO C.
;
FUNCTION RETHL
EXTERNAL HEXTODEC,RETDE
XCHG ;DE=HL
JMP RETDE ;HL->DE-> RESULT
ENDFUNC
END