(FILECREATED "14-Mar-85 11:02:06" {ERIS}<LISPCORE>SOURCES>DTDECLARE.;11 20947  

      changes to:  (VARS DTDECLARECOMS)
		   (FNS DECLAREDATATYPE ALLOCATE.DATATYPE /DECLAREDATATYPE)

      previous date: "13-Mar-85 17:07:02" {ERIS}<LISPCORE>SOURCES>DTDECLARE.;9)


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

(PRETTYCOMPRINT DTDECLARECOMS)

(RPAQQ DTDECLARECOMS ((* declaring DATATYPES - part of ABC too)
		      (FNS /DECLAREDATATYPE DECLAREDATATYPE TRANSLATE.DATATYPE \REUSETO 
			   \TYPEGLOBALVARIABLE)
		      (FNS BitFieldMask BitFieldShift BitFieldShiftedMask MakeBitField BitFieldWidth 
			   BitFieldFirst)
		      (PROP DMACRO FETCHFIELD FFETCHFIELD REPLACEFIELD FREPLACEFIELD REPLACEFIELDVAL 
			    FREPLACEFIELDVAL TYPENAMEP NCREATE \DTEST \TESTBITS)
		      (FNS COMPILEDFETCHFIELD COMPILEDREPLACEFIELD COMPILEDTYPENAMEP COMPILEDNCREATE)
		      (DECLARE: DONTCOPY (EXPORT (RECORDS FldDsc)))
		      (VARS DATATYPEFIELDTYPES)
		      (COMS (* Macros which convert a record access form into an address-generating 
			       form)
			    (MACROS LOCF INDEXF)
			    (FNS TRANSLATE.LOCF TRANSLATE.LOCF.EXPAND))
		      (LOCALVARS . T)))



(* declaring DATATYPES - part of ABC too)

