(FILECREATED "11-Mar-86 22:30:01" {ERIS}<TAMARIN>WORK>LLBIGNUM.;3 28206
changes to: (FNS \FORCEBIGNUM)
(VARS LLBIGNUMCOMS)
previous date: "11-Mar-86 22:16:55" {ERIS}<TAMARIN>WORK>LLBIGNUM.;2)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LLBIGNUMCOMS)
(RPAQQ LLBIGNUMCOMS ((CONSTANTS THETA (BETA (EXPT 2 14))
(BETA1 (SUB1 BETA)))
[DECLARE: EVAL@COMPILE (ADDVARS (CHARACTERNAMES (INFINITY 8551]
(ADDVARS (GLOBALVARS MIN.INTEGER MAX.INTEGER \BIG.0 \BIG.1))
(DECLARE: DONTCOPY (RECORDS BIGNUM))
(INITRECORDS BIGNUM)
(* entries)
(FNS \BIGNUM.COMPARE \BIGNUM.DIFFERENCE \BIGNUM.INTEGERLENGTH \BIGNUM.LOGAND \BIGNUM.LOGOR
\BIGNUM.LOGXOR \BIGNUM.PLUS \FORCEBIGNUM \BIGNUM.LSH \BIGNUM.TIMES \BIGNUM.QUOTIENT
\BIGNUM.REMAINDER \BIGNUM.TO.FLOAT)
(* internal functions)
(FNS \BIGNUM.TO.INT \BN.2TH \BN.ABS \BN.DIFFERENCE \BN.DIVIDE \BN.FLOAT \BN.IGNN
BIGNUM.DEFPRINT \BN.INTEGERLENGTH \BN.LOGAND \BN.LOGANDC2 \BN.LOGOR \BN.LOGXOR \BN.MINUS
\BN.PLUS2 \BN.SIGN \BN.TIMES2 \BN.COMPAREN \BN.D2TH \BN.FROM.FIXP \BN.ICANON \BN.IDIVIDE
\BN.ISUM0 \BN.ISUM1 \BN.MADD \BN.TO.FIXP \BN.NZEROS \BN.QRS \BN.SIGN \BN.TH2B \BN.TH2D)
(FNS \INITBIGNUMS)
(P (* MAKERATIONAL needs work)
(* needs work: MASK.1'S MASK.0'S BITTEST BITSET BITCLEAR LOGNOT LOADBYTE DEPOSITBYTE
IMODLESSP IMODPLUS IMODDIFFERENCE ROT)
(\INITBIGNUMS))))
(DECLARE: EVAL@COMPILE
(RPAQQ THETA 10000)
(RPAQ BETA (EXPT 2 14))
(RPAQ BETA1 (SUB1 BETA))
(CONSTANTS THETA (BETA (EXPT 2 14))
(BETA1 (SUB1 BETA)))
)
(DECLARE: EVAL@COMPILE
(ADDTOVAR CHARACTERNAMES (INFINITY 8551))
)
(ADDTOVAR GLOBALVARS MIN.INTEGER MAX.INTEGER \BIG.0 \BIG.1)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE BIGNUM (ELEMENTS)
(INIT (DEFPRINT (QUOTE BIGNUM)
(QUOTE BIGNUM.DEFPRINT))))
]
(/DECLAREDATATYPE (QUOTE BIGNUM)
(QUOTE (POINTER))
(QUOTE ((BIGNUM 0 POINTER)))
(QUOTE 2))
(DEFPRINT (QUOTE BIGNUM)
(QUOTE BIGNUM.DEFPRINT))
)
(/DECLAREDATATYPE (QUOTE BIGNUM)
(QUOTE (POINTER))
(QUOTE ((BIGNUM 0 POINTER)))
(QUOTE 2))
(DEFPRINT (QUOTE BIGNUM)
(QUOTE BIGNUM.DEFPRINT))
(* entries)
(DEFINEQ
(\BIGNUM.COMPARE
[LAMBDA (X Y) (* lmm "15-Apr-85 17:36")
(COND
((EQ X MIN.INTEGER)
(if (EQ Y MIN.INTEGER)
then 0
else -1))
((EQ X MAX.INTEGER)
(if (EQ Y MAX.INTEGER)
then 0
else 1))
((EQ Y MIN.INTEGER)
1)
((EQ Y MAX.INTEGER)
-1)
(T (\BN.COMPAREN (\BN.FROM.FIXP X)
(\BN.FROM.FIXP Y])
(\BIGNUM.DIFFERENCE
[LAMBDA (X Y) (* lmm "12-Apr-85 08:38")
(\BN.TO.FIXP (\BN.DIFFERENCE (\BN.FROM.FIXP X)
(\BN.FROM.FIXP Y])
(\BIGNUM.INTEGERLENGTH
[LAMBDA (X) (* lmm "12-Apr-85 08:01")
(\BN.INTEGERLENGTH (\BN.FROM.FIXP X])
(\BIGNUM.LOGAND
[LAMBDA (X Y) (* lmm "21-Apr-85 12:55")
(if (OR (EQ X 0)
(EQ Y 0))
then 0
elseif (LESSP Y 0)
then [if (LESSP X 0)
then (LOGNOT (LOGOR (LOGNOT X)
(LOGNOT Y)))
else (\BN.TO.FIXP (\BN.LOGANDC2 (\BN.FROM.FIXP X)
(\BN.FROM.FIXP (LOGNOT Y]
elseif (LESSP X 0)
then (\BIGNUM.LOGAND Y X)
else (\BN.TO.FIXP (\BN.LOGAND (\BN.FROM.FIXP X)
(\BN.FROM.FIXP Y])
(\BIGNUM.LOGOR
[LAMBDA (X Y) (* lmm "21-Apr-85 12:39")
(if (EQ X 0)
then Y
elseif (EQ Y 0)
then X
elseif (AND (GREATERP X 0)
(GREATERP Y 0))
then (\BN.TO.FIXP (\BN.LOGOR (\BN.FROM.FIXP X)
(\BN.FROM.FIXP Y)))
else (LOGNOT (LOGAND (LOGNOT X)
(LOGNOT Y])
(\BIGNUM.LOGXOR
[LAMBDA (X Y) (* lmm "21-Apr-85 13:00")
(if (OR (LESSP X 0)
(LESSP Y 0))
then (* stupid dumb but working definition)
(\BIGNUM.DIFFERENCE (\BIGNUM.LOGOR X Y)
(\BIGNUM.LOGAND X Y))
else (\BN.TO.FIXP (\BN.LOGXOR (\BN.FROM.FIXP X)
(\BN.FROM.FIXP Y])
(\BIGNUM.PLUS
[LAMBDA (X Y) (* lmm "12-Apr-85 08:03")
(\BN.TO.FIXP (\BN.PLUS2 (\BN.FROM.FIXP X)
(\BN.FROM.FIXP Y])
(\FORCEBIGNUM
[LAMBDA (I) (* jrb: "11-Mar-86 22:28")
(IF (TYPENAMEP I (QUOTE BIGNUM))
THEN I
ELSE (CREATE BIGNUM
ELEMENTS ← (LIST I])
(\BIGNUM.LSH
[LAMBDA (X N) (* lmm "12-Apr-85 08:36")
(if (IGEQ N 0)
then (\BIGNUM.TIMES X (EXPT 2 N))
elseif (IGREATERP X 0)
then (\BIGNUM.QUOTIENT X (EXPT 2 (IMINUS N)))
else (* RIGHTSHIFT A NEGATIVE)
(MINUS (\BIGNUM.LSH (MINUS X)
N])
(\BIGNUM.TIMES
[LAMBDA (X Y) (* lmm "12-Apr-85 08:03")
(\BN.TO.FIXP (\BN.TIMES2 (\BN.FROM.FIXP X)
(\BN.FROM.FIXP Y])
(\BIGNUM.QUOTIENT
[LAMBDA (X Y) (* lmm "12-Apr-85 08:03")
(\BN.TO.FIXP (CAR (\BN.DIVIDE (\BN.FROM.FIXP X)
(\BN.FROM.FIXP Y])
(\BIGNUM.REMAINDER
[LAMBDA (X Y) (* lmm "12-Apr-85 08:03")
(\BN.TO.FIXP (CDR (\BN.DIVIDE (\BN.FROM.FIXP X)
(\BN.FROM.FIXP Y])
(\BIGNUM.TO.FLOAT
[LAMBDA (X) (* lmm "12-Apr-85 08:06")
(* called by \FLOAT)
(\BN.FLOAT (\BN.FROM.FIXP X])
)
(* internal functions)
(DEFINEQ
(\BIGNUM.TO.INT
[LAMBDA (X) (* lmm "22-JUL-84 00:09")
(if (NULL (CDR X))
then (CAR X)
else (IPLUS (CAR X)
(ITIMES BETA (\BIGNUM.TO.INT (CDR X])
(\BN.2TH
[LAMBDA (A) (* lmm "20-JUL-84 01:35")
(PROG (L B)
[while A do (PROGN (SETQ L (\BN.QRS A THETA))
(SETQ A (CAR L))
(SETQ B (CONS (CDR L)
B]
(RETURN B])
(\BN.ABS
[LAMBDA (U) (* lmm "20-JUL-84 02:00")
(COND
((ILESSP (\BN.SIGN U)
0)
(\BN.MINUS U))
(T U])
(\BN.DIFFERENCE
[LAMBDA (U V) (* lmm "20-JUL-84 01:33")
(\BN.PLUS2 U (\BN.MINUS V])
(\BN.DIVIDE
[LAMBDA (A B FLG) (* lmm "12-Apr-85 08:11")
(PROG (M N K SA ST C D W E F B1 B2 A1 A2 A3 QHAT C1 R1 R2 U V Q X IP BIP L1 L2)
[COND
((OR (NULL A)
(NULL B))
(RETURN (CONS \BIG.0 A]
(COND
((CDR B)
(GO LL1)))
(SETQ BIP (\BN.QRS A (CAR B)))
[RETURN (CONS (CAR BIP)
(AND (NEQ FLG (QUOTE QUOTIENT))
(\BN.FROM.FIXP (CDR BIP]
LL1 (SETQ M (FLENGTH A))
(SETQ N (FLENGTH B))
(SETQ K (IDIFFERENCE M N))
[COND
((ILESSP K 0)
(RETURN (CONS \BIG.0 A]
(SETQ SA (\BN.SIGN A))
(SETQ U B)
(for i from 1 to (IDIFFERENCE N 1) do (SETQ U (CDR U)))
(SETQ C (CAR U))
(SETQ ST 1)
[COND
((ILESSP C 0)
(PROGN (SETQ ST -1)
(SETQ C (IMINUS C]
(SETQ D (IQUOTIENT BETA (IPLUS C 1)))
(SETQ W (ITIMES SA ST))
[SETQ A (\BN.TIMES2 A (\BN.FROM.FIXP (ITIMES SA D]
[SETQ B (\BN.TIMES2 B (\BN.FROM.FIXP (ITIMES ST D]
(SETQ U A)
(SETQ L1 NIL)
[for I from 1 to (IPLUS K 1) do (PROGN (SETQ L1 (CONS U L1))
(SETQ U (CDR U]
(SETQ L2 L1)
(for I from 1 to (IDIFFERENCE N 2)
do (SETQ L2 (CONS U L2))
(SETQ U (CDR U)))
[COND
((NULL (CDR U))
(RPLACD U (CONS 0 NIL]
(SETQ U B)
(for I from 1 to (IDIFFERENCE N 2) do (SETQ U (CDR U)))
(SETQ B2 (CAR U))
(SETQ U (CDR U))
(SETQ B1 (CAR U))
L10 (SETQ U (CAR L2))
(SETQ A3 (CAR U))
(SETQ U (CDR U))
(SETQ A2 (CAR U))
(SETQ U (CDR U))
(SETQ A1 (CAR U))
(SETQ U (CDR U))
[COND
((IGEQ A1 B1)
(SETQ QHAT BETA1))
(T (SETQ QHAT (IQUOTIENT (IPLUS (ITIMES A1 BETA)
A2)
B1]
L12 (SETQ IP (\BN.IDIVIDE (ITIMES QHAT B1)
BETA))
(SETQ R1 (IDIFFERENCE A1 (CAR IP)))
(SETQ R2 (IDIFFERENCE A2 (CDR IP)))
[COND
((ILESSP R2 0)
(PROGN (SETQ R2 (IPLUS R2 BETA))
(SETQ R1 (IDIFFERENCE R1 1]
(COND
((IGREATERP R1 0)
(GO L13)))
(SETQ IP (\BN.IDIVIDE (ITIMES QHAT B2)
BETA))
(SETQ R1 (IDIFFERENCE R2 (CAR IP)))
(COND
((IGREATERP R1 0)
(GO L13)))
(SETQ R2 (IDIFFERENCE A3 (CDR IP)))
[COND
((OR (ILESSP R1 0)
(ILESSP R2 0))
(PROGN (SETQ QHAT (IDIFFERENCE QHAT 1))
(GO L12]
L13 (SETQ U (CAR L1))
(SETQ V B)
(SETQ C1 0)
L14 (SETQ E (IMINUS QHAT))
(SETQ IP (\BN.IDIVIDE (ITIMES E (CAR V))
BETA))
(SETQ V (CDR V))
(SETQ E (CAR IP))
(SETQ A1 (CAR U))
(SETQ IP (\BN.IDIVIDE (IPLUS C1 (IPLUS A1 (CDR IP)))
BETA))
(SETQ A1 (CDR IP))
(SETQ C1 (CAR IP))
[COND
((ILESSP A1 0)
(PROGN (SETQ A1 (IPLUS A1 BETA))
(SETQ C1 (IDIFFERENCE C1 1]
(SETQ C1 (IPLUS C1 E))
(RPLACA U A1)
(SETQ X U)
(SETQ U (CDR U))
(COND
(V (GO L14)))
(SETQ A1 (IPLUS (CAR U)
C1))
(SETQ U (CDR U))
(RPLACD X \BIG.0)
(COND
((EQ A1 0)
(GO L17)))
(SETQ U (CAR L1))
(SETQ V B)
(SETQ C1 0)
(SETQ QHAT (IDIFFERENCE QHAT 1))
L16 (SETQ A1 (CAR U))
(SETQ B1 (CAR V))
(SETQ V (CDR V))
(SETQ IP (\BN.IDIVIDE (IPLUS C1 (IPLUS A1 B1))
BETA))
(RPLACA U (CDR IP))
(SETQ U (CDR U))
(COND
(V (GO L16)))
L17 [COND
((OR (NEQ QHAT 0)
Q)
(SETQ Q (CONS (ITIMES W QHAT)
Q]
(SETQ L1 (CDR L1))
(SETQ U (CAR L2))
(SETQ L2 (CDR L2))
(COND
(L1 (GO L10)))
(RETURN (CONS Q (AND (NEQ FLG (QUOTE QUOTIENT))
(CAR (\BN.QRS A (ITIMES SA D])
(\BN.FLOAT
[LAMBDA (X) (* lmm "24-JUL-84 00:19")
(if (NULL X)
then 0.0
else (FPLUS (CAR X)
(FTIMES BETA (\BN.FLOAT (CDR X])
(\BN.IGNN
[LAMBDA (U) (* lmm "12-Apr-85 08:01")
(COND
((NULL U)
NIL)
((ILESSP U BETA)
(LIST U))
(T (PROG (Y)
(SETQ Y (IQUOTIENT U BETA))
(SETQ U (IDIFFERENCE U (ITIMES Y BETA)))
(RETURN (CONS U (\BN.FROM.FIXP Y])
(BIGNUM.DEFPRINT
[LAMBDA (BIGN STREAM) (* lmm "12-Jul-85 00:03")
(COND
((EQ BIGN MIN.INTEGER)
(CONS (CONCAT (CHARACTER \RADIX.PREFIX)
".")
(QUOTE MIN.INTEGER)))
((EQ BIGN MAX.INTEGER)
(CONS (CONCAT (CHARACTER \RADIX.PREFIX)
".")
(QUOTE MAX.INTEGER)))
(T (LET* ((RADIX (COND
(STREAM \PRINTRADIX)
(T 10)))
(ELS (fetch (BIGNUM ELEMENTS) of BIGN)))
(LET* ([TH (SELECTQ RADIX
(10 10000)
(8 4096)
(bind (TH ← RADIX)
NEWTH while (LEQ (SETQ NEWTH (TIMES TH RADIX))
BETA)
do (SETQ TH NEWTH) finally (RETURN TH]
(CHARS (\BN.TH2D (PROG (L B)
[while ELS do (PROGN (SETQ L (\BN.QRS ELS TH))
(SETQ ELS (CAR L))
(SETQ B (CONS (CDR L)
B]
(RETURN B))
RADIX TH)))
[if [AND STREAM (NEQ RADIX 10)
(CAR (NLSETQ (STKARG 3 (QUOTE \PRINDATUM]
then (if (EQ RADIX 8)
then (NCONC1 CHARS "Q")
else (push CHARS (SELECTQ RADIX
(8 "o")
(16 "x")
(2 "b")
(PROGN (push CHARS "r")
RADIX)))
(push CHARS (CHARACTER \RADIX.PREFIX]
(CONS (CONCATLIST CHARS])
(\BN.INTEGERLENGTH
[LAMBDA (X) (* lmm "22-JUL-84 19:19")
(if (NULL X)
then 0
elseif (CDR X)
then (IPLUS (CONSTANT (INTEGERLENGTH (SUB1 BETA)))
(\BN.INTEGERLENGTH (CDR X)))
else (INTEGERLENGTH (CAR X])
(\BN.LOGAND
[LAMBDA (B1 B2) (* lmm "20-Jul-84 11:13")
(COND
((NULL B1)
NIL)
((NULL B2)
NIL)
(T (PROG (B)
(SETQ B (\BN.LOGAND (CDR B1)
(CDR B2)))
(SETQ B1 (LOGAND (CAR B1)
(CAR B2)))
(COND
((AND (NULL B)
(EQ B1 0))
(RETURN B)))
(RETURN (CONS B1 B])
(\BN.LOGANDC2
[LAMBDA (B1 B2) (* lmm "21-Apr-85 12:43")
(COND
((NULL B1)
NIL)
((NULL B2)
B1)
(T (PROG (B)
(SETQ B (\BN.LOGANDC2 (CDR B1)
(CDR B2)))
[SETQ B1 (LOGAND (CAR B1)
(LOGNOT (CAR B2]
(COND
((AND (NULL B)
(EQ B1 0))
(RETURN B)))
(RETURN (CONS B1 B])
(\BN.LOGOR
[LAMBDA (B1 B2) (* lmm "21-JUL-84 23:57")
(COND
((NULL B1)
B2)
((NULL B2)
B1)
(T (CONS (LOGOR (CAR B1)
(CAR B2))
(\BN.LOGOR (CDR B1)
(CDR B2])
(\BN.LOGXOR
[LAMBDA (B1 B2) (* lmm "21-JUL-84 23:59")
(COND
((NULL B1)
B2)
((NULL B2)
B1)
(T (CONS (LOGXOR (CAR B1)
(CAR B2))
(\BN.LOGXOR (CDR B1)
(CDR B2])
(\BN.MINUS
[LAMBDA (U) (* lmm "20-JUL-84 01:34")
(COND
((NULL U)
NIL)
(T (CONS (IMINUS (CAR U))
(\BN.MINUS (CDR U])
(\BN.PLUS2
[LAMBDA (U V) (* lmm "20-JUL-84 02:03")
(COND
((NULL U)
V)
((NULL V)
U)
(T (PROG (L)
(SETQ L (IDIFFERENCE (FLENGTH U)
(FLENGTH V)))
[COND
[(ILESSP L 0)
(SETQ U (APPEND U (\BN.NZEROS (IDIFFERENCE 0 L]
((IGREATERP L 0)
(SETQ V (APPEND V (\BN.NZEROS L]
(RETURN (COND
((EQ (\BN.SIGN U)
(\BN.SIGN V))
(\BN.ISUM0 U V))
(T (\BN.ISUM1 U V])
(\BN.SIGN
[LAMBDA (U) (* lmm "20-JUL-84 02:22")
(COND
((NULL U)
0)
((IGREATERP (CAR U)
0)
1)
((ILESSP (CAR U)
0)
-1)
(T (\BN.SIGN (CDR U])
(\BN.TIMES2
[LAMBDA (U V) (* lmm "20-JUL-84 02:04")
(PROG (TAIL U1 W W1 W2 L C AP BP)
(COND
((OR (NULL U)
(NULL V))
(RETURN NIL)))
(SETQ TAIL (LIST 0 0))
(SETQ L (IPLUS (FLENGTH U)
(IDIFFERENCE (FLENGTH V)
2)))
(SETQ W TAIL)
(for I from 1 to L do (SETQ W (CONS 0 W)))
(SETQ W1 W)
A (SETQ U1 U)
(SETQ W2 W1)
(SETQ C 0)
B (SETQ AP (\BN.IDIVIDE (ITIMES (CAR U1)
(CAR V))
BETA))
(SETQ BP (\BN.IDIVIDE (IPLUS (CAR W2)
(IPLUS (CDR AP)
C))
BETA))
(RPLACA W2 (CDR BP))
(SETQ C (IPLUS (CAR AP)
(CAR BP)))
(SETQ W2 (CDR W2))
(SETQ U1 (CDR U1))
(COND
(U1 (GO B)))
(RPLACA W2 C)
(SETQ W1 (CDR W1))
(SETQ V (CDR V))
(COND
(V (GO A)))
(COND
((EQ C 0)
(RPLACD TAIL NIL)))
(RETURN W])
(\BN.COMPAREN
[LAMBDA (U V) (* lmm "12-Apr-85 08:33")
(PROG ((SU 0)
(SV 0)
(ST 0)
(S 0))
[COND
[(EQ (SETQ SU (\BN.SIGN U))
0)
(RETURN (IMINUS (\BN.SIGN V]
((EQ (SETQ SV (\BN.SIGN V))
0)
(RETURN SU))
((NEQ (SETQ S (IDIFFERENCE SU SV))
0)
(RETURN (COND
((IGREATERP S 0)
1)
((ILESSP S 0)
-1)
(T (SHOULDNT]
A (COND
((NEQ (SETQ ST (IDIFFERENCE (CAR U)
(CAR V)))
0)
(SETQ S ST)))
(SETQ V (CDR V))
(SETQ U (CDR U))
(COND
[(NULL U)
(RETURN (COND
(V (IMINUS SU))
(T (COND
((IGREATERP S 0)
1)
((ILESSP S 0)
-1)
(T 0]
(V (GO A))
(T (RETURN SU])
(\BN.D2TH
[LAMBDA (U) (* lmm "20-JUL-84 02:02")
(PROG (B S V BI M AI)
(COND
((NULL U)
(RETURN B)))
[COND
[(OR (EQ (CAR U)
(QUOTE +))
(EQ (CAR U)
(QUOTE -)))
(PROGN (SETQ S (CAR U))
(SETQ U (CDR U]
(T (SETQ S (QUOTE +]
(COND
((NULL U)
(RETURN B)))
(SETQ U (SETQ V (REVERSE U)))
L2 (SETQ BI 0)
(SETQ M 1)
[while (AND U (ILESSP M THETA)) do (PROGN (SETQ AI (CAR U))
(SETQ U (CDR U))
(SETQ BI (IPLUS (ITIMES AI M)
BI))
(SETQ M (ITIMES 10 M]
[COND
((EQ S (QUOTE -))
(SETQ BI (IMINUS BI]
(SETQ B (CONS BI B))
(COND
(U (GO L2)))
(RETURN B])
(\BN.FROM.FIXP
[LAMBDA (U) (* lmm "12-Apr-85 08:22")
(COND
((type? BIGNUM U)
(if (OR (EQ U MIN.INTEGER)
(EQ U MAX.INTEGER))
then (ERROR "Can't do arithmetic with " U)
else (fetch ELEMENTS of U)))
((OR (NULL U)
(EQ U 0))
NIL)
((LISTP U)
U)
[(ILESSP U 0)
(if (EQUAL U MIN.FIXP)
then (\BN.DIFFERENCE (\BN.FROM.FIXP (IPLUS U THETA))
(\BN.FROM.FIXP THETA))
else (\BN.MINUS (\BN.IGNN (IMINUS U]
(T (\BN.IGNN U])
(\BN.ICANON
[LAMBDA (U SIGN) (* lmm "21-Apr-85 13:47")
(PROG ((U0 U)
U1
(CARRY 0)
B)
A (SETQ B (IPLUS (CAR U)
CARRY))
(SETQ CARRY (COND
((AND (IGREATERP SIGN 0)
(ILESSP B 0))
-1)
((AND (ILESSP SIGN 0)
(IGREATERP B 0))
1)
(T 0)))
(SETQ B (IDIFFERENCE B (ITIMES CARRY BETA)))
(RPLACA U B)
(if (NEQ B 0)
then (SETQ U1 U))
B (COND
((SETQ U (CDR U))
(GO A)))
(RETURN U0])
(\BN.IDIVIDE
[LAMBDA (A B) (* lmm "20-JUL-84 01:37")
(CONS (IQUOTIENT A B)
(IREMAINDER A B])
(\BN.ISUM0
[LAMBDA (U V) (* lmm "21-Apr-85 13:19")
(PROG ((CARRY 0)
RES BP)
A (SETQ BP (\BN.IDIVIDE (IPLUS (CAR U)
(IPLUS (CAR V)
CARRY))
BETA))
(SETQ CARRY (CAR BP))
(SETQ RES (CONS (CDR BP)
RES))
(SETQ U (CDR U))
(SETQ V (CDR V))
(COND
(V (GO A)))
[COND
((NEQ CARRY 0)
(SETQ RES (CONS CARRY RES]
(RETURN (REVERSE RES])
(\BN.ISUM1
[LAMBDA (U V) (* lmm "20-JUL-84 02:22")
(PROG (C S RES)
(SETQ C 0)
(SETQ S 0)
A (SETQ C (IPLUS (CAR U)
(CAR V)))
(COND
((NEQ C 0)
(SETQ S C)))
(SETQ RES (CONS C RES))
(SETQ U (CDR U))
(SETQ V (CDR V))
(COND
(V (GO A)))
(RETURN (COND
((EQ S 0)
NIL)
(T (\BN.ICANON (DREVERSE RES)
(COND
((ILESSP S 0)
-1)
(T 1])
(\BN.MADD
[LAMBDA (A B C) (* lmm "20-JUL-84 01:59")
(PROG (H TT TTT IP IPP)
(SETQ TT A)
(SETQ H 0)
L2 (SETQ IP (\BN.IDIVIDE (ITIMES B (CAR TT))
BETA))
(SETQ IPP (\BN.IDIVIDE (IPLUS C (IPLUS (CDR IP)
H))
BETA))
(RPLACA TT (CDR IPP))
(SETQ H (CAR IP))
(SETQ C (CAR IPP))
(SETQ TTT TT)
(SETQ TT (CDR TT))
(COND
(TT (GO L2)))
(SETQ C (IPLUS C H))
(COND
((EQ C 0)
(RETURN A)))
(RPLACD TTT (CONS C (CDR TTT)))
(RETURN A])
(\BN.TO.FIXP
[LAMBDA (X) (* lmm "12-Apr-85 08:01")
(COND
[X (COND
((OR (EQ (\BN.COMPAREN X (CONSTANT (\BN.FROM.FIXP MAX.FIXP)))
1)
(EQ (\BN.COMPAREN X (CONSTANT (\BN.FROM.FIXP MIN.FIXP)))
-1))
(create BIGNUM
ELEMENTS ← X))
(T (\BIGNUM.TO.INT X]
(T 0])
(\BN.NZEROS
[LAMBDA (N) (* lmm "20-JUL-84 02:30")
(for I from 1 to N collect 0])
(\BN.QRS
[LAMBDA (B I) (* lmm "20-JUL-84 01:58")
(PROG (D CP C1 C2)
[COND
((NULL B)
(RETURN (CONS B 0]
(COND
((EQ I 0)
(ERROR " QRS DIV BY 0 ")))
(SETQ B (REVERSE B))
(SETQ C1 0)
A (SETQ C2 (CAR B))
(SETQ CP (\BN.IDIVIDE (IPLUS (ITIMES C1 BETA)
C2)
I))
[COND
((OR D (NOT (EQ (CAR CP)
0)))
(SETQ D (CONS (CAR CP)
D]
(SETQ B (CDR B))
(SETQ C1 (CDR CP))
[COND
((NULL B)
(RETURN (CONS D C1]
(GO A])
(\BN.SIGN
[LAMBDA (U) (* lmm "20-JUL-84 02:22")
(COND
((NULL U)
0)
((IGREATERP (CAR U)
0)
1)
((ILESSP (CAR U)
0)
-1)
(T (\BN.SIGN (CDR U])
(\BN.TH2B
[LAMBDA (U) (* lmm "20-JUL-84 01:35")
(PROG (AI B)
(COND
((NULL U)
(RETURN B)))
(SETQ AI (CAR U))
(SETQ U (CDR U))
(SETQ B (CONS AI B))
[while U do (PROGN (SETQ AI (CAR U))
(SETQ U (CDR U))
(SETQ B (\BN.MADD B THETA AI]
(RETURN B])
(\BN.TH2D
[LAMBDA (A RADIX TH) (* lmm "23-Jun-85 14:35")
(OR RADIX (SETQ RADIX 10)) (* lmm "20-JUL-84 02:03")
(PROG (B M S AI BI)
[COND
((NULL A)
(RETURN (LIST 0]
(SETQ S (CAR A))
L2 (COND
((NULL A)
(GO L4)))
(SETQ AI (CAR A))
(SETQ A (CDR A))
(SETQ M (IQUOTIENT TH RADIX))
L3 (SETQ BI (IQUOTIENT AI M))
(SETQ AI (IDIFFERENCE AI (ITIMES BI M)))
[COND
((OR B (NOT (EQ BI 0)))
(SETQ B (CONS (if (GEQ (SETQ BI (ABS BI))
10)
then (CHARACTER (PLUS (CHARCODE A)
(DIFFERENCE BI 10)))
else BI)
B]
(SETQ M (IQUOTIENT M RADIX))
(COND
((NOT (EQ M 0))
(GO L3)))
(GO L2)
L4 [COND
((IGREATERP S 0)
(SETQ B (REVERSE B)))
(T (SETQ B (CONS (QUOTE -)
(REVERSE B]
(RETURN B])
)
(DEFINEQ
(\INITBIGNUMS
[LAMBDA NIL (* lmm "12-Apr-85 08:13")
(SETQ \BIG.0 (\BN.FROM.FIXP 0))
(SETQ \BIG.1 (\BN.FROM.FIXP 1))
(SETQ MIN.INTEGER (create BIGNUM
ELEMENTS ←(QUOTE MIN.INTEGER)))
(SETQ MAX.INTEGER (create BIGNUM
ELEMENTS ←(QUOTE MAX.INTEGER)))
(\SETTYPEMASK (\TYPENUMBERFROMNAME (QUOTE BIGNUM))
(LOGOR \TT.FIXP \TT.NUMBERP \TT.ATOM])
)
(* MAKERATIONAL needs work)
(* needs work: MASK.1'S MASK.0'S BITTEST BITSET BITCLEAR LOGNOT LOADBYTE DEPOSITBYTE IMODLESSP
IMODPLUS IMODDIFFERENCE ROT)
(\INITBIGNUMS)
(PUTPROPS LLBIGNUM COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2250 6313 (\BIGNUM.COMPARE 2260 . 2724) (\BIGNUM.DIFFERENCE 2726 . 2931) (
\BIGNUM.INTEGERLENGTH 2933 . 3100) (\BIGNUM.LOGAND 3102 . 3692) (\BIGNUM.LOGOR 3694 . 4112) (
\BIGNUM.LOGXOR 4114 . 4569) (\BIGNUM.PLUS 4571 . 4767) (\FORCEBIGNUM 4769 . 5007) (\BIGNUM.LSH 5009 .
5445) (\BIGNUM.TIMES 5447 . 5646) (\BIGNUM.QUOTIENT 5648 . 5857) (\BIGNUM.REMAINDER 5859 . 6069) (
\BIGNUM.TO.FLOAT 6071 . 6311)) (6345 27448 (\BIGNUM.TO.INT 6355 . 6614) (\BN.2TH 6616 . 6927) (\BN.ABS
6929 . 7126) (\BN.DIFFERENCE 7128 . 7278) (\BN.DIVIDE 7280 . 12324) (\BN.FLOAT 12326 . 12557) (
\BN.IGNN 12559 . 12928) (BIGNUM.DEFPRINT 12930 . 14409) (\BN.INTEGERLENGTH 14411 . 14752) (\BN.LOGAND
14754 . 15214) (\BN.LOGANDC2 15216 . 15687) (\BN.LOGOR 15689 . 15980) (\BN.LOGXOR 15982 . 16278) (
\BN.MINUS 16280 . 16505) (\BN.PLUS2 16507 . 17100) (\BN.SIGN 17102 . 17372) (\BN.TIMES2 17374 . 18639)
(\BN.COMPAREN 18641 . 19615) (\BN.D2TH 19617 . 20646) (\BN.FROM.FIXP 20648 . 21287) (\BN.ICANON 21289
. 21949) (\BN.IDIVIDE 21951 . 22117) (\BN.ISUM0 22119 . 22724) (\BN.ISUM1 22726 . 23369) (\BN.MADD
23371 . 24141) (\BN.TO.FIXP 24143 . 24554) (\BN.NZEROS 24556 . 24713) (\BN.QRS 24715 . 25489) (
\BN.SIGN 25491 . 25761) (\BN.TH2B 25763 . 26233) (\BN.TH2D 26235 . 27446)) (27449 27951 (\INITBIGNUMS
27459 . 27949)))))
STOP