(FILECREATED "11-OCT-83 15:31:39" {PHYLUM}<LISPCORE>SOURCES>RDSYS.;1


      previous date: "18-AUG-83 15:52:21" {PHYLUM}<LISPCORE>SOURCES>RDSYS.;21)


(PRETTYCOMPRINT RDSYSCOMS)

(RPAQQ RDSYSCOMS
 ((FNS VREADPAGEMAP VREADPAGEMAPBLOCK VCHECKIFPAGE VFIXIFPAGE) (FNS VRAIDCOMMAND 
VRAIDSHOWFRAME VPRINTADDRS VPRINTVA VREADVA VREADOCT VSHOWSTACKBLOCKS VSHOWSTACKBLOCK1 VPRINCOPY) (FNS
 V\BACKTRACE V\PRINTBF V\PRINTFRAME V\SCANFORNTENTRY V\PRINTSTK) (FNS VDPRINTCODE VPRINTCODENT 
VBROKENDEF) (MACROS PCVAR) (FNS V\CAR.UFN V\CDR.UFN) (FNS V\COPY V\UNCOPY) (FNS V\GETBASEBYTE 
V\PUTBASEBYTE) (FNS VNTYPX VTYPENAME) (FNS VCOPYATOM VUNCOPYATOM V\MKATOM VGETTOPVAL VGETPROPLIST 
VSETTOPVAL VGETDEFN V\SMASHATOM) (FNS VLISTP) (VARS (COPYATOMSTR)) (FNS V\FINDOP) (VARS \OPCODES) (
VARS (\OPCODEARRAY)) (GLOBALVARS \OPCODEARRAY \OPCODES) (DECLARE: DONTCOPY (RECORDS OPCODE)) (FILES 
VMEM) (VARS RDVALS RDPTRS) (DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) VMEM))))
(DEFINEQ

(VREADPAGEMAP

(LAMBDA NIL (*) (*) (PROG (FIRSTPMT D) (MAPVMPAGE (IPLUS (LLSH (VHILOC (VVAG2 22 4096)) 8) (LRSH (
VLOLOC (VVAG2 22 4096)) 8)) 1) (*) (VCHECKIFPAGE) (MAPVMPAGE (IPLUS (LLSH (VHILOC (VVAG2 21 0)) 8) (
LRSH (VLOLOC (VVAG2 21 0)) 8)) (SUB1 (VGETBASE (VVAG2 22 4096) 22))) (*) (SETQ FIRSTPMT (SUB1 (
VGETBASE (VVAG2 22 4096) 23))) (SETVMPTR (VVAG2 21 0)) (VREADPAGEMAPBLOCK (IPLUS (LLSH (VHILOC (VVAG2 
21 0)) 8) (LRSH (VLOLOC (VVAG2 21 0)) 8))) (*) (for J from 0 to (SUB1 2) do (MAPVMPAGE (IPLUS (IPLUS (
LLSH (VHILOC (VVAG2 22 0)) 8) (LRSH (VLOLOC (VVAG2 22 0)) 8)) J) (IPLUS FIRSTPMT J))) (for I from 0 to
 (SUB1 (LLSH 2 8)) do (COND ((IEQ (SETQ D (VGETBASE (VVAG2 22 0) I)) 65535)) (T (SETVMPTR (VADDBASE (
VVAG2 21 0) D)) (VREADPAGEMAPBLOCK (LLSH I 5))))))))

(VREADPAGEMAPBLOCK

(LAMBDA (VP) (*) (PROG ((B VP) P) (FRPTQ 32 (COND ((NEQ (SETQ P (VBIN2)) 0) (MAPVMPAGE B (SUB1 P)))) (
SETQ B (ADD1 B))))))

(VCHECKIFPAGE

(LAMBDA NIL (*) (COND ((NOT (EQUAL 36864 (VGETBASE (VVAG2 22 4096) 8))) (printout T "Warning: " 
"Lisp Version" "= " (PROGN 36864) ", but \InterfacePage says " (VGETBASE (VVAG2 22 4096) 8) T))) (COND
 ((NOT (EQUAL 5603 (VGETBASE (VVAG2 22 4096) 15))) (printout T "Warning: " "Interface page key" "= " (
PROGN 5603) ", but \InterfacePage says " (VGETBASE (VVAG2 22 4096) 15) T)))))

(VFIXIFPAGE

(LAMBDA (RPT RPTSIZE RPOFFSET RPTLAST EMBUFVP) (*) (*) (VPUTBASE (VVAG2 22 4096) 11 4096) (VPUTBASE (
VVAG2 22 4096) 12 65535) (VPUTBASE (VVAG2 22 4096) 13 6) (VPUTBASE (VVAG2 22 4096) 16 0) (VPUTBASE (
VVAG2 22 4096) 17 0) (VPUTBASE (VVAG2 22 4096) 18 64) (VPUTBASE (VVAG2 22 4096) 28 0) (VPUTBASE (VVAG2
 22 4096) 29 0) (VPUTBASE (VVAG2 22 4096) 33 RPT) (VPUTBASE (VVAG2 22 4096) 34 RPTSIZE) (VPUTBASE (
VVAG2 22 4096) 35 (LOGAND RPOFFSET (CONSTANT (SUB1 (LLSH 1 16))))) (VPUTBASE (VVAG2 22 4096) 36 
RPTLAST) (VPUTBASE (VVAG2 22 4096) 37 EMBUFVP) (*) NIL))
)
(DEFINEQ

(VRAIDCOMMAND

(LAMBDA NIL (*) (DECLARE (USEDFREE ROOTFRAME ALINKS? RAIDIX FRAME#)) (PROG (CMD) (SELECTQ (SETQ CMD (
ASKUSER NIL NIL "@" (QUOTE ((Q "uit [confirm]" CONFIRMFLG T) (% "↑N - remote return [confirm]" 
CONFIRMFLG T RETURN (QUOTE ↑N)) (% "Basic frame at: " EXPLAINSTRING 
"↑F - print basic frame at octal address" RETURN (QUOTE ↑F)) (% "frame extension at: " EXPLAINSTRING 
"↑X - print frame extension at octal address" RETURN (QUOTE ↑X)) (%
 "Next frame " EXPLAINSTRING 
"LF - next frame" RETURN (QUOTE LF)) (↑ " Previous frame ") (% "atom number for atom: " EXPLAINSTRING
 "↑O - look up atom" RETURN (QUOTE ↑O)) (A "tom top-level value of atom: ") (P 
"roperty list for atom: ") (D "efinition for atom: ") (L "isp stack ") (% 
"Lisp stack from frame or context " EXPLAINSTRING "↑L -- Lisp stack from arbitrary frame" RETURN (
QUOTE ↑L)) (F "rame ") (S "how stack addresses: ") (V "irtual address: ") (B "lock from address: ") (C
 "ode for function:") (W "alk stack blocks starting at: ") (% " Enter Lisp " EXPLAINSTRING 
"↑Y -- Enter Lisp" RETURN (QUOTE ↑Y)) (K "" EXPLAINSTRING "K -- Set linKtype for stack ops") (← 
" Set word at address: ") (I "nspect InterfacePage") (U " -- Show remote screen") ("
" "" RETURN NIL))) T)) (↑N (RETURN (QUOTE RETURN))) (Q (TERPRI T) (RETURN (QUOTE QUIT))) (NIL) (A (
PRINT (V\UNCOPY (VGETTOPVAL (PROG1 (READ T T) (READC T)))) T T)) (P (PRINT (V\UNCOPY (VGETPROPLIST (
PROG1 (READ T T) (READC T)))) T T)) (C (VDPRINTCODE (PROG1 (READ T T) (READC T)) T RAIDIX)) (V (PRINT 
(V\UNCOPY (VREADVA)) T T)) (B (VPRINTADDRS (VREADVA) (VREADOCT))) (S (VPRINTADDRS (VVAG2 23 (VREADOCT)
) (VREADOCT))) (D (VPRINTADDRS (VADDBASE (VVAG2 17 0) (LLSH (VATOMNUMBER (PROG1 (READ T T) (READC T)))
 1)) 2)) ((L ↑L) (SETQ FRAME# 0) (COND ((EQ CMD (QUOTE L)) (SETQ ROOTFRAME (PROG1 (COND ((LISTP 
VMEMFILE) (PRIN1 "in TeleRaid Context" T) (VGETBASE (VVAG2 22 4096) 24)) (T (VGETBASE (VVAG2 22 4096) 
0))) (TERPRI T)))) ((AND (ILESSP (SETQ ROOTFRAME (VREADOCT)) 256) (ILESSP (VGETBASE (VVAG2 22 4096) 
ROOTFRAME) (VGETBASE (VVAG2 22 4096) 7)) (IEQ (LRSH (VGETBASE (VVAG2 23 (PROGN (PROGN (VGETBASE (VVAG2
 22 4096) ROOTFRAME)))) 0) 13) 6)) (SETQ ROOTFRAME (VGETBASE (VVAG2 22 4096) ROOTFRAME)))) (
V\BACKTRACE ROOTFRAME NIL T NIL NIL NIL ALINKS? (FUNCTION VPRINCOPY) 1 RAIDIX)) (F (VRAIDSHOWFRAME (
SETQ FRAME# (PROG1 (READ T T) (READC T))))) (LF (OR FRAME# (SETQ FRAME# 0)) (printout T "(" .I1 (SETQ 
FRAME# (IPLUS FRAME# 1)) ")" T) (VRAIDSHOWFRAME FRAME#)) (↑ (COND ((OR (NULL FRAME#) (ILEQ FRAME# 1)) 
(printout T "No previous frame" T)) (T (printout T "(" .I1 (SETQ FRAME# (IPLUS FRAME# -1)) ")" T) (
VRAIDSHOWFRAME FRAME#)))) (↑F (V\PRINTBF (VREADOCT) NIL (FUNCTION VPRINCOPY))) (W (VSHOWSTACKBLOCKS (
COND ((EQ (PEEKC T) (QUOTE %
)) (READC T) 0) (T (VREADOCT))))) (↑X (V\PRINTFRAME (VREADOCT) (QUOTE VPRINCOPY))) (↑Y (TERPRI T) (
USEREXEC (QUOTE ::))) (K (SETQ ALINKS? (EQ (ASKUSER NIL NIL " Set link type for stack operations to " 
(QUOTE ((A "links
") (C "links
"))) T) (QUOTE A)))) (← (PROG ((VA (VREADVA))) (printout " Currently ") (PRINTNUM .I7 (VGETBASE VA 0))
 (printout " to be ") (VPUTBASE VA 0 (VREADOCT)))) (I (COND ((NULL (GETD (QUOTE INSPECT)))) ((RECLOOK 
(QUOTE IFPAGE)) (INSPECT (COND ((LISTP VMEMFILE) (VMAPPAGE (fetch (POINTER PAGE#) of \InterfacePage)))
 (T (PROG ((PAGE (NCREATE (QUOTE VMEMPAGEP)))) (SETVMPTR (VGETTOPVAL (QUOTE \InterfacePage))) (\BINS (
GETSTREAM VMEMFILE) PAGE 0 BYTESPERPAGE) (RETURN PAGE)))) (QUOTE IFPAGE))) (T (PRIN1 
" Can't -- no record for IFPAGE"))) (TERPRI T)) (U (SHOWREMOTESCREEN)) (HELP)) (RETURN NIL))))

(VRAIDSHOWFRAME

(LAMBDA (N) (*) (PROG ((FRAME (OR ROOTFRAME (SETQ ROOTFRAME (VGETBASE (VVAG2 22 4096) 0))))) (FRPTQ (
SUB1 N) (COND ((ZEROP (PROGN (SETQ FRAME (COND (ALINKS? (IDIFFERENCE (LOGAND (VGETBASE (VVAG2 23 FRAME
) 1) (CONSTANT (LOGXOR (SUB1 2) -1))) 10)) (T (IDIFFERENCE (COND ((EVENP (VGETBASE (VVAG2 23 FRAME) 1)
 2) (VGETBASE (VVAG2 23 FRAME) 1)) (T (VGETBASE (VVAG2 23 FRAME) 9))) 10)))))) (RETURN (printout T N 
" is beyond the bottom of the stack" T))))) (V\BACKTRACE FRAME FRAME T NIL T T NIL (FUNCTION VPRINCOPY
) NIL RAIDIX))))

(VPRINTADDRS

(LAMBDA (BASE CNT) (*) (PRIN1 "words from ") (VPRINTVA BASE) (PRIN1 " to ") (VPRINTVA (VADDBASE BASE (
SUB1 CNT))) (TERPRI) (SPACES 7) (for I from 0 to 7 do (PRINTNUM .I7 I)) (PROG ((NB (VVAG2 (VHILOC BASE
) (LOGAND (VLOLOC BASE) (CONSTANT (LOGXOR (SUB1 8) -1))))) (LB (VADDBASE BASE CNT))) (do (COND ((ZEROP
 (LOGAND (VLOLOC NB) 7)) (TAB 0 0) (PRINTNUM .I5 (VLOLOC NB)) (PRIN1 ": "))) (COND ((IGREATERP BASE NB
) (SPACES 7)) (T (PRINTNUM .I7 (VGETBASE NB 0)))) (SETQ NB (VADDBASE NB 1)) repeatwhile (IGREATERP LB 
NB)) (TAB 0 0))))

(VPRINTVA

(LAMBDA (X) (*) (PRIN1 "{") (PRINTNUM .I2 (VHILOC X)) (PRIN1 ",") (PRINTNUM .I6 (VLOLOC X)) (PRIN1 "}"
)))

(VREADVA

(LAMBDA NIL (*) (VVAG2 (VREADOCT) (VREADOCT))))

(VREADOCT

(LAMBDA NIL (*) (bind STR while (EQUAL (SETQ STR (RSTRING T T)) "") do (READC T) finally (RETURN (
PROG1 (OR (FIXP (SELECTQ RAIDIX (8 (MKATOM (CONCAT STR "Q"))) (16 (bind N←0 CHAR while (SETQ CHAR (GNC
 STR)) do (SETQ N (IPLUS (ITIMES N 16) (COND ((FIXP CHAR) CHAR) ((AND (IGEQ (SETQ CHAR (CHCON1 CHAR)) 
(CHARCODE A)) (ILEQ CHAR (CHARCODE F))) (IPLUS (IDIFFERENCE CHAR (CHARCODE A)) 10)) (T (ERROR CHAR (
QUOTE ?) T))))) finally (RETURN N))) (SHOULDNT))) (PROGN (PRIN1 "?" T) (ERROR!))) (READC T))))))

(VSHOWSTACKBLOCKS

(LAMBDA (SCANPTR WAITFLG) (*) (*) (PROG ((EASP (VGETBASE (VVAG2 22 4096) 7))) SCAN (SELECTC (LRSH (
VGETBASE (VVAG2 23 SCANPTR) 0) 13) (5 (VSHOWSTACKBLOCK1 SCANPTR "free block" (IEQ (VGETBASE (VVAG2 23 
SCANPTR) 0) 40960)) (SETQ SCANPTR (IPLUS SCANPTR (VGETBASE (VVAG2 23 SCANPTR) 1)))) (7 (
VSHOWSTACKBLOCK1 SCANPTR "guard block" T) (SETQ SCANPTR (IPLUS SCANPTR (VGETBASE (VVAG2 23 SCANPTR) 1)
))) (6 (*) (VSHOWSTACKBLOCK1 SCANPTR "Frame extn = " (AND (IEQ (LRSH (VGETBASE (VVAG2 23 SCANPTR) 0) 
13) 6) (OR (IEQ (IDIFFERENCE SCANPTR 2) (COND ((EVENP (VGETBASE (VVAG2 23 SCANPTR) 1) 2) (IDIFFERENCE 
SCANPTR 2)) (T (VGETBASE (VVAG2 23 SCANPTR) 8)))) (AND (NOT (ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 23 (
PROGN (IDIFFERENCE SCANPTR 2))) 0) 9) 1))) (IEQ (VGETBASE (VVAG2 23 (PROGN (IDIFFERENCE SCANPTR 2))) 1
) (VGETBASE (VVAG2 23 (PROGN (COND ((EVENP (VGETBASE (VVAG2 23 SCANPTR) 1) 2) (IDIFFERENCE SCANPTR 2))
 (T (VGETBASE (VVAG2 23 SCANPTR) 8))))) 1)))))) (PRIN2 (V\UNCOPY (VGETBASEPTR (PROGN (COND ((NOT (
ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 23 SCANPTR) 0) 9) 1))) (VVAG2 (LOGAND (VGETBASE (VVAG2 23 SCANPTR
) 7) 255) (VGETBASE (VVAG2 23 SCANPTR) 6))) (T (VVAG2 (LOGAND (VGETBASE (VVAG2 23 SCANPTR) 3) 255) (
VGETBASE (VVAG2 23 SCANPTR) 2))))) 4))) (SETQ SCANPTR (VGETBASE (VVAG2 23 SCANPTR) 4))) (PROG ((ORIG 
SCANPTR) IVAR) (*) (while (EQ (LRSH (VGETBASE (VVAG2 23 SCANPTR) 0) 13) 0) do (SETQ SCANPTR (IPLUS 
SCANPTR 2))) (COND ((NOT (IEQ (LRSH (VGETBASE (VVAG2 23 SCANPTR) 0) 13) 4)) (VSHOWSTACKBLOCK1 ORIG 
"Garbage" T)) (T (SETQ IVAR (VGETBASE (VVAG2 23 SCANPTR) 1)) (COND ((NOT (ZEROP (LOGAND (LRSH (
VGETBASE (VVAG2 23 SCANPTR) 0) 9) 1))) (VSHOWSTACKBLOCK1 SCANPTR "Residual BF" (EQ SCANPTR ORIG)) (
PRIN1 " with IVar = ") (PRINTNUM .I7 IVAR)) (T (VSHOWSTACKBLOCK1 SCANPTR "Basic frame" (AND (EQ ORIG 
IVAR) (AND (IEQ (LRSH (VGETBASE (VVAG2 23 SCANPTR) 0) 13) 4) (for I from (VGETBASE (VVAG2 23 SCANPTR) 
1) to (IDIFFERENCE SCANPTR 2) by 2 always (IEQ 0 (LRSH (VGETBASE (VVAG2 23 I) 0) 13)))))))) (SETQ 
SCANPTR (IPLUS SCANPTR 2)))))) (TERPRI) (COND ((IGREATERP SCANPTR EASP) (RETURN))) (AND WAITFLG (READC
 T)) (GO SCAN))))

