(FILECREATED " 7-Sep-84 18:01:09" {ERIS}<LISPCORE>SOURCES>MISCOPS.;1 8652
changes to: (VARS MISCOPSCOMS)
(FNS BLKSEP BLKFDIFF BLKFPLUS \MISC8.UFN \MISC7.UFN \MISC6.UFN \MISC5.UFN
\MISC4.UFN \MISC3.UFN \IBLT1.UFN \IBLT2.UFN BLKEXPONENT)
(PROPS (\BLKEXPONENT DOPVAL)
(\BLKMAG DOPVAL)
(\BLKSMALLP2FLOAT DOPVAL)
(\BLKPERM DOPVAL)
(\BLKFTIMES DOPVAL)
(\BLKFDIFF DOPVAL)
(\BLKFPLUS DOPVAL)
(\BLKSEP DOPVAL)
(\IBLT1 DOPVAL)
(\IBLT2 DOPVAL)
(\BLKFLOATP2COMP DOPVAL))
previous date: " 7-Sep-84 17:53:03" {ERIS}<LISPCORE>SOURCES>MISCOPS.;1)
(* Copyright (c) by NIL. All rights reserved.)
(PRETTYCOMPRINT MISCOPSCOMS)
(RPAQQ MISCOPSCOMS ((* * misc opcode UFNs)
(FNS \MISC3.UFN \MISC4.UFN \MISC5.UFN \MISC6.UFN \MISC7.UFN \MISC8.UFN)
(COMS (* * sub-UFNs for \MISC3.UFN)
(FNS \FLOATBLT1.UFN BLKEXPONENT BLKMAG BLKSMALLP2FLOAT BLKFLOATP2COMP)
(PROP DOPVAL \BLKEXPONENT \BLKMAG \BLKSMALLP2FLOAT \BLKFLOATP2COMP))
(COMS (* * sub-UFNs for \MISC4.UFN)
(FNS \FLOATBLT2.UFN BLKPERM BLKFTIMES BLKFDIFF BLKFPLUS BLKSEP)
(PROP DOPVAL \BLKPERM \BLKFTIMES \BLKFDIFF \BLKFPLUS \BLKSEP))
(COMS (* * sub-UFNs for \MISC8.UFN)
(FNS \IBLT1.UFN \IBLT2.UFN)
(PROP DOPVAL \IBLT1 \IBLT2))))
(* * misc opcode UFNs)
(DEFINEQ
(\MISC3.UFN
[LAMBDA (ARG1 ARG2 ARG3 ALPHA) (* hdj " 7-Sep-84 15:49")
(SELECTQ ALPHA
((0 1 2 3)
(\FLOATBLT1.UFN ARG1 ARG2 ARG3 ALPHA))
(HELP "Illegal op to \MISC3.UFN --" ALPHA])
(\MISC4.UFN
[LAMBDA (ARG1 ARG2 ARG3 ARG4 ALPHA) (* hdj " 7-Sep-84 15:46")
(SELECTQ ALPHA
((0 1 2 3 4)
(\FLOATBLT2.UFN ARG1 ARG2 ARG3 ARG4 ALPHA))
(HELP "Illegal op to \MISC4.UFN -- " ALPHA])
(\MISC5.UFN
[LAMBDA (ARG1 ARG2 ARG3 ARG4 ARG5 ALPHA) (* hdj " 7-Sep-84 17:37")
(SELECTQ ALPHA
((0 THRU N)
(\FLOATBLT ARG1 ARG2 ARG3 ARG4 ARG5 ALPHA))
(HELP "illegal op to \MISC5.UFN -- ALPHA"])
(\MISC6.UFN
[LAMBDA (ARG1 ARG2 ARG3 ARG4 ARG5 ARG6 ALPHA) (* hdj " 7-Sep-84 15:58")
(SELECTQ ALPHA NIL])
(\MISC7.UFN
[LAMBDA (ARG1 ARG2 ARG3 ARG4 ARG5 ARG6 ARG7 ALPHA) (* hdj " 7-Sep-84 15:58")
(SELECTQ ALPHA NIL])
(\MISC8.UFN
[LAMBDA (ARG1 ARG2 ARG3 ARG4 ARG5 ARG6 ARG7 ARG8 ALPHA) (* hdj " 7-Sep-84 16:03")
(SELECTQ ALPHA
(0 (\IBLT1.UFN ARG1 ARG2 ARG3 ARG4 ARG5 ARG6 ARG7 ARG8))
(1 (\IBLT2.UFN ARG1 ARG2 ARG3 ARG4 ARG5 ARG6 ARG7 ARG8))
(HELP "Illegal op to \MISC8.UFN --" ALPHA])
)
(* * sub-UFNs for \MISC3.UFN)
(DEFINEQ
(\FLOATBLT1.UFN
[LAMBDA (SOURCE DEST KOUNT OP) (* hdj " 7-Sep-84 15:47")
(* * single-source version of floating-point array ops)
(SELECTC OP
(0 (BLKEXPONENT SOURCE DEST KOUNT))
(1 (BLKMAG SOURCE DEST KOUNT))
(2 (BLKSMALLP2FLOAT SOURCE DEST KOUNT))
(3 (BLKFLOATP2COMP SOURCE DEST KOUNT))
(HELP "illegal op to \FLOATBLT1.UFN" OP])
(BLKEXPONENT
[LAMBDA (source destination kount) (* edited: "24-Jun-84 23:44")
(* * extract the exponent of each element of source, stick it in destination)
(* \CHECKARRAYINDEX destination
(SUB1 kount))
(for X from 0 to (SUB1 kount) do (\PUTBASE destination X (fetch (FLOATP EXPONENT)
of (\GETBASEFLOATP source
(LLSH X 1])
(BLKMAG
[LAMBDA (complexArray magnitudeArray kount) (* hdj " 7-Sep-84 17:57")
(for magnitude from 0 to (SUB1 kount) bind complexcount real imag
do (SETQ complexcount (LLSH magnitude 2))
(SETQ real (\GETBASEFLOATP complexArray complexcount))
(SETQ imag (\GETBASEFLOATP complexArray (IPLUS complexcount 2)))
(\PUTBASEFLOATP magnitudeArray (LLSH magnitude 1)
(FPLUS (FTIMES real real)
(FTIMES imag imag])
(BLKSMALLP2FLOAT
[LAMBDA (source destination kkount) (* hdj " 7-Sep-84 17:57")
(* * convert an array of SMALLPs to FLOATPs)
(for NN from 0 to (SUB1 kkount) do (\PUTBASEFLOATP destination (LLSH NN 1)
(FLOAT (\GETBASE source NN])
(BLKFLOATP2COMP
[LAMBDA (source destination kount) (* hdj " 7-Sep-84 17:58")
(* * moves the contents of a Real array into a Complex array; sets imaginary part to 0)
(for sourceElt from 0 to (SUB1 kount) do (SETCOMPLEX (\ADDBASE destination (LLSH sourceElt 2))
(\GETBASEFLOATP source (LLSH sourceElt 1))
0.0])
)
(PUTPROPS \BLKEXPONENT DOPVAL (3 MISC3 0))
(PUTPROPS \BLKMAG DOPVAL (3 MISC3 1))
(PUTPROPS \BLKSMALLP2FLOAT DOPVAL (3 MISC3 2))
(PUTPROPS \BLKFLOATP2COMP DOPVAL (3 MISC3 3))
(* * sub-UFNs for \MISC4.UFN)
(DEFINEQ
(\FLOATBLT2.UFN
[LAMBDA (SOURCE1 SOURCE2 DEST KOUNT OP) (* hdj " 7-Sep-84 15:34")
(SELECTC OP
(0 (BLKFTIMES SOURCE1 SOURCE2 DEST KOUNT))
(1 (BLKPERM SOURCE1 SOURCE2 DEST KOUNT))
(2 (BLKFPLUS SOURCE1 SOURCE2 DEST KOUNT))
(3 (BLKFDIFF SOURCE1 SOURCE2 DEST KOUNT))
(4 (BLKSEP SOURCE1 SOURCE2 DEST KOUNT))
(SHOULDNT "illegal OP to \FLOATBLT2.UFN"])
(BLKPERM
[LAMBDA (orig permutations destination kount) (* hdj " 7-Sep-84 17:58")
(* * destination (x) ← orig (perm (x)))
(* * args are arrays of smallps (words))
(* * must fold initial into offset for compatibility with microcode)
(for X from 0 to (SUB1 kount) do (\PUTBASE destination X (\GETBASE orig (\GETBASE permutations X])
(BLKFTIMES
[LAMBDA (SOURCE1 SOURCE2 DEST KOUNT) (* hdj " 7-Sep-84 15:38")
(for INDEX from 0 to (LLSH (SUB1 KOUNT)
1)
by 2 do (\PUTBASEFLOATP DEST INDEX (FTIMES (\GETBASEFLOATP SOURCE1 INDEX)
(\GETBASEFLOATP SOURCE2 INDEX])
(BLKFDIFF
[LAMBDA (SOURCE1 SOURCE2 DEST KOUNT) (* hdj " 7-Sep-84 15:39")
(for INDEX from 0 to (LLSH (SUB1 KOUNT)
1)
by 2 do (\PUTBASEFLOATP DEST INDEX (FDIFFERENCE (\GETBASEFLOATP SOURCE1 INDEX)
(\GETBASEFLOATP SOURCE2 INDEX])
(BLKFPLUS
[LAMBDA (SOURCE1 SOURCE2 DEST KOUNT) (* hdj " 7-Sep-84 15:38")
(for INDEX from 0 to (LLSH (SUB1 KOUNT)
1)
by 2 do (\PUTBASEFLOATP DEST INDEX (FPLUS (\GETBASEFLOATP SOURCE1 INDEX)
(\GETBASEFLOATP SOURCE2 INDEX])
(BLKSEP
[LAMBDA (SOURCE1 SOURCE2 DEST KOUNT) (* hdj " 7-Sep-84 15:40")
(HELP "No UFN for BLKSEP as yet"])
)
(PUTPROPS \BLKPERM DOPVAL (4 MISC4 1))
(PUTPROPS \BLKFTIMES DOPVAL (4 MISC4 0))
(PUTPROPS \BLKFDIFF DOPVAL (4 MISC4 3))
(PUTPROPS \BLKFPLUS DOPVAL (4 MISC4 2))
(PUTPROPS \BLKSEP DOPVAL (4 MISC4 4))
(* * sub-UFNs for \MISC8.UFN)
(DEFINEQ
(\IBLT1.UFN
[LAMBDA (ValueArray TextureArray XCoord BitmapAddr BitmapWidth ValHeight ValWidth Kount)
(* hdj " 2-Jul-84 17:52")
(* * ValueArray -
an array of 128 elements, 8 bits each)
(* * TextureArray -
an array of 256 elements, each a texture)
(* * XCoord -
bit offset from left of destination bitmap)
(* * BitmapAddr -
destination)
(* * BitmapWidth -
width of dest bitmap in words)
(* * ValHeight -
height of bar)
(* * ValWidth -
width of bar)
(* * Kount -
how many elements of ValueArray to graph)
(PROG (TEXTURE (BITMAPOFFSET BitmapAddr))
(for val from (SUB1 Kount) to 0 by -1
do (SETQ TEXTURE (\GETBASE TextureArray (\GETBASE ValueArray val)))
(for X from 1 to ValHeight
do (\PUTBASEBITS BITMAPOFFSET XCoord ValWidth TEXTURE)
(SETQ BITMAPOFFSET (\ADDBASE BITMAPOFFSET BitmapWidth])
(\IBLT2.UFN
[LAMBDA NIL (* hdj " 7-Sep-84 16:04")
(HELP "\IBLT2.UFN not yet defined"])
)
(PUTPROPS \IBLT1 DOPVAL (8 MISC8 1))
(PUTPROPS \IBLT2 DOPVAL (8 MISC8 1))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1334 2666 (\MISC3.UFN 1344 . 1587) (\MISC4.UFN 1589 . 1840) (\MISC5.UFN 1842 . 2087) (
\MISC6.UFN 2089 . 2220) (\MISC7.UFN 2222 . 2353) (\MISC8.UFN 2355 . 2664)) (2703 4839 (\FLOATBLT1.UFN
2713 . 3146) (BLKEXPONENT 3148 . 3650) (BLKMAG 3652 . 4128) (BLKSMALLP2FLOAT 4130 . 4440) (
BLKFLOATP2COMP 4442 . 4837)) (5070 7004 (\FLOATBLT2.UFN 5080 . 5513) (BLKPERM 5515 . 5938) (BLKFTIMES
5940 . 6243) (BLKFDIFF 6245 . 6557) (BLKFPLUS 6559 . 6859) (BLKSEP 6861 . 7002)) (7264 8546 (
\IBLT1.UFN 7274 . 8395) (\IBLT2.UFN 8397 . 8544)))))
STOP