(FILECREATED "22-Jun-84 18:21:16" {ERIS}<SPEECH>SPECTRUM>LOBOTOMIZED>BLOCKFLOAT.;4 26689
previous date: "22-Jun-84 17:36:27" {ERIS}<SPEECH>SPECTRUM>LOBOTOMIZED>BLOCKFLOAT.;2)
(* Copyright (c) 1984 by I)
(PRETTYCOMPRINT BLOCKFLOATCOMS)
(RPAQQ BLOCKFLOATCOMS ((* UFNs)
(FNS * BLOCKFNS)
(* support fns)
(FNS * BLOCKSUPPORTFNS)
(* * these are dangerous and probably wrong)
(FNS * BLOCKACCESSORS)
(VARS GRAPHOFFSET GRAPHTESTFLG GWIDTH INNERFNS SAMPLESPERFFT SCALE
SpeechThresholds THRESHLIST (WAVE))
(RECORDS ARRAYP FFTTABLE FLOATP PILOTBBT)
(MACROS ARRAYBASE FASTSETA FASTELT \DOPILOTBITBLT)))
(* UFNs)
(RPAQQ BLOCKFNS (ARRAYBASE BLKEXPONENT BLKGRAPH BLKGRAPH2 BLKMAG BLKSMALLP2FLOAT BLKFLOATP2COMP
BLKFTIMES BLKPERM INITTHEM \DOPILOTBITBLT \FLOATBLT1.UFN \FLOATBLT2.UFN))
(DEFINEQ
(ARRAYBASE
[LAMBDA (AR) (* lmm "28-Mar-84 17:05")
(\GETBASEPTR AR 0])
(BLKEXPONENT
[LAMBDA NIL (* edited: "22-Jun-84 17:02")
(* source destination kount)
(* hdj "21-Jun-84 18:13")
(* * extract the exponent of each element of source, stick it in destination)
(* \CHECKARRAYINDEX destination
(SUB1 kount))
(for X from 0 to (IPLUS (SUB1 128)
(SUB1 128))
by 2 do (\PUTBASEFIXP MAGNITUDESQUARED X (fetch (FLOATP EXPONENT) of (\GETBASEFLOATP
MAGNITUDESQUARED X])
(BLKGRAPH
[LAMBDA NIL (* edited: "22-Jun-84 17:04")
(* ARRAY X BITMAP KOUNT)
(* hdj "18-Jun-84 16:20")
(* * draws contents of LOGMAGNITUDE at position X in BITMAP)
(\CHECKARRAYINDEX LOGMAGNITUDE (SUB1 KOUNT))
[for XL from 1 to 6 do (for Y from 0 to (SUB1 128) do (COND
((IGREATERP (ELT LOGMAGNITUDE Y)
(ELT THRESH XL))
(BITMAPBIT GBITMAP (IPLUS GSTART XL)
Y 1]
(COND
(NIL (for Y from 0 to 512 do (COND
((ILESSP (ELT WAVE (PLUS Y (ITIMES 100 WSTART)))
0)
(for XL from (ELT WAVE (PLUS Y (ITIMES 100 WSTART)))
to 0 do (BITMAPBIT BITMAP Y (PLUS 300 XL)
1)))
(T (for XL from 0 to (ELT WAVE (PLUS Y (ITIMES 100 WSTART)))
do (BITMAPBIT BITMAP Y (PLUS 300 XL)
1])
(BLKGRAPH2
[LAMBDA (ValueArray ThreshArray XCoord BitmapAddr BitmapWidth ValHeight ValWidth Kount)
(* hdj "21-Jun-84 19:46")
(* * ValueArray -
an array of 128 elements, 8 bits each)
(* * ThreshArray -
an array of 256 elements, each a texture)
(* * XCoord -
bit offset from left of destination bitmap)
(* * BitmapAddr -
destination)
(* * ValHeight -
height of bar)
(* * ValWidth -
width of bar)
(* * Kount -
how many elements of ValueArray to graph)
(PROG [(BBTTABLE (NCREATE (QUOTE PILOTBBT]
(replace (PILOTBBT PBTDEST) of BBTTABLE with BitmapAddr)
(replace (PILOTBBT PBTDESTBPL) of BBTTABLE with BitmapWidth)
(replace (PILOTBBT PBTSOURCEBPL) of BBTTABLE with 16)
(replace (PILOTBBT PBTSOURCEBIT) of BBTTABLE with 0)
(replace (PILOTBBT PBTDESTBIT) of BBTTABLE with XCoord)
(replace (PILOTBBT PBTWIDTH) of BBTTABLE with ValWidth)
(replace (PILOTBBT PBTHEIGHT) of BBTTABLE with ValHeight)
(replace (PILOTBBT PBTOPERATION) of BBTTABLE with 2)
(* 2 means "OR")
(replace (PILOTBBT PBTSOURCETYPE) of BBTTABLE with 0)
(* 0 means "nothing special")
(replace (PILOTBBT PBTUSEGRAY) of BBTTABLE with T)
(replace (PILOTBBT PBTGRAYOFFSET) of BBTTABLE with 0)
(replace (PILOTBBT PBTGRAYWIDTHLESSONE) of BBTTABLE with 0)
(replace (PILOTBBT PBTGRAYHEIGHTLESSONE) of BBTTABLE with 0)
(for val from 0 to Kount
do (* replace (PILOTBBT PBTSOURCE) of BBTTABLE with
(ELT ThreshArray (ELT ValueArray val)))
(replace (PILOTBBT PBTSOURCE) of BBTTABLE with FOO)
(\DOPILOTBITBLT BBTTABLE])
(BLKMAG
[LAMBDA NIL (* edited: "22-Jun-84 16:59")
(* complexArray magnitudeArray kount)
(* hdj "21-Jun-84 18:53")
(* \CHECKARRAYINDEX magnitudeArray
(SUB1 kount))
(for magnitude from 0 to (SUB1 128) bind complexcount real imag
do (SETQ complexcount (LLSH magnitude 2))
(SETQ real (\GETBASEFLOATP FFTBUF1 complexcount))
(SETQ imag (\GETBASEFLOATP FFTBUF1 (IPLUS complexcount 2)))
(\PUTBASEFLOATP MAGNITUDESQUARED (LLSH magnitude 1)
(FPLUS (FTIMES real real)
(FTIMES imag imag])
(BLKSMALLP2FLOAT
[LAMBDA NIL (* edited: "22-Jun-84 16:55")
(* source destination kkount)
(* edited: "22-Jun-84 04:21")
(* * convert an array of SMALLPs to FLOATPs)
(* \CHECKARRAYINDEX destination
(SUB1 kount))
(for NN from 0 to (SUB1 256) do (\PUTBASEFLOATP SUBWAVESHUFFLEDFLOATP (LLSH NN 1)
(FLOAT (\GETBASE SUBWAVESHUFFLEDSMALLP NN])
(BLKFLOATP2COMP
[LAMBDA NIL (* edited: "22-Jun-84 16:57")
(* source destination kount)
(* hdj "21-Jun-84 19:03")
(* * moves the contents of a Real array into a Complex array; sets imaginary part to 0)
(* \CHECKARRAYINDEX destination
(SUB1 kount))
(for sourceElt from 0 to (SUB1 256) do (SETCOMPLEX (\ADDBASE FFTBUF1 (LLSH sourceElt 2))
(\GETBASEFLOATP SUBWAVEWEIGHTEDFLOATP
(LLSH sourceElt 1))
0.0])
(BLKFTIMES
[LAMBDA NIL (* edited: "22-Jun-84 16:56")
(* SOURCE1 SOURCE2 DEST KOUNT)
(* \CHECKARRAYINDEX DEST (SUB1 KOUNT))
(for INDEX from 0 to (LLSH (SUB1 256)
1)
by 2 do (\PUTBASEFLOATP SUBWAVEWEIGHTEDFLOATP INDEX (FTIMES (\GETBASEFLOATP
SUBWAVESHUFFLEDFLOATP
INDEX)
(\GETBASEFLOATP
WINDOWWEIGHTSSHUFFLED
INDEX])
(BLKPERM
[LAMBDA NIL (* edited: "22-Jun-84 16:54")
(* orig permutations destination kount)
(* hdj "21-Jun-84 19:26")
(* * destination (x) ← orig (perm (x)))
(* * args are arrays of smallps (words))
(* * must fold initial into offset for compatibility with microcode)
(* \CHECKARRAYINDEX destination
(SUB1 kount))
(for X from 0 to (SUB1 256) do (\PUTBASE SUBWAVESHUFFLEDSMALLP X (\GETBASE (\ADDBASE WAVE WSTART)
(\GETBASE SHUFFLE X])
(INITTHEM
[LAMBDA NIL (* edited: "22-Jun-84 18:11")
[SETQ SHUFFLE (PERMINIT (OR PASSES (SETQ PASSES 8]
(SETQ SUBWAVESHUFFLEDSMALLP (ARRAY 256 (QUOTE WORD)
0 0))
(SETQ SUBWAVESHUFFLEDFLOATP (ARRAY 256 (QUOTE FLOATP)
0.0 0))
(SETQ WINDOWWEIGHTSSHUFFLED (ARRAY 256 (QUOTE FLOATP)
1.0 0))
(SETQ SUBWAVEWEIGHTEDFLOATP (ARRAY 256 (QUOTE FLOATP)
0.0 0))
(SETQ SUBWAVEWEIGHTEDCOMPLEX (ARRAY 512 (QUOTE FLOATP)
0.0 0))
(SETQ FFTBUF1 (ARRAY 512 (QUOTE FIXP)
0 0 256))
(SETQ FFTBUF2 (ARRAY 512 (QUOTE FIXP)
0 0 256))
(SETQ MAGNITUDESQUARED (ARRAY 128 (QUOTE FLOATP)
0.0 0))
(SETQ LOGMAGNITUDE (ARRAY 128 (QUOTE FIXP)
0 0])
(\DOPILOTBITBLT
[LAMBDA (X) (* hdj "18-Jun-84 18:56")
((OPCODES PILOTBITBLT)
X])
(\FLOATBLT1.UFN
[LAMBDA (SOURCE DEST KOUNT OP) (* hdj "18-Jun-84 16:15")
(* * 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))
(SHOULDNT "illegal op to \FLOATBLT1.UFN"])
(\FLOATBLT2.UFN
[LAMBDA (SOURCE1 SOURCE2 DEST KOUNT OP) (* hdj "21-Jun-84 19:55")
(SELECTC OP
(0 (BLKFTIMES SOURCE1 SOURCE2 DEST KOUNT))
(1 (BLKPERM SOURCE1 SOURCE2 DEST KOUNT))
(SHOULDNT "illegal OP to \FLOATBLT2.UFN"])
)
(* support fns)
(RPAQQ BLOCKSUPPORTFNS (CORRECT NEWTHRESH PCORRECT \CHECKARRAYINDEX FFTTABLEINIT FIN FIN2 INITFFT
PERMINIT READWAVE SPEECHDEMO FFTSTEP SPEECHDEMOINIT TRYIT))
(DEFINEQ
(CORRECT
[LAMBDA (X) (* scp "21-Jun-84 22:39")
(COND
((ILESSP X 128)
(IPLUS X 128))
(T (IDIFFERENCE 256 X])
(NEWTHRESH
[LAMBDA (args...) (* scp " 8-Jun-84 00:01")
(* * comment)
(SETQ THRESH (ARRAY 6 (QUOTE FIXP)))
(for X from 1 to 6 do (SETA THRESH X (CAR (NTH THRESHLIST X])
(PCORRECT
[LAMBDA (X) (* scp " 7-Jun-84 17:01")
(COND
((ZEROP X)
X)
(T (CORRECT X])
(\CHECKARRAYINDEX
[LAMBDA (ARRAY INDEX) (* hdj " 6-Jun-84 15:34")
(COND
((IGREATERP INDEX (SUB1 (ARRAYSIZE ARRAY)))
(ERROR "Count too large for array size" ARRAY])
(FFTTABLEINIT
[LAMBDA (FFTBUF1 FFTBUF2 PASSES) (* edited: "22-Jun-84 02:54")
(PROG ((\FFTTABLES (ARRAY PASSES (QUOTE POINTER)))
M N N2 LEXP LE1 NV2 UR UI WR WI ASOURCE ADEST)
(SETQ N (EXPT 2 PASSES))
(SETQ N2 (TIMES N 2))
(SETQ NV2 (IQUOTIENT N 2))
(SETQ M PASSES) (* Compute M = log (N))
[for PASS from 1 to M
do (* Loop thru stages)
(SETQ LEXP (EXPT 2 PASS))
(SETQ LE1 (IQUOTIENT LEXP 2))
(SETQ UR 1.0)
(SETQ UI 0.0)
(SETQ WR (COS (FQUOTIENT PI LE1)
T))
(SETQ WI (SIN (FQUOTIENT PI LE1)
T))
(COND
((ODDP PASS)
(SETQ ASOURCE FFTBUF1)
(SETQ ADEST FFTBUF2))
(T (SETQ ASOURCE FFTBUF2)
(SETQ ADEST FFTBUF1)))
(SETA \FFTTABLES PASS (create FFTTABLE
TWIDDLE ←(FMINUS WR)
ITWIDDLE ← WI
SOURCE ← ASOURCE
ABDEST ← ADEST
CDDEST ←(\ADDBASE ADEST N2)
(* midpoint of dest array)
TCNT ←(ITIMES 4 (IQUOTIENT NV2 LE1))
HCNT ←(ITIMES 4 (SUB1 LE1)
(IQUOTIENT NV2 LE1))
LCNT ←(ITIMES 4 (SUB1 (IQUOTIENT NV2 LE1)))
DELTA ← WR
IDELTA ←(FMINUS WI]
(RETURN \FFTTABLES])
(FIN
[LAMBDA (A) (* hdj " 6-Jun-84 23:52")
(FIX2FLOAT A PA)
(INSPECT PA])
(FIN2
[LAMBDA NIL (* scp " 7-Jun-84 01:05")
(FIN FFTBUF1)
(FIN FFTBUF2])
(INITFFT
[LAMBDA (FFTBUF1 FFTBUF2) (* scp " 6-Jun-84 10:23")
(PROG (M N N2 LEXP LE1 NV2 UR UI WR WI ASOURCE ADEST)
(SETQ N2 512)
(SETQ \FFTARRAY2 (ARRAY N2 (QUOTE FIXP)))
(SETQ N (IQUOTIENT N2 2))
(SETQ NV2 (IQUOTIENT N 2))
(SETQ M 8) (* Compute M = log (N))
(SETQ \FFTTABLES (ARRAY M (QUOTE POINTER)))
[for PASS from 1 to M
do (* Loop thru stages)
(SETQ LEXP (EXPT 2 PASS))
(SETQ LE1 (IQUOTIENT LEXP 2))
(SETQ UR 1.0)
(SETQ UI 0.0)
(SETQ WR (COS (FQUOTIENT PI LE1)
T))
(SETQ WI (SIN (FQUOTIENT PI LE1)
T))
(COND
((EVENP PASS)
(SETQ ASOURCE FFTBUF1)
(SETQ ADEST FFTBUF2))
(T (SETQ ASOURCE FFTBUF2)
(SETQ ADEST FFTBUF1)))
(SETA \FFTTABLES PASS (create FFTTABLE
TWIDDLE ←(FMINUS WR)
ITWIDDLE ← WI
SOURCE ←(ARRAYBASE ASOURCE)
ABDEST ←(ARRAYBASE ADEST)
CDDEST ←(\ADDBASE (ARRAYBASE ADEST)
N2)
(* midpoint of dest array)
TCNT ←(ITIMES 4 (IQUOTIENT NV2 LE1))
HCNT ←(ITIMES 4 (SUB1 LE1)
(IQUOTIENT NV2 LE1))
LCNT ←(ITIMES 4 (SUB1 (IQUOTIENT NV2 LE1)))
DELTA ← WR
IDELTA ←(FMINUS WI]
(RETURN \FFTTABLES])
(PERMINIT
[LAMBDA (PASSES) (* hdj "21-Jun-84 19:16")
(PROG (I J K N NV2 PERM)
(SETQ N (EXPT 2 PASSES))
(SETQ NV2 (IQUOTIENT N 2))
(SETQ PERM (ARRAY 256 (QUOTE WORD)
0 0))
(for I from 0 to (SUB1 256) do (SETA PERM I I))
(SETQ J 1) (* Interchange elements)
(SETQ I 1) (* in bit-reversed order)
(repeatwhile (ILESSP I N)
do (COND
((ILESSP I J)
(SETQ TEMP (ELT PERM (SUB1 I)))
(SETA PERM (SUB1 I)
(ELT PERM (SUB1 J)))
(SETA PERM (SUB1 J)
TEMP)))
(SETQ K NV2)
(while (ILESSP K J)
do (SETQ J (IDIFFERENCE J K))
(SETQ K (IQUOTIENT K 2)))
(SETQ J (IPLUS J K))
(SETQ I (ADD1 I)))
(RETURN PERM])
(READWAVE
[LAMBDA (ARRAY INDEX N FILE FIRSTBYTE) (* scp "21-Jun-84 22:39")
(* * read successive bytes into array from stream)
(PROG [(STREAM (OPENSTREAM FILE (QUOTE INPUT]
(SETFILEPTR STREAM FIRSTBYTE)
[for BYTE from INDEX to (IPLUS INDEX N -1) do (SETA ARRAY BYTE (CORRECT (\BIN STREAM]
(CLOSEF STREAM])
(SPEECHDEMO
[LAMBDA NIL (* edited: "22-Jun-84 17:28")
(* SHUFFLE WAVE SUBWAVESHUFFLEDSMALLP
SUBWAVESHUFFLEDFLOATP WINDOWWEIGHTSSHUFFLED
SUBWAVEWEIGHTEDFLOATP SUBWAVEWEIGHTEDCOMPLEX FFTBUF1
FFTBUF2 MAGNITUDESQUARED LOGMAGNITUDE FFTTABLE PASSES
WAVEFORMEND)
(PROG ((FFTTABLE (FFTTABLEINIT FFTBUF1 FFTBUF2 PASSES))
(\FFTTABLE (create FFTTABLE))
(WAVEFORMEND NIL))
(SETQ WAVEFORMSTART 1)
(OR WAVEFORMEND (SETQ WAVEFORMEND (PLUS WAVEFORMSTART 300)))
(SETQ GBITMAP (CREATEW NIL "Spectrogram..."))
(for WSTART from (ITIMES WAVEFORMSTART SAMPLESPERFFT) to (ITIMES WAVEFORMEND SAMPLESPERFFT)
by SAMPLESPERFFT as GSTART from 0 by GWIDTH
do (BLKPERM)
(BLKSMALLP2FLOAT)
(BLKFTIMES)
(* for I from 0 to (SUB1 (EXPT 2 PASSES)) do (PRINT (SETA SUBWAVEWEIGHTEDFLOATP (ELT SHUFFLE I)
(PLUS 0.0 (TIMES 100.0 (PLUS (SIN (TIMES PI (QUOTIENT (FLOAT I) (FLOAT (EXPT 2 (SUB1 PASSES))))) T)
(SIN (TIMES PI (QUOTIENT (FLOAT I) (FLOAT 32))) T) (SIN (TIMES PI (QUOTIENT (FLOAT I) (FLOAT 8))) T)))))))
(BLKFLOATP2COMP)
(* for I from 1 to (ITIMES 2 8) do (SETA FFTBUF1 (SUB1 I) (XFIXFLT (FLOAT (CAR (NTH FFTDATA I))))))
(for PASS from 1 to PASSES do (FFTSTEP))
(BLKMAG)
(BLKEXPONENT)
(BLKGRAPH])
(FFTSTEP
[LAMBDA (* FFTTABLE)
(* edited: "22-Jun-84 17:08")
(\BLT \FFTTABLE FFTTABLE \FFTTABLESIZE)
(\FFTSTEP \FFTTABLE (fetch (FFTTABLE LCNT) of (ELT FFTTABLE PASS)))
(\PUTBASEPTR (LOCF (fetch (FFTTABLE SOURCE) of (ELT FFTTABLE PASS)))
0 NIL)
(\PUTBASEPTR (LOCF (fetch (FFTTABLE ABDEST) of (ELT FFTTABLE PASS)))
0 NIL)
(\PUTBASEPTR (LOCF (fetch (FFTTABLE CDDEST) of (ELT FFTTABLE PASS)))
0 NIL])
(SPEECHDEMOINIT
[LAMBDA (WAVEFILE PASSES FIRSTBYTE) (* edited: "22-Jun-84 17:35")
(OR WAVE (PROGN (SETQ WAVE (ARRAY 50000 (QUOTE WORD)
0 0))
(READWAVE WAVE 0 35000 WAVEFILE FIRSTBYTE)))
(* SETQ \FFTTABLE (create FFTTABLE))
(* SETQ FFTTABLE (FFTTABLEINIT FFTBUF1 FFTBUF2 PASSES))
(SETQ THRESH (ARRAY 6 (QUOTE FIXP)))
[for X from 1 to 6 do (SETA THRESH X (CAR (NTH THRESHLIST X]
(* READWAVE WAVE 0 35000 WAVEFILE FIRSTBYTE)
(* (READWAVE WAVE 1 (IMIN 50000
(GETFILEINFO WAVEFILE (QUOTE LENGTH))) WAVEFILE))
(* for I from 0 to 511 do (SETA WAVE I (IPLUS 128 (FIX (TIMES 127.0 (SIN (TIMES PI (QUOTIENT
(FLOAT I) (FLOAT 128))) T))))))
(* SPEECHDEMO (ARRAYBASE SHUFFLE) (ARRAYBASE WAVE) (ARRAYBASE SUBWAVESHUFFLEDSMALLP) (ARRAYBASE
SUBWAVESHUFFLEDFLOATP) (ARRAYBASE WINDOWWEIGHTSSHUFFLED) (ARRAYBASE SUBWAVEWEIGHTEDFLOATP)
(ARRAYBASE SUBWAVEWEIGHTEDCOMPLEX) (ARRAYBASE FFTBUF1) (ARRAYBASE FFTBUF2) (ARRAYBASE MAGNITUDESQUARED)
LOGMAGNITUDE NIL PASSES)
(SPEECHDEMO])
(TRYIT
[LAMBDA (PASSES FIRSTBYTE) (* edited: "22-Jun-84 17:35")
(INITTHEM)
(SPEECHDEMOINIT (QUOTE {ERIS}<SPEECH>WAVE>AUSTIN1.WAVE)
(OR PASSES (SETQ PASSES 8))
(OR FIRSTBYTE 15050])
)
(* * these are dangerous and probably wrong)
(RPAQQ BLOCKACCESSORS (SETAFIXP ELTFIXP SETAFLOATP ELTFLOATP))
(DEFINEQ
(SETAFIXP
[LAMBDA (FIXPARRAYBASE INDEX VALUE) (* hdj "18-Jun-84 16:12")
(* * put a fixp into array at index INDEX)
(\PUTBASEPTR FIXPARRAYBASE (LLSH INDEX 1)
VALUE])
(ELTFIXP
[LAMBDA (FIXPARRAYBASE INDEX) (* hdj "18-Jun-84 16:06")
(* * pulls a fixp out of FIXPARRAYBASE)
(\GETBASEPTR FIXPARRAYBASE (LLSH INDEX 1])
(SETAFLOATP
[LAMBDA (FLOATPARRAYBASE INDEX VALUE) (* hdj "15-Jun-84 17:59")
(\PUTBASEPTR FLOATPARRAYBASE INDEX VALUE])
(ELTFLOATP
[LAMBDA (FLOATPARRAYBASE INDEX) (* hdj "15-Jun-84 17:59")
(* * pulls an unboxed floatp out of given array)
(\GETBASEPTR FLOATPARRAYBASE INDEX])
)
(RPAQQ GRAPHOFFSET 140)
(RPAQQ GRAPHTESTFLG NIL)
(RPAQQ GWIDTH 6)
(RPAQQ INNERFNS (\FFTSTEP READWAVE CORRECT PCORRECT PTROK PTRINRANGE PTRGEQ PTRGTP ARRAYBASE
SETCOMPLEX))
(RPAQQ SAMPLESPERFFT 100)
(RPAQQ SCALE 10)
(RPAQ SpeechThresholds (READARRAY 256 (QUOTE FIXP) 0))
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 NIL
)
(RPAQQ THRESHLIST (140 142 144 146 148 150))
(RPAQQ WAVE NIL)
[DECLARE: EVAL@COMPILE
(DATATYPE ARRAYP ((ORIG BITS 1)
(NIL BITS 1)
(READONLY FLAG) (* probably no READONLY arrays now)
(NIL BITS 1)
(TYP BITS 4)
(BASE POINTER)
(LENGTH WORD)
(OFFST WORD)) (* note that while ARRAYP is a DATATYPE, the allocation
of it actually happens at MAKEINIT time under
INITDATATYPE{NAMES})
)
(DATATYPE FFTTABLE ((TWIDDLE FLOATP)
(ITWIDDLE FLOATP (* imaginary part of TWIDDLE))
(SOURCE XPOINTER (* virtual address of source array base))
(ABDEST XPOINTER (* virtual address of destination array base)
)
(CDDEST XPOINTER (* midpoint in destination array))
(TCNT WORD (* count of butterfiles with same twiddle x4)
)
(HCNT WORD (* (mod cnt tcnt) high portion of count of butterflies
remaining x4))
(NIL 2 FLOATP (* must have floating complex zero here))
(DELTA FLOATP (* packed complex root of unity to change twiddle)
)
(IDELTA FLOATP (* imaginary part of DELTA))
(LCNT WORD (* (remainder cnt tcnt) low portion of count of
butterflies remaining x4))
(PAD 11 WORD (* padding so that FFTTABLE will never cross page
boundary.))))
(BLOCKRECORD FLOATP ((SIGNBIT BITS 1)
(EXPONENT BITS 8)
(HIFRACTION BITS 7)
(LOFRACTION BITS 16))
(BLOCKRECORD FLOATP ((HIWORD WORD)
(LOWORD WORD)))
(BLOCKRECORD FLOATP ((NIL BITS 9)
(LONGFRACTION BITS 23)))
(BLOCKRECORD FLOATP ((FLOATCONTENTS BITS 32)))
(BLOCKRECORD FLOATP ((NIL BITS 1)
(HIWORDNOSIGNBIT BITS 15)))
(CREATE (CREATECELL \FLOATP)))
(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 ARRAYP)
(QUOTE ((BITS 1)
(BITS 1)
FLAG
(BITS 1)
(BITS 4)
POINTER WORD WORD)))
(/DECLAREDATATYPE (QUOTE FFTTABLE)
(QUOTE (FLOATP FLOATP XPOINTER XPOINTER XPOINTER WORD WORD FLOATP FLOATP FLOATP
FLOATP WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE PILOTBBT)
(QUOTE (WORD WORD WORD SIGNEDWORD WORD WORD WORD SIGNEDWORD WORD WORD WORD WORD
WORD WORD WORD WORD)))
(DECLARE: EVAL@COMPILE
(PUTPROPS ARRAYBASE DMACRO (OPENLAMBDA (AR)
(fetch (ARRAYP BASE)
of AR)))
(PUTPROPS FASTSETA DMACRO (OPENLAMBDA (A J V)
(\PUTBASEPTR (ARRAYBASE A)
(LLSH (SUB1 J)
1)
V)))
(PUTPROPS FASTELT DMACRO (OPENLAMBDA (A J)
(\GETBASEPTR (ARRAYBASE A)
(LLSH (SUB1 J)
1))))
(PUTPROPS \DOPILOTBITBLT DMACRO [LAMBDA (X)
((OPCODES PILOTBITBLT)
X])
)
(PUTPROPS BLOCKFLOAT COPYRIGHT ("I" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (891 10332 (ARRAYBASE 901 . 1030) (BLKEXPONENT 1032 . 1761) (BLKGRAPH 1763 . 2842) (
BLKGRAPH2 2844 . 5083) (BLKMAG 5085 . 5880) (BLKSMALLP2FLOAT 5882 . 6532) (BLKFLOATP2COMP 6534 . 7279)
(BLKFTIMES 7281 . 7890) (BLKPERM 7892 . 8679) (INITTHEM 8681 . 9465) (\DOPILOTBITBLT 9467 . 9613) (
\FLOATBLT1.UFN 9615 . 10049) (\FLOATBLT2.UFN 10051 . 10330)) (10525 19681 (CORRECT 10535 . 10716) (
NEWTHRESH 10718 . 10977) (PCORRECT 10979 . 11140) (\CHECKARRAYINDEX 11142 . 11363) (FFTTABLEINIT 11365
. 12777) (FIN 12779 . 12917) (FIN2 12919 . 13064) (INITFFT 13066 . 14563) (PERMINIT 14565 . 15472) (
READWAVE 15474 . 15879) (SPEECHDEMO 15881 . 17454) (FFTSTEP 17456 . 18039) (SPEECHDEMOINIT 18041 .
19431) (TRYIT 19433 . 19679)) (19801 20612 (SETAFIXP 19811 . 20032) (ELTFIXP 20034 . 20241) (
SETAFLOATP 20243 . 20396) (ELTFLOATP 20398 . 20610)))))
STOP