(FILECREATED " 2-Oct-86 23:22:59" {ERIS}<LISPCORE>SOURCES>LLCODE.;68 43645
changes to: (FNS DCODERD DCODESKIP)
previous date: "30-Sep-86 00:18:30" {ERIS}<LISPCORE>SOURCES>LLCODE.;67)
(* "
Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LLCODECOMS)
(RPAQQ LLCODECOMS
[[COMS (* ; "reading in compiled code")
(FNS DCODERD DCODESKIP \RENAMEDFN \ALLOC.CODE.BLOCK \REALNAMEP)
(DECLARE: DONTEVAL@LOAD DOCOPY [VARS (CODERDTBL (COPYREADTABLE (QUOTE ORIG]
(P (SETSYNTAX 25 [QUOTE (MACRO (LAMBDA (FILE RDTBL)
(EVAL (READ FILE RDTBL]
CODERDTBL)
(SETSYNTAX 124 (QUOTE (MACRO ALWAYS READVBAR))
CODERDTBL)
(READTABLEPROP CODERDTBL (QUOTE USESILPACKAGE)
NIL)))
(GLOBALVARS CODERDTBL FILERDTBL)
(VARS CODEINDICATOR)
(GLOBALVARS CODEINDICATOR)
(PROP CODEREADER * (LIST CODEINDICATOR (QUOTE D2)
(QUOTE D1]
[COMS (* ; "Compiled CLOSURE type")
(FNS MAKE-COMPILED-CLOSURE \CCLOSURE.DEFPRINT \GET-COMPILED-DEFINITION
\GET-COMPILED-CODE-BASE EQDEFP)
(DECLARE: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS COMPILED-CLOSURE)
(CONSTANTS \COMPILED-CLOSURE)
(MACROS \EXTENDED.EQP)))
(INITRECORDS COMPILED-CLOSURE)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (DEFPRINT (QUOTE COMPILED-CLOSURE)
(QUOTE \CCLOSURE.DEFPRINT]
[COMS (* ; "utilities")
(FNS \FINDOP)
(VARS \OPCODES)
(ADDVARS (\OPCODEARRAY))
(GLOBALVARS \OPCODEARRAY \OPCODES)
(DECLARE: EVAL@COMPILE DONTCOPY (EXPORT (MACROS DPUTCODE MCODEP)
(MACROS CODELT CODELT2 CODESETA2 CODESETA)
(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)
(SETSYNTAX (CHARCODE %|)
(QUOTE (MACRO ALWAYS READVBAR))
CODERDTBL)
(READTABLEPROP CODERDTBL (QUOTE USESILPACKAGE)
NIL)))
(MKI.SUBFNS (\CODEARRAY . SCRATCHARRAY)
(DPUTCODE . I.PUTDEFN)
(CODERDTBL . I.CODERDTBL))
(EXPANDMACROFNS CODELT CODELT2 CODESETA CODESETA2 DPUTCODE
MCODEP)
(RD.SUBFNS (CODELT . VGETBASEBYTE)
(CODESETA . VPUTBASEBYTE))
(RDCOMS (FNS \GET-COMPILED-CODE-BASE])
(* ; "reading in compiled code")
(DEFINEQ
(DCODERD
[LAMBDA (FN) (* bvm: " 2-Oct-86 22:01")
(READC)
(LET ((INSTREAM (GETSTREAM NIL (QUOTE INPUT)))
(*READTABLE* (if (EQ *READTABLE* FILERDTBL)
then (* ;
"old style file, read code with different read table!")
CODERDTBL
else (* ; "read code in same readtable")
*READTABLE*)))
(PROG ((NAMETABLE (PROG1 (READ)
(READC)))
(CODELEN (IPLUS (LLSH (\BIN INSTREAM)
8)
(\BIN INSTREAM)))
(NLOCALS (\BIN INSTREAM))
(NFREEVARS (\BIN INSTREAM))
(ARGTYPE (\BIN INSTREAM))
(NARGS (\BIN INSTREAM))
(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 INSTREAM) (* ;; "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))
(* ;; "Now read fixups: 3 lists in plist format of function fixups, symbol fixups and random pointer fixups.")
(for X on (READ) by (CDDR X) do (\FIXCODENUM CA (IPLUS (CAR X)
STARTPC)
(\ATOMDEFINDEX (CADR X))
-1))
(for X on (READ) by (CDDR X) do (\FIXCODENUM CA (IPLUS (CAR X)
STARTPC)
(\ATOMPNAMEINDEX (CADR X))
-1))
[for X on (READ) by (CDDR X) do (\FIXCODEPTR CA (IPLUS (CAR X)
STARTPC)
(EVQ (CADR X]
(DPUTCODE FN CA (IPLUS STARTPC CODELEN])
(DCODESKIP
[LAMBDA (FN FLG) (* bvm: " 2-Oct-86 21:39")
(* ;;; "If FLG is true then copy code from input to output, else just skip code on input. For copy case, source and destination read tables must be the same!")
(PROG ((INSTREAM (GETSTREAM NIL (QUOTE INPUT)))
(RDTBL (if (EQ *READTABLE* FILERDTBL)
then (* ;
"old style file, read code with different read table!")
CODERDTBL
else (* ; "read code in same readtable")
*READTABLE*))
CODELEN START)
(READC INSTREAM) (* ; "Skip EOL after code indicator")
[COND
(FLG (* ;
"In both cases, scan over the code. When FLG is true, we will copy when done")
(SETQ START (GETFILEPTR INSTREAM]
(SKREAD INSTREAM) (* ; "Skip localvar args")
(READC INSTREAM)
(SETQ CODELEN (IPLUS (LLSH (\BIN INSTREAM)
8)
(\BIN INSTREAM)))
(\BIN INSTREAM)
(\BIN INSTREAM)
(\BIN INSTREAM)
(\BIN INSTREAM)
(SETFILEPTR INSTREAM (IPLUS (GETFILEPTR INSTREAM)
CODELEN)) (* ; "Skip the code itself")
(SKREAD INSTREAM NIL RDTBL) (* ; "Skip 3 lists of fixups")
(SKREAD INSTREAM NIL RDTBL)
(SKREAD INSTREAM NIL RDTBL)
(READC INSTREAM RDTBL)
(COND
(FLG (* ;
"copy it all to destination. We assume reader environments are the same")
(PRIN4 FN)
(PRIN3 " ")
(PRIN4 CODEINDICATOR)
(TERPRI)
(COPYBYTES INSTREAM NIL START (GETFILEPTR])
(\RENAMEDFN
[LAMBDA (DEF FN) (* bvm: " 8-Jul-86 17:46")
(* USED BY PUTD WHEN DOING MOVDS FROM
ONE FUNCTION TO ANOTHER)
(LET* ([CODEBASE (fetch (COMPILED-CLOSURE FNHEADER) of (\DTEST DEF (QUOTE COMPILED-CLOSURE]
(WORDSIZE (UNFOLD (\#BLOCKDATACELLS CODEBASE)
WORDSPERCELL))
NEWCA)
(SETQ NEWCA (\ALLOC.CODE.BLOCK (UNFOLD WORDSIZE BYTESPERWORD)
(CEIL (ADD1 (FOLDHI (fetch (FNHEADER STARTPC) of CODEBASE)
BYTESPERCELL))
CELLSPERQUAD)))
(\BLT NEWCA CODEBASE WORDSIZE)
(UNINTERRUPTABLY
(\ADDREF FN)
(replace (FNHEADER #FRAMENAME) of NEWCA with FN))
(create COMPILED-CLOSURE using DEF FNHEADER ← NEWCA])
(\ALLOC.CODE.BLOCK
[LAMBDA (NBYTES INITONPAGE) (* bvm: " 8-Jul-86 17:09")
(\ALLOCBLOCK (FOLDHI NBYTES BYTESPERCELL)
CODEBLOCK.GCT INITONPAGE CELLSPERQUAD])
(\REALNAMEP
[LAMBDA (X) (* lmm "15-OCT-81 00:16")
(AND (NEQ X (QUOTE ERRORSET))
(NEQ (NTHCHAR X 1)
(QUOTE \])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQ CODERDTBL (COPYREADTABLE (QUOTE ORIG)))
(SETSYNTAX 25 [QUOTE (MACRO (LAMBDA (FILE RDTBL)
(EVAL (READ FILE RDTBL]
CODERDTBL)
(SETSYNTAX 124 (QUOTE (MACRO ALWAYS READVBAR))
CODERDTBL)
(READTABLEPROP CODERDTBL (QUOTE USESILPACKAGE)
NIL)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS CODERDTBL FILERDTBL)
)
(RPAQQ CODEINDICATOR D1)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS CODEINDICATOR)
)
(PUTPROPS D1 CODEREADER (DCODERD . DCODESKIP))
(PUTPROPS D2 CODEREADER (DCODERD . DCODESKIP))
(PUTPROPS D1 CODEREADER (DCODERD . DCODESKIP))
(* ; "Compiled CLOSURE type")
(DEFINEQ
(MAKE-COMPILED-CLOSURE
[LAMBDA (CODEBASE ENVIRONMENT) (* bvm: " 7-Jul-86 11:32")
(create COMPILED-CLOSURE
FNHEADER ← CODEBASE
ENVIRONMENT ← ENVIRONMENT])
(\CCLOSURE.DEFPRINT
[LAMBDA (CLOSURE STREAM) (* bvm: " 7-Jul-86 15:50")
(* * "Print closure object as, for example, #<Compiled Closure FOOBAR/76,5432>")
(LET [(NAME (fetch (COMPILED-CLOSURE FRAMENAME) of CLOSURE))
(TYPE (COND
((fetch (COMPILED-CLOSURE ENVIRONMENT) of CLOSURE)
"Closure")
(T "Function"]
(.SPACECHECK. STREAM (IPLUS (CONSTANT (NCHARS "<Compiled Function />"))
(PROGN (* Longest stack address is "177,177777")
10)
(COND
((OR (LITATOM NAME)
(STRINGP NAME))
(NCHARS NAME (LITATOM NAME)))
(T (SETQ NAME)
0))
1))
(\OUTCHAR STREAM (fetch (READTABLEP HASHMACROCHAR) of *READTABLE*))
(\SOUT "<Compiled " STREAM)
(\SOUT TYPE STREAM)
[COND
(NAME (\OUTCHAR STREAM (CHARCODE SPACE))
(COND
((STRINGP NAME)
(\SOUT NAME STREAM))
(T (\PRINDATUM NAME STREAM]
(\OUTCHAR STREAM (CHARCODE /))
(\PRINTADDR CLOSURE STREAM)
(\OUTCHAR STREAM (CHARCODE >))
T])
(\GET-COMPILED-DEFINITION
[LAMBDA (X) (* bvm: "11-Jul-86 16:28")
(* * X is an object denoting a function somehow.
If it represents a compiled function, return a CLOSURE object for it)
(PROG NIL
[COND
((LITATOM X)
(COND
((PROG1 (fetch (LITATOM CCODEP) of X)
(SETQ X (fetch (LITATOM DEFPOINTER) of X)))
(RETURN (MAKE-COMPILED-CLOSURE X]
(RETURN (AND (type? COMPILED-CLOSURE X)
X])
(\GET-COMPILED-CODE-BASE
[LAMBDA (X) (* bvm: "11-Jul-86 16:26")
(* * X is an object denoting a function somehow.
If it represents a compiled function, return its code base)
(PROG NIL
[COND
((LITATOM X)
(COND
((PROG1 (fetch (LITATOM CCODEP) of X)
(SETQ X (fetch (LITATOM DEFPOINTER) of X)))
(RETURN X]
(RETURN (AND (EQ (NTYPX X)
\COMPILED-CLOSURE)
(fetch (COMPILED-CLOSURE FNHEADER) of X])
(EQDEFP
[LAMBDA (CA1 CA2) (* bvm: " 7-Jul-86 22:36")
(* determines whether two code arrays
CA1 and CA2 are equivalent
(same except for framename))
(COND
((AND (TYPEP CA1 (QUOTE COMPILED-CLOSURE))
(TYPEP CA2 (QUOTE COMPILED-CLOSURE))
(EQ (fetch (COMPILED-CLOSURE ENVIRONMENT) of CA1)
(fetch (COMPILED-CLOSURE ENVIRONMENT) of CA2)))
(SETQ CA1 (fetch (COMPILED-CLOSURE FNHEADER) of CA1))
(SETQ CA2 (fetch (COMPILED-CLOSURE FNHEADER) of CA2))
(for I from 0 to (SUB1 (UNFOLD (IMIN (\#BLOCKDATACELLS CA1)
(\#BLOCKDATACELLS CA2))
WORDSPERCELL))
always (OR (EQ (\GETBASE CA1 I)
(\GETBASE CA2 I))
[EQ I (INDEXF (fetch (FNHEADER #FRAMENAME]
(EQ I (ADD1 (INDEXF (fetch (FNHEADER #FRAMENAME])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(DATATYPE COMPILED-CLOSURE (FNHEADER ENVIRONMENT))
]
(/DECLAREDATATYPE (QUOTE COMPILED-CLOSURE)
(QUOTE (POINTER POINTER))
(QUOTE ((COMPILED-CLOSURE 0 POINTER)
(COMPILED-CLOSURE 2 POINTER)))
(QUOTE 4))
(DECLARE: EVAL@COMPILE
(RPAQQ \COMPILED-CLOSURE 13)
(CONSTANTS \COMPILED-CLOSURE)
)
(DECLARE: EVAL@COMPILE
[PUTPROPS \EXTENDED.EQP MACRO (OPENLAMBDA (X Y)
(COND ((EQ (NTYPX X)
(NTYPX Y))
(SELECTC (NTYPX X)
(\STACKP (EQ (fetch (STACKP EDFXP)
of X)
(fetch (STACKP EDFXP)
of Y)))
(\COMPILED-CLOSURE (EQDEFP X Y))
NIL]
)
(* END EXPORTED DEFINITIONS)
)
(/DECLAREDATATYPE (QUOTE COMPILED-CLOSURE)
(QUOTE (POINTER POINTER))
(QUOTE ((COMPILED-CLOSURE 0 POINTER)
(COMPILED-CLOSURE 2 POINTER)))
(QUOTE 4))
(DECLARE: DONTEVAL@LOAD DOCOPY
(DEFPRINT (QUOTE COMPILED-CLOSURE)
(QUOTE \CCLOSURE.DEFPRINT))
)
(* ; "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 UNWIND 2 T (UNWIND 1)
\UNWIND.UFN)
(8 FN0 2 FN 1)
(9 FN1 2 FN 0)
(10 FN2 2 FN -1)
(11 FN3 2 FN -2)
(12 FN4 2 FN -3)
(13 FNX 3 FNX FNX)
(14 APPLYFN 0 T -1)
(15 CHECKAPPLY* 0 T 0 \CHECKAPPLY* (4K 12K))
(16 RETURN 0 T (JUMP 1)
\HARDRETURN)
(17 BIND 2)
(18 UNBIND 0)
(19 DUNBIND 0)
(20 RPLPTR.N 1 T -1 \RPLPTR.UFN (4K))
(21 GCREF 1 T 0 \HTFIND)
(22 ASSOC 0 T -1 ASSOC (4K DORADO))
(23 GVAR← 2 ATOM 0 \SETGLOBALVAL.UFN)
(24 RPLACA 0 T -1 \RPLACA.UFN 4K)
(25 RPLACD 0 T -1 \RPLACD.UFN 4K)
(26 CONS 0 T -1 \CONS.UFN)
(27 GETP 0 T -1 GETPROP T)
(28 FMEMB 0 T -1 FMEMB (4K DORADO))
(29 GETHASH 0 T -1 GETHASH T)
(30 FINDKEY 1 T 0 \FINDKEY.UFN)
(31 CREATECELL 0 T 0 \CREATECELL 4K)
(32 BIN 0 T 0 \BIN 4K)
(33 BOUT 0 T -1 \BOUT T)
(34 POPDISP 0 T 0 \POPDISP.UFN (4K DORADO))
(35 RESTLIST 1 T -1 \RESTLIST.UFN)
(36 DOCOLLECT 0 T -1 DOCOLLECT T)
(37 ENDCOLLECT 0 T -1 ENDCOLLECT T)
(38 RPLCONS 0 T -1 \RPLCONS (4K DORADO))
(39 LISTGET 0 T -1 LISTGET (4K DORADO))
(40 ELT 0 T -1 ELT T)
(41 NTHCHC 0 T -1 NTHCHARCODE T)
(42 SETA 0 T -2 SETA T)
(43 RPLCHARCODE 0 T -2 RPLCHARCODE T)
(44 EVAL 0 T 0 \EVAL)
(45 EVALV 0 T 0 \EVALV1 T)
(46 TYPECHECK 0 T 0 \TYPECHECK.UFN)
(47 STKSCAN 0 T 0 \STKSCAN)
(48 BUSBLT 1 (WORDSOUT BYTESOUT BYTESOUTSWAPPED NYBBLESOUT WORDSIN BYTESIN
BYTESINSWAPPED NYBBLESINSWAPPED)
-3 \BUSBLT.UFN (4K DORADO))
(49 MISC8 1 (IBLT1 IBLT2)
-7 \MISC8.UFN (4K DORADO))
(50 UBFLOAT3 1 (POLY MATRIX.3X3 MATRIX.4X4 MATRIX.133 MATRIX.331 MATRIX.144
MATRIX.441 UBASET1)
(-2 1)
\UNBOXFLOAT3
(4K DORADO))
(51 TYPEMASK.N 1 T 0 \TYPEMASK.UFN)
(52 RDPROLOGPTR 0 T 0 RAID (4K DORADO))
(53 RDPROLOGTAG 0 T 0 RAID (4K DORADO))
(54 WRTPTR&TAG 0 T -2 RAID (4K DORADO))
(55 WRTPTR&0TAG 0 T -1 RAID (4K DORADO))
(56 MISC7 1 (PSEUDOCOLOR)
-6 \MISC7.UFN (4K DORADO))
(57 DOVEMISC 1 (READIW WRITEIO WRITEMP RDTIMER BYTESWAP LOCKMEM NOTIFYIOP SETWP)
(0 -1 0 0 0 -3 0 0))
(58 EQL 0 T -1 EQL)
(59 DRAWLINE 0 T -8 \DRAWLINE.UFN (4K DORADO))
(60 STORE.N 1 T 0 \STORE.N.UFN)
(61 COPY.N 1 T 1 \COPY.N.UFN)
(62 RAID 0 T 0 RAID T)
(63 \RETURN 0 T 0 \RETURN)
((64 70)
IVAR 0 IVAR 1)
(71 IVARX 1 IVAR 1)
((72 78)
PVAR 0 PVAR 1)
(79 PVARX 1 PVAR 1)
((80 86)
FVAR 0 FVAR 1)
(87 FVARX 1 FVAR 1)
((88 94)
PVAR← 0 PVAR 0)
(95 PVARX← 1 PVAR 0)
(96 GVAR 2 ATOM 1)
(97 ARG0 0 T 0 \ARG0 T)
(98 IVARX← 1 IVAR 0)
(99 FVARX← 1 FVAR 0)
(100 COPY 0 T 1)
(101 MYARGCOUNT 0 T 1 \MYARGCOUNT T)
(102 MYALINK 0 T 1)
(103 ACONST 2 ATOM 1)
(104 'NIL 0 T 1)
(105 'T 0 T 1)
(106 '0 0 T 1)
(107 '1 0 T 1)
(108 SIC 1 SIC 1)
(109 SNIC 1 SNIC 1)
(110 SICX 2 SICX 1)
(111 GCONST 3 GCONST 1)
(112 ATOMNUMBER 2 ATOM 1)
(113 READFLAGS 0 T 0 \READFLAGS)
(114 READRP 0 T 0 \READRP)
(115 WRITEMAP 0 T -2 \WRITEMAP DORADO)
(116 READPRINTERPORT 0 T 1 \READPRINTERPORT.UFN 4K)
(117 WRITEPRINTERPORT 0 T 0 \WRITEPRINTERPORT.UFN 4K)
(118 PILOTBITBLT 0 T -1 \PILOTBITBLT)
(119 RCLK 0 T 0 \RCLKSUBR)
(120 MISC1 1 (error INPUT OUTPUT error error error error error error RWMUFMAN)
0 \MISC1.UFN)
(121 MISC2 1 (?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?10)
-1 \MISC2.UFN)
(122 RECLAIMCELL 0 T 0 \GCRECLAIMCELL DORADO)
(123 GCSCAN1 0 T 0 \GCSCAN1)
(124 GCSCAN2 0 T 0 \GCSCAN2)
(125 SUBRCALL 2 SUBRCALL)
(126 CONTEXTSWITCH 0 T 0 \CONTEXTSWITCH)
(127 RETCALL 3 FNX (JUMP 1)
\RETCALL)
((128 143)
JUMP 0 JUMP JUMP NIL)
((144 159)
FJUMP 0 JUMP CJUMP NIL)
((160 175)
TJUMP 0 JUMP CJUMP NIL)
(176 JUMPX 1 JUMPX JUMP)
(177 JUMPXX 2 JUMPXX JUMP)
(178 FJUMPX 1 JUMPX CJUMP)
(179 TJUMPX 1 JUMPX CJUMP)
(180 NFJUMPX 1 JUMPX NCJUMP)
(181 NTJUMPX 1 JUMPX NCJUMP)
(182 AREF1 0 T -1 %%AREF1 (4K DORADO))
(183 ASET1 0 T -2 %%ASET1 (4K DORADO))
((184 190)
PVAR←↑ 0 PVAR -1 NIL)
(191 POP 0 T -1)
(192 POP.N 1 T (POP.N 1)
\POP.N.UFN)
(193 ATOMCELL.N 1 T 0 \ATOMCELL)
(194 GETBASEBYTE 0 T -1 \GETBASEBYTE)
(195 INSTANCEP 2 ATOM 0 \INSTANCEP.UFN NIL)
(196 BLT 0 T -2 \BLT)
(197 MISC10 1 T -9 \MISC10.UFN (4K DORADO))
(198 was.putbaseptr)
(199 PUTBASEBYTE 0 T -2 \PUTBASEBYTE)
(200 GETBASE.N 1 T 0)
(201 GETBASEPTR.N 1 T 0)
(202 GETBITS.N.FD 2 T 0)
(203 GETBASEFIXP.N 1 T 0 \GETBASEFIXP T)
(204 PUTBASEFIXP.N 1 T -1 \PUTBASEFIXP.UFN T)
(205 PUTBASE.N 1 T -1 \PUTBASE.UFN)
(206 PUTBASEPTR.N 1 T -1 \PUTBASEPTR.UFN)
(207 PUTBITS.N.FD 2 T -1 \PUTBITS.UFN)
(208 ADDBASE 0 T -1 \ADDBASE)
(209 VAG2 0 T -1 \VAG2)
(210 HILOC 0 T 0)
(211 LOLOC 0 T 0)
(212 PLUS2 0 T -1 \SLOWPLUS2 *)
(213 DIFFERENCE 0 T -1 \SLOWDIFFERENCE *)
(214 TIMES2 0 T -1 \SLOWTIMES2 *)
(215 QUOTIENT 0 T -1 \SLOWQUOTIENT *)
(216 IPLUS2 0 T -1 \SLOWIPLUS2)
(217 IDIFFERENCE 0 T -1 \SLOWIDIFFERENCE)
(218 ITIMES2 0 T -1 \SLOWITIMES2)
(219 IQUOTIENT 0 T -1 \SLOWIQUOTIENT)
(220 IREMAINDER 0 T -1 IREMAINDER)
(221 IPLUS.N 1 T 0 \SLOWIPLUS2 (4K 12K))
(222 IDIFFERENCE.N 1 T 0 \SLOWIDIFFERENCE (4K 12K))
(223 was.iblt)
(224 LLSH1 0 T 0 \SLOWLLSH1)
(225 LLSH8 0 T 0 \SLOWLLSH8)
(226 LRSH1 0 T 0 \SLOWLRSH1)
(227 LRSH8 0 T 0 \SLOWLRSH8)
(228 LOGOR2 0 T -1 \SLOWLOGOR2)
(229 LOGAND2 0 T -1 \SLOWLOGAND2)
(230 LOGXOR2 0 T -1 \SLOWLOGXOR2)
(231 LSH 0 T -1 LSH T)
(232 FPLUS2 0 T -1 \SLOWFPLUS2 4K)
(233 FDIFFERENCE 0 T -1 \SLOWFDIFFERENCE 4K)
(234 FTIMES2 0 T -1 \SLOWFTIMES2 4K)
(235 FQUOTIENT 0 T -1 \SLOWFQUOTIENT 4K)
(236 UBFLOAT2 1 (UFADD UFSUB UFISUB UFMULT UFDIV UFGREAT UFMAX UFMIN UFREM UBAREF1)
(-1 1)
\UNBOXFLOAT2
(4K DORADO))
(237 UBFLOAT1 1 (BOX UNBOX UFABS UFNEGATE UFIX)
(0 1)
\UNBOXFLOAT1
(4K DORADO))
(238 AREF2 0 T -2 %%AREF2 (4K DORADO))
(239 ASET2 0 T -3 %%ASET2 (4K DORADO))
(240 EQ 0 T -1)
(241 IGREATERP 0 T -1 \SLOWIGREATERP)
(242 FGREATERP 0 T -1 \SLOWFGREATERP)
(243 GREATERP 0 T -1 GREATERP)
(244 EQUAL 0 T -1 EQUAL)
(245 MAKENUMBER 0 T -1 \MAKENUMBER 4K)
(246 BOXIPLUS 0 T -1 \BOXIPLUS 4K)
(247 BOXIDIFFERENCE 0 T -1 \BOXIDIFFERENCE 4K)
(248 FLOATBLT 1 (FLOATWRAP FLOATUNWRAP FLOAT FIX FPLUS FDIFFERENCE FDIFFERENCE
FPLUSABS ABSDIFFERENCE ABSFPLUS FTIMES)
-3 \FLOATBLT (4K DORADO))
(249 FFTSTEP 0 T -1 \FFTSTEP (4K DORADO))
(250 MISC3 1 (EXPONENT MAGNITUDE FLOAT COMP BLKFMAX BLKFMIN BLKFABSMAX BLKFABSMIN
FLOATTOBYTE ARRAYREAD)
-2 \MISC3.UFN (4K DORADO))
(251 MISC4 1 (ARRAY.TIMES ARRAY.PERM ARRAY.PLUS ARRAY.DIFFERENCE ARRAY.MAGIC 3MATCH
BMBIT ARRAYWRITE)
-3 \MISC4.UFN)
(252 UPCTRACE 0 T 0 NILL (4K 12K))
(253 SWAP 0 T 0)
(254 NOP 0 T 0)
(255 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)))
)
[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 8)
4)
3)
(CODESETA DATUM 8 (LOGOR (LOGAND (CODELT DATUM 8)
65487)
(LLSH (LOGAND NEWVALUE 3)
4]
(FRAMENAME (\VAG2 (CODELT DATUM 9)
(CODELT2 DATUM 10))
(\FIXCODEPTR DATUM 11 (EVQ NEWVALUE)))
(NTSIZE (CODELT2 DATUM 12)
(CODESETA2 DATUM 12 NEWVALUE))
(NLOCALS (CODELT DATUM 14)
(CODESETA DATUM 14 NEWVALUE))
(FVAROFFSET (CODELT DATUM 15)
(CODESETA DATUM 15 NEWVALUE)))
[ACCESSFNS
CODEARRAY
((LSTARP (ILESSP (fetch (CODEARRAY NA) of DATUM)
0))
(OVERHEADWORDS (PROGN 8))
(ALIGNED (IPLUS (fetch (CODEARRAY NTSIZE) of DATUM)
(fetch (CODEARRAY OVERHEADWORDS) of T)))
(FIXED NIL (replace (CODEARRAY STKMIN) of DATUM
with (IPLUS (UNFOLD (IPLUS (IMAX (fetch (CODEARRAY NA)
of DATUM)
0)
(UNFOLD (ADD1 (fetch (CODEARRAY
PV)
of DATUM))
CELLSPERQUAD))
WORDSPERCELL)
12 32)))
(FRAMENAME# (PROGN 8])
]
[DECLARE: EVAL@COMPILE
(RECORD OPCODE (OP# OPCODENAME OPNARGS OPPRINT LEVADJ UFNFN UNIMPL))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \OPCODES)
)
(DECLARE: EVAL@COMPILE
(RPAQQ PVARCODE 32768)
(RPAQQ FVARCODE 49152)
(RPAQQ IVARCODE 0)
(RPAQQ VARCODEMASK 49152)
(CONSTANTS PVARCODE FVARCODE IVARCODE VARCODEMASK)
)
(* END EXPORTED DEFINITIONS)
)
(* ; "ufns")
(DEFINEQ
(INITUFNTABLE
[LAMBDA NIL (* lmm " 5-Feb-86 15: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)
[COND
((LISTP (fetch (OPCODE LEVADJ) of X))
(CADR (fetch (OPCODE LEVADJ) of X)))
(T (IDIFFERENCE (IPLUS 1 (COND
((EQ (fetch (OPCODE OPNARGS) of X)
0)
0)
(T 1)))
(fetch (OPCODE LEVADJ) of X]
(SELECTQ (fetch (OPCODE OPNARGS) of X)
(0 0)
(1 1)
(2 2)
(3 1)
(SHOULDNT])
(\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)
(SETSYNTAX (CHARCODE %|)
(QUOTE (MACRO ALWAYS READVBAR))
CODERDTBL)
(READTABLEPROP CODERDTBL (QUOTE USESILPACKAGE)
NIL)))
(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))
(ADDTOVAR RDCOMS (FNS \GET-COMPILED-CODE-BASE))
)
(PUTPROPS LLCODE COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4722 17028 (DCODERD 4732 . 13273) (DCODESKIP 13275 . 15552) (\RENAMEDFN 15554 . 16610)
(\ALLOC.CODE.BLOCK 16612 . 16827) (\REALNAMEP 16829 . 17026)) (17723 22088 (MAKE-COMPILED-CLOSURE
17733 . 17958) (\CCLOSURE.DEFPRINT 17960 . 19540) (\GET-COMPILED-DEFINITION 19542 . 20179) (
\GET-COMPILED-CODE-BASE 20181 . 20855) (EQDEFP 20857 . 22086)) (23587 24922 (\FINDOP 23597 . 24920)) (
39779 42023 (INITUFNTABLE 39789 . 41188) (\SETUFNENTRY 41190 . 41632) (\GETUFNENTRY 41634 . 42021)) (
42024 42222 (\UNKNOWN.UFN 42034 . 42220)))))
STOP