(VSHOWSTACKBLOCK1

(LAMBDA (PTR STR GOODFLG) (*) (PRINTNUM .I7 PTR) (SPACES 1) (OR GOODFLG (PRIN1 "[bad] ")) (PRIN1 STR))
)

(VPRINCOPY

(LAMBDA (X) (*) (PRINT (V\UNCOPY X))))
)
(DEFINEQ

(V\BACKTRACE

(LAMBDA (IPOS EPOS NAMES VARS LOCALS JUNK ALINKS PRINTFN CNT RADIX) (*) (OR RADIX (SETQ RADIX 8)) (
PROG (NARGS NPVARS NAME ARGNAME BLINK (.I7 (NUMFORMATCODE (LIST (QUOTE FIX) 7 RADIX)))) (DECLARE (
SPECVARS .I7)) POSLP (COND (CNT (printout NIL .I3 CNT ": ") (SETQ CNT (IPLUS CNT 1)))) (SETQ NAME (
VGETBASEPTR (PROGN (COND ((NOT (ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 23 IPOS) 0) 9) 1))) (VVAG2 (
LOGAND (VGETBASE (VVAG2 23 IPOS) 7) 255) (VGETBASE (VVAG2 23 IPOS) 6))) (T (VVAG2 (LOGAND (VGETBASE (
VVAG2 23 IPOS) 3) 255) (VGETBASE (VVAG2 23 IPOS) 2))))) 4)) (COND (JUNK (TERPRI) (TERPRI) (PRIN1 
"Basic frame at ") (PRINTNUM .I7 (SETQ BLINK (COND ((EVENP (VGETBASE (VVAG2 23 IPOS) 1) 2) (
IDIFFERENCE IPOS 2)) (T (VGETBASE (VVAG2 23 IPOS) 8))))) (TERPRI) (V\PRINTBF BLINK (COND ((NOT (ZEROP 
(LOGAND (LRSH (VGETBASE (VVAG2 23 IPOS) 0) 9) 1))) (VVAG2 (LOGAND (VGETBASE (VVAG2 23 IPOS) 7) 255) (
VGETBASE (VVAG2 23 IPOS) 6))) (T (VVAG2 (LOGAND (VGETBASE (VVAG2 23 IPOS) 3) 255) (VGETBASE (VVAG2 23 
IPOS) 2)))) PRINTFN) (PROGN (TERPRI) (PRIN1 "Frame xtn at ") (PRINTNUM .I7 IPOS) (PRIN1 
", frame name= ")) (APPLY* PRINTFN NAME) (V\PRINTFRAME IPOS PRINTFN)) ((OR VARS LOCALS) (V\PRINTBF (
COND ((EVENP (VGETBASE (VVAG2 23 IPOS) 1) 2) (IDIFFERENCE IPOS 2)) (T (VGETBASE (VVAG2 23 IPOS) 8))) (
COND ((NOT (ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 23 IPOS) 0) 9) 1))) (VVAG2 (LOGAND (VGETBASE (VVAG2 
23 IPOS) 7) 255) (VGETBASE (VVAG2 23 IPOS) 6))) (T (VVAG2 (LOGAND (VGETBASE (VVAG2 23 IPOS) 3) 255) (
VGETBASE (VVAG2 23 IPOS) 2)))) PRINTFN (COND (LOCALS (QUOTE LOCALS)) (T T))) (COND (NAMES (APPLY* 
PRINTFN NAME) (TERPRI))) (V\PRINTFRAME IPOS PRINTFN (COND (LOCALS (QUOTE LOCALS)) (T T)))) (NAMES (
APPLY* PRINTFN NAME))) (COND ((AND (NEQ EPOS IPOS) (NOT (ZEROP (PROGN (SETQ IPOS (COND (ALINKS (
IDIFFERENCE (LOGAND (VGETBASE (VVAG2 23 IPOS) 1) (CONSTANT (LOGXOR (SUB1 2) -1))) 10)) (T (IDIFFERENCE
 (COND ((EVENP (VGETBASE (VVAG2 23 IPOS) 1) 2) (VGETBASE (VVAG2 23 IPOS) 1)) (T (VGETBASE (VVAG2 23 
IPOS) 9))) 10)))))))) (GO POSLP))) (RETURN T))))

