(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