(FILECREATED "27-Mar-86 15:47:01" {ERIS}<LISPCORE>LIBRARY>MATMULT.;16 31432
changes to: (VARS MATMULTCOMS)
previous date: "24-Feb-86 23:03:45" {ERIS}<LISPCORE>LIBRARY>MATMULT.;15)
(* Copyright (c) 1985, 1986 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 CREATE4BY1 CREATE1BY4 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))
(DECLARE: EVAL@LOAD DONTCOPY (FILES CMLSPECIALFORMS)
(RESOURCES TRANSFORM.BOX))
(DECLARE: EVAL@LOAD DOCOPY (INITRESOURCES TRANSFORM.BOX))
(FNS \MATMULT)
(MACROS \GETELT \SETELT)
(FNS \GETELT \SETELT \MATRIX.GET.BASE)
(FNS \CHECKVALIDARRAY)
(CONSTANTS WORDSPER3BY3MATRIX)))
(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
"24-Feb-86 22:59")
(* * multiply (1 , 3) * (3 , 3) => (1 , 3))
(.MATMULT133 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC))
MATRIXC])
(MATMULT331
[LAMBDA (MATRIXA MATRIXB MATRIXC) (* hdj
"24-Feb-86 23:00")
(* * multiply (3 , 3) * (3 , 1) => (3 , 1))
(.MATMULT331 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC))
MATRIXC])
(MATMULT333
[LAMBDA (MATRIXA MATRIXB MATRIXC) (* hdj
"24-Feb-86 23:00")
(* * multiply two (3 , 3) matrices in microcode)
(.MATMULT333 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC))
MATRIXC])
(MATMULT144
[LAMBDA (MATRIXA MATRIXB MATRIXC) (* hdj
"24-Feb-86 23:01")
(* * multiply (1 , 4) * (4 , 4) => (1 , 41))
(.MATMULT144 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC))
MATRIXC])
(MATMULT441
[LAMBDA (MATRIXA MATRIXB MATRIXC) (* hdj
"24-Feb-86 23:01")
(* * multiply (4 , 4) * (4 , 1) => (4 , 1))
(.MATMULT441 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC))
MATRIXC])
(MATMULT444
[LAMBDA (MATRIXA MATRIXB MATRIXC) (* hdj
"24-Feb-86 23:02")
(* * multiply two (4 , 4) matrices in microcode)
(.MATMULT444 (\MATRIX.GET.BASE MATRIXA)
(\MATRIX.GET.BASE MATRIXB)
(\MATRIX.GET.BASE MATRIXC))
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])
(CREATE4BY1
[LAMBDA NIL (* hdj
"24-Feb-86 22:18")
(MAKE-ARRAY (LIST 4 1):ELEMENT-TYPE (QUOTE SINGLE-FLOAT])
(CREATE1BY4
[LAMBDA NIL (* hdj
"24-Feb-86 22:18")
(MAKE-ARRAY (LIST 1 4):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
"24-Feb-86 22:50")
(LET [(MATRIX (\MAKEVALIDARRAY M (LIST 3 3)
(FUNCTION CREATE3BY3]
(ASET (FLOAT Sx)
MATRIX 0 0)
(ASET 0.0 MATRIX 0 1)
(ASET 0.0 MATRIX 0 2)
(ASET 0.0 MATRIX 1 0)
(ASET (FLOAT 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
"24-Feb-86 22:40")
(LET [(MATRIX (\MAKEVALIDARRAY M (LIST 4 4)
(FUNCTION CREATE4BY4]
(ASET (FLOAT Sx)
MATRIX 0 0)
(ASET (FLOAT Sy)
MATRIX 1 1)
(ASET (FLOAT 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
"24-Feb-86 22:42")
(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)
(ASET (FMINUS SINPHI)
MATRIX 2 0)
(ASET 1.0 MATRIX 1 1)
(ASET SINPHI MATRIX 0 2)
(ASET COSPHI MATRIX 2 2)
(ASET 1.0 MATRIX 3 3)
MATRIX])
(ROTATE4BY4.ABOUTZ
[LAMBDA (PHI RADIANSFLG M) (* hdj
"24-Feb-86 22:46")
(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)
(ASET (FMINUS SINPHI)
MATRIX 0 1)
(ASET SINPHI MATRIX 1 0)
(ASET COSPHI MATRIX 1 1)
(ASET 1.0 MATRIX 2 2)
(ASET 1.0 MATRIX 3 3)
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))
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))
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))
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))
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))
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))
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]
)
)
(DECLARE: EVAL@LOAD DONTCOPY
(FILESLOAD CMLSPECIALFORMS)
(DECLARE: EVAL@COMPILE
[PUTDEF (QUOTE TRANSFORM.BOX)
(QUOTE RESOURCES)
(QUOTE (NEW (IDENTITY3BY3]
)
)
(DECLARE: EVAL@LOAD DOCOPY
(/SETTOPVAL (QUOTE \TRANSFORM.BOX.GLOBALRESOURCE))
)
(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)
)
(PUTPROPS MATMULT COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2023 7221 (ARRAYCOLS 2033 . 2178) (ARRAYROWS 2180 . 2324) (SHOW.ARRAY 2326 . 2687) (
\CHECKVALIDARRAY 2689 . 3052) (MAKEAIJ 3054 . 3608) (MAT.DETERMINANT 3610 . 4702) (MAT.INVERT 4704 .
5686) (MAT.INVERT.3BY3 5688 . 7020) (MAT.SIGN 7022 . 7219)) (7222 10783 (CONCATTRANSFORMS 7232 . 7575)
(MATMULT 7577 . 8256) (MATMULT133 8258 . 8675) (MATMULT331 8677 . 9094) (MATMULT333 9096 . 9518) (
MATMULT144 9520 . 9938) (MATMULT441 9940 . 10357) (MATMULT444 10359 . 10781)) (10784 11898 (SET.WCOORD
10794 . 10933) (SET.XCOORD 10935 . 11074) (SET.YCOORD 11076 . 11215) (SET.ZCOORD 11217 . 11356) (
GET.XCOORD 11358 . 11491) (GET.YCOORD 11493 . 11626) (GET.ZCOORD 11628 . 11761) (GET.WCOORD 11763 .
11896)) (11899 15665 (\MAKEVALIDARRAY 11909 . 12257) (CREATE1BY3 12259 . 12444) (CREATE4BY1 12446 .
12704) (CREATE1BY4 12706 . 12964) (CREATE3BY1 12966 . 13151) (CREATE3BY3 13153 . 13338) (IDENTITY3BY3
13340 . 13868) (TRANSLATE3BY3 13870 . 14397) (SCALE3BY3 14399 . 15030) (ROTATE3BY3 15032 . 15663)) (
15666 19394 (CREATE4BY4 15676 . 15854) (IDENTITY4BY4 15856 . 16322) (SCALE4BY4 16324 . 16822) (
TRANSLATE4BY4 16824 . 17180) (ROTATE4BY4.ABOUTX 17182 . 17828) (ROTATE4BY4.ABOUTY 17830 . 18610) (
ROTATE4BY4.ABOUTZ 18612 . 19392)) (27320 27686 (\MATMULT 27330 . 27684)) (29870 30880 (\GETELT 29880
. 30131) (\SETELT 30133 . 30399) (\MATRIX.GET.BASE 30401 . 30878)) (30881 31256 (\CHECKVALIDARRAY
30891 . 31254)))))
STOP