(V\PRINTBF

(LAMBDA (BL NMT PRINTFN VARSONLY) (*) (bind NM for I from (VGETBASE (VVAG2 23 BL) 1) by 2 as J from 0 
to (SUB1 (IDIFFERENCE (LRSH (IDIFFERENCE BL (VGETBASE (VVAG2 23 BL) 1)) 1) (LOGAND (LRSH (VGETBASE (
VVAG2 23 BL) 0) 8) 1))) do (OR VARSONLY (V\PRINTSTK I)) (COND ((OR (SETQ NM (V\SCANFORNTENTRY (OR NMT 
(RETURN (OR VARSONLY (TERPRI)))) (IPLUS 0 J))) (AND (NEQ VARSONLY T) (SETQ NM (QUOTE *local*)))) (AND 
VARSONLY (SPACES 3)) (PRIN2 NM) (SPACES 1) (APPLY* PRINTFN (VGETBASEPTR (VVAG2 23 0) I)))) finally (OR
 VARSONLY (while (ILESSP I BL) do (V\PRINTSTK I) (printout NIL "[padding]" T) (SETQ I (IPLUS I 2))))) 
(COND ((NOT VARSONLY) (V\PRINTSTK BL) (COND ((NOT (ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 23 BL) 0) 9) 1
))) (PRIN1 "residual "))) (COND ((NEQ (LOGAND (VGETBASE (VVAG2 23 BL) 0) 255) 0) (printout NIL 
"usecnt= " (LOGAND (VGETBASE (VVAG2 23 BL) 0) 255) ,))) (TERPRI)))))

