(FILECREATED "11-JUN-83 21:06:44" {PHYLUM}<LISPCORE>SOURCES>MODARITH.;10
 5947   

      changes to:  (MACROS SIGNED)

      previous date: "16-FEB-83 19:44:28" {PHYLUM}<LISPCORE>SOURCES>MODARITH.;9)


(* Copyright (c) 1982, 1983 by Xerox Corporation)

(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 (QUOTE EXPANDMACROFNS)
			       MODARITHMACROS)))
	(EXPORT (MACROS * MODARITHMACROS)
		(CONSTANTS BITSPERNIBBLE NIBBLESPERBYTE BITSPERBYTE BITSPERCELL BITSPERWORD 
			   BYTESPERCELL BYTESPERPAGE BYTESPERWORD CELLSPERPAGE CELLSPERSEGMENT 
			   PAGESPERSEGMENT WORDSPERCELL WORDSPERPAGE WORDSPERSEGMENT WORDSPERQUAD 
			   CELLSPERQUAD BYTESPERQUAD)
		(CONSTANTS BITSPERHALFWORD MASKHALFWORD1'S MASKWORD1'S MASK1WORD0'S MASK0WORD1'S)
		(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 UNSIGNED SIGNED MOD)
(* FOLLOWING DEFINITIONS EXPORTED)



(RPAQQ MODARITHMACROS
 (CEIL FLOOR FOLDHI FOLDLO MODUP UNFOLD UNSIGNED SIGNED 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 (QUOTE LRSH)
					      (LIST (QUOTE 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 (QUOTE 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 (QUOTE LLSH)
					      FORM
					      (SUB1 (INTEGERLENGTH DIVISOR])

(PUTPROPS UNSIGNED MACRO
 [(X WIDTH)
			  (LOGAND X (CONSTANT (SUB1 (LLSH 1 WIDTH])

(PUTPROPS SIGNED MACRO
 ((N WIDTH)
			([LAMBDA (X)
			    (DECLARE
 (LOCALVARS . T))
			    (COND
			      [[IGREATERP X (CONSTANT (SUB1 (LLSH 1 (SUB1 WIDTH]
				(SUB1 (IDIFFERENCE X (CONSTANT (SUB1 (LLSH 1 WIDTH]
			      (T X]
			  N)))

(PUTPROPS SIGNED BYTEMACRO
 [ARGS (COND (EFF (CAR ARGS))
				       (T (BQUOTE ([LAMBDA
						     (X)
						     (DECLARE (LOCALVARS . T))
						     (COND
						       [[IGREATERP X
								   (SUB1 (LLSH 1 (SUB1 ,
										       (CADR ARGS]
							(SUB1 (IDIFFERENCE
								X
								(SUB1 (LLSH 1 , (CADR ARGS]
						       (T X]
						   ,
						   (CAR ARGS])

(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)
)
(DECLARE: EVAL@COMPILE 

(RPAQQ BITSPERHALFWORD
 8)

(RPAQQ MASKHALFWORD1'S
 255)

(RPAQQ MASKWORD1'S
 65535)

(RPAQQ MASK1WORD0'S
 32768)

(RPAQQ MASK0WORD1'S
 32767)

(CONSTANTS BITSPERHALFWORD MASKHALFWORD1'S MASKWORD1'S MASK1WORD0'S MASK0WORD1'S)
)

(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 ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL)))
STOP