(FILECREATED " 4-Apr-85 11:22:05" {ERIS}<LISP>INTERMEZZO>PATCHES>DATATYPEPATCH2.;1
 2003   

      changes to:  (VARS DATATYPEPATCH2COMS))


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

(PRETTYCOMPRINT DATATYPEPATCH2COMS)

(RPAQQ DATATYPEPATCH2COMS
 ((FNS DECLAREDATATYPE /DECLAREDATATYPE)))
(DEFINEQ

(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))
      DLIST])

(/DECLAREDATATYPE

  [LAMBDA (
TYPENAME
 FIELDSPECS DLIST LEN)                    (* lmm "14-Mar-85 09:34")

    (
PROG
 (ONTYPX DLIST)
          [
AND
 LISPXHIST TYPENAME (
UNDOSAVE
 (
LIST
 (
QUOTE
 /DECLAREDATATYPE)
						  TYPENAME
						  (
GETFIELDSPECS
 TYPENAME]
          (
SETQ
 ONTYPX (
\TYPENUMBERFROMNAME
 TYPENAME))
          (
SETQ
 DLIST (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
 DLIST])
)
(PUTPROPS DATATYPEPATCH2 COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (322 1918 (DECLAREDATATYPE 332 . 1068) (/DECLAREDATATYPE 1070 . 1916)))))
STOP