(FILECREATED "15-Apr-86 17:18:33" {ERIS}<LISPCORE>SOURCES>LLBIGNUM.;14 33019
changes to: (VARS LLBIGNUMCOMS)
(FNS BIGNUM.DEFPRINT \BN.TH2D)
previous date: " 9-Jan-86 15:35:54" {ERIS}<LISPCORE>SOURCES>LLBIGNUM.;12)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LLBIGNUMCOMS)
(RPAQQ LLBIGNUMCOMS
[(COMS (DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
APRINT)
(RECORDS BIGNUM))
(INITRECORDS BIGNUM)
(CONSTANTS \BIGNUM.THETA (\BIGNUM.BETA (EXPT 2 14))
(\BIGNUM.BETA1 (SUB1 \BIGNUM.BETA)))
[DECLARE: EVAL@COMPILE (ADDVARS (CHARACTERNAMES (INFINITY 8551]
(ADDVARS (GLOBALVARS MIN.INTEGER MAX.INTEGER \BIG.0 \BIG.1)))
(COMS (* entries)
(FNS \BIGNUM.COMPARE \BIGNUM.DIFFERENCE \BIGNUM.INTEGERLENGTH \BIGNUM.LOGAND
\BIGNUM.LOGOR \BIGNUM.LOGXOR \BIGNUM.PLUS \BIGNUM.LSH \BIGNUM.TIMES
\BIGNUM.QUOTIENT \BIGNUM.REMAINDER \BIGNUM.TO.FLOAT))
(COMS (* 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))
(COMS (FNS \INITBIGNUMS)
(* MAKERATIONAL needs work)
(* needs work: MASK.1'S MASK.0'S BITTEST BITSET BITCLEAR LOGNOT LOADBYTE DEPOSITBYTE
IMODLESSP IMODPLUS IMODDIFFERENCE ROT)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\INITBIGNUMS])
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
APRINT)
[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))
(DECLARE: EVAL@COMPILE
(RPAQQ \BIGNUM.THETA 10000)
(RPAQ \BIGNUM.BETA (EXPT 2 14))
(RPAQ \BIGNUM.BETA1 (SUB1 \BIGNUM.BETA))
(CONSTANTS \BIGNUM.THETA (\BIGNUM.BETA (EXPT 2 14))
(\BIGNUM.BETA1 (SUB1 \BIGNUM.BETA)))
)
(DECLARE: EVAL@COMPILE
(ADDTOVAR CHARACTERNAMES (INFINITY 8551))
)
(ADDTOVAR GLOBALVARS MIN.INTEGER MAX.INTEGER \BIG.0 \BIG.1)
(* entries)
(DEFINEQ
(\BIGNUM.COMPARE
[LAMBDA (X Y) (* lmm "15-Apr-85 17:36")
(COND
((EQ X MIN.INTEGER)
(COND
((EQ Y MIN.INTEGER)
0)
(T -1)))
((EQ X MAX.INTEGER)
(COND
((EQ Y MAX.INTEGER)
0)
(T 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")
(COND
((OR (EQ X 0)
(EQ Y 0))
0)
[(LESSP Y 0)
(COND
[(LESSP X 0)
(LOGNOT (LOGOR (LOGNOT X)
(LOGNOT Y]
(T (\BN.TO.FIXP (\BN.LOGANDC2 (\BN.FROM.FIXP X)
(\BN.FROM.FIXP (LOGNOT Y]
((LESSP X 0)
(\BIGNUM.LOGAND Y X))
(T (\BN.TO.FIXP (\BN.LOGAND (\BN.FROM.FIXP X)
(\BN.FROM.FIXP Y])
(\BIGNUM.LOGOR
[LAMBDA (X Y) (* lmm "21-Apr-85 12:39")
(COND
((EQ X 0)
Y)
((EQ Y 0)
X)
[(AND (GREATERP X 0)
(GREATERP Y 0))
(\BN.TO.FIXP (\BN.LOGOR (\BN.FROM.FIXP X)
(\BN.FROM.FIXP Y]
(T (LOGNOT (LOGAND (LOGNOT X)
(LOGNOT Y])
(\BIGNUM.LOGXOR
[LAMBDA (X Y) (* lmm "21-Apr-85 13:00")
(COND
((OR (LESSP X 0)
(LESSP Y 0)) (* stupid dumb but working definition)
(\BIGNUM.DIFFERENCE (\BIGNUM.LOGOR X Y)
(\BIGNUM.LOGAND X Y)))
(T (\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])
(\BIGNUM.LSH
[LAMBDA (X N) (* lmm "12-Apr-85 08:36")
(COND
((IGEQ N 0)
(\BIGNUM.TIMES X (EXPT 2 N)))
[(IGREATERP X 0)
(\BIGNUM.QUOTIENT X (EXPT 2 (IMINUS N]
(T (* 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 " 9-Jan-86 15:30")
(COND
((NULL (CDR X))
(CAR X))
(T (IPLUS (CAR X)
(ITIMES \BIGNUM.BETA (\BIGNUM.TO.INT (CDR X])
(\BN.2TH
[LAMBDA (A) (* lmm " 9-Jan-86 15:31")
(PROG (L B)
[while A do (PROGN (SETQ L (\BN.QRS A \BIGNUM.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 " 9-Jan-86 15:33")
(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 \BIGNUM.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 \BIGNUM.BETA1))
(T (SETQ QHAT (IQUOTIENT (IPLUS (ITIMES A1 \BIGNUM.BETA)
A2)
B1]
L12 (SETQ IP (\BN.IDIVIDE (ITIMES QHAT B1)
\BIGNUM.BETA))
(SETQ R1 (IDIFFERENCE A1 (CAR IP)))
(SETQ R2 (IDIFFERENCE A2 (CDR IP)))
[COND
((ILESSP R2 0)
(PROGN (SETQ R2 (IPLUS R2 \BIGNUM.BETA))
(SETQ R1 (IDIFFERENCE R1 1]
(COND
((IGREATERP R1 0)
(GO L13)))
(SETQ IP (\BN.IDIVIDE (ITIMES QHAT B2)
\BIGNUM.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))
\BIGNUM.BETA))
(SETQ V (CDR V))
(SETQ E (CAR IP))
(SETQ A1 (CAR U))
(SETQ IP (\BN.IDIVIDE (IPLUS C1 (IPLUS A1 (CDR IP)))
\BIGNUM.BETA))
(SETQ A1 (CDR IP))
(SETQ C1 (CAR IP))
[COND
((ILESSP A1 0)
(PROGN (SETQ A1 (IPLUS A1 \BIGNUM.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))
\BIGNUM.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 " 9-Jan-86 15:30")
(COND
((NULL X)
0.0)
(T (FPLUS (CAR X)
(FTIMES \BIGNUM.BETA (\BN.FLOAT (CDR X])
(\BN.IGNN
[LAMBDA (U) (* lmm " 9-Jan-86 15:30")
(COND
((NULL U)
NIL)
((ILESSP U \BIGNUM.BETA)
(LIST U))
(T (PROG (Y)
(SETQ Y (IQUOTIENT U \BIGNUM.BETA))
(SETQ U (IDIFFERENCE U (ITIMES Y \BIGNUM.BETA)))
(RETURN (CONS U (\BN.FROM.FIXP Y])
(BIGNUM.DEFPRINT
[LAMBDA (BIGN STREAM RDTBL) (* bvm: "15-Apr-86 12:52")
(COND
[(OR (EQ BIGN MIN.INTEGER)
(EQ BIGN MAX.INTEGER)) (* Distinguished integers
smaller/larger than any others.
Print using "evaluate at read time"
syntax)
(CONS (COND
(RDTBL (CONCAT (CHARACTER (fetch (READTABLEP HASHMACROCHAR) of RDTBL))
"."))
(T "#."))
(COND
((EQ BIGN MIN.INTEGER)
(QUOTE MIN.INTEGER))
(T (QUOTE MAX.INTEGER]
(T (LET* ((RADIX (COND
((AND (PNAMESTREAMP STREAM)
(NOT PRXFLG))
(* The pname of a number is unaffected by RADIX unless PRXFLG is true.
Changing this for bignums probably wouldn't break anything, but we might as
well be consistent)
10)
(T \PRINTRADIX)))
[TH (SELECTQ RADIX
(10 10000)
(8 4096)
(bind (TH ← RADIX)
NEWTH while (LEQ (SETQ NEWTH (TIMES TH RADIX))
\BIGNUM.BETA) do (SETQ TH NEWTH)
finally (RETURN TH]
(CHARS (\BN.TH2D (bind (ELS ←(fetch (BIGNUM ELEMENTS) of BIGN))
L B while ELS do (SETQ L (\BN.QRS ELS TH))
(SETQ ELS (CAR L))
(SETQ B (CONS (CDR L)
B)) finally (RETURN B))
RADIX TH)))
[COND
((AND RDTBL (NEQ RADIX 10)) (* need radix qualifier)
(COND
((AND (EQ RADIX 8)
(NOT (fetch (READTABLEP COMMONLISP) of RDTBL)))
(NCONC1 CHARS (CHARCODE Q)))
(T [push CHARS (SELECTQ RADIX
(8 (CHARCODE o))
(16 (CHARCODE x))
(2 (CHARCODE b))
(PROGN (push CHARS (CHARCODE r))
[COND
((IGEQ RADIX 10)
(push CHARS (IPLUS (CHARCODE 0)
(IMOD RADIX 10)))
(SETQ RADIX (IQUOTIENT RADIX 10]
(IPLUS RADIX (CHARCODE 0]
(push CHARS (fetch (READTABLEP HASHMACROCHAR) of RDTBL]
(.SPACECHECK. STREAM (LENGTH CHARS))
(for C in CHARS do (\OUTCHAR STREAM C)) (* Return T to show we have done it
ourselves)
T])
(\BN.INTEGERLENGTH
[LAMBDA (X) (* lmm " 9-Jan-86 15:30")
(COND
((NULL X)
0)
[(CDR X)
(IPLUS (CONSTANT (INTEGERLENGTH (SUB1 \BIGNUM.BETA)))
(\BN.INTEGERLENGTH (CDR X]
(T (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 " 9-Jan-86 15:30")
(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))
\BIGNUM.BETA))
(SETQ BP (\BN.IDIVIDE (IPLUS (CAR W2)
(IPLUS (CDR AP)
C))
\BIGNUM.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 " 9-Jan-86 15:31")
(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 \BIGNUM.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 " 9-Jan-86 15:31")
(COND
[(type? BIGNUM U)
(COND
((OR (EQ U MIN.INTEGER)
(EQ U MAX.INTEGER))
(ERROR "Can't do arithmetic with " U))
(T (fetch ELEMENTS of U]
((OR (NULL U)
(EQ U 0))
NIL)
((LISTP U)
U)
[(ILESSP U 0)
(COND
((EQUAL U MIN.FIXP)
(\BN.DIFFERENCE (\BN.FROM.FIXP (IPLUS U \BIGNUM.THETA))
(\BN.FROM.FIXP \BIGNUM.THETA)))
(T (\BN.MINUS (\BN.IGNN (IMINUS U]
(T (\BN.IGNN U])
(\BN.ICANON
[LAMBDA (U SIGN) (* lmm " 9-Jan-86 15:30")
(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 \BIGNUM.BETA)))
(RPLACA U B)
(COND
((NEQ B 0)
(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 " 9-Jan-86 15:30")
(PROG ((CARRY 0)
RES BP)
A (SETQ BP (\BN.IDIVIDE (IPLUS (CAR U)
(IPLUS (CAR V)
CARRY))
\BIGNUM.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 " 9-Jan-86 15:30")
(PROG (H TT TTT IP IPP)
(SETQ TT A)
(SETQ H 0)
L2 (SETQ IP (\BN.IDIVIDE (ITIMES B (CAR TT))
\BIGNUM.BETA))
(SETQ IPP (\BN.IDIVIDE (IPLUS C (IPLUS (CDR IP)
H))
\BIGNUM.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 " 9-Jan-86 15:30")
(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 \BIGNUM.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 " 9-Jan-86 15:31")
(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 \BIGNUM.THETA AI]
(RETURN B])
(\BN.TH2D
[LAMBDA (A RADIX TH) (* bvm: "15-Apr-86 14:28")
(* * A is a list of integers obtained by repeatedly dividing some bignum by TH,
which is a power of RADIX, hopefully chosen to keep the integers small.
The elements of A concatenated thus make up the print name of the bignum in the
indicated RADIX. Convert the list to a series of character codes by computing
the print names of each subpart)
(OR RADIX (SETQ RADIX 10))
(COND
((NULL A)
(LIST (CHARCODE 0)))
(T (for AI in A bind (MAXFACTOR ←(IQUOTIENT TH RADIX))
DIGIT RESULT
do [for (M ← MAXFACTOR) by (IQUOTIENT M RADIX) repeatuntil (EQ M 1)
do (SETQ DIGIT (IQUOTIENT AI M))
(SETQ AI (IDIFFERENCE AI (ITIMES DIGIT M)))
(COND
((OR RESULT (NEQ DIGIT 0))
(push RESULT (COND
((GEQ (SETQ DIGIT (ABS DIGIT))
10) (* Use alphabetics for digits greater
than 9)
(IPLUS (IDIFFERENCE DIGIT 10)
(CHARCODE A)))
(T (IPLUS DIGIT (CHARCODE 0]
finally (RETURN (COND
((IGREATERP (CAR A)
0)
(REVERSE RESULT))
(T (* Negative bignum)
(CONS (CHARCODE -)
(REVERSE RESULT])
)
(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)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\INITBIGNUMS)
)
(PUTPROPS LLBIGNUM COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2889 6901 (\BIGNUM.COMPARE 2899 . 3404) (\BIGNUM.DIFFERENCE 3406 . 3634) (
\BIGNUM.INTEGERLENGTH 3636 . 3807) (\BIGNUM.LOGAND 3809 . 4428) (\BIGNUM.LOGOR 4430 . 4852) (
\BIGNUM.LOGXOR 4854 . 5322) (\BIGNUM.PLUS 5324 . 5541) (\BIGNUM.LSH 5543 . 5963) (\BIGNUM.TIMES 5965
. 6184) (\BIGNUM.QUOTIENT 6186 . 6418) (\BIGNUM.REMAINDER 6420 . 6653) (\BIGNUM.TO.FLOAT 6655 . 6899)
) (6933 32203 (\BIGNUM.TO.INT 6943 . 7199) (\BN.2TH 7201 . 7565) (\BN.ABS 7567 . 7776) (\BN.DIFFERENCE
7778 . 7932) (\BN.DIVIDE 7934 . 12836) (\BN.FLOAT 12838 . 13074) (\BN.IGNN 13076 . 13466) (
BIGNUM.DEFPRINT 13468 . 17053) (\BN.INTEGERLENGTH 17055 . 17368) (\BN.LOGAND 17370 . 17910) (
\BN.LOGANDC2 17912 . 18461) (\BN.LOGOR 18463 . 18780) (\BN.LOGXOR 18782 . 19102) (\BN.MINUS 19104 .
19326) (\BN.PLUS2 19328 . 20066) (\BN.SIGN 20068 . 20357) (\BN.TIMES2 20359 . 21702) (\BN.COMPAREN
21704 . 22997) (\BN.D2TH 22999 . 24201) (\BN.FROM.FIXP 24203 . 24899) (\BN.ICANON 24901 . 25701) (
\BN.IDIVIDE 25703 . 25868) (\BN.ISUM0 25870 . 26531) (\BN.ISUM1 26533 . 27270) (\BN.MADD 27272 . 28051
) (\BN.TO.FIXP 28053 . 28530) (\BN.NZEROS 28532 . 28693) (\BN.QRS 28695 . 29502) (\BN.SIGN 29504 .
29793) (\BN.TH2B 29795 . 30266) (\BN.TH2D 30268 . 32201)) (32204 32717 (\INITBIGNUMS 32214 . 32715))))
)
STOP