(FILECREATED "19-OCT-82 16:50:18" {PHYLUM}<LISPCORE>SOURCES>RENAMEMACROS.;3
 4463   

      changes to:  (MACROS PAGEBASE)

      previous date: " 4-NOV-81 00:09:32" {PHYLUM}<LISPCORE>SOURCES>RENAMEMACROS.;2)


(* Copyright (c) 1982 by Xerox Corporation)

(PRETTYCOMPRINT RENAMEMACROSCOMS)

(RPAQQ RENAMEMACROSCOMS
 ((ADDVARS (RD.SUBFNS (UNLESSRDSYS . 2ND)
					     (\GETBITS . RNGETBITS)
					     (\PUTBITS . RNPUTBITS))
				  (MKI.SUBFNS (\GETBITS . RNGETBITS)
					      (\PUTBITS . RNPUTBITS))
				  (EXPANDMACROFNS 1ST 2ND UNLESSRDSYS RNGETBITS RNPUTBITS \TESTBITS)
				  (EXPANDMACROFNS ADDBASE GETBASE GETBASEBYTE GETBASEPTR HILOC LOLOC 
						  PUTBASE PUTBASEBYTE PUTBASEPTR REPLACEPTRFIELD VAG2 
						  PAGEBASE PAGELOC))
	(EXPORT (MACROS UNLESSRDSYS 1ST 2ND LOCAL ALLOCAL)
		(MACROS ADDBASE GETBASE GETBASEBYTE GETBASEPTR HILOC LOLOC PUTBASE PUTBASEBYTE 
			PUTBASEPTR REPLACEPTRFIELD VAG2 PAGEBASE PAGELOC))
	(MACROS RNPUTBITS RNGETBITS)))

(ADDTOVAR RD.SUBFNS
 (UNLESSRDSYS . 2ND)
		    (\GETBITS . RNGETBITS)
		    (\PUTBITS . RNPUTBITS))

(ADDTOVAR MKI.SUBFNS
 (\GETBITS . RNGETBITS)
		     (\PUTBITS . RNPUTBITS))

(ADDTOVAR EXPANDMACROFNS
 1ST 2ND UNLESSRDSYS RNGETBITS RNPUTBITS \TESTBITS)

(ADDTOVAR EXPANDMACROFNS
 ADDBASE GETBASE GETBASEBYTE GETBASEPTR HILOC LOLOC PUTBASE PUTBASEBYTE 
				 PUTBASEPTR REPLACEPTRFIELD VAG2 PAGEBASE PAGELOC)

(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: EVAL@COMPILE 

(PUTPROPS UNLESSRDSYS MACRO
 ((X)
			     X))

(PUTPROPS 1ST MACRO
 ((A . B)
		     A))

(PUTPROPS 2ND MACRO
 ((A B . C)
		     B))

(PUTPROPS LOCAL MACRO
 ((X)
		       X))

(PUTPROPS ALLOCAL MACRO
 ((X)
			 X))
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS ADDBASE DMACRO
 (= . \ADDBASE))

(PUTPROPS GETBASE DMACRO
 (= . \GETBASE))

(PUTPROPS GETBASEBYTE DMACRO
 (= . \GETBASEBYTE))

(PUTPROPS GETBASEPTR DMACRO
 (= . \GETBASEPTR))

(PUTPROPS HILOC DMACRO
 (= . \HILOC))

(PUTPROPS LOLOC DMACRO
 (= . \LOLOC))

(PUTPROPS PUTBASE DMACRO
 (= . \PUTBASE))

(PUTPROPS PUTBASEBYTE DMACRO
 (= . \PUTBASEBYTE))

(PUTPROPS PUTBASEPTR DMACRO
 (= . \PUTBASEPTR))

(PUTPROPS REPLACEPTRFIELD DMACRO
 (= . \RPLPTR))

(PUTPROPS VAG2 DMACRO
 (= . \VAG2))

(PUTPROPS PAGEBASE MACRO
 ((PTR)
			  (fetch
 (POINTER PAGEBASE) of
 PTR)))

(PUTPROPS PAGELOC MACRO
 (OPENLAMBDA (PTR)
				    (IPLUS (LLSH (\HILOC PTR)
						 8)
					   (LRSH (\LOLOC PTR)
						 8))))
)


(* END EXPORTED DEFINITIONS)

(DECLARE: EVAL@COMPILE 

(PUTPROPS RNPUTBITS MACRO
 (X ([LAMBDA (DATUM OFFSET FD NEWVALUE)
				 (PROG ((MASK (BitFieldMask FD))
					(SHIFT (BitFieldShift FD))
					(FIRST
 (BitFieldFirst FD)))
				       (OR (EQ FIRST 0)
					   (SETQ NEWVALUE (LIST (QUOTE LOGAND)
								NEWVALUE MASK)))
				       (OR (EQ SHIFT 0)
					   (SETQ NEWVALUE (LIST (QUOTE LLSH)
								NEWVALUE SHIFT)))
				       [COND
					 ((AND (EQ FIRST 0)
					       (EQ SHIFT 0))
					   (SETQ NEWVALUE (LIST (QUOTE \PUTBASE)
								DATUM OFFSET NEWVALUE)))
					 (T (SETQ NEWVALUE (LIST (QUOTE LOGOR)
								 (LIST (QUOTE LOGAND)
								       (LIST (QUOTE \GETBASE)
									     (QUOTE $$PUTBITS)
									     OFFSET)
								       (LOGXOR 65535
									       (LLSH MASK SHIFT)))
								 NEWVALUE))
					    (SETQ NEWVALUE (LIST (LIST (QUOTE OPENLAMBDA)
								       (QUOTE ($$PUTBITS))
								       (LIST (QUOTE \PUTBASE)
									     (QUOTE $$PUTBITS)
									     OFFSET NEWVALUE))
								 DATUM]
				       [COND
					 ((NOT EFF)
					   (OR (EQ SHIFT 0)
					       (SETQ NEWVALUE (LIST (QUOTE LRSH)
								    NEWVALUE SHIFT)))
					   (OR (EQ FIRST 0)
					       (SETQ NEWVALUE (LIST (QUOTE LOGAND)
								    NEWVALUE MASK]
				       (RETURN NEWVALUE]
			       (CAR X)
			       (CADR X)
			       (CADDR X)
			       (CADDDR X))))

(PUTPROPS RNGETBITS MACRO
 (X ([LAMBDA (FORM OFFSET FD)
				 (COND
				   ((NOT (FIXP FD))
				     (QUOTE IGNOREMACRO))
				   (T (SETQ FORM (LIST (QUOTE \GETBASE)
						       FORM OFFSET))
				      [OR (EQ (BitFieldShift FD)
					      0)
					  (SETQ FORM (LIST (QUOTE LRSH)
							   FORM
							   (BitFieldShift FD]
				      [OR (EQ (BitFieldFirst FD)
					      0)
					  (SETQ FORM (LIST (QUOTE LOGAND)
							   FORM
							   (BitFieldMask FD]
				      FORM]
			       (CAR X)
			       (CADR X)
			       (CADDR X))))
)
(DECLARE: DONTCOPY (PUTPROPS RENAMEMACROS COPYRIGHT ("Xerox Corporation" 1982)))
(DECLARE: DONTCOPY
  (FILEMAP (NIL)))
STOP