(DEFINEQ

(/DECLAREDATATYPE
  [LAMBDA (TYPENAME FIELDSPECS DLIST LEN)                    (* lmm "14-Mar-85 09:34")
    (PROG (ONTYPX)
          [AND LISPXHIST TYPENAME (UNDOSAVE (LIST (QUOTE /DECLAREDATATYPE)
						  TYPENAME
						  (GETFIELDSPECS TYPENAME]
          (SETQ ONTYPX (\TYPENUMBERFROMNAME TYPENAME))
          (DECLAREDATATYPE TYPENAME FIELDSPECS DLIST LEN)
          (if ONTYPX
	      then                                           (* Non-null PREV implies non-null TYPENAME)
		   (OR (SELECTQ (SYSTEMTYPE)
				(D (EQUAL ONTYPX (\TYPENUMBERFROMNAME TYPENAME)))
				(EQUAL FIELDSPECS PREV))
		       (LISPXPRINT (LIST (QUOTE datatype)
					 TYPENAME
					 (QUOTE redeclared))
				   T T)))
          (RETURN TYPENAME])

(DECLAREDATATYPE
  [LAMBDA (TYPENAME FIELDSPECS DLIST LENGTH)                 (* lmm "14-Mar-85 10:50")
    (if (AND FIELDSPECS (OR (NOT DLIST)
			    (NOT LENGTH)))
	then (SETQ DLIST (TRANSLATE.DATATYPE TYPENAME FIELDSPECS))
	     (SETQ LENGTH (pop DLIST)))
    (OR (AND TYPENAME (LITATOM TYPENAME))
	(LISPERROR "ILLEGAL ARG" TYPENAME))
    (LET [(PTRS (for P in DLIST when (SELECTQ (fetch fdType of P)
					      ((POINTER FULLPOINTER)
						T)
					      NIL)
		   collect (fetch fdOffset of P]
      (SETTOPVAL (\TYPEGLOBALVARIABLE TYPENAME)
		 (\ASSIGNDATATYPE1 TYPENAME DLIST LENGTH FIELDSPECS PTRS])

(TRANSLATE.DATATYPE
  [LAMBDA (TYPENAME FIELDSPECS)                              (* DECLARATIONS: (RECORD SPEC 
							     (N LEN . FD)))
    (DECLARE (SPECVARS TYPENAME UNUSED BIT OFFSET FD))       (* lmm "13-Mar-85 16:48")
    (COND
      ((NULL TYPENAME))
      ((OR (NOT (LITATOM TYPENAME))
	   (EQ TYPENAME (QUOTE **DEALLOC**)))
	(ERROR "Invalid type name" TYPENAME)))
    (PROG ((N 0)
	   UNUSED
	   (OFFSET 0)
	   (BIT 0)
	   DLIST REUSE LEN FD)
          [SETQ DLIST (for S in FIELDSPECS
			 collect (create SPEC
					 N ←(add N 1)
					 LEN ←(SELECTQ S
						       ((POINTER XPOINTER)
							 24)
						       ((FIXP FLOATP SWAPPEDFIXP FULLPOINTER 
							      SWAPPEDXPOINTER FULLXPOINTER)
							 BITSPERCELL)
						       (FLAG (SETQQ S FLAGBITS)
							     1)
						       (BYTE (SETQQ S BITS)
							     BITSPERBYTE)
						       (WORD (SETQQ S BITS)
							     BITSPERWORD)
						       (SIGNEDWORD (SETQQ S SIGNEDBITS)
								   BITSPERWORD)
						       (SELECTQ (CAR (LISTP S))
								[(BITS FLAGBITS SIGNEDBITS)
								  (PROG1 (CADR S)
									 (SETQ S (CAR S]
								(ERROR "invalid field spec: " S)))
					 FD ←(create FldDsc
						     fdTypeName ← TYPENAME
						     fdType ← S
						     fdOffset ← NIL]
          [for S in DLIST
	     do (replace fdOffset of (SETQ FD (fetch FD of S))
		   with (SELECTQ (fetch fdType of FD)
				 ((POINTER XPOINTER)
				   (COND
				     ([AND TYPENAME
					   (find X in UNUSED
					      suchthat
					       (AND (EQ 0 (LOGAND (CAR X)
								  1))
						    (IGEQ (CADDR X)
							  8)
						    (EQ (IPLUS (CADR X)
							       (CADDR X))
							BITSPERWORD)
						    (find Y in UNUSED
						       suchthat (AND (EQ (CAR Y)
									 (ADD1 (CAR X)))
								     (EQ (CADDR Y)
									 BITSPERWORD]
                                                             (* unused 24 bit quantity)
                                                             (* this case not implemented yet)
				       ))
				   (COND
				     ((IGREATERP BIT 8)      (* Less than 8 bits left in this word)
				       (\REUSETO BITSPERWORD)))
				   (COND
				     ((ODDP OFFSET WORDSPERCELL)
                                                             (* not on double word boundary)
				       (\REUSETO BITSPERWORD)))
				   [COND
				     ((NEQ BIT 8)
				       (\REUSETO 8 (EQ BIT 0]
				   (SETQ BIT 0)
				   (PROG1 OFFSET (add OFFSET WORDSPERCELL)))
				 ((FIXP SWAPPEDFIXP FLOATP SWAPPEDXPOINTER)
                                                             (* 32 bit quantities)
				   (COND
				     ((NEQ BIT 0)
				       (\REUSETO BITSPERWORD)))
				   (PROG1 OFFSET (add OFFSET WORDSPERCELL)))
				 ((FULLPOINTER FULLXPOINTER)
                                                             (* 32 bit doubleword-aligned quantities)
				   (COND
				     ((NEQ BIT 0)
				       (\REUSETO BITSPERWORD)))
				   (COND
				     ((ODDP OFFSET WORDSPERCELL)
				       (\REUSETO BITSPERWORD)))
				   (PROG1 OFFSET (add OFFSET WORDSPERCELL)))
				 [(BITS FLAGBITS SIGNEDBITS)
				   (SETQ LEN (fetch LEN of S))
				   (COND
				     ([AND TYPENAME (SETQ REUSE (find X in UNUSED
								   suchthat (ILEQ LEN (CADDR X]
				       (RPLACA (CDDR REUSE)
					       (IDIFFERENCE (CAR (CDDR REUSE))
							    LEN))
				       (replace fdType of FD with (CONS (fetch fdType of FD)
									(MakeBitField (CADR REUSE)
										      LEN)))
				       (add (CADR REUSE)
					    LEN)
				       (CAR REUSE))
				     ((IGREATERP LEN BITSPERWORD)
                                                             (* more than 1 word -
							     Must right justify first word)
				       (SETQ LEN (IDIFFERENCE LEN BITSPERWORD))
				       (COND
					 ((IGREATERP LEN (IDIFFERENCE BITSPERWORD BIT))
					   (\REUSETO BITSPERWORD)))
				       [COND
					 ((NEQ (IDIFFERENCE BITSPERWORD BIT)
					       LEN)
					   (\REUSETO (IDIFFERENCE BITSPERWORD LEN]
				       (replace fdType of FD with (CONS (QUOTE LONGBITS)
									(MakeBitField BIT LEN)))
				       (SETQ BIT 0)
				       (PROG1 OFFSET (add OFFSET 2)))
				     (T (COND
					  ((IGREATERP LEN (IDIFFERENCE BITSPERWORD BIT))
					    (\REUSETO BITSPERWORD)))
					(replace fdType of FD with (CONS (fetch fdType of FD)
									 (MakeBitField BIT LEN)))
					(add BIT LEN)
					(PROG1 OFFSET (COND
						 ((EQ BIT BITSPERWORD)
						   (SETQ BIT 0)
						   (add OFFSET 1]
				 (SHOULDNT]
          [COND
	    (TYPENAME (COND
			((NEQ BIT 0)
			  (\REUSETO BITSPERWORD)))
		      (while (ODDP OFFSET WORDSPERCELL) do (add OFFSET 1))
		      (COND
			((IGREATERP OFFSET \MDSIncrement)
			  (ERROR TYPENAME "DATATYPE TOO BIG"]
          (RETURN (CONS OFFSET (MAPCAR DLIST (FUNCTION (LAMBDA (X)
					   (fetch FD of X])

(\REUSETO
  [LAMBDA (N FLG)                                            (* lmm " 2-SEP-80 15:11")
    (SETQ N (IDIFFERENCE N BIT))
    [COND
      ((NEQ N 0)
	(COND
	  ((AND (NULL TYPENAME)
		(NOT FLG))
	    (ERROR "Block/datatype field not alligned properly" FD)))
	(push UNUSED (LIST OFFSET BIT N]
    (add BIT N)
    (COND
      ((EQ BIT 16)
	(SETQ BIT 0)
	(add OFFSET 1])

(\TYPEGLOBALVARIABLE
  [LAMBDA (TYPENAME)               (* lmm "15-MAY-80 11:18")

          (* returns a constant or a variable which contains the datatype number of TYPE. It is used when compiling type tests
	  and assigning datatypes. If TYPENAME is a system type, it returns the number. Otherwise it creates a variable name 
	  and puts it on GLOBALVARS.)


    (SELECTQ TYPENAME
	     (SMALLP (QUOTE \SMALLP))
	     (FIXP (QUOTE \FIXP))
	     (FLOATP (QUOTE \FLOATP))
	     (LITATOM (QUOTE \LITATOM))
	     (LISTP (QUOTE \LISTP))
	     (ARRAYP (QUOTE \ARRAYP))
	     (STRINGP (QUOTE \STRINGP))
	     (STACKP (QUOTE \STACKP))
	     (VMEMPAGEP (QUOTE \VMEMPAGEP))
	     (PROG ((VAR (PACK* "" TYPENAME "TYPE#")))
                                   (* Need to create unique variable. strategy is to put ↑d ↑c on front.)
	           (COND
		     ([NOT (OR (FMEMB VAR GLOBALVARS)
			       (GETPROP VAR (QUOTE GLOBALVAR]
		       (PUTPROP VAR (QUOTE GLOBALVAR)
				T)))
	           (RETURN VAR])
)
(DEFINEQ

(BitFieldMask
  [LAMBDA (FD)                     (* lmm "24-FEB-81 13:41")
    (SUB1 (LLSH 1 (BitFieldWidth FD])

(BitFieldShift
  [LAMBDA (FD)                     (* lmm "21-JAN-80 01:14")
    (IDIFFERENCE 16 (IPLUS (BitFieldFirst FD)
			   (BitFieldWidth FD])

(BitFieldShiftedMask
  [LAMBDA (FD)                     (* lmm "10-FEB-80 12:00")
    (IDIFFERENCE (LLSH 1 (IDIFFERENCE 16 (BitFieldFirst FD)))
		 (LLSH 1 (IDIFFERENCE 16 (IPLUS (BitFieldFirst FD)
						(BitFieldWidth FD])

(MakeBitField
  [LAMBDA (first width)            (* lmm "20-JAN-80 23:52")
    (LOGOR (LLSH first 4)
	   (SUB1 width])

(BitFieldWidth
  [LAMBDA (FD)                     (* lmm "21-JAN-80 01:14")
    (ADD1 (LOGAND FD 15])

(BitFieldFirst
  [LAMBDA (FD)                     (* lmm "21-JAN-80 01:13")
    (LRSH FD 4])
)

(PUTPROPS FETCHFIELD DMACRO (X (COMPILEDFETCHFIELD X)))

(PUTPROPS FFETCHFIELD DMACRO (X (COMPILEDFETCHFIELD X T)))

(PUTPROPS REPLACEFIELD DMACRO (X (COMPILEDREPLACEFIELD X)))

(PUTPROPS FREPLACEFIELD DMACRO (X (COMPILEDREPLACEFIELD X T)))

(PUTPROPS REPLACEFIELDVAL DMACRO (OPENLAMBDA (DESCRIPTOR DATUM NEWVALUE)
					     (PROG1 DATUM (REPLACEFIELD DESCRIPTOR DATUM NEWVALUE))))

(PUTPROPS FREPLACEFIELDVAL DMACRO (OPENLAMBDA (DESCRIPTOR DATUM NEWVALUE)
					      (PROG1 DATUM (FREPLACEFIELD DESCRIPTOR DATUM NEWVALUE)))
)

(PUTPROPS TYPENAMEP DMACRO (X (COMPILEDTYPENAMEP X)))

(PUTPROPS NCREATE DMACRO (X (COMPILEDNCREATE X)))

(PUTPROPS \DTEST DMACRO [X (COND ([AND (EQ (CAADR X)
					   (QUOTE QUOTE))
				       (LITATOM (CADR (CADR X]
				  (LIST [LIST (QUOTE OPCODES)
					      (QUOTE DTEST)
					      0
					      (CONS (QUOTE ATOM)
						    (CADR (CADR X]
					(CAR X)))
				 (T (QUOTE IGNOREMACRO])

(PUTPROPS \TESTBITS DMACRO ((X N FD)
			    (NEQ 0 (\GETBITS X N FD))))
(DEFINEQ

(COMPILEDFETCHFIELD
  [LAMBDA (X FASTFLG)                                        (* lmm "19-Dec-84 16:10")
    (COND
      ((EQ (CAR (LISTP (CAR X)))
	   (QUOTE QUOTE))
	([LAMBDA (DESCRIPTOR DATUM)
	    (PROG (TYPENAME)
	          [COND
		    ((AND (NOT FASTFLG)
			  (SETQ TYPENAME (fetch fdTypeName of DESCRIPTOR)))
		      (SETQ DATUM (LIST (FUNCTION \DTEST)
					DATUM
					(KWOTE TYPENAME]
	          (RETURN
		    (SELECTQ (fetch fdType of DESCRIPTOR)
			     ((POINTER XPOINTER FULLPOINTER FULLXPOINTER)
			       (LIST (QUOTE \GETBASEPTR)
				     DATUM
				     (fetch fdOffset of DESCRIPTOR)))
			     (SWAPPEDXPOINTER (BQUOTE ([OPENLAMBDA (D)
								   (\VAG2 (\GETBASE
									    D ,
									    (ADD1 (fetch fdOffset
										     of DESCRIPTOR)))
									  (\GETBASE D ,
										    (fetch fdOffset
										       of DESCRIPTOR]
						       , DATUM)))
			     [FLOATP (BQUOTE (\GETBASEFLOATP , DATUM , (fetch fdOffset of DESCRIPTOR]
			     [FIXP (BQUOTE (\GETBASEFIXP , DATUM , (fetch fdOffset of DESCRIPTOR]
			     (SWAPPEDFIXP (BQUOTE ([OPENLAMBDA (D)
							       (\MAKENUMBER
								 (\GETBASE D ,
									   (ADD1 (fetch fdOffset
										    of DESCRIPTOR)))
								 (\GETBASE D , (fetch fdOffset
										  of DESCRIPTOR]
						   , DATUM)))
			     (PROG ((FT (fetch fdType of DESCRIPTOR))
				    (OFF (fetch fdOffset of DESCRIPTOR)))
			           (RETURN (SELECTQ (CAR FT)
						    (BITS (LIST (QUOTE \GETBITS)
								DATUM OFF (CDR FT)))
						    [SIGNEDBITS (BQUOTE (SIGNED (\GETBITS
										  , DATUM , OFF ,
										  (CDR FT))
										,
										(BitFieldWidth
										  (CDR FT]
						    (FLAGBITS (LIST (QUOTE \TESTBITS)
								    DATUM OFF (CDR FT)))
						    (LONGBITS
						      (BQUOTE ([OPENLAMBDA
								 (D)
								 (\MAKENUMBER (\GETBITS D , OFF ,
											(CDR FT))
									      (\GETBASE D ,
											(ADD1 OFF]
							       , DATUM)))
						    (SHOULDNT]
	  (CADAR X)
	  (CADR X)))
      (T (QUOTE IGNOREMACRO])

(COMPILEDREPLACEFIELD
  [LAMBDA (X FASTFLG RPLVALFLG)                              (* lmm "19-Dec-84 16:12")
                                                             (* compile code for replacing field values.
							     Goes to great length to ensure that the coerced value 
							     is returned)
    (COND
      ((EQ (CAR (LISTP (CAR X)))
	   (QUOTE QUOTE))
	([LAMBDA (DESCRIPTOR DATUM NEWVALUE)
	    (PROG ((TYPENAME (fetch fdTypeName of DESCRIPTOR))
		   (FT (fetch fdType of DESCRIPTOR))
		   (OFFSET (fetch fdOffset of DESCRIPTOR)))
	          [COND
		    ((AND (NOT FASTFLG)
			  TYPENAME)
		      (SETQ DATUM (LIST (FUNCTION \DTEST)
					DATUM
					(KWOTE TYPENAME]
	          (RETURN (SELECTQ FT
				   ((POINTER FULLPOINTER)
				     (LIST (FUNCTION \RPLPTR)
					   DATUM OFFSET NEWVALUE))
				   (XPOINTER (LIST (FUNCTION PUTBASEPTRX)
						   DATUM OFFSET NEWVALUE))
				   (FULLXPOINTER (LIST (QUOTE \PUTBASEPTR)
						       DATUM OFFSET NEWVALUE))
				   (SWAPPEDXPOINTER (BQUOTE ((OPENLAMBDA (D R)
									 (\PUTBASE D , OFFSET
										   (\LOLOC R))
									 (\PUTBASE D , (ADD1 OFFSET)
										   (\HILOC R))
									 R)
							     , DATUM , NEWVALUE)))
				   (FIXP (BQUOTE (\PUTBASEFIXP , DATUM , OFFSET , NEWVALUE)))
				   (SWAPPEDFIXP (BQUOTE (\PUTSWAPPEDFIXP (\ADDBASE , DATUM , OFFSET)
									 , NEWVALUE)))
				   (FLOATP (BQUOTE (\PUTBASEFLOATP , DATUM , OFFSET , NEWVALUE)))
				   (SELECTQ (CAR FT)
					    (BITS (LIST (QUOTE \PUTBITS)
							DATUM OFFSET (CDR FT)
							NEWVALUE))
					    (LONGBITS
					      (LIST (SUBPAIR (QUOTE (OFFSET FT))
							     (LIST OFFSET (CDR FT))
							     (QUOTE (OPENLAMBDA (D V)
										(\PUTBITS
										  D OFFSET FT
										  (\HINUM V))
										(\PUTBASE
										  D
										  (ADD1 OFFSET)
										  (\LONUM V))
										V)))
						    DATUM NEWVALUE))
					    [SIGNEDBITS
					      (BQUOTE (SIGNED [\PUTBITS , DATUM , OFFSET ,
									(CDR FT)
									(UNSIGNED
									  , NEWVALUE ,
									  (BitFieldWidth
									    (CDR FT]
							      ,
							      (BitFieldWidth (CDR FT]
					    (FLAGBITS
					      (BQUOTE (NEQ (\PUTBITS , DATUM , OFFSET , (CDR FT)
								     (COND
								       (, NEWVALUE ,
									  (BitFieldMask (CDR FT)))
								       (T 0)))
							   0)))
					    (RETURN (QUOTE IGNOREMACRO]
	  (CADAR X)
	  (CADR X)
	  (CADDR X)))
      (T (QUOTE IGNOREMACRO])

(COMPILEDTYPENAMEP
  [LAMBDA (X)                                                (* lmm "15-MAY-80 07:41")
    (PROG ((TNAME (CADR X)))
          (RETURN (CONS (QUOTE EQ)
			(COND
			  [[AND (EQ (CAR TNAME)
				    (QUOTE QUOTE))
				(NOT (FMEMB (CADR TNAME)
					    (QUOTE (CCODEP HARRAYP ARRAYP]
			    (LIST (LIST (QUOTE NTYPX)
					(CAR X))
				  (\TYPEGLOBALVARIABLE (CADR TNAME]
			  (T (CONS (LIST (QUOTE TYPENAME)
					 (CAR X))
				   (CDR X])

(COMPILEDNCREATE
  [LAMBDA (X)                      (* lmm " 9-DEC-81 11:20")
                                   (* compiles code for NCREATEs. Exists to eliminate the call to 
				   \TYPENUMBERFROMNAME.)
    (COND
      [(EQ (CAR (LISTP (CAR X)))
	   (QUOTE QUOTE))
	(COND
	  [(NULL (CADR X))
	    (LIST (QUOTE CREATECELL)
		  (\TYPEGLOBALVARIABLE (CADAR X]
	  (T (LIST (QUOTE NCREATE2)
		   (\TYPEGLOBALVARIABLE (CADAR X))
		   (CADR X]
      (T (QUOTE IGNOREMACRO])
)
(DECLARE: DONTCOPY 
(* FOLLOWING DEFINITIONS EXPORTED)


[DECLARE: EVAL@COMPILE 

(RECORD FldDsc (fdTypeName fdOffset fdType))
]


(* END EXPORTED DEFINITIONS)

)

(RPAQQ DATATYPEFIELDTYPES ((FLOATP 0.0)
			   (FIXP 0)
			   (SWAPPEDFIXP 0)
			   (POINTER NIL)
			   (XPOINTER NIL)
			   (FULLPOINTER NIL)
			   (FULLXPOINTER NIL)
			   (SWAPPEDXPOINTER NIL)
			   (FLAG NIL)
			   (BYTE 0)
			   (WORD 0)
			   (SIGNEDWORD 0)))



(* Macros which convert a record access form into an address-generating form)

(DECLARE: EVAL@COMPILE 

(PUTPROPS LOCF DMACRO (X (TRANSLATE.LOCF X)))

(PUTPROPS INDEXF DMACRO (X (TRANSLATE.LOCF X T)))
)
(DEFINEQ

(TRANSLATE.LOCF
  [LAMBDA (ARGS INDEXONLY)                                   (* bvm: "14-Feb-85 00:15")
    (DECLARE (GLOBALVARS CLISPARRAY))
    (PROG ((FORM (MKPROGN ARGS))
	   NEWFORM OFFSET SPEC)                              (* The DWIMIFY should convert a record access into some
							     kind of fetch.)
      RETRY
          [SELECTQ (CAR (LISTP FORM))
		   [PROGN (COND
			    ((NOT (CDDR FORM))               (* get rid of extra PROGN's inserted by record package)
			      (SETQ FORM (CADR FORM))
			      (GO RETRY]
		   [(FETCHFIELD FFETCHFIELD)
		     (COND
		       ((AND (SETQ OFFSET (LISTP (CADR FORM)))
			     (EQ (CAR OFFSET)
				 (QUOTE QUOTE))
			     [SETQ OFFSET (CADR (SETQ SPEC (CADR OFFSET]
			     (FIXP OFFSET))
			 (RETURN (COND
				   (INDEXONLY OFFSET)
				   ((EQ OFFSET 0)
				     (CADDR FORM))
				   (T (SETQ FORM (CADDR FORM))
                                                             (* loop in order to merge \ADDBASEs.
							     Should actually be done by compiler optimization, but 
							     apparently that is currently broken)
				      (repeatwhile (SELECTQ (CAR (LISTP FORM))
							    (PROGN (COND
								     ((NULL (CDDR FORM))
								       (SETQ FORM (CADR FORM))
								       T)))
							    ((ADDBASE \ADDBASE)
							      (COND
								((FIXP (CADDR FORM))
								  (add OFFSET (CADDR FORM))
								  (SETQ FORM (CADR FORM))
								  T)))
							    (if (SETQ NEWFORM (TRANSLATE.LOCF.EXPAND
								    FORM))
								then (SETQ FORM NEWFORM)
								     T)))
				      (LIST (QUOTE \ADDBASE)
					    FORM OFFSET]
		   (COND
		     ((SETQ FORM (TRANSLATE.LOCF.EXPAND FORM))
		       (GO RETRY]
          (ERROR "LOCF Can't figure out this argument" ARGS)
          (RETURN (QUOTE IGNOREMACRO])

(TRANSLATE.LOCF.EXPAND
  [LAMBDA (FORM)                                             (* hts: " 4-Jun-84 15:45")
    (COND
      ((GETHASH FORM CLISPARRAY))
      ((GETPROP (CAR FORM)
		(QUOTE CLISPWORD))
	(DWIMIFY FORM T)
	(GETHASH FORM CLISPARRAY))
      ((NEQ FORM (SETQ FORM (EXPANDMACRO FORM T)))           (* Be sure any macros are expanded)
	FORM])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(PUTPROPS DTDECLARE COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1256 9740 (/DECLAREDATATYPE 1266 . 2092) (DECLAREDATATYPE 2094 . 2816) (
TRANSLATE.DATATYPE 2818 . 8322) (\REUSETO 8324 . 8718) (\TYPEGLOBALVARIABLE 8720 . 9738)) (9741 10619 
(BitFieldMask 9751 . 9873) (BitFieldShift 9875 . 10036) (BitFieldShiftedMask 10038 . 10278) (
MakeBitField 10280 . 10408) (BitFieldWidth 10410 . 10517) (BitFieldFirst 10519 . 10617)) (11650 17699 
(COMPILEDFETCHFIELD 11660 . 13992) (COMPILEDREPLACEFIELD 13994 . 16732) (COMPILEDTYPENAMEP 16734 . 
17202) (COMPILEDNCREATE 17204 . 17697)) (18355 20794 (TRANSLATE.LOCF 18365 . 20425) (
TRANSLATE.LOCF.EXPAND 20427 . 20792)))))
STOP