(V\PRINTFRAME

(LAMBDA (FRAME PRINTFN VARSONLY) (*) (PROG ((NMT (COND ((NOT (ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 23 
FRAME) 0) 9) 1))) (VVAG2 (LOGAND (VGETBASE (VVAG2 23 FRAME) 7) 255) (VGETBASE (VVAG2 23 FRAME) 6))) (T
 (VVAG2 (LOGAND (VGETBASE (VVAG2 23 FRAME) 3) 255) (VGETBASE (VVAG2 23 FRAME) 2))))) (I 0) (FT (IPLUS 
(IPLUS FRAME (PROGN 10)) (LLSH (ADD1 ((LAMBDA (X) (DECLARE (LOCALVARS . T)) (COND ((IGREATERP X (SUB1 
(LLSH 1 (SUB1 16)))) (SUB1 (IDIFFERENCE X (SUB1 (LLSH 1 16))))) (T X))) (VGETBASE (PROGN (VVAG2 (
LOGAND (VGETBASE (VVAG2 23 FRAME) 3) 255) (VGETBASE (VVAG2 23 FRAME) 2))) 2))) 2) (PROGN 4))) TMP 
NLOCALS) (COND ((NOT VARSONLY) (V\PRINTSTK FRAME) (PRIN1 "[") (PROGN (PROG ((FAST (NOT (ZEROP (LOGAND 
(LRSH (VGETBASE (VVAG2 23 FRAME) 0) 12) 1))))) (DECLARE (LOCALVARS FAST)) (COND (FAST (PRIN1 (QUOTE 
"F, ")) (SELECTQ (CONSTANT (NTHCHAR (QUOTE "F, ") -1)) (= (printout NIL , FAST NIL)) NIL) T))) (PROG (
(INCALL (NOT (ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 23 FRAME) 0) 10) 1))))) (DECLARE (LOCALVARS INCALL)
) (COND (INCALL (PRIN1 (QUOTE "C, ")) (SELECTQ (CONSTANT (NTHCHAR (QUOTE "C, ") -1)) (= (printout NIL 
, INCALL NIL)) NIL) T))) (PROG ((VALIDNAMETABLE (NOT (ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 23 FRAME) 0
) 9) 1))))) (DECLARE (LOCALVARS VALIDNAMETABLE)) (COND (VALIDNAMETABLE (PRIN1 (QUOTE "V, ")) (SELECTQ 
(CONSTANT (NTHCHAR (QUOTE "V, ") -1)) (= (printout NIL , VALIDNAMETABLE NIL)) NIL) T))) (PROG ((NOPUSH
 (NOT (ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 23 FRAME) 0) 8) 1))))) (DECLARE (LOCALVARS NOPUSH)) (COND 
(NOPUSH (PRIN1 (QUOTE "N, ")) (SELECTQ (CONSTANT (NTHCHAR (QUOTE "N, ") -1)) (= (printout NIL , NOPUSH
 NIL)) NIL) T))) (PROG ((USECNT (LOGAND (VGETBASE (VVAG2 23 FRAME) 0) 255))) (DECLARE (LOCALVARS 
USECNT)) (COND ((NOT (ZEROP USECNT)) (PRIN1 (QUOTE "USE=")) (SELECTQ (CONSTANT (NTHCHAR (QUOTE "USE=")
 -1)) (= (printout NIL , USECNT ", ")) NIL) T))) (PROG ((FASTP (EVENP (VGETBASE (VVAG2 23 FRAME) 1) 2)
)) (DECLARE (LOCALVARS FASTP)) (COND ((NOT FASTP) (PRIN1 (QUOTE "X, ")) (SELECTQ (CONSTANT (NTHCHAR (
QUOTE "X, ") -1)) (= (printout NIL , FASTP NIL)) NIL) T))) (PROG ((ALINK (IDIFFERENCE (LOGAND (
VGETBASE (VVAG2 23 FRAME) 1) (CONSTANT (LOGXOR (SUB1 2) -1))) 10))) (DECLARE (LOCALVARS ALINK)) (COND 
(T (PRIN1 (QUOTE " alink]")) (SELECTQ (CONSTANT (NTHCHAR (QUOTE " alink]") -1)) (= (printout NIL , 
ALINK NIL)) NIL) T)))) (TERPRI) (PROGN (V\PRINTSTK (IPLUS FRAME 2)) (PROGN (PROG ((FNHEADER (VVAG2 (
LOGAND (VGETBASE (VVAG2 23 FRAME) 3) 255) (VGETBASE (VVAG2 23 FRAME) 2)))) (DECLARE (LOCALVARS 
FNHEADER)) (COND (T (PRIN1 (QUOTE "[fn header]")) (SELECTQ (CONSTANT (NTHCHAR (QUOTE "[fn header]") -1
)) (= (printout NIL , FNHEADER NIL)) NIL) T)))) (TERPRI)) (PROGN (V\PRINTSTK (IPLUS FRAME 4)) (PROGN (
PROG ((NEXTBLOCK (VGETBASE (VVAG2 23 FRAME) 4))) (DECLARE (LOCALVARS NEXTBLOCK)) (COND (T (PRIN1 (
QUOTE "[next, pc]")) (SELECTQ (CONSTANT (NTHCHAR (QUOTE "[next, pc]") -1)) (= (printout NIL , 
NEXTBLOCK NIL)) NIL) T)))) (TERPRI)) (PROGN (V\PRINTSTK (IPLUS FRAME 6)) (PROGN (PROG ((NAMETABLE (
COND ((NOT (ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 23 FRAME) 0) 9) 1))) (VVAG2 (LOGAND (VGETBASE (VVAG2 
23 FRAME) 7) 255) (VGETBASE (VVAG2 23 FRAME) 6))) (T (VVAG2 (LOGAND (VGETBASE (VVAG2 23 FRAME) 3) 255)
 (VGETBASE (VVAG2 23 FRAME) 2)))))) (DECLARE (LOCALVARS NAMETABLE)) (COND (T (PRIN1 (QUOTE 
"[nametable]")) (SELECTQ (CONSTANT (NTHCHAR (QUOTE "[nametable]") -1)) (= (printout NIL , NAMETABLE 
NIL)) NIL) T)))) (TERPRI)) (PROGN (V\PRINTSTK (IPLUS FRAME 8)) (PROGN (PROG ((BLINK (COND ((EVENP (
VGETBASE (VVAG2 23 FRAME) 1) 2) (IDIFFERENCE FRAME 2)) (T (VGETBASE (VVAG2 23 FRAME) 8))))) (DECLARE (
LOCALVARS BLINK)) (COND (T (PRIN1 (QUOTE "[blink, clink]")) (SELECTQ (CONSTANT (NTHCHAR (QUOTE 
"[blink, clink]") -1)) (= (printout NIL , BLINK NIL)) NIL) T)))) (TERPRI)))) (SETQ NLOCALS (LRSH (
VGETBASE NMT 7) 8)) (for old I from (IPLUS FRAME (PROGN 10)) by 2 while (ILESSP I FT) as J from 0 do (
OR VARSONLY (V\PRINTSTK I)) (COND ((ILESSP J NLOCALS) (COND ((OR (SETQ TMP (V\SCANFORNTENTRY NMT (
IPLUS 32768 J))) (AND (NEQ VARSONLY T) (SETQ TMP (QUOTE *local*)))) (COND ((ZEROP (LRSH (VGETBASE (
PROGN (VVAG2 23 I)) 0) 8)) (AND VARSONLY (SPACES 3)) (PRIN2 TMP) (SPACES 1) (APPLY* PRINTFN (
VGETBASEPTR (VVAG2 23 0) I))) ((NOT VARSONLY) (printout NIL TMP " [unbound]" T)))))) ((NOT VARSONLY) (
COND ((SETQ TMP (V\SCANFORNTENTRY NMT (IPLUS 49152 J))) (printout NIL "[fvar " .P2 TMP " " (COND ((
EVENP (VGETBASE (PROGN (VVAG2 23 I)) 0)) (COND ((EQ (SETQ TMP (VHILOC ((LAMBDA ($$1) (VVAG2 (LRSH (
VGETBASE (PROGN $$1) 1) 8) (VGETBASE $$1 0))) (VVAG2 23 I)))) 23) " on stack]") ((NEQ TMP (VHILOC (
VVAG2 18 0))) " non-stack binding]") (T " top value]"))) (T " not looked up]")) T)) (T (printout NIL 
"[padding]" T)))))) (COND ((NOT VARSONLY) (SETQ FT (VGETBASE (VVAG2 23 FRAME) 4)) (for old I by 2 
while (ILESSP I FT) do (V\PRINTSTK I) (COND ((ZEROP (LRSH (VGETBASE (PROGN (VVAG2 23 I)) 0) 8)) (
APPLY* PRINTFN (VGETBASEPTR (VVAG2 23 0) I))) (T (TERPRI)))))))))

(V\SCANFORNTENTRY

(LAMBDA (NMT NTENTRY) (*) (bind NM for NT1 from (PROGN 8) as NT2 from (IPLUS (PROGN 8) (VGETBASE NMT 6
)) do (COND ((ZEROP (SETQ NM (VGETBASE NMT NT1))) (RETURN))) (COND ((IEQ NTENTRY (VGETBASE NMT NT2)) (
RETURN (VATOM NM)))))))

