(FILECREATED "27-Mar-85 08:12:36" {ERIS}<LISPCORE>LIBRARY>FLOATARRAY.;4
 41155Q 

      changes to:  (FNS \FLOATBLT)

      previous date: "26-Feb-85 12:14:56" {ERIS}<LISPCORE>LIBRARY>FLOATARRAY.;3)


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

(PRETTYCOMPRINT FLOATARRAYCOMS)

(RPAQQ FLOATARRAYCOMS
 [(* * MAPELT fns and macros)
		       (FNS MAPELT MAPELT1 MAPELT2 EXPANDMAPELT EXPANDMAPELT1 EXPANDMAPELT2 
			    RATIONALIZEMAPELT1 RATIONALIZEMAPELT2)
		       (MACROS MAPELT MAPELT1 MAPELT2)
		       (* * FFT stuff)
		       (FNS FFTSTEP \FFTSTEP)
		       (PROP DOPVAL \FFTSTEP)
		       (RECORDS FFTTABLE FFTSOURCE COMPLEX)
		       (CONSTANTS \FFTTABLESIZE)
		       (* * UFNs)
		       (FNS \FLOATBLT)
		       (PROP DOPVAL \FLOATBLT)
		       (* * For convenience)
		       (PROP ARGNAMES MAPELT \BLKEXPONENT \BLKFDIFF \BLKFLOATP2COMP \BLKFPLUS 
			     \BLKFTIMES \BLKMAG \BLKPERM \BLKSEP \BLKSMALLP2FLOAT \IBLT1 \IBLT2)
		       (MACROS ARRAYHIELT DOUBLE QUADRUPLE)
		       (FNS ARRAYBASE)
		       (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
				 (ADDVARS (NLAMA)
					  (NLAML)
					  (LAMA MAPELT])
(* * MAPELT fns and macros)


(DEFINEQ

(MAPELT

  [LAMBDA ARGS                                               (* hdj "13-Nov-84 14:25")


          (* * Top level entry to array mapper: recognizes MAPELT1 and MAPELT2 cases.)




          (* * if RESULT is not an array, ARRAY1 had better be)



    (LET ((RESULT (
ARG
 ARGS 1))
       (MAPFN (
ARG
 ARGS 2))
       (ARRAY1 (
ARG
 ARGS 3)))
      (
SELECTQ
 ARGS
	       (3 (MAPELT1
 RESULT MAPFN ARRAY1))
	       (4 (MAPELT2
 RESULT MAPFN ARRAY1 (
ARG
 ARGS 4)))
	       (LET* ([INPUTARRAYBASES (for
 ARGUMENT from
 3 to
 ARGS collect
 (ARRAYBASE (
ARG
 ARGS 
											 ARGUMENT]
		  (NUMINPUTARRAYS (
LENGTH
 INPUTARRAYBASES))
		  (ELEMENTS (
ARRAYSIZE
 ARRAY1))
		  [GOODRESULT (
OR
 (
ARRAYP
 RESULT)
				  (
ARRAY
 (
ARRAYSIZE
 ARRAY1)
					 (
QUOTE
 FLOATP)
					 0.0
					 (
ARRAYORIG
 ARRAY1]
		  (RESULTBASE (ARRAYBASE GOODRESULT)))
		 [for
 ELEMENT from
 0 to
 ELEMENTS
		    do
 (
\PUTBASEFLOATP
 RESULTBASE (DOUBLE ELEMENT)
				       (
APPLY
 MAPFN
					      (for
 OPERAND from
 1 to
 NUMINPUTARRAYS as
 ARRAY
						 in
 INPUTARRAYBASES collect
 (
\GETBASEFLOATP

									      ARRAY
									      (DOUBLE ELEMENT]
		 GOODRESULT])

(MAPELT1

  [LAMBDA (RESULT MAPFN ARRAY)                               (* hdj "28-Sep-84 12:44")


          (* * Map a function across an array. Recognizes the special cases that can run in microcode.)



    (LET [(GOODRESULT (
OR
 RESULT (
ARRAY
 (
ARRAYSIZE
 ARRAY)
					(
QUOTE
 FLOATP)
					0.0
					(
ARRAYORIG
 ARRAY]
	 (LET ((
ARRAYSIZE
 (
ARRAYSIZE
 ARRAY))
	       (ARRAYBASE (ARRAYBASE ARRAY))
	       (RESULTBASE (ARRAYBASE GOODRESULT)))
	      [
SELECTQ
 MAPFN
		       (EXPONENT (\BLKEXPONENT ARRAYBASE RESULTBASE ARRAYSIZE))
		       (MAGNITUDE (\BLKMAG ARRAYBASE RESULTBASE (HALF ARRAYSIZE)))
		       (
FLOAT
 (\BLKSMALLP2FLOAT ARRAYBASE RESULTBASE ARRAYSIZE))
		       (COMPLEXIFYFLOATP (\BLKFLOATP2COMP ARRAYBASE RESULTBASE ARRAYSIZE))
		       (SEPARATE (\BLKSEP ARRAYBASE (
\ADDBASE
 ARRAYBASE (DOUBLE (
IDIFFERENCE

										  (
ARRAYSIZE
 ARRAY)
										  2)))
					  RESULTBASE ARRAYSIZE))
		       (for
 ELT from
 0 to
 (DOUBLE (
SUB1
 ARRAYSIZE)) by
 2
			  do
 (
\PUTBASEFLOATP
 RESULTBASE ELT (
APPLY*
 MAPFN (
\GETBASEFLOATP
 ARRAYBASE 
											  ELT]
	      GOODRESULT])

(MAPELT2

  [LAMBDA (RESULT MAPFN ARRAY1 ARRAY2)                       (* hdj "28-Sep-84 13:31")


          (* * Map a function across two arrays. Recognizes the cases that can run in microcode.)



    (
PROG
 (ARRAY1SIZE ARRAY1BASE ARRAY2SIZE ARRAY2BASE RESULTBASE)

          (* if ARRAY1 is really an array, leave it alone. Otherwise it is a constant; create an array that has each elt equal

	  to that constant)



          [
SETQ
 ARRAY1 (
OR
 (
ARRAYP
 ARRAY1)
			   (if
 (
ARRAYP
 ARRAY2)
			       then
 (
ARRAY
 (
ARRAYSIZE
 ARRAY2)
					   (
QUOTE
 FLOATP)
					   ARRAY1
					   (
ARRAYORIG
 ARRAY2))
			     else
 (
HELP
 "Neither ARRAY1 nor ARRAY2 is an array"]

          (* * same, but for ARRAY2)



          [
SETQ
 ARRAY2 (
OR
 (
ARRAYP
 ARRAY2)
			   (if
 (
ARRAYP
 ARRAY1)
			       then
 (
ARRAY
 (
ARRAYSIZE
 ARRAY1)
					   (
QUOTE
 FLOATP)
					   ARRAY1
					   (
ARRAYORIG
 ARRAY1))
			     else
 (
HELP
 "Neither ARRAY1 nor ARRAY2 is an array"]
          [
SETQ
 RESULT (
OR
 (
ARRAYP
 RESULT)
			   (
ARRAY
 (
ARRAYSIZE
 ARRAY1)
				  (
QUOTE
 FLOATP)
				  0.0
				  (
ARRAYORIG
 ARRAY1]
          (
SETQ
 ARRAY1SIZE (
ARRAYSIZE
 ARRAY1))
          (
SETQ
 ARRAY1BASE (ARRAYBASE ARRAY1))
          (
SETQ
 ARRAY2SIZE (
ARRAYSIZE
 ARRAY2))
          (
SETQ
 ARRAY2BASE (ARRAYBASE ARRAY2))
          (
SETQ
 RESULTBASE (ARRAYBASE RESULT))
          [
SELECTQ
 MAPFN
		   (
FTIMES
 (\BLKFTIMES ARRAY1BASE ARRAY2BASE RESULTBASE ARRAY1SIZE))
		   ((PERMUTE ELT)
		     (\BLKPERM ARRAY1BASE ARRAY2BASE RESULTBASE ARRAY1SIZE))
		   (
FPLUS
 (\BLKFPLUS ARRAY1BASE ARRAY2BASE RESULTBASE ARRAY1SIZE))
		   (FDIFF (\BLKFDIFF ARRAY1BASE ARRAY2BASE RESULTBASE ARRAY1SIZE))
		   (for
 ELT from
 0 to
 (DOUBLE (
SUB1
 ARRAY1SIZE)) by
 2
		      do
 (
\PUTBASEFLOATP
 RESULTBASE ELT (
APPLY*
 MAPFN (
\GETBASEFLOATP
 ARRAY1BASE ELT)
								(
\GETBASEFLOATP
 ARRAY2BASE ELT]
          (
RETURN
 RESULT])

(EXPANDMAPELT

  [LAMBDA (ARGS)                                             (* hdj "28-Sep-84 12:12")


          (* * Expands the MAPELT macro. Recognizes when you want MAPELT1 and when you want MAPELT2)




          (* * Args looks like "(RESULT MAPFN ARRAY1 {ARRAY2})")



    (LET ((ARRAY2 (
CADDDR
 ARGS)))
	 (if
 ARRAY2
	     then
 (EXPANDMAPELT2
 ARGS)
	   else
 (EXPANDMAPELT1
 ARGS])

(EXPANDMAPELT1

  [LAMBDA (ARGS)                                             (* hdj "26-Sep-84 18:50")


          (* * Expands the MAPELT macro. Recognizes when MAPFN equals EXPONENT, MAGNITUDE, FLOATSMALLP, COMPLEXIFYFLOATP, or 

	  SEPARATE, and expands into a call on the appropriate opcodes.)



    (
PROG
 ((RESULT (
CAR
 ARGS))
	   (MAPFN (
CADR
 ARGS))
	   (
ARRAY
 (
CADDR
 ARGS)))
          (
RETURN
 (if
 (
OR
 (
EQ
 (
CAR
 MAPFN)
			      (
QUOTE
 QUOTE))
			  (
EQ
 (
CAR
 MAPFN)
			      (
QUOTE
 FUNCTION)))
		      then
 (
SELECTQ
 (
CADR
 MAPFN)
				    (EXPONENT (RATIONALIZEMAPELT1
 RESULT (
QUOTE
 \BLKEXPONENT)
								  ARRAY))
				    (MAGNITUDE (RATIONALIZEMAPELT1
 RESULT (
QUOTE
 \BLKMAG)
								   ARRAY))
				    (FLOATSMALLP (RATIONALIZEMAPELT1
 RESULT (
QUOTE
 \BLKSMALLP2FLOAT)
								     ARRAY))
				    (COMPLEXIFYFLOATP (RATIONALIZEMAPELT1
 RESULT (
QUOTE
 
										  \BLKFLOATP2COMP)
									  ARRAY))
				    [SEPARATE (
BQUOTE
 (
PROG
 ((SIZE (
ARRAYSIZE
 , ARRAY))
							     RESULT)
							    [
SETQ
 RESULT
							      (
OR
 (
ARRAYP
 RESULT)
								  (
ARRAY
 SIZE (
QUOTE
 FLOATP)
									 0.0
									 (
ARRAYORIG
 , ARRAY]
							    (\BLKSEP (ARRAYBASE , ARRAY)
								     (
\ADDBASE
 (ARRAYBASE , ARRAY)
									       (DOUBLE (
IDIFFERENCE

											 SIZE 2)))
								     (ARRAYBASE , RESULT)
								     SIZE)
							    (
RETURN
 RESULT]
				    (
QUOTE
 IGNOREMACRO))
		    else
 (
QUOTE
 IGNOREMACRO])

(EXPANDMAPELT2

  [LAMBDA (ARGS)                                             (* hdj "28-Sep-84 11:57")


          (* * Expands the MAPELT2 macro. Recognizes when MAPFN equals FTIMES, PERMUTE, ELT, FPLUS, FDIFF, or SEP, and expands

	  into a call on the appropriate opcodes.)



    (LET ((RESULT (
CAR
 ARGS))
	  (MAPFN (
CADR
 ARGS))
	  (ARRAY1 (
CADDR
 ARGS))
	  (ARRAY2 (
CADDDR
 ARGS)))
	 (if
 (
OR
 (
EQ
 (
CAR
 MAPFN)
		     (
QUOTE
 QUOTE))
		 (
EQ
 (
CAR
 MAPFN)
		     (
QUOTE
 FUNCTION)))
	     then
 (
SELECTQ
 (
CADR
 MAPFN)
			   (
FTIMES
 (RATIONALIZEMAPELT2
 RESULT (
QUOTE
 \BLKFTIMES)
						       ARRAY1 ARRAY2))
			   ((PERMUTE ELT)
			     (RATIONALIZEMAPELT2
 RESULT (
QUOTE
 \BLKPERM)
						 ARRAY1 ARRAY2))
			   (
FPLUS
 (RATIONALIZEMAPELT2
 RESULT (
QUOTE
 \BLKFPLUS)
						      ARRAY1 ARRAY2))
			   (FDIFF (RATIONALIZEMAPELT2
 RESULT (
QUOTE
 \BLKFDIFF)
						      ARRAY1 ARRAY2))
			   (
QUOTE
 IGNOREMACRO))
	   else
 (
QUOTE
 IGNOREMACRO])

(RATIONALIZEMAPELT1

  [LAMBDA (ACTUALRESULT ACTUALMAPFN ACTUALARRAY)             (* hdj "28-Sep-84 11:48")

    (
BQUOTE
 (LET* [(SIZE (
ARRAYSIZE
 , ACTUALARRAY))
		   (RESULT (
OR
 (
ARRAYP
 , ACTUALRESULT)
			       (
ARRAY
 SIZE (
QUOTE
 FLOATP)
				      0.0
				      (
ARRAYORIG
 , ACTUALARRAY]
		  (, ACTUALMAPFN (ARRAYBASE , ACTUALARRAY)
		     (ARRAYBASE RESULT)
		     SIZE)
		  RESULT])

(RATIONALIZEMAPELT2

  [LAMBDA (ACTUALRESULT ACTUALMAPFN ACTUALARRAY1 ACTUALARRAY2)
                                                             (* hdj "12-Nov-84 17:14")

    (
BQUOTE
 (LET* [(SIZE (
ARRAYSIZE
 , ACTUALARRAY1))
	       (RESULT (
OR
 (
ARRAYP
 , ACTUALRESULT)
			   (
ARRAY
 SIZE (
QUOTE
 FLOATP)
				  0.0
				  (
ARRAYORIG
 , ACTUALARRAY1]
	      (, ACTUALMAPFN (ARRAYBASE , ACTUALARRAY1)
		 (ARRAYBASE , ACTUALARRAY2)
		 (ARRAYBASE RESULT)
		 SIZE)
	      RESULT])
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS MAPELT MACRO
 (ARGS (EXPANDMAPELT ARGS)))

(PUTPROPS MAPELT1 MACRO
 (ARGS (EXPANDMAPELT1 ARGS)))

(PUTPROPS MAPELT2 DMACRO
 (ARGS (EXPANDMAPELT2 ARGS)))
)
(* * FFT stuff)


(DEFINEQ

(FFTSTEP

  [LAMBDA (FFTTABLE)                                         (* hdj "23-Jul-84 23:50")

    (
\BLT
 \FFTTABLE FFTTABLE \FFTTABLESIZE)
    (\FFTSTEP
 \FFTTABLE (fetch
 (FFTTABLE LCNT) of
 FFTTABLE])

(\FFTSTEP

  [LAMBDA (TABLE COUNTLO)                                    (* hdj "25-Sep-84 19:15")

    (
PROG
 (X Y)
          [with
 FFTTABLE TABLE (do
 (with
 FFTSOURCE (
\ADDBASE
 SOURCE (
ITIMES
 2 (
IPLUS
 HCNT COUNTLO)))
					 (
SETQ
 X (
FDIFFERENCE
 (
FTIMES
 C TWIDDLE)
							      (
FTIMES
 D ITWIDDLE)))
					 (
SETQ
 Y (
FPLUS
 (
FTIMES
 C ITWIDDLE)
							(
FTIMES
 D TWIDDLE)))
					 (SETCOMPLEX (
\ADDBASE
 ABDEST (
IPLUS
 HCNT COUNTLO))
						     (
FPLUS
 A X)
						     (
FPLUS
 B Y))
					 (SETCOMPLEX (
\ADDBASE
 CDDEST (
IPLUS
 HCNT COUNTLO))
						     (
FDIFFERENCE
 A X)
						     (
FDIFFERENCE
 B Y))
					 (
COND

					   ((
IGREATERP
 COUNTLO 0)
					     (add
 COUNTLO -4))
					   ((
ILEQ
 HCNT 0)    (* return from iteration)

					     (
OR
 (
EQ
 HCNT 0)
						 (
SHOULDNT
))
					     (
RETURN
))
					   (T (
SETQ
 HCNT (
IDIFFERENCE
 HCNT TCNT))
					      (
SETQ
 COUNTLO (
IDIFFERENCE
 TCNT 4))
					      (
SETQ
 X (
FDIFFERENCE
 (
FTIMES
 TWIDDLE DELTA)
								   (
FTIMES
 ITWIDDLE IDELTA)))
					      (
SETQ
 ITWIDDLE (
FPLUS
 (
FTIMES
 ITWIDDLE DELTA)
								    (
FTIMES
 TWIDDLE IDELTA)))
					      (
SETQ
 TWIDDLE X]
          (
RETURN
 0])
)

(PUTPROPS \FFTSTEP DOPVAL
 (2 FFTSTEP))
[DECLARE: EVAL@COMPILE 

(DATATYPE FFTTABLE
 ((TWIDDLE FLOATP)
		    (ITWIDDLE FLOATP                         (* imaginary part of TWIDDLE)
)
		    (SOURCE XPOINTER                         (* virtual address of source array base)
)
		    (ABDEST XPOINTER                         (* virtual address of destination array base)

			    )
		    (CDDEST XPOINTER                         (* midpoint in destination array)
)
		    (TCNT WORD                               (* count of butterfiles with same twiddle x4)

			  )
		    (HCNT WORD                               (* (mod cnt tcnt) high portion of count of butterflies 

							     remaining x4)
)
		    (NIL 2 FLOATP                            (* must have floating complex zero here)
)
		    (DELTA FLOATP                            (* packed complex root of unity to change twiddle)

			   )
		    (IDELTA FLOATP                           (* imaginary part of DELTA)
)
		    (LCNT WORD                               (* (remainder cnt tcnt) low portion of count of 

							     butterflies remaining x4)
)
		    (PAD 13Q WORD                            (* padding so that FFTTABLE will never cross page 

							     boundary.)
)))

(BLOCKRECORD FFTSOURCE
 ((A FLOATP)
			(B FLOATP)
			(C FLOATP)
			(D FLOATP)))

(BLOCKRECORD COMPLEX
 ((REAL FLOATP)
		      (IMAG FLOATP)))
]
(/DECLAREDATATYPE (QUOTE FFTTABLE)
		  (QUOTE (FLOATP FLOATP XPOINTER XPOINTER XPOINTER WORD WORD FLOATP FLOATP FLOATP 
				 FLOATP WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD))
		  [QUOTE ((FFTTABLE 0 FLOATP)
			  (FFTTABLE 2 FLOATP)
			  (FFTTABLE 4 XPOINTER)
			  (FFTTABLE 6 XPOINTER)
			  (FFTTABLE 10Q XPOINTER)
			  (FFTTABLE 12Q (BITS . 17Q))
			  (FFTTABLE 13Q (BITS . 17Q))
			  (FFTTABLE 14Q FLOATP)
			  (FFTTABLE 16Q FLOATP)
			  (FFTTABLE 20Q FLOATP)
			  (FFTTABLE 22Q FLOATP)
			  (FFTTABLE 24Q (BITS . 17Q))
			  (FFTTABLE 25Q (BITS . 17Q))
			  (FFTTABLE 26Q (BITS . 17Q))
			  (FFTTABLE 27Q (BITS . 17Q))
			  (FFTTABLE 30Q (BITS . 17Q))
			  (FFTTABLE 31Q (BITS . 17Q))
			  (FFTTABLE 32Q (BITS . 17Q))
			  (FFTTABLE 33Q (BITS . 17Q))
			  (FFTTABLE 34Q (BITS . 17Q))
			  (FFTTABLE 35Q (BITS . 17Q))
			  (FFTTABLE 36Q (BITS . 17Q))
			  (FFTTABLE 37Q (BITS . 17Q]
		  (QUOTE 40Q))
(DECLARE: EVAL@COMPILE 

(RPAQQ \FFTTABLESIZE
 40Q)

(CONSTANTS \FFTTABLESIZE)
)
(* * UFNs)


(DEFINEQ

(\FLOATBLT

  [LAMBDA (SOURCE1 SOURCE2 DEST N OPERATION)                 (* lmm "27-Mar-85 08:12")

    (for
 I from
 0 to
 (
PLUS
 N N) by
 2 do
 (
\PUTBASEFLOATP
 DEST I
							(
SELECTQ
 OPERATION
								 (0 (FLOATWRAP (
\GETBASEFLOATP
 
											  SOURCE1 I)))
								 (1 (FLOATUNWRAP (
\GETBASEFLOATP

										   SOURCE1 I)))
								 (2 (
FLOAT
 (
\GETBASEFIXP
 SOURCE1 I)))
								 (3 (
\PUTBASEFIXP

								      DEST I (
FIX
 (
\GETBASEFLOATP

										    SOURCE1 I)))
								    (
GO
 $$ITERATE))
								 (4 (
FPLUS
 (
\GETBASEFLOATP
 SOURCE1 I)
									   (
\GETBASEFLOATP
 SOURCE2 I))
								    )
								 (5 (
FDIFFERENCE
 (
\GETBASEFLOATP

										   SOURCE1 I)
										 (
\GETBASEFLOATP

										   SOURCE2 I)))
								 (6 (
FDIFFERENCE
 (
\GETBASEFLOATP

										   SOURCE2 I)
										 (
\GETBASEFLOATP

										   SOURCE1 I)))
								 [7 (
FPLUS
 (
ABS
 (
\GETBASEFLOATP

										  SOURCE1 I))
									   (
ABS
 (
\GETBASEFLOATP

										  SOURCE2 I]
								 [10Q (
ABS
 (
FDIFFERENCE
 (

\GETBASEFLOATP
 SOURCE1 I)
											(

\GETBASEFLOATP
 SOURCE2 I]
								 [11Q (
ABS
 (
FPLUS
 (
\GETBASEFLOATP

										    SOURCE1 I)
										  (
\GETBASEFLOATP

										    SOURCE2 I]
								 (20Q (
FTIMES
 (
\GETBASEFLOATP
 SOURCE1 
											      I)
									      (
\GETBASEFLOATP
 SOURCE2 
											      I)))
								 (
SHOULDNT
])
)

(PUTPROPS \FLOATBLT DOPVAL
 (5 FLOATBLT))
(* * For convenience)



(PUTPROPS MAPELT ARGNAMES
 "RESULT MAPFN ARRAY1")

(PUTPROPS \BLKEXPONENT ARGNAMES
 (source destination kount))

(PUTPROPS \BLKFDIFF ARGNAMES
 (source1 source2 dest kount))

(PUTPROPS \BLKFLOATP2COMP ARGNAMES
 (source destination kount))

(PUTPROPS \BLKFPLUS ARGNAMES
 (source1 source2 dest kount))

(PUTPROPS \BLKFTIMES ARGNAMES
 (source1 source2 dest kount))

(PUTPROPS \BLKMAG ARGNAMES
 (complexArray magnitudeArray kount))

(PUTPROPS \BLKPERM ARGNAMES
 (orig permutations destination kount))

(PUTPROPS \BLKSEP ARGNAMES
 (source1 source2 dest kount))

(PUTPROPS \BLKSMALLP2FLOAT ARGNAMES
 (source destination kount))

(PUTPROPS \IBLT1 ARGNAMES
 (ValueArray TextureArray XCoord BitmapAddr BitmapWidth ValHeight ValWidth 
				      Kount))

(PUTPROPS \IBLT2 ARGNAMES
 (ValueArray TextureArray XCoord BitmapAddr BitmapWidth ValHeight ValWidth 
				      Kount))
(DECLARE: EVAL@COMPILE 

(PUTPROPS ARRAYHIELT MACRO
 [(
ARRAY
)
			    (
IPLUS
 (
ARRAYSIZE
 ARRAY)
				   (
SUB1
 (
ARRAYORIG
 ARRAY])

(PUTPROPS DOUBLE MACRO
 ((A)
			(
LLSH
 A 1)))

(PUTPROPS QUADRUPLE MACRO
 ((A)
			   (
LLSH
 A 2)))
)
(DEFINEQ

(ARRAYBASE

  [LAMBDA (
ARRAY
)                                            (* hdj "14-Nov-84 18:16")

    (FETCH
 (
ARRAYP
 BASE) OF
 ARRAY])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 MAPELT)
)
(PUTPROPS FLOATARRAY COPYRIGHT ("Xerox Corporation" 3700Q 3701Q))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2263Q 22702Q (MAPELT 2275Q . 4642Q) (MAPELT1 4644Q . 7057Q) (MAPELT2 7061Q . 13071Q) (
EXPANDMAPELT 13073Q . 13741Q) (EXPANDMAPELT1 13743Q . 17007Q) (EXPANDMAPELT2 17011Q . 21041Q) (
RATIONALIZEMAPELT1 21043Q . 21706Q) (RATIONALIZEMAPELT2 21710Q . 22700Q)) (23240Q 26235Q (FFTSTEP 
23252Q . 23612Q) (\FFTSTEP 23614Q . 26233Q)) (33057Q 36014Q (\FLOATBLT 33071Q . 36012Q)) (40342Q 
40613Q (ARRAYBASE 40354Q . 40611Q)))))
STOP