(FILECREATED "16-Jul-86 13:00:21" {PHYLUM}<PAPERWORKS>SKETCHTRANSUTILS.;8 10212
changes to: (VARS SKETCHTRANSUTILSCOMS)
(FNS SK.AREF.3BY3 AREF SK.ASET)
previous date: "16-Jul-86 12:05:41" {PHYLUM}<PAPERWORKS>SKETCHTRANSUTILS.;7)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT SKETCHTRANSUTILSCOMS)
(RPAQQ SKETCHTRANSUTILSCOMS ((COMS (* fns from MATMULT that are here so CMLARRAY doesn't need to be
loaded.)
(FNS MATMULT333 CREATE3BY3 TRANSLATE3BY3 SCALE3BY3 AREF
ROTATE3BY3 \MATRIX.GET.BASE)
(DECLARE: DONTCOPY DONTEVAL@LOAD DOEVAL@COMPILE (FILES (LOADCOMP)
MATMULT)))
(COMS (* fns from CMLARRAY that are here so it doesn't need to be
loaded.)
(FNS SK.ASET ARRAY-RANK \ASETLINEAR \CML.MAKE.STORAGE
\MAKEVALIDARRAY ARRAY-DIMENSIONS \MARGINTO
\MARGIN.ONE.DIMENSION)
(DECLARE: DONTCOPY DONTEVAL@LOAD DOEVAL@COMPILE (FILES (LOADCOMP)
CMLARRAY))
(INITRECORDS ARRAY))))
(* fns from MATMULT that are here so CMLARRAY doesn't need to be loaded.)
(DEFINEQ
(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])
(CREATE3BY3
[LAMBDA NIL (* rrb "14-Jul-86 17:25")
(* used to be (MAKE-ARRAY (LIST 3 3) :ELEMENT-TYPE (QUOTE SINGLE-FLOAT)) Was expanded in-line to remove the call to
MAKE-ARRAY which requires large parts of CMLARRAY)
(LET ((TYPE# 7)
(#ELTS 9)
(RANK 2)
BASE
(BASE.OFFSET 0)
ARRAY)
(* * Handle storage requirements (this should move into implementing structure cases below))
(SETQ BASE (\CML.MAKE.STORAGE #ELTS TYPE# NIL NIL))
(* * Make an array)
(SETQ ARRAY
(create ARRAY
ORIGIN ← 0
RANK ← RANK
HAS.FILL.POINTER ← NIL
TOTAL.SIZE ← #ELTS
BASE ← BASE
BASE.OFFSET ← BASE.OFFSET
ELEMENT.TYPE ← TYPE#
MARGINS ←(\MARGINTO (LIST 3 3))
DIMENSIONS ←(LIST 3 3)
ADJUSTABLE.P ← NIL
FILL.POINTER ←(OR NIL 0)
DISPLACEE.START ← NIL))
ARRAY])
(TRANSLATE3BY3
[LAMBDA (Tx Ty M) (* rrb "14-Jul-86 17:39")
(LET [(MATRIX (\MAKEVALIDARRAY M (LIST 3 3)
(FUNCTION CREATE3BY3]
(SK.ASET 1.0 MATRIX 0 0)
(SK.ASET 0.0 MATRIX 0 1)
(SK.ASET 0.0 MATRIX 0 2)
(SK.ASET 0.0 MATRIX 1 0)
(SK.ASET 1.0 MATRIX 1 1)
(SK.ASET 0.0 MATRIX 1 2)
(SK.ASET Tx MATRIX 2 0)
(SK.ASET Ty MATRIX 2 1)
(SK.ASET 1.0 MATRIX 2 2)
MATRIX])
(SCALE3BY3
[LAMBDA (Sx Sy M) (* rrb "14-Jul-86 17:38")
(LET [(MATRIX (\MAKEVALIDARRAY M (LIST 3 3)
(FUNCTION CREATE3BY3]
(SK.ASET (FLOAT Sx)
MATRIX 0 0)
(SK.ASET 0.0 MATRIX 0 1)
(SK.ASET 0.0 MATRIX 0 2)
(SK.ASET 0.0 MATRIX 1 0)
(SK.ASET (FLOAT Sy)
MATRIX 1 1)
(SK.ASET 0.0 MATRIX 1 2)
(SK.ASET 0.0 MATRIX 2 0)
(SK.ASET 0.0 MATRIX 2 1)
(SK.ASET 1.0 MATRIX 2 2)
MATRIX])
(AREF
[LAMBDA (ARRAY ROW COL) (* rrb "16-Jul-86 12:54")
(* version of AREF that works on 3 by 3 arrays.
Here so that CMLARRY doesn't have to be loaded.)
(\CML.TYPED.GET (ffetch (ARRAY ELEMENT.TYPE) of ARRAY)
(ffetch (ARRAY BASE) of ARRAY)
(IPLUS (PLUS (TIMES ROW 3)
COL)
(ffetch (ARRAY BASE.OFFSET) of ARRAY])
(ROTATE3BY3
[LAMBDA (PHI RADIANSFLG M) (* rrb "14-Jul-86 17:38")
(LET ((MATRIX (\MAKEVALIDARRAY M (LIST 3 3)
(FUNCTION CREATE3BY3)))
(COSPHI (COS PHI RADIANSFLG))
(SINPHI (SIN PHI RADIANSFLG)))
(SK.ASET COSPHI MATRIX 0 0)
(SK.ASET (FMINUS SINPHI)
MATRIX 0 1)
(SK.ASET 0.0 MATRIX 0 2)
(SK.ASET SINPHI MATRIX 1 0)
(SK.ASET COSPHI MATRIX 1 1)
(SK.ASET 0.0 MATRIX 1 2)
(SK.ASET 0.0 MATRIX 2 0)
(SK.ASET 0.0 MATRIX 2 1)
(SK.ASET 1.0 MATRIX 2 2)
MATRIX])
(\MATRIX.GET.BASE
[LAMBDA (ARRAY) (* hdj " 8-Oct-85 15:31")
(COND
((type? ARRAY ARRAY)
(\ADDBASE (ffetch (ARRAY BASE) of ARRAY)
(ffetch (ARRAY BASE.OFFSET) of ARRAY)))
((type? ARRAYP ARRAY)
(\ADDBASE (ffetch (ARRAYP BASE) of ARRAY)
(ffetch (ARRAYP OFFST) of ARRAY)))
(T (\ILLEGAL.ARG ARRAY])
)
(DECLARE: DONTCOPY DONTEVAL@LOAD DOEVAL@COMPILE
(FILESLOAD (LOADCOMP)
MATMULT)
)
(* fns from CMLARRAY that are here so it doesn't need to be loaded.)
(DEFINEQ
(SK.ASET
[LAMBDA (VALUE ARRAY ROW COL) (* rrb "14-Jul-86 17:37")
(* version of ASET that only works on ARRAYs.
Copied here so that CMLARRAY doesn't need to be
loaded.)
(\ASETLINEAR VALUE ARRAY (IPLUS (\AREFSET.LINEARIZE ARRAY (LIST ROW COL))
(ffetch (ARRAY BASE.OFFSET) of ARRAY])
(ARRAY-RANK
[LAMBDA (ARRAY) (* raf "19-Sep-85 14:18")
(COND
((type? ARRAY ARRAY)
(fetch (ARRAY RANK) of ARRAY))
((OR (type? STRINGP ARRAY)
(type? ARRAYP ARRAY))
1)
((type? BITMAP ARRAY)
2)
(T (ERROR "Not an array" ARRAY])
(\ASETLINEAR
[LAMBDA (VAL ARRAY I) (* raf "26-Jul-85 18:45")
(* * Set an array element. Does not take offsets into account. Does not check argument types)
(\CML.TYPED.PUT (ffetch (ARRAY ELEMENT.TYPE) of ARRAY)
(ffetch (ARRAY BASE) of ARRAY)
I VAL])
(\CML.MAKE.STORAGE
[LAMBDA (#ELTS TYPE# INIT.ON.PAGE ALIGNMENT) (* raf "17-Sep-85 00:49")
(LET ((#CELLS (FOLDHI (ADD1 (ITIMES #ELTS (\CML.BITS.PER.ELEMENT TYPE#)))
BITSPERCELL)))
(COND
((ZEROP #ELTS)
NIL)
((ILEQ #ELTS (CONSTANT \MaxArrayNCells))
(\ALLOCBLOCK #CELLS (\CML.ELEMENT.GC.TYPE TYPE#)
INIT.ON.PAGE ALIGNMENT))
(T (COND
(ARRAYWARNINGFLG (PROMPTPRINT "Warning: allocating fixed pages for large array")))
(\ALLOCPAGEBLOCK (FOLDHI #CELLS CELLSPERPAGE])
(\MAKEVALIDARRAY
[LAMBDA (ARRAY DIMS CREATEFN) (* hdj "26-Sep-85 14:36")
(COND
((AND (type? ARRAY ARRAY)
(EQUAL DIMS (ARRAY-DIMENSIONS ARRAY)))
ARRAY)
(T (COND
((NULL ARRAY)
(APPLY CREATEFN))
(T (\ILLEGAL.ARG ARRAY])
(ARRAY-DIMENSIONS
[LAMBDA (ARRAY) (* raf "16-Sep-85 16:29")
(COND
((type? STRINGP ARRAY)
(LIST (NCHARS ARRAY)))
((type? BITMAP ARRAY)
(LIST (BITMAPWIDTH ARRAY)
(BITMAPHEIGHT ARRAY)))
((type? ARRAY ARRAY)
(ffetch (ARRAY DIMENSIONS) of ARRAY))
((type? ARRAYP ARRAY)
(LIST (ARRAYSIZE ARRAY)))
(T (ERROR "Not an array" ARRAY])
(\MARGINTO
[LAMBDA (DIML) (* raf "18-Jul-85 16:59")
(if (ILESSP (FLENGTH DIML)
2)
then 0
else (LET ((THIS.ROW.BASE 0))
(DECLARE (SPECVARS THIS.ROW.BASE))
(\MARGIN.ONE.DIMENSION DIML])
(\MARGIN.ONE.DIMENSION
[LAMBDA (DIML) (* raf "17-Jul-85 00:21")
(DECLARE (SPECVARS THIS.ROW.BASE))
(LET* ((#HYPER.ROWS (CAR DIML))
(NEXTDIML (OR (CDR DIML)
(SHOULDNT)))
(LASTDIMENSIONP (NULL (CDR NEXTDIML)))
(MARGINARRAY (\ALLOCBLOCK #HYPER.ROWS T)))
(* * Except for the final margining over the real baseblock, each margin array will be going into another margin
array for the next dimension.)
[if LASTDIMENSIONP
then (LET ((#ELTS/ROW (CAR NEXTDIML)))
(for I from 0 to (SUB1 #HYPER.ROWS)
do (\RPLPTR MARGINARRAY (LLSH I 1)
THIS.ROW.BASE)
(add THIS.ROW.BASE #ELTS/ROW)))
else (for I from 0 to (SUB1 #HYPER.ROWS) do (\RPLPTR MARGINARRAY
(LLSH I 1)
(
\MARGIN.ONE.DIMENSION
NEXTDIML]
MARGINARRAY])
)
(DECLARE: DONTCOPY DONTEVAL@LOAD DOEVAL@COMPILE
(FILESLOAD (LOADCOMP)
CMLARRAY)
)
(/DECLAREDATATYPE (QUOTE ARRAY)
(QUOTE ((BITS 4)
(BITS 1)
(BITS 18)
FLAG FLAG (BITS 7)
(BITS 32)
POINTER POINTER POINTER (BITS 32)
(BITS 32)
POINTER
(BITS 32)
FULLXPOINTER FULLXPOINTER))
(QUOTE ((ARRAY 0 (BITS . 3))
(ARRAY 0 (BITS . 64))
(ARRAY 0 (LONGBITS . 225))
(ARRAY 0 (FLAGBITS . 80))
(ARRAY 0 (FLAGBITS . 96))
(ARRAY 0 (BITS . 118))
(ARRAY 2 (LONGBITS . 15))
(ARRAY 4 POINTER)
(ARRAY 6 POINTER)
(ARRAY 8 POINTER)
(ARRAY 10 (LONGBITS . 15))
(ARRAY 12 (LONGBITS . 15))
(ARRAY 14 POINTER)
(ARRAY 16 (LONGBITS . 15))
(ARRAY 18 FULLXPOINTER)
(ARRAY 20 FULLXPOINTER)))
(QUOTE 22))
(PUTPROPS SKETCHTRANSUTILS COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1138 5240 (MATMULT333 1148 . 1451) (CREATE3BY3 1453 . 2455) (TRANSLATE3BY3 2457 . 3011)
(SCALE3BY3 3013 . 3599) (AREF 3601 . 4119) (ROTATE3BY3 4121 . 4782) (\MATRIX.GET.BASE 4784 . 5238)) (
5404 9324 (SK.ASET 5414 . 5864) (ARRAY-RANK 5866 . 6219) (\ASETLINEAR 6221 . 6573) (\CML.MAKE.STORAGE
6575 . 7155) (\MAKEVALIDARRAY 7157 . 7488) (ARRAY-DIMENSIONS 7490 . 7971) (\MARGINTO 7973 . 8281) (
\MARGIN.ONE.DIMENSION 8283 . 9322)))))
STOP