(FILECREATED "16-Feb-86 17:56:46" {QV}<IDL>SOURCES>GLOBAL.;34
 19901  

      changes to:  (VARS GLOBALCOMS)

      previous date: "16-Feb-86 13:50:58" {QV}<IDL>SOURCES>GLOBAL.;33)


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

(PRETTYCOMPRINT GLOBALCOMS)

(RPAQQ GLOBALCOMS
 [(* Global functions and definitions)
	(FNS AELTTYPE ALLOC.SARRAY ARRAYTYPEP COPYIDLARRAY DIMENSIONP GETAELT GETARRAYPROP LEVELP 
	     MAKEOFFSETS NLOGICALELTS NPHYSICALELTS PRESERVE SERIALNUMBER SETARRAYPROP SETAELT VFROMR 
	     ZEROFORARRAY)
	(INITRECORDS ARRAYFRAME)
	(IF: TESTSYS (RECORDS ARRAYFRAME SIMARRAY SELARRAY)
	     (RECORDS ID KEEPS)
	     (RECORDS AELTPTR)
	     (MACROS IJKBOX IVALUE)
	     (PROP CLISPWORD fadd FADD)
	     (PROP CHANGEWORD fadd))
	(P (MOVD (QUOTE GETAELT)
		 (QUOTE COPYAELT)))
	(IF: TESTSYS (DECLTYPES ARRAY (ARRAY COERCION)
				VECTOR MATRIX)
	     (DECLTYPES FORMATCODE))
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
									      (NLAML)
									      (LAMA])



(* Global functions and definitions)


(DEFINEQ

(AELTTYPE

  [DLAMBDA ((A ARRAY)
            (RETURNS (MEMQ INTEGER FLOATING)))
                                                             (* jop: "27-Nov-85 17:22" posted: "27-AUG-78 15:33")

                                                             (* Returns array elementtype.

							     Subfunctioned because of the volume of code it 

							     generates)

    [fetch
 RELTTYPE of
 (fetch
 ELEMENTBLOCK of
 (
SELECTQ
 (fetch
 (ARRAYFRAME TYPE)
								    of
 A)
								 (SIMPLE A)
								 (SELECTION (fetch
 (SELARRAY 
											BASEARRAY)
									       of
 A))
								 (
SHOULDNT
]])

(ALLOC.SARRAY

  [DLAMBDA ((SHAPE ROWINT)
            (FORMAT FORMATCODE)
            (RELTVAL (ONEOF SCALAR (MEMQ INTEGER FLOATING)))
            (RETURNS SIMARRAY))
                                                             (* rmk: "16-AUG-78 00:30")


          (* builds a simple array of shape SHAPE format FORMAT and with elements initialized to RELTVAL.

	  NPHYSICALELTS called on the shape returns the size in elements)


                                                             (* Note: Element type is determined by type of RELTVAL,

							     with NIL -> INTEGER)

    (
SETQ
 RELTVAL (
SELECTQ
 RELTVAL
			   (INTEGER 0)
			   (FLOATING 0.0)
			   RELTVAL))
    (create
 SIMARRAY
	    SHAPE _ SHAPE
	    FORMAT _ FORMAT
	    ELEMENTBLOCK _(create
 ROWSCALAR
				  NELTS _(NPHYSICALELTS
 SHAPE FORMAT)
				  RELTTYPE _(if
 (type?
 FLOATING RELTVAL)
						then
 (
QUOTE
 FLOATING)
					      else
 (
QUOTE
 INTEGER))
				  INIT _ RELTVAL))])

(ARRAYTYPEP

  [LAMBDA (A TYPE)                                           (* jop: "27-Nov-85 17:22" posted: " 5-JUL-77 10:04")

                                                             (* A predicate for checking the type of an 

							     array-frame. This is fast-compiled open)

    (
AND
 (type?
 ARRAYFRAME A)
	   (
SELECTQ
 TYPE
		      (
ARRAY
 T)
		      ((SIMPLE SELECTION)
			(
EQ
 TYPE (fetch
 (ARRAYFRAME TYPE) of
 A)))
		      (VECTOR (
EQ
 (fetch
 NDIMS of
 A)
				    1))
		      (MATRIX (
EQ
 (fetch
 NDIMS of
 A)
				    2))
		      (
SHOULDNT
])

(COPYIDLARRAY

  [DLAMBDA ((A ARRAY)
            (NEWELTTYPE (MEMQ NIL FLOATING INTEGER))
            (RETURNS SIMARRAY))
                                                             (* bas: " 9-FEB-83 15:19" posted: "13-MAY-77 00:30")

                                                             (* Produces a simple copy of an array, converting 

							     elements to NEWELTTYPE)

    (DPROG ((RESULT (ALLOC.SARRAY
 (fetch
 SHAPE of
 A)
				    (fetch
 FORMAT of
 A)
				    (
OR
 NEWELTTYPE (fetch
 AELTTYPE of
 A))) SIMARRAY)
            (GSBOLD (
SETUP
 A (if
 (
EQ
 (fetch
 FORMAT of
 A)
					   (
QUOTE
 FULL))
				   then
 (
QUOTE
 DONTCARE)
				 else
 (
QUOTE
 SYMMETRIC))) GENSTATEBLOCK)
       THEN (GSBNEW (
SETUP
 RESULT (fetch
 ORDER of
 GSBOLD)) GENSTATEBLOCK))
         [if
 (
AND
 (
EQ
 NEWELTTYPE (
QUOTE
 INTEGER))
		      (
EQ
 (fetch
 AELTTYPE of
 A)
			    (
QUOTE
 FLOATING)))
	     then
 [bind
 TEMP until
 (fetch
 DONE of
 GSBOLD)
		       do
 (SETAELT
 RESULT (
NEXT
 GSBNEW)
				       (
AND
 (
SETQ
 TEMP (GETAELT
 A (
NEXT
 GSBOLD)))
					      (IVALUE (
FIXR
 TEMP]
	   else
 (until
 (fetch
 DONE of
 GSBOLD) do
 (SETAELT
 RESULT (
NEXT
 GSBNEW)
								      (GETAELT
 A (
NEXT
 GSBOLD]
         (
LAB.COPYALL
 A RESULT)
         (
RETURN
 RESULT))])

(DIMENSIONP

  [DLAMBDA ((ARY ARRAY)
            (DIM INTEGER)
            (RETURNS BOOL))
                                                             (* bas: "24-MAR-78 16:50")

                                                             (* DIMENSIONP returns true if DIM is a plausible 

							     dimension index for ARY.)

    (
BETWEEN
 DIM 1 (fetch
 NDIMS of
 ARY))])

(GETAELT

  [DLAMBDA ((ARR ARRAY)
            (AP AELTPTR (SATISFIES ARR=AP:SOURCE))
            (RETURNS SCALAR))
                                                             (* jop: "11-Feb-86 22:54")

                                                             (* Retrieves the element pointed to by AP, with type 

							     determined by ARR)

    (if
 [
NOT
 (TESTMISSING (fetch
 I of
 (fetch
 (
AELTPTR
 PTR) of
 AP]
	then
 (
SELECTQ
 (fetch
 AELTTYPE of
 ARR)
			  (INTEGER (fetch
 I of
 (fetch
 (
AELTPTR
 PTR) of
 AP)))
			  (FLOATING (fetch
 F of
 (fetch
 (
AELTPTR
 PTR) of
 AP)))
			  (
SHOULDNT
)))])

(GETARRAYPROP

  [DLAMBDA ((A ARRAY)
            (P LITATOM))
                                                             (* bas: "24-MAR-78 16:54" posted: "16-NOV-77 15:24")

                                                             (* Gets the value of the P property of A)

    (
CDR
 (
FASSOC
 P (fetch
 SLOT5 of
 A)))])

(LEVELP

  [DLAMBDA ((A ARRAY)
            (DIM INTEGER (SATISFIES (DIMENSIONP
 A DIM)))
            (LEV INTEGER)
            (RETURNS BOOL))
                                                             (* bas: " 7-SEP-78 00:04" posted: " 4-MAY-77 10:57")

    (
BETWEEN
 LEV 1 (
GETRELT
 (fetch
 SHAPE of
 A)
			    DIM))])

(MAKEOFFSETS

  [DLAMBDA ((SHP ROWINT)
            (RETURNS ROWINT))
                                                             (* bas: "16-FEB-83 17:56")

                                                             (* ex. {2,3,4}=>{12,4,1})

    (if
 (
IEQP
 (fetch
 NELTS of
 SHP)
	      1)
	then
 (
CONSTANT
 (
ROWINTOF
 1))
      else
 (bind
 [Y _(create
 ROWINT (
SETQ
 NELTS (fetch
 NELTS of
 SHP]
		 (VAL _ 1)
	      declare
 (Y ROWINT)
		      (VAL IJK)
	      for
 J from
 (fetch
 NELTS of
 SHP) by
 -1 to
 1
	      do
 (
SETRELT
 Y J VAL)
		 (
SETQ
 VAL (
ITIMES
 (
GETRELT
 SHP J)
				   VAL))
	      finally
 (
RETURN
 Y)))])

(NLOGICALELTS

  [DLAMBDA ((SHP ROWINT)
            (RETURNS IJK))
                                                             (* bas: "10-FEB-83 14:43")


          (* Returns the number of logical elements in an array with this shape. In particular, the number of elements that a 

	  generator of this array will return.)



    (if
 (
IEQP
 (fetch
 NELTS of
 SHP)
	      0)
	then
 (IJKBOX 0)
      else
 (for
 I (C _ 1) to
 (fetch
 NELTS of
 SHP)
	      declare
 (I INTEGER)
		      (C IJK)
	      do
 (
SETQ
 C (
ITIMES
 C (
GETRELT
 SHP I))) finally
 (
RETURN
 C)))])

(NPHYSICALELTS

  [DLAMBDA ((SHP ROWINT)
            (FMT FORMATCODE)
            (RETURNS IJK))
                                                             (* bas: "10-FEB-83 14:48")

                                                             (* Returns the number of elements that a simple array 

							     with these attributes would have in its elementblock.)

    (
SELECTQ
 FMT
	     (FULL (NLOGICALELTS
 SHP))
	     (SYMMETRIC [
ASSERT
 (
AND
 (
IEQP
 2 (fetch
 NELTS of
 SHP))
				     (
IEQP
 (
GETRELT
 SHP 1)
					   (
GETRELT
 SHP 2]
			(
SYMELTLOC
 (
GETRELT
 SHP 1)
				   (
GETRELT
 SHP 1)))
	     (
SHOULDNT
))])

(PRESERVE

  [DLAMBDA ((A ARRAY)
            (RETURNS ARRAY))
                                                             (* jop: "29-Nov-85 12:11" posted: " 8-OCT-77 18:02")


          (* Returns a "copy" of A which will survive intact even though A is side-effected later. Labels in TTAB arrays do 

	  not have to be preserved b/c the arrays were preserved in MAKESLTR)



    (DPROG ((NEWA NIL ARRAY)
            (RETURNS ARRAY))
         (
SELECTQ
 (fetch
 (ARRAYFRAME TYPE) of
 A)
		    (SIMPLE (
SETQ
 NEWA (create
 SIMARRAY using
 A))
			    [if
 (fetch
 LABELBLOCK of
 A)
				then
 (
PROG
 [(PTR (fetch
 DIMLABELBLOCK
							of
 (replace
 LABELBLOCK of
 NEWA
								with
 (create
 LABELBLOCK
									  using
 (fetch
 LABELBLOCK
										     of
 A]
					       (if
 PTR
						   then
 (BUMPREFCNT PTR]
                                                             (* Copy top level of labelblock and bump refcount of 

							     dimlabblock)

			    )
		    [SELECTION (
SETQ
 NEWA (create
 SELARRAY using
 A))
			       (replace
 (SELARRAY BASEARRAY) of
 NEWA
				  with
 (PRESERVE
 (fetch
 (SELARRAY BASEARRAY) of
 A]
		    (
SHOULDNT
))
         (replace
 (ARRAYFRAME ID) of
 NEWA with
 NIL)    (* Smash to ID block)

         (
SETTITLE
 NEWA (
GETTITLE
 A))                    (* Both copies the title and sets a new serial number)

         (
RETURN
 NEWA))])

(SERIALNUMBER

  [DLAMBDA ((A ARRAY)
            (RETURNS INTEGER))
                                                             (* jop: "27-Nov-85 17:38" posted: " 9-MAR-78 16:12")


          (* Returns the serial number of A, constructing one if necessary. Relies on the fact that this is the ONLY place 

	  where IDs are created so the existence of an ID implies a preassigned serialnumber)



    [
PROG
 [(LST (
CONSTANT
 (
LIST
 0]
	    (
RETURN
 (fetch
 SNF of
 (
OR
 (fetch
 (ARRAYFRAME ID) of
 A)
					      (replace
 (ARRAYFRAME ID) of
 A
						 with
 (create
 ID
								  SNF _(add
 (
CAR
 LST)
									      1]])

(SETARRAYPROP

  [DLAMBDA ((A ARRAY)
            (P LITATOM)
            (V ANY))
                                                             (* bas: "24-MAR-78 16:54" posted: "16-NOV-77 15:27")

                                                             (* Attaches property P with value V to A)

    (push
 A:SLOT5 (<P ! V>))
    V])

(SETAELT

  [DLAMBDA ((ARY ARRAY)
            (AP AELTPTR (SATISFIES ARY=AP:SOURCE))
            (V SCALAR)
            (RETURNS SCALAR))
                                                             (* jop: "11-Feb-86 22:58")

                                                             (* Primitive function for setting an element in an 

							     array)

    (if
 V
	then
 (
SELECTQ
 (fetch
 AELTTYPE of
 ARY)
			  [INTEGER (if
 (type?
 INTEGER V)
				       then
 (replace
 I of
 (fetch
 (
AELTPTR
 PTR)
								   of
 AP)
						 with
 V)
				     else
 (
HELP
 "Attempt to store FLOAT into INTEGER array"
						    (
LIST
 ARY V]
			  (FLOATING (replace
 F of
 (fetch
 (
AELTPTR
 PTR) of
 AP)
				       with
 (
FLOAT
 V)))
			  (
SHOULDNT
))
      else
 (replace
 MAYHAVENIL of
 (fetch
 ELEMENTBLOCK
					   of
 (
SELECTQ
 (fetch
 (ARRAYFRAME TYPE) of
 ARY)
							   (SIMPLE ARY)
							   (SELECTION (fetch
 (SELARRAY BASEARRAY)
									 of
 ARY))
							   (
SHOULDNT
)))
		with
 T)
	     (replace
 I of
 (fetch
 (
AELTPTR
 PTR) of
 AP) with
 (
CONSTANT
 MIN.FIXP)))
    V])

(VFROMR

  [DLAMBDA ((R ROWSCALAR)
            (TITLE (ONEOF NIL TITLE))
            (RETURNS SIMARRAY))
                                                             (* bas: " 9-FEB-83 15:23")

                                                             (* Constructs a vector with elementblock=R and 

							     title=TITLE)

    (DPROG ((A (create
 SIMARRAY
		       FORMAT _(
QUOTE
 FULL)
		       SHAPE _(
ROWINTOF
 (IJKBOX (fetch
 NELTS of
 R)))
		       ELEMENTBLOCK _ R) SIMARRAY))
         (if
 TITLE
	     then
 (
SETTITLE
 A TITLE))
         (
RETURN
 A))])

(ZEROFORARRAY

  [DLAMBDA ((A ARRAY)
            (RETURNS ARITH))
                                                             (* rmk: " 6-Oct-84 14:18")

                                                             (* Returns a zero of the type of A)

    (
SELECTQ
 (fetch
 AELTTYPE of
 A)
	     (INTEGER 0)
	     (FLOATING 0.0)
	     (
SHOULDNT
))])
)
(/DECLAREDATATYPE (QUOTE ARRAYFRAME)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
		  (QUOTE ((ARRAYFRAME 0 POINTER)
			  (ARRAYFRAME 2 POINTER)
			  (ARRAYFRAME 4 POINTER)
			  (ARRAYFRAME 6 POINTER)
			  (ARRAYFRAME 8 POINTER)
			  (ARRAYFRAME 10 POINTER)
			  (ARRAYFRAME 12 POINTER)
			  (ARRAYFRAME 14 POINTER)))
		  (QUOTE 16))
(DECLARE: DOCOPY 
(DECLARE: EVAL@LOADWHEN TESTSYS 
[DECLARE: EVAL@COMPILE 

(DATATYPE ARRAYFRAME
 (TYPE SHAPESLOT FORMAT SLOT1 SLOT2 SLOT3 ID SLOT5)
		       (
ACCESSFNS
 ARRAYFRAME ([
SHAPE
 (the
 ROWINT (fetch
 SHAPESLOT
									  of
 DATUM))
							 (replace
 SHAPESLOT of
 DATUM
							    with
 (the
 ROWINT (BUMPREFCNT NEWVALUE]
				     (NDIMS (fetch
 NELTS of
 (fetch
 SHAPE of
 DATUM)))
				     (
AELTTYPE
 AELTTYPE)
				     (
TITLE
 GETTITLE SETTITLE)
				     (
SERIALNUMBER
 SERIALNUMBER))))
[
DATATYPE
 (SIMARRAY ARRAYFRAME)
	    (TYPE SHAPESLOT FORMAT LABELBLOCK SLOT2 SLOT3 ID SLOT5)
	    TYPE _(
QUOTE
 SIMPLE)
	    [
ACCESSFNS
 SIMARRAY ([
SHAPE
 (the
 ROWINT (fetch
 SHAPESLOT of
 DATUM))
					    (replace
 SHAPESLOT of
 DATUM
					       with
 (the
 ROWINT (BUMPREFCNT NEWVALUE]
			  (ELEMENTBLOCK (the
 ROWSCALAR (fetch
 SLOT2 of
 DATUM))
					(replace
 SLOT2 of
 DATUM with
 (the
 ROWSCALAR NEWVALUE))
					)
			  (OFFSETS (the
 ROWINT (fetch
 SLOT3 of
 (the
 SIMARRAY DATUM]
	    (TYPE?
 (
ARRAYTYPEP
 DATUM (
QUOTE
 SIMPLE)))
                                                             (* The CCREATE prevents re-computation of OFFSETS when

							     SHAPE is being shared in a create-using)

	    (CCREATE (
COND

		       ((
AND
 (
EQ
 USINGTYPE (
QUOTE
 using))
			       (
NOT
 (
ASSOC
 (
QUOTE
 SHAPE)
					       FIELDS.IN.CREATE)))
			 (
QUOTE
 ([LAMBDA (.AF.)
				      (
ASSERT
 (type?
 FORMATCODE (fetch
 FORMAT of
 .AF.)))
				      (BUMPREFCNT (fetch
 SHAPE of
 .AF.))
				      (replace
 ELEMENTBLOCK of
 .AF. with
 (BUMPREFCNT 
										     ELEMENTBLOCK))
				      .AF.]
				    DATUM)))
		       (T (
QUOTE
 ([LAMBDA (.AF.)
				       (
ASSERT
 (type?
 FORMATCODE (fetch
 FORMAT of
 .AF.)))
				       (replace
 SHAPE of
 .AF. with
 SHAPE)
				       (replace
 ELEMENTBLOCK of
 .AF. with
 (BUMPREFCNT 
										     ELEMENTBLOCK))
				       (replace
 SLOT3 of
 .AF.
					  with
 (
MAKEOFFSETS
 (fetch
 SHAPE of
 .AF.)))
				       .AF.]
				     DATUM]
(
DATATYPE
 (SELARRAY ARRAYFRAME)
	    (TYPE SHAPESLOT FORMAT SLOT1 BASEARRAY SLOT3 ID SLOT5)
	    TYPE _(
QUOTE
 SELECTION)
	    [
ACCESSFNS
 SELARRAY ([
SHAPE
 (the
 ROWINT (fetch
 SHAPESLOT of
 DATUM))
					    (replace
 SHAPESLOT of
 DATUM
					       with
 (the
 ROWINT (BUMPREFCNT NEWVALUE]
			  (TTAB (the
 ROWPTR (fetch
 SLOT1 of
 DATUM))
				(replace
 SLOT1 of
 DATUM with
 (the
 ROWPTR NEWVALUE)))
			  (DIMMAP (the
 ROWPTR (fetch
 SLOT3 of
 DATUM]
	    (TYPE?
 (
ARRAYTYPEP
 DATUM (
QUOTE
 SELECTION)))
	    (CREATE
 ([LAMBDA (.AF.)
			  (
ASSERT
 (type?
 FORMATCODE (fetch
 FORMAT of
 .AF.)))
			  (
ASSERT
 (type?
 SIMARRAY (fetch
 BASEARRAY of
 .AF.)))
			  (replace
 SHAPE of
 .AF. with
 SHAPE)
			  (replace
 TTAB of
 .AF. with
 (BUMPREFCNT TTAB))
			  (replace
 SLOT3 of
 .AF. with
 (BUMPREFCNT (
MAKEDIMMAP
 .AF.)))
			  .AF.]
			DATUM)))
]
(/DECLAREDATATYPE (QUOTE ARRAYFRAME)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
		  (QUOTE ((ARRAYFRAME 0 POINTER)
			  (ARRAYFRAME 2 POINTER)
			  (ARRAYFRAME 4 POINTER)
			  (ARRAYFRAME 6 POINTER)
			  (ARRAYFRAME 8 POINTER)
			  (ARRAYFRAME 10 POINTER)
			  (ARRAYFRAME 12 POINTER)
			  (ARRAYFRAME 14 POINTER)))
		  (QUOTE 16))
(/DECLAREDATATYPE (QUOTE ARRAYFRAME)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
		  (QUOTE ((ARRAYFRAME 0 POINTER)
			  (ARRAYFRAME 2 POINTER)
			  (ARRAYFRAME 4 POINTER)
			  (ARRAYFRAME 6 POINTER)
			  (ARRAYFRAME 8 POINTER)
			  (ARRAYFRAME 10 POINTER)
			  (ARRAYFRAME 12 POINTER)
			  (ARRAYFRAME 14 POINTER)))
		  (QUOTE 16))
(/DECLAREDATATYPE (QUOTE ARRAYFRAME)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
		  (QUOTE ((ARRAYFRAME 0 POINTER)
			  (ARRAYFRAME 2 POINTER)
			  (ARRAYFRAME 4 POINTER)
			  (ARRAYFRAME 6 POINTER)
			  (ARRAYFRAME 8 POINTER)
			  (ARRAYFRAME 10 POINTER)
			  (ARRAYFRAME 12 POINTER)
			  (ARRAYFRAME 14 POINTER)))
		  (QUOTE 16))
[DECLARE: EVAL@COMPILE 

(RECORD ID
 (SNF . TITLEF)
	     (TYPE?
 LISTP))

(ACCESSFN KEEPS
 [(KEEPS (
GETARRAYPROP
 DATUM (
QUOTE
 KEEPS))
			  (
SETARRAYPROP
 DATUM (
QUOTE
 KEEPS)
					  (the
 (LST OF INTEGER)
						 NEWVALUE])
]
[DECLARE: EVAL@COMPILE 

(RECORD AELTPTR
 (SOURCE . PTR)
		  [TYPE?
 (
AND
 (
LISTP
 DATUM)
				  (type?
 ARRAY (FETCH
 SOURCE OF
 DATUM])
]
(DECLARE: EVAL@COMPILE 
(PUTPROPS IJKBOX DMACRO (= . PROGN))
(PUTPROPS IVALUE DMACRO (= . PROGN))
)

(PUTPROPS fadd CLISPWORD
 (CHANGETRAN . fadd))

(PUTPROPS FADD CLISPWORD
 (CHANGETRAN . fadd))

(PUTPROPS fadd CHANGEWORD
 [LAMBDA (F)
				    (LIST (QUOTE DATUM_)
					  (APPEND (QUOTE (FPLUS DATUM))
						  (CDDR F])
)
)
(MOVD (QUOTE GETAELT)
      (QUOTE COPYAELT))
(DECLARE: DOCOPY 
(DECLARE: EVAL@LOADWHEN TESTSYS 

(DECLARE: EVAL@COMPILE

(DECLTYPES (ARRAY (SYNONYM ARRAYFRAME)
                  COERCION (
CONV.ARRAY
))
           (ARRAY ARRAY COERCION (CONV.ARRAY))
           (VECTOR (SUBTYPE ARRAY)
                   TESTFN [LAMBDA (VALUE)
			    (
ARRAYTYPEP
 VALUE (
QUOTE
 VECTOR]
                   COERCION (
CONV.VECTOR
))
           (MATRIX (SUBTYPE ARRAY)
                   TESTFN [LAMBDA (VALUE)
			    (
ARRAYTYPEP
 VALUE (
QUOTE
 MATRIX]
                   COERCION (
CONV.ARRAY
 (
ARRAYTYPEP
 UARG (
QUOTE
 MATRIX)))))
)

(DECLARE: EVAL@COMPILE

(DECLTYPE FORMATCODE (MEMQ FULL SYMMETRIC)
                     COERCION ((
OR
 (
MISSPELLED?
 UARG 80 (
QUOTE
 (FULL SYMMETRIC)))
				     (UERROR "Invalid format specification:  " .P2 UARG))))
)
)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 )
)
(PUTPROPS GLOBAL COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1105 13398 (AELTTYPE 1115 . 1764) (ALLOC.SARRAY 1766 . 2773) (ARRAYTYPEP 2775 . 3391) (
COPYIDLARRAY 3393 . 4828) (DIMENSIONP 4830 . 5227) (GETAELT 5229 . 5918) (GETARRAYPROP 5920 . 6267) (
LEVELP 6269 . 6613) (MAKEOFFSETS 6615 . 7336) (NLOGICALELTS 7338 . 7970) (NPHYSICALELTS 7972 . 8649) (
PRESERVE 8651 . 10161) (SERIALNUMBER 10163 . 10842) (SETARRAYPROP 10844 . 11194) (SETAELT 11196 . 
12416) (VFROMR 12418 . 13023) (ZEROFORARRAY 13025 . 13396)))))
STOP