(FILECREATED "18-AUG-83 15:52:21" {PHYLUM}<LISPCORE>SOURCES>RDSYS.;21
previous date: "13-AUG-83 20:09:31" {PHYLUM}<LISPCORE>SOURCES>RDSYS.;20)
(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) (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 26Q 10000Q)) 10Q) (LRSH
(VLOLOC (VVAG2 26Q 10000Q)) 10Q)) 1) (*) (VCHECKIFPAGE) (MAPVMPAGE (IPLUS (LLSH (VHILOC (VVAG2 25Q 0))
10Q) (LRSH (VLOLOC (VVAG2 25Q 0)) 10Q)) (SUB1 (VGETBASE (VVAG2 26Q 10000Q) 26Q))) (*) (SETQ FIRSTPMT
(SUB1 (VGETBASE (VVAG2 26Q 10000Q) 27Q))) (SETVMPTR (VVAG2 25Q 0)) (VREADPAGEMAPBLOCK (IPLUS (LLSH (
VHILOC (VVAG2 25Q 0)) 10Q) (LRSH (VLOLOC (VVAG2 25Q 0)) 10Q))) (*) (for J from 0 to (SUB1 2) do (
MAPVMPAGE (IPLUS (IPLUS (LLSH (VHILOC (VVAG2 26Q 0)) 10Q) (LRSH (VLOLOC (VVAG2 26Q 0)) 10Q)) J) (IPLUS
FIRSTPMT J))) (for I from 0 to (SUB1 (LLSH 2 10Q)) do (COND ((IEQ (SETQ D (VGETBASE (VVAG2 26Q 0) I))
177777Q)) (T (SETVMPTR (VADDBASE (VVAG2 25Q 0) D)) (VREADPAGEMAPBLOCK (LLSH I 5))))))))
(VREADPAGEMAPBLOCK
(LAMBDA (VP) (*) (PROG ((B VP) P) (FRPTQ 40Q (COND ((NEQ (SETQ P (VBIN2)) 0) (MAPVMPAGE B (SUB1 P))))
(SETQ B (ADD1 B))))))
(VCHECKIFPAGE
(LAMBDA NIL (*) (COND ((NOT (EQUAL 107400Q (VGETBASE (VVAG2 26Q 10000Q) 10Q))) (printout T "Warning: "
"Lisp Version" "= " (PROGN 107400Q) ", but \InterfacePage says " (VGETBASE (VVAG2 26Q 10000Q) 10Q) T)
)) (COND ((NOT (EQUAL 12743Q (VGETBASE (VVAG2 26Q 10000Q) 17Q))) (printout T "Warning: "
"Interface page key" "= " (PROGN 12743Q) ", but \InterfacePage says " (VGETBASE (VVAG2 26Q 10000Q) 17Q
) T)))))
(VFIXIFPAGE
(LAMBDA (RPT RPTSIZE RPOFFSET RPTLAST EMBUFVP) (*) (*) (VPUTBASE (VVAG2 26Q 10000Q) 13Q 10000Q) (
VPUTBASE (VVAG2 26Q 10000Q) 14Q 177777Q) (VPUTBASE (VVAG2 26Q 10000Q) 15Q 6) (VPUTBASE (VVAG2 26Q
10000Q) 20Q 0) (VPUTBASE (VVAG2 26Q 10000Q) 21Q 0) (VPUTBASE (VVAG2 26Q 10000Q) 22Q 100Q) (VPUTBASE (
VVAG2 26Q 10000Q) 34Q 0) (VPUTBASE (VVAG2 26Q 10000Q) 35Q 0) (VPUTBASE (VVAG2 26Q 10000Q) 41Q RPT) (
VPUTBASE (VVAG2 26Q 10000Q) 42Q RPTSIZE) (VPUTBASE (VVAG2 26Q 10000Q) 43Q (LOGAND RPOFFSET (CONSTANT (
SUB1 (LLSH 1 20Q))))) (VPUTBASE (VVAG2 26Q 10000Q) 44Q RPTLAST) (VPUTBASE (VVAG2 26Q 10000Q) 45Q
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 27Q (VREADOCT
)) (VREADOCT))) (D (VPRINTADDRS (VADDBASE (VVAG2 21Q 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 26Q 10000Q) 30Q)) (T (VGETBASE (VVAG2 26Q
10000Q) 0))) (TERPRI T)))) ((AND (ILESSP (SETQ ROOTFRAME (VREADOCT)) 400Q) (ILESSP (VGETBASE (VVAG2
26Q 10000Q) ROOTFRAME) (VGETBASE (VVAG2 26Q 10000Q) 7)) (IEQ (LRSH (VGETBASE (VVAG2 27Q (PROGN (PROGN
(VGETBASE (VVAG2 26Q 10000Q) ROOTFRAME)))) 0) 15Q) 6)) (SETQ ROOTFRAME (VGETBASE (VVAG2 26Q 10000Q)
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 26Q 10000Q) 0))))) (FRPTQ
(SUB1 N) (COND ((ZEROP (PROGN (SETQ FRAME (COND (ALINKS? (IDIFFERENCE (LOGAND (VGETBASE (VVAG2 27Q
FRAME) 1) (CONSTANT (LOGXOR (SUB1 2) -1))) 12Q)) (T (IDIFFERENCE (COND ((EVENP (VGETBASE (VVAG2 27Q
FRAME) 1) 2) (VGETBASE (VVAG2 27Q FRAME) 1)) (T (VGETBASE (VVAG2 27Q FRAME) 11Q))) 12Q)))))) (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 10Q) -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 (10Q (MKATOM (CONCAT STR "Q"))) (20Q (bind N←0 CHAR while (SETQ CHAR (
GNC STR)) do (SETQ N (IPLUS (ITIMES N 20Q) (COND ((FIXP CHAR) CHAR) ((AND (IGEQ (SETQ CHAR (CHCON1
CHAR)) (CHARCODE A)) (ILEQ CHAR (CHARCODE F))) (IPLUS (IDIFFERENCE CHAR (CHARCODE A)) 12Q)) (T (ERROR
CHAR (QUOTE ?) T))))) finally (RETURN N))) (SHOULDNT))) (PROGN (PRIN1 "?" T) (ERROR!))) (READC T))))))
(VSHOWSTACKBLOCKS
(LAMBDA (SCANPTR WAITFLG) (*) (*) (PROG ((EASP (VGETBASE (VVAG2 26Q 10000Q) 7))) SCAN (SELECTC (LRSH (
VGETBASE (VVAG2 27Q SCANPTR) 0) 15Q) (5 (VSHOWSTACKBLOCK1 SCANPTR "free block" (IEQ (VGETBASE (VVAG2
27Q SCANPTR) 0) 120000Q)) (SETQ SCANPTR (IPLUS SCANPTR (VGETBASE (VVAG2 27Q SCANPTR) 1)))) (7 (
VSHOWSTACKBLOCK1 SCANPTR "guard block" T) (SETQ SCANPTR (IPLUS SCANPTR (VGETBASE (VVAG2 27Q SCANPTR) 1
)))) (6 (*) (VSHOWSTACKBLOCK1 SCANPTR "Frame extn = " (AND (IEQ (LRSH (VGETBASE (VVAG2 27Q SCANPTR) 0)
15Q) 6) (OR (IEQ (IDIFFERENCE SCANPTR 2) (COND ((EVENP (VGETBASE (VVAG2 27Q SCANPTR) 1) 2) (
IDIFFERENCE SCANPTR 2)) (T (VGETBASE (VVAG2 27Q SCANPTR) 10Q)))) (AND (NOT (ZEROP (LOGAND (LRSH (
VGETBASE (VVAG2 27Q (PROGN (IDIFFERENCE SCANPTR 2))) 0) 11Q) 1))) (IEQ (VGETBASE (VVAG2 27Q (PROGN (
IDIFFERENCE SCANPTR 2))) 1) (VGETBASE (VVAG2 27Q (PROGN (COND ((EVENP (VGETBASE (VVAG2 27Q SCANPTR) 1)
2) (IDIFFERENCE SCANPTR 2)) (T (VGETBASE (VVAG2 27Q SCANPTR) 10Q))))) 1)))))) (PRIN2 (V\UNCOPY (
VGETBASEPTR (PROGN (COND ((NOT (ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 27Q SCANPTR) 0) 11Q) 1))) (VVAG2
(LOGAND (VGETBASE (VVAG2 27Q SCANPTR) 7) 377Q) (VGETBASE (VVAG2 27Q SCANPTR) 6))) (T (VVAG2 (LOGAND (
VGETBASE (VVAG2 27Q SCANPTR) 3) 377Q) (VGETBASE (VVAG2 27Q SCANPTR) 2))))) 4))) (SETQ SCANPTR (
VGETBASE (VVAG2 27Q SCANPTR) 4))) (PROG ((ORIG SCANPTR) IVAR) (*) (while (EQ (LRSH (VGETBASE (VVAG2
27Q SCANPTR) 0) 15Q) 0) do (SETQ SCANPTR (IPLUS SCANPTR 2))) (COND ((NOT (IEQ (LRSH (VGETBASE (VVAG2
27Q SCANPTR) 0) 15Q) 4)) (VSHOWSTACKBLOCK1 ORIG "Garbage" T)) (T (SETQ IVAR (VGETBASE (VVAG2 27Q
SCANPTR) 1)) (COND ((NOT (ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 27Q SCANPTR) 0) 11Q) 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 27Q
SCANPTR) 0) 15Q) 4) (for I from (VGETBASE (VVAG2 27Q SCANPTR) 1) to (IDIFFERENCE SCANPTR 2) by 2
always (IEQ 0 (LRSH (VGETBASE (VVAG2 27Q I) 0) 15Q)))))))) (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 10Q)) (
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 27Q IPOS) 0) 11Q) 1))) (VVAG2 (
LOGAND (VGETBASE (VVAG2 27Q IPOS) 7) 377Q) (VGETBASE (VVAG2 27Q IPOS) 6))) (T (VVAG2 (LOGAND (VGETBASE
(VVAG2 27Q IPOS) 3) 377Q) (VGETBASE (VVAG2 27Q IPOS) 2))))) 4)) (COND (JUNK (TERPRI) (TERPRI) (PRIN1
"Basic frame at ") (PRINTNUM .I7 (SETQ BLINK (COND ((EVENP (VGETBASE (VVAG2 27Q IPOS) 1) 2) (
IDIFFERENCE IPOS 2)) (T (VGETBASE (VVAG2 27Q IPOS) 10Q))))) (TERPRI) (V\PRINTBF BLINK (COND ((NOT (
ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 27Q IPOS) 0) 11Q) 1))) (VVAG2 (LOGAND (VGETBASE (VVAG2 27Q IPOS)
7) 377Q) (VGETBASE (VVAG2 27Q IPOS) 6))) (T (VVAG2 (LOGAND (VGETBASE (VVAG2 27Q IPOS) 3) 377Q) (
VGETBASE (VVAG2 27Q 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 27Q IPOS) 1) 2) (IDIFFERENCE IPOS 2)) (T (VGETBASE (VVAG2 27Q
IPOS) 10Q))) (COND ((NOT (ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 27Q IPOS) 0) 11Q) 1))) (VVAG2 (LOGAND
(VGETBASE (VVAG2 27Q IPOS) 7) 377Q) (VGETBASE (VVAG2 27Q IPOS) 6))) (T (VVAG2 (LOGAND (VGETBASE (VVAG2
27Q IPOS) 3) 377Q) (VGETBASE (VVAG2 27Q 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 27Q IPOS) 1) (CONSTANT (LOGXOR (SUB1 2) -1))) 12Q))
(T (IDIFFERENCE (COND ((EVENP (VGETBASE (VVAG2 27Q IPOS) 1) 2) (VGETBASE (VVAG2 27Q IPOS) 1)) (T (
VGETBASE (VVAG2 27Q IPOS) 11Q))) 12Q)))))))) (GO POSLP))) (RETURN T))))
(V\PRINTBF
(LAMBDA (BL NMT PRINTFN VARSONLY) (*) (bind NM for I from (VGETBASE (VVAG2 27Q BL) 1) by 2 as J from 0
to (SUB1 (IDIFFERENCE (LRSH (IDIFFERENCE BL (VGETBASE (VVAG2 27Q BL) 1)) 1) (LOGAND (LRSH (VGETBASE (
VVAG2 27Q BL) 0) 10Q) 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 27Q 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
27Q BL) 0) 11Q) 1))) (PRIN1 "residual "))) (COND ((NEQ (LOGAND (VGETBASE (VVAG2 27Q BL) 0) 377Q) 0) (
printout NIL "usecnt= " (LOGAND (VGETBASE (VVAG2 27Q BL) 0) 377Q) ,))) (TERPRI)))))
(V\PRINTFRAME
(LAMBDA (FRAME PRINTFN VARSONLY) (*) (PROG ((NMT (COND ((NOT (ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 27Q
FRAME) 0) 11Q) 1))) (VVAG2 (LOGAND (VGETBASE (VVAG2 27Q FRAME) 7) 377Q) (VGETBASE (VVAG2 27Q FRAME) 6
))) (T (VVAG2 (LOGAND (VGETBASE (VVAG2 27Q FRAME) 3) 377Q) (VGETBASE (VVAG2 27Q FRAME) 2))))) (I 0) (
FT (IPLUS (IPLUS FRAME (PROGN 12Q)) (LLSH (ADD1 ((LAMBDA (X) (DECLARE (LOCALVARS . T)) (COND ((
IGREATERP X (SUB1 (LLSH 1 (SUB1 20Q)))) (SUB1 (IDIFFERENCE X (SUB1 (LLSH 1 20Q))))) (T X))) (VGETBASE
(PROGN (VVAG2 (LOGAND (VGETBASE (VVAG2 27Q FRAME) 3) 377Q) (VGETBASE (VVAG2 27Q FRAME) 2))) 2))) 2) (
PROGN 4))) TMP NLOCALS) (COND ((NOT VARSONLY) (V\PRINTSTK FRAME) (PRIN1 "[") (PROGN (PROG ((FAST (NOT
(ZEROP (LOGAND (LRSH (VGETBASE (VVAG2 27Q FRAME) 0) 14Q) 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 27Q FRAME) 0) 12Q) 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 27Q FRAME) 0) 11Q) 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 27Q FRAME) 0) 10Q) 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 27Q FRAME) 0) 377Q
))) (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 27Q 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 27Q FRAME) 1) (CONSTANT (LOGXOR (SUB1 2) -1))) 12Q))) (
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 27Q FRAME) 3) 377Q) (VGETBASE (VVAG2 27Q
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 27Q 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 27Q FRAME) 0) 11Q
) 1))) (VVAG2 (LOGAND (VGETBASE (VVAG2 27Q FRAME) 7) 377Q) (VGETBASE (VVAG2 27Q FRAME) 6))) (T (VVAG2
(LOGAND (VGETBASE (VVAG2 27Q FRAME) 3) 377Q) (VGETBASE (VVAG2 27Q 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 10Q)) (
PROGN (PROG ((BLINK (COND ((EVENP (VGETBASE (VVAG2 27Q FRAME) 1) 2) (IDIFFERENCE FRAME 2)) (T (
VGETBASE (VVAG2 27Q FRAME) 10Q))))) (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) 10Q)) (for old I from (IPLUS FRAME (
PROGN 12Q)) 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 100000Q J))) (AND (NEQ VARSONLY T) (SETQ
TMP (QUOTE *local*)))) (COND ((ZEROP (LRSH (VGETBASE (PROGN (VVAG2 27Q I)) 0) 10Q)) (AND VARSONLY (
SPACES 3)) (PRIN2 TMP) (SPACES 1) (APPLY* PRINTFN (VGETBASEPTR (VVAG2 27Q 0) I))) ((NOT VARSONLY) (
printout NIL TMP " [unbound]" T)))))) ((NOT VARSONLY) (COND ((SETQ TMP (V\SCANFORNTENTRY NMT (IPLUS
140000Q J))) (printout NIL "[fvar " .P2 TMP " " (COND ((EVENP (VGETBASE (PROGN (VVAG2 27Q I)) 0)) (
COND ((EQ (SETQ TMP (VHILOC ((LAMBDA ($$1) (VVAG2 (LRSH (VGETBASE (PROGN $$1) 1) 10Q) (VGETBASE $$1 0)
)) (VVAG2 27Q I)))) 27Q) " on stack]") ((NEQ TMP (VHILOC (VVAG2 22Q 0))) " non-stack binding]") (T
" top value]"))) (T " not looked up]")) T)) (T (printout NIL "[padding]" T)))))) (COND ((NOT VARSONLY)
(SETQ FT (VGETBASE (VVAG2 27Q FRAME) 4)) (for old I by 2 while (ILESSP I FT) do (V\PRINTSTK I) (COND
((ZEROP (LRSH (VGETBASE (PROGN (VVAG2 27Q I)) 0) 10Q)) (APPLY* PRINTFN (VGETBASEPTR (VVAG2 27Q 0) I)))
(T (TERPRI)))))))))
(V\SCANFORNTENTRY
(LAMBDA (NMT NTENTRY) (*) (bind NM for NT1 from (PROGN 10Q) as NT2 from (IPLUS (PROGN 10Q) (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 27Q 0) I)) (PRINTNUM .I7
(VGETBASE (VVAG2 27Q 0) (ADD1 I))) (SPACES 1)))
)
(DEFINEQ
(VDPRINTCODE
(LAMBDA (FN LVFLG RADIX OUTF FIRSTBYTE) (*) (DECLARE (GLOBALVARS \INITSUBRS FVA STKA) (SPECVARS OUTF))
(OR RADIX (SETQ RADIX 10Q)) (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) 10Q) (
VGETBASEBYTE DEF (ADD1 LC)))) CA 0) OUTF) (PRIN1 " na: " OUTF) (PRINTNUM I4 ((LAMBDA (X) (DECLARE (
LOCALVARS . T)) (COND ((IGREATERP X (SUB1 (LLSH 1 (SUB1 20Q)))) (SUB1 (IDIFFERENCE X (SUB1 (LLSH 1 20Q
))))) (T X))) ((LAMBDA (DEF LC) (IPLUS (LLSH (VGETBASEBYTE DEF LC) 10Q) (VGETBASEBYTE DEF (ADD1 LC))))
CA 2)) OUTF) (PRIN1 " pv: " OUTF) (PRINTNUM I4 ((LAMBDA (X) (DECLARE (LOCALVARS . T)) (COND ((
IGREATERP X (SUB1 (LLSH 1 (SUB1 20Q)))) (SUB1 (IDIFFERENCE X (SUB1 (LLSH 1 20Q))))) (T X))) ((LAMBDA (
DEF LC) (IPLUS (LLSH (VGETBASEBYTE DEF LC) 10Q) (VGETBASEBYTE DEF (ADD1 LC)))) CA 4)) OUTF) (PRIN1
" startpc: " OUTF) (PRINTNUM I4 (SETQ STARTPC ((LAMBDA (DEF LC) (IPLUS (LLSH (VGETBASEBYTE DEF LC) 10Q
) (VGETBASEBYTE DEF (ADD1 LC)))) CA 6)) OUTF) (PRIN1 " argtype: " OUTF) (PRIN1 (LOGAND (LRSH (
VGETBASEBYTE CA 10Q) 4) 3) OUTF) (PRIN1 " framename: " OUTF) (PRIN1 (V\UNCOPY (VVAG2 (VGETBASEBYTE CA
11Q) ((LAMBDA (DEF LC) (IPLUS (LLSH (VGETBASEBYTE DEF LC) 10Q) (VGETBASEBYTE DEF (ADD1 LC)))) CA 12Q))
) OUTF) (PRIN1 " ntsize: " OUTF) (PRINTNUM I4 (SETQ NTSIZE ((LAMBDA (DEF LC) (IPLUS (LLSH (
VGETBASEBYTE DEF LC) 10Q) (VGETBASEBYTE DEF (ADD1 LC)))) CA 14Q)) OUTF) (PRIN1 " nlocals: " OUTF) (
PRINTNUM I4 (VGETBASEBYTE CA 16Q) OUTF) (TERPRI OUTF)) (for I from 0 by 2 while (ILESSP I (LLSH (PROGN
10Q) 1)) do (PRINTNUM I4 I OUTF) (PRIN1 ": " OUTF) (PRINTNUM I6 ((LAMBDA (DEF LC) (IPLUS (LLSH (
VGETBASEBYTE DEF LC) 10Q) (VGETBASEBYTE DEF (ADD1 LC)))) CA I) OUTF) (TERPRI OUTF)) (VPRINTCODENT
"name table: " (LLSH (PROGN 10Q) 1) (LLSH NTSIZE 1)) (VPRINTCODENT "Local args: " (SETQ TEMP (IPLUS (
LLSH (PROGN 10Q) 1) (COND ((ZEROP NTSIZE) (*) 10Q) (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 14Q 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) 17Q)))))))) (
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 36Q (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 50Q 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 50Q 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 50Q 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 50Q .P2 B1)) (SNIC (printout OUTF 50Q .P2 (IDIFFERENCE B1 400Q))) (SICX
(printout OUTF 50Q .P2 (IPLUS (LLSH B1 10Q) 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 200Q) (IDIFFERENCE B1
400Q)) (T B1)))) (FN (SETQ B (IPLUS (LLSH B1 10Q) B2)) (printout OUTF 50Q (VATOM B))) (BIND (TAB 50Q
NIL OUTF) (PROG ((NNILS (LRSH B1 4)) (NVALS (LOGAND B1 17Q))) (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 10Q) B2 (COND ((IGREATERP B1 177Q) -200000Q) (T 0))))) (ATOM (printout OUTF 50Q .P2
(VATOM (IPLUS (LLSH B1 10Q) B2)))) (GCONST (printout OUTF 50Q .P2 (V\UNCOPY (VVAG2 B1 (IPLUS (LLSH B2
10Q) B3))))) (FNX (printout OUTF "(" B1 ")" 50Q (VATOM (IPLUS (LLSH B2 10Q) 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 10Q) (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 50Q .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) 10Q) (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) 10Q) (VGETBASEBYTE DEF (ADD1 LC)))) CA NT2) OUTF) (COND ((SETQ NAME
(VATOM ((LAMBDA (DEF LC) (IPLUS (LLSH (VGETBASEBYTE DEF LC) 10Q) (VGETBASEBYTE DEF (ADD1 LC)))) CA
NT1))) (SETQ TAG (VGETBASEBYTE CA (ADD1 NT2))) (printout OUTF .SP 5 (SELECTC (VGETBASEBYTE CA NT2) ((
LRSH 0 10Q) (push IVARS (LIST TAG NAME)) (QUOTE IVAR)) ((LRSH 100000Q 10Q) (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) 10Q) (VGETBASEBYTE DEF (ADD1 LC)))) (PROGN (SETQ NEWCA (
SETQ CA (VGETDEFN CA)))) 6)) (SETQ BEFORE) (SETQ AFTER T) (SETQ OFFSET 0) (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) 10Q) (VGETBASEBYTE DEF (ADD1 LC)))) CA 6)) (SETQ
NEWCA (\CODEARRAY (COND (BEFORE (IPLUS OFFSET SIZE)) (T SIZE)) (LOGAND (IPLUS (ADD1 (LRSH (IPLUS FB 3)
2)) (CONSTANT (SUB1 2))) (CONSTANT (LOGXOR (SUB1 2) -1))))) 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))))
)
(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) 10Q) 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) 10Q))) (RETURN (COND ((EQ Q 200Q) NIL) ((IGREATERP Q 200Q) (VADDBASE (VVAG2 (VHILOC X) (LOGAND (
VLOLOC X) 177400Q)) (LLSH (IDIFFERENCE Q 200Q) 1))) ((EQ Q 0) (V\CDR.UFN (VGETBASEPTR X 0))) (T (
VGETBASEPTR (VADDBASE (VVAG2 (VHILOC X) (LOGAND (VLOLOC X) 177400Q)) (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 -200001Q
) (*) (RETURN (VADDBASE (VVAG2 17Q 0) (LOGAND X 177777Q)))))) ((ILESSP X 200000Q) (*) (RETURN (
VADDBASE (VVAG2 16Q 0) X)))) (*) (SETQ V (VCREATECELL 2)) (VPUTBASE V 0 (LOGOR (COND ((IGREATERP 0 X)
100000Q) (T 0)) (LOGAND (LRSH X 20Q) 77777Q))) (VPUTBASE V 1 (LOGAND X 177777Q)) (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 16Q
)) (VLOLOC X)) (T (IPLUS (VLOLOC X) -200000Q)))) ((EQ TYP 2) (*) (IPLUS (LLSH (VGETBASE X 0) 20Q) (
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))) 10Q)) (T (
LOGAND (PROGN (VGETBASE PTR (LRSH N 1))) 377Q)))))
(V\PUTBASEBYTE
(LAMBDA (PTR DISP BYTE) (*) (*) (VPUTBASE PTR (LRSH DISP 1) (SELECTQ (LOGAND DISP 1) (0 ((LAMBDA ($$1)
(IPLUS (LLSH (SETQ BYTE (PROG1 BYTE)) 10Q) (LOGAND $$1 377Q))) (VGETBASE PTR (LRSH DISP 1)))) ((
LAMBDA ($$1) (IPLUS (LLSH (LRSH $$1 10Q) 10Q) BYTE)) (VGETBASE PTR (LRSH DISP 1))))) BYTE))
)
(DEFINEQ
(VNTYPX
(LAMBDA (X) (*) (*) (LOGAND (VGETBASE (VVAG2 26Q 100000Q) (LRSH (IPLUS (LLSH (VHILOC X) 10Q) (LRSH (
VLOLOC X) 10Q)) 1)) 377Q)))
(VTYPENAME
(LAMBDA (DATUM) (*) (PROG ((N (VNTYPX DATUM))) (RETURN (SELECTC N (6 ((LAMBDA (X) (QUOTE ARRAYP))
DATUM)) (VATOM (VGETBASE (VADDBASE (VVAG2 26Q 124000Q) (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 20Q 0) (LLSH N 1))) LEN (STR (OR COPYATOMSTR (SETQ COPYATOMSTR (ALLOCSTRING 177Q)))
)) (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 7777Q) 2))) 77777Q) (LLSH (LOGAND H1 177Q) 10Q)) (
NTHCHARCODE BASE (IPLUS OFFST L))) 77777Q)) (SETQ L (ADD1 L)) (GO HASH))) (*) LP (COND ((NEQ (SETQ P (
VGETBASE (VVAG2 24Q 0) H)) 0) (COND ((EQ (VATOM (SETQ Q (SUB1 P))) BASE) (RETURN Q)) (T (SETQ H (
LOGAND (IPLUS H 23Q) 77777Q)) (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 22Q 0) (LLSH (PROGN (VATOMNUMBER X)) 1)) 0)))))))
(VGETPROPLIST
(LAMBDA (ATM) (*) (PROG NIL (RETURN (VGETBASEPTR (VVAG2 23Q 0) (LLSH (OR (VATOMNUMBER ATM) (RETURN)) 1
))))))
(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 22Q 0) (LLSH (PROGN (VATOMNUMBER ATM))
1)) 0 (V\COPY VAL)))))))
(VGETDEFN
(LAMBDA (A) (*) (VGETBASEPTR (VADDBASE (VVAG2 21Q 0) (LLSH (VATOMNUMBER A) 1)) 0)))
)
(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 400Q)) (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 ((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) (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 NIL \CHECKAPPLY*) (20Q RETURN 0 T 0 NIL
\HARDRETURN) (21Q BIND 2) (22Q UNBIND 0) (23Q DUNBIND 0) (24Q RPLPTR.N 1 T -1 NIL \RPLPTR.UFN) (25Q
GCREF 1 T 0 NIL \HTFIND) (26Q was.htfind 0 T) (27Q GVAR← 2 ATOM 0 NIL \SETGLOBALVAL.UFN) (30Q RPLACA 0
T -1 NIL \RPLACA.UFN) (31Q RPLACD 0 T -1 NIL \RPLACD.UFN) (32Q CONS 0 T -1 NIL \CONS.UFN) (33Q GETP 0
T -1 NIL GETPROP) (34Q FMEMB 0 T -1 NIL FMEMB) (35Q GETHASH 0 T -1 NIL GETHASH) (36Q PUTHASH 0 T -2
NIL PUTHASH) (37Q CREATECELL 0 T 0 NIL \CREATECELL) (40Q BIN 0 T 0 NIL \BIN) (41Q BOUT 0 T -1 NIL
\BOUT) (42Q BITBLT 0 T -1 NIL BitBltSUBR) (43Q LIST1 0 T 0 NIL CONS) (44Q DOCOLLECT 0 T -1 NIL
DOCOLLECT) (45Q ENDCOLLECT 0 T -1 NIL ENDCOLLECT) (46Q RPLCONS 0 T -1 NIL \RPLCONS) (47Q unused) (50Q
ELT 0 T -1 NIL ELT) (51Q NTHCHC 0 T -1 NIL NTHCHARCODE) (52Q SETA 0 T -2 NIL SETA) (53Q RPLCHARCODE 0
T -2 NIL RPLCHARCODE) (54Q EVAL 0 T 0 NIL \EVAL) (55Q EVALV 0 T 0 NIL \EVALV1) (56Q unused) (57Q
STKSCAN 0 T 0 NIL \STKSCAN) (60Q unused NIL NIL NIL 73Q) (74Q STORE.N 1 T 0) (75Q COPY.N 1 T 1) (76Q
RAID 0 T 0 NIL RAID) (77Q \RETURN 0 T 0 NIL \RETURN) (100Q IVAR 0 IVAR 1 106Q) (107Q IVARX 1 IVAR 1) (
110Q PVAR 0 PVAR 1 116Q) (117Q PVARX 1 PVAR 1) (120Q FVAR 0 FVAR 1 126Q) (127Q FVARX 1 FVAR 1) (130Q
PVAR← 0 PVAR 0 136Q) (137Q PVARX← 1 PVAR 0) (140Q GVAR 2 ATOM 1) (141Q ARG0 0 T 0 NIL \ARG0) (142Q
IVARX← 1 IVAR 0) (143Q FVARX← 1 FVAR 0) (144Q COPY 0 T 1) (145Q MYARGCOUNT 0 T 1 NIL \MYARGCOUNT) (
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 NIL \READFLAGS) (162Q READRP 0 T 0 NIL \READRP) (163Q
WRITEMAP 0 T -2 NIL \WRITEMAP) (164Q READPRINTERPORT 0 T 1 NIL NILL) (165Q WRITEPRINTERPORT 0 T 0 NIL
NILL) (166Q PILOTBITBLT 0 T -1 NIL \PILOTBITBLT) (167Q RCLK 0 T 0 NIL \RCLKSUBR) (170Q MISC1 1 T 0 NIL
\MISC1.UFN) (171Q MISC2 1 T -1 NIL \MISC2.UFN) (172Q RECLAIMCELL 0 T 0 NIL \GCRECLAIMCELL) (173Q
GCSCAN1 0 T 0 NIL \GCSCAN1) (174Q GCSCAN2 0 T 0 NIL \GCSCAN2) (175Q SUBRCALL 2) (176Q CONTEXTSWITCH 0
T 0 NIL \CONTEXTSWITCH) (177Q AUDIO 0 T 0 NIL NILL) (200Q JUMP 0 JUMP JUMP 217Q) (220Q FJUMP 0 JUMP
CJUMP 237Q) (240Q TJUMP 0 JUMP CJUMP 257Q) (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 PVAR←↑ 0 PVAR -1 276Q) (277Q POP 0 T -1) (300Q was.getbase) (
301Q was.getbaseptr) (302Q GETBASEBYTE 0 T -1 NIL \GETBASEBYTE) (303Q was.scanbase) (304Q BLT 0 T -2
NIL \BLT) (305Q was.putbase) (306Q was.putbaseptr) (307Q PUTBASEBYTE 0 T -2 NIL \PUTBASEBYTE) (310Q
GETBASE.N 1 T 0) (311Q GETBASEPTR.N 1 T 0) (312Q GETBITS.N.FD 2 T 0) (313Q unused) (314Q unused) (315Q
PUTBASE.N 1 T -1 NIL \PUTBASE.UFN) (316Q PUTBASEPTR.N 1 T -1 NIL \PUTBASEPTR.UFN) (317Q PUTBITS.N.FD
2 T -1 NIL \PUTBITS.UFN) (320Q ADDBASE 0 T -1 NIL \ADDBASE) (321Q VAG2 0 T -1 NIL \VAG2) (322Q HILOC 0
T 0) (323Q LOLOC 0 T 0) (324Q PLUS2 0 T -1 NIL PLUS) (325Q DIFFERENCE 0 T -1 NIL DIFFERENCE) (326Q
TIMES2 0 T -1 NIL TIMES) (327Q QUOTIENT 0 T -1 NIL QUOTIENT) (330Q IPLUS2 0 T -1 NIL \SLOWIPLUS2) (
331Q IDIFFERENCE 0 T -1 NIL \SLOWIDIFFERENCE) (332Q ITIMES2 0 T -1 NIL \SLOWITIMES2) (333Q IQUOTIENT 0
T -1 NIL \SLOWIQUOTIENT) (334Q IREMAINDER 0 T -1 NIL IREMAINDER) (335Q IPLUS.N 1 T 0 NIL \SLOWIPLUS2)
(336Q IDIFFERENCE.N 1 T 0 NIL \SLOWIDIFFERENCE) (337Q unused) (340Q LLSH1 0 T 0 NIL \SLOWLLSH1) (341Q
LLSH8 0 T 0 NIL \SLOWLLSH8) (342Q LRSH1 0 T 0 NIL \SLOWLRSH1) (343Q LRSH8 0 T 0 NIL \SLOWLRSH8) (344Q
LOGOR2 0 T -1 NIL \SLOWLOGOR2) (345Q LOGAND2 0 T -1 NIL \SLOWLOGAND2) (346Q LOGXOR2 0 T -1 NIL
\SLOWLOGXOR2) (347Q unused) (350Q FPLUS2 0 T -1 NIL FPLUS2) (351Q FDIFFERENCE 0 T -1 NIL FDIFFERENCE)
(352Q FTIMES2 0 T -1 NIL FTIMES2) (353Q FQUOTIENT 0 T -1 NIL FQUOTIENT) (354Q unused NIL NIL NIL 357Q)
(360Q EQ 0 T -1) (361Q IGREATERP 0 T -1 NIL \SLOWIGREATERP) (362Q FGREATERP 0 T -1 NIL FGREATERP) (
363Q GREATERP 0 T -1 NIL GREATERP) (364Q unused) (365Q MAKENUMBER 0 T -1 NIL \MAKENUMBER) (366Q
BOXIPLUS 0 T -1 NIL \BOXIPLUS) (367Q BOXIDIFFERENCE 0 T -1 NIL \BOXIDIFFERENCE) (370Q unused NIL NIL
NIL 374Q) (375Q SWAP 0 T 0) (376Q NOP 0 T 0) (377Q 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