(FILECREATED "14-Oct-85 16:22:05" {ERIS}<LISPCORE>LIBRARY>MATMULT.;12 24490
changes to: (VARS MATMULTCOMS)
previous date: " 8-Oct-85 18:37:54" {ERIS}<LISPCORE>LIBRARY>MATMULT.;10)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT MATMULTCOMS)
(RPAQQ MATMULTCOMS ((FILES CMLARRAY)
(FNS ARRAYCOLS ARRAYROWS SHOW.ARRAY \CHECKVALIDARRAY MAKEAIJ MAT.DETERMINANT
MAT.INVERT MAT.INVERT.3BY3 MAT.SIGN)
(FNS CONCATTRANSFORMS MATMULT MATMULT133 MATMULT331 MATMULT333 MATMULT144
MATMULT441 MATMULT444)
(FNS SET.WCOORD SET.XCOORD SET.YCOORD SET.ZCOORD GET.XCOORD GET.YCOORD
GET.ZCOORD GET.WCOORD)
(FNS \MAKEVALIDARRAY CREATE1BY3 CREATE3BY1 CREATE3BY3 IDENTITY3BY3
TRANSLATE3BY3 SCALE3BY3 ROTATE3BY3)
(FNS CREATE4BY4 IDENTITY4BY4 SCALE4BY4 TRANSLATE4BY4 ROTATE4BY4.ABOUTX
ROTATE4BY4.ABOUTY ROTATE4BY4.ABOUTZ)
(DECLARE: EVAL@LOAD DOCOPY (MACROS GET.WCOORD GET.XCOORD GET.YCOORD GET.ZCOORD
SET.WCOORD SET.XCOORD SET.YCOORD SET.ZCOORD)
(MACROS MATMULT133 MATMULT331 MATMULT333 MATMULT144 MATMULT441
MATMULT444)
(MACROS .MATMULT133 .MATMULT331 .MATMULT333 .MATMULT144 .MATMULT441
.MATMULT444))
(FNS \MATMULT)
(MACROS \GETELT \SETELT)
(FNS \GETELT \SETELT \MATRIX.GET.BASE)
(FNS \CHECKVALIDARRAY)
(CONSTANTS WORDSPER3BY3MATRIX)
(RESOURCES TRANSFORM.BOX)))
(FILESLOAD CMLARRAY)
(DEFINEQ
(ARRAYCOLS
[LAMBDA (A) (* hdj "26-Sep-85 15:02")
(CADR (ARRAY-DIMENSIONS A])
(ARRAYROWS
[LAMBDA (A) (* hdj "26-Sep-85 15:05")
(CAR (ARRAY-DIMENSIONS A])
(SHOW.ARRAY
[LAMBDA (A W) (* hdj "16-May-85 12:18")
(for Y from 0 to (SUB1 (ARRAYROWS A))
do (for X from 0 to (SUB1 (ARRAYCOLS A))
do (PRINTOUT W "[" .I2 Y "," .I2 X "]:" .F8.6 (AREF A Y X)
,))
(TERPRI W))
(TERPRI W])
(\CHECKVALIDARRAY
[LAMBDA (ARRAY DIMS TYPE) (* hdj "26-Sep-85 15:06")
(LET ((DIMENSIONS (ARRAY-DIMENSIONS ARRAY)))
(if (AND (type? ARRAY ARRAY)
(EQUAL DIMS DIMENSIONS)
(EQ (ARRAYELEMENTTYPE ARRAY)
TYPE))
then ARRAY
else (\ILLEGAL.ARG ARRAY])
(MAKEAIJ
[LAMBDA (A NEWA ELIDEROW ELIDECOL) (* hdj "16-May-85 10:24")
(PROG ((N 0)
(M 0)
(AROWS (ARRAYROWS A))
(ACOLS (ARRAYCOLS A)))
(for ROW from 0 to (SUB1 AROWS) do (if (NEQ ROW ELIDEROW)
then (SETQ M 0)
(for COL from 0 to (SUB1 ACOLS)
do (if (NEQ COL ELIDECOL)
then (ASET (AREF A ROW COL)
NEWA N M)
(add M 1)))
(add N 1])
(MAT.DETERMINANT
[LAMBDA (A) (* hdj "26-Sep-85 15:07")
(PROG (NROWS NCOLS DET)
(SETQ NROWS (ARRAYROWS A))
(SETQ NCOLS (ARRAYCOLS A))
(if (NEQ NROWS NCOLS)
then (ERROR "Can't take determinant of non-square matrix" A))
[if (EQ NROWS 1)
then (SETQ DET (AREF A 0 0))
elseif (EQ NROWS 2)
then [SETQ DET (FDIFFERENCE (FTIMES (AREF A 0 0)
(AREF A 1 1))
(FTIMES (AREF A 0 1)
(AREF A 1 0]
else (PROG [I J (AIJ (MAKE-ARRAY (LIST (SUB1 NROWS)
(SUB1 NCOLS))
:ELEMENT-TYPE
(QUOTE SINGLE-FLOAT]
(SETQ DET 0.0)
(SETQ J 0)
(for I from 0 to (SUB1 NROWS)
do (MAKEAIJ A AIJ I J)
(SETQ DET (FPLUS DET (FTIMES (AREF A I J)
(MAT.SIGN I J)
(MAT.DETERMINANT AIJ]
(RETURN DET])
(MAT.INVERT
[LAMBDA (MATRIX) (* hdj "26-Sep-85 15:09")
(LET ((NROWS (ARRAYROWS MATRIX))
(NCOLS (ARRAYCOLS MATRIX)))
(PROG (AI AIJ DET)
(if (NEQ NROWS NCOLS)
then (ERROR "Square matrices cannot be inverted" MATRIX))
(SETQ DET (MAT.DETERMINANT MATRIX))
(SETQ AI (MAKE-ARRAY (LIST NROWS NCOLS)
:ELEMENT-TYPE
(QUOTE SINGLE-FLOAT)))
(SETQ AIJ (MAKE-ARRAY (LIST (SUB1 NROWS)
(SUB1 NCOLS))
:ELEMENT-TYPE
(QUOTE SINGLE-FLOAT)))
(for I from 0 to (SUB1 NROWS) do (for J from 0 to (SUB1 NCOLS)
do (MAKEAIJ MATRIX AIJ I J)
(ASET (FQUOTIENT (FTIMES (MAT.SIGN I J)
(MAT.DETERMINANT
AIJ))
DET)
AI J I)))
(RETURN AI])
(MAT.INVERT.3BY3
[LAMBDA (MATRIX) (* hdj " 4-Jun-85 12:33")
(PROG ((INVERT (CREATE3BY3))
(A (AREF MATRIX 0 0))
(B (AREF MATRIX 1 0))
(C (AREF MATRIX 2 0))
(D (AREF MATRIX 0 1))
(E (AREF MATRIX 1 1))
(F (AREF MATRIX 2 1))
AE BD BF EC CD AF AE-BD)
(SETQ AE (TIMES A E))
(SETQ BD (TIMES B D))
(SETQ BF (TIMES B F))
(SETQ EC (TIMES E C))
(SETQ CD (TIMES E C))
(SETQ AF (TIMES A F))
(SETQ AE-BD (FDIFFERENCE AE BD))
(if (ZEROP AE-BD)
then (HELP "Matrix cannot be inverted" MATRIX))
(ASET (FQUOTIENT E AE-BD)
INVERT 0 0)
(ASET (FQUOTIENT (FMINUS B)
AE-BD)
INVERT 1 0)
(ASET (FQUOTIENT (FDIFFERENCE BF EC)
AE-BD)
INVERT 2 0)
(ASET (FQUOTIENT (FMINUS D)
AE-BD)
INVERT 0 1)
(ASET (FQUOTIENT A AE-BD)
INVERT 1 1)
(ASET (FQUOTIENT (FDIFFERENCE CD AF)
AE-BD)
INVERT 2 1)
(ASET 0.0 INVERT 0 2)
(ASET 0.0 INVERT 1 2)
(ASET 1.0 INVERT 2 2)
(RETURN INVERT])
(MAT.SIGN
[LAMBDA (I J) (* hdj "16-May-85 10:46")
(if (EQ (IMOD (IPLUS I J)
2)
0)
then 1
else -1])
)
(DEFINEQ
(CONCATTRANSFORMS
[LAMBDA (A B) (* hdj " 8-Oct-85 15:29")
(GLOBALRESOURCE TRANSFORM.BOX (*)
(MATMULT333 A B TRANSFORM.BOX)
(\BLT (\MATRIX.GET.BASE A)
(\MATRIX.GET.BASE TRANSFORM.BOX)
WORDSPER3BY3MATRIX))
A])
(MATMULT
[LAMBDA (MATRIXA MATRIXB MATRIXC K M N) (* hdj "16-May-85 12:13")
(* * multiply matrices of arbitrary size)
(\CHECKVALIDARRAY MATRIXA (LIST K M)
(QUOTE FLONUM))
(\CHECKVALIDARRAY MATRIXB (LIST M N)
(QUOTE FLONUM))
(\CHECKVALIDARRAY MATRIXC (LIST K N)
(QUOTE FLONUM))
(for I from 0 to (SUB1 K) do (for J from 0 to (SUB1 N)
do (ASET (for K from 0 to (SUB1 M)
sum (FTIMES (AREF MATRIXA I K)
(AREF MATRIXB K J)))
MATRIXC I J)))
MATRIXC])
(MATMULT133
[LAMBDA (MATRIXA MATRIXB MATRIXC) (* hdj " 8-Oct-85 15:29")
(* * multiply (1 , 3) * (3 , 3) => (1 , 3))
(.MATMULT133 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC])
(MATMULT331
[LAMBDA (MATRIXA MATRIXB MATRIXC) (* hdj " 8-Oct-85 15:29")
(* * multiply (3 , 3) * (3 , 1) => (3 , 1))
(.MATMULT331 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC])
(MATMULT333
[LAMBDA (MATRIXA MATRIXB MATRIXC) (* hdj " 8-Oct-85 15:29")
(* * multiply two (3 , 3) matrices in microcode)
(.MATMULT333 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC])
(MATMULT144
[LAMBDA (MATRIXA MATRIXB MATRIXC) (* hdj " 8-Oct-85 15:29")
(* * multiply (1 , 4) * (4 , 4) => (1 , 41))
(.MATMULT144 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC])
(MATMULT441
[LAMBDA (MATRIXA MATRIXB MATRIXC) (* hdj " 8-Oct-85 15:29")
(* * multiply (4 , 4) * (4 , 1) => (4 , 1))
(.MATMULT441 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC])
(MATMULT444
[LAMBDA (MATRIXA MATRIXB MATRIXC) (* hdj " 8-Oct-85 15:29")
(* * multiply two (4 , 4) matrices in microcode)
(.MATMULT444 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC])
)
(DEFINEQ
(SET.WCOORD
[LAMBDA (VECTOR VALUE) (* hdj "16-May-85 14:29")
(ASET VALUE VECTOR 0 3])
(SET.XCOORD
[LAMBDA (VECTOR VALUE) (* hdj "16-May-85 14:27")
(ASET VALUE VECTOR 0 0])
(SET.YCOORD
[LAMBDA (VECTOR VALUE) (* hdj "16-May-85 14:28")
(ASET VALUE VECTOR 0 1])
(SET.ZCOORD
[LAMBDA (VECTOR VALUE) (* hdj "16-May-85 14:28")
(ASET VALUE VECTOR 0 2])
(GET.XCOORD
[LAMBDA (VECTOR) (* hdj "17-May-85 14:34")
(AREF VECTOR 0 0])
(GET.YCOORD
[LAMBDA (VECTOR) (* hdj "17-May-85 14:34")
(AREF VECTOR 0 1])
(GET.ZCOORD
[LAMBDA (VECTOR) (* hdj "17-May-85 14:35")
(AREF VECTOR 0 2])
(GET.WCOORD
[LAMBDA (VECTOR) (* hdj "17-May-85 14:35")
(AREF VECTOR 0 3])
)
(DEFINEQ
(\MAKEVALIDARRAY
[LAMBDA (ARRAY DIMS CREATEFN) (* hdj "26-Sep-85 14:36")
(if (AND (type? ARRAY ARRAY)
(EQUAL DIMS (ARRAY-DIMENSIONS ARRAY)))
then ARRAY
else (if (NULL ARRAY)
then (APPLY CREATEFN)
else (\ILLEGAL.ARG ARRAY])
(CREATE1BY3
[LAMBDA NIL (* hdj "26-Sep-85 14:55")
(MAKE-ARRAY (LIST 1 3)
:ELEMENT-TYPE
(QUOTE SINGLE-FLOAT])
(CREATE3BY1
[LAMBDA NIL (* hdj "26-Sep-85 14:56")
(MAKE-ARRAY (LIST 3 1)
:ELEMENT-TYPE
(QUOTE SINGLE-FLOAT])
(CREATE3BY3
[LAMBDA NIL (* hdj "26-Sep-85 14:59")
(MAKE-ARRAY (LIST 3 3)
:ELEMENT-TYPE
(QUOTE SINGLE-FLOAT])
(IDENTITY3BY3
[LAMBDA (M) (* hdj " 8-Oct-85 18:23")
(LET [(MATRIX (\MAKEVALIDARRAY M (LIST 3 3)
(FUNCTION CREATE3BY3]
(ASET 1.0 MATRIX 0 0)
(ASET 0.0 MATRIX 0 1)
(ASET 0.0 MATRIX 0 2)
(ASET 0.0 MATRIX 1 0)
(ASET 1.0 MATRIX 1 1)
(ASET 0.0 MATRIX 1 2)
(ASET 0.0 MATRIX 2 0)
(ASET 0.0 MATRIX 2 1)
(ASET 1.0 MATRIX 2 2)
MATRIX])
(TRANSLATE3BY3
[LAMBDA (Tx Ty M) (* hdj " 8-Oct-85 18:25")
(LET [(MATRIX (\MAKEVALIDARRAY M (LIST 3 3)
(FUNCTION CREATE3BY3]
(ASET 1.0 MATRIX 0 0)
(ASET 0.0 MATRIX 0 1)
(ASET 0.0 MATRIX 0 2)
(ASET 0.0 MATRIX 1 0)
(ASET 1.0 MATRIX 1 1)
(ASET 0.0 MATRIX 1 2)
(ASET Tx MATRIX 2 0)
(ASET Ty MATRIX 2 1)
(ASET 1.0 MATRIX 2 2)
MATRIX])
(SCALE3BY3
[LAMBDA (Sx Sy M) (* hdj " 8-Oct-85 18:25")
(LET [(MATRIX (\MAKEVALIDARRAY M (LIST 3 3)
(FUNCTION CREATE3BY3]
(ASET Sx MATRIX 0 0)
(ASET 0.0 MATRIX 0 1)
(ASET 0.0 MATRIX 0 2)
(ASET 0.0 MATRIX 1 0)
(ASET Sy MATRIX 1 1)
(ASET 0.0 MATRIX 1 2)
(ASET 0.0 MATRIX 2 0)
(ASET 0.0 MATRIX 2 1)
(ASET 1.0 MATRIX 2 2)
MATRIX])
(ROTATE3BY3
[LAMBDA (PHI RADIANSFLG M) (* hdj " 8-Oct-85 18:19")
(LET ((MATRIX (\MAKEVALIDARRAY M (LIST 3 3)
(FUNCTION CREATE3BY3)))
(COSPHI (COS PHI RADIANSFLG))
(SINPHI (SIN PHI RADIANSFLG)))
(ASET COSPHI MATRIX 0 0)
(ASET (FMINUS SINPHI)
MATRIX 0 1)
(ASET 0.0 MATRIX 0 2)
(ASET SINPHI MATRIX 1 0)
(ASET COSPHI MATRIX 1 1)
(ASET 0.0 MATRIX 1 2)
(ASET 0.0 MATRIX 2 0)
(ASET 0.0 MATRIX 2 1)
(ASET 1.0 MATRIX 2 2)
MATRIX])
)
(DEFINEQ
(CREATE4BY4
[LAMBDA NIL (* hdj "26-Sep-85 14:35")
(MAKE-ARRAY (LIST 4 4)
:ELEMENT-TYPE
(QUOTE FLOAT])
(IDENTITY4BY4
[LAMBDA (M) (* hdj " 8-Oct-85 18:33")
(LET [(MATRIX (\MAKEVALIDARRAY M (LIST 4 4)
(FUNCTION CREATE4BY4]
(for Y from 0 to 3 do (for X from 0 to 3 do (ASET 0.0 MATRIX X Y)))
(ASET 1.0 MATRIX 0 0)
(ASET 1.0 MATRIX 1 1)
(ASET 1.0 MATRIX 2 2)
(ASET 1.0 MATRIX 3 3)
MATRIX])
(SCALE4BY4
[LAMBDA (Sx Sy Sz M) (* hdj "30-May-85 15:05")
(LET [(MATRIX (\MAKEVALIDARRAY M (LIST 3 3)
(FUNCTION CREATE4BY4]
(ASET Sx MATRIX 0 0)
(ASET Sy MATRIX 1 1)
(ASET Sz MATRIX 2 2)
(ASET 1.0 MATRIX 3 3)
MATRIX])
(TRANSLATE4BY4
[LAMBDA (Tx Ty Tz M) (* hdj "30-May-85 15:37")
(LET [(MATRIX (IDENTITY4BY4 (\MAKEVALIDARRAY M (LIST 4 4)
(FUNCTION CREATE4BY4]
(IDENTITY4BY4 MATRIX)
(ASET Tx MATRIX 3 0)
(ASET Ty MATRIX 3 1)
(ASET Tz MATRIX 3 2)
MATRIX])
(ROTATE4BY4.ABOUTX
[LAMBDA (PHI RADIANSFLG M) (* hdj " 8-Oct-85 18:36")
(LET ((MATRIX (\MAKEVALIDARRAY M (LIST 4 4)
(FUNCTION CREATE4BY4)))
(COSPHI (COS PHI RADIANSFLG))
(SINPHI (SIN PHI RADIANSFLG)))
(for Y from 0 to 3 do (for X from 0 to 3 do (ASET 0.0 MATRIX X Y)))
(ASET 1.0 MATRIX 0 0)
(ASET COSPHI MATRIX 1 1)
(ASET (FMINUS SINPHI)
MATRIX 1 2)
(ASET SINPHI MATRIX 2 1)
(ASET COSPHI MATRIX 2 2)
(ASET 1.0 MATRIX 3 3)
MATRIX])
(ROTATE4BY4.ABOUTY
[LAMBDA (PHI RADIANSFLG M) (* hdj " 8-Oct-85 18:36")
(LET ((MATRIX (\MAKEVALIDARRAY M (LIST 4 4)
(FUNCTION CREATE4BY4)))
(COSPHI (COS PHI RADIANSFLG))
(SINPHI (SIN PHI RADIANSFLG)))
(for Y from 0 to 3 do (for X from 0 to 3 do (ASET 0.0 MATRIX X Y)))
(ASET COSPHI MATRIX 0 0 4)
(ASET (FMINUS SINPHI)
MATRIX 2 0 4)
(ASET 1.0 MATRIX 1 1 4)
(ASET SINPHI MATRIX 0 2 4)
(ASET COSPHI MATRIX 2 2 4)
(ASET 1.0 MATRIX 3 3 4)
MATRIX])
(ROTATE4BY4.ABOUTZ
[LAMBDA (PHI RADIANSFLG M) (* hdj " 8-Oct-85 18:36")
(LET ((MATRIX (\MAKEVALIDARRAY M (LIST 4 4)
(FUNCTION CREATE4BY4)))
(COSPHI (COS PHI RADIANSFLG))
(SINPHI (SIN PHI RADIANSFLG)))
(for Y from 0 to 3 do (for X from 0 to 3 do (ASET 0.0 MATRIX X Y)))
(ASET COSPHI MATRIX 1 1)
(ASET (FMINUS SINPHI)
MATRIX 1 2)
(ASET SINPHI MATRIX 2 1)
(ASET COSPHI MATRIX 2 2)
(ASET 1.0 MATRIX 3 3)
(ASET 1.0 MATRIX 4 4)
MATRIX])
)
(DECLARE: EVAL@LOAD DOCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS GET.WCOORD MACRO [LAMBDA (VECTOR)
(* hdj "17-May-85 14:35")
(AREF VECTOR 0 3])
(PUTPROPS GET.XCOORD MACRO [LAMBDA (VECTOR)
(* hdj "17-May-85 14:34")
(AREF VECTOR 0 0])
(PUTPROPS GET.YCOORD MACRO [LAMBDA (VECTOR)
(* hdj "17-May-85 14:34")
(AREF VECTOR 0 1])
(PUTPROPS GET.ZCOORD MACRO [LAMBDA (VECTOR)
(* hdj "17-May-85 14:35")
(AREF VECTOR 0 2])
(PUTPROPS SET.WCOORD MACRO [LAMBDA (VECTOR VALUE)
(* hdj "16-May-85 14:29")
(ASET VALUE VECTOR 0 3])
(PUTPROPS SET.XCOORD MACRO [LAMBDA (VECTOR VALUE)
(* hdj "16-May-85 14:27")
(ASET VALUE VECTOR 0 0])
(PUTPROPS SET.YCOORD MACRO [LAMBDA (VECTOR VALUE)
(* hdj "16-May-85 14:28")
(ASET VALUE VECTOR 0 1])
(PUTPROPS SET.ZCOORD MACRO [LAMBDA (VECTOR VALUE)
(* hdj "16-May-85 14:28")
(ASET VALUE VECTOR 0 2])
)
(DECLARE: EVAL@COMPILE
[PUTPROPS MATMULT133 DMACRO (LAMBDA (MATRIXA MATRIXB MATRIXC)
(* hdj "12-Feb-85 12:28")
(* * multiply (1 , 3)
*
(3 , 3)
=>
(1 , 3))
(.MATMULT133 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC]
[PUTPROPS MATMULT331 DMACRO (LAMBDA (MATRIXA MATRIXB MATRIXC)
(* hdj "12-Feb-85 12:30")
(* * multiply (3 , 3)
*
(3 , 1)
=>
(3 , 1))
(.MATMULT331 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC]
[PUTPROPS MATMULT333 DMACRO (LAMBDA (MATRIXA MATRIXB MATRIXC)
(* hdj "12-Feb-85 12:30")
(* * multiply two (3 , 3)
matrices in microcode)
(.MATMULT333 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC]
[PUTPROPS MATMULT144 DMACRO (LAMBDA (MATRIXA MATRIXB MATRIXC)
(* hdj "12-Feb-85 12:31")
(* * multiply (1 , 4)
*
(4 , 4)
=>
(1 , 41))
(.MATMULT144 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC]
[PUTPROPS MATMULT441 DMACRO (LAMBDA (MATRIXA MATRIXB MATRIXC)
(* hdj "12-Feb-85 12:32")
(* * multiply (4 , 4)
*
(4 , 1)
=>
(4 , 1))
(.MATMULT441 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC]
[PUTPROPS MATMULT444 DMACRO (LAMBDA (MATRIXA MATRIXB MATRIXC)
(* hdj "12-Feb-85 12:25")
(* * multiply two (4 , 4)
matrices in microcode)
(.MATMULT444 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC]
)
(DECLARE: EVAL@COMPILE
(PUTPROPS .MATMULT133 DMACRO [LAMBDA (MATRIXABASE MATRIXBBASE MATRIXCBASE)
(* hdj "12-Feb-85 12:28")
(* * multiply (1 , 3)
*
(3 , 3)
=>
(1 , 3))
((OPCODES UBFLOAT3 3)
MATRIXABASE MATRIXBBASE MATRIXCBASE])
(PUTPROPS .MATMULT331 DMACRO [LAMBDA (MATRIXABASE MATRIXBBASE MATRIXCBASE)
(* hdj "12-Feb-85 12:30")
(* * multiply (3 , 3)
*
(3 , 1)
=>
(3 , 1))
((OPCODES UBFLOAT3 4)
MATRIXABASE MATRIXBBASE MATRIXCBASE])
(PUTPROPS .MATMULT333 DMACRO [LAMBDA (MATRIXABASE MATRIXBBASE MATRIXCBASE)
(* hdj "12-Feb-85 12:30")
(* * multiply two (3 , 3)
matrices in microcode)
((OPCODES UBFLOAT3 1)
MATRIXABASE MATRIXBBASE MATRIXCBASE])
(PUTPROPS .MATMULT144 DMACRO [LAMBDA (MATRIXABASE MATRIXBBASE MATRIXCBASE)
(* hdj "12-Feb-85 12:31")
(* * multiply (1 , 4)
*
(4 , 4)
=>
(1 , 41))
((OPCODES UBFLOAT3 5)
MATRIXABASE MATRIXBBASE MATRIXCBASE])
(PUTPROPS .MATMULT441 DMACRO [LAMBDA (MATRIXABASE MATRIXBBASE MATRIXCBASE)
(* hdj "12-Feb-85 12:32")
(* * multiply (4 , 4)
*
(4 , 1)
=>
(4 , 1))
((OPCODES UBFLOAT3 6)
MATRIXABASE MATRIXBBASE MATRIXCBASE])
(PUTPROPS .MATMULT444 DMACRO [LAMBDA (MATRIXABASE MATRIXBBASE MATRIXCBASE)
(* hdj "12-Feb-85 12:25")
(* * multiply two (4 , 4)
matrices in microcode)
((OPCODES UBFLOAT3 2)
MATRIXABASE MATRIXBBASE MATRIXCBASE])
)
)
(DEFINEQ
(\MATMULT
[LAMBDA (A B RESULT L M N) (* hdj " 7-Oct-85 15:04")
[for I from 1 to L do (for J from 1 to N
do (\SETELT RESULT I J N
(for K from 1 to M
sum (FTIMES (\GETELT A I K M)
(\GETELT B K J N]
RESULT])
)
(DECLARE: EVAL@COMPILE
[PUTPROPS \GETELT MACRO (ARGS (LET ((ARRAYBASE (CAR ARGS))
(ROW (CADR ARGS))
(COLUMN (CADDR ARGS))
(EltsPerRow (CADDDR ARGS)))
(if (AND (CONSTANTEXPRESSIONP ROW)
(CONSTANTEXPRESSIONP COLUMN)
(CONSTANTEXPRESSIONP EltsPerRow))
then
(BQUOTE (\GETBASEFLOATP , ARRAYBASE ,
(UNFOLD (IPLUS (SUB1 COLUMN)
(ITIMES (SUB1 ROW)
EltsPerRow))
WORDSPERCELL)))
else
(QUOTE IGNOREMACRO]
[PUTPROPS \SETELT MACRO (ARGS (LET [(ARRAYBASE (CAR ARGS))
(ROW (CADR ARGS))
(COLUMN (CADDR ARGS))
(EltsPerRow (CADDDR ARGS))
(VALUE (CADR (CDDDR ARGS]
(if (AND (CONSTANTEXPRESSIONP ROW)
(CONSTANTEXPRESSIONP COLUMN)
(CONSTANTEXPRESSIONP EltsPerRow))
then
(BQUOTE (\PUTBASEFLOATP , ARRAYBASE ,
(UNFOLD (IPLUS (SUB1 COLUMN)
(ITIMES (SUB1 ROW)
EltsPerRow))
WORDSPERCELL)
, VALUE))
else
(QUOTE IGNOREMACRO]
)
(DEFINEQ
(\GETELT
[LAMBDA (ARRAYBASE ROW COLUMN EltsPerRow) (* hdj " 5-Mar-85 16:59")
(\GETBASEFLOATP ARRAYBASE (UNFOLD (IPLUS (SUB1 COLUMN)
(ITIMES (SUB1 ROW)
EltsPerRow))
WORDSPERCELL])
(\SETELT
[LAMBDA (ARRAYBASE ROW COLUMN EltsPerRow VALUE) (* hdj "28-Feb-85 22:55")
(\PUTBASEFLOATP ARRAYBASE (UNFOLD (IPLUS (SUB1 COLUMN)
(ITIMES (SUB1 ROW)
EltsPerRow))
WORDSPERCELL)
VALUE])
(\MATRIX.GET.BASE
[LAMBDA (ARRAY) (* hdj " 8-Oct-85 15:31")
(if (type? ARRAY ARRAY)
then (\ADDBASE (ffetch (ARRAY BASE) of ARRAY)
(ffetch (ARRAY BASE.OFFSET) of ARRAY))
elseif (type? ARRAYP ARRAY)
then (\ADDBASE (ffetch (ARRAYP BASE) of ARRAY)
(ffetch (ARRAYP OFFST) of ARRAY))
else (\ILLEGAL.ARG ARRAY])
)
(DEFINEQ
(\CHECKVALIDARRAY
[LAMBDA (ARRAY DIMS TYPE) (* hdj "26-Sep-85 15:06")
(LET ((DIMENSIONS (ARRAY-DIMENSIONS ARRAY)))
(if (AND (type? ARRAY ARRAY)
(EQUAL DIMS DIMENSIONS)
(EQ (ARRAYELEMENTTYPE ARRAY)
TYPE))
then ARRAY
else (\ILLEGAL.ARG ARRAY])
)
(DECLARE: EVAL@COMPILE
(RPAQQ WORDSPER3BY3MATRIX 18)
(CONSTANTS WORDSPER3BY3MATRIX)
)
(DECLARE: EVAL@COMPILE
[PUTDEF (QUOTE TRANSFORM.BOX)
(QUOTE RESOURCES)
(QUOTE (NEW (IDENTITY3BY3]
)
(PUTPROPS MATMULT COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1482 6680 (ARRAYCOLS 1492 . 1637) (ARRAYROWS 1639 . 1783) (SHOW.ARRAY 1785 . 2146) (
\CHECKVALIDARRAY 2148 . 2511) (MAKEAIJ 2513 . 3067) (MAT.DETERMINANT 3069 . 4161) (MAT.INVERT 4163 .
5145) (MAT.INVERT.3BY3 5147 . 6479) (MAT.SIGN 6481 . 6678)) (6681 9444 (CONCATTRANSFORMS 6691 . 7034)
(MATMULT 7036 . 7715) (MATMULT133 7717 . 8001) (MATMULT331 8003 . 8287) (MATMULT333 8289 . 8578) (
MATMULT144 8580 . 8865) (MATMULT441 8867 . 9151) (MATMULT444 9153 . 9442)) (9445 10559 (SET.WCOORD
9455 . 9594) (SET.XCOORD 9596 . 9735) (SET.YCOORD 9737 . 9876) (SET.ZCOORD 9878 . 10017) (GET.XCOORD
10019 . 10152) (GET.YCOORD 10154 . 10287) (GET.ZCOORD 10289 . 10422) (GET.WCOORD 10424 . 10557)) (
10560 13698 (\MAKEVALIDARRAY 10570 . 10918) (CREATE1BY3 10920 . 11105) (CREATE3BY1 11107 . 11292) (
CREATE3BY3 11294 . 11479) (IDENTITY3BY3 11481 . 12009) (TRANSLATE3BY3 12011 . 12538) (SCALE3BY3 12540
. 13063) (ROTATE3BY3 13065 . 13696)) (13699 17007 (CREATE4BY4 13709 . 13887) (IDENTITY4BY4 13889 .
14355) (SCALE4BY4 14357 . 14691) (TRANSLATE4BY4 14693 . 15049) (ROTATE4BY4.ABOUTX 15051 . 15697) (
ROTATE4BY4.ABOUTY 15699 . 16357) (ROTATE4BY4.ABOUTZ 16359 . 17005)) (21336 21702 (\MATMULT 21346 .
21700)) (22830 23840 (\GETELT 22840 . 23091) (\SETELT 23093 . 23359) (\MATRIX.GET.BASE 23361 . 23838))
(23841 24216 (\CHECKVALIDARRAY 23851 . 24214)))))
STOP