(FILECREATED " 5-Jan-85 21:42:58" {ERIS}<LISPCORE>SOURCES>RENAMEMACROS.;2
 4832   

      changes to:  (MACROS UNLESSRDSYS)

      previous date: "19-OCT-82 16:50:18" {ERIS}<LISPCORE>SOURCES>RENAMEMACROS.;1)


(* Copyright (c) 1982, 1985 by Xerox Corporation. All rights reserved.)

(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
 ((NORMAL RDSYS)
			     NORMAL))

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