(V\PRINTSTK

(LAMBDA (I) (*) (PRINTNUM .I7 I) (PRIN1 ": ") (PRINTNUM .I7 (VGETBASE (VVAG2 23 0) I)) (PRINTNUM .I7 (
VGETBASE (VVAG2 23 0) (ADD1 I))) (SPACES 1)))
)
(DEFINEQ

(VDPRINTCODE

(LAMBDA (FN LVFLG RADIX OUTF FIRSTBYTE) (*) (DECLARE (GLOBALVARS \INITSUBRS FVA STKA) (SPECVARS OUTF))
 (OR RADIX (SETQ RADIX 8)) (PROG ((CA (OR (VGETDEFN FN) (ERROR FN "not compiled code"))) PVARS FVARS 
IVARS NTSIZE STARTPC TAG TEMP OP# (REMOTEFLG T) (I4 (NUMFORMATCODE (LIST (QUOTE FIX) 4 RADIX))) (I6 (
NUMFORMATCODE (LIST (QUOTE FIX) 6 RADIX)))) (DECLARE (SPECVARS CA IVARS PVARS FVARS I4 I6)) (PROGN (
PRIN1 " stkmin: " OUTF) (PRINTNUM I6 ((LAMBDA (DEF LC) (IPLUS (LLSH (VGETBASEBYTE DEF LC) 8) (
VGETBASEBYTE DEF (ADD1 LC)))) CA 0) OUTF) (PRIN1 " na: " OUTF) (PRINTNUM I4 ((LAMBDA (X) (DECLARE (
LOCALVARS . T)) (COND ((IGREATERP X (SUB1 (LLSH 1 (SUB1 16)))) (SUB1 (IDIFFERENCE X (SUB1 (LLSH 1 16))
))) (T X))) ((LAMBDA (DEF LC) (IPLUS (LLSH (VGETBASEBYTE DEF LC) 8) (VGETBASEBYTE DEF (ADD1 LC)))) CA 
2)) OUTF) (PRIN1 " pv: " OUTF) (PRINTNUM I4 ((LAMBDA (X) (DECLARE (LOCALVARS . T)) (COND ((IGREATERP X
 (SUB1 (LLSH 1 (SUB1 16)))) (SUB1 (IDIFFERENCE X (SUB1 (LLSH 1 16))))) (T X))) ((LAMBDA (DEF LC) (
IPLUS (LLSH (VGETBASEBYTE DEF LC) 8) (VGETBASEBYTE DEF (ADD1 LC)))) CA 4)) OUTF) (PRIN1 " startpc: " 
OUTF) (PRINTNUM I4 (SETQ STARTPC ((LAMBDA (DEF LC) (IPLUS (LLSH (VGETBASEBYTE DEF LC) 8) (VGETBASEBYTE
 DEF (ADD1 LC)))) CA 6)) OUTF) (PRIN1 " argtype: " OUTF) (PRIN1 (LOGAND (LRSH (VGETBASEBYTE CA 8) 4) 3
) OUTF) (PRIN1 " framename: " OUTF) (PRIN1 (V\UNCOPY (VVAG2 (VGETBASEBYTE CA 9) ((LAMBDA (DEF LC) (
IPLUS (LLSH (VGETBASEBYTE DEF LC) 8) (VGETBASEBYTE DEF (ADD1 LC)))) CA 10))) OUTF) (PRIN1 " ntsize: " 
OUTF) (PRINTNUM I4 (SETQ NTSIZE ((LAMBDA (DEF LC) (IPLUS (LLSH (VGETBASEBYTE DEF LC) 8) (VGETBASEBYTE 
DEF (ADD1 LC)))) CA 12)) OUTF) (PRIN1 " nlocals: " OUTF) (PRINTNUM I4 (VGETBASEBYTE CA 14) OUTF) (
TERPRI OUTF)) (for I from 0 by 2 while (ILESSP I (LLSH (PROGN 8) 1)) do (PRINTNUM I4 I OUTF) (PRIN1 
": " OUTF) (PRINTNUM I6 ((LAMBDA (DEF LC) (IPLUS (LLSH (VGETBASEBYTE DEF LC) 8) (VGETBASEBYTE DEF (
ADD1 LC)))) CA I) OUTF) (TERPRI OUTF)) (VPRINTCODENT "name table: " (LLSH (PROGN 8) 1) (LLSH NTSIZE 1)
) (VPRINTCODENT "Local args: " (SETQ TEMP (IPLUS (LLSH (PROGN 8) 1) (COND ((ZEROP NTSIZE) (*) 8) (T (
LLSH NTSIZE 2))))) (LRSH (IDIFFERENCE STARTPC TEMP) 1)) (printout OUTF T "----" T) (PROG ((CODELOC 
STARTPC) B B1 B2 B3 FN LEN LEVADJ STK (LEVEL (AND LVFLG 0))) (COND (LEVEL (SETUPHASHARRAY (QUOTE FVA))
 (SETUPHASHARRAY (QUOTE STKA)) (CLRHASH FVA) (CLRHASH STKA))) LP (COND ((OR (NULL FIRSTBYTE) (IGEQ 
CODELOC FIRSTBYTE)) (PRINTNUM I4 CODELOC OUTF) (PRIN1 ": " OUTF) (COND (LVFLG (SETQ TEMP (GETHASH 
CODELOC FVA)) (COND (LEVEL (COND ((AND TEMP (OR (NEQ LEVEL TEMP) (NOT (EQUAL STK (GETHASH CODELOC STKA
))))) (PRIN1 "*" OUTF)))) (T (SETQ LEVEL TEMP) (SETQ STK (GETHASH CODELOC STKA)))) (COND (LEVEL (TAB 7
 NIL OUTF) (PRINTNUM I4 LEVEL OUTF))))) (TAB 12 NIL OUTF)) (T (*) (SETQ TAG (V\FINDOP (VGETBASEBYTE CA
 (PROG1 CODELOC (SETQ CODELOC (IPLUS CODELOC 1)))))) (SELECTQ (OR (fetch OPPRINT of TAG) (fetch 
OPCODENAME of TAG)) (-X- (TERPRI OUTF) (RETURN)) (BIND (COND (LEVEL (push STK (SETQ LEVEL (ADD1 (
IDIFFERENCE LEVEL (LOGAND (CODELT CA CODELOC) 15)))))))) (UNBIND (AND LEVEL (SETQ LEVEL (pop STK)))) (
DUNBIND (AND LEVEL (SETQ LEVEL (SUB1 (pop STK))))) (RETURN (SETQ LEVEL)) (SUBRCALL (AND LEVEL (SETQ 
LEVEL (ADD1 (IDIFFERENCE LEVEL (VGETBASEBYTE CA (ADD1 CODELOC))))))) NIL) (COND ((AND LEVEL (SETQ 
LEVADJ (fetch LEVADJ of TAG))) (SELECTQ LEVADJ (FNX (SETQ LEVEL (IPLUS LEVEL (IDIFFERENCE 1 (
VGETBASEBYTE CA CODELOC))))) (JUMP (SETQ LEVEL)) ((CJUMP NCJUMP) (SETQ LEVEL (IPLUS LEVEL -1))) (COND 
((NUMBERP LEVADJ) (SETQ LEVEL (IPLUS LEVEL LEVADJ))))))) (add CODELOC (fetch OPNARGS of TAG)) (GO LP))
) (SETQ LEN (fetch OPNARGS of (SETQ TAG (V\FINDOP (SETQ B (VGETBASEBYTE CA (PROG1 CODELOC (SETQ 
CODELOC (IPLUS CODELOC 1))))))))) (PRINTNUM I4 B OUTF) (COND ((IGREATERP LEN 0) (PRINTNUM I4 (SETQ B1 
(VGETBASEBYTE CA (PROG1 CODELOC (SETQ CODELOC (IPLUS CODELOC 1))))) OUTF))) (COND ((IGREATERP LEN 1) (
PRINTNUM I4 (SETQ B2 (VGETBASEBYTE CA (PROG1 CODELOC (SETQ CODELOC (IPLUS CODELOC 1))))) OUTF))) (AND 
(IGREATERP LEN 2) (PRINTNUM I4 (SETQ B3 (VGETBASEBYTE CA (PROG1 CODELOC (SETQ CODELOC (IPLUS CODELOC 1
))))) OUTF)) (PROGN (printout OUTF 30 (fetch OPCODENAME of TAG)) (SETQ OP# (fetch OP# of TAG)) (SETQ 
LEVADJ (fetch LEVADJ of TAG))) (SELECTQ (OR (fetch OPPRINT of TAG) (fetch OPCODENAME of TAG)) (-X- (
TERPRI OUTF) (RETURN)) (IVAR (TAB 40 NIL OUTF) (PROGN (*) (PROG NIL (PRIN2 (CADR (OR (ASSOC (SELECTQ 
LEN (0 (IDIFFERENCE B OP#)) (LRSH B1 1)) IVARS) (RETURN (printout OUTF "[" (QUOTE ivar) (SELECTQ LEN (
0 (IDIFFERENCE B OP#)) (LRSH B1 1)) "]")))) OUTF)))) (PVAR (TAB 40 NIL OUTF) (PROGN (*) (PROG NIL (
PRIN2 (CADR (OR (ASSOC (SELECTQ LEN (0 (IDIFFERENCE B OP#)) (LRSH B1 1)) PVARS) (RETURN (printout OUTF
 "[" (QUOTE pvar) (SELECTQ LEN (0 (IDIFFERENCE B OP#)) (LRSH B1 1)) "]")))) OUTF)))) (FVAR (TAB 40 NIL
 OUTF) (PROGN (*) (PROG NIL (PRIN2 (CADR (OR (ASSOC (SELECTQ LEN (0 (IDIFFERENCE B OP#)) (LRSH B1 1)) 
FVARS) (RETURN (printout OUTF "[" (QUOTE fvar) (SELECTQ LEN (0 (IDIFFERENCE B OP#)) (LRSH B1 1)) "]"))
)) OUTF)))) (JUMP ((LAMBDA (N) (PRIN1 "->" OUTF) (PRINTNUM I4 (SETQ N (IPLUS N (IDIFFERENCE CODELOC (
ADD1 LEN)))) OUTF) (COND (LEVEL (PUTHASH N (SELECTQ LEVADJ ((NCJUMP JUMP) LEVEL) (SUB1 LEVEL)) FVA) (
PUTHASH N STK STKA)))) (IPLUS (IDIFFERENCE B OP#) 2))) (SIC (printout OUTF 40 .P2 B1)) (SNIC (printout
 OUTF 40 .P2 (IDIFFERENCE B1 256))) (SICX (printout OUTF 40 .P2 (IPLUS (LLSH B1 8) B2))) (JUMPX ((
LAMBDA (N) (PRIN1 "->" OUTF) (PRINTNUM I4 (SETQ N (IPLUS N (IDIFFERENCE CODELOC (ADD1 LEN)))) OUTF) (
COND (LEVEL (PUTHASH N (SELECTQ LEVADJ ((NCJUMP JUMP) LEVEL) (SUB1 LEVEL)) FVA) (PUTHASH N STK STKA)))
) (COND ((IGEQ B1 128) (IDIFFERENCE B1 256)) (T B1)))) (FN (SETQ B (IPLUS (LLSH B1 8) B2)) (printout 
OUTF 40 (VATOM B))) (BIND (TAB 40 NIL OUTF) (PROG ((NNILS (LRSH B1 4)) (NVALS (LOGAND B1 15))) (for I 
from (ADD1 (IDIFFERENCE B2 (IPLUS NNILS NVALS))) to (IDIFFERENCE B2 NNILS) do (SPACES 1 OUTF) (PCVAR I
 PVARS (QUOTE pvar))) (PRIN1 (QUOTE ;) OUTF) (for I from (ADD1 (IDIFFERENCE B2 NNILS)) to B2 do (
SPACES 1 OUTF) (PCVAR I PVARS (QUOTE pvar))) (COND (LEVEL (push STK (SETQ LEVEL (ADD1 (IDIFFERENCE 
LEVEL NVALS)))))))) (JUMPXX ((LAMBDA (N) (PRIN1 "->" OUTF) (PRINTNUM I4 (SETQ N (IPLUS N (IDIFFERENCE 
CODELOC (ADD1 LEN)))) OUTF) (COND (LEVEL (PUTHASH N (SELECTQ LEVADJ ((NCJUMP JUMP) LEVEL) (SUB1 LEVEL)
) FVA) (PUTHASH N STK STKA)))) (IPLUS (LLSH B1 8) B2 (COND ((IGREATERP B1 127) -65536) (T 0))))) (ATOM
 (printout OUTF 40 .P2 (VATOM (IPLUS (LLSH B1 8) B2)))) (GCONST (printout OUTF 40 .P2 (V\UNCOPY (VVAG2
 B1 (IPLUS (LLSH B2 8) B3))))) (FNX (printout OUTF "(" B1 ")" 40 (VATOM (IPLUS (LLSH B2 8) B3)))) (
TYPEP (printout OUTF "(" (COND ((EQ B1 6) (QUOTE ARRAYP)) ((EQ B1 7) (QUOTE STRINGP)) ((EQ B1 3) (
QUOTE FLOATP)) ((EQ B1 1) (QUOTE SMALLP)) ((EQ B1 8) (QUOTE STACKP)) ((EQ B1 2) (QUOTE 2)) ((EQ B1 4) 
(QUOTE 4)) (T (QUOTE ?))) ")")) (UNBIND (AND LEVEL (SETQ LEVEL (pop STK)))) (DUNBIND (AND LEVEL (SETQ 
LEVEL (SUB1 (pop STK))))) (RETURN (SETQ LEVEL)) (SUBRCALL (printout OUTF 40 .P2 (CAR (NTH \INITSUBRS (
ADD1 B1)))) (AND LEVEL (SETQ LEVEL (ADD1 (IDIFFERENCE LEVEL B2))))) NIL) (TERPRI OUTF) (COND ((AND 
LEVEL LEVADJ) (SELECTQ LEVADJ (FNX (SETQ LEVEL (IPLUS LEVEL (IDIFFERENCE 1 B1)))) (JUMP (SETQ LEVEL)) 
((CJUMP NCJUMP) (SETQ LEVEL (IPLUS LEVEL -1))) (COND ((NUMBERP LEVADJ) (SETQ LEVEL (IPLUS LEVEL LEVADJ
))))))) (GO LP)))))

(VPRINTCODENT

(LAMBDA (STR START1 START2) (*) (DECLARE (USEDFREE CA IVARS PVARS FVARS I4 I6 OUTF)) (PROG (NAME TAG) 
(COND ((ILESSP START1 (SETQ START2 (IPLUS START2 START1))) (printout OUTF STR T) (for NT1 from START1 
by 2 while (ILESSP NT1 START2) as NT2 from START2 by 2 do (PRINTNUM I4 NT1 OUTF) (PRIN1 ": " OUTF) (
PRINTNUM I6 ((LAMBDA (DEF LC) (IPLUS (LLSH (VGETBASEBYTE DEF LC) 8) (VGETBASEBYTE DEF (ADD1 LC)))) CA 
NT1) OUTF) (SPACES 3 OUTF) (PRINTNUM I4 NT2 OUTF) (PRIN1 ": " OUTF) (PRINTNUM I6 ((LAMBDA (DEF LC) (
IPLUS (LLSH (VGETBASEBYTE DEF LC) 8) (VGETBASEBYTE DEF (ADD1 LC)))) CA NT2) OUTF) (COND ((SETQ NAME (
VATOM ((LAMBDA (DEF LC) (IPLUS (LLSH (VGETBASEBYTE DEF LC) 8) (VGETBASEBYTE DEF (ADD1 LC)))) CA NT1)))
 (SETQ TAG (VGETBASEBYTE CA (ADD1 NT2))) (printout OUTF .SP 5 (SELECTC (VGETBASEBYTE CA NT2) ((LRSH 0 
8) (push IVARS (LIST TAG NAME)) (QUOTE IVAR)) ((LRSH 32768 8) (push PVARS (LIST TAG NAME)) (QUOTE PVAR
)) (PROGN (push FVARS (LIST TAG NAME)) (QUOTE FVAR))) " " TAG ": " NAME))) (TERPRI OUTF)))))))

(VBROKENDEF

(LAMBDA (CA WHEN) (*) (PROG (BEFORE AFTER SIZE FB OP OFFSET NEWCA OPCODE TAG) (PROGN (SETQ FB ((LAMBDA
 (DEF LC) (IPLUS (LLSH (VGETBASEBYTE DEF LC) 8) (VGETBASEBYTE DEF (ADD1 LC)))) (PROGN (PROGN (SETQ 
NEWCA (SETQ CA 8 u 3 2 1 %. - , J  S (GO DOCOPY))) (SELECTQ WHEN (BEFORE (SETQ BEFORE T)) (AFTER (
SETQ AFTER T)) ((NIL BOTH) (SETQ BEFORE T) (SETQ AFTER T)) (LISPERROR "ILLEGAL ARG" WHEN)) (SETQ SIZE 
(ARRAYSIZE CA)) (SETQ OFFSET (COND (BEFORE 3) (T 0))) (SETQ FB ((LAMBDA (DEF LC) (IPLUS (LLSH (
VGETBASEBYTE DEF LC) 8) (VGETBASEBYTE DEF (ADD1 LC)))) CA 6)) (SETQ NEWCA (\CODEARRAY (COND (BEFORE (
IP PERQUAD))) DOCOPY (for I from 0 to (SUB1 FB) do (VPUTBASEBYTE NEWCA I (VGETBASEBYTE CA I))) (*) (
COND (BEFORE (*) (VPUTBASEBYTE NEWCA FB (V\CAR.UFN (V\FINDOP (QUOTE 'NIL)))) (VPUTBASEBYTE NEWCA (ADD1
 FB) (V\CAR.UFN (V\FINDOP (QUOTE HELP)))) (VPUTBASEBYTE NEWCA (IPLUS FB 2) (V\CAR.UFN (V\FINDOP (QUOTE
 POP)))))) (do (SETQ OP (VGETBASEBYTE CA FB)) (SETQ TAG (V\FINDOP OP)) (VPUTBASEBYTE NEWCA (IPLUS FB 
OFFSET) (SELECTQ (CADR TAG) (-X- (RETURN)) (RETURN (COND (AFTER (V\CAR.UFN (V\FINDOP (QUOTE \RETURN)))
) (T OP))) OP)) (FRPTQ (CADDR TAG) (VPUTBASEBYTE NEWCA (IPLUS (SETQ FB (IPLUS FB 1)) OFFSET) (
VGETBASEBYTE CA FB))) (SETQ FB (IPLUS FB 1))) (RETURN NEWCA))))) 6))) (DEFINEQ (SUBFNDEF (LAMBDA (X) (
*) (AND (LITATOM X) (EQ (NTHCHAR X -5) (QUOTE A)) (EQ (NTHCHAR X -4) 0) (VGETDEFN X))))) (DECLARE: 
DONTCOPY (ADDTOVAR RDCOMS (FNS VDPRINTCODE VPRINTCODENT VBROKENDEF) (MACROS PCVAR)) (ADDTOVAR 
RD.SUBFNS (VGETDEFN . VGETDEFN) (VGETBASEBYTE . VGETBASEBYTE)) (ADDTOVAR EXPANDMACROFNS NEXTBYTE PCVAR
 PRINJUMP)) (*) (DEFINEQ (PRINTOPCODES (LAMBDA (START LAST) (*) (printout NIL "  #" 9 "name" 24 
"len-1" 34 "format" 43 "stk effect" 55 "UFN table entry" T T) (OR LAST (SETQ LAST 255)) (for X in (
COND (START (find TAIL on \OPCODES suchthat (IGEQ (V\CAR.UFN (V\CAR.UFN TAIL)) START))) (T \OPCODES)) 
until (IGREATERP (V\CAR.UFN X) LAST) do (3 2 1 %. - , J  S LAST of X) (printout NIL "-" .I3.8 (CADDDR
 (CDDR X))))) 9 (CADR X)) (COND ((NEQ (CADR X) (QUOTE unused)) (printout NIL 26 (OR (CADDR X) (QUOTE ?
)) 35 (OR (CADDDR X) (QUOTE ?)) 44 (OR (CADDDR (V\CDR.UFN X)) (QUOTE ?)) 55 (OR (CADDDR (CDDDR X)) "")
))) (TERPRI)))))
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS PCVAR MACRO
 ((IND LST NAME) (* lmm "11-AUG-81 22:27") (PROG NIL (PRIN2 (CADR (OR (ASSOC IND 
LST) (RETURN (printout OUTF "[" NAME IND "]")))) OUTF))))
)
(DEFINEQ

(V\CAR.UFN

(LAMBDA (X) (*) (*) (COND ((VLISTP X) (COND ((ZEROP 1) (VGETBASEPTR X 0)) (T (COND ((EQ (LRSH (
VGETBASE X 0) 8) 0) (VGETBASEPTR (VGETBASEPTR X 0) 0)) (T (VGETBASEPTR X 0)))))) ((NULL X) NIL) (
CAR/CDRERR (LISPERROR "ARG NOT LIST" X)) ((EQ X T) T) ((LITATOM X) NIL) (T (QUOTE "{car of non-list}")
))))

(V\CDR.UFN

(LAMBDA (X) (*) (*) (COND ((VLISTP X) (COND ((ZEROP 1) (VGETBASEPTR X 2)) (T (PROG ((Q (LRSH (VGETBASE
 X 0) 8))) (RETURN (COND ((EQ Q 128) NIL) ((IGREATERP Q 128) (VADDBASE (VVAG2 (VHILOC X) (LOGAND (
VLOLOC X) 65280)) (LLSH (IDIFFERENCE Q 128) 1))) ((EQ Q 0) (V\CDR.UFN (VGETBASEPTR X 0))) (T (
VGETBASEPTR (VADDBASE (VVAG2 (VHILOC X) (LOGAND (VLOLOC X) 65280)) (LLSH Q 1)) 0)))))))) ((NULL X) NIL
) (CAR/CDRERR (LISPERROR "ARG NOT LIST" X)) ((LITATOM X) (VGETPROPLIST X)) (T "{cdr of non-list}"))))
)
(DEFINEQ

(V\COPY

(LAMBDA (X) (*) (*) (SELECTQ (TYPENAME X) (LITATOM (VATOMNUMBER X T)) (VLISTP (PROG ((R (REVERSE X)) (
V (V\COPY (CDR (LAST X))))) LP (COND ((LISTP R) (SETQ V (VCONS (V\COPY (CAR R)) V)) (SETQ R (CDR R)) (
GO LP))) (RETURN V))) ((FIXP SMALLP) (PROG (V) (COND ((IGREATERP 0 X) (*) (COND ((IGREATERP X -65537) 
(*) (RETURN (VADDBASE (VVAG2 15 0) (LOGAND X 65535)))))) ((ILESSP X 65536) (*) (RETURN (VADDBASE (
VVAG2 14 0) X)))) (*) (SETQ V (VCREATECELL 2)) (VPUTBASE V 0 (LOGOR (COND ((IGREATERP 0 X) 32768) (T 0
)) (LOGAND (LRSH X 16) 32767))) (VPUTBASE V 1 (LOGAND X 65535)) (RETURN V))) (STRINGP (VCOPYSTRING X))
 (FLOATP (PROG ((VAL (VCREATECELL 3))) (SELECTQ (SYSTEMTYPE) ((ALTO D) (VPUTBASE VAL 0 (\GETBASE X 0))
 (VPUTBASE VAL 1 (\GETBASE X 1))) (MKI.IEEE X VAL)) (RETURN VAL))) (ERROR X (QUOTE (can't be copied to
 remote file))))))

(V\UNCOPY

(LAMBDA (X) (*) (PROG ((TYP (VNTYPX X))) (RETURN (COND ((EQ TYP 1) (COND ((EQ (VHILOC X) (CONSTANT 14)
) (VLOLOC X)) (T (IPLUS (VLOLOC X) -65536)))) ((EQ TYP 2) (*) (IPLUS (LLSH (VGETBASE X 0) 16) (
VGETBASE X 1))) ((EQ TYP 4) (VATOM (VLOLOC X))) ((EQ TYP 7) (PROG (STR (OFFST (VGETBASE X 3)) (I 1) (
PTR (VGETBASEPTR X 0)) (LENGTH (VGETBASE X 2))) (SETQ STR (ALLOCSTRING LENGTH)) (FRPTQ LENGTH (
RPLSTRING STR I (FCHARACTER (V\GETBASEBYTE PTR OFFST))) (SETQ I (IPLUS I 1)) (SETQ OFFST (IPLUS OFFST 
1))) (RETURN STR))) ((EQ TYP 5) (CONS (V\UNCOPY (V\CAR.UFN X)) (V\UNCOPY (V\CDR.UFN X)))) ((ZEROP TYP)
 (LIST (QUOTE #) (VHILOC X) (VLOLOC X))) (T (LIST (VTYPENAME X) (VHILOC X) (VLOLOC X))))))))
)
(DEFINEQ

(V\GETBASEBYTE

(LAMBDA (PTR N) (*) (*) (COND ((ZEROP (LOGAND N 1)) (LRSH (PROGN (VGETBASE PTR (LRSH N 1))) 8)) (T (
LOGAND (PROGN (VGETBASE PTR (LRSH N 1))) 255)))))

(V\PUTBASEBYTE

(LAMBDA (PTR DISP BYTE) (*) (*) (VPUTBASE PTR (LRSH DISP 1) (SELECTQ (LOGAND DISP 1) (0 ((LAMBDA ($$1)
 (IPLUS (LLSH (SETQ BYTE (PROG1 BYTE)) 8) (LOGAND $$1 255))) (VGETBASE PTR (LRSH DISP 1)))) ((LAMBDA (
$$1) (IPLUS (LLSH (LRSH $$1 8) 8) BYTE)) (VGETBASE PTR (LRSH DISP 1))))) BYTE))
)
(DEFINEQ

(VNTYPX

(LAMBDA (X) (*) (*) (LOGAND (VGETBASE (VVAG2 22 32768) (LRSH (IPLUS (LLSH (VHILOC X) 8) (LRSH (VLOLOC 
X) 8)) 1)) 255)))

(VTYPENAME

(LAMBDA (DATUM) (*) (PROG ((N (VNTYPX DATUM))) (RETURN (SELECTC N (6 ((LAMBDA (X) (QUOTE ARRAYP)) 
DATUM)) (VATOM (VGETBASE (VADDBASE (VVAG2 22 43008) (LLSH N 4)) 0)))))))
)
(DEFINEQ

(VCOPYATOM

(LAMBDA (X) (*) (*) (PROG ((N (NCHARS X)) (BASE (VGETBASEPTR \SCRATCHSTRING 0)) (OFFST (VGETBASE 
\SCRATCHSTRING 3))) (for I from 1 to N do (V\PUTBASEBYTE BASE (IPLUS OFFST I -1) (NTHCHARCODE X I))) (
RETURN (VATOMNUMBER (V\MKATOM BASE OFFST N))))))

(VUNCOPYATOM

(LAMBDA (N) (*) (*) (COND ((AND VAtomFrLst (IGEQ N VAtomFrLst)) (CONCAT "ATOM#" N)) (T (PROG ((ADDR (
VGETBASEPTR (VVAG2 16 0) (LLSH N 1))) LEN (STR (OR COPYATOMSTR (SETQ COPYATOMSTR (ALLOCSTRING 255)))))
 (SETQ LEN (V\GETBASEBYTE ADDR 0)) (for I from 1 to LEN do (RPLSTRING COPYATOMSTR I (FCHARACTER (
V\GETBASEBYTE ADDR I)))) (RETURN (SUBATOM COPYATOMSTR 1 LEN)))))))

(V\MKATOM

(LAMBDA (BASE OFFST LEN) (*) (PROG ((L 1) (H 0) H1 P Q C) (COND ((ZEROP LEN) (GO LP))) (SETQ C (
NTHCHARCODE BASE OFFST)) (PROGN NIL NIL) (*) (SETQ H C) HASH (COND ((NEQ L LEN) (SETQ H (LOGAND (IPLUS
 (IPLUS (LOGAND (SETQ H1 (IPLUS H (LLSH (LOGAND H 4095) 2))) 32767) (LLSH (LOGAND H1 127) 8)) (
NTHCHARCODE BASE (IPLUS OFFST L))) 32767)) (SETQ L (ADD1 L)) (GO HASH))) (*) LP (COND ((NEQ (SETQ P (
VGETBASE (VVAG2 20 0) H)) 0) (COND ((EQ (VATOM (SETQ Q (SUB1 P))) BASE) (RETURN Q)) (T (SETQ H (LOGAND
 (IPLUS H 19) 32767)) (GO LP))))) (*) (RETURN (ERROR! BASE OFFST LEN H)))))

(VGETTOPVAL

(LAMBDA (X) (*) (PROG NIL (COND ((NOT (LITATOM (OR X (RETURN)))) (LISPERROR "ARG NOT LITATOM" X)) (T (
RETURN (VGETBASEPTR (VADDBASE (VVAG2 18 0) (LLSH (PROGN (VATOMNUMBER X)) 1)) 0)))))))

(VGETPROPLIST

(LAMBDA (ATM) (*) (VGETBASEPTR (VADDBASE (VVAG2 19 0) (LLSH (VATOMNUMBER (PROGN (\DTEST ATM (QUOTE 
LITATOM)))) 1)) 0)))

(VSETTOPVAL

(LAMBDA (ATM VAL) (*) (COND ((NOT (LITATOM ATM)) (LISPERROR "ARG NOT LITATOM" ATM)) (T (SELECTQ ATM (
NIL (AND VAL (LISPERROR "ATTEMPT TO SET NIL OR T" VAL))) (T (OR (EQ VAL T) (LISPERROR 
"ATTEMPT TO SET NIL OR T" VAL))) (VPUTBASEPTR (VADDBASE (VVAG2 18 0) (LLSH (PROGN (VATOMNUMBER ATM)) 1
)) 0 (V\COPY VAL)))))))

(VGETDEFN

(LAMBDA (A) (*) (VGETBASEPTR (VADDBASE (VVAG2 17 0) (LLSH (VATOMNUMBER A) 1)) 0)))

(V\SMASHATOM

(LAMBDA (A) (*) (LRSH ((LAMBDA ($$PUTBITS) (VPUTBASE $$PUTBITS 0 (LOGOR (LOGAND (VGETBASE $$PUTBITS 0)
 255) (LLSH 0 8)))) (VGETBASEPTR (VADDBASE (VVAG2 16 0) (LLSH (VATOMNUMBER A) 1)) 0)) 8)))
)
(DEFINEQ

(VLISTP

(LAMBDA (X) (*) (*) (AND (EQ (VNTYPX X) 5) X)))
)

(RPAQQ COPYATOMSTR
 NIL)
(DEFINEQ

(V\FINDOP

(LAMBDA (OPNAME FLG) (*) (PROGN (OR \OPCODEARRAY (PROGN (SETQ \OPCODEARRAY (ARRAY 256)) (for X in 
\OPCODES do (PUTPROP (fetch OPCODENAME of X) (QUOTE DOPCODE) X) (for I from (fetch OP# of X) to (OR (
fetch OPLAST of X) (fetch OP# of X)) by 1 do (SETA \OPCODEARRAY (ADD1 I) X))))) (OR (COND ((LITATOM 
OPNAME) (GETPROP OPNAME (QUOTE DOPCODE))) ((FIXP OPNAME) (ELT \OPCODEARRAY (ADD1 OPNAME)))) (AND FLG (
ERROR OPNAME FLG))))))
)

(RPAQQ \OPCODES
 ((248 FLOATBLT 0 T -4 NIL \FLOATBLT) (249 FFTSTEP 0 T -1 NIL \FFTSTEP) (250 unused NIL
 NIL NIL 252) (0 -X- 0) (1 CAR 0 T 0 NIL \CAR.UFN) (2 CDR 0 T 0 NIL \CDR.UFN) (3 LISTP 0 T 0 NIL LISTP
) (4 NTYPX 0 T 0 NIL NTYPX) (5 TYPEP 1 TYPEP 0) (6 DTEST 2 ATOM 0 NIL \DTESTFAIL) (7 CDDR 0 T 0 NIL 
CDDR) (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 NIL \CHECKAPPLY*) (16 RETURN 0 T 0 NIL \HARDRETURN) (17
 BIND 2) (18 UNBIND 0) (19 DUNBIND 0) (20 RPLPTR.N 1 T -1 NIL \RPLPTR.UFN) (21 GCREF 1 T 0 NIL \HTFIND
) (22 was.htfind 0 T) (23 GVAR← 2 ATOM 0 NIL \SETGLOBALVAL.UFN) (24 RPLACA 0 T -1 NIL \RPLACA.UFN) (25
 RPLACD 0 T -1 NIL \RPLACD.UFN) (26 CONS 0 T -1 NIL \CONS.UFN) (27 GETP 0 T -1 NIL GETPROP) (28 FMEMB 
0 T -1 NIL FMEMB) (29 GETHASH 0 T -1 NIL GETHASH) (30 PUTHASH 0 T -2 NIL PUTHASH) (31 CREATECELL 0 T 0
 NIL \CREATECELL) (32 BIN 0 T 0 NIL \BIN) (33 BOUT 0 T -1 NIL \BOUT) (34 BITBLT 0 T -1 NIL BitBltSUBR)
 (35 LIST1 0 T 0 NIL CONS) (36 DOCOLLECT 0 T -1 NIL DOCOLLECT) (37 ENDCOLLECT 0 T -1 NIL ENDCOLLECT) (
38 RPLCONS 0 T -1 NIL \RPLCONS) (39 unused) (40 ELT 0 T -1 NIL ELT) (41 NTHCHC 0 T -1 NIL NTHCHARCODE)
 (42 SETA 0 T -2 NIL SETA) (43 RPLCHARCODE 0 T -2 NIL RPLCHARCODE) (44 EVAL 0 T 0 NIL \EVAL) (45 EVALV
 0 T 0 NIL \EVALV1) (46 unused) (47 STKSCAN 0 T 0 NIL \STKSCAN) (48 unused NIL NIL NIL 59) (60 STORE.N
 1 T 0) (61 COPY.N 1 T 1) (62 RAID 0 T 0 NIL RAID) (63 \RETURN 0 T 0 NIL \RETURN) (64 IVAR 0 IVAR 1 70
) (71 IVARX 1 IVAR 1) (72 PVAR 0 PVAR 1 78) (79 PVARX 1 PVAR 1) (80 FVAR 0 FVAR 1 86) (87 FVARX 1 FVAR
 1) (88 PVAR← 0 PVAR 0 94) (95 PVARX← 1 PVAR 0) (96 GVAR 2 ATOM 1) (97 ARG0 0 T 0 NIL \ARG0) (98 
IVARX← 1 IVAR 0) (99 FVARX← 1 FVAR 0) (100 COPY 0 T 1) (101 MYARGCOUNT 0 T 1 NIL \MYARGCOUNT) (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 NIL \READFLAGS) (114 READRP 0 T 0 NIL \READRP) (115 WRITEMAP 0 T -2 NIL 
\WRITEMAP) (116 READPRINTERPORT 0 T 1 NIL NILL) (117 WRITEPRINTERPORT 0 T 0 NIL NILL) (118 PILOTBITBLT
 0 T -1 NIL \PILOTBITBLT) (119 RCLK 0 T 0 NIL \RCLKSUBR) (120 MISC1 1 T 0 NIL \MISC1.UFN) (121 MISC2 1
 T -1 NIL \MISC2.UFN) (122 RECLAIMCELL 0 T 0 NIL \GCRECLAIMCELL) (123 GCSCAN1 0 T 0 NIL \GCSCAN1) (124
 GCSCAN2 0 T 0 NIL \GCSCAN2) (125 SUBRCALL 2) (126 CONTEXTSWITCH 0 T 0 NIL \CONTEXTSWITCH) (127 AUDIO 
0 T 0 NIL NILL) (128 JUMP 0 JUMP JUMP 143) (144 FJUMP 0 JUMP CJUMP 159) (160 TJUMP 0 JUMP CJUMP 175) (
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 jeq) (183 jlistp) (184 PVAR←↑ 0 
PVAR -1 190) (191 POP 0 T -1) (192 was.getbase) (193 was.getbaseptr) (194 GETBASEBYTE 0 T -1 NIL 
\GETBASEBYTE) (195 was.scanbase) (196 BLT 0 T -2 NIL \BLT) (197 was.putbase) (198 was.putbaseptr) (199
 PUTBASEBYTE 0 T -2 NIL \PUTBASEBYTE) (200 GETBASE.N 1 T 0) (201 GETBASEPTR.N 1 T 0) (202 GETBITS.N.FD
 2 T 0) (203 unused) (204 unused) (205 PUTBASE.N 1 T -1 NIL \PUTBASE.UFN) (206 PUTBASEPTR.N 1 T -1 NIL
 \PUTBASEPTR.UFN) (207 PUTBITS.N.FD 2 T -1 NIL \PUTBITS.UFN) (208 ADDBASE 0 T -1 NIL \ADDBASE) (209 
VAG2 0 T -1 NIL \VAG2) (210 HILOC 0 T 0) (211 LOLOC 0 T 0) (212 PLUS2 0 T -1 NIL PLUS) (213 DIFFERENCE
 0 T -1 NIL DIFFERENCE) (214 TIMES2 0 T -1 NIL TIMES) (215 QUOTIENT 0 T -1 NIL QUOTIENT) (216 IPLUS2 0
 T -1 NIL \SLOWIPLUS2) (217 IDIFFERENCE 0 T -1 NIL \SLOWIDIFFERENCE) (218 ITIMES2 0 T -1 NIL 
\SLOWITIMES2) (219 IQUOTIENT 0 T -1 NIL \SLOWIQUOTIENT) (220 IREMAINDER 0 T -1 NIL IREMAINDER) (221 
IPLUS.N 1 T 0 NIL \SLOWIPLUS2) (222 IDIFFERENCE.N 1 T 0 NIL \SLOWIDIFFERENCE) (223 unused) (224 LLSH1 
0 T 0 NIL \SLOWLLSH1) (225 LLSH8 0 T 0 NIL \SLOWLLSH8) (226 LRSH1 0 T 0 NIL \SLOWLRSH1) (227 LRSH8 0 T
 0 NIL \SLOWLRSH8) (228 LOGOR2 0 T -1 NIL \SLOWLOGOR2) (229 LOGAND2 0 T -1 NIL \SLOWLOGAND2) (230 
LOGXOR2 0 T -1 NIL \SLOWLOGXOR2) (231 unused) (232 FPLUS2 0 T -1 NIL FPLUS2) (233 FDIFFERENCE 0 T -1 
NIL FDIFFERENCE) (234 FTIMES2 0 T -1 NIL FTIMES2) (235 FQUOTIENT 0 T -1 NIL FQUOTIENT) (236 unused NIL
 NIL NIL 239) (240 EQ 0 T -1) (241 IGREATERP 0 T -1 NIL \SLOWIGREATERP) (242 FGREATERP 0 T -1 NIL 
FGREATERP) (243 GREATERP 0 T -1 NIL GREATERP) (244 unused) (245 MAKENUMBER 0 T -1 NIL \MAKENUMBER) (
246 BOXIPLUS 0 T -1 NIL \BOXIPLUS) (247 BOXIDIFFERENCE 0 T -1 NIL \BOXIDIFFERENCE) (248 unused NIL NIL
 NIL 252) (253 SWAP 0 T 0) (254 NOP 0 T 0) (255 UPCTRACE 0 T 0 NIL NILL)))

(RPAQQ \OPCODEARRAY
 NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \OPCODEARRAY \OPCODES)
)
(DECLARE: DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD OPCODE
 (OP# OPCODENAME OPNARGS OPPRINT LEVADJ OPLAST UFNFN))
]
)
(FILESLOAD VMEM)

(RPAQQ RDVALS
 ((\AtomFrLst)))

(RPAQQ RDPTRS
 NIL)
(DECLARE: EVAL@COMPILE DONTCOPY 
(FILESLOAD (LOADCOMP) VMEM)
)
STOP