(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED "16-May-90 20:46:21" {DSK}<usr>local>lde>lispcore>sources>MODARITH.;2
 5852   

      changes to%:  (VARS MODARITHCOMS)

      previous date%: " 2-Nov-86 17:42:53" {DSK}<usr>local>lde>lispcore>sources>MODARITH.;1)


(* ; "
Copyright (c) 1982, 1983, 1984, 1986, 1990 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT MODARITHCOMS)

(RPAQQ MODARITHCOMS

       (
        (* ;; "The intent, as of Feb 1983, is to move most of these macros into the system under real or CommonLisp names, and to move the various CONSTANTS into some arithmetic package.")


        (ADDVARS * (LIST (CONS 'EXPANDMACROFNS MODARITHMACROS)))
        (EXPORT (MACROS * MODARITHMACROS)
               (CONSTANTS BITSPERNIBBLE NIBBLESPERBYTE BITSPERBYTE BITSPERCELL BITSPERWORD 
                      BYTESPERCELL BYTESPERPAGE BYTESPERWORD CELLSPERPAGE CELLSPERSEGMENT 
                      PAGESPERSEGMENT WORDSPERCELL WORDSPERPAGE WORDSPERSEGMENT WORDSPERQUAD 
                      CELLSPERQUAD BYTESPERQUAD)
               (CONSTANTS * INTEGERSIZECONSTANTS))))



(* ;; 
"The intent, as of Feb 1983, is to move most of these macros into the system under real or CommonLisp names, and to move the various CONSTANTS into some arithmetic package."
)



(ADDTOVAR EXPANDMACROFNS
 CEIL FLOOR FOLDHI FOLDLO MODUP UNFOLD MOD)
(* "FOLLOWING DEFINITIONS EXPORTED")


(RPAQQ MODARITHMACROS
 (CEIL FLOOR FOLDHI FOLDLO MODUP UNFOLD MOD))
(DECLARE%: EVAL@COMPILE 

(PUTPROPS CEIL
 MACRO
 ((X N)
                              (FLOOR (IPLUS X (CONSTANT (SUB1 N)))
                                     N)))

(PUTPROPS FLOOR
 MACRO
 [(X N)
                               (LOGAND X (CONSTANT (LOGXOR (SUB1 N)
                                                          -1])

(PUTPROPS FOLDHI
 MACRO
 [X (PROG [(FORM (CAR X))
                                         (DIVISOR (CAR (CONSTANTEXPRESSIONP (CADR X]
                                        (OR (AND DIVISOR (POWEROFTWOP DIVISOR))
                                            (\ILLEGAL.ARG (CADR X)))
                                        (RETURN (LIST 'LRSH (LIST 'IPLUS FORM (SUB1 DIVISOR))
                                                      (SUB1 (INTEGERLENGTH DIVISOR])

(PUTPROPS FOLDLO
 MACRO
 [X (PROG [(FORM (CAR X))
                                         (DIVISOR (CAR (CONSTANTEXPRESSIONP (CADR X]
                                        (OR (AND DIVISOR (POWEROFTWOP DIVISOR))
                                            (\ILLEGAL.ARG (CADR X)))
                                        (RETURN (LIST 'LRSH FORM (SUB1 (INTEGERLENGTH DIVISOR])

(PUTPROPS MODUP
 MACRO
 (OPENLAMBDA (X N)
                                     (IDIFFERENCE (SUB1 N)
                                            (IMOD (SUB1 X)
                                                  N))))

(PUTPROPS UNFOLD
 MACRO
 [X (PROG [(FORM (CAR X))
                                         (DIVISOR (CAR (CONSTANTEXPRESSIONP (CADR X]
                                        (OR (AND DIVISOR (POWEROFTWOP DIVISOR))
                                            (\ILLEGAL.ARG (CADR X)))
                                        (RETURN (LIST 'LLSH FORM (SUB1 (INTEGERLENGTH DIVISOR])

(PUTPROPS MOD
 MACRO
 (= . IMOD))
)
(DECLARE%: EVAL@COMPILE 

(RPAQQ BITSPERNIBBLE
 4)

(RPAQQ NIBBLESPERBYTE
 2)

(RPAQQ BITSPERBYTE
 8)

(RPAQQ BITSPERCELL
 32)

(RPAQQ BITSPERWORD
 16)

(RPAQQ BYTESPERCELL
 4)

(RPAQQ BYTESPERPAGE
 512)

(RPAQQ BYTESPERWORD
 2)

(RPAQQ CELLSPERPAGE
 128)

(RPAQQ CELLSPERSEGMENT
 32768)

(RPAQQ PAGESPERSEGMENT
 256)

(RPAQQ WORDSPERCELL
 2)

(RPAQQ WORDSPERPAGE
 256)

(RPAQQ WORDSPERSEGMENT
 65536)

(RPAQQ WORDSPERQUAD
 4)

(RPAQQ CELLSPERQUAD
 2)

(RPAQQ BYTESPERQUAD
 8)


(CONSTANTS BITSPERNIBBLE NIBBLESPERBYTE BITSPERBYTE BITSPERCELL BITSPERWORD BYTESPERCELL BYTESPERPAGE
       BYTESPERWORD CELLSPERPAGE CELLSPERSEGMENT PAGESPERSEGMENT WORDSPERCELL WORDSPERPAGE 
       WORDSPERSEGMENT WORDSPERQUAD CELLSPERQUAD BYTESPERQUAD)
)

(RPAQQ INTEGERSIZECONSTANTS

       ((BITS.PER.SMALLP (ADD1 BITSPERWORD))
        (SMALLP.LENGTH (SUB1 BITS.PER.SMALLP))
        [MAX.SMALLP (LOGOR (LSH 1 (SUB1 SMALLP.LENGTH))
                           (SUB1 (LSH 1 (SUB1 SMALLP.LENGTH]
        (MIN.SMALLP (IDIFFERENCE -1 MAX.SMALLP))
        (BITS.PER.FIXP BITSPERCELL)
        (FIXP.LENGTH (SUB1 BITS.PER.FIXP))
        [MAX.FIXP (LOGOR (LSH 1 (SUB1 FIXP.LENGTH))
                         (SUB1 (LSH 1 (SUB1 FIXP.LENGTH]
        (MIN.FIXP (IDIFFERENCE -1 MAX.FIXP))))
(DECLARE%: EVAL@COMPILE 

(RPAQ BITS.PER.SMALLP
 (ADD1 BITSPERWORD))

(RPAQ SMALLP.LENGTH
 (SUB1 BITS.PER.SMALLP))

(RPAQ MAX.SMALLP
 [LOGOR (LSH 1 (SUB1 SMALLP.LENGTH))
                            (SUB1 (LSH 1 (SUB1 SMALLP.LENGTH])

(RPAQ MIN.SMALLP
 (IDIFFERENCE -1 MAX.SMALLP))

(RPAQ BITS.PER.FIXP
 BITSPERCELL)

(RPAQ FIXP.LENGTH
 (SUB1 BITS.PER.FIXP))

(RPAQ MAX.FIXP
 [LOGOR (LSH 1 (SUB1 FIXP.LENGTH))
                          (SUB1 (LSH 1 (SUB1 FIXP.LENGTH])

(RPAQ MIN.FIXP
 (IDIFFERENCE -1 MAX.FIXP))


(CONSTANTS (BITS.PER.SMALLP (ADD1 BITSPERWORD))
       (SMALLP.LENGTH (SUB1 BITS.PER.SMALLP))
       [MAX.SMALLP (LOGOR (LSH 1 (SUB1 SMALLP.LENGTH))
                          (SUB1 (LSH 1 (SUB1 SMALLP.LENGTH]
       (MIN.SMALLP (IDIFFERENCE -1 MAX.SMALLP))
       (BITS.PER.FIXP BITSPERCELL)
       (FIXP.LENGTH (SUB1 BITS.PER.FIXP))
       [MAX.FIXP (LOGOR (LSH 1 (SUB1 FIXP.LENGTH))
                        (SUB1 (LSH 1 (SUB1 FIXP.LENGTH]
       (MIN.FIXP (IDIFFERENCE -1 MAX.FIXP)))
)

(* "END EXPORTED DEFINITIONS")

(PUTPROPS MODARITH COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1986 1990))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL)))
STOP