(FILECREATED " 4-Jun-86 14:47:19" {QV}<PEDERSEN>LISP>BLAS.;19 29103
changes to: (VARS BLASCOMS)
(FNS BLAS.MATMULT BLAS.ADD BLAS.ARRAYBLT BLAS.ARRAYFILL BLAS.ASUM BLAS.AXPY
BLAS.COPY BLAS.DOTPROD BLAS.MAX BLAS.NRM2 BLAS.ROT BLAS.SCAL BLAS.SUM
BLAS.SWAP \FLOATARRAYBLT)
previous date: "27-May-86 21:53:00" {QV}<PEDERSEN>LISP>BLAS.;16)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT BLASCOMS)
(RPAQQ BLASCOMS ((FNS BLAS.ADD BLAS.ARRAYBLT BLAS.ARRAYFILL BLAS.ASUM BLAS.AXPY BLAS.COPY
BLAS.DOTPROD BLAS.MAX BLAS.NRM2 BLAS.ROT BLAS.ROTGMACRO BLAS.SCAL BLAS.SUM
BLAS.SWAP \FLOATARRAYBLT \FLOATARRAYFILL)
(MACROS BLAS.CHECKARRAY BLAS.CHECKOFFSET BLAS.CHECKSIZE BLAS.CHECKSKIP BLAS.COMPUTECNT
BLAS.ROTG MUL32)
(INITRECORDS PILOTBBT)
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
UNBOXEDOPS CMLFLOATARRAY)
(DECLARE: DONTCOPY DOEVAL@COMPILE (RECORDS PILOTBBT))
(DECLARE: DONTEVAL@LOAD DONTCOPY DOEVAL@COMPILE (LOCALVARS . T))))
(DEFINEQ
(BLAS.ADD
[LAMBDA (SCALAR X XOFFSET XSKIP CNT) (* jop: " 4-Jun-86 14:14")
(* * Implements vector plus SCALAR. X must be a FLOAT array. SCALAR must be a FLOATP. CNT defaults to largest
vector commensurate with XOFFSET and XSKIP. Returns X)
(SETQ SCALAR (FLOAT SCALAR))
(BLAS.CHECKARRAY X)
(LET ((XSIZE (ARRAY-TOTAL-SIZE X)))
(* * Arg checking)
(BLAS.CHECKOFFSET XOFFSET XSIZE)
(BLAS.CHECKSKIP XSKIP)
(if (NULL CNT)
then (SETQ CNT (BLAS.COMPUTECNT XSIZE XOFFSET XSKIP))
elseif (ILESSP CNT 0)
then (HELP "Cnt less than zero" CNT))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT)
(* * Compute the result)
[bind (XBASE ←(ARRAYBASE X))
(FSCALAR ← SCALAR) for I from 1 to CNT as XINDEX from (MUL2 XOFFSET)
by (MUL2 XSKIP) declare (TYPE FLOATP FSCALAR) do (\PUTBASEFLOATP
XBASE XINDEX
(FPLUS FSCALAR
(\GETBASEFLOATP
XBASE XINDEX]
X])
(BLAS.ARRAYBLT
[LAMBDA (SOURCE SOURCEOFFSET SOURCESKIP DEST DESTOFFSET DESTSKIP CNT)
(* jop: " 4-Jun-86 14:17")
(* * 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 a vector 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)
(LET ((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 (ILESSP CNT 0)
then (HELP "CNT less than zero" CNT))
(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)
(LET ((SOURCEBASE (ARRAYBASE SOURCE))
(DESTBASE (ARRAYBASE DEST))
(LIMIT 2048)) (* Check that offsets and skips are less than
(MAX.SMALLP / 32))
(if (NOT (ILESSP SOURCEOFFSET LIMIT))
then (SETQ SOURCEBASE (\ADDBASE SOURCEBASE (MUL2 SOURCEOFFSET)))
(SETQ SOURCEOFFSET 0))
(if (NOT (ILESSP DESTOFFSET LIMIT))
then (SETQ DESTBASE (\ADDBASE DESTBASE (MUL2 DESTOFFSET)))
(SETQ DESTOFFSET 0))
(if (NOT (AND (ILESSP SOURCESKIP LIMIT)
(ILESSP DESTSKIP LIMIT)))
then (HELP "Skip larger than limit"))
(\FLOATARRAYBLT SOURCEBASE SOURCEOFFSET SOURCESKIP DESTBASE DESTOFFSET DESTSKIP CNT))
DEST])
(BLAS.ARRAYFILL
[LAMBDA (SOURCEFLOATP DEST DESTOFFSET DESTSKIP CNT) (* jop: " 4-Jun-86 14:20")
(* * 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))
(LET (DESTSIZE)
(* * 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))
elseif (ILESSP CNT 0)
then (HELP "CNT less than zero" CNT))
(BLAS.CHECKSIZE DESTSIZE DESTOFFSET DESTSKIP CNT)
(* * Do the Fill)
(LET ((DESTBASE (ARRAYBASE DEST))
(LIMIT 2048)) (* Check that offsets and skips are less than
(MAX.SMALLP / 32))
(if (NOT (ILESSP DESTOFFSET LIMIT))
then (SETQ DESTBASE (\ADDBASE DESTBASE (MUL2 DESTOFFSET)))
(SETQ DESTOFFSET 0))
(if (NOT (ILESSP DESTSKIP LIMIT))
then (HELP "Skip larger than limit" DESTSKIP))
(\FLOATARRAYFILL SOURCEFLOATP DESTBASE DESTOFFSET DESTSKIP CNT))
DEST])
(BLAS.ASUM
[LAMBDA (X XOFFSET XSKIP CNT) (* jop: " 4-Jun-86 14:22")
(* * Implements BLAS sum of magnitudes. X must be a FLOAT array. CNT defaults to largest vector commensurate with
XOFFSET and XSKIP. Returns X)
(BLAS.CHECKARRAY X)
(LET ((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 (ILESSP CNT 0)
then (HELP "CNT less than zero" CNT))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT)
(* *)
(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
(UFABS (
\GETBASEFLOATP
XBASE INDEX]
finally (RETURN RESULT])
(BLAS.AXPY
[LAMBDA (SCALAR X XOFFSET XSKIP Y YOFFSET YSKIP CNT) (* jop: " 4-Jun-86 14: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 Y)
(SETQ SCALAR (FLOAT SCALAR))
(BLAS.CHECKARRAY X)
(BLAS.CHECKARRAY Y)
(LET ((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 (ILESSP CNT 0)
then (HELP "CNT less than zero" CNT))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT)
(BLAS.CHECKSIZE YSIZE YOFFSET YSKIP CNT)
(* *)
[bind (XBASE ←(ARRAYBASE X))
(YBASE ←(ARRAYBASE Y))
(FSCALAR ← SCALAR) for I from 1 to CNT as XINDEX from (MUL2 XOFFSET)
by (MUL2 XSKIP) as YINDEX from (MUL2 YOFFSET) by (MUL2 YSKIP)
declare (TYPE FLOATP FSCALAR) do (\PUTBASEFLOATP YBASE YINDEX
(FPLUS (\GETBASEFLOATP YBASE
YINDEX)
(FTIMES FSCALAR
(
\GETBASEFLOATP
XBASE XINDEX]
Y])
(BLAS.COPY
[LAMBDA (X XOFFSET XSKIP Y YOFFSET YSKIP CNT) (* jop: " 4-Jun-86 14:24")
(* * Implements BLAS array copy. Returns NIL if CNT < 0 else returns Y)
(BLAS.ARRAYBLT X XOFFSET XSKIP Y YOFFSET YSKIP CNT])
(BLAS.DOTPROD
[LAMBDA (X XOFFSET XSKIP Y YOFFSET YSKIP CNT) (* jop: " 4-Jun-86 14:25")
(* * Implements BLAS dot product. X and Y must be FLOAT arrays. CNT defaults to largest vector commensurate with
XOFFSET and XSKIP)
(BLAS.CHECKARRAY X)
(BLAS.CHECKARRAY Y)
(LET ((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 (ILESSP CNT 0)
then (HELP "CNT less than zero" CNT))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT)
(BLAS.CHECKSIZE YSIZE YOFFSET YSKIP CNT)
(* * Compute the inner product)
(bind (XBASE ←(ARRAYBASE X))
(YBASE ←(ARRAYBASE Y))
(FSUM ← 0.0) for I from 1 to CNT as XINDEX from (MUL2 XOFFSET)
by (MUL2 XSKIP) as YINDEX from (MUL2 YOFFSET) by (MUL2 YSKIP)
declare (TYPE FLOATP FSUM) do [SETQ FSUM (FPLUS FSUM (FTIMES (\GETBASEFLOATP
XBASE XINDEX)
(\GETBASEFLOATP
YBASE YINDEX]
finally (RETURN FSUM])
(BLAS.MAX
[LAMBDA (X XOFFSET XSKIP CNT) (* jop: " 4-Jun-86 14:26")
(* * Implements BLAS array max. Returns index of entry with maximum absolute value)
(BLAS.CHECKARRAY X)
(LET ((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 (ILESSP CNT 0)
then (HELP "CNT less than zero" CNT))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT)
(* *)
(bind (XBASE ←(ARRAYBASE X))
(FMAX ← MIN.FLOAT)
(MAXINDEX ← 0)
XTEMP for I from 0 to (SUB1 CNT) as XINDEX from (MUL2 XOFFSET)
by (MUL2 XSKIP) declare (TYPE FLOATP FMAX XTEMP)
do (SETQ XTEMP (UFABS (\GETBASEFLOATP XBASE XINDEX)))
(if (UFGREATERP XTEMP FMAX)
then (SETQ FMAX XTEMP)
(SETQ MAXINDEX I))
finally (RETURN MAXINDEX])
(BLAS.NRM2
[LAMBDA (X XOFFSET XSKIP CNT) (* jop: " 4-Jun-86 14:26")
(* * Implements BLAS euclidean norm. X must be a FLOAT array. CNT defaults to largest vector commensurate with
XOFFSET and XSKIP.)
(SQRT (BLAS.DOTPROD X XOFFSET XSKIP X XOFFSET XSKIP CNT])
(BLAS.ROT
[LAMBDA (C S X XOFFSET XSKIP Y YOFFSET YSKIP CNT) (* jop: " 4-Jun-86 14:28")
(* * Implements BLAS Givens rotation. X and Y must be FLOAT arrays. CNT defaults to largest vector commensurate
with XOFFSET and XSKIP. RETURNS Y)
(SETQ C (FLOAT C))
(SETQ S (FLOAT S))
(BLAS.CHECKARRAY X)
(BLAS.CHECKARRAY Y)
(LET ((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 (ILESSP CNT 0)
then (HELP "CNT less than zero" CNT))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT)
(BLAS.CHECKSIZE YSIZE YOFFSET YSKIP CNT)
(* * Do the rotation)
[bind (XBASE ←(ARRAYBASE X))
(YBASE ←(ARRAYBASE Y))
(FC ← C)
(FS ← S)
XTEMP YTEMP for I from 1 to CNT as XINDEX from (MUL2 XOFFSET)
by (MUL2 XSKIP) as YINDEX from (MUL2 YOFFSET) by (MUL2 YSKIP)
declare (TYPE FLOATP FC FS XTEMP YTEMP)
do (SETQ XTEMP (\GETBASEFLOATP XBASE XINDEX))
(SETQ YTEMP (\GETBASEFLOATP YBASE YINDEX))
(\PUTBASEFLOATP XBASE XINDEX (FPLUS (FTIMES FC XTEMP)
(FTIMES FS YTEMP)))
(\PUTBASEFLOATP YBASE YINDEX (FDIFFERENCE (FTIMES FC YTEMP)
(FTIMES FS XTEMP]
Y])
(BLAS.ROTGMACRO
[LAMBDA (ARGS) (* jop: "26-May-86 15:57")
(* *)
(LET ((BA (CAR ARGS))
(BB (CADR ARGS))
(BC (CADDR ARGS))
(BS (CADDDR ARGS)))
(BQUOTE (LET* [(SIGMA (if (FGREATERP (FABS , BA)
(FABS , BB))
then (if (FLESSP , BA 0.0)
then -1.0
else 1.0)
else (if (FLESSP , BB 0.0)
then -1.0
else 1.0)))
(RADIUS (FTIMES SIGMA (SQRT (FTIMES , BA , BA)
(FTIMES , BB , BB]
(SETQ , BC (if (NOT (FEQP RADIUS 0.0))
then (FQUOTIENT , BA RADIUS)
else 1.0))
(SETQ , BS (if (NOT (FEQP RADIUS 0.0))
then (FQUOTIENT , BB RADIUS)
else 0.0))
(if (FEQP , BC 0.0)
then 1.0
elseif (FGREATERP (FABS , BA)
(FABS , BB))
then , BS
else (FQUOTIENT 1.0 , BC])
(BLAS.SCAL
[LAMBDA (SCALAR X XOFFSET XSKIP CNT) (* jop: " 4-Jun-86 14:29")
(* * 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 X)
(SETQ SCALAR (FLOAT SCALAR))
(BLAS.CHECKARRAY X)
(LET ((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 (ILESSP CNT 0)
then (HELP "Cnt less than zero" CNT))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT)
(* * Compute the result using array ops)
[bind (XBASE ←(ARRAYBASE X))
(FSCALAR ← SCALAR) for I from 1 to CNT as XINDEX from (MUL2 XOFFSET)
by (MUL2 XSKIP) declare (TYPE FLOATP FSCALAR) do (\PUTBASEFLOATP
XBASE XINDEX
(FTIMES FSCALAR
(\GETBASEFLOATP
XBASE XINDEX]
X])
(BLAS.SUM
[LAMBDA (X XOFFSET XSKIP CNT) (* jop: " 4-Jun-86 14:30")
(* * Implements vector sum reduction. X must be a FLOAT array. CNT defaults to largest vector commensurate with
XOFFSET and XSKIP. Returns X)
(BLAS.CHECKARRAY X)
(LET ((XSIZE (ARRAY-TOTAL-SIZE X)))
(* * Arg checking)
(BLAS.CHECKOFFSET XOFFSET XSIZE)
(BLAS.CHECKSKIP XSKIP)
(if (NULL CNT)
then (SETQ CNT (BLAS.COMPUTECNT XSIZE XOFFSET XSKIP))
elseif (ILESSP CNT 0)
then (HELP "Cnt less than zero" CNT))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT)
(* *)
(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 (\GETBASEFLOATP
XBASE INDEX)))
finally (RETURN RESULT])
(BLAS.SWAP
[LAMBDA (X XOFFSET XSKIP Y YOFFSET YSKIP CNT) (* jop: " 4-Jun-86 14:31")
(* * Implements BLAS swap array. X and Y must be FLOAT arrays. Returns Y)
(BLAS.CHECKARRAY X)
(BLAS.CHECKARRAY Y)
(LET ((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 (ILESSP CNT 0)
then (HELP "Cnt less than zero" CNT))
(BLAS.CHECKSIZE XSIZE XOFFSET XSKIP CNT)
(BLAS.CHECKSIZE YSIZE YOFFSET YSKIP CNT)
(* * Now do the swap)
(bind (XBASE ←(ARRAYBASE X))
(YBASE ←(ARRAYBASE Y))
XTEMP for I from 1 to CNT as XINDEX from (MUL2 XOFFSET)
by (MUL2 XSKIP) as YINDEX from (MUL2 YOFFSET) by (MUL2 YSKIP)
declare (TYPE FLOATP XTEMP)
do (SETQ XTEMP (\GETBASEFLOATP XBASE XINDEX))
(\PUTBASEFLOATP XBASE XINDEX (\GETBASEFLOATP YBASE YINDEX))
(\PUTBASEFLOATP YBASE YINDEX XTEMP))
Y])
(\FLOATARRAYBLT
[LAMBDA (SOURCEBASE SOURCEOFFSET SOURCESKIP DESTBASE DESTOFFSET DESTSKIP CNT)
(* jop: " 4-Jun-86 14:33")
(* * 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 (IGREATERP CNT 1)
then (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 (DEFERREDCONSTANT (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: "27-May-86 16:52")
(* * 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 (DEFERREDCONSTANT (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 (IGEQ (IPLUS ARRAYOFFSET (ITIMES ARRAYSKIP
(SUB1 CNT)))
ARRAYSIZE)
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 BLAS.ROTG MACRO (ARGS (if (NOT (EQLENGTH ARGS 4))
then
(ERROR "Macro must have four args" ARGS))
(BLAS.ROTGMACRO ARGS)))
(PUTPROPS MUL32 MACRO ((X)
(LLSH X 5)))
)
(/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))
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
UNBOXEDOPS CMLFLOATARRAY)
(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)
)
)
(PUTPROPS BLAS COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1025 23783 (BLAS.ADD 1035 . 2177) (BLAS.ARRAYBLT 2179 . 4525) (BLAS.ARRAYFILL 4527 .
6191) (BLAS.ASUM 6193 . 7281) (BLAS.AXPY 7283 . 8814) (BLAS.COPY 8816 . 9072) (BLAS.DOTPROD 9074 .
10471) (BLAS.MAX 10473 . 11586) (BLAS.NRM2 11588 . 11920) (BLAS.ROT 11922 . 13559) (BLAS.ROTGMACRO
13561 . 15113) (BLAS.SCAL 15115 . 16295) (BLAS.SUM 16297 . 17340) (BLAS.SWAP 17342 . 18693) (
\FLOATARRAYBLT 18695 . 20761) (\FLOATARRAYFILL 20763 . 23781)))))
STOP