(FILECREATED "30-Jan-86 12:43:44" {QV}<PEDERSEN>LISP>VBLAS.;1 29577
changes to: (FNS \FLOATARRAYFILL \FLOATARRAYBLT)
previous date: "28-Jan-86 23:34:14" {QV}<PEDERSEN>LISP>BLAS.;7)
(PRETTYCOMPRINT VBLASCOMS)
(RPAQQ VBLASCOMS ((FNS BLAS.ARRAYBLT BLAS.ARRAYFILL BLAS.ASUM BLAS.AXPY BLAS.COPY BLAS.DOTPROD
BLAS.MAX BLAS.NRM2 BLAS.ROT BLAS.SCAL BLAS.SWAP BLAS.TRANSPOSE
\FLOATARRAYBLT \FLOATARRAYFILL)
(MACROS BLAS.CHECKARRAY BLAS.CHECKOFFSET BLAS.CHECKSIZE BLAS.CHECKSKIP
BLAS.COMPUTECNT MUL32)
(VARS SAVINGS (\BLAS.SIZELIMIT FFTSSIZE)
(\BLAS.SCRATCH1 (MAKE-ARRAY \BLAS.SIZELIMIT (QUOTE :ELEMENT-TYPE)
(QUOTE FLOAT)
(QUOTE :ALIGNMENT)
128
(QUOTE :INITIAL-ELEMENT)
0.0))
(\BLAS.SCRATCH2 (MAKE-ARRAY \BLAS.SIZELIMIT (QUOTE :ELEMENT-TYPE)
(QUOTE FLOAT)
(QUOTE :ALIGNMENT)
128
(QUOTE :INITIAL-ELEMENT)
0.0)))
(GLOBALVARS \BLAS.SIZELIMIT \BLAS.SCRATCH1 \BLAS.SCRATCH2)
(INITRECORDS PILOTBBT)
(DECLARE: DONTCOPY DOEVAL@COMPILE (RECORDS PILOTBBT))
(DECLARE: DONTEVAL@LOAD DONTCOPY DOEVAL@COMPILE (LOCALVARS . T))))
(DEFINEQ
(BLAS.ARRAYBLT
[LAMBDA (SOURCE SOURCEOFFSET SOURCESKIP DEST DESTOFFSET DESTSKIP CNT)
(* jop: "28-Jan-86 14:30")
(* * Blt CNT entries of SOURCE starting at SOURCEOFFSET with skip SOURCESKIP to DEST starting at DESTOFFSET with
skip DESTSKIP. SOURCE and DEST must be FLOATP ARRAYS. If DEST is NIL will create an array of the appropriate size.
SOURCEOFFSET and DESTOFFSET default to zero. SOURCESKIP and DESTSKIP default to one. CNT defaults to the max count
commensurate with SOURCEOFFSET and SOURCESKIP. Returns DEST)
(BLAS.CHECKARRAY SOURCE)
(PROG ((SOURCESIZE (ARRAY-TOTAL-SIZE SOURCE))
DESTSIZE)
(* * Start arg checking)
(BLAS.CHECKOFFSET SOURCEOFFSET SOURCESIZE)
(BLAS.CHECKSKIP SOURCESKIP)
(if (NULL CNT)
then (SETQ CNT (BLAS.COMPUTECNT SOURCESIZE SOURCEOFFSET SOURCESKIP))
elseif (ILEQ CNT 0)
then (* Return DEST in the degenerate case)
(RETURN DEST))
(BLAS.CHECKSIZE SOURCESIZE SOURCEOFFSET SOURCESKIP CNT)
(if (NULL DEST)
then (SETQ DEST (MAKE-ARRAY CNT (QUOTE :ELEMENT-TYPE)
(QUOTE FLOAT)))
else (BLAS.CHECKARRAY DEST))
(SETQ DESTSIZE (ARRAY-TOTAL-SIZE DEST))
(BLAS.CHECKOFFSET DESTOFFSET DESTSIZE)
(BLAS.CHECKSKIP DESTSKIP)
(BLAS.CHECKSIZE DESTSIZE DESTOFFSET DESTSKIP CNT)
(* * Do the BLT)
(\FLOATARRAYBLT (ARRAYBASE SOURCE)
SOURCEOFFSET SOURCESKIP (ARRAYBASE DEST)
DESTOFFSET DESTSKIP CNT)
(RETURN DEST])
(BLAS.ARRAYFILL
[LAMBDA (SOURCEFLOATP DEST DESTOFFSET DESTSKIP CNT) (* jop: "28-Jan-86 20:41")
(* * Fill the float array DEST starting at DESTOFFSET with skip DESTSKIP with the FLOATP SOURCEFLOATP.
DESTOFFSET defaults to zero. DESTSKIP defaults to one. CNT defaults to the max count commensurate with DESTOFFSET
and DESTSKIP. Returns DEST)
(SETQ SOURCEFLOATP (FLOAT SOURCEFLOATP))
(PROG (DESTSIZE)
(* * Start arg checking)
(if (AND CNT (NULL DEST))
then (SETQ DEST (MAKE-ARRAY CNT (QUOTE :ELEMENT-TYPE)
(QUOTE FLOAT)))
else (BLAS.CHECKARRAY DEST))
(SETQ DESTSIZE (ARRAY-TOTAL-SIZE DEST))
(BLAS.CHECKOFFSET DESTOFFSET DESTSIZE)
(BLAS.CHECKSKIP DESTSKIP)
(if (NULL CNT)
then (SETQ CNT (BLAS.COMPUTECNT DESTSIZE DESTOFFSET DESTSKIP)))
(if (IGREATERP CNT 0)
then (BLAS.CHECKSIZE DESTSIZE DESTOFFSET DESTSKIP CNT)
(* * Do the array fill)
(\FLOATARRAYFILL SOURCEFLOATP (ARRAYBASE DEST)
DESTOFFSET DESTSKIP CNT))
(RETURN DEST])
(BLAS.ASUM
[LAMBDA (X XOFFSET XSKIP CNT) (* jop: "28-Jan-86 20:09")
(* * Implements BLAS sum of magnitudes. X must be a FLOAT array. CNT defaults to largest vector commensurate with
XOFFSET and XSKIP. Returns 0 if CNT < 0, else Returns X)
(BLAS.CHECKARRAY X)
(PROG ((XSIZE (ARRAY-TOTAL-SIZE X)))
(* * Start arg checking)
(BLAS.CHECKOFFSET XOFFSET XSIZE)
(BLAS.CHECKSKIP XSKIP)
(if (NULL CNT)
then (SETQ CNT (BLAS.COMPUTECNT XSIZE XOFFSET XSKIP))
elseif (ILEQ CNT 0)
then (* Return 0.0 in the degenerate case)
(RETURN 0.0))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT)
(* * No opcode for FABS)
(RETURN (bind (XBASE ←(ARRAYBASE X))
(RESULT ← 0.0) for I from 0 to CNT as INDEX
from (MUL2 XOFFSET) by (MUL2 XSKIP) declare (TYPE FLOATP RESULT)
do [SETQ RESULT (FPLUS RESULT (FABS (\GETBASEFLOATP XBASE INDEX]
finally (RETURN RESULT])
(BLAS.AXPY
[LAMBDA (SCALAR X XOFFSET XSKIP Y YOFFSET YSKIP CNT) (* jop: "28-Jan-86 21:23")
(* * Implements BLAS elementary vector operation (Y = SCALAR * X + Y) X and Y must be FLOAT arrays.
SCALAR must be a FLOATP. CNT defaults to largest vector commensurate with XOFFSET and XSKIP.
Returns NIL if CNT < 0, else Returns Y)
(SETQ SCALAR (FLOAT SCALAR))
(BLAS.CHECKARRAY X)
(BLAS.CHECKARRAY Y)
(PROG ((XSIZE (ARRAY-TOTAL-SIZE X))
(YSIZE (ARRAY-TOTAL-SIZE Y)))
(* * Start arg checking)
(BLAS.CHECKOFFSET XOFFSET XSIZE)
(BLAS.CHECKSKIP XSKIP)
(BLAS.CHECKOFFSET YOFFSET YSIZE)
(BLAS.CHECKSKIP YSKIP)
(if (NULL CNT)
then (SETQ CNT (BLAS.COMPUTECNT XSIZE XOFFSET XSKIP))
elseif (ILEQ CNT 0)
then (* Return NIL in the degenerate case)
(RETURN NIL))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT)
(BLAS.CHECKSIZE YSIZE YOFFSET YSKIP CNT)
(* * Compute the result using array ops)
(LET ((XBASE (ARRAYBASE X))
(YBASE (ARRAYBASE Y))
(TEMPBASE1 \SLICE1)
(TEMPBASE2 \SLICE2))
(\FLOATARRAYFILL SCALAR TEMPBASE1 0 1 CNT)
(if (EQ XSKIP 1)
then (\BLKFTIMES (\ADDBASE XBASE (MUL2 XOFFSET))
TEMPBASE1 TEMPBASE1 CNT)
else (\FLOATARRAYBLT XBASE XOFFSET XSKIP TEMPBASE2 0 1 CNT)
(\BLKFTIMES TEMPBASE2 TEMPBASE1 TEMPBASE1 CNT))
(if (EQ YSKIP 1)
then (SETQ YBASE (\ADDBASE YBASE (MUL2 YOFFSET)))
(\BLKFPLUS TEMPBASE1 YBASE YBASE CNT)
else (\FLOATARRAYBLT YBASE YOFFSET YSKIP TEMPBASE2 0 1 CNT)
(\BLKFPLUS TEMPBASE1 TEMPBASE2 TEMPBASE2 CNT)
(\FLOATARRAYBLT TEMPBASE2 0 1 YBASE YOFFSET YSKIP CNT)))
(RETURN Y])
(BLAS.COPY
[LAMBDA (X XOFFSET XSKIP Y YOFFSET YSKIP CNT) (* jop: "28-Jan-86 15:25")
(* * Implements BLAS array copy. Returns NIL if CNT < 0 else returns Y)
(if (AND CNT (ILESSP CNT 0))
then NIL
else (BLAS.ARRAYBLT X XOFFSET XSKIP Y YOFFSET YSKIP CNT])
(BLAS.DOTPROD
[LAMBDA (X XOFFSET XSKIP Y YOFFSET YSKIP CNT) (* jop: "28-Jan-86 15:22")
(* * Implements BLAS dot product. X and Y must be FLOAT arrays. CNT defaults to largest vector commensurate with
XOFFSET and XSKIP Returns 0 if CNT < 0)
(BLAS.CHECKARRAY X)
(BLAS.CHECKARRAY Y)
(PROG ((XSIZE (ARRAY-TOTAL-SIZE X))
(YSIZE (ARRAY-TOTAL-SIZE Y)))
(* * Start arg checking)
(BLAS.CHECKOFFSET XOFFSET XSIZE)
(BLAS.CHECKSKIP XSKIP)
(BLAS.CHECKOFFSET YOFFSET YSIZE)
(BLAS.CHECKSKIP YSKIP)
(if (NULL CNT)
then (SETQ CNT (BLAS.COMPUTECNT XSIZE XOFFSET XSKIP))
elseif (ILEQ CNT 0)
then (* Return 0.0 in the degenerate case)
(RETURN 0.0))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT)
(BLAS.CHECKSIZE YSIZE YOFFSET YSKIP CNT)
(* * Compute the inner product using array ops)
(RETURN (LET ((XBASE (ARRAYBASE X))
(YBASE (ARRAYBASE Y))
(TEMPBASE1 \SLICE1)
(TEMPBASE2 \SLICE2)
SOURCEBASE DESTBASE)
(if (EQ XSKIP 1)
then (\FLOATARRAYBLT YBASE YOFFSET YSKIP TEMPBASE1 0 1 CNT)
(SETQ SOURCEBASE (\ADDBASE XBASE (MUL2 XOFFSET)))
(SETQ DESTBASE TEMPBASE1)
elseif (EQ YSKIP 1)
then (\FLOATARRAYBLT XBASE XOFFSET XSKIP TEMPBASE1 0 1 CNT)
(SETQ SOURCEBASE (\ADDBASE YBASE (MUL2 YOFFSET)))
(SETQ DESTBASE TEMPBASE1)
else (\FLOATARRAYBLT XBASE XOFFSET XSKIP TEMPBASE1 0 1 CNT)
(\FLOATARRAYBLT YBASE YOFFSET YSKIP TEMPBASE2 0 1 CNT)
(SETQ SOURCEBASE TEMPBASE1)
(SETQ DESTBASE TEMPBASE2))
(\BLKFTIMES SOURCEBASE DESTBASE DESTBASE CNT)
(\POLYNOM 1.0 DESTBASE (SUB1 CNT])
(BLAS.MAX
[LAMBDA (X XOFFSET XSKIP CNT) (* jop: "28-Jan-86 15:07")
(* * Implements BLAS array max. Returns 0 if CNT < 0 else returns index of entry with maximum absolute value)
(BLAS.CHECKARRAY X)
(PROG ((XSIZE (ARRAY-TOTAL-SIZE X)))
(* * Start arg checking)
(BLAS.CHECKOFFSET XOFFSET XSIZE)
(BLAS.CHECKSKIP XSKIP)
(if (NULL CNT)
then (SETQ CNT (BLAS.COMPUTECNT XSIZE XOFFSET XSKIP))
elseif (ILEQ CNT 0)
then (* RETURN 0.0 in the degenerate case)
(RETURN 0.0))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT) (* Check Opcode limit)
(if (IGREATERP CNT 8192)
then (HELP "CNT exceeds max size of 8192" CNT))
(* * Compute result using array ops)
(RETURN (LET ((XBASE (ARRAYBASE X))
(TEMPBASE \SLICE1))
(if (EQ XSKIP 1)
then (\BLKFABSMAX (\ADDBASE XBASE (MUL2 XOFFSET))
0 CNT)
else (\FLOATARRAYBLT XBASE XOFFSET XSKIP TEMPBASE 0 1 CNT)
(\BLKFABSMAX TEMPBASE 0 CNT])
(BLAS.NRM2
[LAMBDA (X XOFFSET XSKIP CNT) (* jop: "28-Jan-86 14:50")
(* * Implements BLAS euclidean norm. X must be a FLOAT array. CNT defaults to largest vector commensurate with
XOFFSET and XSKIP. Returns 0.0 if CNT < 0)
(if (AND CNT (ILESSP CNT 0))
then 0.0
else (SQRT (BLAS.DOTPROD X XOFFSET XSKIP X XOFFSET XSKIP CNT])
(BLAS.ROT
[LAMBDA (C S X XOFFSET XSKIP Y YOFFSET YSKIP CNT) (* jop: "29-Jan-86 11:43")
(* * Implements BLAS Givens rotation. X and Y must be FLOAT arrays. CNT defaults to largest vector commensurate
with XOFFSET and XSKIP. Always returns NIL)
(SETQ C (FLOAT C))
(SETQ S (FLOAT S))
(BLAS.CHECKARRAY X)
(BLAS.CHECKARRAY Y)
(PROG ((XSIZE (ARRAY-TOTAL-SIZE X))
(YSIZE (ARRAY-TOTAL-SIZE Y)))
(* * Start arg checking)
(BLAS.CHECKOFFSET XOFFSET XSIZE)
(BLAS.CHECKSKIP XSKIP)
(BLAS.CHECKOFFSET YOFFSET YSIZE)
(BLAS.CHECKSKIP YSKIP)
(if (NULL CNT)
then (SETQ CNT (BLAS.COMPUTECNT XSIZE XOFFSET XSKIP))
elseif (ILEQ CNT 0)
then (* Return NIL in the degenerate case)
(RETURN NIL))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT)
(BLAS.CHECKSIZE YSIZE YOFFSET YSKIP CNT)
(* * Do the rotation)
(LET ((XBASE (ARRAYBASE X))
(YBASE (ARRAYBASE Y))
(SBASE \SLICE1)
(CBASE \SLICE2)
(XSAVEBASE (ARRAYBASE \BLAS.SCRATCH1))
(YSAVEBASE (ARRAYBASE \BLAS.SCRATCH2)))
(* Establish constants)
(\FLOATARRAYFILL C CBASE 0 1 CNT)
(\FLOATARRAYFILL S SBASE 0 1 CNT) (* Save X)
(\FLOATARRAYBLT XBASE XOFFSET XSKIP XSAVEBASE 0 1 CNT)
(* Save Y)
(\FLOATARRAYBLT YBASE YOFFSET YSKIP YSAVEBASE 0 1 CNT)
(* Compute C * X, save in CBASE)
(\BLKFTIMES XSAVEBASE CBASE CBASE CNT) (* Compute S * Y, save in SBASE)
(\BLKFTIMES YSAVEBASE SBASE SBASE CNT) (* Compute (C*X) + (S*Y), save in CBASE)
(\BLKFPLUS SBASE CBASE CBASE CNT) (* Store result in X)
(\FLOATARRAYBLT CBASE 0 1 XBASE XOFFSET XSKIP CNT)
(* Restore constants)
(\FLOATARRAYFILL C CBASE 0 1 CNT)
(\FLOATARRAYFILL S SBASE 0 1 CNT) (* Compute S * X)
(\BLKFTIMES XSAVEBASE SBASE SBASE CNT) (* Compute C * Y)
(\BLKFTIMES YSAVEBASE CBASE CBASE CNT) (* Compute (C*Y) -
(S*X))
(\BLKFDIFF CBASE SBASE CBASE CNT) (* Store result in Y)
(\FLOATARRAYBLT CBASE 0 1 YBASE YOFFSET YSKIP CNT])
(BLAS.SCAL
[LAMBDA (SCALAR X XOFFSET XSKIP CNT) (* jop: "28-Jan-86 14:49")
(* * Implements BLAS vector scaling (X = A * X). X must be a FLOAT array. SCALAR must be a FLOATP.
CNT defaults to largest vector commensurate with XOFFSET and XSKIP. Returns NIL if CNT < 0, else Returns X)
(SETQ SCALAR (FLOAT SCALAR))
(BLAS.CHECKARRAY X)
(PROG ((XSIZE (ARRAY-TOTAL-SIZE X)))
(* * Start arg checking)
(BLAS.CHECKOFFSET XOFFSET XSIZE)
(BLAS.CHECKSKIP XSKIP)
(if (NULL CNT)
then (SETQ CNT (BLAS.COMPUTECNT XSIZE XOFFSET XSKIP))
elseif (ILEQ CNT 0)
then (* Return NIL in the degenerate case)
(RETURN NIL))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT)
(* * Compute the result using array ops)
(LET ((XBASE (ARRAYBASE X))
(VSCALAR \SLICE1)
(TEMPBASE \SLICE2))
(\FLOATARRAYFILL SCALAR VSCALAR 0 1 CNT)
(if (EQ XSKIP 1)
then (SETQ XBASE (\ADDBASE XBASE (MUL2 XOFFSET)))
(\BLKFTIMES VSCALAR XBASE XBASE CNT)
else (\FLOATARRAYBLT XBASE XOFFSET XSKIP TEMPBASE 0 1 CNT)
(\BLKFTIMES VSCALAR TEMPBASE TEMPBASE CNT)
(\FLOATARRAYBLT TEMPBASE 0 1 XBASE XOFFSET XSKIP CNT)))
(RETURN X])
(BLAS.SWAP
[LAMBDA (X XOFFSET XSKIP Y YOFFSET YSKIP CNT) (* jop: "28-Jan-86 20:49")
(* * Implements BLAS swap array. X and Y must be FLOAT arrays. Returns NIL if CNT < 0 else returns Y)
(BLAS.CHECKARRAY X)
(BLAS.CHECKARRAY Y)
(PROG ((XSIZE (ARRAY-TOTAL-SIZE X))
(YSIZE (ARRAY-TOTAL-SIZE Y)))
(* * Start arg checking)
(BLAS.CHECKOFFSET XOFFSET XSIZE)
(BLAS.CHECKSKIP XSKIP)
(BLAS.CHECKOFFSET YOFFSET YSIZE)
(BLAS.CHECKSKIP YSKIP) (* Default CNT)
(if (NULL CNT)
then (SETQ CNT (BLAS.COMPUTECNT XSIZE XOFFSET XSKIP))
elseif (ILEQ CNT 0)
then (* Return NIL in the degenerate case)
(RETURN NIL))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT)
(BLAS.CHECKSIZE YSIZE YOFFSET YSKIP CNT)
(* * Swap the vectors using array ops)
(LET ((XBASE (ARRAYBASE X))
(YBASE (ARRAYBASE Y))
(TEMPBLOCK \SLICE1))
(\FLOATARRAYBLT XBASE XOFFSET XSKIP TEMPBLOCK 0 1 CNT)
(\FLOATARRAYBLT YBASE YOFFSET YSKIP XBASE XOFFSET XSKIP CNT)
(\FLOATARRAYBLT TEMPBLOCK 0 1 YBASE YOFFSET YSKIP CNT))
(RETURN Y])
(BLAS.TRANSPOSE
[LAMBDA (SOURCEMATRIX M N DESTMATRIX) (* jop: "29-Jan-86 13:31")
(* * Transpose the M x N matrix SOURCEMATRIX. DESTMATRIX should be N x M, but no check is made.
Returns DESTMATRIX)
(BLAS.CHECKARRAY SOURCEMATRIX)
(BLAS.CHECKARRAY DESTMATRIX)
(if (NOT (IGREATERP M 1))
then (HELP "M less than 1" M))
(if (NOT (IGREATERP N 1))
then (HELP "N less than 1" N))
(PROG ((SOURCESIZE (ARRAY-TOTAL-SIZE SOURCEMATRIX))
(DESTSIZE (ARRAY-TOTAL-SIZE DESTMATRIX))
(TOTALSIZE (ITIMES M N)))
(if (ILESSP SOURCESIZE TOTALSIZE)
then (HELP "SOURCEMATRIX too small" SOURCEMATRIX))
(if (ILESSP DESTSIZE TOTALSIZE)
then (HELP "DESTMATRIX too small" DESTMATRIX))
(if (ILESSP M N)
then (bind (SOURCEBASE ←(ARRAYBASE SOURCEMATRIX))
(DESTBASE ←(ARRAYBASE DESTMATRIX)) for I from 0
to (SUB1 M) do (\FLOATARRAYBLT SOURCEBASE (ITIMES N I)
1 DESTBASE I M N))
else (bind (SOURCEBASE ←(ARRAYBASE SOURCEMATRIX))
(DESTBASE ←(ARRAYBASE DESTMATRIX)) for J from 0
to (SUB1 N) do (\FLOATARRAYBLT SOURCEBASE J N DESTBASE
(ITIMES J M)
1 M)))
(RETURN DESTMATRIX])
(\FLOATARRAYBLT
[LAMBDA (SOURCEBASE SOURCEOFFSET SOURCESKIP DESTBASE DESTOFFSET DESTSKIP CNT)
(* jop: "30-Jan-86 12:32")
(* * Raw version of BLAS.ARRAYBLT. No arg checking or defaults. SOURCEBASE and DESTBASE must point to Float array
blocks. Other args as in BLAS.ARRAYBLT Note that the fields of PILOTBBT are no longer than 16 bit words, so
DESTOFFSET etc need to be less than 2048 to keep things SMALLP. Returns NIL)
(if (AND (EQ SOURCESKIP 1)
(EQ DESTSKIP 1))
then (* Special case when both source and dest are
contiguous)
(PROG [(SOURCEPLUSOFFSET (\ADDBASE SOURCEBASE (MUL2 SOURCEOFFSET)))
(DESTPLUSOFFSET (\ADDBASE DESTBASE (MUL2 DESTOFFSET]
(* Execute the BLT)
(\BLT DESTPLUSOFFSET SOURCEPLUSOFFSET (MUL2 CNT)))
else (* General case)
(PROG [(GBBT (CONSTANT (create PILOTBBT
PBTWIDTH ← 32
PBTDISJOINT ← T]
(* Set fields in BLT table)
(replace (PILOTBBT PBTSOURCE) of GBBT with SOURCEBASE)
(replace (PILOTBBT PBTSOURCEBIT) of GBBT with (MUL32 SOURCEOFFSET))
(replace (PILOTBBT PBTSOURCEBPL) of GBBT with (MUL32 SOURCESKIP))
(replace (PILOTBBT PBTDEST) of GBBT with DESTBASE)
(replace (PILOTBBT PBTDESTBIT) of GBBT with (MUL32 DESTOFFSET))
(replace (PILOTBBT PBTDESTBPL) of GBBT with (MUL32 DESTSKIP))
(replace (PILOTBBT PBTHEIGHT) of GBBT with CNT)
(* Execute the BLT)
(\PILOTBITBLT GBBT 0])
(\FLOATARRAYFILL
[LAMBDA (SOURCEFLOATP DESTBASE DESTOFFSET DESTSKIP CNT) (* jop: "30-Jan-86 12:25")
(* * Fill CNT entries of DESTBASE starting at DESTOFFSET with skip DESTSKIP, with the FLOATP SOURCEFLOATP.
No arg checking is attempted. Returns NIL)
(if (IGREATERP CNT 0)
then (if (EQ DESTSKIP 1)
then (* Special case of contiguous destination)
(PROG [(DESTPLUSOFFSET (\ADDBASE DESTBASE (MUL2 DESTOFFSET)))
(TWICECNTLESS1 (MUL2 (SUB1 CNT]
(* Setup the last entry)
(\PUTBASEFLOATP DESTPLUSOFFSET TWICECNTLESS1 SOURCEFLOATP)
(* \BLT operates backwards)
(\BLT DESTPLUSOFFSET (\ADDBASE DESTPLUSOFFSET 2)
TWICECNTLESS1))
else (* General case)
(PROG [(BITDESTSKIP (MUL32 DESTSKIP))
(GBBT (CONSTANT (create PILOTBBT
PBTWIDTH ← 32
PBTDISJOINT ← T]
(* Setup the first entry)
(\PUTBASEFLOATP DESTBASE (MUL2 DESTOFFSET)
SOURCEFLOATP)
(* Set fields in BLT table)
(replace (PILOTBBT PBTSOURCE) of GBBT with DESTBASE)
(replace (PILOTBBT PBTSOURCEBIT) of GBBT with (MUL32 DESTOFFSET)
)
(replace (PILOTBBT PBTSOURCEBPL) of GBBT with BITDESTSKIP)
(* Same as source except displaced by one entry)
(replace (PILOTBBT PBTDEST) of GBBT with DESTBASE)
(replace (PILOTBBT PBTDESTBIT) of GBBT
with (MUL32 (IPLUS DESTOFFSET DESTSKIP)))
(replace (PILOTBBT PBTDESTBPL) of GBBT with BITDESTSKIP)
(* (SUB1 CNT) since first entry already done)
(replace (PILOTBBT PBTHEIGHT) of GBBT with (SUB1 CNT))
(* Execute the BLT depending on copy on)
(\PILOTBITBLT GBBT 0])
)
(DECLARE: EVAL@COMPILE
[PUTPROPS BLAS.CHECKARRAY MACRO (OPENLAMBDA (X)
(if [NOT (AND (type? ARRAY X)
(EQ (ARRAY-ELEMENT-TYPE X)
(QUOTE SINGLE-FLOAT]
then
(HELP "Must be an array of FLOATP's" X]
[PUTPROPS BLAS.CHECKOFFSET MACRO (OPENLAMBDA (OFFSET SIZE)
(if (NULL OFFSET)
then
(SETQ OFFSET 0)
elseif
(NOT (AND (IGEQ OFFSET 0)
(ILESSP OFFSET SIZE)))
then
(HELP "OFFSET out of bounds" OFFSET]
[PUTPROPS BLAS.CHECKSIZE MACRO (OPENLAMBDA (ARRAYSIZE ARRAYOFFSET ARRAYSKIP CNT)
(if (OR (IGEQ (IPLUS ARRAYOFFSET (ITIMES ARRAYSKIP
(SUB1 CNT)))
ARRAYSIZE)
(IGREATERP CNT \BLAS.SIZELIMIT))
then
(HELP "CNT too large" CNT]
[PUTPROPS BLAS.CHECKSKIP MACRO (OPENLAMBDA (SKIP)
(if (NULL SKIP)
then
(SETQ SKIP 1)
elseif
(NOT (IGREATERP SKIP 0))
then
(HELP "SKIP out of bounds" SKIP]
[PUTPROPS BLAS.COMPUTECNT MACRO (OPENLAMBDA (ARRAYSIZE ARRAYOFFSET ARRAYSKIP)
(if (EQ ARRAYSKIP 1)
then
(IDIFFERENCE ARRAYSIZE ARRAYOFFSET)
else
(IQUOTIENT (IDIFFERENCE ARRAYSIZE ARRAYOFFSET)
ARRAYSKIP]
(PUTPROPS MUL32 MACRO ((X)
(LLSH X 5)))
)
(RPAQQ SAVINGS ((29.35 2.87 2329.68 2.87 11.43)
(23.32 4.41 1507.99 3.93 12.07)
(23.8 4.43 2108.47 3.82 13.17)
(41.89 1.67 189.13 .22 5.75)
(42.19 .83 728.47 4.56 12.88)
(31.72 2.85 2982.88 2.43 8.79)
(39.74 1.34 662.86 2.67 .6)
(44.75 .67 289.52 6.51 11.9)
(46.64 1.06 276.65 3.08 4.98)
(47.64 1.14 471.24 2.8 10.78)
(24.42 3.93 2496.53 3.99 16.85)
(46.31 1.19 287.77 2.19 3.59)
(27.84 2.37 1681.25 4.32 11.24)
(25.06 4.7 2213.82 4.52 12.64)
(23.31 3.35 2457.12 3.44 12.55)
(25.62 3.1 870.85 6.28 10.67)
(46.05 .87 289.71 1.48 3.01)
(47.32 .58 232.44 3.19 7.7)
(34.03 3.08 1900.1 1.12 1.27)
(41.31 .96 88.94 1.54 9.0)
(31.16 4.19 1139.95 2.99 11.34)
(24.52 3.48 1390.99 3.54 14.28)
(27.01 1.91 1257.28 8.21 21.1)
(41.74 .91 207.68 5.81 3.98)
(21.8 3.73 2449.39 1.57 10.35)
(32.54 2.47 601.05 8.12 15.48)
(25.96 3.67 2231.03 3.62 10.25)
(24.71 3.25 1740.7 7.66 14.65)
(32.61 3.17 1487.52 1.76 10.67)
(45.04 1.21 325.54 2.48 7.3)
(43.56 1.2 568.56 3.61 4.44)
(41.18 1.05 220.56 1.03 2.02)
(44.19 1.28 400.06 .67 12.7)
(46.26 1.12 152.01 2.0 12.78)
(28.96 2.85 579.91 7.48 12.49)
(31.94 2.28 651.11 2.19 11.14)
(31.92 1.52 250.96 2.0 13.3)
(27.74 2.87 768.79 4.35 11.77)
(21.44 4.54 3299.49 3.01 6.86)
(23.49 3.73 2630.96 2.7 14.13)
(43.42 1.08 389.66 2.96 5.13)
(46.12 1.21 249.87 1.13 2.81)
(23.27 4.46 1813.93 2.01 7.81)
(29.81 3.43 4001.89 2.45 7.56)
(46.4 .9 813.39 .53 9.22)
(45.25 .56 138.33 5.14 18.56)
(41.12 1.73 380.47 10.23 7.72)
(28.13 2.72 766.54 1.88 9.24)
(43.69 2.07 123.58 16.71 8.89)
(47.2 .6600001 242.69 5.08 4.71)))
(RPAQ \BLAS.SIZELIMIT FFTSSIZE)
(RPAQ \BLAS.SCRATCH1 (MAKE-ARRAY \BLAS.SIZELIMIT (QUOTE :ELEMENT-TYPE)
(QUOTE FLOAT)
(QUOTE :ALIGNMENT)
128
(QUOTE :INITIAL-ELEMENT)
0.0))
(RPAQ \BLAS.SCRATCH2 (MAKE-ARRAY \BLAS.SIZELIMIT (QUOTE :ELEMENT-TYPE)
(QUOTE FLOAT)
(QUOTE :ALIGNMENT)
128
(QUOTE :INITIAL-ELEMENT)
0.0))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \BLAS.SIZELIMIT \BLAS.SCRATCH1 \BLAS.SCRATCH2)
)
(/DECLAREDATATYPE (QUOTE PILOTBBT)
(QUOTE (WORD WORD WORD SIGNEDWORD WORD WORD WORD SIGNEDWORD WORD WORD WORD WORD
WORD WORD WORD WORD))
[QUOTE ((PILOTBBT 0 (BITS . 15))
(PILOTBBT 1 (BITS . 15))
(PILOTBBT 2 (BITS . 15))
(PILOTBBT 3 (SIGNEDBITS . 15))
(PILOTBBT 4 (BITS . 15))
(PILOTBBT 5 (BITS . 15))
(PILOTBBT 6 (BITS . 15))
(PILOTBBT 7 (SIGNEDBITS . 15))
(PILOTBBT 8 (BITS . 15))
(PILOTBBT 9 (BITS . 15))
(PILOTBBT 10 (BITS . 15))
(PILOTBBT 11 (BITS . 15))
(PILOTBBT 12 (BITS . 15))
(PILOTBBT 13 (BITS . 15))
(PILOTBBT 14 (BITS . 15))
(PILOTBBT 15 (BITS . 15]
(QUOTE 16))
(DECLARE: DONTCOPY DOEVAL@COMPILE
[DECLARE: EVAL@COMPILE
(DATATYPE PILOTBBT ((PBTDESTLO WORD)
(PBTDESTHI WORD)
(PBTDESTBIT WORD) (* Destination bit address)
(PBTDESTBPL SIGNEDWORD) (* Destination bits per line -- distance in bits to
move between items)
(PBTSOURCELO WORD)
(PBTSOURCEHI WORD)
(PBTSOURCEBIT WORD) (* Source bit address)
(PBTSOURCEBPL SIGNEDWORD) (* Source bits per line)
(PBTWIDTH WORD) (* Width of an item in bits)
(PBTHEIGHT WORD) (* Number of items -- height in scanlines)
(PBTFLAGS WORD)
(NIL 5 WORD) (* Unused, needed to make 16-alignment)
)
(BLOCKRECORD PILOTBBT ((NIL 7 WORD)
(NIL BITS 4) (* Overlay on PBTSOURCEBPL when PBTUSEGRAY)
(PBTGRAYOFFSET BITS 4)
(* Offset in gray block where BITBLT should start)
(PBTGRAYWIDTHLESSONE BITS 4)
(* Width-1 of gray block in words)
(PBTGRAYHEIGHTLESSONE BITS 4)
(* Height-1 of gray block)
(NIL 2 WORD) (* Overlay on PBTFLAGS ...)
(PBTBACKWARD FLAG)
(PBTDISJOINT FLAG)
(PBTDISJOINTITEMS FLAG)
(PBTUSEGRAY FLAG)
(PBTSOURCETYPE BITS 1)
(PBTOPERATION BITS 2)
(NIL BITS 9)))
[ACCESSFNS PILOTBBT ([PBTSOURCE (\VAG2 (fetch PBTSOURCEHI of DATUM)
(fetch PBTSOURCELO of DATUM))
(PROGN (replace PBTSOURCEHI of DATUM
with (\HILOC NEWVALUE))
(replace PBTSOURCELO of DATUM
with (\LOLOC NEWVALUE]
(PBTDEST (\VAG2 (fetch PBTDESTHI of DATUM)
(fetch PBTDESTLO of DATUM))
(PROGN (replace PBTDESTHI of DATUM
with (\HILOC NEWVALUE))
(replace PBTDESTLO of DATUM
with (\LOLOC NEWVALUE]
(SYSTEM))
]
(/DECLAREDATATYPE (QUOTE PILOTBBT)
(QUOTE (WORD WORD WORD SIGNEDWORD WORD WORD WORD SIGNEDWORD WORD WORD WORD WORD
WORD WORD WORD WORD))
[QUOTE ((PILOTBBT 0 (BITS . 15))
(PILOTBBT 1 (BITS . 15))
(PILOTBBT 2 (BITS . 15))
(PILOTBBT 3 (SIGNEDBITS . 15))
(PILOTBBT 4 (BITS . 15))
(PILOTBBT 5 (BITS . 15))
(PILOTBBT 6 (BITS . 15))
(PILOTBBT 7 (SIGNEDBITS . 15))
(PILOTBBT 8 (BITS . 15))
(PILOTBBT 9 (BITS . 15))
(PILOTBBT 10 (BITS . 15))
(PILOTBBT 11 (BITS . 15))
(PILOTBBT 12 (BITS . 15))
(PILOTBBT 13 (BITS . 15))
(PILOTBBT 14 (BITS . 15))
(PILOTBBT 15 (BITS . 15]
(QUOTE 16))
)
(DECLARE: DONTEVAL@LOAD DONTCOPY DOEVAL@COMPILE
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1219 22271 (BLAS.ARRAYBLT 1229 . 2954) (BLAS.ARRAYFILL 2956 . 4140) (BLAS.ASUM 4142 .
5292) (BLAS.AXPY 5294 . 7220) (BLAS.COPY 7222 . 7548) (BLAS.DOTPROD 7550 . 9504) (BLAS.MAX 9506 .
10720) (BLAS.NRM2 10722 . 11147) (BLAS.ROT 11149 . 13787) (BLAS.SCAL 13789 . 15201) (BLAS.SWAP 15203
. 16508) (BLAS.TRANSPOSE 16510 . 17919) (\FLOATARRAYBLT 17921 . 19887) (\FLOATARRAYFILL 19889 . 22269
)))))
STOP