(FILECREATED " 7-Aug-85 19:55:05" {ERIS}<LISPCORE>SOURCES>LLCODE.;48 56046Q
changes to: (VARS \OPCODES)
previous date: " 7-Aug-85 15:23:56" {ERIS}<LISPCORE>SOURCES>LLCODE.;47)
(* Copyright (c) 1981, 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LLCODECOMS)
(RPAQQ LLCODECOMS [(* reading in compiled code)
(FNS DCODERD DCODESKIP \RENAMEDFN \REALNAMEP)
[VARS (CODERDTBL (COPYREADTABLE (QUOTE ORIG]
(GLOBALVARS CODERDTBL FILERDTBL)
(P (SETSYNTAX 31Q [QUOTE (MACRO (LAMBDA (FILE RDTBL)
(EVAL (READ FILE RDTBL]
CODERDTBL))
[DECLARE: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD (FILES (LOADCOMP)
MODARITH RENAMEMACROS)
(P (SELECTQ (COMPILEMODE)
((D ALTO)
NIL)
(FILESLOAD (LOADCOMP)
DCODEFOR10]
(VARS CODEINDICATOR)
(GLOBALVARS CODEINDICATOR)
(PROP CODEREADER * (LIST CODEINDICATOR (QUOTE D2)
(QUOTE D1)))
(FNS EQDEFP)
[COMS (* utilities)
(FNS \FINDOP)
(VARS \OPCODES)
(ADDVARS (\OPCODEARRAY))
(GLOBALVARS \OPCODEARRAY \OPCODES)
(DECLARE: EVAL@COMPILE DONTCOPY (EXPORT (MACROS DPUTCODE MCODEP)
(MACROS CODELT CODELT2 CODESETA2 CODESETA)
(ADDVARS (SYSSPECVARS CA))
(RECORDS CODEARRAY)
(RECORDS OPCODE)
(GLOBALVARS \OPCODES)
(CONSTANTS PVARCODE FVARCODE IVARCODE
VARCODEMASK]
[COMS (* "ufns")
(FNS INITUFNTABLE \SETUFNENTRY \GETUFNENTRY)
(FNS \UNKNOWN.UFN)
(DECLARE: DONTCOPY (RECORDS UFNENTRY)
(ADDVARS (INEWCOMS (FNS INITUFNTABLE \SETUFNENTRY)))
EVAL@COMPILE
(ADDVARS (DONTCOMPILEFNS INITUFNTABLE]
(COMS (* for MAKEINIT and READSYS)
(DECLARE: DONTCOPY (ADDVARS (INEWCOMS
(FNS DCODERD)
[VARS \OPCODES (CODERDTBL (COPYREADTABLE (QUOTE ORIG]
(P (SETSYNTAX (CHARCODE ↑Y)
[QUOTE (MACRO (LAMBDA (FILE RDTBL)
(EVALFORMAKEINIT
(READ FILE RDTBL]
CODERDTBL)))
(MKI.SUBFNS (\CODEARRAY . SCRATCHARRAY)
(DPUTCODE . I.PUTDEFN)
(CODERDTBL . I.CODERDTBL))
(EXPANDMACROFNS CODELT CODELT2 CODESETA CODESETA2 DPUTCODE
MCODEP)
(RD.SUBFNS (CODELT . VGETBASEBYTE)
(CODESETA . VPUTBASEBYTE])
(* reading in compiled code)
(DEFINEQ
(DCODERD
[LAMBDA (FN) (* JonL "31-Dec-83 22:25")
(READC)
(PROG ((COFD (GETOFD)))
(PROG ((NAMETABLE (PROG1 (READ NIL CODERDTBL)
(READC)))
(CODELEN (IPLUS (LLSH (\BIN COFD)
8)
(\BIN COFD)))
(NLOCALS (\BIN COFD))
(NFREEVARS (\BIN COFD))
(ARGTYPE (\BIN COFD))
(NARGS (\BIN COFD))
(NTSIZE 0)
(FRAMENAME FN)
REALSIZE STARTPC NTWORDS CA FVAROFFSET LOCALARGS STARTLOCALS LOCALSIZE)
[COND
((EQ (CAR NAMETABLE)
(QUOTE NAME))
(SETQ FRAMENAME (CADR NAMETABLE))
(SETQ NAMETABLE (CDDR NAMETABLE]
[COND
((EQ (CAR NAMETABLE)
(QUOTE L))
(SETQ LOCALARGS (CADR NAMETABLE))
(SETQ NAMETABLE (CDDR NAMETABLE]
[COND
(NAMETABLE (* NAMETABLE now is a sequence of flat triples, one per
name to be stored in nametable)
(on NAMETABLE by CDDDR do (add NTSIZE 1))
(SETQ NTSIZE (CEIL (ADD1 NTSIZE)
WORDSPERQUAD]
[SETQ NTWORDS (COND
(NAMETABLE (IPLUS NTSIZE NTSIZE))
(T (CONSTANT WORDSPERQUAD]
(* NameTable must end in quadword which ends in 0 -
thus, round down and add a quad -
NTWORDS is the number of words allocated for nametable)
(SETQ STARTPC (UNFOLD (IPLUS (fetch (CODEARRAY OVERHEADWORDS) of T)
NTWORDS)
BYTESPERWORD)) (* initial pc for the function: after fixed header and
double nametable)
[COND
(LOCALARGS (SETQ STARTLOCALS STARTPC) (* Insert an extra nametable between the real one and
the start pc where we store localvar args)
(SETQ LOCALSIZE (CEIL (ADD1 (FOLDLO (FLENGTH LOCALARGS)
2))
(IQUOTIENT WORDSPERQUAD 2)))
(* Number of words in half this nametable: must end in
zero, when doubled is quad-aligned)
(SETQ LOCALSIZE (UNFOLD LOCALSIZE BYTESPERWORD))
(* size in bytes now)
(add STARTPC (UNFOLD LOCALSIZE 2]
(SETQ REALSIZE (CEIL (IPLUS STARTPC CODELEN)
BYTESPERQUAD))
(SETQ CA (\CODEARRAY REALSIZE (CEIL (ADD1 (FOLDHI STARTPC BYTESPERCELL))
CELLSPERQUAD)))
(AIN CA STARTPC CODELEN COFD) (* Now build the name table, which has two parallel
parts: the names, and where to find them on the stack)
(for X on NAMETABLE by (CDDDR X) as NT1 from (ADD1 (UNFOLD (fetch (CODEARRAY
OVERHEADWORDS)
of T)
BYTESPERWORD))
by (CONSTANT BYTESPERWORD) bind (NTBYTESIZE ←(UNFOLD NTSIZE BYTESPERWORD))
do (\FIXCODENUM CA NT1 (\ATOMVALINDEX (CADDR X))
-1) (* Insert the name into first half of table)
(\FIXCODENUM CA (IPLUS NT1 NTBYTESIZE)
(IPLUS (CADR X)
(SELECTQ (CAR X)
(P (CONSTANT PVARCODE))
(F (OR FVAROFFSET (SETQ FVAROFFSET
(FOLDLO NT1 BYTESPERWORD)))
(* Save word offset of first FVAR in nametable, so ucode
can easily access FVAR n)
(CONSTANT FVARCODE))
(I (CONSTANT IVARCODE))
(SHOULDNT)))
-1) (* Code type and index into second half)
)
[COND
(LOCALARGS (* Build invisible name table for locals)
(for X on LOCALARGS by (CDDR X) as NT from (ADD1 STARTLOCALS)
by BYTESPERWORD
do (\FIXCODENUM CA NT (\ATOMVALINDEX (CADR X))
-1) (* Name in first half)
(\FIXCODENUM CA (IPLUS NT LOCALSIZE)
(IPLUS (CAR X)
(CONSTANT IVARCODE))
-1) (* index in second half)
]
(PROGN (* Fill in function header)
(replace (CODEARRAY NA) of CA with (COND
((EQ ARGTYPE 2)
-1)
(T NARGS)))
(replace (CODEARRAY PV) of CA with (SUB1 (FOLDHI (IPLUS NLOCALS NFREEVARS)
CELLSPERQUAD)))
(replace (CODEARRAY STARTPC) of CA with STARTPC)
(replace (CODEARRAY ARGTYPE) of CA with ARGTYPE)
(replace (CODEARRAY FRAMENAME) of CA with FRAMENAME)
(replace (CODEARRAY NTSIZE) of CA with NTSIZE)
(replace (CODEARRAY NLOCALS) of CA with NLOCALS)
(replace (CODEARRAY FVAROFFSET) of CA with (OR FVAROFFSET 0))
(replace (CODEARRAY FIXED) of CA with T))
(for X on (READ NIL CODERDTBL) by (CDDR X) do (\FIXCODENUM CA (IPLUS (CAR X)
STARTPC)
(\ATOMDEFINDEX
(CADR X))
-1))
(for X on (READ NIL CODERDTBL) by (CDDR X) do (\FIXCODENUM CA (IPLUS (CAR X)
STARTPC)
(\ATOMPNAMEINDEX
(CADR X))
-1))
[for X on (READ NIL CODERDTBL) by (CDDR X) do (\FIXCODEPTR CA (IPLUS (CAR X)
STARTPC)
(EVQ (CADR X]
(DPUTCODE FN CA (IPLUS STARTPC CODELEN])
(DCODESKIP
[LAMBDA (FN FLG) (* lmm " 2-DEC-81 23:52")
(READC)
(RESETVARS ((FILERDTBL CODERDTBL))
(PROG ((P (AND FLG (GETFILEPTR)))
LC
(COFD (GETOFD)))
(SKREAD)
(READC)
(SETQ LC (IPLUS (LLSH (\BIN COFD)
8)
(\BIN COFD)))
(\BIN COFD)
(\BIN COFD)
(\BIN COFD)
(\BIN COFD)
(SETFILEPTR NIL (IPLUS (GETFILEPTR)
LC))
(SKREAD)
(SKREAD)
(SKREAD)
(READC)
(COND
(FLG (PRIN2 FN)
(SPACES 1)
(PRINT CODEINDICATOR)
(COPYBYTES NIL NIL P (GETFILEPTR])
(\RENAMEDFN
[LAMBDA (DEF FN) (* lmm "15-OCT-81 00:34")
(* USED BY PUTD WHEN DOING MOVDS FROM ONE FUNCTION TO
ANOTHER)
(PROG (NEWCA (SIZE (ARRAYSIZE DEF))
(FB (fetch (CODEARRAY STARTPC) of DEF)))
(SETQ NEWCA (\CODEARRAY SIZE (CEIL (ADD1 (FOLDHI FB BYTESPERCELL))
CELLSPERQUAD)))
(for I from 0 to (SUB1 SIZE) do (CODESETA NEWCA I (CODELT DEF I)))
(replace (CODEARRAY FRAMENAME) of NEWCA with FN)
(RETURN NEWCA])
(\REALNAMEP
[LAMBDA (X) (* lmm "15-OCT-81 00:16")
(AND (NEQ X (QUOTE ERRORSET))
(NEQ (NTHCHAR X 1)
(QUOTE \])
)
(RPAQ CODERDTBL (COPYREADTABLE (QUOTE ORIG)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS CODERDTBL FILERDTBL)
)
(SETSYNTAX 31Q [QUOTE (MACRO (LAMBDA (FILE RDTBL)
(EVAL (READ FILE RDTBL]
CODERDTBL)
(DECLARE: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD
(FILESLOAD (LOADCOMP)
MODARITH RENAMEMACROS)
(SELECTQ (COMPILEMODE)
((D ALTO)
NIL)
(FILESLOAD (LOADCOMP)
DCODEFOR10))
)
(RPAQQ CODEINDICATOR D1)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS CODEINDICATOR)
)
(PUTPROPS D1 CODEREADER (DCODERD . DCODESKIP))
(PUTPROPS D2 CODEREADER (DCODERD . DCODESKIP))
(PUTPROPS D1 CODEREADER (DCODERD . DCODESKIP))
(DEFINEQ
(EQDEFP
[LAMBDA (CA1 CA2) (* lmm "16-MAY-82 19:43")
(* determines whether two code arrays CA1 and CA2 are
equivalent (same except for framename))
(AND (EQ (ARRAYTYP CA1)
(QUOTE CODE))
(EQ (ARRAYTYP CA2)
(QUOTE CODE))
(for I from 0 to (SUB1 (IMIN (ARRAYSIZE CA1)
(ARRAYSIZE CA2)))
always (OR (EQ (CODELT CA1 I)
(CODELT CA2 I))
(AND (IGEQ I (fetch FRAMENAME# of CA1))
(ILESSP I (IPLUS (fetch FRAMENAME# of CA1)
BYTESPERCELL])
)
(* utilities)
(DEFINEQ
(\FINDOP
(LAMBDA (OPNAME FLG) (* lmm "22-Mar-85 10:20") (ALLOCAL (PROGN (OR \OPCODEARRAY (PROGN (SETQ
\OPCODEARRAY (ARRAY 256 (QUOTE POINTER) NIL 0)) (for X in \OPCODES do (PUTPROP (fetch OPCODENAME of X)
(QUOTE DOPCODE) X) (if (LISTP (fetch OP# of X)) then (for I from (CAR (fetch OP# of X)) to (CADR (
fetch OP# of X)) by 1 do (SETA \OPCODEARRAY I X)) else (SETA \OPCODEARRAY (fetch OP# of X) X))))) (OR
(COND ((LITATOM OPNAME) (GETPROP OPNAME (QUOTE DOPCODE))) ((FIXP OPNAME) (ELT \OPCODEARRAY OPNAME))) (
AND FLG (ERROR OPNAME FLG)))))))
)
(RPAQQ \OPCODES ((0 -X- 0)
(1 CAR 0 T 0 \CAR.UFN)
(2 CDR 0 T 0 \CDR.UFN)
(3 LISTP 0 T 0 LISTP)
(4 NTYPX 0 T 0 NTYPX)
(5 TYPEP 1 TYPEP 0 \TYPEP.UFN)
(6 DTEST 2 ATOM 0 \DTEST.UFN)
(7 CDDR 0 T 0 CDDR T)
(10Q FN0 2 FN 1)
(11Q FN1 2 FN 0)
(12Q FN2 2 FN -1)
(13Q FN3 2 FN -2)
(14Q FN4 2 FN -3)
(15Q FNX 3 FNX FNX)
(16Q APPLYFN 0 T -1)
(17Q CHECKAPPLY* 0 T 0 \CHECKAPPLY* (4K 12K))
(20Q RETURN 0 T (JUMP 1)
\HARDRETURN)
(21Q BIND 2)
(22Q UNBIND 0)
(23Q DUNBIND 0)
(24Q RPLPTR.N 1 T -1 \RPLPTR.UFN (4K))
(25Q GCREF 1 T 0 \HTFIND)
(26Q ASSOC 0 T -1 ASSOC (4K DORADO))
(27Q GVAR← 2 ATOM 0 \SETGLOBALVAL.UFN)
(30Q RPLACA 0 T -1 \RPLACA.UFN 4K)
(31Q RPLACD 0 T -1 \RPLACD.UFN 4K)
(32Q CONS 0 T -1 \CONS.UFN)
(33Q GETP 0 T -1 GETPROP T)
(34Q FMEMB 0 T -1 FMEMB (4K DORADO))
(35Q GETHASH 0 T -1 GETHASH T)
(36Q PUTHASH 0 T -2 PUTHASH T)
(37Q CREATECELL 0 T 0 \CREATECELL 4K)
(40Q BIN 0 T 0 \BIN 4K)
(41Q BOUT 0 T -1 \BOUT T)
(42Q POPDISP 0 T 0 \POPDISP.UFN (4K DORADO))
(43Q LIST1 0 T 0 CONS T)
(44Q DOCOLLECT 0 T -1 DOCOLLECT T)
(45Q ENDCOLLECT 0 T -1 ENDCOLLECT T)
(46Q RPLCONS 0 T -1 \RPLCONS (4K DORADO))
(47Q LISTGET 0 T -1 LISTGET (4K DORADO))
(50Q ELT 0 T -1 ELT T)
(51Q NTHCHC 0 T -1 NTHCHARCODE T)
(52Q SETA 0 T -2 SETA T)
(53Q RPLCHARCODE 0 T -2 RPLCHARCODE T)
(54Q EVAL 0 T 0 \EVAL)
(55Q EVALV 0 T 0 \EVALV1 T)
(56Q TYPECHECK 0 T 0 \TYPECHECK.UFN)
(57Q STKSCAN 0 T 0 \STKSCAN)
(60Q BUSBLT 1 (WORDSOUT BYTESOUT BYTESOUTSWAPPED NYBBLESOUT WORDSIN BYTESIN
BYTESINSWAPPED NYBBLESINSWAPPED)
-3 \BUSBLT.UFN (4K DORADO))
(61Q MISC8 1 (IBLT1 IBLT2)
-7 \MISC8.UFN (4K DORADO))
(62Q UBFLOAT3 1 (POLY MATRIX.3X3 MATRIX.4X4 MATRIX.133 MATRIX.331 MATRIX.144
MATRIX.441)
(-2 1)
\UNBOXFLOAT3
(4K DORADO))
(63Q TYPEMASK.N 1 T 0 \TYPEMASK.UFN)
(64Q RDPROLOGPTR 0 T 0 RAID (4K DORADO))
(65Q RDPROLOGTAG 0 T 0 RAID (4K DORADO))
(66Q WRTPTR&TAG 0 T -2 RAID (4K DORADO))
(67Q WRTPTR&0TAG 0 T -1 RAID (4K DORADO))
(70Q MISC7 1 (PSEUDOCOLOR)
-6 \MISC7.UFN (4K DORADO))
(71Q DOVEMISC 1 (READIW WRITEIO WRITEMP RDTIMER BYTESWAP LOCKMEM NOTIFYIOP SETWP)
(0 -1 0 0 0 -3 0 0))
(72Q EQL 0 T -1 EQL)
(73Q DRAWLINE 0 T -10Q \DRAWLINE.UFN (4K DORADO))
(74Q STORE.N 1 T 0 \STORE.N.UFN)
(75Q COPY.N 1 T 1 \COPY.N.UFN)
(76Q RAID 0 T 0 RAID T)
(77Q \RETURN 0 T 0 \RETURN)
((100Q 106Q)
IVAR 0 IVAR 1)
(107Q IVARX 1 IVAR 1)
((110Q 116Q)
PVAR 0 PVAR 1)
(117Q PVARX 1 PVAR 1)
((120Q 126Q)
FVAR 0 FVAR 1)
(127Q FVARX 1 FVAR 1)
((130Q 136Q)
PVAR← 0 PVAR 0)
(137Q PVARX← 1 PVAR 0)
(140Q GVAR 2 ATOM 1)
(141Q ARG0 0 T 0 \ARG0 T)
(142Q IVARX← 1 IVAR 0)
(143Q FVARX← 1 FVAR 0)
(144Q COPY 0 T 1)
(145Q MYARGCOUNT 0 T 1 \MYARGCOUNT T)
(146Q MYALINK 0 T 1)
(147Q ACONST 2 ATOM 1)
(150Q 'NIL 0 T 1)
(151Q 'T 0 T 1)
(152Q '0 0 T 1)
(153Q '1 0 T 1)
(154Q SIC 1 SIC 1)
(155Q SNIC 1 SNIC 1)
(156Q SICX 2 SICX 1)
(157Q GCONST 3 GCONST 1)
(160Q ATOMNUMBER 2 ATOM 1)
(161Q READFLAGS 0 T 0 \READFLAGS)
(162Q READRP 0 T 0 \READRP)
(163Q WRITEMAP 0 T -2 \WRITEMAP DORADO)
(164Q READPRINTERPORT 0 T 1 \READPRINTERPORT.UFN 4K)
(165Q WRITEPRINTERPORT 0 T 0 \WRITEPRINTERPORT.UFN 4K)
(166Q PILOTBITBLT 0 T -1 \PILOTBITBLT)
(167Q RCLK 0 T 0 \RCLKSUBR)
(170Q MISC1 1 (error INPUT OUTPUT error error error error error error RWMUFMAN)
0 \MISC1.UFN)
(171Q MISC2 1 (?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?10)
-1 \MISC2.UFN)
(172Q RECLAIMCELL 0 T 0 \GCRECLAIMCELL DORADO)
(173Q GCSCAN1 0 T 0 \GCSCAN1)
(174Q GCSCAN2 0 T 0 \GCSCAN2)
(175Q SUBRCALL 2 SUBRCALL)
(176Q CONTEXTSWITCH 0 T 0 \CONTEXTSWITCH)
(177Q was.audio)
((200Q 217Q)
JUMP 0 JUMP JUMP NIL)
((220Q 237Q)
FJUMP 0 JUMP CJUMP NIL)
((240Q 257Q)
TJUMP 0 JUMP CJUMP NIL)
(260Q JUMPX 1 JUMPX JUMP)
(261Q JUMPXX 2 JUMPXX JUMP)
(262Q FJUMPX 1 JUMPX CJUMP)
(263Q TJUMPX 1 JUMPX CJUMP)
(264Q NFJUMPX 1 JUMPX NCJUMP)
(265Q NTJUMPX 1 JUMPX NCJUMP)
(266Q jeq)
(267Q jlistp)
((270Q 276Q)
PVAR←↑ 0 PVAR -1 NIL)
(277Q POP 0 T -1)
(300Q POP.N 1 T (POP.N 1)
\POP.N.UFN)
(301Q ATOMCELL.N 1 T 0 \ATOMCELL)
(302Q GETBASEBYTE 0 T -1 \GETBASEBYTE)
(303Q was.scanbase)
(304Q BLT 0 T -2 \BLT)
(305Q MISC10 1 T -11Q \MISC10.UFN (4K DORADO))
(306Q was.putbaseptr)
(307Q PUTBASEBYTE 0 T -2 \PUTBASEBYTE)
(310Q GETBASE.N 1 T 0)
(311Q GETBASEPTR.N 1 T 0)
(312Q GETBITS.N.FD 2 T 0)
(313Q GETBASEFIXP.N 1 T 0 \GETBASEFIXP T)
(314Q PUTBASEFIXP.N 1 T -1 \PUTBASEFIXP.UFN T)
(315Q PUTBASE.N 1 T -1 \PUTBASE.UFN)
(316Q PUTBASEPTR.N 1 T -1 \PUTBASEPTR.UFN)
(317Q PUTBITS.N.FD 2 T -1 \PUTBITS.UFN)
(320Q ADDBASE 0 T -1 \ADDBASE)
(321Q VAG2 0 T -1 \VAG2)
(322Q HILOC 0 T 0)
(323Q LOLOC 0 T 0)
(324Q PLUS2 0 T -1 \SLOWPLUS2 *)
(325Q DIFFERENCE 0 T -1 \SLOWDIFFERENCE *)
(326Q TIMES2 0 T -1 \SLOWTIMES2 *)
(327Q QUOTIENT 0 T -1 \SLOWQUOTIENT *)
(330Q IPLUS2 0 T -1 \SLOWIPLUS2)
(331Q IDIFFERENCE 0 T -1 \SLOWIDIFFERENCE)
(332Q ITIMES2 0 T -1 \SLOWITIMES2)
(333Q IQUOTIENT 0 T -1 \SLOWIQUOTIENT)
(334Q IREMAINDER 0 T -1 IREMAINDER)
(335Q IPLUS.N 1 T 0 \SLOWIPLUS2 (4K 12K))
(336Q IDIFFERENCE.N 1 T 0 \SLOWIDIFFERENCE (4K 12K))
(337Q was.iblt)
(340Q LLSH1 0 T 0 \SLOWLLSH1)
(341Q LLSH8 0 T 0 \SLOWLLSH8)
(342Q LRSH1 0 T 0 \SLOWLRSH1)
(343Q LRSH8 0 T 0 \SLOWLRSH8)
(344Q LOGOR2 0 T -1 \SLOWLOGOR2)
(345Q LOGAND2 0 T -1 \SLOWLOGAND2)
(346Q LOGXOR2 0 T -1 \SLOWLOGXOR2)
(347Q LSH 0 T -1 LSH T)
(350Q FPLUS2 0 T -1 \SLOWFPLUS2 4K)
(351Q FDIFFERENCE 0 T -1 \SLOWFDIFFERENCE 4K)
(352Q FTIMES2 0 T -1 \SLOWFTIMES2 4K)
(353Q FQUOTIENT 0 T -1 \SLOWFQUOTIENT 4K)
(354Q UBFLOAT2 1 (UFADD UFSUB UFISUB UFMULT UFDIV UFGREAT UFMAX UFMIN UFREM)
(-1 1)
\UNBOXFLOAT2
(4K DORADO))
(355Q UBFLOAT1 1 (BOX UNBOX UFABS UFNEGATE)
(0 1)
\UNBOXFLOAT1
(4K DORADO))
(356Q unused)
(357Q unused)
(360Q EQ 0 T -1)
(361Q IGREATERP 0 T -1 \SLOWIGREATERP)
(362Q FGREATERP 0 T -1 \SLOWFGREATERP)
(363Q GREATERP 0 T -1 GREATERP)
(364Q EQUAL 0 T -1 EQUAL)
(365Q MAKENUMBER 0 T -1 \MAKENUMBER 4K)
(366Q BOXIPLUS 0 T -1 \BOXIPLUS 4K)
(367Q BOXIDIFFERENCE 0 T -1 \BOXIDIFFERENCE 4K)
(370Q FLOATBLT 0 (FLOATWRAP FLOATUNWRAP FLOAT FIX FPLUS FDIFFERENCE FDIFFERENCE
FPLUSABS ABSDIFFERENCE ABSFPLUS FTIMES)
-3 \FLOATBLT (4K DORADO))
(371Q FFTSTEP 0 T -1 \FFTSTEP (4K DORADO))
(372Q MISC3 1 (EXPONENT MAGNITUDE FLOAT COMP)
-2 \MISC3.UFN (4K DORADO))
(373Q MISC4 1 (ARRAY.TIMES ARRAY.PERM ARRAY.PLUS ARRAY.DIFFERENCE ARRAY.MAGIC 3MATCH
BMBIT)
-3 \MISC4.UFN)
(374Q UPCTRACE 0 T 0 NILL (4K 12K))
(375Q SWAP 0 T 0)
(376Q NOP 0 T 0)
(377Q was.upctrace)))
(ADDTOVAR \OPCODEARRAY )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \OPCODEARRAY \OPCODES)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
[PUTPROPS DPUTCODE MACRO ((FN CA SIZE)
(SELECTQ (SYSTEMTYPE)
(D (DEFC FN CA))
(/PUTPROP FN (QUOTE DCODE)
CA]
[PUTPROPS MCODEP MACRO ((X)
(OR (ARRAYP X)
(AND (LITATOM X)
(ARRAYP (SELECTQ (SYSTEMTYPE)
(D (GETD X))
(GETPROP X (QUOTE DCODE]
)
(DECLARE: EVAL@COMPILE
(PUTPROPS CODELT MACRO ((CA N)
(\BYTELT CA N)))
[PUTPROPS CODELT2 MACRO (OPENLAMBDA (DEF LC)
(LOGOR (LLSH (CODELT DEF LC)
BITSPERBYTE)
(CODELT DEF (ADD1 LC]
[PUTPROPS CODESETA2 MACRO (OPENLAMBDA (DEF LC VALUE)
(CODESETA DEF LC (LRSH VALUE BITSPERBYTE))
(CODESETA DEF (ADD1 LC)
(IMOD VALUE (CONSTANT (LLSH 1 BITSPERBYTE]
(PUTPROPS CODESETA MACRO ((CA N NV)
(\BYTESETA CA N NV)))
)
(ADDTOVAR SYSSPECVARS CA)
[DECLARE: EVAL@COMPILE
(ACCESSFNS CODEARRAY ((STKMIN (CODELT2 DATUM 0)
(CODESETA2 DATUM 0 NEWVALUE))
(NA (SIGNED (CODELT2 DATUM 2)
BITSPERWORD)
(CODESETA2 DATUM 2 (UNSIGNED NEWVALUE BITSPERWORD)))
(PV (SIGNED (CODELT2 DATUM 4)
BITSPERWORD)
(CODESETA2 DATUM 4 (UNSIGNED NEWVALUE BITSPERWORD)))
(STARTPC (CODELT2 DATUM 6)
(CODESETA2 DATUM 6 NEWVALUE))
[ARGTYPE (LOGAND (LRSH (CODELT DATUM 10Q)
4)
3)
(CODESETA DATUM 10Q (LOGOR (LOGAND (CODELT DATUM 10Q)
177717Q)
(LLSH (LOGAND NEWVALUE 3)
4]
(FRAMENAME (\VAG2 (CODELT DATUM 11Q)
(CODELT2 DATUM 12Q))
(\FIXCODEPTR DATUM 13Q (EVQ NEWVALUE)))
(NTSIZE (CODELT2 DATUM 14Q)
(CODESETA2 DATUM 14Q NEWVALUE))
(NLOCALS (CODELT DATUM 16Q)
(CODESETA DATUM 16Q NEWVALUE))
(FVAROFFSET (CODELT DATUM 17Q)
(CODESETA DATUM 17Q NEWVALUE)))
[ACCESSFNS CODEARRAY
((LSTARP (ILESSP (fetch (CODEARRAY NA) of DATUM)
0))
(OVERHEADWORDS (PROGN 10Q))
(ALIGNED (IPLUS (fetch (CODEARRAY NTSIZE) of DATUM)
(fetch (CODEARRAY OVERHEADWORDS) of T)))
(FIXED NIL (replace (CODEARRAY STKMIN) of DATUM
with (IPLUS (UNFOLD (IPLUS (fetch (CODEARRAY NA) of DATUM)
(UNFOLD (ADD1 (fetch (CODEARRAY
PV)
of DATUM))
CELLSPERQUAD))
WORDSPERCELL)
14Q 40Q)))
(FRAMENAME# (PROGN 10Q])
]
[DECLARE: EVAL@COMPILE
(RECORD OPCODE (OP# OPCODENAME OPNARGS OPPRINT LEVADJ UFNFN UNIMPL))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \OPCODES)
)
(DECLARE: EVAL@COMPILE
(RPAQQ PVARCODE 100000Q)
(RPAQQ FVARCODE 140000Q)
(RPAQQ IVARCODE 0)
(RPAQQ VARCODEMASK 140000Q)
(CONSTANTS PVARCODE FVARCODE IVARCODE VARCODEMASK)
)
(* END EXPORTED DEFINITIONS)
)
(* "ufns")
(DEFINEQ
(INITUFNTABLE
(LAMBDA NIL (* edited: "25-Mar-85 08:57") (CREATEPAGES \UFNTable \UFNTableSize NIL T) (for I from 0 to
255 do (\SETUFNENTRY I (QUOTE \UNKNOWN.UFN) 0 0)) (for X in \OPCODES when (fetch (OPCODE UFNFN) of X)
do (\SETUFNENTRY (PROG ((OP (fetch (OPCODE OP#) of X))) (RETURN (if (LISTP OP) then (CAR OP) else OP)
)) (fetch (OPCODE UFNFN) of X) (if (LISTP (fetch (OPCODE LEVADJ) of X)) then (CADR (fetch (OPCODE
LEVADJ) of X)) else (IDIFFERENCE (IPLUS 1 (COND ((EQ (fetch (OPCODE OPNARGS) of X) 0) 0) (T 1))) (
fetch (OPCODE LEVADJ) of X))) (fetch (OPCODE OPNARGS) of X)))))
(\SETUFNENTRY
[LAMBDA (INDEX FN NARGS NEXTRA) (* lmm " 7-Jun-85 14:08")
(SETQ INDEX (\ADDBASE (\ADDBASE \UFNTable INDEX)
INDEX))
(change (fetch (UFNENTRY FNINDEX) of INDEX)
(\ATOMDEFINDEX FN))
(change (fetch (UFNENTRY NEXTRA) of INDEX)
NEXTRA)
(change (fetch (UFNENTRY NARGS) of INDEX)
NARGS])
(\GETUFNENTRY
[LAMBDA (OP) (* hdj "17-Jun-85 13:08")
(LET [(INDEX (\ADDBASE2 \UFNTable (if (LITATOM OP)
then (fetch (OPCODE OP#) of (\FINDOP OP))
else OP]
(\VAG2 0 (fetch (UFNENTRY FNINDEX) of INDEX])
)
(DEFINEQ
(\UNKNOWN.UFN
(LAMBDA NIL (* bvm: "23-Mar-84 15:52") (\MP.ERROR \MP.UNKNOWN.UFN
"Compiler/microcode error: unknown UFN")))
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(BLOCKRECORD UFNENTRY ((FNINDEX WORD)
(NEXTRA BYTE)
(NARGS BYTE)))
]
(ADDTOVAR INEWCOMS (FNS INITUFNTABLE \SETUFNENTRY))
EVAL@COMPILE
(ADDTOVAR DONTCOMPILEFNS INITUFNTABLE)
)
(* for MAKEINIT and READSYS)
(DECLARE: DONTCOPY
(ADDTOVAR INEWCOMS (FNS DCODERD)
[VARS \OPCODES (CODERDTBL (COPYREADTABLE (QUOTE ORIG]
(P (SETSYNTAX (CHARCODE ↑Y)
[QUOTE (MACRO (LAMBDA (FILE RDTBL)
(EVALFORMAKEINIT (READ FILE RDTBL]
CODERDTBL)))
(ADDTOVAR MKI.SUBFNS (\CODEARRAY . SCRATCHARRAY)
(DPUTCODE . I.PUTDEFN)
(CODERDTBL . I.CODERDTBL))
(ADDTOVAR EXPANDMACROFNS CODELT CODELT2 CODESETA CODESETA2 DPUTCODE MCODEP)
(ADDTOVAR RD.SUBFNS (CODELT . VGETBASEBYTE)
(CODESETA . VPUTBASEBYTE))
)
(PUTPROPS LLCODE COPYRIGHT ("Xerox Corporation" 3675Q 3676Q 3677Q 3700Q 3701Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4426Q 22126Q (DCODERD 4440Q . 17210Q) (DCODESKIP 17212Q . 20441Q) (\RENAMEDFN 20443Q .
21637Q) (\REALNAMEP 21641Q . 22124Q)) (23345Q 24600Q (EQDEFP 23357Q . 24576Q)) (24627Q 25707Q (\FINDOP
24641Q . 25705Q)) (51362Q 53762Q (INITUFNTABLE 51374Q . 52510Q) (\SETUFNENTRY 52512Q . 53260Q) (
\GETUFNENTRY 53262Q . 53760Q)) (53763Q 54176Q (\UNKNOWN.UFN 53775Q . 54174Q)))))
STOP