(FILECREATED " 1-Apr-85 13:36:33" {ERIS}<LISPNEW>PATCHES>DATATYPEPATCH.;1
 3196   

      changes to:  (VARS DATATYPEPATCHCOMS))


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

(PRETTYCOMPRINT DATATYPEPATCHCOMS)

(RPAQQ DATATYPEPATCHCOMS
 ((FNS \ASSIGNDATATYPE1)))
(DEFINEQ

(\ASSIGNDATATYPE1

  [LAMBDA (NAME DESCRIPTORS SIZE SPECS PTRFIELDS)            (* lmm "31-Mar-85 21:18")

    (
PROG
 ((
NTYPX
 (
\TYPENUMBERFROMNAME
 NAME))
	   DTD)
          [
COND

	    (
NTYPX
                                           (* a datatype of this name already allocated)

		   (
SETQ
 DTD (\GETDTD NTYPX))
		   (
COND

		     ((
AND
 (
EQUAL
 PTRFIELDS (fetch
 DTDPTRS of
 DTD))
			   (
EQUAL
 SIZE (fetch
 DTDSIZE of
 DTD)))
                                                             (* has same shape, can reuse DTD)

		       (replace
 DTDDESCRS of
 DTD with
 DESCRIPTORS)
		       (replace
 DTDTYPESPECS of
 DTD with
 SPECS)
		       (
RETURN
 NTYPX))
		     ([
OR
 (
EQ
 CROSSCOMPILING T)
			  (
AND
 CROSSCOMPILING (
NEQ
 (
QUOTE
 Y)
						   (
ASKUSER
 30 (
SELECTQ
 CROSSCOMPILING
									(Y (
QUOTE
 Y))
									(
QUOTE
 N))
							    (
LIST
 (if
 SIZE
								      then
 
								      "OK TO REDECLARE DATATYPE "
								    else
 "OK to deallocate DATATYPE ")
								  NAME]
                                                             (* don't do it if cross compiling)

		       (
RETURN
 NTYPX))
		     ((
IGREATERP
 NTYPX \MaxSysTypeNum)
		       (UNINTERRUPTABLY
                           (replace
 DTDNAME of
 DTD with
 (\ATOMPNAMEINDEX (
QUOTE
 **DEALLOC**)))
			   (replace
 DTDDESCRS of
 DTD with
 NIL)
			   (replace
 DTDTYPESPECS of
 DTD with
 NIL)))
		     (T                                      (* can't mess with sys types)

			(
ERROR
 "ILLEGAL DATA TYPE" NAME]
          (if
 (
NOT
 SIZE)
	      then
                                           (* only called to deallocate old datatype)

	    else
 (
COND

		   ((
EQ
 \MaxTypeNumber \EndTypeNumber)
		     (
LISPERROR
 "DATA TYPES FULL" NAME)))
		 (UNINTERRUPTABLY
                     (
SETQ
 NTYPX (add
 \MaxTypeNumber 1))
		     (
SETQ
 DTD (\GETDTD NTYPX))
		     (
COND

		       ((
IGREATERP
 (
IPLUS
 (fetch
 WORDINPAGE of
 DTD)
					  \DTDSize)
				   (
CONSTANT
 (
SUB1
 WORDSPERPAGE)))
                                                             (* if this is the last one which would fit on a page, 

							     create a new page)

			 (
\NEWPAGE
 (
\ADDBASE
 DTD \DTDSize)
				   T)))
		     (replace
 DTDNAME of
 DTD with
 (\ATOMPNAMEINDEX NAME))
		     (
COND

		       ((
NEQ
 SIZE 0)
			 (replace
 DTDSIZE of
 DTD with
 SIZE)
			 (replace
 DTDDESCRS of
 DTD with
 (
COPY
 DESCRIPTORS))
			 (replace
 DTDTYPESPECS of
 DTD with
 (
COPY
 SPECS))
			 (replace
 DTDPTRS of
 DTD with
 PTRFIELDS)
			 (
\GCTYPE
 NTYPX DTD))))
		 (
RETURN
 NTYPX])
)
(PUTPROPS DATATYPEPATCH COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (294 3112 (\ASSIGNDATATYPE1 304 . 3110)))))
STOP