diff --git a/library/RDSYS b/library/RDSYS
index bcff5f5c..fe97150b 100644
--- a/library/RDSYS
+++ b/library/RDSYS
@@ -1 +1 @@
-(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
(FILECREATED "12-Mar-2021 12:23:53" |{DSK}<home>larry>ilisp>med>tmp>RDSYS.;1|)


(PRETTYCOMPRINT RDSYSCOMS)

(RPAQQ RDSYSCOMS ((FNS VREADPAGEMAP VREADPAGEMAPBLOCK VCHECKIFPAGE V\\LOCKEDPAGEP V\\LOOKUPPAGEMAP VCHECKPAGEMAP VCHECKFPTOVP VCHECKFPTOVP1 V\\SHOWPAGETABLE V\\PRINTFPTOVP) (FNS VRAIDCOMMAND VRAIDSHOWFRAME VRAIDSTACKCMD VRAIDROOTFRAME VPRINTADDRS VPRINTVA VREADVA VREADOCT VREADATOM VSHOWSTACKBLOCKS VSHOWSTACKBLOCK1 VPRINCOPY VNOSUCHATOM) (FNS V\\BACKTRACE V\\STKNAME V\\PRINTBF V\\PRINTFRAME V\\SCANFORNTENTRY V\\PRINTSTK) (FNS V\\CHECKARRAYBLOCK V\\PARSEARRAYSPACE V\\PARSEARRAYSPACE1) (FNS VPRINTCODE VPRINTCODENT VBROKENDEF) (FNS V\\CAR.UFN V\\CDR.UFN) (FNS V\\COPY V\\UNCOPY) (FNS V\\GETBASEBYTE V\\PUTBASEBYTE) (FNS VNTYPX VTYPENAME V\\TYPENAMEFROMNUMBER) (FNS VUNCOPYATOM VMAKE.LOCAL.ATOM VSYMBOL.VALUE VSYMBOL.PNAME VSYMBOL.PACKAGE VOLD.FIND.SYMBOL VLOOKUP-SYMBOL VFIND.PACKAGE VFIND.SYMBOL VPACKAGE.NAME V\\MKATOM VGETTOPVAL VGETPROPLIST VSETTOPVAL VGETDEFN V\\ATOMCELL) (FNS VLISTP) (VARS (COPYATOMSTR)) (FNS V\\GET-COMPILED-CODE-BASE) (* |;;| "YOU MUST REMAKE THIS FILE using (DORENAME 'R) (after CONNing to library) whenever the SYSOUT layout changes in LLPARAMS (e.g., if MDSTypeTable moves)") (FILES VMEM) (VARS RDVALS RDPTRS) (DECLARE\: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) VMEM))))
(DEFINEQ

(VREADPAGEMAP
(LAMBDA NIL (*) (*) (PROG (D) (MAPVMPAGE (IPLUS (LLSH (VHILOC (VVAG2 20 0)) 8) (LRSH (VLOLOC (VVAG2 20 0)) 8)) 1) (*) (*) (MAPVMPAGE (IPLUS (LLSH (VHILOC (VVAG2 5 0)) 8) (LRSH (VLOLOC (VVAG2 5 0)) 8)) (SUB1 (VGETBASE (VVAG2 20 0) 22))) (*) (SETVMPTR (VVAG2 5 0)) (|for| I |from| 0 |to| (SUB1 (LRSH (IPLUS 256 31) 5)) |as| VP |from| (IPLUS (LLSH (VHILOC (VVAG2 5 0)) 8) (LRSH (VLOLOC (VVAG2 5 0)) 8)) |by| 32 |do| (*) (VREADPAGEMAPBLOCK VP)) (|for| J |from| 0 |to| (SUB1 8) |as| FP |from| (SUB1 (VGETBASE (VVAG2 20 0) 23)) |do| (*) (MAPVMPAGE (IPLUS (IPLUS (LLSH (VHILOC (VVAG2 20 512)) 8) (LRSH (VLOLOC (VVAG2 20 512)) 8)) J) FP)) (|for| I |from| 0 |to| (SUB1 (LLSH 8 8)) |do| (COND ((IEQ (SETQ D (VGETBASE (VVAG2 20 512) I)) 65535)) (T (SETVMPTR (VADDBASE (VVAG2 5 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 5603 (VGETBASE (VVAG2 20 0) 15))) (|printout| T "Warning: " "Interface page key" "= " (PROGN 5603) ", but \\InterfacePage says " (VGETBASE (VVAG2 20 0) 15) T))))
)

(V\\LOCKEDPAGEP
(LAMBDA (VP TEMP) (*) (*) (OR (NEQ 0 (LOGAND (LLSH 1 (IMOD VP 16)) (VGETBASE (VADDBASE (VVAG2 20 28672) (LRSH VP 4)) 0))) NIL))
)

(V\\LOOKUPPAGEMAP
(LAMBDA (VP) (*) (*) (LET ((PRIMENTRY (VGETBASE (VVAG2 20 512) (LRSH VP 5)))) (COND ((EQ PRIMENTRY 65535) 0) (T (VGETBASE (VVAG2 5 0) (IPLUS PRIMENTRY (LOGAND VP 31)))))))
)

(VCHECKPAGEMAP
(LAMBDA NIL (*) (LET ((*PRINT-BASE* 8) (NUMOCCUPIED 0) (NUMLOCKED 0) (CHAINOCCUPIED 0) (CHAINLOCKED 0) RPTR FPBASE FP VP RP) (VCHECKFPTOVP) (|for| RPTINDEX |from| 1 |to| (SUB1 VRPTSIZE) |when| (ILESSP (VGETBASE (PROGN (SETQ RPTR (VADDBASE (VADDBASE VREALPAGETABLE (LLSH RPTINDEX 1)) RPTINDEX))) 1) 65534) |do| (SETQ NUMOCCUPIED (PLUS NUMOCCUPIED 1)) (SETQ VP (VGETBASE RPTR 1)) (SETQ FP (VGETBASE RPTR 2)) (COND ((VCHECKFPTOVP1 FP VP RPTINDEX)) ((NEQ VP (\\GETBASEFIXP (SETQ FPBASE (VADDBASE (VVAG2 2 0) FP)) 0)) (|printout| T "RPT for RP " (RPFROMRPT RPTINDEX) " says VP ") (\\PRINTVP VP T) (|printout| T " lives in FP " FP "; but FP Map says that FP contains ") (\\PRINTVP (\\GETBASEFIXP FPBASE 0) T) (|printout| T T)) ((V\\LOCKEDPAGEP VP) (SETQ NUMLOCKED (PLUS NUMLOCKED 1)) (COND ((NOT (NEQ 0 (LRSH (VGETBASE RPTR 0) 15))) (|printout| T "VP " VP ", living in RP " (RPFROMRPT RPTINDEX) " should be locked but isn't." T)) ((IGREATERP FP (DLRPFROMFP (VGETBASE (VVAG2 20 0) 57))) (|printout| T "VP " VP " is locked, but living in FP " FP ", which is not in the locked page area" T)))))) (PROGN (SETQ RPTR VREALPAGETABLE) (*) (|while| (NEQ (SETQ RP (LOGAND (VGETBASE RPTR 0) 32767)) 0) |when| (ILESSP (VGETBASE (PROGN (SETQ RPTR (VADDBASE (VADDBASE VREALPAGETABLE (LLSH RP 1)) RP))) 1) 65534) |do| (SETQ CHAINOCCUPIED (PLUS CHAINOCCUPIED 1)) (COND ((NEQ 0 (LRSH (VGETBASE RPTR 0) 15)) (SETQ CHAINLOCKED (PLUS CHAINLOCKED 1))))) (COND ((ILESSP CHAINOCCUPIED NUMOCCUPIED) (|printout| T NUMOCCUPIED " occupied pages, but only " CHAINOCCUPIED " are on page chain.  " NUMLOCKED " pages are permanently locked; " CHAINLOCKED " pages on chain are locked somehow." T))))))
)

(VCHECKFPTOVP
(LAMBDA NIL (*) (|for| FP |from| 1 |to| (\\GETBASEFIXP (VVAG2 20 0) 82) |as| (FPBASE _ (VADDBASE (VVAG2 2 0) 1)) |by| (VADDBASE FPBASE 1) |when| (NEQ (VGETBASE FPBASE 0) 65535) |do| (VCHECKFPTOVP1 FP (\\GETBASEFIXP FPBASE 0))))
)

(VCHECKFPTOVP1
(LAMBDA (FP VP RPTINDEX) (*) (PROG ((FP2 (V\\LOOKUPPAGEMAP VP))) (RETURN (COND ((NEQ FP2 FP) (COND (NIL (|printout| T "RPT for RP " (RPFROMRPT RPTINDEX))) (T (|printout| T "FP map"))) (|printout| T " says FP " FP " contains VP ") (\\PRINTVP VP T) (|printout| T "; but PageMap says that page is in FP " FP2 T) T)))))
)

(V\\SHOWPAGETABLE
(LAMBDA (MODE FILE) (*) (PROG ((*PRINT-BASE* 8) (OUTSTREAM (GETSTREAM FILE (QUOTE OUTPUT))) (RPTR VREALPAGETABLE) (RP 0) FLAGS VP STATE FIRSTONE LASTONE) (|printout| OUTSTREAM "     RP      VP           FilePage  Status" T) (|until| (SELECTQ MODE (CHAIN (EQ (SETQ RP (LOGAND (VGETBASE RPTR 0) 32767)) 0)) (NIL (SETQ RP (PLUS RP 1)) (IGEQ RP VRPTSIZE)) (\\ILLEGAL.ARG MODE)) |do| (SETQ RPTR (VADDBASE (VADDBASE VREALPAGETABLE (LLSH RP 1)) RP)) (SETQ VP (VGETBASE RPTR 1)) (COND ((AND (NULL MODE) (EQ VP STATE)) (SETQ LASTONE RP)) (T (COND (LASTONE (|printout| OUTSTREAM "ditto thru " LASTONE T) (SETQ LASTONE NIL))) (SETQ FIRSTONE RP) (SETQ STATE VP) (|printout| OUTSTREAM .I7.8 (RPFROMRPT RP)) (COND ((EQ (VGETBASE RPTR 1) 65534) (PRIN1 " Empty" OUTSTREAM)) ((NOT (ILESSP (VGETBASE RPTR 1) 65534)) (PRIN1 " Unavailable" OUTSTREAM)) (T (|printout| OUTSTREAM .I8.8 VP \,) (\\PRINTVP VP OUTSTREAM) (|printout| OUTSTREAM 28 .I6.8 (VGETBASE RPTR 2) |,,|) (COND ((NEQ 0 (LRSH (VGETBASE RPTR 0) 15)) (COND ((NOT (V\\LOCKEDPAGEP VP)) (*) (PRIN1 "Temp" OUTSTREAM))) (PRIN1 "Locked " OUTSTREAM))) NIL)) (TERPRI OUTSTREAM))))))
)

(V\\PRINTFPTOVP
(LAMBDA (FIRSTPAGE NWORDS TYPEFLG STREAM VPRAWFLG) (*) (SETQ STREAM (GETSTREAM STREAM (QUOTE OUTPUT))) (OR FIRSTPAGE (SETQ FIRSTPAGE 1)) (OR NWORDS (SETQ NWORDS (\\GETBASEFIXP (VVAG2 20 0) 82))) (LET ((BASE (VADDBASE (VVAG2 2 0) (SUB1 FIRSTPAGE))) (*PRINT-BASE* 8) (LASTVP -2) (NEXTFP (SUB1 FIRSTPAGE)) FIRSTFP FIRSTVP NEXTVP LOCKEDP TYPE NEXTLOCKED NEXTTYPE) (|while| (IGEQ NWORDS 0) |do| (SETQ NEXTFP (PLUS NEXTFP 1)) (COND ((EQ NWORDS 0) (SETQ NEXTVP -1)) ((NEQ (SETQ NEXTVP (VGETBASE (SETQ BASE (VADDBASE BASE 1)) 0)) 65535) (SETQ NEXTLOCKED (V\\LOCKEDPAGEP NEXTVP)) (|if| TYPEFLG |then| (SETQ NEXTTYPE (VTYPENAME ((LAMBDA ($$1) (VVAG2 (LRSH (SETQ $$1 NEXTVP) 8) (LLSH (LOGAND $$1 255) 8))) NIL))) (|if| (NULL NEXTTYPE) |then| (SETQ NEXTTYPE (SELECTC (LRSH NEXTVP 8) ((LIST 8 (CL:1+ 8)) "Pnames") ((LIST 10 (CL:1+ 10)) "Definitions") ((LIST 12 (CL:1+ 12)) "Value cells") ((LIST 2 (CL:1+ 2)) "Property lists") ((VHILOC (VVAG2 2 0)) "\\FPTOVP") (1 "Stack") ((VHILOC (VVAG2 22 0)) "GC Main table") ((VHILOC (VVAG2 23 0)) "GC Overflow table") NIL)))))) (COND ((COND ((EQ NEXTVP 65535) (NEQ LASTVP 65535)) (T (OR (NEQ NEXTVP (ADD1 LASTVP)) (NEQ NEXTLOCKED LOCKEDP) (NEQ TYPE NEXTTYPE)))) (COND ((IGEQ LASTVP 0) (COND (FIRSTFP (|printout| STREAM FIRSTFP "-"))) (|printout| STREAM (SUB1 NEXTFP) 12) (COND ((EQ LASTVP 65535) (|printout| STREAM "empty")) (T (COND (FIRSTFP (|if| VPRAWFLG |then| (PRIN1 FIRSTVP STREAM) |else| (\\PRINTVP FIRSTVP STREAM)) (PRIN1 "-" STREAM))) (|if| VPRAWFLG |then| (PRIN1 LASTVP STREAM) |else| (\\PRINTVP LASTVP STREAM)) (COND (LOCKEDP (PRIN1 (QUOTE *) STREAM))) (|if| TYPE |then| (|printout| STREAM 32 TYPE)))))) (SETQ FIRSTFP) (TERPRI STREAM) (SETQ FIRSTVP NEXTVP)) (T (*) (OR FIRSTFP (SETQ FIRSTFP (SUB1 NEXTFP))))) (SETQ LASTVP NEXTVP) (SETQ LOCKEDP NEXTLOCKED) (SETQ TYPE NEXTTYPE) (SETQ NWORDS (PLUS NWORDS -1)))))
)
)
(DEFINEQ

(VRAIDCOMMAND
(LAMBDA NIL (*) (DECLARE (USEDFREE ROOTFRAME ALINKS? RAIDIX FRAME# VPRINTLEVEL)) (FRESHLINE T) (PROG (CMD) (SELECTQ (SETQ CMD (ASKUSER NIL NIL "@" (QUOTE ((Q "uit [confirm]" CONFIRMFLG T) (\ "^N - remote return [confirm]" NOECHOFLG T CONFIRMFLG T RETURN (QUOTE ^N)) (L "isp stack ") (\ "Lisp stack " NOECHOFLG T EXPLAINSTRING "^L -- Lisp stack from arbitrary frame or context" RETURN (QUOTE ^L)) (F "rame ") (\
 "Next frame " EXPLAINSTRING "LF - next frame" RETURN (QUOTE LF)) (^ " Previous frame ") (A "tom top-level value of atom: ") (D "efinition for atom: ") (P "roperty list for atom: ") (V " -- show object at Virtual address: ") (B "lock of storage starting at address: ") (S "how raw stack from address: ") (C "ode for function:") (\ "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)) (W "alk stack blocks starting at: ") (K "" EXPLAINSTRING "K -- Set linKtype for stack ops") (_ " Set word at address: ") (\ " Set value of atom " EXPLAINSTRING "^V -- Set value of atom" RETURN (QUOTE ^V)) (\ "atom number for atom: " EXPLAINSTRING "^O - look up atom" RETURN (QUOTE ^O)) (Z "Zap Print level to: ") (I "nspect InterfacePage [confirm]" CONFIRMFLG T) (U " -- Show remote screen [confirm]" CONFIRMFLG T) ("
" "" RETURN NIL) (\ " Enter Lisp " EXPLAINSTRING "^Y -- Enter Lisp" RETURN (QUOTE ^Y)))) T)) (^N (RETURN (QUOTE RETURN))) (Q (TERPRI T) (RETURN (QUOTE QUIT))) (NIL) (A (VPRINCOPY (VGETTOPVAL (VREADATOM)))) (P (VPRINCOPY (VGETPROPLIST (VREADATOM)))) (C (VPRINTCODE (VREADATOM) T RAIDIX)) (V (VPRINCOPY (VREADVA))) (B (VPRINTADDRS (VREADVA) (VREADOCT " for (number of words): "))) (S (VPRINTADDRS (VVAG2 1 (VREADOCT)) (VREADOCT " for (number of words): "))) (D (VPRINTADDRS (V\\ATOMCELL (PROGN (VREADATOM)) 10) 2)) (^O (PRINTNUM .I2 (VATOMNUMBER (VREADATOM)) T)) (^V (PROG ((ATM (VREADATOM))) (|printout| T " to be ") (VSETTOPVAL ATM (READ T T)))) ((L ^L) (VRAIDSTACKCMD CMD)) (F (VRAIDSHOWFRAME (SETQ FRAME# (PROG1 (READ T T) (READC T))))) (LF (OR FRAME# (SETQ FRAME# 0)) (|printout| T "(" .I1 (SETQ FRAME# (PLUS FRAME# 1)) ")" T) (VRAIDSHOWFRAME FRAME#)) (^ (COND ((OR (NULL FRAME#) (ILEQ FRAME# 1)) (|printout| T "No previous frame" T)) (T (|printout| T "(" .I1 (SETQ FRAME# (PLUS FRAME# -1)) ")" T) (VRAIDSHOWFRAME FRAME#)))) (^F (V\\PRINTBF (VREADOCT) NIL (FUNCTION VPRINCOPY))) (Z (LET ((A (PROG1 (READ T T) (READC T))) (D (PROG1 (READ T T) (READC T)))) (COND ((AND (FIXP A) (FIXP D)) (SETQ VPRINTLEVEL (CONS A D))) (T (PRINTOUT T "Must be two integers, car level then cdr level" T) (ERROR!))))) (W (VSHOWSTACKBLOCKS (COND ((EQ (PEEKC T) (QUOTE \
)) (READC T) (VGETBASE (VVAG2 20 0) 30)) (T (VREADOCT))))) (^X (V\\PRINTFRAME (VREADOCT) (QUOTE PRINCOPY))) (^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| T " Currently ") (PRINTNUM .I7 (VGETBASE VA 0) T) (|printout| T " 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 (VRAIDROOTFRAME)))) (FRPTQ (SUB1 N) (COND ((EQ (PROGN (SETQ FRAME (COND (ALINKS? (IDIFFERENCE (LOGAND (VGETBASE (VVAG2 1 FRAME) 1) (CONSTANT (LOGXOR (SUB1 2) -1))) 10)) (T (IDIFFERENCE (COND ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 FRAME) 1) 1))) (VGETBASE (VVAG2 1 FRAME) 1)) (T (VGETBASE (VVAG2 1 FRAME) 9))) 10))))) 0) (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)))
)

(VRAIDSTACKCMD
(LAMBDA (CMD) (*) (DECLARE (USEDFREE FRAME# ROOTFRAME)) (PROG (FRAME) (SETQ FRAME# 0) (COND ((EQ CMD (QUOTE L)) (VRAIDROOTFRAME)) (T (SETQ ROOTFRAME (SELECTQ (SETQ FRAME (ASKUSER NIL NIL "in context (? for help): " (QUOTE ((P "age fault") (G "arbage collection") (K "eyboard handler") (H "ard Return") (S "tack manipulator") (R "eset") (M "iscellaneous") (F "rame at location: "))) T)) (P (VGETBASE (VVAG2 20 0) 6)) (G (VGETBASE (VVAG2 20 0) 5)) (K (VGETBASE (VVAG2 20 0) 3)) (H (VGETBASE (VVAG2 20 0) 4)) (S (VGETBASE (VVAG2 20 0) 2)) (R (VGETBASE (VVAG2 20 0) 1)) (M (VGETBASE (VVAG2 20 0) 14)) (COND ((AND (ILESSP (SETQ FRAME (VREADOCT)) 256) (ILESSP (VGETBASE (VVAG2 20 0) FRAME) (VGETBASE (VVAG2 20 0) 7)) (IEQ (LRSH (VGETBASE (VVAG2 1 (PROGN (PROGN (VGETBASE (VVAG2 20 0) FRAME)))) 0) 13) 6)) (VGETBASE (VVAG2 20 0) FRAME)) ((IEQ (LRSH (VGETBASE (VVAG2 1 FRAME) 0) 13) 6) FRAME) (T (PRINTNUM .I7 FRAME) (|printout| T " not a valid frame." T) (RETURN))))))) (FRESHLINE T) (V\\BACKTRACE ROOTFRAME NIL T NIL NIL NIL ALINKS? (FUNCTION VPRINCOPY) 1 RAIDIX)))
)

(VRAIDROOTFRAME
(LAMBDA NIL (*) (SETQ ROOTFRAME (PROG1 (COND ((LISTP VMEMFILE) (PRIN1 "in TeleRaid Context" T) (VGETBASE (VVAG2 20 0) 24)) (T (VGETBASE (VVAG2 20 0) 0))) (TERPRI T))))
)

(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 ((EVENP (VLOLOC NB) 8) (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 .I2 (VLOLOC X)) (PRIN1 "}"))
)

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

(VREADOCT
(LAMBDA (PROMPT) (*) (DECLARE (USEDFREE RAIDIX)) (COND ((AND PROMPT (NOT (READP T))) (|printout| T PROMPT))) (|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)))))
)

(VREADATOM
(LAMBDA NIL (*) (PROG1 (HANDLER-BIND ((XCL:MISSING-EXTERNAL-SYMBOL (CL:FUNCTION (LAMBDA (CONDITION) (* |;;| "MAKE AN INTERNAL SYMBOL INSTEAD") (CL:INTERN (XCL:MISSING-EXTERNAL-SYMBOL-NAME CONDITION) (XCL:MISSING-EXTERNAL-SYMBOL-PACKAGE CONDITION))))) (XCL:MISSING-PACKAGE (CL:FUNCTION (LAMBDA (CONDITION) (* |;;| "FAKE A PACKAGE BY THIS NAME AND MAKE THE SYMBOL IN IT") (CL:INTERN (XCL:MISSING-PACKAGE-SYMBOL-NAME CONDITION) (CL:MAKE-PACKAGE (XCL:MISSING-PACKAGE-PACKAGE-NAME CONDITION) :USE NIL)))))) (CL:READ T)) (READC T)))
)

(VSHOWSTACKBLOCKS
(LAMBDA (SCANPTR WAITFLG) (*) (*) (PROG ((EASP (VGETBASE (VVAG2 20 0) 7))) SCAN (SELECTC (LRSH (VGETBASE (VVAG2 1 SCANPTR) 0) 13) (5 (VSHOWSTACKBLOCK1 SCANPTR "free block" (IEQ (VGETBASE (VVAG2 1 SCANPTR) 0) 40960)) (SETQ SCANPTR (PLUS SCANPTR (VGETBASE (VVAG2 1 SCANPTR) 1)))) (7 (VSHOWSTACKBLOCK1 SCANPTR "guard block" T) (SETQ SCANPTR (PLUS SCANPTR (VGETBASE (VVAG2 1 SCANPTR) 1)))) (6 (*) (VSHOWSTACKBLOCK1 SCANPTR "Frame extn = " (AND (IEQ (LRSH (VGETBASE (VVAG2 1 SCANPTR) 0) 13) 6) (OR (IEQ (IDIFFERENCE SCANPTR 2) (COND ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 SCANPTR) 1) 1))) (IDIFFERENCE SCANPTR 2)) (T (VGETBASE (VVAG2 1 SCANPTR) 8)))) (AND (NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 (PROGN (IDIFFERENCE SCANPTR 2))) 0) 9) 1)) (IEQ (VGETBASE (VVAG2 1 (PROGN (IDIFFERENCE SCANPTR 2))) 1) (VGETBASE (VVAG2 1 (PROGN (COND ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 SCANPTR) 1) 1))) (IDIFFERENCE SCANPTR 2)) (T (VGETBASE (VVAG2 1 SCANPTR) 8))))) 1)))))) (PRIN2 (V\\UNCOPY (VGETBASEPTR (PROGN (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 SCANPTR) 0) 9) 1)) (VGETBASEPTR (VVAG2 1 SCANPTR) 6)) (T (VGETBASEPTR (VVAG2 1 SCANPTR) 2)))) 4))) (SETQ SCANPTR (VGETBASE (VVAG2 1 SCANPTR) 4))) (PROG ((ORIG SCANPTR) IVAR) (*) (|while| (EQ (LRSH (VGETBASE (VVAG2 1 SCANPTR) 0) 13) 0) |do| (SETQ SCANPTR (PLUS SCANPTR 2))) (COND ((NOT (IEQ (LRSH (VGETBASE (VVAG2 1 SCANPTR) 0) 13) 4)) (VSHOWSTACKBLOCK1 ORIG "Garbage" T)) (T (SETQ IVAR (VGETBASE (VVAG2 1 SCANPTR) 1)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 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 1 SCANPTR) 0) 13) 4) (|for| I |from| (VGETBASE (VVAG2 1 SCANPTR) 1) |to| (IDIFFERENCE SCANPTR 2) |by| 2 |always| (IEQ 0 (LRSH (VGETBASE (VVAG2 1 I) 0) 13)))))))) (SETQ SCANPTR (PLUS 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 (CAR VPRINTLEVEL) (CDR VPRINTLEVEL)) T T)))

(VNOSUCHATOM
(LAMBDA (ATM) (*) (*) (|printout| T "No such atom: " ATM T) (ERROR "No such atom: ")))
)
(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 (PLUS CNT 1)))) (SETQ NAME (V\\STKNAME IPOS)) (COND (JUNK (TERPRI) (TERPRI) (PRIN1 "Basic frame at ") (PRINTNUM .I7 (SETQ BLINK (COND ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 IPOS) 1) 1))) (IDIFFERENCE IPOS 2)) (T (VGETBASE (VVAG2 1 IPOS) 8))))) (TERPRI) (V\\PRINTBF BLINK (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 IPOS) 0) 9) 1)) (VGETBASEPTR (VVAG2 1 IPOS) 6)) (T (VGETBASEPTR (VVAG2 1 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 ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 IPOS) 1) 1))) (IDIFFERENCE IPOS 2)) (T (VGETBASE (VVAG2 1 IPOS) 8))) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 IPOS) 0) 9) 1)) (VGETBASEPTR (VVAG2 1 IPOS) 6)) (T (VGETBASEPTR (VVAG2 1 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 (EQ (PROGN (SETQ IPOS (COND (ALINKS (IDIFFERENCE (LOGAND (VGETBASE (VVAG2 1 IPOS) 1) (CONSTANT (LOGXOR (SUB1 2) -1))) 10)) (T (IDIFFERENCE (COND ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 IPOS) 1) 1))) (VGETBASE (VVAG2 1 IPOS) 1)) (T (VGETBASE (VVAG2 1 IPOS) 9))) 10))))) 0))) (GO POSLP))) (RETURN T)))
)

(V\\STKNAME
(LAMBDA (POS) (*) (*) (LET ((NAME (VGETBASEPTR (PROGN (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 POS) 0) 9) 1)) (VGETBASEPTR (VVAG2 1 POS) 6)) (T (VGETBASEPTR (VVAG2 1 POS) 2)))) 4))) (|if| (EQ NAME (QUOTE \\INTERPRETER)) |then| (VGETBASEPTR (VVAG2 1 0) (LET ((BFLINK (COND ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 POS) 1) 1))) (IDIFFERENCE POS 2)) (T (VGETBASE (VVAG2 1 POS) 8))))) (+ (VGETBASE (VVAG2 1 BFLINK) 1) (TIMES (CL:1- (IDIFFERENCE (LRSH (IDIFFERENCE BFLINK (VGETBASE (VVAG2 1 BFLINK) 1)) 1) (LOGAND (LRSH (VGETBASE (VVAG2 1 BFLINK) 0) 8) 1))) 2)))) |else| NAME)))
)

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

(V\\PRINTFRAME
(LAMBDA (FRAME PRINTFN VARSONLY) (*) (PROG ((NMT (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 FRAME) 0) 9) 1)) (VGETBASEPTR (VVAG2 1 FRAME) 6)) (T (VGETBASEPTR (VVAG2 1 FRAME) 2)))) (I 0) (FT (IPLUS (IPLUS FRAME (PROGN 10)) (LLSH (ADD1 (SIGNED (VGETBASE (PROGN (VGETBASEPTR (VVAG2 1 FRAME) 2)) 2) 16)) 2) (PROGN 4))) TMP NLOCALS) (COND ((NOT VARSONLY) (V\\PRINTSTK FRAME) (PRIN1 "[") (PROGN (PROG ((FAST (NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 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 (NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 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 (NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 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 (NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 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 1 FRAME) 0) 255))) (DECLARE (LOCALVARS USECNT)) (COND ((NEQ USECNT 0) (PRIN1 (QUOTE "USE=")) (SELECTQ (CONSTANT (NTHCHAR (QUOTE "USE=") -1)) (= (|printout| NIL \, USECNT ", ")) NIL) T))) (PROG ((SLOWP (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 FRAME) 1) 1)))) (DECLARE (LOCALVARS SLOWP)) (COND (SLOWP (PRIN1 (QUOTE "X, ")) (SELECTQ (CONSTANT (NTHCHAR (QUOTE "X, ") -1)) (= (|printout| NIL \, SLOWP NIL)) NIL) T))) (PROG ((ALINK (IDIFFERENCE (LOGAND (VGETBASE (VVAG2 1 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 (VGETBASEPTR (VVAG2 1 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 1 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 ((NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 FRAME) 0) 9) 1)) (VGETBASEPTR (VVAG2 1 FRAME) 6)) (T (VGETBASEPTR (VVAG2 1 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 ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 FRAME) 1) 1))) (IDIFFERENCE FRAME 2)) (T (VGETBASE (VVAG2 1 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 (MAKE-NTENTRY 32768 J))) (AND (NEQ VARSONLY T) (SETQ TMP "local"))) (COND ((EQ (LRSH (VGETBASE (PROGN (VVAG2 1 I)) 0) 12) 0) (AND VARSONLY (SPACES 3)) (PRIN2 TMP) (SPACES 1) (APPLY* PRINTFN (VGETBASEPTR (VVAG2 1 I) 0))) ((NOT VARSONLY) (|printout| NIL TMP " [unbound]" T)))))) ((NOT VARSONLY) (COND ((SETQ TMP (V\\SCANFORNTENTRY NMT (MAKE-NTENTRY 49152 J))) (|printout| NIL "[fvar " .P2 TMP " " (COND ((EVENP (VGETBASE (PROGN (VVAG2 1 I)) 0)) (COND ((EQ (SETQ TMP (VHILOC ((LAMBDA ($$1) (VVAG2 (VGETBASE (PROGN $$1) 1) (VGETBASE $$1 0))) (VVAG2 1 I)))) 1) " on stack]") ((NEQ (LOGAND TMP (CONSTANT (LOGXOR (SUB1 2) -1))) (VHILOC (VVAG2 12 0))) (*) " non-stack binding]") (T " top value]"))) (T " not looked up]")) T)) (T (|printout| NIL "[padding]" T)))))) (COND ((NOT VARSONLY) (SETQ FT (VGETBASE (VVAG2 1 FRAME) 4)) (|for| |old| I |by| 2 |while| (ILESSP I FT) |do| (*) (V\\PRINTSTK I) (COND ((EQ (LRSH (VGETBASE (PROGN (VVAG2 1 I)) 0) 12) 0) (APPLY* PRINTFN (VGETBASEPTR (VVAG2 1 I) 0))) (T (TERPRI))))))))
)

(V\\SCANFORNTENTRY
(LAMBDA (NMT NTENTRY) (*) (*) (|bind| NM |for| NT1 |from| (PROGN 8) |by| (CONSTANT (PROGN 2)) |as| NT2 |from| (IPLUS (PROGN 8) (VGETBASE NMT 6)) |by| (CONSTANT (WORDSPERNTOFFSETENTRY)) |do| (COND ((NULL-NTENTRY (SETQ NM (GETSTKNAMEENTRY NMT NT1))) (RETURN))) (COND ((IEQP NTENTRY (GETSTKNTOFFSETENTRY NMT NT2)) (RETURN (VATOM NM))))))
)

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

(V\\CHECKARRAYBLOCK
(LAMBDA (BASE FREE ONFREELIST) (*) (COND (T (PROG (ERROR TRAILER) (COND ((NEQ (LRSH (VGETBASE BASE 0) 3) 5461) (SETQ ERROR "ARRAYBLOCK Password wrong")) ((NEQ (NEQ 0 (LOGAND (VGETBASE BASE 0) 1)) (NOT FREE)) (SETQ ERROR "ARRAYBLOCK INUSE bit set wrong")) (NIL (SETQ ERROR "Free ARRAYBLOCK with RefCnt not 1")) ((NEQ (LRSH (VGETBASE (SETQ TRAILER ((LAMBDA (BASE N) (DECLARE (LOCALVARS BASE N)) (VADDBASE (VADDBASE BASE N) N)) BASE (IDIFFERENCE (VGETBASE BASE 1) 1))) 0) 3) 5461) (SETQ ERROR "ARRAYBLOCK Trailer password wrong")) ((NEQ (VGETBASE BASE 1) (VGETBASE TRAILER 1)) (SETQ ERROR "ARRAYBLOCK Header and Trailer length don't match")) ((NEQ (NEQ 0 (LOGAND (VGETBASE BASE 0) 1)) (NOT FREE)) (SETQ ERROR "ARRAYBLOCK Trailer INUSE bit set wrong")) ((OR (NOT ONFREELIST) (ILESSP (VGETBASE BASE 1) 4)) (*) (RETURN)) ((OR (NOT (EQUAL (VGETBASEPTR (VGETBASEPTR BASE 4) 2) BASE)) (NOT (EQUAL (VGETBASEPTR (VGETBASEPTR BASE 2) 4) BASE))) (SETQ ERROR "ARRAYBLOCK links fouled")) ((|bind| (FBL _ ((LAMBDA (BASE N) (DECLARE (LOCALVARS BASE N)) (VADDBASE (VADDBASE BASE N) N)) VFREEBLOCKBUCKETS (IMIN (INTEGERLENGTH (VGETBASE BASE 1)) 30))) ROVER |first| (OR (SETQ ROVER (VGETBASEPTR FBL 0)) (RETURN (SETQ ERROR "Free block's bucket empty"))) |do| (AND (EQUAL ROVER BASE) (RETURN)) (V\\CHECKARRAYBLOCK ROVER T) |repeatuntil| (EQ (SETQ ROVER (VGETBASEPTR ROVER 2)) (VGETBASEPTR FBL 0)))) (T (*) (RETURN))) (ERROR BASE ERROR) (RETURN ERROR)))))
)

(V\\PARSEARRAYSPACE
(LAMBDA (FN) (*) (COND ((NEQ |VArrayFrLst2| (VVAG2 64 0)) (*) (V\\PARSEARRAYSPACE1 FN (VVAG2 46 0) |VArrayFrLst2|) (V\\PARSEARRAYSPACE1 FN (VVAG2 64 0) |VArrayFrLst|)) (T (V\\PARSEARRAYSPACE1 FN (VVAG2 46 0) |VArrayFrLst|))))
)

(V\\PARSEARRAYSPACE1
(LAMBDA (FN START END) (*) (|for| (ROVER _ START) |repeatuntil| (EQUAL END (SETQ ROVER ((LAMBDA (BASE N) (DECLARE (LOCALVARS BASE N)) (VADDBASE (VADDBASE BASE N) N)) ROVER (VGETBASE ROVER 1)))) |do| (V\\CHECKARRAYBLOCK ROVER (NOT (NEQ 0 (LOGAND (VGETBASE ROVER 0) 1))) (AND (NOT (NEQ 0 (LOGAND (VGETBASE ROVER 0) 1))) (VGETBASEPTR ROVER 2))) (AND FN (APPLY* FN ROVER (VGETBASE ROVER 1) (NEQ 0 (LOGAND (VGETBASE ROVER 0) 1)) (LOGAND (LRSH (VGETBASE ROVER 0) 1) 3)))))
)
)
(DEFINEQ

(VPRINTCODE
(LAMBDA (FN LVFLG RADIX OUTF FIRSTBYTE PC FN.IS.CODEBASE) (*) (*) (*) (*) (*) (*) (DECLARE (SPECVARS OUTF)) (OR RADIX (SETQ RADIX 16)) (LET ((CODEBASE (COND (FN.IS.CODEBASE FN) (T (OR (V\\GET-COMPILED-CODE-BASE FN) (AND (LITATOM FN) (V\\GET-COMPILED-CODE-BASE (GET FN (QUOTE CODE)))) (ERROR FN "not compiled code"))))) (I4 (NUMFORMATCODE (LIST (QUOTE FIX) (|if| (IGREATERP RADIX 15) |then| 3 |else| 4) RADIX))) (I6 (NUMFORMATCODE (LIST (QUOTE FIX) (|if| (IGREATERP RADIX 15) |then| 5 |else| 6) RADIX))) NTSIZE STARTPC TAG TEMP OP# PVARS FVARS IVARS) (DECLARE (SPECVARS CODEBASE IVARS PVARS FVARS I4 I6)) (*) (LET ((*PRINT-BASE* RADIX)) (|for| I |from| 0 |by| 2 |while| (ILESSP I (LLSH (PROGN 8) 1)) |do| (PRINTNUM I4 I OUTF) (PRIN1 ": " OUTF) (PRINTNUM I6 (LOGOR (LLSH (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR I 3))) (T (V\\GETBASEBYTE CODEBASE I))) 8) ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (ADD1 I))) OUTF) (SELECTQ I (0 (PRIN1 " stkmin" OUTF)) (2 (PRIN1 " na" OUTF)) (4 (PRIN1 " pv" OUTF)) (6 (PRIN1 " startpc" OUTF)) (8 (AND (NEQ 0 (LRSH (VGETBASE CODEBASE 4) 15)) (PRIN1 "[CLOSUREP]" OUTF)) (|printout| OUTF " byteswapped: " (NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1))) (|printout| OUTF " argtype: " (LOGAND (LRSH (VGETBASE CODEBASE 4) 12) 3))) (10 (|printout| OUTF " frame name: " .P2 (V\\UNCOPY (VGETBASEPTR CODEBASE 4)))) (12 (PRIN1 " ntsize" OUTF)) (14 (|printout| OUTF " nlocals: " (LRSH (VGETBASE CODEBASE 7) 8)) (|printout| OUTF " fvaroffset: " (LOGAND (VGETBASE CODEBASE 7) 255))) NIL) (*) (TERPRI OUTF))) (SETQ NTSIZE (VGETBASE CODEBASE 6)) (VPRINTCODENT "name table: " (LLSH (PROGN 8) 1) (LLSH NTSIZE 1)) (SETQ STARTPC (VGETBASE CODEBASE 3)) (COND ((GREATERP (SETQ NTSIZE (IDIFFERENCE (COND ((PROGN NIL) (*) (- STARTPC 4)) (T STARTPC)) (SETQ TEMP (IPLUS (LLSH (PROGN 8) 1) (COND ((EQ NTSIZE 0) (*) 8) (T (LLSH NTSIZE 2))))))) 4) (VPRINTCODENT "Local args: " TEMP (LRSH NTSIZE 1))) ((EQ NTSIZE 4) (*) (|printout| OUTF T "Info: " .P2 (VGETBASEPTR CODEBASE (LRSH TEMP 1)) T))) (|printout| OUTF T "----" T) (PROG ((CODELOC STARTPC) (LEVEL (AND LVFLG 0)) B B1 B2 B3 B4 B5 FN LEN LEVADJ STK) (COND (LEVEL (SETUPHASHARRAY (QUOTE \\PRINTCODE.LEVEL)) (SETUPHASHARRAY (QUOTE \\PRINTCODE.STKSTATE)) (CLRHASH \\PRINTCODE.LEVEL) (CLRHASH \\PRINTCODE.STKSTATE))) LP (COND ((AND PC (IGEQ CODELOC PC)) (*) (COND ((NOT (IEQP CODELOC PC)) (PRINTOUT OUTF "(PC ") (PRINTNUM I4 PC OUTF) (PRINTOUT OUTF " not found)"))) (|printout| OUTF "------------------------------" T) (SETQ PC))) (COND ((OR (NULL FIRSTBYTE) (IGEQ CODELOC FIRSTBYTE)) (PRINTNUM I4 CODELOC OUTF) (PRIN1 ": " OUTF) (COND (LVFLG (SETQ TEMP (GETHASH CODELOC \\PRINTCODE.LEVEL)) (COND (LEVEL (COND ((AND TEMP (OR (NEQ LEVEL TEMP) (NOT (EQUAL STK (GETHASH CODELOC \\PRINTCODE.STKSTATE))))) (PRIN1 "*" OUTF)))) (T (SETQ LEVEL TEMP) (SETQ STK (GETHASH CODELOC \\PRINTCODE.STKSTATE)))) (COND (LEVEL (TAB 7 NIL OUTF) (PRINTNUM I4 LEVEL OUTF))))) (TAB 12 NIL OUTF)) (T (*) (SETQ TAG (\\FINDOP ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (PROG1 CODELOC (SETQ CODELOC (PLUS 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 (CODEBASELT CODEBASE 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 ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (ADD1 CODELOC))))))) (MISCN (AND LEVEL (SETQ LEVEL (ADD1 (IDIFFERENCE LEVEL ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (IPLUS 2 CODELOC))))))) NIL) (COND ((AND LEVEL (SETQ LEVADJ (|fetch| LEVADJ |of| TAG))) (COND ((LISTP LEVADJ) (SETQ LEVADJ (CAR LEVADJ)))) (SELECTQ LEVADJ (FNX (SETQ LEVEL (PLUS LEVEL (IDIFFERENCE 1 (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR CODELOC 3))) (T (V\\GETBASEBYTE CODEBASE CODELOC))))))) (POP.N (SETQ LEVEL (IDIFFERENCE LEVEL (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR CODELOC 3))) (T (V\\GETBASEBYTE CODEBASE CODELOC)))))) ((JUMP UNWIND) (SETQ LEVEL)) ((CJUMP NCJUMP) (SETQ LEVEL (PLUS LEVEL -1))) (COND ((NUMBERP LEVADJ) (SETQ LEVEL (PLUS LEVEL LEVADJ))))))) (|add| CODELOC (|fetch| OPNARGS |of| TAG)) (GO LP))) (SETQ LEN (|fetch| OPNARGS |of| (SETQ TAG (\\FINDOP (SETQ B ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (PROG1 CODELOC (SETQ CODELOC (PLUS CODELOC 1))))))))) (PRINTNUM I4 B OUTF) (COND ((IGREATERP LEN 0) (PRINTNUM I4 (SETQ B1 ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (PROG1 CODELOC (SETQ CODELOC (PLUS CODELOC 1))))) OUTF))) (COND ((IGREATERP LEN 1) (PRINTNUM I4 (SETQ B2 ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (PROG1 CODELOC (SETQ CODELOC (PLUS CODELOC 1))))) OUTF))) (COND ((IGREATERP LEN 2) (PRINTNUM I4 (SETQ B3 ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (PROG1 CODELOC (SETQ CODELOC (PLUS CODELOC 1))))) OUTF))) (COND ((IGREATERP LEN 3) (PRINTNUM I4 (SETQ B4 ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (PROG1 CODELOC (SETQ CODELOC (PLUS CODELOC 1))))) OUTF))) (COND ((IGREATERP LEN 4) (PRINTNUM I4 (SETQ B5 ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (PROG1 CODELOC (SETQ CODELOC (PLUS CODELOC 1))))) OUTF))) (PROGN (|printout| OUTF 30 (|fetch| OPCODENAME |of| TAG)) (SETQ OP# (|fetch| OP# |of| TAG)) (SETQ LEVADJ (|fetch| LEVADJ |of| TAG))) (COND ((LISTP OP#) (SETQ OP# (CAR OP#)))) (SELECTQ (SETQ TAG (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)) \\PRINTCODE.LEVEL) (PUTHASH N STK \\PRINTCODE.STKSTATE)))) (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)) \\PRINTCODE.LEVEL) (PUTHASH N STK \\PRINTCODE.STKSTATE)))) (COND ((IGEQ B1 128) (IDIFFERENCE B1 256)) (T B1)))) (FN (*) (NEW-SYMBOL-CODE (SETQ B (IPLUS (LLSH (IPLUS (LLSH (IPLUS (LLSH B1 8) B2) 8) B3) 8) B4)) (SETQ B (IPLUS (LLSH B1 8) B2))) (|printout| OUTF 40 .P2 (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)) \\PRINTCODE.LEVEL) (PUTHASH N STK \\PRINTCODE.STKSTATE)))) (IPLUS (LLSH B1 8) B2 (COND ((IGREATERP B1 127) -65536) (T 0))))) (ATOM (|printout| OUTF 40 .P2 (VATOM (NEW-SYMBOL-CODE (IPLUS (LLSH (IPLUS (LLSH (IPLUS (LLSH B1 8) B2) 8) B3) 8) B4) (IPLUS (LLSH B1 8) B2))))) (GCONST (|printout| OUTF 40 .P2 (V\\UNCOPY (VVAG2 (IPLUS (LLSH B1 8) B2) (IPLUS (LLSH B3 8) B4))))) (FNX (|printout| OUTF "(" B1 ")" 40 .P2 (VATOM (NEW-SYMBOL-CODE (IPLUS (LLSH (IPLUS (LLSH (IPLUS (LLSH B2 8) B3) 8) B4) 8) B5) (IPLUS (LLSH B2 8) B3))))) (TYPEP (|printout| OUTF "(" .P2 (OR (V\\TYPENAMEFROMNUMBER B1) (QUOTE ?)) ")")) (UNBIND (AND LEVEL (SETQ LEVEL (|pop| STK)))) (DUNBIND (AND LEVEL (SETQ LEVEL (SUB1 (|pop| STK))))) (RETURN (SETQ LEVEL)) (SUBRCALL (|printout| OUTF 40 (|for| X |in| \\INITSUBRS |when| (EQ B1 (CADR X)) |do| (RETURN (CAR X)) |finally| (RETURN "?"))) (AND LEVEL (SETQ LEVEL (ADD1 (IDIFFERENCE LEVEL B2))))) (MISCN (|printout| OUTF 40 (|for| X |in| \\USER-SUBR-LIST |when| (EQ B1 (CADR X)) |do| (RETURN (CAR X)) |finally| (RETURN "?"))) (AND LEVEL (SETQ LEVEL (ADD1 (IDIFFERENCE LEVEL B2))))) (COND ((LISTP TAG) (|printout| OUTF 40 (CAR (NTH TAG (ADD1 B1))))))) (TERPRI OUTF) (COND ((AND LEVEL LEVADJ) (SELECTQ LEVADJ (FNX (SETQ LEVEL (PLUS LEVEL (IDIFFERENCE 1 B1)))) (POP.N (SETQ LEVEL (IDIFFERENCE LEVEL B1))) ((JUMP UNWIND) (SETQ LEVEL)) ((CJUMP NCJUMP) (SETQ LEVEL (PLUS LEVEL -1))) (COND ((NUMBERP LEVADJ) (SETQ LEVEL (PLUS LEVEL LEVADJ))))))) (GO LP))))
)

(VPRINTCODENT
(LAMBDA (STR START1 START2) (DECLARE (USEDFREE CODEBASE IVARS PVARS FVARS I4 I6 OUTF)) (*) (*) (LET (NAME TAG) (COND ((ILESSP START1 (SETQ START2 (IPLUS START2 START1))) (|printout| OUTF STR T) (|for| NT1 |from| START1 |by| (LLSH (CONSTANT (PROGN 2)) 1) |while| (ILESSP NT1 START2) |as| NT2 |from| START2 |by| (LLSH (PROGN 2) 1) |do| (PRINTNUM I4 NT1 OUTF) (PRIN1 ": " OUTF) (|for| I |from| 0 |to| (CONSTANT (SUB1 (LLSH (CONSTANT (PROGN 2)) 1))) |do| (PRINTNUM I4 ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (IPLUS NT1 I)) OUTF)) (SPACES 2 OUTF) (PRINTNUM I4 NT2 OUTF) (PRIN1 ": " OUTF) (COND ((SETQ NAME (VATOM (CODEBASEGETNAME CODEBASE NT1))) (SETQ TAG (GETNTOFFSET CODEBASE NT2)) (|printout| OUTF .SP 1 (SELECTC (NTSLOT-VARTYPE (GETNTOFFSETENTRY CODEBASE NT2)) (0 (|push| IVARS (LIST TAG NAME)) (QUOTE IVAR)) (32768 (|push| PVARS (LIST TAG NAME)) (QUOTE PVAR)) (PROGN (|push| FVARS (LIST TAG NAME)) (QUOTE FVAR))) " " TAG ": " .P2 NAME))) (TERPRI OUTF))))))
)

(VBROKENDEF
(LAMBDA (DEF WHEN) (*) (PROG ((CA (V\\GET-COMPILED-CODE-BASE DEF)) BEFORE AFTER SIZE FIRSTBYTE NEWCA) (SETQ FIRSTBYTE (VGETBASE CA 3)) NIL (*) (PROGN (*) (PROGN (*) (SETQ NEWCA CA) (SETQ AFTER T)) (*) (COND (AFTER (*) (|bind| OP |do| (SELECTQ (CADR (SETQ OP (\\FINDOP (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE NEWCA 4) 14) 1)) (V\\GETBASEBYTE NEWCA (LOGXOR FIRSTBYTE 3))) (T (V\\GETBASEBYTE NEWCA FIRSTBYTE)))))) (-X- (RETURN)) (GCONST NIL) (RETURN ((LAMBDA (CODEBASE OFFSET NEWVALUE) (DECLARE (LOCALVARS CODEBASE OFFSET NEWVALUE)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\PUTBASEBYTE CODEBASE (LOGXOR OFFSET 3) NEWVALUE)) (T (V\\PUTBASEBYTE CODEBASE OFFSET NEWVALUE)))) NEWCA FIRSTBYTE (V\\CAR.UFN (\\FINDOP (QUOTE \\RETURN))))) NIL) (SETQ FIRSTBYTE (PLUS FIRSTBYTE 1 (CADDR OP))))))) (RETURN NEWCA)))
)
)
(DEFINEQ

(V\\CAR.UFN
(LAMBDA (X) (*) (*) (*) (COND ((VLISTP X) (COND ((ZEROP 1) (VGETBASEPTR X 0)) (T (COND ((EQ (LRSH (VGETBASE X 0) 12) 0) (VGETBASEPTR (VGETBASEPTR X 0) 0)) (T (VGETBASEPTR X 0)))))) ((NULL X) NIL) (T (SELECTQ T (T (LISPERROR "ARG NOT LIST" X)) ((NIL V\\CDR.UFN) (COND ((EQ X T) T) ((LITATOM X) NIL) (T (QUOTE "{car of non-list}")))) (COND ((EQ X T) T) ((STRINGP X) (LISPERROR "ARG NOT LIST" X)) (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) 12))) (RETURN (COND ((EQ Q 8) NIL) ((IGREATERP Q 8) (VADDBASE (VVAG2 (VHILOC X) (LOGAND (VLOLOC X) 65280)) (LLSH (IDIFFERENCE Q 8) 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) (T (SELECTQ T ((T V\\CDR.UFN) (LISPERROR "ARG NOT LIST" X)) (NIL (COND ((LITATOM X) (VGETPROPLIST X)) (T "{cdr of non-list}"))) (COND ((STRINGP X) (LISPERROR "ARG NOT LIST" X)) (T "{cdr of non-list}"))))))
)
)
(DEFINEQ

(V\\COPY
(LAMBDA (X) (*) (*) (SELECTQ (TYPENAME X) ((LITATOM NEW-ATOM) (VATOMNUMBER X T)) (VLISTP (PROG ((R (REVERSE X)) (V (V\\COPY (CDR (LAST X))))) LP (COND ((LISTP R) (SETQ V (CONS (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 (CREATECELL 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))) (ONED-ARRAY (%COPY-ONED-ARRAY X)) (STRINGP (*) (%COPY-STRING-TO-ARRAY X)) (FLOATP (PROG ((VAL (CREATECELL 3))) (SELECTQ (SYSTEMTYPE) ((ALTO D) (VPUTBASE VAL 0 (\\GETBASE X 0)) (VPUTBASE VAL 1 (\\GETBASE X 1))) (MKI.IEEE X VAL)) (RETURN VAL))) (CHARACTER (VVAG2 7 (CL:CHAR-CODE X))) (ERROR X "can't be copied to remote file")))
)

(V\\UNCOPY
(LAMBDA (X CARLVL CDRLVL) (*) (SELECTC (VNTYPX X) (1 (COND ((EQ (VHILOC X) 14) (*) (VLOLOC X)) (T (IPLUS (VLOLOC X) -65536)))) (2 (*) (|create| FIXP HINUM _ (VGETBASE X 0) LONUM _ (VGETBASE X 1))) (3 (|create| FLOATP HIWORD _ (VGETBASE X 0) LOWORD _ (VGETBASE X 1))) (4 (VATOM (VLOLOC X))) (7 (PROG ((PTR (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE X 2) 14) 1)) (%ARRAY-BASE X)) (T (VGETBASEPTR X 0)))) (OFFST (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE X 2) 14) 1)) (%ARRAY-OFFSET X)) (T (VGETBASE X 3)))) (LENGTH (\\GETBASEFIXP X 4)) (I 1) STR) (*) (SETQ STR (ALLOCSTRING LENGTH)) (FRPTQ LENGTH (RPLSTRING STR I (FCHARACTER (V\\GETBASEBYTE PTR OFFST))) (SETQ I (PLUS I 1)) (SETQ OFFST (PLUS OFFST 1))) (RETURN STR))) (9 (\\VAG2 7 (VLOLOC X))) (%ONED-ARRAY (LET ((SIZE (\\GETBASEFIXP X 6)) (BASE (VGETBASEPTR X 0)) (OFFSET (VGETBASE X 3)) (TYPENUMBER (LOGAND (VGETBASE X 2) 255)) NCELLS LOCAL-ARRAY LOCAL-BASE) (|if| (EQ (%TYPENUMBER-TO-GC-TYPE TYPENUMBER) 1) |then| (VTYPEDPOINTER (VTYPENAME X) X) |else| (SETQ NCELLS (LRSH (IPLUS (ITIMES (IPLUS SIZE OFFSET) (%TYPENUMBER-TO-BITS-PER-ELEMENT TYPENUMBER)) 31) 5)) (SETQ LOCAL-ARRAY (|create| ONED-ARRAY)) (SETQ LOCAL-BASE (\\ALLOCBLOCK NCELLS)) (|freplace| (ONED-ARRAY BASE) |of| LOCAL-ARRAY |with| LOCAL-BASE) (|freplace| (ONED-ARRAY STRING-P) |of| LOCAL-ARRAY |with| (%CHAR-TYPE-P TYPENUMBER)) (|freplace| (ONED-ARRAY FILL-POINTER-P) |of| LOCAL-ARRAY |with| (NEQ 0 (LOGAND (LRSH (VGETBASE X 2) 9) 1))) (|freplace| (ONED-ARRAY TYPE-NUMBER) |of| LOCAL-ARRAY |with| TYPENUMBER) (|freplace| (ONED-ARRAY FILL-POINTER) |of| LOCAL-ARRAY |with| (\\GETBASEFIXP X 4)) (|if| (NEQ OFFSET 0) |then| (|freplace| (ONED-ARRAY OFFSET) |of| LOCAL-ARRAY |with| OFFSET) (|freplace| (ONED-ARRAY DISPLACED-P) |of| LOCAL-ARRAY |with| T)) (|freplace| (ONED-ARRAY TOTAL-SIZE) |of| LOCAL-ARRAY |with| SIZE) (|for| I |from| 0 |to| (SUB1 (LLSH NCELLS 1)) |do| (\\PUTBASE LOCAL-BASE I (VGETBASE BASE I))) LOCAL-ARRAY))) (5 (COND ((VLISTP X) (COND ((EQ CDRLVL 0) (*) (QUOTE (--))) (T (CONS (COND ((OR (EQ CARLVL 0) (AND (OR (EQ CARLVL 1) (EQ CDRLVL 1)) (VLISTP (V\\CAR.UFN X)))) (QUOTE &)) (T (V\\UNCOPY (V\\CAR.UFN X) (AND CARLVL (SUB1 CARLVL)) (AND CDRLVL (SUB1 CDRLVL))))) (V\\UNCOPY (V\\CDR.UFN X) CARLVL (AND CDRLVL (SUB1 CDRLVL))))))) (T (*) (VTYPEDPOINTER (QUOTE LISTP) X)))) (0 (VTYPEDPOINTER NIL X)) (VTYPEDPOINTER (VTYPENAME X) X)))
)
)
(DEFINEQ

(V\\GETBASEBYTE
(LAMBDA (PTR N) (*) (*) (COND ((EVENP N) (LRSH (PROGN (VGETBASE PTR (LRSH N 1))) 8)) (T (LOGAND (PROGN (VGETBASE PTR (LRSH N 1))) 255))))
)

(V\\PUTBASEBYTE
(LAMBDA (PTR DISP BYTE) (*) (*) (SETQ BYTE (PROG1 BYTE)) (VPUTBASE PTR (LRSH (SETQ DISP (\\DTEST DISP (QUOTE SMALLP))) 1) (COND ((EVENP DISP 2) ((LAMBDA ($$1) (IPLUS (LLSH BYTE 8) (LOGAND $$1 255))) (VGETBASE PTR (LRSH DISP 1)))) (T ((LAMBDA ($$1) (IPLUS (LLSH (LRSH $$1 8) 8) BYTE)) (VGETBASE PTR (LRSH DISP 1)))))) BYTE)
)
)
(DEFINEQ

(VNTYPX
(LAMBDA (X) (*) (*) (LOGAND (VGETBASE (VVAG2 24 0) (LRSH (IPLUS (LLSH (VHILOC X) 8) (LRSH (VLOLOC X) 8)) 1)) 2047))
)

(VTYPENAME
(LAMBDA (X) (*) (*) (*) (LET ((N (VNTYPX X))) (COND ((EQ N 6) ((LAMBDA (X) (QUOTE ARRAYP)) X)) ((%STRINGP X) (*) (QUOTE STRINGP)) ((EQ (QUOTE NEW-ATOM) (SETQ N (VATOM (VGETBASEPTR (VADDBASE (VVAG2 20 4096) (ITIMES N 18)) 0)))) (*) (QUOTE LITATOM)) (T N))))
)

(V\\TYPENAMEFROMNUMBER
(LAMBDA (N) (*) (COND ((ILESSP N (ADD1 |VMaxTypeNumber|)) (VATOM (VGETBASEPTR (VADDBASE (VVAG2 20 4096) (ITIMES N 18)) 0)))))
)
)
(DEFINEQ

(VUNCOPYATOM
(LAMBDA (N) (*) (*) (PROG (ATOM.NAME VPACKAGE.NAME) (*) (SETQ ATOM.NAME (VSYMBOL.PNAME N)) (*) (SETQ VPACKAGE.NAME (IF (READSYS.HAS.PACKAGES) THEN (VPACKAGE.NAME (VSYMBOL.PACKAGE N)) ELSE "INTERLISP")) (RETURN (VMAKE.LOCAL.ATOM VPACKAGE.NAME ATOM.NAME))))
)

(VMAKE.LOCAL.ATOM
(LAMBDA (PKG.NAME ATM.NAME) (*) (*) (CL:INTERN ATM.NAME (OR (CL:FIND-PACKAGE PKG.NAME) (CL:MAKE-PACKAGE PKG.NAME :USES NIL))))
)

(VSYMBOL.VALUE
(LAMBDA (SYMBOL) (*) (*) (LET ((LOC (VOLD.FIND.SYMBOL SYMBOL 1 (NCHARS SYMBOL)))) (COND (NIL (*) (VGETBASEPTR (VADDBASE (VVAG2 12 LOC) LOC) 0)) (T (*) (VGETBASEPTR (VADDBASE (VVAG2 44 0) (IPLUS (ITIMES (LOGAND LOC 65535) 10) 2)) 0)))))
)

(VSYMBOL.PNAME
(LAMBDA (N BUFFER) (*) (*) (SETQ BUFFER (OR BUFFER (ALLOCSTRING \\PNAMELIMIT))) (PROG (ADDR LEN) (*) (COND (NIL (SETQ ADDR (VGETBASEPTR (VADDBASE (VADDBASE (VVAG2 8 0) N) N) 0))) (T (SETQ ADDR (VGETBASEPTR (VADDBASE (VVAG2 44 0) (IPLUS (ITIMES (LOGAND N 65535) 10) 0)) 0)))) (SETQ LEN (V\\GETBASEBYTE ADDR 0)) (|for| I |from| 1 |to| LEN |do| (RPLSTRING BUFFER I (FCHARACTER (V\\GETBASEBYTE ADDR I)))) (RETURN (SUBSTRING BUFFER 1 LEN))))
)

(VSYMBOL.PACKAGE
(LAMBDA (N) (*) (*) (PROG ((INDEX (COND (NIL (*) (LRSH (VGETBASE (VADDBASE (VADDBASE (VVAG2 8 0) N) N) 0) 8)) (NIL (T (LRSH (VGETBASE (VADDBASE (VVAG2 44 0) (IPLUS (ITIMES 10 N) 0 8)) 0) 8))) (T (LRSH (VGETBASE (V\\ATOMCELL N 8) 8) 8))))) (RETURN (COND ((EQ INDEX *UNINTERNED-PACKAGE-INDEX*) NIL) (T (VGETBASEPTR (VGETBASEPTR READSYS.PACKAGE.FROM.INDEX 0) (LLSH INDEX 1)))))))
)

(VOLD.FIND.SYMBOL
(LAMBDA (BASE OFFST LEN FATP NONNUMERICP) (*) (PROG ((FATCHARSEENP (AND FATP (NOT (NULL (|for| I |from| OFFST |to| (SUB1 (IPLUS OFFST LEN)) |suchthat| (IGREATERP (VGETBASE BASE I) 255)))))) HASH HASHENT ATM# PNBASE FIRSTCHAR FIRSTBYTE REPROBE) (*) (COND ((EQ LEN 0) (*) (SETQ HASH 0) (SETQ FIRSTBYTE 255) (GO LP))) (SETQ FIRSTCHAR (NTHCHARCODE BASE OFFST)) (*) NIL (*) (SETQ FIRSTBYTE (LOGAND FIRSTCHAR 255)) (*) (PROGN (*) (SETQ HASH (LLSH FIRSTBYTE 8)) (|for| CHAR# |from| (ADD1 OFFST) |to| (SUB1 (IPLUS OFFST LEN)) |do| (SETQ HASH (IPLUS16 (IPLUS16 (SETQ HASH (IPLUS16 HASH (LLSH (LOGAND HASH 4095) 2))) (LLSH (LOGAND HASH 255) 8)) (NTHCHARCODE BASE CHAR#))))) (*) LP (*) (COND ((NEQ 0 (SETQ HASHENT (VGETBASE (VVAG2 21 0) HASH))) (*) (COND ((STREQUAL (CL:SYMBOL-NAME BASE) (VSYMBOL.PNAME (SETQ ATM# (SUB1 HASHENT)))) (RETURN ATM#)) (T (*) (SETQ HASH (IPLUS16 HASH (OR REPROBE (SETQ REPROBE (LOGAND 63 (LOGOR 1 (LOGXOR FIRSTBYTE HASH))))))) (GO LP))))) (*) (RETURN (PROGN (LET ((NEWATOM (VNOSUCHATOM BASE OFFST LEN FATP FATCHARSEENP))) NIL NEWATOM)))))
)

(VLOOKUP-SYMBOL
(LAMBDA (TABLE STRING SXHASH ENTRY-HASH) (*) (*) (LET* ((VEC (VGETBASEPTR TABLE 0)) (*) (HASH (VGETBASEPTR TABLE 2)) (*) (LEN (\\GETBASEFIXP VEC 6)) (*) (H2 (ADD1 (IREMAINDER SXHASH (IDIFFERENCE LEN 2)))) (*)) (DECLARE (TYPE (CL:SIMPLE-ARRAY (CL:UNSIGNED-BYTE 8)) HASH) (TYPE (CL:SIMPLE-ARRAY (CL:UNSIGNED-BYTE 16)) VEC)) (PROG ((INDEX-VAR (IREMAINDER SXHASH LEN)) SYMBOL-NUMBER EHASH) (IF NIL THEN (CL:FORMAT T "Probe @ ~s~%" INDEX-VAR)) LOOP (SETQ EHASH (V\\GETBASEBYTE (VGETBASEPTR HASH 0) INDEX-VAR)) (*) (COND ((EQL EHASH ENTRY-HASH) (IF NIL THEN (CL:FORMAT T "Entry hash MATCHES~%")) (LET ((SYMBOL-NAME (VSYMBOL.PNAME (SETQ SYMBOL-NUMBER (VGETBASE (VGETBASEPTR VEC 0) INDEX-VAR))))) (*) (IF NIL THEN (CL:FORMAT T "Got symbol index~%")) (*) (COND ((STREQUAL SYMBOL-NAME STRING) (IF NIL THEN (CL:FORMAT T " found~%")) (GO DOIT)) (T (IF NIL THEN (CL:FORMAT T "Didn't match~%")))))) ((EQL 0 EHASH) (IF NIL THEN (CL:FORMAT T "Hit deleted entry (no match)~%")) (SETQ INDEX-VAR NIL) (GO DOIT)) (T (IF NIL THEN (CL:FORMAT T "Entry hash does not match~%")))) (SETQ INDEX-VAR (IREMAINDER (IPLUS INDEX-VAR H2) LEN)) (*) (IF NIL THEN (CL:FORMAT T "Reprobe @ ~s~%" INDEX-VAR)) (GO LOOP) DOIT (RETURN SYMBOL-NUMBER))))
)

(VFIND.PACKAGE
(LAMBDA (NAME) (*) (*) (PROG ((ITEM (MKSTRING NAME)) (HA READSYS.PACKAGE.FROM.NAME) BITS INDEX SLOT SKEY FIRSTINDEX REPROBE LIMIT ABASE VALUE) (SETQ BITS (STRINGHASHBITS ITEM)) (SETQ INDEX (LOGAND BITS (VGETBASE HA 1))) (*) (SETQ ABASE (VGETBASEPTR HA 2)) (SETQ FIRSTINDEX INDEX) (SETQ REPROBE (LOGOR (LOGAND (LOGXOR BITS (LRSH BITS 8)) (IMIN 63 (VGETBASE HA 1))) 1)) (*) (SETQ LIMIT (VGETBASE HA 1)) LP (SETQ SLOT ((LAMBDA (BASEA0198) (DECLARE (LOCALVARS BASEA0198)) (VADDBASE (VADDBASE BASEA0198 INDEX) INDEX)) (VADDBASE (VADDBASE ABASE INDEX) INDEX))) (*) (COND ((SETQ VALUE (VGETBASEPTR SLOT 2)) (*) (SETQ SKEY (V\\UNCOPY (VGETBASEPTR SLOT 0))) (COND ((STREQUAL ITEM SKEY) (*) (GO FOUND)))) ((NULL (VGETBASEPTR SLOT 0)) (*) (RETURN NIL))) (SETQ INDEX (LOGAND (IPLUS16 INDEX REPROBE) LIMIT)) (*) (COND ((EQ INDEX FIRSTINDEX) (*) (SHOULDNT "Hashing in full hash table"))) (GO LP) FOUND (RETURN (AND (NEQ VALUE \\HASH.NULL.VALUE) VALUE))))
)

(VFIND.SYMBOL
(LAMBDA (STRING PACKAGE) (*) (*) (LET* ((LENGTH (FFETCH (STRINGP LENGTH) OF STRING)) (HASH (COND ((EQL 0 LENGTH) 0) (T (PROG* ((TERMINUS LENGTH) (HASH (LLSH (NTHCHARCODE STRING 1) 8)) (CHAR# 2)) A0355 (COND ((IGREATERP CHAR# TERMINUS) (RETURN (PROGN HASH)))) (PROGN) (SETQ HASH (IPLUS16 (IPLUS16 (SETQ HASH (IPLUS16 HASH (LLSH (LOGAND HASH 4095) 2))) (LLSH (LOGAND HASH 255) 8)) (NTHCHARCODE STRING CHAR#))) (SETQ CHAR# (ADD1 CHAR#)) (GO A0355))))) (*) (EHASH (IPLUS (IREMAINDER (LOGXOR LENGTH HASH (RSH HASH 8) (RSH HASH 16) (RSH HASH 19)) 254) 2)) (*) (SYM) (WHERE) (DONE)) (COND ((NOT (VGETBASEPTR PACKAGE 14)) (*) (IF NIL THEN (PRINT "Checking INTERNAL symbols")) (LET ((INDEX (VLOOKUP-SYMBOL (VGETBASEPTR PACKAGE 16) STRING HASH EHASH))) (*) (COND (INDEX (SETQ SYM INDEX) (SETQ WHERE :INTERNAL) (SETQ DONE T)))))) (COND ((NOT DONE) (IF NIL THEN (PRINT "Checking EXTERNAL symbols")) (LET ((INDEX (VLOOKUP-SYMBOL (VGETBASEPTR PACKAGE 18) STRING HASH EHASH))) (*) (COND (INDEX (SETQ SYM INDEX) (SETQ WHERE :EXTERNAL) (SETQ DONE T)))))) (COND ((NOT DONE) (IF NIL THEN (CL:FORMAT T "Checking USE'd packages~%")) (LET ((HEAD (VGETBASEPTR PACKAGE 2)) (*)) (PROG ((PREV HEAD) (TABLE (V\\CDR.UFN HEAD))) USED-PACKAGE-LOOP (COND ((OR DONE (NULL TABLE)) (RETURN (PROGN (CL:VALUES NIL NIL))))) (PROGN (LET ((INDEX (VLOOKUP-SYMBOL (V\\CAR.UFN TABLE) STRING HASH EHASH))) (*) (COND (INDEX (COND ((NEQ PREV HEAD) (LET* ((A0347 PREV) (A0346 (V\\CDR.UFN A0347)) (A0349 TABLE) (A0348 (V\\CDR.UFN A0349)) (A0351 HEAD) (A0350 (V\\CDR.UFN A0351))) (V\\CDR.UFN (RPLACD A0347 A0348)) (V\\CDR.UFN (RPLACD A0349 A0350)) (V\\CDR.UFN (RPLACD A0351 TABLE)) A0346))) (SETQ SYM INDEX) (SETQ WHERE :INHERITED) (SETQ DONE T)) (T)))) (PROGN (SETQ PREV (PROG1 TABLE (PROGN (SETQ TABLE (V\\CDR.UFN TABLE)) NIL))) NIL) (GO USED-PACKAGE-LOOP))))) (CL:VALUES SYM WHERE)))
)

(VPACKAGE.NAME
(LAMBDA (RMPKG) (*) (AND RMPKG (V\\UNCOPY (VGETBASEPTR RMPKG 4)))))

(V\\MKATOM
(LAMBDA (BASE OFFST LEN FATP NONNUMERICP) (*) (PROG ((FATCHARSEENP (AND FATP (NOT (NULL (|for| I |from| OFFST |to| (SUB1 (IPLUS OFFST LEN)) |suchthat| (IGREATERP (VGETBASE BASE I) 255)))))) HASH HASHENT ATM# PNBASE FIRSTCHAR FIRSTBYTE REPROBE) (*) (COND ((EQ LEN 0) (*) (SETQ HASH 0) (SETQ FIRSTBYTE 255) (GO LP))) (SETQ FIRSTCHAR (NTHCHARCODE BASE OFFST)) (*) NIL (*) (SETQ FIRSTBYTE (LOGAND FIRSTCHAR 255)) (*) (PROGN (*) (SETQ HASH (LLSH FIRSTBYTE 8)) (|for| CHAR# |from| (ADD1 OFFST) |to| (SUB1 (IPLUS OFFST LEN)) |do| (SETQ HASH (IPLUS16 (IPLUS16 (SETQ HASH (IPLUS16 HASH (LLSH (LOGAND HASH 4095) 2))) (LLSH (LOGAND HASH 255) 8)) (NTHCHARCODE BASE CHAR#))))) (*) LP (*) (COND ((NEQ 0 (SETQ HASHENT (VGETBASE (VVAG2 21 0) HASH))) (*) (COND ((EQ (VATOM (SETQ ATM# (SUB1 HASHENT))) BASE) (RETURN (VADDBASE (VVAG2 0 0) ATM#))) (T (*) (SETQ HASH (IPLUS16 HASH (OR REPROBE (SETQ REPROBE (LOGAND 63 (LOGOR 1 (LOGXOR FIRSTBYTE HASH))))))) (GO LP))))) (*) (RETURN (PROGN (LET ((NEWATOM (VNOSUCHATOM BASE OFFST LEN FATP FATCHARSEENP))) NIL NEWATOM)))))
)

(VGETTOPVAL
(LAMBDA (X) (*) (VGETBASEPTR (V\\ATOMCELL X 12) 0)))

(VGETPROPLIST
(LAMBDA (ATM) (*) (VGETBASEPTR (V\\ATOMCELL ATM (CONSTANT 2)) 0)))

(VSETTOPVAL
(LAMBDA (ATM VAL) (*) (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 (V\\ATOMCELL ATM 12) 0 (V\\COPY VAL))))
)

(VGETDEFN
(LAMBDA (A) (*) (VGETBASEPTR (V\\ATOMCELL A 10) 0)))

(V\\ATOMCELL
(LAMBDA (X N) (*) (LET ((ATOMNO (VATOMNUMBER X))) (COND (NIL (*) (EQ (VHILOC ATOMNO) 0) (*) (LET ((LOC (SELECTC N (10 (VATOMNUMBER ATOMNO)) (12 (VATOMNUMBER ATOMNO)) (2 (VATOMNUMBER ATOMNO)) (8 (\\ATOMPNAMEINDEX ATOMNO)) (SHOULDNT)))) (VADDBASE (VVAG2 N LOC) LOC))) ((FIXP ATOMNO) (*) (LET ((LOC (SELECTC N (10 4) (12 2) (2 6) (8 0) (SHOULDNT)))) (VADDBASE (VVAG2 44 0) (IPLUS LOC (ITIMES 10 ATOMNO))))) (T (*) (LET ((OFFSET (SELECTC N (10 4) (12 2) (2 6) (8 0) (SHOULDNT)))) (VADDBASE ATOMNO OFFSET))))))
)
)
(DEFINEQ

(VLISTP
(LAMBDA (X) (*) (*) (AND (EQ (VNTYPX X) 5) (COND ((EQ 1 0) T) (T (*) (NEQ (LOGAND (VLOLOC X) 255) 0))) X))
)
)

(RPAQQ COPYATOMSTR NIL)
(DEFINEQ

(V\\GET-COMPILED-CODE-BASE
(LAMBDA (X) (*) (*) (PROG NIL (COND ((LITATOM X) (COND ((PROG1 (NEQ 0 (LRSH (VGETBASE (V\\ATOMCELL X 10) 0) 15)) (SETQ X (VGETBASEPTR (V\\ATOMCELL X 10) 0))) (RETURN X))))) (RETURN (AND (EQ (VNTYPX X) 13) (VGETBASEPTR (\\DTEST X (QUOTE COMPILED-CLOSURE)) 0)))))
)
)



(* |;;| 
"YOU MUST REMAKE THIS FILE using (DORENAME 'R) (after CONNing to library) whenever the SYSOUT layout changes in LLPARAMS (e.g., if MDSTypeTable moves)"
)


(FILESLOAD VMEM)

(RPAQQ RDVALS ((\\RPTSIZE) (|\\MaxTypeNumber|) (|\\AtomFrLst|) (|\\ArrayFrLst|) (|\\ArrayFrLst2|)))

(RPAQQ RDPTRS ((\\REALPAGETABLE) (\\FREEBLOCKBUCKETS)))
(DECLARE\: EVAL@COMPILE DONTCOPY 

(FILESLOAD (LOADCOMP) VMEM)
)
STOP
\ No newline at end of file
+(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
(FILECREATED "21-Mar-2021 21:59:39" |{DSK}<home>larry>ilisp>medley>tmp>RDSYS.;6|)


(PRETTYCOMPRINT RDSYSCOMS)

(RPAQQ RDSYSCOMS ((FNS VREADPAGEMAP VREADPAGEMAPBLOCK VCHECKIFPAGE V\\LOCKEDPAGEP V\\LOOKUPPAGEMAP VCHECKPAGEMAP VCHECKFPTOVP VCHECKFPTOVP1 V\\SHOWPAGETABLE V\\PRINTFPTOVP) (FNS VRAIDCOMMAND VRAIDSHOWFRAME VRAIDSTACKCMD VRAIDROOTFRAME VPRINTADDRS VPRINTVA VREADVA VREADOCT VREADATOM VSHOWSTACKBLOCKS VSHOWSTACKBLOCK1 VPRINCOPY VNOSUCHATOM) (FNS V\\BACKTRACE V\\STKNAME V\\PRINTBF V\\PRINTFRAME V\\SCANFORNTENTRY V\\PRINTSTK) (FNS V\\CHECKARRAYBLOCK V\\PARSEARRAYSPACE V\\PARSEARRAYSPACE1) (FNS VPRINTCODE VPRINTCODENT VBROKENDEF) (FNS V\\CAR.UFN V\\CDR.UFN) (FNS V\\COPY V\\UNCOPY) (FNS V\\GETBASEBYTE V\\PUTBASEBYTE) (FNS VNTYPX VTYPENAME V\\TYPENAMEFROMNUMBER) (FNS VUNCOPYATOM VMAKE.LOCAL.ATOM VSYMBOL.VALUE VSYMBOL.PNAME VSYMBOL.PACKAGE VOLD.FIND.SYMBOL VLOOKUP-SYMBOL VFIND.PACKAGE VFIND.SYMBOL VPACKAGE.NAME V\\MKATOM VGETTOPVAL VGETPROPLIST VSETTOPVAL VGETDEFN V\\ATOMCELL) (FNS VLISTP) (VARS (COPYATOMSTR)) (FNS V\\GET-COMPILED-CODE-BASE) (* |;;| "YOU MUST REMAKE THIS FILE using (DORENAME 'R) (after CONNing to library) whenever the SYSOUT layout changes in LLPARAMS (e.g., if MDSTypeTable moves)") (FILES VMEM) (VARS RDVALS RDPTRS) (DECLARE\: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) VMEM))))
(DEFINEQ

(VREADPAGEMAP
(LAMBDA NIL (*) (*) (PROG (D) (MAPVMPAGE (IPLUS (LLSH (VHILOC (VVAG2 20 0)) 8) (LRSH (VLOLOC (VVAG2 20 0)) 8)) 1) (*) (*) (MAPVMPAGE (IPLUS (LLSH (VHILOC (VVAG2 5 0)) 8) (LRSH (VLOLOC (VVAG2 5 0)) 8)) (SUB1 (VGETBASE (VVAG2 20 0) 22))) (*) (SETVMPTR (VVAG2 5 0)) (|for| I |from| 0 |to| (SUB1 (LRSH (IPLUS 256 31) 5)) |as| VP |from| (IPLUS (LLSH (VHILOC (VVAG2 5 0)) 8) (LRSH (VLOLOC (VVAG2 5 0)) 8)) |by| 32 |do| (*) (VREADPAGEMAPBLOCK VP)) (|for| J |from| 0 |to| (SUB1 8) |as| FP |from| (SUB1 (VGETBASE (VVAG2 20 0) 23)) |do| (*) (MAPVMPAGE (IPLUS (IPLUS (LLSH (VHILOC (VVAG2 20 512)) 8) (LRSH (VLOLOC (VVAG2 20 512)) 8)) J) FP)) (|for| I |from| 0 |to| (SUB1 (LLSH 8 8)) |do| (COND ((IEQ (SETQ D (VGETBASE (VVAG2 20 512) I)) 65535)) (T (SETVMPTR (VADDBASE (VVAG2 5 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 5603 (VGETBASE (VVAG2 20 0) 15))) (|printout| T "Warning: " "Interface page key" "= " (PROGN 5603) ", but \\InterfacePage says " (VGETBASE (VVAG2 20 0) 15) T))))
)

(V\\LOCKEDPAGEP
(LAMBDA (VP TEMP) (*) (*) (OR (NEQ 0 (LOGAND (LLSH 1 (IMOD VP 16)) (VGETBASE (VADDBASE (VVAG2 20 28672) (LRSH VP 4)) 0))) NIL))
)

(V\\LOOKUPPAGEMAP
(LAMBDA (VP) (*) (*) (LET ((PRIMENTRY (VGETBASE (VVAG2 20 512) (LRSH VP 5)))) (COND ((EQ PRIMENTRY 65535) 0) (T (VGETBASE (VVAG2 5 0) (IPLUS PRIMENTRY (LOGAND VP 31)))))))
)

(VCHECKPAGEMAP
(LAMBDA NIL (*) (LET ((*PRINT-BASE* 8) (NUMOCCUPIED 0) (NUMLOCKED 0) (CHAINOCCUPIED 0) (CHAINLOCKED 0) RPTR FPBASE FP VP RP) (VCHECKFPTOVP) (|for| RPTINDEX |from| 1 |to| (SUB1 VRPTSIZE) |when| (ILESSP (VGETBASE (PROGN (SETQ RPTR (VADDBASE (VADDBASE VREALPAGETABLE (LLSH RPTINDEX 1)) RPTINDEX))) 1) 65534) |do| (SETQ NUMOCCUPIED (PLUS NUMOCCUPIED 1)) (SETQ VP (VGETBASE RPTR 1)) (SETQ FP (VGETBASE RPTR 2)) (COND ((VCHECKFPTOVP1 FP VP RPTINDEX)) ((NEQ VP (\\GETBASEFIXP (SETQ FPBASE (VADDBASE (VVAG2 2 0) FP)) 0)) (|printout| T "RPT for RP " (RPFROMRPT RPTINDEX) " says VP ") (\\PRINTVP VP T) (|printout| T " lives in FP " FP "; but FP Map says that FP contains ") (\\PRINTVP (\\GETBASEFIXP FPBASE 0) T) (|printout| T T)) ((V\\LOCKEDPAGEP VP) (SETQ NUMLOCKED (PLUS NUMLOCKED 1)) (COND ((NOT (NEQ 0 (LRSH (VGETBASE RPTR 0) 15))) (|printout| T "VP " VP ", living in RP " (RPFROMRPT RPTINDEX) " should be locked but isn't." T)) ((IGREATERP FP (DLRPFROMFP (VGETBASE (VVAG2 20 0) 57))) (|printout| T "VP " VP " is locked, but living in FP " FP ", which is not in the locked page area" T)))))) (PROGN (SETQ RPTR VREALPAGETABLE) (*) (|while| (NEQ (SETQ RP (LOGAND (VGETBASE RPTR 0) 32767)) 0) |when| (ILESSP (VGETBASE (PROGN (SETQ RPTR (VADDBASE (VADDBASE VREALPAGETABLE (LLSH RP 1)) RP))) 1) 65534) |do| (SETQ CHAINOCCUPIED (PLUS CHAINOCCUPIED 1)) (COND ((NEQ 0 (LRSH (VGETBASE RPTR 0) 15)) (SETQ CHAINLOCKED (PLUS CHAINLOCKED 1))))) (COND ((ILESSP CHAINOCCUPIED NUMOCCUPIED) (|printout| T NUMOCCUPIED " occupied pages, but only " CHAINOCCUPIED " are on page chain.  " NUMLOCKED " pages are permanently locked; " CHAINLOCKED " pages on chain are locked somehow." T))))))
)

(VCHECKFPTOVP
(LAMBDA NIL (*) (|for| FP |from| 1 |to| (\\GETBASEFIXP (VVAG2 20 0) 82) |as| (FPBASE _ (VADDBASE (VVAG2 2 0) 1)) |by| (VADDBASE FPBASE 1) |when| (NEQ (VGETBASE FPBASE 0) 65535) |do| (VCHECKFPTOVP1 FP (\\GETBASEFIXP FPBASE 0))))
)

(VCHECKFPTOVP1
(LAMBDA (FP VP RPTINDEX) (*) (PROG ((FP2 (V\\LOOKUPPAGEMAP VP))) (RETURN (COND ((NEQ FP2 FP) (COND (NIL (|printout| T "RPT for RP " (RPFROMRPT RPTINDEX))) (T (|printout| T "FP map"))) (|printout| T " says FP " FP " contains VP ") (\\PRINTVP VP T) (|printout| T "; but PageMap says that page is in FP " FP2 T) T)))))
)

(V\\SHOWPAGETABLE
(LAMBDA (MODE FILE) (*) (PROG ((*PRINT-BASE* 8) (OUTSTREAM (GETSTREAM FILE (QUOTE OUTPUT))) (RPTR VREALPAGETABLE) (RP 0) FLAGS VP STATE FIRSTONE LASTONE) (|printout| OUTSTREAM "     RP      VP           FilePage  Status" T) (|until| (SELECTQ MODE (CHAIN (EQ (SETQ RP (LOGAND (VGETBASE RPTR 0) 32767)) 0)) (NIL (SETQ RP (PLUS RP 1)) (IGEQ RP VRPTSIZE)) (\\ILLEGAL.ARG MODE)) |do| (SETQ RPTR (VADDBASE (VADDBASE VREALPAGETABLE (LLSH RP 1)) RP)) (SETQ VP (VGETBASE RPTR 1)) (COND ((AND (NULL MODE) (EQ VP STATE)) (SETQ LASTONE RP)) (T (COND (LASTONE (|printout| OUTSTREAM "ditto thru " LASTONE T) (SETQ LASTONE NIL))) (SETQ FIRSTONE RP) (SETQ STATE VP) (|printout| OUTSTREAM .I7.8 (RPFROMRPT RP)) (COND ((EQ (VGETBASE RPTR 1) 65534) (PRIN1 " Empty" OUTSTREAM)) ((NOT (ILESSP (VGETBASE RPTR 1) 65534)) (PRIN1 " Unavailable" OUTSTREAM)) (T (|printout| OUTSTREAM .I8.8 VP \,) (\\PRINTVP VP OUTSTREAM) (|printout| OUTSTREAM 28 .I6.8 (VGETBASE RPTR 2) |,,|) (COND ((NEQ 0 (LRSH (VGETBASE RPTR 0) 15)) (COND ((NOT (V\\LOCKEDPAGEP VP)) (*) (PRIN1 "Temp" OUTSTREAM))) (PRIN1 "Locked " OUTSTREAM))) NIL)) (TERPRI OUTSTREAM))))))
)

(V\\PRINTFPTOVP
(LAMBDA (FIRSTPAGE NWORDS TYPEFLG STREAM VPRAWFLG) (*) (SETQ STREAM (GETSTREAM STREAM (QUOTE OUTPUT))) (OR FIRSTPAGE (SETQ FIRSTPAGE 1)) (OR NWORDS (SETQ NWORDS (\\GETBASEFIXP (VVAG2 20 0) 82))) (LET ((BASE (VADDBASE (VVAG2 2 0) (SUB1 FIRSTPAGE))) (*PRINT-BASE* 8) (LASTVP -2) (NEXTFP (SUB1 FIRSTPAGE)) FIRSTFP FIRSTVP NEXTVP LOCKEDP TYPE NEXTLOCKED NEXTTYPE) (|while| (IGEQ NWORDS 0) |do| (SETQ NEXTFP (PLUS NEXTFP 1)) (COND ((EQ NWORDS 0) (SETQ NEXTVP -1)) ((NEQ (SETQ NEXTVP (VGETBASE (SETQ BASE (VADDBASE BASE 1)) 0)) 65535) (SETQ NEXTLOCKED (V\\LOCKEDPAGEP NEXTVP)) (|if| TYPEFLG |then| (SETQ NEXTTYPE (VTYPENAME ((LAMBDA ($$1) (VVAG2 (LRSH (SETQ $$1 NEXTVP) 8) (LLSH (LOGAND $$1 255) 8))) NIL))) (|if| (NULL NEXTTYPE) |then| (SETQ NEXTTYPE (SELECTC (LRSH NEXTVP 8) ((LIST 8 (CL:1+ 8)) "Pnames") ((LIST 10 (CL:1+ 10)) "Definitions") ((LIST 12 (CL:1+ 12)) "Value cells") ((LIST 2 (CL:1+ 2)) "Property lists") ((VHILOC (VVAG2 2 0)) "\\FPTOVP") (1 "Stack") ((VHILOC (VVAG2 22 0)) "GC Main table") ((VHILOC (VVAG2 23 0)) "GC Overflow table") NIL)))))) (COND ((COND ((EQ NEXTVP 65535) (NEQ LASTVP 65535)) (T (OR (NEQ NEXTVP (ADD1 LASTVP)) (NEQ NEXTLOCKED LOCKEDP) (NEQ TYPE NEXTTYPE)))) (COND ((IGEQ LASTVP 0) (COND (FIRSTFP (|printout| STREAM FIRSTFP "-"))) (|printout| STREAM (SUB1 NEXTFP) 12) (COND ((EQ LASTVP 65535) (|printout| STREAM "empty")) (T (COND (FIRSTFP (|if| VPRAWFLG |then| (PRIN1 FIRSTVP STREAM) |else| (\\PRINTVP FIRSTVP STREAM)) (PRIN1 "-" STREAM))) (|if| VPRAWFLG |then| (PRIN1 LASTVP STREAM) |else| (\\PRINTVP LASTVP STREAM)) (COND (LOCKEDP (PRIN1 (QUOTE *) STREAM))) (|if| TYPE |then| (|printout| STREAM 32 TYPE)))))) (SETQ FIRSTFP) (TERPRI STREAM) (SETQ FIRSTVP NEXTVP)) (T (*) (OR FIRSTFP (SETQ FIRSTFP (SUB1 NEXTFP))))) (SETQ LASTVP NEXTVP) (SETQ LOCKEDP NEXTLOCKED) (SETQ TYPE NEXTTYPE) (SETQ NWORDS (PLUS NWORDS -1)))))
)
)
(DEFINEQ

(VRAIDCOMMAND
(LAMBDA NIL (*) (DECLARE (USEDFREE ROOTFRAME ALINKS? RAIDIX FRAME# VPRINTLEVEL)) (FRESHLINE T) (PROG (CMD) (SELECTQ (SETQ CMD (ASKUSER NIL NIL "@" (QUOTE ((Q "uit [confirm]" CONFIRMFLG T) (\ "^N - remote return [confirm]" NOECHOFLG T CONFIRMFLG T RETURN (QUOTE ^N)) (L "isp stack ") (\ "Lisp stack " NOECHOFLG T EXPLAINSTRING "^L -- Lisp stack from arbitrary frame or context" RETURN (QUOTE ^L)) (F "rame ") (\
 "Next frame " EXPLAINSTRING "LF - next frame" RETURN (QUOTE LF)) (^ " Previous frame ") (A "tom top-level value of atom: ") (D "efinition for atom: ") (P "roperty list for atom: ") (V " -- show object at Virtual address: ") (B "lock of storage starting at address: ") (S "how raw stack from address: ") (C "ode for function:") (\ "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)) (W "alk stack blocks starting at: ") (K "" EXPLAINSTRING "K -- Set linKtype for stack ops") (_ " Set word at address: ") (\ " Set value of atom " EXPLAINSTRING "^V -- Set value of atom" RETURN (QUOTE ^V)) (\ "atom number for atom: " EXPLAINSTRING "^O - look up atom" RETURN (QUOTE ^O)) (Z "Zap Print level to: ") (I "nspect InterfacePage [confirm]" CONFIRMFLG T) (U " -- Show remote screen [confirm]" CONFIRMFLG T) ("
" "" RETURN NIL) (\ " Enter Lisp " EXPLAINSTRING "^Y -- Enter Lisp" RETURN (QUOTE ^Y)))) T)) (^N (RETURN (QUOTE RETURN))) (Q (TERPRI T) (RETURN (QUOTE QUIT))) (NIL) (A (VPRINCOPY (VGETTOPVAL (VREADATOM)))) (P (VPRINCOPY (VGETPROPLIST (VREADATOM)))) (C (VPRINTCODE (VREADATOM) T RAIDIX)) (V (VPRINCOPY (VREADVA))) (B (VPRINTADDRS (VREADVA) (VREADOCT " for (number of words): "))) (S (VPRINTADDRS (VVAG2 1 (VREADOCT)) (VREADOCT " for (number of words): "))) (D (VPRINTADDRS (V\\ATOMCELL (PROGN (VREADATOM)) 10) 2)) (^O (PRINTNUM .I2 (VATOMNUMBER (VREADATOM)) T)) (^V (PROG ((ATM (VREADATOM))) (|printout| T " to be ") (VSETTOPVAL ATM (READ T T)))) ((L ^L) (VRAIDSTACKCMD CMD)) (F (VRAIDSHOWFRAME (SETQ FRAME# (PROG1 (READ T T) (READC T))))) (LF (OR FRAME# (SETQ FRAME# 0)) (|printout| T "(" .I1 (SETQ FRAME# (PLUS FRAME# 1)) ")" T) (VRAIDSHOWFRAME FRAME#)) (^ (COND ((OR (NULL FRAME#) (ILEQ FRAME# 1)) (|printout| T "No previous frame" T)) (T (|printout| T "(" .I1 (SETQ FRAME# (PLUS FRAME# -1)) ")" T) (VRAIDSHOWFRAME FRAME#)))) (^F (V\\PRINTBF (VREADOCT) NIL (FUNCTION VPRINCOPY))) (Z (LET ((A (PROG1 (READ T T) (READC T))) (D (PROG1 (READ T T) (READC T)))) (COND ((AND (FIXP A) (FIXP D)) (SETQ VPRINTLEVEL (CONS A D))) (T (PRINTOUT T "Must be two integers, car level then cdr level" T) (ERROR!))))) (W (VSHOWSTACKBLOCKS (COND ((EQ (PEEKC T) (QUOTE \
)) (READC T) (VGETBASE (VVAG2 20 0) 30)) (T (VREADOCT))))) (^X (V\\PRINTFRAME (VREADOCT) (QUOTE PRINCOPY))) (^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| T " Currently ") (PRINTNUM .I7 (VGETBASE VA 0) T) (|printout| T " 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 (VRAIDROOTFRAME)))) (FRPTQ (SUB1 N) (COND ((EQ (PROGN (SETQ FRAME (COND (ALINKS? (IDIFFERENCE (LOGAND (VGETBASE (VVAG2 1 FRAME) 1) (CONSTANT (LOGXOR (SUB1 2) -1))) 10)) (T (IDIFFERENCE (COND ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 FRAME) 1) 1))) (VGETBASE (VVAG2 1 FRAME) 1)) (T (VGETBASE (VVAG2 1 FRAME) 9))) 10))))) 0) (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)))
)

(VRAIDSTACKCMD
(LAMBDA (CMD) (*) (DECLARE (USEDFREE FRAME# ROOTFRAME)) (PROG (FRAME) (SETQ FRAME# 0) (COND ((EQ CMD (QUOTE L)) (VRAIDROOTFRAME)) (T (SETQ ROOTFRAME (SELECTQ (SETQ FRAME (ASKUSER NIL NIL "in context (? for help): " (QUOTE ((P "age fault") (G "arbage collection") (K "eyboard handler") (H "ard Return") (S "tack manipulator") (R "eset") (M "iscellaneous") (F "rame at location: "))) T)) (P (VGETBASE (VVAG2 20 0) 6)) (G (VGETBASE (VVAG2 20 0) 5)) (K (VGETBASE (VVAG2 20 0) 3)) (H (VGETBASE (VVAG2 20 0) 4)) (S (VGETBASE (VVAG2 20 0) 2)) (R (VGETBASE (VVAG2 20 0) 1)) (M (VGETBASE (VVAG2 20 0) 14)) (COND ((AND (ILESSP (SETQ FRAME (VREADOCT)) 256) (ILESSP (VGETBASE (VVAG2 20 0) FRAME) (VGETBASE (VVAG2 20 0) 7)) (IEQ (LRSH (VGETBASE (VVAG2 1 (PROGN (PROGN (VGETBASE (VVAG2 20 0) FRAME)))) 0) 13) 6)) (VGETBASE (VVAG2 20 0) FRAME)) ((IEQ (LRSH (VGETBASE (VVAG2 1 FRAME) 0) 13) 6) FRAME) (T (PRINTNUM .I7 FRAME) (|printout| T " not a valid frame." T) (RETURN))))))) (FRESHLINE T) (V\\BACKTRACE ROOTFRAME NIL T NIL NIL NIL ALINKS? (FUNCTION VPRINCOPY) 1 RAIDIX)))
)

(VRAIDROOTFRAME
(LAMBDA NIL (*) (SETQ ROOTFRAME (PROG1 (COND ((LISTP VMEMFILE) (PRIN1 "in TeleRaid Context" T) (VGETBASE (VVAG2 20 0) 24)) (T (VGETBASE (VVAG2 20 0) 0))) (TERPRI T))))
)

(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 ((EVENP (VLOLOC NB) 8) (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 .I2 (VLOLOC X)) (PRIN1 "}"))
)

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

(VREADOCT
(LAMBDA (PROMPT) (*) (DECLARE (USEDFREE RAIDIX)) (COND ((AND PROMPT (NOT (READP T))) (|printout| T PROMPT))) (|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)))))
)

(VREADATOM
(LAMBDA NIL (*) (PROG1 (HANDLER-BIND ((XCL:MISSING-EXTERNAL-SYMBOL (CL:FUNCTION (LAMBDA (CONDITION) (* |;;| "MAKE AN INTERNAL SYMBOL INSTEAD") (CL:INTERN (XCL:MISSING-EXTERNAL-SYMBOL-NAME CONDITION) (XCL:MISSING-EXTERNAL-SYMBOL-PACKAGE CONDITION))))) (XCL:MISSING-PACKAGE (CL:FUNCTION (LAMBDA (CONDITION) (* |;;| "FAKE A PACKAGE BY THIS NAME AND MAKE THE SYMBOL IN IT") (CL:INTERN (XCL:MISSING-PACKAGE-SYMBOL-NAME CONDITION) (CL:MAKE-PACKAGE (XCL:MISSING-PACKAGE-PACKAGE-NAME CONDITION) :USE NIL)))))) (CL:READ T)) (READC T)))
)

(VSHOWSTACKBLOCKS
(LAMBDA (SCANPTR WAITFLG) (*) (*) (PROG ((EASP (VGETBASE (VVAG2 20 0) 7))) SCAN (SELECTC (LRSH (VGETBASE (VVAG2 1 SCANPTR) 0) 13) (5 (VSHOWSTACKBLOCK1 SCANPTR "free block" (IEQ (VGETBASE (VVAG2 1 SCANPTR) 0) 40960)) (SETQ SCANPTR (PLUS SCANPTR (VGETBASE (VVAG2 1 SCANPTR) 1)))) (7 (VSHOWSTACKBLOCK1 SCANPTR "guard block" T) (SETQ SCANPTR (PLUS SCANPTR (VGETBASE (VVAG2 1 SCANPTR) 1)))) (6 (*) (VSHOWSTACKBLOCK1 SCANPTR "Frame extn = " (AND (IEQ (LRSH (VGETBASE (VVAG2 1 SCANPTR) 0) 13) 6) (OR (IEQ (IDIFFERENCE SCANPTR 2) (COND ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 SCANPTR) 1) 1))) (IDIFFERENCE SCANPTR 2)) (T (VGETBASE (VVAG2 1 SCANPTR) 8)))) (AND (NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 (PROGN (IDIFFERENCE SCANPTR 2))) 0) 9) 1)) (IEQ (VGETBASE (VVAG2 1 (PROGN (IDIFFERENCE SCANPTR 2))) 1) (VGETBASE (VVAG2 1 (PROGN (COND ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 SCANPTR) 1) 1))) (IDIFFERENCE SCANPTR 2)) (T (VGETBASE (VVAG2 1 SCANPTR) 8))))) 1)))))) (PRIN2 (V\\UNCOPY (VGETBASEPTR (PROGN (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 SCANPTR) 0) 9) 1)) (VGETBASEPTR (VVAG2 1 SCANPTR) 6)) (T (VGETBASEPTR (VVAG2 1 SCANPTR) 2)))) 4))) (SETQ SCANPTR (VGETBASE (VVAG2 1 SCANPTR) 4))) (PROG ((ORIG SCANPTR) IVAR) (*) (|while| (EQ (LRSH (VGETBASE (VVAG2 1 SCANPTR) 0) 13) 0) |do| (SETQ SCANPTR (PLUS SCANPTR 2))) (COND ((NOT (IEQ (LRSH (VGETBASE (VVAG2 1 SCANPTR) 0) 13) 4)) (VSHOWSTACKBLOCK1 ORIG "Garbage" T)) (T (SETQ IVAR (VGETBASE (VVAG2 1 SCANPTR) 1)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 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 1 SCANPTR) 0) 13) 4) (|for| I |from| (VGETBASE (VVAG2 1 SCANPTR) 1) |to| (IDIFFERENCE SCANPTR 2) |by| 2 |always| (IEQ 0 (LRSH (VGETBASE (VVAG2 1 I) 0) 13)))))))) (SETQ SCANPTR (PLUS 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 (CAR VPRINTLEVEL) (CDR VPRINTLEVEL)) T T)))

(VNOSUCHATOM
(LAMBDA (ATM) (*) (*) (|printout| T "No such atom: " ATM T) (ERROR "No such atom: ")))
)
(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 (PLUS CNT 1)))) (SETQ NAME (V\\STKNAME IPOS)) (COND (JUNK (TERPRI) (TERPRI) (PRIN1 "Basic frame at ") (PRINTNUM .I7 (SETQ BLINK (COND ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 IPOS) 1) 1))) (IDIFFERENCE IPOS 2)) (T (VGETBASE (VVAG2 1 IPOS) 8))))) (TERPRI) (V\\PRINTBF BLINK (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 IPOS) 0) 9) 1)) (VGETBASEPTR (VVAG2 1 IPOS) 6)) (T (VGETBASEPTR (VVAG2 1 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 ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 IPOS) 1) 1))) (IDIFFERENCE IPOS 2)) (T (VGETBASE (VVAG2 1 IPOS) 8))) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 IPOS) 0) 9) 1)) (VGETBASEPTR (VVAG2 1 IPOS) 6)) (T (VGETBASEPTR (VVAG2 1 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 (EQ (PROGN (SETQ IPOS (COND (ALINKS (IDIFFERENCE (LOGAND (VGETBASE (VVAG2 1 IPOS) 1) (CONSTANT (LOGXOR (SUB1 2) -1))) 10)) (T (IDIFFERENCE (COND ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 IPOS) 1) 1))) (VGETBASE (VVAG2 1 IPOS) 1)) (T (VGETBASE (VVAG2 1 IPOS) 9))) 10))))) 0))) (GO POSLP))) (RETURN T)))
)

(V\\STKNAME
(LAMBDA (POS) (*) (*) (LET ((NAME (VGETBASEPTR (PROGN (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 POS) 0) 9) 1)) (VGETBASEPTR (VVAG2 1 POS) 6)) (T (VGETBASEPTR (VVAG2 1 POS) 2)))) 4))) (|if| (EQ NAME (QUOTE \\INTERPRETER)) |then| (VGETBASEPTR (VVAG2 1 0) (LET ((BFLINK (COND ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 POS) 1) 1))) (IDIFFERENCE POS 2)) (T (VGETBASE (VVAG2 1 POS) 8))))) (+ (VGETBASE (VVAG2 1 BFLINK) 1) (TIMES (CL:1- (IDIFFERENCE (LRSH (IDIFFERENCE BFLINK (VGETBASE (VVAG2 1 BFLINK) 1)) 1) (LOGAND (LRSH (VGETBASE (VVAG2 1 BFLINK) 0) 8) 1))) 2)))) |else| NAME)))
)

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

(V\\PRINTFRAME
(LAMBDA (FRAME PRINTFN VARSONLY) (*) (PROG ((NMT (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 FRAME) 0) 9) 1)) (VGETBASEPTR (VVAG2 1 FRAME) 6)) (T (VGETBASEPTR (VVAG2 1 FRAME) 2)))) (I 0) (FT (IPLUS (IPLUS FRAME (PROGN 10)) (LLSH (ADD1 (SIGNED (VGETBASE (PROGN (VGETBASEPTR (VVAG2 1 FRAME) 2)) 2) 16)) 2) (PROGN 4))) TMP NLOCALS) (COND ((NOT VARSONLY) (V\\PRINTSTK FRAME) (PRIN1 "[") (PROGN (PROG ((FAST (NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 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 (NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 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 (NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 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 (NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 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 1 FRAME) 0) 255))) (DECLARE (LOCALVARS USECNT)) (COND ((NEQ USECNT 0) (PRIN1 (QUOTE "USE=")) (SELECTQ (CONSTANT (NTHCHAR (QUOTE "USE=") -1)) (= (|printout| NIL \, USECNT ", ")) NIL) T))) (PROG ((SLOWP (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 FRAME) 1) 1)))) (DECLARE (LOCALVARS SLOWP)) (COND (SLOWP (PRIN1 (QUOTE "X, ")) (SELECTQ (CONSTANT (NTHCHAR (QUOTE "X, ") -1)) (= (|printout| NIL \, SLOWP NIL)) NIL) T))) (PROG ((ALINK (IDIFFERENCE (LOGAND (VGETBASE (VVAG2 1 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 (VGETBASEPTR (VVAG2 1 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 1 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 ((NEQ 0 (LOGAND (LRSH (VGETBASE (VVAG2 1 FRAME) 0) 9) 1)) (VGETBASEPTR (VVAG2 1 FRAME) 6)) (T (VGETBASEPTR (VVAG2 1 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 ((NOT (NEQ 0 (LOGAND (VGETBASE (VVAG2 1 FRAME) 1) 1))) (IDIFFERENCE FRAME 2)) (T (VGETBASE (VVAG2 1 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 (MAKE-NTENTRY 32768 J))) (AND (NEQ VARSONLY T) (SETQ TMP "local"))) (COND ((EQ (LRSH (VGETBASE (PROGN (VVAG2 1 I)) 0) 12) 0) (AND VARSONLY (SPACES 3)) (PRIN2 TMP) (SPACES 1) (APPLY* PRINTFN (VGETBASEPTR (VVAG2 1 I) 0))) ((NOT VARSONLY) (|printout| NIL TMP " [unbound]" T)))))) ((NOT VARSONLY) (COND ((SETQ TMP (V\\SCANFORNTENTRY NMT (MAKE-NTENTRY 49152 J))) (|printout| NIL "[fvar " .P2 TMP " " (COND ((EVENP (VGETBASE (PROGN (VVAG2 1 I)) 0)) (COND ((EQ (SETQ TMP (VHILOC ((LAMBDA ($$1) (VVAG2 (VGETBASE (PROGN $$1) 1) (VGETBASE $$1 0))) (VVAG2 1 I)))) 1) " on stack]") ((NEQ (LOGAND TMP (CONSTANT (LOGXOR (SUB1 2) -1))) (VHILOC (VVAG2 12 0))) (*) " non-stack binding]") (T " top value]"))) (T " not looked up]")) T)) (T (|printout| NIL "[padding]" T)))))) (COND ((NOT VARSONLY) (SETQ FT (VGETBASE (VVAG2 1 FRAME) 4)) (|for| |old| I |by| 2 |while| (ILESSP I FT) |do| (*) (V\\PRINTSTK I) (COND ((EQ (LRSH (VGETBASE (PROGN (VVAG2 1 I)) 0) 12) 0) (APPLY* PRINTFN (VGETBASEPTR (VVAG2 1 I) 0))) (T (TERPRI))))))))
)

(V\\SCANFORNTENTRY
(LAMBDA (NMT NTENTRY) (*) (*) (|bind| NM |for| NT1 |from| (PROGN 8) |by| (CONSTANT (PROGN 2)) |as| NT2 |from| (IPLUS (PROGN 8) (VGETBASE NMT 6)) |by| (CONSTANT (WORDSPERNTOFFSETENTRY)) |do| (COND ((NULL-NTENTRY (SETQ NM (GETSTKNAMEENTRY NMT NT1))) (RETURN))) (COND ((IEQP NTENTRY (GETSTKNTOFFSETENTRY NMT NT2)) (RETURN (VATOM NM))))))
)

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

(V\\CHECKARRAYBLOCK
(LAMBDA (BASE FREE ONFREELIST) (*) (COND (T (PROG (ERROR TRAILER) (COND ((NEQ (LRSH (VGETBASE BASE 0) 3) 5461) (SETQ ERROR "ARRAYBLOCK Password wrong")) ((NEQ (NEQ 0 (LOGAND (VGETBASE BASE 0) 1)) (NOT FREE)) (SETQ ERROR "ARRAYBLOCK INUSE bit set wrong")) (NIL (SETQ ERROR "Free ARRAYBLOCK with RefCnt not 1")) ((NEQ (LRSH (VGETBASE (SETQ TRAILER ((LAMBDA (BASE N) (DECLARE (LOCALVARS BASE N)) (VADDBASE (VADDBASE BASE N) N)) BASE (IDIFFERENCE (VGETBASE BASE 1) 1))) 0) 3) 5461) (SETQ ERROR "ARRAYBLOCK Trailer password wrong")) ((NEQ (VGETBASE BASE 1) (VGETBASE TRAILER 1)) (SETQ ERROR "ARRAYBLOCK Header and Trailer length don't match")) ((NEQ (NEQ 0 (LOGAND (VGETBASE BASE 0) 1)) (NOT FREE)) (SETQ ERROR "ARRAYBLOCK Trailer INUSE bit set wrong")) ((OR (NOT ONFREELIST) (ILESSP (VGETBASE BASE 1) 4)) (*) (RETURN)) ((OR (NOT (EQUAL (VGETBASEPTR (VGETBASEPTR BASE 4) 2) BASE)) (NOT (EQUAL (VGETBASEPTR (VGETBASEPTR BASE 2) 4) BASE))) (SETQ ERROR "ARRAYBLOCK links fouled")) ((|bind| (FBL _ ((LAMBDA (BASE N) (DECLARE (LOCALVARS BASE N)) (VADDBASE (VADDBASE BASE N) N)) VFREEBLOCKBUCKETS (IMIN (INTEGERLENGTH (VGETBASE BASE 1)) 30))) ROVER |first| (OR (SETQ ROVER (VGETBASEPTR FBL 0)) (RETURN (SETQ ERROR "Free block's bucket empty"))) |do| (AND (EQUAL ROVER BASE) (RETURN)) (V\\CHECKARRAYBLOCK ROVER T) |repeatuntil| (EQ (SETQ ROVER (VGETBASEPTR ROVER 2)) (VGETBASEPTR FBL 0)))) (T (*) (RETURN))) (ERROR BASE ERROR) (RETURN ERROR)))))
)

(V\\PARSEARRAYSPACE
(LAMBDA (FN) (*) (COND ((NEQ |VArrayFrLst2| (VVAG2 64 0)) (*) (V\\PARSEARRAYSPACE1 FN (VVAG2 46 0) |VArrayFrLst2|) (V\\PARSEARRAYSPACE1 FN (VVAG2 64 0) |VArrayFrLst|)) (T (V\\PARSEARRAYSPACE1 FN (VVAG2 46 0) |VArrayFrLst|))))
)

(V\\PARSEARRAYSPACE1
(LAMBDA (FN START END) (*) (|for| (ROVER _ START) |repeatuntil| (EQUAL END (SETQ ROVER ((LAMBDA (BASE N) (DECLARE (LOCALVARS BASE N)) (VADDBASE (VADDBASE BASE N) N)) ROVER (VGETBASE ROVER 1)))) |do| (V\\CHECKARRAYBLOCK ROVER (NOT (NEQ 0 (LOGAND (VGETBASE ROVER 0) 1))) (AND (NOT (NEQ 0 (LOGAND (VGETBASE ROVER 0) 1))) (VGETBASEPTR ROVER 2))) (AND FN (APPLY* FN ROVER (VGETBASE ROVER 1) (NEQ 0 (LOGAND (VGETBASE ROVER 0) 1)) (LOGAND (LRSH (VGETBASE ROVER 0) 1) 3)))))
)
)
(DEFINEQ

(VPRINTCODE
(LAMBDA (FN LVFLG RADIX OUTF FIRSTBYTE PC FN.IS.CODEBASE) (*) (*) (*) (*) (*) (*) (DECLARE (SPECVARS OUTF)) (OR RADIX (SETQ RADIX 16)) (LET ((CODEBASE (COND (FN.IS.CODEBASE FN) (T (OR (V\\GET-COMPILED-CODE-BASE FN) (AND (LITATOM FN) (V\\GET-COMPILED-CODE-BASE (GET FN (QUOTE CODE)))) (ERROR FN "not compiled code"))))) (I4 (NUMFORMATCODE (LIST (QUOTE FIX) (|if| (IGREATERP RADIX 15) |then| 3 |else| 4) RADIX))) (I6 (NUMFORMATCODE (LIST (QUOTE FIX) (|if| (IGREATERP RADIX 15) |then| 5 |else| 6) RADIX))) NTSIZE STARTPC TAG TEMP OP# PVARS FVARS IVARS) (DECLARE (SPECVARS CODEBASE IVARS PVARS FVARS I4 I6)) (*) (LET ((*PRINT-BASE* RADIX)) (|for| I |from| 0 |by| 2 |while| (ILESSP I (LLSH (PROGN 8) 1)) |do| (PRINTNUM I4 I OUTF) (PRIN1 ": " OUTF) (PRINTNUM I6 (LOGOR (LLSH (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR I 3))) (T (V\\GETBASEBYTE CODEBASE I))) 8) ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (ADD1 I))) OUTF) (SELECTQ I (0 (PRIN1 " stkmin" OUTF)) (2 (PRIN1 " na" OUTF)) (4 (PRIN1 " pv" OUTF)) (6 (PRIN1 " startpc" OUTF)) (8 (AND (NEQ 0 (LRSH (VGETBASE CODEBASE 4) 15)) (PRIN1 "[CLOSUREP]" OUTF)) (|printout| OUTF " byteswapped: " (NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1))) (|printout| OUTF " argtype: " (LOGAND (LRSH (VGETBASE CODEBASE 4) 12) 3))) (10 (|printout| OUTF " frame name: " .P2 (V\\UNCOPY (VGETBASEPTR CODEBASE 4)))) (12 (PRIN1 " ntsize" OUTF)) (14 (|printout| OUTF " nlocals: " (LRSH (VGETBASE CODEBASE 7) 8)) (|printout| OUTF " fvaroffset: " (LOGAND (VGETBASE CODEBASE 7) 255))) NIL) (*) (TERPRI OUTF))) (SETQ NTSIZE (VGETBASE CODEBASE 6)) (VPRINTCODENT "name table: " (LLSH (PROGN 8) 1) (LLSH NTSIZE 1)) (SETQ STARTPC (VGETBASE CODEBASE 3)) (COND ((GREATERP (SETQ NTSIZE (IDIFFERENCE (COND ((PROGN NIL) (*) (- STARTPC 4)) (T STARTPC)) (SETQ TEMP (IPLUS (LLSH (PROGN 8) 1) (COND ((EQ NTSIZE 0) (*) 8) (T (LLSH NTSIZE 2))))))) 4) (VPRINTCODENT "Local args: " TEMP (LRSH NTSIZE 1))) ((EQ NTSIZE 4) (*) (|printout| OUTF T "Info: " .P2 (VGETBASEPTR CODEBASE (LRSH TEMP 1)) T))) (|printout| OUTF T "----" T) (PROG ((CODELOC STARTPC) (LEVEL (AND LVFLG 0)) B B1 B2 B3 B4 B5 FN LEN LEVADJ STK) (COND (LEVEL (SETUPHASHARRAY (QUOTE \\PRINTCODE.LEVEL)) (SETUPHASHARRAY (QUOTE \\PRINTCODE.STKSTATE)) (CLRHASH \\PRINTCODE.LEVEL) (CLRHASH \\PRINTCODE.STKSTATE))) LP (COND ((AND PC (IGEQ CODELOC PC)) (*) (COND ((NOT (IEQP CODELOC PC)) (PRINTOUT OUTF "(PC ") (PRINTNUM I4 PC OUTF) (PRINTOUT OUTF " not found)"))) (|printout| OUTF "------------------------------" T) (SETQ PC))) (COND ((OR (NULL FIRSTBYTE) (IGEQ CODELOC FIRSTBYTE)) (PRINTNUM I4 CODELOC OUTF) (PRIN1 ": " OUTF) (COND (LVFLG (SETQ TEMP (GETHASH CODELOC \\PRINTCODE.LEVEL)) (COND (LEVEL (COND ((AND TEMP (OR (NEQ LEVEL TEMP) (NOT (EQUAL STK (GETHASH CODELOC \\PRINTCODE.STKSTATE))))) (PRIN1 "*" OUTF)))) (T (SETQ LEVEL TEMP) (SETQ STK (GETHASH CODELOC \\PRINTCODE.STKSTATE)))) (COND (LEVEL (TAB 7 NIL OUTF) (PRINTNUM I4 LEVEL OUTF))))) (TAB 12 NIL OUTF)) (T (*) (SETQ TAG (\\FINDOP ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (PROG1 CODELOC (SETQ CODELOC (PLUS 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 (CODEBASELT CODEBASE 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 ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (ADD1 CODELOC))))))) (MISCN (AND LEVEL (SETQ LEVEL (ADD1 (IDIFFERENCE LEVEL ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (IPLUS 2 CODELOC))))))) NIL) (COND ((AND LEVEL (SETQ LEVADJ (|fetch| LEVADJ |of| TAG))) (COND ((LISTP LEVADJ) (SETQ LEVADJ (CAR LEVADJ)))) (SELECTQ LEVADJ (FNX (SETQ LEVEL (PLUS LEVEL (IDIFFERENCE 1 (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR CODELOC 3))) (T (V\\GETBASEBYTE CODEBASE CODELOC))))))) (POP.N (SETQ LEVEL (IDIFFERENCE LEVEL (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR CODELOC 3))) (T (V\\GETBASEBYTE CODEBASE CODELOC)))))) ((JUMP UNWIND) (SETQ LEVEL)) ((CJUMP NCJUMP) (SETQ LEVEL (PLUS LEVEL -1))) (COND ((NUMBERP LEVADJ) (SETQ LEVEL (PLUS LEVEL LEVADJ))))))) (|add| CODELOC (|fetch| OPNARGS |of| TAG)) (GO LP))) (SETQ LEN (|fetch| OPNARGS |of| (SETQ TAG (\\FINDOP (SETQ B ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (PROG1 CODELOC (SETQ CODELOC (PLUS CODELOC 1))))))))) (PRINTNUM I4 B OUTF) (COND ((IGREATERP LEN 0) (PRINTNUM I4 (SETQ B1 ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (PROG1 CODELOC (SETQ CODELOC (PLUS CODELOC 1))))) OUTF))) (COND ((IGREATERP LEN 1) (PRINTNUM I4 (SETQ B2 ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (PROG1 CODELOC (SETQ CODELOC (PLUS CODELOC 1))))) OUTF))) (COND ((IGREATERP LEN 2) (PRINTNUM I4 (SETQ B3 ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (PROG1 CODELOC (SETQ CODELOC (PLUS CODELOC 1))))) OUTF))) (COND ((IGREATERP LEN 3) (PRINTNUM I4 (SETQ B4 ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (PROG1 CODELOC (SETQ CODELOC (PLUS CODELOC 1))))) OUTF))) (COND ((IGREATERP LEN 4) (PRINTNUM I4 (SETQ B5 ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (PROG1 CODELOC (SETQ CODELOC (PLUS CODELOC 1))))) OUTF))) (PROGN (|printout| OUTF 30 (|fetch| OPCODENAME |of| TAG)) (SETQ OP# (|fetch| OP# |of| TAG)) (SETQ LEVADJ (|fetch| LEVADJ |of| TAG))) (COND ((LISTP OP#) (SETQ OP# (CAR OP#)))) (SELECTQ (SETQ TAG (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)) \\PRINTCODE.LEVEL) (PUTHASH N STK \\PRINTCODE.STKSTATE)))) (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)) \\PRINTCODE.LEVEL) (PUTHASH N STK \\PRINTCODE.STKSTATE)))) (COND ((IGEQ B1 128) (IDIFFERENCE B1 256)) (T B1)))) (FN (*) (NEW-SYMBOL-CODE (SETQ B (IPLUS (LLSH (IPLUS (LLSH (IPLUS (LLSH B1 8) B2) 8) B3) 8) B4)) (SETQ B (IPLUS (LLSH B1 8) B2))) (|printout| OUTF 40 .P2 (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)) \\PRINTCODE.LEVEL) (PUTHASH N STK \\PRINTCODE.STKSTATE)))) (IPLUS (LLSH B1 8) B2 (COND ((IGREATERP B1 127) -65536) (T 0))))) (ATOM (|printout| OUTF 40 .P2 (VATOM (NEW-SYMBOL-CODE (IPLUS (LLSH (IPLUS (LLSH (IPLUS (LLSH B1 8) B2) 8) B3) 8) B4) (IPLUS (LLSH B1 8) B2))))) (GCONST (|printout| OUTF 40 .P2 (V\\UNCOPY (VVAG2 (IPLUS (LLSH B1 8) B2) (IPLUS (LLSH B3 8) B4))))) (FNX (|printout| OUTF "(" B1 ")" 40 .P2 (VATOM (NEW-SYMBOL-CODE (IPLUS (LLSH (IPLUS (LLSH (IPLUS (LLSH B2 8) B3) 8) B4) 8) B5) (IPLUS (LLSH B2 8) B3))))) (TYPEP (|printout| OUTF "(" .P2 (OR (V\\TYPENAMEFROMNUMBER B1) (QUOTE ?)) ")")) (UNBIND (AND LEVEL (SETQ LEVEL (|pop| STK)))) (DUNBIND (AND LEVEL (SETQ LEVEL (SUB1 (|pop| STK))))) (RETURN (SETQ LEVEL)) (SUBRCALL (|printout| OUTF 40 (|for| X |in| \\INITSUBRS |when| (EQ B1 (CADR X)) |do| (RETURN (CAR X)) |finally| (RETURN "?"))) (AND LEVEL (SETQ LEVEL (ADD1 (IDIFFERENCE LEVEL B2))))) (MISCN (|printout| OUTF 40 (|for| X |in| \\USER-SUBR-LIST |when| (EQ B1 (CADR X)) |do| (RETURN (CAR X)) |finally| (RETURN "?"))) (AND LEVEL (SETQ LEVEL (ADD1 (IDIFFERENCE LEVEL B2))))) (COND ((LISTP TAG) (|printout| OUTF 40 (CAR (NTH TAG (ADD1 B1))))))) (TERPRI OUTF) (COND ((AND LEVEL LEVADJ) (SELECTQ LEVADJ (FNX (SETQ LEVEL (PLUS LEVEL (IDIFFERENCE 1 B1)))) (POP.N (SETQ LEVEL (IDIFFERENCE LEVEL B1))) ((JUMP UNWIND) (SETQ LEVEL)) ((CJUMP NCJUMP) (SETQ LEVEL (PLUS LEVEL -1))) (COND ((NUMBERP LEVADJ) (SETQ LEVEL (PLUS LEVEL LEVADJ))))))) (GO LP))))
)

(VPRINTCODENT
(LAMBDA (STR START1 START2) (DECLARE (USEDFREE CODEBASE IVARS PVARS FVARS I4 I6 OUTF)) (*) (*) (LET (NAME TAG) (COND ((ILESSP START1 (SETQ START2 (IPLUS START2 START1))) (|printout| OUTF STR T) (|for| NT1 |from| START1 |by| (LLSH (CONSTANT (PROGN 2)) 1) |while| (ILESSP NT1 START2) |as| NT2 |from| START2 |by| (LLSH (PROGN 2) 1) |do| (PRINTNUM I4 NT1 OUTF) (PRIN1 ": " OUTF) (|for| I |from| 0 |to| (CONSTANT (SUB1 (LLSH (CONSTANT (PROGN 2)) 1))) |do| (PRINTNUM I4 ((LAMBDA (CODEBASE OFFSET) (DECLARE (LOCALVARS CODEBASE OFFSET)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3))) (T (V\\GETBASEBYTE CODEBASE OFFSET)))) CODEBASE (IPLUS NT1 I)) OUTF)) (SPACES 2 OUTF) (PRINTNUM I4 NT2 OUTF) (PRIN1 ": " OUTF) (COND ((SETQ NAME (VATOM (CODEBASEGETNAME CODEBASE NT1))) (SETQ TAG (GETNTOFFSET CODEBASE NT2)) (|printout| OUTF .SP 1 (SELECTC (NTSLOT-VARTYPE (GETNTOFFSETENTRY CODEBASE NT2)) (0 (|push| IVARS (LIST TAG NAME)) (QUOTE IVAR)) (32768 (|push| PVARS (LIST TAG NAME)) (QUOTE PVAR)) (PROGN (|push| FVARS (LIST TAG NAME)) (QUOTE FVAR))) " " TAG ": " .P2 NAME))) (TERPRI OUTF))))))
)

(VBROKENDEF
(LAMBDA (DEF WHEN) (*) (PROG ((CA (V\\GET-COMPILED-CODE-BASE DEF)) BEFORE AFTER SIZE FIRSTBYTE NEWCA) (SETQ FIRSTBYTE (VGETBASE CA 3)) NIL (*) (PROGN (*) (PROGN (*) (SETQ NEWCA CA) (SETQ AFTER T)) (*) (COND (AFTER (*) (|bind| OP |do| (SELECTQ (CADR (SETQ OP (\\FINDOP (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE NEWCA 4) 14) 1)) (V\\GETBASEBYTE NEWCA (LOGXOR FIRSTBYTE 3))) (T (V\\GETBASEBYTE NEWCA FIRSTBYTE)))))) (-X- (RETURN)) (GCONST NIL) (RETURN ((LAMBDA (CODEBASE OFFSET NEWVALUE) (DECLARE (LOCALVARS CODEBASE OFFSET NEWVALUE)) (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE CODEBASE 4) 14) 1)) (V\\PUTBASEBYTE CODEBASE (LOGXOR OFFSET 3) NEWVALUE)) (T (V\\PUTBASEBYTE CODEBASE OFFSET NEWVALUE)))) NEWCA FIRSTBYTE (V\\CAR.UFN (\\FINDOP (QUOTE \\RETURN))))) NIL) (SETQ FIRSTBYTE (PLUS FIRSTBYTE 1 (CADDR OP))))))) (RETURN NEWCA)))
)
)
(DEFINEQ

(V\\CAR.UFN
(LAMBDA (X) (*) (*) (*) (COND ((VLISTP X) (COND ((ZEROP 1) (VGETBASEPTR X 0)) (T (COND ((EQ (LRSH (VGETBASE X 0) 12) 0) (VGETBASEPTR (VGETBASEPTR X 0) 0)) (T (VGETBASEPTR X 0)))))) ((NULL X) NIL) (T (SELECTQ T (T (LISPERROR "ARG NOT LIST" X)) ((NIL V\\CDR.UFN) (COND ((EQ X T) T) ((LITATOM X) NIL) (T (QUOTE "{car of non-list}")))) (COND ((EQ X T) T) ((STRINGP X) (LISPERROR "ARG NOT LIST" X)) (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) 12))) (RETURN (COND ((EQ Q 8) NIL) ((IGREATERP Q 8) (VADDBASE (VVAG2 (VHILOC X) (LOGAND (VLOLOC X) 65280)) (LLSH (IDIFFERENCE Q 8) 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) (T (SELECTQ T ((T V\\CDR.UFN) (LISPERROR "ARG NOT LIST" X)) (NIL (COND ((LITATOM X) (VGETPROPLIST X)) (T "{cdr of non-list}"))) (COND ((STRINGP X) (LISPERROR "ARG NOT LIST" X)) (T "{cdr of non-list}"))))))
)
)
(DEFINEQ

(V\\COPY
(LAMBDA (X) (*) (*) (SELECTQ (TYPENAME X) ((LITATOM NEW-ATOM) (VATOMNUMBER X T)) (VLISTP (PROG ((R (REVERSE X)) (V (V\\COPY (CDR (LAST X))))) LP (COND ((LISTP R) (SETQ V (CONS (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 (CREATECELL 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))) (ONED-ARRAY (%COPY-ONED-ARRAY X)) (STRINGP (*) (%COPY-STRING-TO-ARRAY X)) (FLOATP (PROG ((VAL (CREATECELL 3))) (SELECTQ (SYSTEMTYPE) ((ALTO D) (VPUTBASE VAL 0 (\\GETBASE X 0)) (VPUTBASE VAL 1 (\\GETBASE X 1))) (MKI.IEEE X VAL)) (RETURN VAL))) (CHARACTER (VVAG2 7 (CL:CHAR-CODE X))) (ERROR X "can't be copied to remote file")))
)

(V\\UNCOPY
(LAMBDA (X CARLVL CDRLVL) (*) (SELECTC (VNTYPX X) (1 (COND ((EQ (VHILOC X) 14) (*) (VLOLOC X)) (T (IPLUS (VLOLOC X) -65536)))) (2 (*) (|create| FIXP HINUM _ (VGETBASE X 0) LONUM _ (VGETBASE X 1))) (3 (|create| FLOATP HIWORD _ (VGETBASE X 0) LOWORD _ (VGETBASE X 1))) (4 (VATOM (VLOLOC X))) (7 (PROG ((PTR (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE X 2) 14) 1)) (%ARRAY-BASE X)) (T (VGETBASEPTR X 0)))) (OFFST (COND ((NEQ 0 (LOGAND (LRSH (VGETBASE X 2) 14) 1)) (%ARRAY-OFFSET X)) (T (VGETBASE X 3)))) (LENGTH (\\GETBASEFIXP X 4)) (I 1) STR) (*) (SETQ STR (ALLOCSTRING LENGTH)) (FRPTQ LENGTH (RPLSTRING STR I (FCHARACTER (V\\GETBASEBYTE PTR OFFST))) (SETQ I (PLUS I 1)) (SETQ OFFST (PLUS OFFST 1))) (RETURN STR))) (9 (\\VAG2 7 (VLOLOC X))) (%ONED-ARRAY (LET ((SIZE (\\GETBASEFIXP X 6)) (BASE (VGETBASEPTR X 0)) (OFFSET (VGETBASE X 3)) (TYPENUMBER (LOGAND (VGETBASE X 2) 255)) NCELLS LOCAL-ARRAY LOCAL-BASE) (|if| (EQ (%TYPENUMBER-TO-GC-TYPE TYPENUMBER) 1) |then| (VTYPEDPOINTER (VTYPENAME X) X) |else| (SETQ NCELLS (LRSH (IPLUS (ITIMES (IPLUS SIZE OFFSET) (%TYPENUMBER-TO-BITS-PER-ELEMENT TYPENUMBER)) 31) 5)) (SETQ LOCAL-ARRAY (|create| ONED-ARRAY)) (SETQ LOCAL-BASE (\\ALLOCBLOCK NCELLS)) (|freplace| (ONED-ARRAY BASE) |of| LOCAL-ARRAY |with| LOCAL-BASE) (|freplace| (ONED-ARRAY STRING-P) |of| LOCAL-ARRAY |with| (%CHAR-TYPE-P TYPENUMBER)) (|freplace| (ONED-ARRAY FILL-POINTER-P) |of| LOCAL-ARRAY |with| (NEQ 0 (LOGAND (LRSH (VGETBASE X 2) 9) 1))) (|freplace| (ONED-ARRAY TYPE-NUMBER) |of| LOCAL-ARRAY |with| TYPENUMBER) (|freplace| (ONED-ARRAY FILL-POINTER) |of| LOCAL-ARRAY |with| (\\GETBASEFIXP X 4)) (|if| (NEQ OFFSET 0) |then| (|freplace| (ONED-ARRAY OFFSET) |of| LOCAL-ARRAY |with| OFFSET) (|freplace| (ONED-ARRAY DISPLACED-P) |of| LOCAL-ARRAY |with| T)) (|freplace| (ONED-ARRAY TOTAL-SIZE) |of| LOCAL-ARRAY |with| SIZE) (|for| I |from| 0 |to| (SUB1 (LLSH NCELLS 1)) |do| (\\PUTBASE LOCAL-BASE I (VGETBASE BASE I))) LOCAL-ARRAY))) (5 (COND ((VLISTP X) (COND ((EQ CDRLVL 0) (*) (QUOTE (--))) (T (CONS (COND ((OR (EQ CARLVL 0) (AND (OR (EQ CARLVL 1) (EQ CDRLVL 1)) (VLISTP (V\\CAR.UFN X)))) (QUOTE &)) (T (V\\UNCOPY (V\\CAR.UFN X) (AND CARLVL (SUB1 CARLVL)) (AND CDRLVL (SUB1 CDRLVL))))) (V\\UNCOPY (V\\CDR.UFN X) CARLVL (AND CDRLVL (SUB1 CDRLVL))))))) (T (*) (VTYPEDPOINTER (QUOTE LISTP) X)))) (0 (VTYPEDPOINTER NIL X)) (VTYPEDPOINTER (VTYPENAME X) X)))
)
)
(DEFINEQ

(V\\GETBASEBYTE
(LAMBDA (PTR N) (*) (*) (COND ((EVENP N) (LRSH (PROGN (VGETBASE PTR (LRSH N 1))) 8)) (T (LOGAND (PROGN (VGETBASE PTR (LRSH N 1))) 255))))
)

(V\\PUTBASEBYTE
(LAMBDA (PTR DISP BYTE) (*) (*) (SETQ BYTE (PROG1 BYTE)) (VPUTBASE PTR (LRSH (SETQ DISP (\\DTEST DISP (QUOTE SMALLP))) 1) (COND ((EVENP DISP 2) ((LAMBDA ($$1) (IPLUS (LLSH BYTE 8) (LOGAND $$1 255))) (VGETBASE PTR (LRSH DISP 1)))) (T ((LAMBDA ($$1) (IPLUS (LLSH (LRSH $$1 8) 8) BYTE)) (VGETBASE PTR (LRSH DISP 1)))))) BYTE)
)
)
(DEFINEQ

(VNTYPX
(LAMBDA (X) (*) (*) (LOGAND (VGETBASE (VVAG2 24 0) (LRSH (IPLUS (LLSH (VHILOC X) 8) (LRSH (VLOLOC X) 8)) 1)) 2047))
)

(VTYPENAME
(LAMBDA (X) (*) (*) (*) (LET ((N (VNTYPX X))) (COND ((EQ N 6) ((LAMBDA (X) (QUOTE ARRAYP)) X)) ((%STRINGP X) (*) (QUOTE STRINGP)) ((EQ (QUOTE NEW-ATOM) (SETQ N (VATOM (VGETBASEPTR (VADDBASE (VVAG2 20 4096) (ITIMES N 18)) 0)))) (*) (QUOTE LITATOM)) (T N))))
)

(V\\TYPENAMEFROMNUMBER
(LAMBDA (N) (*) (COND ((ILESSP N (ADD1 |VMaxTypeNumber|)) (VATOM (VGETBASEPTR (VADDBASE (VVAG2 20 4096) (ITIMES N 18)) 0)))))
)
)
(DEFINEQ

(VUNCOPYATOM
(LAMBDA (N) (*) (*) (PROG (ATOM.NAME VPACKAGE.NAME) (*) (SETQ ATOM.NAME (VSYMBOL.PNAME N)) (*) (SETQ VPACKAGE.NAME (IF (READSYS.HAS.PACKAGES) THEN (VPACKAGE.NAME (VSYMBOL.PACKAGE N)) ELSE "INTERLISP")) (RETURN (VMAKE.LOCAL.ATOM VPACKAGE.NAME ATOM.NAME))))
)

(VMAKE.LOCAL.ATOM
(LAMBDA (PKG.NAME ATM.NAME) (*) (*) (CL:INTERN ATM.NAME (OR (CL:FIND-PACKAGE PKG.NAME) (CL:MAKE-PACKAGE PKG.NAME :USES NIL))))
)

(VSYMBOL.VALUE
(LAMBDA (SYMBOL) (*) (*) (LET ((LOC (VOLD.FIND.SYMBOL SYMBOL 1 (NCHARS SYMBOL)))) (COND (NIL (*) (VGETBASEPTR (VADDBASE (VVAG2 12 LOC) LOC) 0)) (T (*) (VGETBASEPTR (VADDBASE (VVAG2 44 0) (IPLUS (ITIMES (LOGAND LOC 65535) 10) 2)) 0)))))
)

(VSYMBOL.PNAME
(LAMBDA (N BUFFER) (*) (*) (SETQ BUFFER (OR BUFFER (ALLOCSTRING \\PNAMELIMIT))) (PROG (ADDR LEN) (*) (COND (NIL (SETQ ADDR (VGETBASEPTR (VADDBASE (VADDBASE (VVAG2 8 0) N) N) 0))) (T (SETQ ADDR (VGETBASEPTR (VADDBASE (VVAG2 44 0) (IPLUS (ITIMES (LOGAND N 65535) 10) 0)) 0)))) (SETQ LEN (V\\GETBASEBYTE ADDR 0)) (|for| I |from| 1 |to| LEN |do| (RPLSTRING BUFFER I (FCHARACTER (V\\GETBASEBYTE ADDR I)))) (RETURN (SUBSTRING BUFFER 1 LEN))))
)

(VSYMBOL.PACKAGE
(LAMBDA (N) (*) (*) (PROG ((INDEX (COND (NIL (*) (LRSH (VGETBASE (VADDBASE (VADDBASE (VVAG2 8 0) N) N) 0) 8)) (NIL (T (LRSH (VGETBASE (VADDBASE (VVAG2 44 0) (IPLUS (ITIMES 10 N) 0 8)) 0) 8))) (T (LRSH (VGETBASE (V\\ATOMCELL N 8) 8) 8))))) (RETURN (COND ((EQ INDEX *UNINTERNED-PACKAGE-INDEX*) NIL) (T (VGETBASEPTR (VGETBASEPTR READSYS.PACKAGE.FROM.INDEX 0) (LLSH INDEX 1)))))))
)

(VOLD.FIND.SYMBOL
(LAMBDA (BASE OFFST LEN FATP NONNUMERICP) (*) (PROG ((FATCHARSEENP (AND FATP (NOT (NULL (|for| I |from| OFFST |to| (SUB1 (IPLUS OFFST LEN)) |suchthat| (IGREATERP (VGETBASE BASE I) 255)))))) HASH HASHENT ATM# PNBASE FIRSTCHAR FIRSTBYTE REPROBE) (*) (COND ((EQ LEN 0) (*) (SETQ HASH 0) (SETQ FIRSTBYTE 255) (GO LP))) (SETQ FIRSTCHAR (NTHCHARCODE BASE OFFST)) (*) NIL (*) (SETQ FIRSTBYTE (LOGAND FIRSTCHAR 255)) (*) (PROGN (*) (SETQ HASH (LLSH FIRSTBYTE 8)) (|for| CHAR# |from| (ADD1 OFFST) |to| (SUB1 (IPLUS OFFST LEN)) |do| (SETQ HASH (IPLUS16 (IPLUS16 (SETQ HASH (IPLUS16 HASH (LLSH (LOGAND HASH 4095) 2))) (LLSH (LOGAND HASH 255) 8)) (NTHCHARCODE BASE CHAR#))))) (*) LP (*) (COND ((NEQ 0 (SETQ HASHENT (VGETBASE (VVAG2 21 0) HASH))) (*) (COND ((STREQUAL (CL:SYMBOL-NAME BASE) (VSYMBOL.PNAME (SETQ ATM# (SUB1 HASHENT)))) (RETURN ATM#)) (T (*) (SETQ HASH (IPLUS16 HASH (OR REPROBE (SETQ REPROBE (LOGAND 63 (LOGOR 1 (LOGXOR FIRSTBYTE HASH))))))) (GO LP))))) (*) (RETURN (PROGN (LET ((NEWATOM (VNOSUCHATOM BASE OFFST LEN FATP FATCHARSEENP))) NIL NEWATOM)))))
)

(VLOOKUP-SYMBOL
(LAMBDA (TABLE STRING SXHASH ENTRY-HASH) (*) (*) (LET* ((VEC (VGETBASEPTR TABLE 0)) (*) (HASH (VGETBASEPTR TABLE 2)) (*) (LEN (\\GETBASEFIXP VEC 6)) (*) (H2 (ADD1 (IREMAINDER SXHASH (IDIFFERENCE LEN 2)))) (*)) (DECLARE (TYPE (CL:SIMPLE-ARRAY (CL:UNSIGNED-BYTE 8)) HASH) (TYPE (CL:SIMPLE-ARRAY (CL:UNSIGNED-BYTE 16)) VEC)) (PROG ((INDEX-VAR (IREMAINDER SXHASH LEN)) SYMBOL-NUMBER EHASH) (IF NIL THEN (CL:FORMAT T "Probe @ ~s~%" INDEX-VAR)) LOOP (SETQ EHASH (V\\GETBASEBYTE (VGETBASEPTR HASH 0) INDEX-VAR)) (*) (COND ((EQL EHASH ENTRY-HASH) (IF NIL THEN (CL:FORMAT T "Entry hash MATCHES~%")) (LET ((SYMBOL-NAME (VSYMBOL.PNAME (SETQ SYMBOL-NUMBER (VGETBASE (VGETBASEPTR VEC 0) INDEX-VAR))))) (*) (IF NIL THEN (CL:FORMAT T "Got symbol index~%")) (*) (COND ((STREQUAL SYMBOL-NAME STRING) (IF NIL THEN (CL:FORMAT T " found~%")) (GO DOIT)) (T (IF NIL THEN (CL:FORMAT T "Didn't match~%")))))) ((EQL 0 EHASH) (IF NIL THEN (CL:FORMAT T "Hit deleted entry (no match)~%")) (SETQ INDEX-VAR NIL) (GO DOIT)) (T (IF NIL THEN (CL:FORMAT T "Entry hash does not match~%")))) (SETQ INDEX-VAR (IREMAINDER (IPLUS INDEX-VAR H2) LEN)) (*) (IF NIL THEN (CL:FORMAT T "Reprobe @ ~s~%" INDEX-VAR)) (GO LOOP) DOIT (RETURN SYMBOL-NUMBER))))
)

(VFIND.PACKAGE
(LAMBDA (NAME) (*) (*) (PROG ((ITEM (MKSTRING NAME)) (HA READSYS.PACKAGE.FROM.NAME) BITS INDEX SLOT SKEY FIRSTINDEX REPROBE LIMIT ABASE VALUE) (SETQ BITS (STRINGHASHBITS ITEM)) (SETQ INDEX (LOGAND BITS (VGETBASE HA 1))) (*) (SETQ ABASE (VGETBASEPTR HA 2)) (SETQ FIRSTINDEX INDEX) (SETQ REPROBE (LOGOR (LOGAND (LOGXOR BITS (LRSH BITS 8)) (IMIN 63 (VGETBASE HA 1))) 1)) (*) (SETQ LIMIT (VGETBASE HA 1)) LP (SETQ SLOT ((LAMBDA (BASEA0198) (DECLARE (LOCALVARS BASEA0198)) (VADDBASE (VADDBASE BASEA0198 INDEX) INDEX)) (VADDBASE (VADDBASE ABASE INDEX) INDEX))) (*) (COND ((SETQ VALUE (VGETBASEPTR SLOT 2)) (*) (SETQ SKEY (V\\UNCOPY (VGETBASEPTR SLOT 0))) (COND ((STREQUAL ITEM SKEY) (*) (GO FOUND)))) ((NULL (VGETBASEPTR SLOT 0)) (*) (RETURN NIL))) (SETQ INDEX (LOGAND (IPLUS16 INDEX REPROBE) LIMIT)) (*) (COND ((EQ INDEX FIRSTINDEX) (*) (SHOULDNT "Hashing in full hash table"))) (GO LP) FOUND (RETURN (AND (NEQ VALUE \\HASH.NULL.VALUE) VALUE))))
)

(VFIND.SYMBOL
(LAMBDA (STRING PACKAGE) (*) (*) (LET* ((LENGTH (FFETCH (STRINGP LENGTH) OF STRING)) (HASH (COND ((EQL 0 LENGTH) 0) (T (PROG* ((TERMINUS LENGTH) (HASH (LLSH (NTHCHARCODE STRING 1) 8)) (CHAR# 2)) A0355 (COND ((IGREATERP CHAR# TERMINUS) (RETURN (PROGN HASH)))) (PROGN) (SETQ HASH (IPLUS16 (IPLUS16 (SETQ HASH (IPLUS16 HASH (LLSH (LOGAND HASH 4095) 2))) (LLSH (LOGAND HASH 255) 8)) (NTHCHARCODE STRING CHAR#))) (SETQ CHAR# (ADD1 CHAR#)) (GO A0355))))) (*) (EHASH (IPLUS (IREMAINDER (LOGXOR LENGTH HASH (RSH HASH 8) (RSH HASH 16) (RSH HASH 19)) 254) 2)) (*) (SYM) (WHERE) (DONE)) (COND ((NOT (VGETBASEPTR PACKAGE 14)) (*) (IF NIL THEN (PRINT "Checking INTERNAL symbols")) (LET ((INDEX (VLOOKUP-SYMBOL (VGETBASEPTR PACKAGE 16) STRING HASH EHASH))) (*) (COND (INDEX (SETQ SYM INDEX) (SETQ WHERE :INTERNAL) (SETQ DONE T)))))) (COND ((NOT DONE) (IF NIL THEN (PRINT "Checking EXTERNAL symbols")) (LET ((INDEX (VLOOKUP-SYMBOL (VGETBASEPTR PACKAGE 18) STRING HASH EHASH))) (*) (COND (INDEX (SETQ SYM INDEX) (SETQ WHERE :EXTERNAL) (SETQ DONE T)))))) (COND ((NOT DONE) (IF NIL THEN (CL:FORMAT T "Checking USE'd packages~%")) (LET ((HEAD (VGETBASEPTR PACKAGE 2)) (*)) (PROG ((PREV HEAD) (TABLE (V\\CDR.UFN HEAD))) USED-PACKAGE-LOOP (COND ((OR DONE (NULL TABLE)) (RETURN (PROGN (CL:VALUES NIL NIL))))) (PROGN (LET ((INDEX (VLOOKUP-SYMBOL (V\\CAR.UFN TABLE) STRING HASH EHASH))) (*) (COND (INDEX (COND ((NEQ PREV HEAD) (LET* ((A0347 PREV) (A0346 (V\\CDR.UFN A0347)) (A0349 TABLE) (A0348 (V\\CDR.UFN A0349)) (A0351 HEAD) (A0350 (V\\CDR.UFN A0351))) (V\\CDR.UFN (RPLACD A0347 A0348)) (V\\CDR.UFN (RPLACD A0349 A0350)) (V\\CDR.UFN (RPLACD A0351 TABLE)) A0346))) (SETQ SYM INDEX) (SETQ WHERE :INHERITED) (SETQ DONE T)) (T)))) (PROGN (SETQ PREV (PROG1 TABLE (PROGN (SETQ TABLE (V\\CDR.UFN TABLE)) NIL))) NIL) (GO USED-PACKAGE-LOOP))))) (CL:VALUES SYM WHERE)))
)

(VPACKAGE.NAME
(LAMBDA (RMPKG) (*) (AND RMPKG (V\\UNCOPY (VGETBASEPTR RMPKG 4)))))

(V\\MKATOM
(LAMBDA (BASE OFFST LEN FATP NONNUMERICP) (*) (PROG ((FATCHARSEENP (AND FATP (NOT (NULL (|for| I |from| OFFST |to| (SUB1 (IPLUS OFFST LEN)) |suchthat| (IGREATERP (VGETBASE BASE I) 255)))))) HASH HASHENT ATM# PNBASE FIRSTCHAR FIRSTBYTE REPROBE) (*) (COND ((EQ LEN 0) (*) (SETQ HASH 0) (SETQ FIRSTBYTE 255) (GO LP))) (SETQ FIRSTCHAR (NTHCHARCODE BASE OFFST)) (*) NIL (*) (SETQ FIRSTBYTE (LOGAND FIRSTCHAR 255)) (*) (PROGN (*) (SETQ HASH (LLSH FIRSTBYTE 8)) (|for| CHAR# |from| (ADD1 OFFST) |to| (SUB1 (IPLUS OFFST LEN)) |do| (SETQ HASH (IPLUS16 (IPLUS16 (SETQ HASH (IPLUS16 HASH (LLSH (LOGAND HASH 4095) 2))) (LLSH (LOGAND HASH 255) 8)) (NTHCHARCODE BASE CHAR#))))) (*) LP (*) (COND ((NEQ 0 (SETQ HASHENT (VGETBASE (VVAG2 21 0) HASH))) (*) (COND ((EQ (VATOM (SETQ ATM# (SUB1 HASHENT))) BASE) (RETURN (VADDBASE (VVAG2 0 0) ATM#))) (T (*) (SETQ HASH (IPLUS16 HASH (OR REPROBE (SETQ REPROBE (LOGAND 63 (LOGOR 1 (LOGXOR FIRSTBYTE HASH))))))) (GO LP))))) (*) (RETURN (PROGN (LET ((NEWATOM (VNOSUCHATOM BASE OFFST LEN FATP FATCHARSEENP))) NIL NEWATOM)))))
)

(VGETTOPVAL
(LAMBDA (X) (*) (VGETBASEPTR (V\\ATOMCELL X 12) 0)))

(VGETPROPLIST
(LAMBDA (ATM) (*) (VGETBASEPTR (V\\ATOMCELL ATM (CONSTANT 2)) 0)))

(VSETTOPVAL
(LAMBDA (ATM VAL) (*) (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 (V\\ATOMCELL ATM 12) 0 (V\\COPY VAL))))
)

(VGETDEFN
(LAMBDA (A) (*) (VGETBASEPTR (V\\ATOMCELL A 10) 0)))

(V\\ATOMCELL
(LAMBDA (X N) (*) (LET ((ATOMNO (VATOMNUMBER X))) (COND (NIL (*) (EQ (VHILOC ATOMNO) 0) (*) (LET ((LOC (SELECTC N (10 (VATOMNUMBER ATOMNO)) (12 (VATOMNUMBER ATOMNO)) (2 (VATOMNUMBER ATOMNO)) (8 (\\ATOMPNAMEINDEX ATOMNO)) (SHOULDNT)))) (VADDBASE (VVAG2 N LOC) LOC))) ((FIXP ATOMNO) (*) (LET ((LOC (SELECTC N (10 4) (12 2) (2 6) (8 0) (SHOULDNT)))) (VADDBASE (VVAG2 44 0) (IPLUS LOC (ITIMES 10 ATOMNO))))) (T (*) (LET ((OFFSET (SELECTC N (10 4) (12 2) (2 6) (8 0) (SHOULDNT)))) (VADDBASE ATOMNO OFFSET))))))
)
)
(DEFINEQ

(VLISTP
(LAMBDA (X) (*) (*) (AND (EQ (VNTYPX X) 5) (COND ((EQ 1 0) T) (T (*) (NEQ (LOGAND (VLOLOC X) 255) 0))) X))
)
)

(RPAQQ COPYATOMSTR NIL)
(DEFINEQ

(V\\GET-COMPILED-CODE-BASE
(LAMBDA (X) (*) (*) (PROG NIL (COND ((LITATOM X) (COND ((PROG1 (NEQ 0 (LRSH (VGETBASE (V\\ATOMCELL X 10) 0) 15)) (SETQ X (VGETBASEPTR (V\\ATOMCELL X 10) 0))) (RETURN X))))) (RETURN (AND (EQ (VNTYPX X) 13) (VGETBASEPTR (\\DTEST X (QUOTE COMPILED-CLOSURE)) 0)))))
)
)



(* |;;| 
"YOU MUST REMAKE THIS FILE using (DORENAME 'R) (after CONNing to library) whenever the SYSOUT layout changes in LLPARAMS (e.g., if MDSTypeTable moves)"
)


(FILESLOAD VMEM)

(RPAQQ RDVALS ((\\RPTSIZE) (|\\MaxTypeNumber|) (|\\AtomFrLst|) (|\\ArrayFrLst|) (|\\ArrayFrLst2|)))

(RPAQQ RDPTRS ((\\REALPAGETABLE) (\\FREEBLOCKBUCKETS)))
(DECLARE\: EVAL@COMPILE DONTCOPY 

(FILESLOAD (LOADCOMP) VMEM)
)
STOP
\ No newline at end of file
diff --git a/library/RDSYS.LCOM b/library/RDSYS.LCOM
index 962a961d..6cdfe24c 100644
Binary files a/library/RDSYS.LCOM and b/library/RDSYS.LCOM differ
diff --git a/library/exports.all b/library/exports.all
index 25c125be..9f52739f 100644
--- a/library/exports.all
+++ b/library/exports.all
@@ -1 +1 @@
-(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
(LISPXPRIN1 "EXPORTS GATHERED FROM {DSK}<home>larry>ilisp>med>sources> ON 12-Mar-2021 12:24:04"  T)
(LISPXTERPRI T)
(RPAQQ MODARITHMACROS (CEIL FLOOR FOLDHI FOLDLO MODUP UNFOLD MOD))
(PUTPROPS CEIL MACRO ((X N) (FLOOR (IPLUS X (CONSTANT (SUB1 N))) N)))
(PUTPROPS FLOOR MACRO ((X N) (LOGAND X (CONSTANT (LOGXOR (SUB1 N) -1)))))
(PUTPROPS FOLDHI MACRO (X (PROG ((FORM (CAR X)) (DIVISOR (CAR (CONSTANTEXPRESSIONP (CADR X))))) (OR (
AND DIVISOR (POWEROFTWOP DIVISOR)) (\\ILLEGAL.ARG (CADR X))) (RETURN (LIST (QUOTE LRSH) (LIST (QUOTE 
IPLUS) FORM (SUB1 DIVISOR)) (SUB1 (INTEGERLENGTH DIVISOR)))))))
(PUTPROPS FOLDLO MACRO (X (PROG ((FORM (CAR X)) (DIVISOR (CAR (CONSTANTEXPRESSIONP (CADR X))))) (OR (
AND DIVISOR (POWEROFTWOP DIVISOR)) (\\ILLEGAL.ARG (CADR X))) (RETURN (LIST (QUOTE LRSH) FORM (SUB1 (
INTEGERLENGTH DIVISOR)))))))
(PUTPROPS MODUP MACRO (OPENLAMBDA (X N) (IDIFFERENCE (SUB1 N) (IMOD (SUB1 X) N))))
(PUTPROPS UNFOLD MACRO (X (PROG ((FORM (CAR X)) (DIVISOR (CAR (CONSTANTEXPRESSIONP (CADR X))))) (OR (
AND DIVISOR (POWEROFTWOP DIVISOR)) (\\ILLEGAL.ARG (CADR X))) (RETURN (LIST (QUOTE LLSH) FORM (SUB1 (
INTEGERLENGTH DIVISOR)))))))
(PUTPROPS MOD MACRO (= . IMOD))
(RPAQQ BITSPERNIBBLE 4)
(RPAQQ NIBBLESPERBYTE 2)
(RPAQQ BITSPERBYTE 8)
(RPAQQ BITSPERCELL 32)
(RPAQQ BITSPERWORD 16)
(RPAQQ BYTESPERCELL 4)
(RPAQQ BYTESPERPAGE 512)
(RPAQQ BYTESPERWORD 2)
(RPAQQ CELLSPERPAGE 128)
(RPAQQ CELLSPERSEGMENT 32768)
(RPAQQ PAGESPERSEGMENT 256)
(RPAQQ WORDSPERCELL 2)
(RPAQQ WORDSPERPAGE 256)
(RPAQQ WORDSPERSEGMENT 65536)
(RPAQQ WORDSPERQUAD 4)
(RPAQQ CELLSPERQUAD 2)
(RPAQQ BYTESPERQUAD 8)
(CONSTANTS BITSPERNIBBLE NIBBLESPERBYTE BITSPERBYTE BITSPERCELL BITSPERWORD BYTESPERCELL BYTESPERPAGE 
BYTESPERWORD CELLSPERPAGE CELLSPERSEGMENT PAGESPERSEGMENT WORDSPERCELL WORDSPERPAGE WORDSPERSEGMENT 
WORDSPERQUAD CELLSPERQUAD BYTESPERQUAD)
(RPAQQ INTEGERSIZECONSTANTS ((BITS.PER.SMALLP (ADD1 BITSPERWORD)) (SMALLP.LENGTH (SUB1 BITS.PER.SMALLP
)) (MAX.SMALLP (LOGOR (LSH 1 (SUB1 SMALLP.LENGTH)) (SUB1 (LSH 1 (SUB1 SMALLP.LENGTH))))) (MIN.SMALLP (
IDIFFERENCE -1 MAX.SMALLP)) (BITS.PER.FIXP BITSPERCELL) (FIXP.LENGTH (SUB1 BITS.PER.FIXP)) (MAX.FIXP (
LOGOR (LSH 1 (SUB1 FIXP.LENGTH)) (SUB1 (LSH 1 (SUB1 FIXP.LENGTH))))) (MIN.FIXP (IDIFFERENCE -1 
MAX.FIXP))))
(RPAQ BITS.PER.SMALLP (ADD1 BITSPERWORD))
(RPAQ SMALLP.LENGTH (SUB1 BITS.PER.SMALLP))
(RPAQ MAX.SMALLP (LOGOR (LSH 1 (SUB1 SMALLP.LENGTH)) (SUB1 (LSH 1 (SUB1 SMALLP.LENGTH)))))
(RPAQ MIN.SMALLP (IDIFFERENCE -1 MAX.SMALLP))
(RPAQ BITS.PER.FIXP BITSPERCELL)
(RPAQ FIXP.LENGTH (SUB1 BITS.PER.FIXP))
(RPAQ MAX.FIXP (LOGOR (LSH 1 (SUB1 FIXP.LENGTH)) (SUB1 (LSH 1 (SUB1 FIXP.LENGTH)))))
(RPAQ MIN.FIXP (IDIFFERENCE -1 MAX.FIXP))
(CONSTANTS (BITS.PER.SMALLP (ADD1 BITSPERWORD)) (SMALLP.LENGTH (SUB1 BITS.PER.SMALLP)) (MAX.SMALLP (
LOGOR (LSH 1 (SUB1 SMALLP.LENGTH)) (SUB1 (LSH 1 (SUB1 SMALLP.LENGTH))))) (MIN.SMALLP (IDIFFERENCE -1 
MAX.SMALLP)) (BITS.PER.FIXP BITSPERCELL) (FIXP.LENGTH (SUB1 BITS.PER.FIXP)) (MAX.FIXP (LOGOR (LSH 1 (
SUB1 FIXP.LENGTH)) (SUB1 (LSH 1 (SUB1 FIXP.LENGTH))))) (MIN.FIXP (IDIFFERENCE -1 MAX.FIXP)))
(PUTPROP (QUOTE MODARITH) (QUOTE IMPORTDATE) (IDATE "16-May-1990 20:46:21"))

(RPAQQ WINDFLG T)
(CONSTANTS (WINDFLG T))
(RPAQQ INITCONSTANTS ((* |;;;| "(LISPNAME VALUE BCPLNAME UCODENAME)") (CDRCODING 1 T T) (* \; 
"IF CDRCODING=0, CDR CODING IS OFF, OTHERWISE ON") (* |;;| "type numbers -- repeated on LLBASIC too") 
(\\SMALLP 1 SMALLTYPE |SmallType|) (\\FIXP 2 INTEGERTYPE |FixpType|) (\\FLOATP 3 FLTPTTYPE 
|FloatpType|) (\\LITATOM 4 ATOMTYPE |AtomType|) (\\LISTP 5 LISTTYPE |ListType|) (\\ARRAYP 6 
ARRAYPTRTYPE |ArrayType|) (\\STRINGP 7 STRINGPTRTYPE) (\\STACKP 8) (\\CHARACTERP 9) (\\VMEMPAGEP 10 
NIL |VMemPagePType|) (\\STREAM 11 NIL STREAMTYPE) (* |;;| 
"TYPE TABLE CONSTANTS - - - - - - - - - - - - - - - - - - - - - -") (\\TT.TYPEMASK 2047 |TTTypeMask| T
) (\\TT.NOREF 32768 NIL T) (\\TT.SYMBOLP 16384 NIL T) (\\TT.FIXP 8192) (\\TT.NUMBERP 4096) (\\TT.ATOM 
2048) (* |;;| "page map - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -") 
(|\\PMblockSize| 32 PMBLOCKSIZE) (|\\STATSsize| 8 T) (|\\NumPMTpages| 8) (|\\EmptyPMTEntry| 65535 T) (
|\\FirstVmemBlock| 2 T) (\\MAXVMPAGE 131069) (\\MAXVMSEGMENT 255) (* |;;| "interface page") (
|\\IFPValidKey| 5603 T) (* |;;| "MDS") (|\\FirstMDSPage| 32766) (* \; "Was 37776Q pre 16-meg intiial")
 (|\\MaxMDSPage| 524285) (|\\DefaultSecondMDSPage| 65532) (|\\MDSIncrement| 512) (|\\PagesPerMDSUnit| 
2) (* \; "(FOLDLO \\MDSIncrement WORDSPERPAGE)") (* |;;| "arrays") (\\ARRAYSPACE (46 0)) (
|\\FirstArraySegment| 46) (|\\FirstArrayPage| 11776) (\\ARRAYSPACE2 (64 0)) (
|\\DefaultSecondArrayPage| 32768) (* \; "Was 40000Q before 16meg initial") (* |;;| 
"stack block constants") (|\\StackMask| 57344 T T) (|\\FxtnBlock| 49152 T T) (|\\GuardBlock| 57344 T T
) (|\\BFBlock| 32768 T T) (|\\FreeStackBlock| 40960 T T) (|\\NotStackBlock| 0) (* \; 
"none of the above") (|\\MinExtraStackWords| 32 T T) (* |;;| "backspace kludge") (ERASECHARCODE 0 T) (
* |;;| "GC constants") (\\HT1CNT 1024 NIL T) (\\HTSTKBIT 512 NIL T) (\\HTCNTMASK 64512 NIL T) (
\\HTMAINSIZE 65536 NIL T) (\\HTCOLLSIZE 1048576 NIL T) (* \; "HTCOLL size in words") (\\HTENDFREE 1 
NIL T) (\\HTFREEPTR 0 NIL T) (* |;;| "pointers and lengths of various data spaces") (\\ATOMSPACE (0 0)
 (|ATOMspace| NIL) (|atomHiVal| NIL)) (|\\AtomHI| 0) (\\CHARHI 7) (* \; 
"overlap character space and the atom hash table space") (|\\AtomHashTable| (21 0) (|AHTspace| 
|AHTbase|)) (|\\AtomHTpages| 256 AHTSIZE) (|\\LastAtomPage| 255) (|\\MaxAtomFrLst| 65535) (
\\SMALLPOSPSPACE (14 0)) (|\\SmallPosHi| 14 |SMALLPOSspace| |smallpl|) (\\SMALLNEGSPACE (15 0)) (
|\\SmallNegHi| 15 |SMALLNEGspace| |smallneg|) (|\\NumSmallPages| 512) (* |;;| 
"PNAME SPACEin the old world; used for initial atoms now.") (\\PNPSPACE (8 0) (|PNPspace| |PNPbase|)) 
(\\PNAME.HI 8) (\\OLDATOMSPACE (44 0)) (* \; "NEW ATOM SPACE") (\\ATOM.HI 44) (* \; 
"HI PART OF NEW ATOM SPACE") (* |;;| "Definitions in old atom world") (\\DEFSPACE (10 0) (|DEFspace| 
|DEFbase|) (|DEFspace| |DEFbase|)) (\\DEF.HI 10) (\\VALSPACE (12 0) (|TOPVALspace| |TOPVALbase|) (
|VALspace| |VALbase|)) (\\VAL.HI 12) (\\PLISTSPACE (2 0) (|PLISTspace| |PLISTbase|)) (\\PLIST.HI 2) (
\\PAGEMAP (5 0) (|PAGEMAPspace| |PAGEMAPbase|)) (|\\NumPageMapPages| 256) (|\\PageMapTBL| (20 512) (
|PMTspace| |PMTbase|)) (|\\InterfacePage| (20 0) (|INTERFACEspace| |INTERFACEbase|) (|INTERFACEspace| 
|INTERFACEbase|)) (\\IOPAGE (0 65280)) (|\\DoveIORegion| (0 16384)) (\\IOCBPAGE (0 256)) (\\FPTOVP (2 
0)) (|\\MDSTypeTable| (24 0) (|MDSTYPEspace| |MDSTYPEbase|) (|MDSTYPEspace| |MDSTYPEbase|)) (
|\\MDSTTsize| 1024 T) (* \; "in Pages") (\\MISCSTATS (20 2560) (|STATSspace| |MISCSTATSbase|)) (
|\\UFNTable| (20 3072) NIL (|STATSspace| |UFNTablebase|)) (|\\UFNTableSize| 2) (|\\DTDSpaceBase| (20 
4096) (|DTDspace| |DTDbase|) (|DTDspace| |DTDbase|)) (|\\DTDSize| 18 T) (\\LISTPDTD (20 4186)) (
|\\EndTypeNumber| 2047) (\\LOCKEDPAGETABLE (20 28672)) (|\\NumLPTPages| 16) (\\STACKSPACE (1 0) (
|STACKspace| NIL) (|STACKspace| NIL)) (|\\GuardStackAddr| 61440) (|\\LastStackAddr| 65534) (\\STACKHI 
1 T T) (\\HTMAIN (22 0) (|HTMAINspace| |HTMAINbase|) (|HTMAINspace| |HTMAINbase|)) (|\\HTMAINnpages| 
256 T) (\\HTOVERFLOW (23 0) NIL (NIL |HTOVERFLOWbase|)) (\\HTBIGCOUNT (23 32768)) (\\HTCOLL (28 0) NIL
 (|HTCOLLspace| |HTCOLLbase|)) (\\DISPLAYREGION (18 0)) (|\\D1BCPLspace| 0 T |LEmubrHiVal|) (
|\\D0BCPLspace| 0 T) (* |;;| "Interface Page locations") (|\\CurrentFXP| 0 T T) (|\\ResetFXP| 1 T T) (
|\\SubovFXP| 2 T T) (|\\KbdFXP| 3 T T) (|\\HardReturnFXP| 4 T T) (\\GCFXP 5) (\\FAULTFXP 6 T T) (
|\\MiscFXP| 14 T T) (|\\TeleRaidFXP| 24 T T) (* |;;| "emulator segment locations") (DCB.EM 272) (
DISPINTERRUPT.EM 273) (CURSORBITMAP.EM 281) (KBDAD0.EM 65052) (KBDAD1.EM 65053) (KBDAD2.EM 65054) (
KBDAD3.EM 65055) (UTILIN.EM 65048) (CURSORX.EM 278) (CURSORY.EM 279) (MOUSEX.EM 276) (MOUSEY.EM 277) (
|\\LispKeyMask| 8192 T T) (|\\BcplKeyMask| 4352 T T) (* \; "Machine types") (\\MAIKO 3) (\\DOLPHIN 4) 
(\\DORADO 5) (\\DANDELION 6) (\\DAYBREAK 8) (* |;;| "FOR DLION (AND DAYBREAK)") (\\VP.DISPLAY 4608) (
\\NP.DISPLAY 202) (* \; "for Dorado display 1024x808 pixels / (16 pixels/word x 256 words/page)") (
\\NP.WIDEDOVEDISPLAY 243) (* \; "Wide Dove display 1152x864 pixels") (\\WIDEDOVEDISPLAYWIDTH 1152) (
\\RP.AFTERDISPLAY 206) (* \; "Includes 4 pages for cursor") (\\RP.AFTERDOVEDISPLAY 243) (* \; 
"if big screen") (\\RP.DISPLAY 0) (\\RP.TEMPDISPLAY 2561) (\\RP.MISCLOCKED 2804) (* \; 
"(+ \\RP.TEMPDISPLAY \\NP.WIDEDOVEDISPLAY)") (\\RP.STACK 768) (\\VP.STACK 256) (\\RP.MAP 256) (
\\NP.MAP 256) (\\RP.IOPAGE 512) (* \; 
"The DOVE IOCBPAGE can go anywhere, but should be under the 1mbyte range") (\\RP.DOVEIOCBPAGE 543) (
\\RP.DOVEIORGN 544) (\\VP.DOVEIORGN 64) (\\DOVEIORGNSIZE 64) (\\VP.IOPAGE 255) (\\VP.IFPAGE 5120) (
\\VP.FPTOVP 512) (\\NP.FPTOVP 4096) (\\RP.FPTOVP 1024) (\\RP.STARTBUFFERS 640) (\\VP.TYPETABLE 6144) (
\\NP.TYPETABLE 1024) (\\RP.TYPETABLE 5120) (\\VP.GCTABLE 5632) (\\NP.GCTABLE 256) (\\RP.GCTABLE 6144) 
(\\VP.GCOVERFLOW 5888) (\\NP.GCOVERFLOW 1) (\\RP.GCOVERFLOW 6400) (\\FP.IFPAGE 2) (\\VP.IOCBS 1) (
\\VP.PRIMARYMAP 5122) (\\VP.SECONDARYMAP 1280) (\\VP.LPT 5232) (\\VP.INITSCRATCH 8) (\\VP.RPT 128) (
\\VP.BUFFERS 218) (* \; "DLion processor commands") (\\DL.PROCESSORBUSY 32768) (\\DL.SETTOD 32769) (
\\DL.READTOD 32770) (\\DL.READPID 32771) (\\DL.BOOTBUTTON 32772)))
(RPAQQ MISCSTATSLAYOUT ((STARTTIME FIXP |MSstrtTime|) (TOTALTIME FIXP) (SWAPWAITTIME FIXP T) (
PAGEFAULTS FIXP T) (SWAPWRITES FIXP T) (DISKIOTIME FIXP T) (DISKOPS FIXP T) (KEYBOARDWAITTIME FIXP T) 
(GCTIME FIXP T) (NETIOTIME FIXP T) (NETIOOPS FIXP T) (SWAPTEMP0 FIXP) (SWAPTEMP1 FIXP) (RCLKSECOND 
FIXP) (SECONDSCLOCK FIXP) (MILLISECONDSCLOCK FIXP) (BASECLOCK FIXP) (RCLKTEMP0 FIXP) (SECONDSTMP FIXP)
 (MILLISECONDSTMP FIXP) (BASETMP FIXP) (EXCESSTIMETMP FIXP) (CLOCKTEMP0 FIXP) (DISKTEMP0 FIXP) (
DISKTEMP1 FIXP) (TELERAIDTEMP1 FIXP) (TELERAIDTEMP2 FIXP) (TELERAIDTEMP3 FIXP) (LASTUSERACTION FIXP) (
DLMOUSETIMER FIXP) (DLMOUSETEMP FIXP)))
(RPAQQ IFPAGELAYOUT ((|CurrentFXP| WORD) (* \; 
"First 7 items are FX values for user and 6 system contexts.") (|ResetFXP| WORD) (|SubovFXP| WORD) (
|KbdFXP| WORD) (|HardReturnFXP| WORD) (GCFXP WORD) (FAULTFXP WORD) (|EndOfStack| WORD) (* \; 
"Stack high-water mark: address of guard block at current end of stack") (|LVersion| WORD) (* \; 
"Lisp version, followed by min versions of microcode and Bcpl compatible with this Lisp") (
|MinRVersion| WORD) (|MinBVersion| WORD) (|RVersion| WORD) (* \; 
"Bcpl fills in the actual microcode, Bcpl versions.") (|BVersion| WORD) (|MachineType| WORD) (
|MiscFXP| WORD) (* \; "FX for MISC context") (|Key| WORD) (* \; "= IFPValidKey if vmem consistent.") (
|SerialNumber| WORD) (* \; "Pup host number (Dorado/Dolphin)") (|EmulatorSpace| WORD) (* \; 
"Hiloc of bcpl space (always zero now)") (|ScreenWidth| WORD) (|NxtPMAddr| WORD) (* \; 
"Next page to be allocated in secondary page map table") (|NActivePages| WORD) (* \; 
"Length of vmem in use") (|NDirtyPages| WORD) (* \; "not used, but maintained as = NActivePages") (
|filePnPMP0| WORD) (* \; 
"Sysout page number of first page of secondary page map table (\\PAGEMAP), which is where the secondary map pages themselves live"
) (|filePnPMT0| WORD) (* \; "Sysout page number of first page of primary page map table") (TELERAIDFXP
 WORD) (* \; "FX for TeleRaid server context") (NATIVE-START-MEM-PAGE WORD) (* \; 
"Unix page where native code starts") (NATIVE-LENGTH-PAGE WORD) (* \; 
"Unix page length of native code") (NATIVE-PAGE-OFFSET WORD) (* \; 
"Lisp Disk Page offset  of native code") (|UserNameAddr| WORD) (* \; 
"Addresses in bcpl space (seg 0) of global user name and password") (|UserPswdAddr| WORD) (|StackBase|
 WORD) (* \; "Stack address where user stack starts") (FAULTHI WORD) (* \; 
"Microcode for page fault stores fault address here, then does context switch to FAULTFXP") (FAULTLO 
WORD) (DEVCONFIG WORD) (* \; "IT'S FOR KB,DISP TYPE") (* \; 
"Formerly REALPAGETABLE, back when it was always in Bcpl space.") (RPTSIZE WORD) (* \; 
"Number of entries in Real Page Table") (RPOFFSET WORD) (* \; "RP-RPOFFSET => index in table") (
MAXETHERBYTES WORD) (* \; "Number of bytes available in a pbi, not counting encapsulation (Dorado)") (
EMBUFVP WORD) (* \; "VP of a one-page emulator buffer") (|NSHost0| WORD) (* \; 
"Machine's 48-bit NS host number.  Lisp manages to compute this on all machines except Dolphin, where Bcpl fills it in."
) (|NSHost1| WORD) (|NSHost2| WORD) (|MDSZone| WORD) (* \; 
"Obsolete -- was used by Dolphin 10MB network code.") (|MDSZoneLength| WORD) (EMUBUFFERS WORD) (* \; 
"Buffer space in segment 0 for swapping/disk activity") (EMUBUFLENGTH WORD) (* \; 
"Number of words of said space") (LASTNUMCHARS WORD) (* \; "No longer used?") (SYSDISK WORD) (* \; 
"Address of sysDisk in Bcpl space -- disk obj for boot partition.") (ISFMAP WORD) (* |;;| 
"The following 4 are for \\MISCAPPLY* -- note that they are not ref counted, so don't pass the only pointer to something this way!"
) (MISCSTACKFN FULLXPOINTER) (MISCSTACKARG1 FULLXPOINTER) (MISCSTACKARG2 FULLXPOINTER) (
MISCSTACKRESULT FULLXPOINTER) (|NRealPages| WORD) (* \; "Number pages of real memory") (
|LastLockedFilePage| WORD) (* \; 
"Last page of vmem that is locked--booting has to load at least that far.") (|LastDominoFilePage| WORD
) (* \; "Last sysout page reserved for Dandelion microcode") (|FPTOVPStart| WORD) (* \; 
"Sysout page where FPTOVP starts") (FAKEMOUSEBITS WORD) (* \; 
"Used to implement fake middle button on 2-button Dandelion.") (|DL24BitAddressable| WORD) (* \; 
"non-zero if DLion capable of addressing 32MB virtual memory") (REALPAGETABLEPTR FULLXPOINTER) (* \; 
"Address of real page table, set up by Bcpl (but not chained together)") (|DLLastVmemPage| WORD) (* \;
 "DLion booting microcode puts length of vmem file here.") (|FullSpaceUsed| WORD) (* \; 
"Non-zero if vmem beyond initial 8MB has been allocated.") (FAKEKBDAD4 WORD) (FAKEKBDAD5 WORD) (* |;;|
 
"The following 9 items (6 words and 3 pointers) are 3 3-element vectors for the Dorado extended virtual memory code--indexed by 0,1,2 according to which of up to 3 virtual memory backing files you're working with."
) (|XVmemFmapBase| WORD) (* \; 
"Bcpl stores isf map pointer to each partition here.  First is redundant with ISFMAP field above.") (
NIL WORD) (NIL WORD) (|XVmemFmapHighBase| WORD) (* \; 
"Bcpl stores the highest vm page contained in this or earlier partition.") (NIL WORD) (NIL WORD) (
|XVmemDiskBase| FULLXPOINTER) (* \; 
"Lisp stores disk objects here (just a convenient non-faulting contiguous block of storage).") (NIL 
FULLXPOINTER) (NIL FULLXPOINTER)))
(RPAQQ MAIKO.IFPAGELAYOUT ((|CurrentFXP| WORD) (* \; 
"First 7 items are FX values for user and 6 system contexts.") (|ResetFXP| WORD) (|SubovFXP| WORD) (
|KbdFXP| WORD) (|HardReturnFXP| WORD) (GCFXP WORD) (FAULTFXP WORD) (|EndOfStack| WORD) (* \; 
"Stack high-water mark: address of guard block at current end of stack") (|LVersion| WORD) (* \; 
"Lisp version, followed by min versions of microcode and Bcpl compatible with this Lisp") (
|MinRVersion| WORD) (|MinBVersion| WORD) (|RVersion| WORD) (* \; 
"Bcpl fills in the actual microcode, Bcpl versions.") (|BVersion| WORD) (|MachineType| WORD) (
|MiscFXP| WORD) (* \; "FX for MISC context") (|Key| WORD) (* \; "= IFPValidKey if vmem consistent.") (
|SerialNumber| WORD) (* \; "Pup host number (Dorado/Dolphin)") (|EmulatorSpace| WORD) (* \; 
"Hiloc of bcpl space (always zero now)") (|ScreenWidth| WORD) (|NxtPMAddr| WORD) (* \; 
"Next page to be allocated in secondary page map table") (NIL WORD) (* \; 
"WAS NActivePages, Length of vmem in use") (NIL WORD) (* \; 
"WAS NDirtyPages, not used, but maintained as = NActivePages") (|filePnPMP0| WORD) (* \; 
"Sysout page number of first page of secondary page map table (\\PAGEMAP), which is where the secondary map pages themselves live"
) (|filePnPMT0| WORD) (* \; "Sysout page number of first page of primary page map table") (TELERAIDFXP
 WORD) (* \; "FX for TeleRaid server context") (NATIVE-START-MEM-PAGE WORD) (* \; 
"Unix page where native code starts") (NATIVE-LENGTH-PAGE WORD) (* \; 
"Unix page length of native code") (NATIVE-PAGE-OFFSET WORD) (* \; 
"Lisp Disk Page offset  of native code") (|UserNameAddr| WORD) (* \; 
"Addresses in bcpl space (seg 0) of global user name and password") (|UserPswdAddr| WORD) (|StackBase|
 WORD) (* \; "Stack address where user stack starts") (FAULTHI WORD) (* \; 
"Microcode for page fault stores fault address here, then does context switch to FAULTFXP") (FAULTLO 
WORD) (DEVCONFIG WORD) (* \; "IT'S FOR KB,DISP TYPE") (* \; 
"Formerly REALPAGETABLE, back when it was always in Bcpl space.") (RPTSIZE WORD) (* \; 
"Number of entries in Real Page Table") (RPOFFSET WORD) (* \; "RP-RPOFFSET => index in table") (
MAXETHERBYTES WORD) (* \; "Number of bytes available in a pbi, not counting encapsulation (Dorado)") (
EMBUFVP WORD) (* \; "VP of a one-page emulator buffer") (|NSHost0| WORD) (* \; 
"Machine's 48-bit NS host number.  Lisp manages to compute this on all machines except Dolphin, where Bcpl fills it in."
) (|NSHost1| WORD) (|NSHost2| WORD) (|MDSZone| WORD) (* \; 
"Obsolete -- was used by Dolphin 10MB network code.") (|MDSZoneLength| WORD) (EMUBUFFERS WORD) (* \; 
"Buffer space in segment 0 for swapping/disk activity") (EMUBUFLENGTH WORD) (* \; 
"Number of words of said space") (* |;;| 
"The following 2 are available if NEW_STOARGE is specified in C") (|ProcessSize| WORD) (* \; 
"Process size for which can be use as LISP space") (|StorageFullState| WORD) (* \; 
"Save last storage state") (ISFMAP WORD) (* |;;| 
"The following 4 are for \\MISCAPPLY* -- note that they are not ref counted, so don't pass the only pointer to something this way!"
) (MISCSTACKFN FULLXPOINTER) (MISCSTACKARG1 FULLXPOINTER) (MISCSTACKARG2 FULLXPOINTER) (
MISCSTACKRESULT FULLXPOINTER) (|NRealPages| WORD) (* \; "Number pages of real memory") (
|LastLockedFilePage| WORD) (* \; 
"Last page of vmem that is locked--booting has to load at least that far.") (|LastDominoFilePage| WORD
) (* \; "Last sysout page reserved for Dandelion microcode") (|FPTOVPStart| WORD) (* \; 
"Sysout page where FPTOVP starts") (FAKEMOUSEBITS WORD) (* \; 
"Used to implement fake middle button on 2-button Dandelion.") (|DL24BitAddressable| WORD) (* \; 
"non-zero if DLion capable of addressing 32MB virtual memory") (REALPAGETABLEPTR FULLXPOINTER) (* \; 
"Address of real page table, set up by Bcpl (but not chained together)") (SYSDISK WORD) (* \; 
"WAS DLLastVmemPage, DLion booting microcode puts length of vmem file here.") (|FullSpaceUsed| WORD) (
* \; "Non-zero if vmem beyond initial 8MB has been allocated.") (FAKEKBDAD4 WORD) (FAKEKBDAD5 WORD) (*
 |;;| 
"The following 9 items (6 words and 3 pointers) are 3 3-element vectors for the Dorado extended virtual memory code--indexed by 0,1,2 according to which of up to 3 virtual memory backing files you're working with."
) (|XVmemFmapBase| WORD) (* \; 
"Bcpl stores isf map pointer to each partition here.  First is redundant with ISFMAP field above.") (
NIL WORD) (NIL WORD) (|XVmemFmapHighBase| WORD) (* \; 
"Bcpl stores the highest vm page contained in this or earlier partition.") (NIL WORD) (NIL WORD) (
|XVmemDiskBase| FULLXPOINTER) (* \; 
"Lisp stores disk objects here (just a convenient non-faulting contiguous block of storage).") (NIL 
FULLXPOINTER) (NIL FULLXPOINTER) (|DLLastVmemPage| FIXP) (* \; 
"DLion booting microcode puts length of vmem file here.") (|NActivePages| FIXP) (* \; 
"Length of vmem in use") (|NDirtyPages| FIXP) (* \; "not used, but maintained as = NActivePages")))
(RPAQQ IOPAGELAYOUT ((NIL 18 WORD) (DLMAINTPANEL WORD NIL T) (DLFLOPPYCMD WORD) (DLTTYPORTCMD WORD) (
DLPROCESSORCMD WORD) (NEWMOUSESTATE WORD) (DLBEEPCMD WORD) (DLRS232CMISCCOMMAND WORD) (DLRS232CPUTFLAG
 WORD) (DLRS232CGETFLAG WORD) (NIL 6 WORD) (DLFLOPPY WORD) (DLTTYOUT WORD) (NIL 1 WORD) (DLTTYIN WORD)
 (NIL 1 WORD) (DLPROCESSOR2 WORD) (DLPROCESSOR1 WORD) (DLPROCESSOR0 WORD) (NEWMOUSEX WORD) (NEWMOUSEY 
WORD) (DLBEEPFREQ WORD) (DLRS232CPARAMETERCSBLO WORD) (DLRS232CPARAMETERCSBHI WORD) (
DLRS232CSETRS366STATUS 3 WORD) (DLRS232CPUTCSBLO WORD) (DLRS232CPUTCSBHI WORD) (DLRS232CGETCSBLO WORD)
 (DLRS232CGETCSBHI WORD) (DLRS232CDEVICESTATUS WORD) (DLRS232CPARAMETEROUTCOME WORD) (DLTODVALID WORD)
 (DLTODLO WORD NIL T) (DLTODHI WORD) (DLTODLO2 WORD) (DLMOUSEX WORD NIL T) (DLMOUSEY WORD NIL T) (
DLUTILIN WORD NIL T) (DLKBDAD0 WORD NIL T) (DLKBDAD1 WORD NIL T) (DLKBDAD2 WORD NIL T) (DLKBDAD3 WORD 
NIL T) (DLKBDAD4 WORD NIL T) (DLKBDAD5 WORD NIL T) (DLLSEPIMAGECSB 32 WORD) (DLIOPHARDWARECONFIG WORD)
 (NIL 11 WORD) (DLRS232CPARAMETERCSBLO.11 WORD) (DLRS232CPARAMETERCSBHI.11 WORD) (
DLRS232CSETRS366STATUS.11 14 WORD) (NIL 60 WORD) (DLMAGTAPE 4 WORD) (DLETHERNET 12 WORD NIL T) (NIL 31
 WORD) (DLDISPINTERRUPT WORD NIL T) (DLDISPCONTROL WORD) (DLDISPBORDER WORD) (DLCURSORX WORD NIL T) (
DLCURSORY WORD NIL T) (DLCURSORBITMAP 16 WORD NIL T)))
(RPAQQ CDRCODING 1)
(RPAQQ \\SMALLP 1)
(RPAQQ \\FIXP 2)
(RPAQQ \\FLOATP 3)
(RPAQQ \\LITATOM 4)
(RPAQQ \\LISTP 5)
(RPAQQ \\ARRAYP 6)
(RPAQQ \\STRINGP 7)
(RPAQQ \\STACKP 8)
(RPAQQ \\CHARACTERP 9)
(RPAQQ \\VMEMPAGEP 10)
(RPAQQ \\STREAM 11)
(RPAQQ \\TT.TYPEMASK 2047)
(RPAQQ \\TT.NOREF 32768)
(RPAQQ \\TT.SYMBOLP 16384)
(RPAQQ \\TT.FIXP 8192)
(RPAQQ \\TT.NUMBERP 4096)
(RPAQQ \\TT.ATOM 2048)
(RPAQQ |\\PMblockSize| 32)
(RPAQQ |\\STATSsize| 8)
(RPAQQ |\\NumPMTpages| 8)
(RPAQQ |\\EmptyPMTEntry| 65535)
(RPAQQ |\\FirstVmemBlock| 2)
(RPAQQ \\MAXVMPAGE 131069)
(RPAQQ \\MAXVMSEGMENT 255)
(RPAQQ |\\IFPValidKey| 5603)
(RPAQQ |\\FirstMDSPage| 32766)
(RPAQQ |\\MaxMDSPage| 524285)
(RPAQQ |\\DefaultSecondMDSPage| 65532)
(RPAQQ |\\MDSIncrement| 512)
(RPAQQ |\\PagesPerMDSUnit| 2)
(RPAQQ |\\FirstArraySegment| 46)
(RPAQQ |\\FirstArrayPage| 11776)
(RPAQQ |\\DefaultSecondArrayPage| 32768)
(RPAQQ |\\StackMask| 57344)
(RPAQQ |\\FxtnBlock| 49152)
(RPAQQ |\\GuardBlock| 57344)
(RPAQQ |\\BFBlock| 32768)
(RPAQQ |\\FreeStackBlock| 40960)
(RPAQQ |\\NotStackBlock| 0)
(RPAQQ |\\MinExtraStackWords| 32)
(RPAQQ ERASECHARCODE 0)
(RPAQQ \\HT1CNT 1024)
(RPAQQ \\HTSTKBIT 512)
(RPAQQ \\HTCNTMASK 64512)
(RPAQQ \\HTMAINSIZE 65536)
(RPAQQ \\HTCOLLSIZE 1048576)
(RPAQQ \\HTENDFREE 1)
(RPAQQ \\HTFREEPTR 0)
(RPAQQ |\\AtomHI| 0)
(RPAQQ \\CHARHI 7)
(RPAQQ |\\AtomHTpages| 256)
(RPAQQ |\\LastAtomPage| 255)
(RPAQQ |\\MaxAtomFrLst| 65535)
(RPAQQ |\\SmallPosHi| 14)
(RPAQQ |\\SmallNegHi| 15)
(RPAQQ |\\NumSmallPages| 512)
(RPAQQ \\PNAME.HI 8)
(RPAQQ \\ATOM.HI 44)
(RPAQQ \\DEF.HI 10)
(RPAQQ \\VAL.HI 12)
(RPAQQ \\PLIST.HI 2)
(RPAQQ |\\NumPageMapPages| 256)
(RPAQQ |\\MDSTTsize| 1024)
(RPAQQ |\\UFNTableSize| 2)
(RPAQQ |\\DTDSize| 18)
(RPAQQ |\\EndTypeNumber| 2047)
(RPAQQ |\\NumLPTPages| 16)
(RPAQQ |\\GuardStackAddr| 61440)
(RPAQQ |\\LastStackAddr| 65534)
(RPAQQ \\STACKHI 1)
(RPAQQ |\\HTMAINnpages| 256)
(RPAQQ |\\D1BCPLspace| 0)
(RPAQQ |\\D0BCPLspace| 0)
(RPAQQ |\\CurrentFXP| 0)
(RPAQQ |\\ResetFXP| 1)
(RPAQQ |\\SubovFXP| 2)
(RPAQQ |\\KbdFXP| 3)
(RPAQQ |\\HardReturnFXP| 4)
(RPAQQ \\GCFXP 5)
(RPAQQ \\FAULTFXP 6)
(RPAQQ |\\MiscFXP| 14)
(RPAQQ |\\TeleRaidFXP| 24)
(RPAQQ DCB.EM 272)
(RPAQQ DISPINTERRUPT.EM 273)
(RPAQQ CURSORBITMAP.EM 281)
(RPAQQ KBDAD0.EM 65052)
(RPAQQ KBDAD1.EM 65053)
(RPAQQ KBDAD2.EM 65054)
(RPAQQ KBDAD3.EM 65055)
(RPAQQ UTILIN.EM 65048)
(RPAQQ CURSORX.EM 278)
(RPAQQ CURSORY.EM 279)
(RPAQQ MOUSEX.EM 276)
(RPAQQ MOUSEY.EM 277)
(RPAQQ |\\LispKeyMask| 8192)
(RPAQQ |\\BcplKeyMask| 4352)
(RPAQQ \\MAIKO 3)
(RPAQQ \\DOLPHIN 4)
(RPAQQ \\DORADO 5)
(RPAQQ \\DANDELION 6)
(RPAQQ \\DAYBREAK 8)
(RPAQQ \\VP.DISPLAY 4608)
(RPAQQ \\NP.DISPLAY 202)
(RPAQQ \\NP.WIDEDOVEDISPLAY 243)
(RPAQQ \\WIDEDOVEDISPLAYWIDTH 1152)
(RPAQQ \\RP.AFTERDISPLAY 206)
(RPAQQ \\RP.AFTERDOVEDISPLAY 243)
(RPAQQ \\RP.DISPLAY 0)
(RPAQQ \\RP.TEMPDISPLAY 2561)
(RPAQQ \\RP.MISCLOCKED 2804)
(RPAQQ \\RP.STACK 768)
(RPAQQ \\VP.STACK 256)
(RPAQQ \\RP.MAP 256)
(RPAQQ \\NP.MAP 256)
(RPAQQ \\RP.IOPAGE 512)
(RPAQQ \\RP.DOVEIOCBPAGE 543)
(RPAQQ \\RP.DOVEIORGN 544)
(RPAQQ \\VP.DOVEIORGN 64)
(RPAQQ \\DOVEIORGNSIZE 64)
(RPAQQ \\VP.IOPAGE 255)
(RPAQQ \\VP.IFPAGE 5120)
(RPAQQ \\VP.FPTOVP 512)
(RPAQQ \\NP.FPTOVP 4096)
(RPAQQ \\RP.FPTOVP 1024)
(RPAQQ \\RP.STARTBUFFERS 640)
(RPAQQ \\VP.TYPETABLE 6144)
(RPAQQ \\NP.TYPETABLE 1024)
(RPAQQ \\RP.TYPETABLE 5120)
(RPAQQ \\VP.GCTABLE 5632)
(RPAQQ \\NP.GCTABLE 256)
(RPAQQ \\RP.GCTABLE 6144)
(RPAQQ \\VP.GCOVERFLOW 5888)
(RPAQQ \\NP.GCOVERFLOW 1)
(RPAQQ \\RP.GCOVERFLOW 6400)
(RPAQQ \\FP.IFPAGE 2)
(RPAQQ \\VP.IOCBS 1)
(RPAQQ \\VP.PRIMARYMAP 5122)
(RPAQQ \\VP.SECONDARYMAP 1280)
(RPAQQ \\VP.LPT 5232)
(RPAQQ \\VP.INITSCRATCH 8)
(RPAQQ \\VP.RPT 128)
(RPAQQ \\VP.BUFFERS 218)
(RPAQQ \\DL.PROCESSORBUSY 32768)
(RPAQQ \\DL.SETTOD 32769)
(RPAQQ \\DL.READTOD 32770)
(RPAQQ \\DL.READPID 32771)
(RPAQQ \\DL.BOOTBUTTON 32772)
(CONSTANTS (CDRCODING 1) (\\SMALLP 1) (\\FIXP 2) (\\FLOATP 3) (\\LITATOM 4) (\\LISTP 5) (\\ARRAYP 6) (
\\STRINGP 7) (\\STACKP 8) (\\CHARACTERP 9) (\\VMEMPAGEP 10) (\\STREAM 11) (\\TT.TYPEMASK 2047) (
\\TT.NOREF 32768) (\\TT.SYMBOLP 16384) (\\TT.FIXP 8192) (\\TT.NUMBERP 4096) (\\TT.ATOM 2048) (
|\\PMblockSize| 32) (|\\STATSsize| 8) (|\\NumPMTpages| 8) (|\\EmptyPMTEntry| 65535) (
|\\FirstVmemBlock| 2) (\\MAXVMPAGE 131069) (\\MAXVMSEGMENT 255) (|\\IFPValidKey| 5603) (
|\\FirstMDSPage| 32766) (|\\MaxMDSPage| 524285) (|\\DefaultSecondMDSPage| 65532) (|\\MDSIncrement| 512
) (|\\PagesPerMDSUnit| 2) (|\\FirstArraySegment| 46) (|\\FirstArrayPage| 11776) (
|\\DefaultSecondArrayPage| 32768) (|\\StackMask| 57344) (|\\FxtnBlock| 49152) (|\\GuardBlock| 57344) (
|\\BFBlock| 32768) (|\\FreeStackBlock| 40960) (|\\NotStackBlock| 0) (|\\MinExtraStackWords| 32) (
ERASECHARCODE 0) (\\HT1CNT 1024) (\\HTSTKBIT 512) (\\HTCNTMASK 64512) (\\HTMAINSIZE 65536) (
\\HTCOLLSIZE 1048576) (\\HTENDFREE 1) (\\HTFREEPTR 0) (|\\AtomHI| 0) (\\CHARHI 7) (|\\AtomHTpages| 256
) (|\\LastAtomPage| 255) (|\\MaxAtomFrLst| 65535) (|\\SmallPosHi| 14) (|\\SmallNegHi| 15) (
|\\NumSmallPages| 512) (\\PNAME.HI 8) (\\ATOM.HI 44) (\\DEF.HI 10) (\\VAL.HI 12) (\\PLIST.HI 2) (
|\\NumPageMapPages| 256) (|\\MDSTTsize| 1024) (|\\UFNTableSize| 2) (|\\DTDSize| 18) (|\\EndTypeNumber|
 2047) (|\\NumLPTPages| 16) (|\\GuardStackAddr| 61440) (|\\LastStackAddr| 65534) (\\STACKHI 1) (
|\\HTMAINnpages| 256) (|\\D1BCPLspace| 0) (|\\D0BCPLspace| 0) (|\\CurrentFXP| 0) (|\\ResetFXP| 1) (
|\\SubovFXP| 2) (|\\KbdFXP| 3) (|\\HardReturnFXP| 4) (\\GCFXP 5) (\\FAULTFXP 6) (|\\MiscFXP| 14) (
|\\TeleRaidFXP| 24) (DCB.EM 272) (DISPINTERRUPT.EM 273) (CURSORBITMAP.EM 281) (KBDAD0.EM 65052) (
KBDAD1.EM 65053) (KBDAD2.EM 65054) (KBDAD3.EM 65055) (UTILIN.EM 65048) (CURSORX.EM 278) (CURSORY.EM 
279) (MOUSEX.EM 276) (MOUSEY.EM 277) (|\\LispKeyMask| 8192) (|\\BcplKeyMask| 4352) (\\MAIKO 3) (
\\DOLPHIN 4) (\\DORADO 5) (\\DANDELION 6) (\\DAYBREAK 8) (\\VP.DISPLAY 4608) (\\NP.DISPLAY 202) (
\\NP.WIDEDOVEDISPLAY 243) (\\WIDEDOVEDISPLAYWIDTH 1152) (\\RP.AFTERDISPLAY 206) (\\RP.AFTERDOVEDISPLAY
 243) (\\RP.DISPLAY 0) (\\RP.TEMPDISPLAY 2561) (\\RP.MISCLOCKED 2804) (\\RP.STACK 768) (\\VP.STACK 256
) (\\RP.MAP 256) (\\NP.MAP 256) (\\RP.IOPAGE 512) (\\RP.DOVEIOCBPAGE 543) (\\RP.DOVEIORGN 544) (
\\VP.DOVEIORGN 64) (\\DOVEIORGNSIZE 64) (\\VP.IOPAGE 255) (\\VP.IFPAGE 5120) (\\VP.FPTOVP 512) (
\\NP.FPTOVP 4096) (\\RP.FPTOVP 1024) (\\RP.STARTBUFFERS 640) (\\VP.TYPETABLE 6144) (\\NP.TYPETABLE 
1024) (\\RP.TYPETABLE 5120) (\\VP.GCTABLE 5632) (\\NP.GCTABLE 256) (\\RP.GCTABLE 6144) (
\\VP.GCOVERFLOW 5888) (\\NP.GCOVERFLOW 1) (\\RP.GCOVERFLOW 6400) (\\FP.IFPAGE 2) (\\VP.IOCBS 1) (
\\VP.PRIMARYMAP 5122) (\\VP.SECONDARYMAP 1280) (\\VP.LPT 5232) (\\VP.INITSCRATCH 8) (\\VP.RPT 128) (
\\VP.BUFFERS 218) (\\DL.PROCESSORBUSY 32768) (\\DL.SETTOD 32769) (\\DL.READTOD 32770) (\\DL.READPID 
32771) (\\DL.BOOTBUTTON 32772))
(RPAQQ \\MPERRORS ((\\MP.OBSOLETEVMEM 1) (\\MP.INVALIDVMEM 2 "Vmem inconsistent at startup") (
\\MP.IOCBPAGE 3 "No place for IOCB page at startup") (\\MP.MOB 4 "Map out of bounds") (
\\MP.INVALIDADDR 5) (\\MP.INVALIDVP 6) (\\MP.CHAIN.UNAVAIL 7 
"Unavailable page on real page table chain") (\\MP.SELECTLOOP 8 "Loop in \\SELECTREALPAGE") (
\\MP.NEWPAGE 9 "Attempt to allocate already existing page") (\\MP.NEWMAPPAGE 10 
"\\DONEWPAGE failed to allocate new map page") (\\MP.BADLOCKED 11 
"Locked page occupies a file page needed to lock another") (\\MP.CLOCK0 12 
"Arg to CLOCK0 not an integer box") (\\MP.RESIDENT 13 "Fault on resident page") (\\MP.STACKFAULT 14 
"Fault on stack") (\\MP.VMEMTOOLONG 16 "Attempt to extend Vmem File beyond fixed limit (8mb)") (
\\MP.WRITING.LOCKED.PAGE 17 "Writing a locked page with UPDATEKEY = T") (\\MP.UNINTERRUPTABLE 18 
"Error in uninterruptable system code") (\\MP.STACKFULL 19) (\\MP.MDSFULL 20) (\\MP.UNKNOWN.UFN 21) (
\\MP.ATOMSFULL 22) (\\MP.PNAMESFULL 23) (\\MP.USECOUNTOVERFLOW 24) (\\MP.MDSFULLWARNING 25) (
\\MP.BADMDSFREELIST 26) (\\MP.BADARRAYBLOCK 27) (\\MP.BADDELETEBLOCK 28) (\\MP.BADARRAYRECLAIM 29) (
\\MP.BIGREFCNTMISSING 30 "PTR refcnt previously overflowed, but not found in table.") (
\\MP.BIGREFCNTALREADYPRESENT 31 "PTR already in overflow table") (\\MP.DELREF0 32) (\\MP.PROCERROR 33)
 (\\MP.PROCNOFRAME 34 "Failed to build frame for PROCESS use") (\\MP.32MBINUSE 35) (\\MP.TOPUNWOUND 36
 "Unexpected (RETTO T)") (\\MP.STACKRELEASED 37) (\\MP.FLUSHLOCKED 38) (\\MP.MAPNOTLOCKED 39) (
\\MP.UNLOCKINGMAP 40) (\\MP.SWAPDISKERROR 41 "Hard Disk Error in swapper") (\\MP.BADRUNTABLE 42 
"Malformed run table for vmem file")))
(RPAQQ \\MP.OBSOLETEVMEM 1)
(RPAQ \\MP.INVALIDVMEM 2 "Vmem inconsistent at startup")
(RPAQ \\MP.IOCBPAGE 3 "No place for IOCB page at startup")
(RPAQ \\MP.MOB 4 "Map out of bounds")
(RPAQQ \\MP.INVALIDADDR 5)
(RPAQQ \\MP.INVALIDVP 6)
(RPAQ \\MP.CHAIN.UNAVAIL 7 "Unavailable page on real page table chain")
(RPAQ \\MP.SELECTLOOP 8 "Loop in \\SELECTREALPAGE")
(RPAQ \\MP.NEWPAGE 9 "Attempt to allocate already existing page")
(RPAQ \\MP.NEWMAPPAGE 10 "\\DONEWPAGE failed to allocate new map page")
(RPAQ \\MP.BADLOCKED 11 "Locked page occupies a file page needed to lock another")
(RPAQ \\MP.CLOCK0 12 "Arg to CLOCK0 not an integer box")
(RPAQ \\MP.RESIDENT 13 "Fault on resident page")
(RPAQ \\MP.STACKFAULT 14 "Fault on stack")
(RPAQ \\MP.VMEMTOOLONG 16 "Attempt to extend Vmem File beyond fixed limit (8mb)")
(RPAQ \\MP.WRITING.LOCKED.PAGE 17 "Writing a locked page with UPDATEKEY = T")
(RPAQ \\MP.UNINTERRUPTABLE 18 "Error in uninterruptable system code")
(RPAQQ \\MP.STACKFULL 19)
(RPAQQ \\MP.MDSFULL 20)
(RPAQQ \\MP.UNKNOWN.UFN 21)
(RPAQQ \\MP.ATOMSFULL 22)
(RPAQQ \\MP.PNAMESFULL 23)
(RPAQQ \\MP.USECOUNTOVERFLOW 24)
(RPAQQ \\MP.MDSFULLWARNING 25)
(RPAQQ \\MP.BADMDSFREELIST 26)
(RPAQQ \\MP.BADARRAYBLOCK 27)
(RPAQQ \\MP.BADDELETEBLOCK 28)
(RPAQQ \\MP.BADARRAYRECLAIM 29)
(RPAQ \\MP.BIGREFCNTMISSING 30 "PTR refcnt previously overflowed, but not found in table.")
(RPAQ \\MP.BIGREFCNTALREADYPRESENT 31 "PTR already in overflow table")
(RPAQQ \\MP.DELREF0 32)
(RPAQQ \\MP.PROCERROR 33)
(RPAQ \\MP.PROCNOFRAME 34 "Failed to build frame for PROCESS use")
(RPAQQ \\MP.32MBINUSE 35)
(RPAQ \\MP.TOPUNWOUND 36 "Unexpected (RETTO T)")
(RPAQQ \\MP.STACKRELEASED 37)
(RPAQQ \\MP.FLUSHLOCKED 38)
(RPAQQ \\MP.MAPNOTLOCKED 39)
(RPAQQ \\MP.UNLOCKINGMAP 40)
(RPAQ \\MP.SWAPDISKERROR 41 "Hard Disk Error in swapper")
(RPAQ \\MP.BADRUNTABLE 42 "Malformed run table for vmem file")
(CONSTANTS (\\MP.OBSOLETEVMEM 1) (\\MP.INVALIDVMEM 2 "Vmem inconsistent at startup") (\\MP.IOCBPAGE 3 
"No place for IOCB page at startup") (\\MP.MOB 4 "Map out of bounds") (\\MP.INVALIDADDR 5) (
\\MP.INVALIDVP 6) (\\MP.CHAIN.UNAVAIL 7 "Unavailable page on real page table chain") (\\MP.SELECTLOOP 
8 "Loop in \\SELECTREALPAGE") (\\MP.NEWPAGE 9 "Attempt to allocate already existing page") (
\\MP.NEWMAPPAGE 10 "\\DONEWPAGE failed to allocate new map page") (\\MP.BADLOCKED 11 
"Locked page occupies a file page needed to lock another") (\\MP.CLOCK0 12 
"Arg to CLOCK0 not an integer box") (\\MP.RESIDENT 13 "Fault on resident page") (\\MP.STACKFAULT 14 
"Fault on stack") (\\MP.VMEMTOOLONG 16 "Attempt to extend Vmem File beyond fixed limit (8mb)") (
\\MP.WRITING.LOCKED.PAGE 17 "Writing a locked page with UPDATEKEY = T") (\\MP.UNINTERRUPTABLE 18 
"Error in uninterruptable system code") (\\MP.STACKFULL 19) (\\MP.MDSFULL 20) (\\MP.UNKNOWN.UFN 21) (
\\MP.ATOMSFULL 22) (\\MP.PNAMESFULL 23) (\\MP.USECOUNTOVERFLOW 24) (\\MP.MDSFULLWARNING 25) (
\\MP.BADMDSFREELIST 26) (\\MP.BADARRAYBLOCK 27) (\\MP.BADDELETEBLOCK 28) (\\MP.BADARRAYRECLAIM 29) (
\\MP.BIGREFCNTMISSING 30 "PTR refcnt previously overflowed, but not found in table.") (
\\MP.BIGREFCNTALREADYPRESENT 31 "PTR already in overflow table") (\\MP.DELREF0 32) (\\MP.PROCERROR 33)
 (\\MP.PROCNOFRAME 34 "Failed to build frame for PROCESS use") (\\MP.32MBINUSE 35) (\\MP.TOPUNWOUND 36
 "Unexpected (RETTO T)") (\\MP.STACKRELEASED 37) (\\MP.FLUSHLOCKED 38) (\\MP.MAPNOTLOCKED 39) (
\\MP.UNLOCKINGMAP 40) (\\MP.SWAPDISKERROR 41 "Hard Disk Error in swapper") (\\MP.BADRUNTABLE 42 
"Malformed run table for vmem file"))
(GLOBALVARS \\ARRAYSPACE \\ARRAYSPACE2 \\ATOMSPACE |\\AtomHashTable| \\SMALLPOSPSPACE \\SMALLNEGSPACE 
\\PNPSPACE \\OLDATOMSPACE \\DEFSPACE \\VALSPACE \\PLISTSPACE \\PAGEMAP |\\PageMapTBL| 
|\\InterfacePage| \\IOPAGE |\\DoveIORegion| \\IOCBPAGE \\FPTOVP |\\MDSTypeTable| \\MISCSTATS 
|\\UFNTable| |\\DTDSpaceBase| \\LISTPDTD \\LOCKEDPAGETABLE \\STACKSPACE \\HTMAIN \\HTOVERFLOW 
\\HTBIGCOUNT \\HTCOLL \\DISPLAYREGION)
(BLOCKRECORD MISCSTATS ((STARTTIME FIXP) (TOTALTIME FIXP) (SWAPWAITTIME FIXP) (PAGEFAULTS FIXP) (
SWAPWRITES FIXP) (DISKIOTIME FIXP) (DISKOPS FIXP) (KEYBOARDWAITTIME FIXP) (GCTIME FIXP) (NETIOTIME 
FIXP) (NETIOOPS FIXP) (SWAPTEMP0 FIXP) (SWAPTEMP1 FIXP) (RCLKSECOND FIXP) (SECONDSCLOCK FIXP) (
MILLISECONDSCLOCK FIXP) (BASECLOCK FIXP) (RCLKTEMP0 FIXP) (SECONDSTMP FIXP) (MILLISECONDSTMP FIXP) (
BASETMP FIXP) (EXCESSTIMETMP FIXP) (CLOCKTEMP0 FIXP) (DISKTEMP0 FIXP) (DISKTEMP1 FIXP) (TELERAIDTEMP1 
FIXP) (TELERAIDTEMP2 FIXP) (TELERAIDTEMP3 FIXP) (LASTUSERACTION FIXP) (DLMOUSETIMER FIXP) (DLMOUSETEMP
 FIXP)) (CREATE (\\ALLOCBLOCK 31)))
(BLOCKRECORD IFPAGE ((|CurrentFXP| WORD) (* \; 
"First 7 items are FX values for user and 6 system contexts.") (|ResetFXP| WORD) (|SubovFXP| WORD) (
|KbdFXP| WORD) (|HardReturnFXP| WORD) (GCFXP WORD) (FAULTFXP WORD) (|EndOfStack| WORD) (* \; 
"Stack high-water mark: address of guard block at current end of stack") (|LVersion| WORD) (* \; 
"Lisp version, followed by min versions of microcode and Bcpl compatible with this Lisp") (
|MinRVersion| WORD) (|MinBVersion| WORD) (|RVersion| WORD) (* \; 
"Bcpl fills in the actual microcode, Bcpl versions.") (|BVersion| WORD) (|MachineType| WORD) (
|MiscFXP| WORD) (* \; "FX for MISC context") (|Key| WORD) (* \; "= IFPValidKey if vmem consistent.") (
|SerialNumber| WORD) (* \; "Pup host number (Dorado/Dolphin)") (|EmulatorSpace| WORD) (* \; 
"Hiloc of bcpl space (always zero now)") (|ScreenWidth| WORD) (|NxtPMAddr| WORD) (* \; 
"Next page to be allocated in secondary page map table") (NIL WORD) (* \; 
"WAS NActivePages, Length of vmem in use") (NIL WORD) (* \; 
"WAS NDirtyPages, not used, but maintained as = NActivePages") (|filePnPMP0| WORD) (* \; 
"Sysout page number of first page of secondary page map table (\\PAGEMAP), which is where the secondary map pages themselves live"
) (|filePnPMT0| WORD) (* \; "Sysout page number of first page of primary page map table") (TELERAIDFXP
 WORD) (* \; "FX for TeleRaid server context") (NATIVE-START-MEM-PAGE WORD) (* \; 
"Unix page where native code starts") (NATIVE-LENGTH-PAGE WORD) (* \; 
"Unix page length of native code") (NATIVE-PAGE-OFFSET WORD) (* \; 
"Lisp Disk Page offset  of native code") (|UserNameAddr| WORD) (* \; 
"Addresses in bcpl space (seg 0) of global user name and password") (|UserPswdAddr| WORD) (|StackBase|
 WORD) (* \; "Stack address where user stack starts") (FAULTHI WORD) (* \; 
"Microcode for page fault stores fault address here, then does context switch to FAULTFXP") (FAULTLO 
WORD) (DEVCONFIG WORD) (* \; "IT'S FOR KB,DISP TYPE") (* \; 
"Formerly REALPAGETABLE, back when it was always in Bcpl space.") (RPTSIZE WORD) (* \; 
"Number of entries in Real Page Table") (RPOFFSET WORD) (* \; "RP-RPOFFSET => index in table") (
MAXETHERBYTES WORD) (* \; "Number of bytes available in a pbi, not counting encapsulation (Dorado)") (
EMBUFVP WORD) (* \; "VP of a one-page emulator buffer") (|NSHost0| WORD) (* \; 
"Machine's 48-bit NS host number.  Lisp manages to compute this on all machines except Dolphin, where Bcpl fills it in."
) (|NSHost1| WORD) (|NSHost2| WORD) (|MDSZone| WORD) (* \; 
"Obsolete -- was used by Dolphin 10MB network code.") (|MDSZoneLength| WORD) (EMUBUFFERS WORD) (* \; 
"Buffer space in segment 0 for swapping/disk activity") (EMUBUFLENGTH WORD) (* \; 
"Number of words of said space") (* |;;| 
"The following 2 are available if NEW_STOARGE is specified in C") (|ProcessSize| WORD) (* \; 
"Process size for which can be use as LISP space") (|StorageFullState| WORD) (* \; 
"Save last storage state") (ISFMAP WORD) (* |;;| 
"The following 4 are for \\MISCAPPLY* -- note that they are not ref counted, so don't pass the only pointer to something this way!"
) (MISCSTACKFN FULLXPOINTER) (MISCSTACKARG1 FULLXPOINTER) (MISCSTACKARG2 FULLXPOINTER) (
MISCSTACKRESULT FULLXPOINTER) (|NRealPages| WORD) (* \; "Number pages of real memory") (
|LastLockedFilePage| WORD) (* \; 
"Last page of vmem that is locked--booting has to load at least that far.") (|LastDominoFilePage| WORD
) (* \; "Last sysout page reserved for Dandelion microcode") (|FPTOVPStart| WORD) (* \; 
"Sysout page where FPTOVP starts") (FAKEMOUSEBITS WORD) (* \; 
"Used to implement fake middle button on 2-button Dandelion.") (|DL24BitAddressable| WORD) (* \; 
"non-zero if DLion capable of addressing 32MB virtual memory") (REALPAGETABLEPTR FULLXPOINTER) (* \; 
"Address of real page table, set up by Bcpl (but not chained together)") (SYSDISK WORD) (* \; 
"WAS DLLastVmemPage, DLion booting microcode puts length of vmem file here.") (|FullSpaceUsed| WORD) (
* \; "Non-zero if vmem beyond initial 8MB has been allocated.") (FAKEKBDAD4 WORD) (FAKEKBDAD5 WORD) (*
 |;;| 
"The following 9 items (6 words and 3 pointers) are 3 3-element vectors for the Dorado extended virtual memory code--indexed by 0,1,2 according to which of up to 3 virtual memory backing files you're working with."
) (|XVmemFmapBase| WORD) (* \; 
"Bcpl stores isf map pointer to each partition here.  First is redundant with ISFMAP field above.") (
NIL WORD) (NIL WORD) (|XVmemFmapHighBase| WORD) (* \; 
"Bcpl stores the highest vm page contained in this or earlier partition.") (NIL WORD) (NIL WORD) (
|XVmemDiskBase| FULLXPOINTER) (* \; 
"Lisp stores disk objects here (just a convenient non-faulting contiguous block of storage).") (NIL 
FULLXPOINTER) (NIL FULLXPOINTER) (|DLLastVmemPage| FIXP) (* \; 
"DLion booting microcode puts length of vmem file here.") (|NActivePages| FIXP) (* \; 
"Length of vmem in use") (|NDirtyPages| FIXP) (* \; "not used, but maintained as = NActivePages")) (
CREATE (\\ALLOCBLOCK 43)))
(BLOCKRECORD IOPAGE ((NIL 18 WORD) (DLMAINTPANEL WORD) (DLFLOPPYCMD WORD) (DLTTYPORTCMD WORD) (
DLPROCESSORCMD WORD) (NEWMOUSESTATE WORD) (DLBEEPCMD WORD) (DLRS232CMISCCOMMAND WORD) (DLRS232CPUTFLAG
 WORD) (DLRS232CGETFLAG WORD) (NIL 6 WORD) (DLFLOPPY WORD) (DLTTYOUT WORD) (NIL 1 WORD) (DLTTYIN WORD)
 (NIL 1 WORD) (DLPROCESSOR2 WORD) (DLPROCESSOR1 WORD) (DLPROCESSOR0 WORD) (NEWMOUSEX WORD) (NEWMOUSEY 
WORD) (DLBEEPFREQ WORD) (DLRS232CPARAMETERCSBLO WORD) (DLRS232CPARAMETERCSBHI WORD) (
DLRS232CSETRS366STATUS 3 WORD) (DLRS232CPUTCSBLO WORD) (DLRS232CPUTCSBHI WORD) (DLRS232CGETCSBLO WORD)
 (DLRS232CGETCSBHI WORD) (DLRS232CDEVICESTATUS WORD) (DLRS232CPARAMETEROUTCOME WORD) (DLTODVALID WORD)
 (DLTODLO WORD) (DLTODHI WORD) (DLTODLO2 WORD) (DLMOUSEX WORD) (DLMOUSEY WORD) (DLUTILIN WORD) (
DLKBDAD0 WORD) (DLKBDAD1 WORD) (DLKBDAD2 WORD) (DLKBDAD3 WORD) (DLKBDAD4 WORD) (DLKBDAD5 WORD) (
DLLSEPIMAGECSB 32 WORD) (DLIOPHARDWARECONFIG WORD) (NIL 11 WORD) (DLRS232CPARAMETERCSBLO.11 WORD) (
DLRS232CPARAMETERCSBHI.11 WORD) (DLRS232CSETRS366STATUS.11 14 WORD) (NIL 60 WORD) (DLMAGTAPE 4 WORD) (
DLETHERNET 12 WORD) (NIL 31 WORD) (DLDISPINTERRUPT WORD) (DLDISPCONTROL WORD) (DLDISPBORDER WORD) (
DLCURSORX WORD) (DLCURSORY WORD) (DLCURSORBITMAP 16 WORD)) (ACCESSFNS IOPAGE ((DLCURSORBITMAPPTR (
\\ADDBASE DATUM 240)) (DLCURSORYPTR (\\ADDBASE DATUM 239)) (DLCURSORXPTR (\\ADDBASE DATUM 238)) (
DLDISPINTERRUPTPTR (\\ADDBASE DATUM 235)) (DLETHERNETPTR (\\ADDBASE DATUM 192)) (DLKBDAD5PTR (
\\ADDBASE DATUM 67)) (DLKBDAD4PTR (\\ADDBASE DATUM 66)) (DLKBDAD3PTR (\\ADDBASE DATUM 65)) (
DLKBDAD2PTR (\\ADDBASE DATUM 64)) (DLKBDAD1PTR (\\ADDBASE DATUM 63)) (DLKBDAD0PTR (\\ADDBASE DATUM 62)
) (DLUTILINPTR (\\ADDBASE DATUM 61)) (DLMOUSEYPTR (\\ADDBASE DATUM 60)) (DLMOUSEXPTR (\\ADDBASE DATUM 
59)) (DLTODLOPTR (\\ADDBASE DATUM 56)) (DLMAINTPANELPTR (\\ADDBASE DATUM 18)))) (CREATE (\\ALLOCBLOCK 
128)))
(PUTPROPS EMADDRESS MACRO (ARGS ((LAMBDA (ADDR) (COND ((EQ |\\D1BCPLspace| |\\D0BCPLspace|) (LIST (
LIST (QUOTE OPCODES) (QUOTE GCONST) 0 0 (LRSH ADDR 8) (LOGAND ADDR 255)))) (T (BQUOTE (\\VAG2 (|fetch|
 |EmulatorSpace| |of| |\\InterfacePage|) \, ADDR))))) (EVAL (CAR ARGS)))))
(PUTPROPS EMGETBASE MACRO ((OFFSET) (\\GETBASE (EMADDRESS OFFSET) 0)))
(PUTPROPS EMPUTBASE MACRO ((OFFSET VAL) (\\PUTBASE (EMADDRESS OFFSET) 0 VAL)))
(PUTPROPS EMULATORSEGMENT MACRO (NIL (|fetch| |EmulatorSpace| |of| |\\InterfacePage|)))
(PUTPROPS EMPOINTER MACRO (X (COND ((NEQ |\\D1BCPLspace| |\\D0BCPLspace|) (LIST (QUOTE \\VAG2) (QUOTE 
(|fetch| (IFPAGE |EmulatorSpace|) |of| |\\InterfacePage|)) (CAR X))) ((ZEROP (CAR X)) NIL) (T (LIST (
QUOTE \\VAG2) |\\D0BCPLspace| (CAR X))))))
(PUTPROPS EMADDRESSP MACRO (X (LIST (QUOTE EQ) (LIST (QUOTE \\HILOC) (CAR X)) (COND ((EQ 
|\\D1BCPLspace| |\\D0BCPLspace|) |\\D0BCPLspace|) (T (QUOTE (|fetch| (IFPAGE |EmulatorSpace|) |of| 
|\\InterfacePage|)))))))
(PUTPROP (QUOTE LLPARAMS) (QUOTE IMPORTDATE) (IDATE " 7-Feb-2021 11:52:02"))

(DATATYPE COMPILED-CLOSURE (FNHEADER ENVIRONMENT))
(RPAQQ \\COMPILED-CLOSURE 13)
(CONSTANTS \\COMPILED-CLOSURE)
(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)))))
(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))))))))
(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)))
(PUTPROPS BYTESPERNAMEENTRY MACRO (NIL (UNFOLD (CONSTANT (WORDSPERNAMEENTRY)) BYTESPERWORD)))
(PUTPROPS BYTESPERNTOFFSETENTRY MACRO (NIL (UNFOLD (WORDSPERNAMEENTRY) BYTESPERWORD)))
(PUTPROPS GETNAMEENTRY MACRO (OPENLAMBDA (DEF LC) (LET ((NUMBER 0)) (* |;;| 
"Must ALWAYS be called with DEF really being either a FNHEADER or a nametable pseudo-fnheader.  Never use addbase to offset from it.  This is because CODEBASEELT checks the BYTESWAPPED flag in the fnheader...."
) (FOR I FROM 0 TO (CONSTANT (SUB1 (BYTESPERNAMEENTRY))) DO (SETQ NUMBER (LOGOR (LLSH NUMBER 
BITSPERBYTE) (CODEBASELT DEF (IPLUS LC I))))) NUMBER)))
(PUTPROPS GETNTFLAGS MACRO (OPENLAMBDA (DEF LC) (CODEBASELT DEF LC)))
(PUTPROPS GETNTOFFSET MACRO (OPENLAMBDA (DEF LC) (NTSLOT-OFFSET (GETNTOFFSETENTRY DEF LC))))
(PUTPROPS GETNTOFFSETENTRY MACRO (OPENLAMBDA (DEF LC) (LET ((NUMBER 0)) (|for| I |from| 0 |to| (
CONSTANT (SUB1 (BYTESPERNTOFFSETENTRY))) |do| (SETQ NUMBER (LOGOR (LLSH NUMBER BITSPERBYTE) (
CODEBASELT DEF (IPLUS LC I))))) NUMBER)))
(PUTPROPS GETNTTAG MACRO (OPENLAMBDA (DEF LC) (CODEBASELT DEF (ADD1 LC))))
(PUTPROPS SETNAMEENTRY MACRO (OPENLAMBDA (DEF LC VALUE) (FOR I FROM (CONSTANT (SUB1 (BYTESPERNAMEENTRY
))) TO 0 BY -1 DO (CODEBASESETA DEF (IPLUS LC I) (LOGAND VALUE (CONSTANT (SUB1 (LLSH 1 BITSPERBYTE))))
) (SETQ VALUE (LRSH VALUE BITSPERBYTE)))))
(PUTPROPS WORDSPERNTOFFSETENTRY MACRO (NIL (WORDSPERNAMEENTRY)))
(PUTPROPS NTSLOT-OFFSET MACRO ((X) (LOGAND 255 X)))
(DEFMACRO NEW-SYMBOL-CODE (NEW-SYMBOL-FORM OLD-SYMBOL-FORM) (* |;;| 
"Use one form or another, depending on whether we're compiling for new 3-byte atoms or old 2-byte atom numbers."
) (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) (* \; "NEW ATOMS") (BQUOTE (\\\, 
NEW-SYMBOL-FORM))) (T (BQUOTE (\\\, OLD-SYMBOL-FORM)))))
(DEFOPTIMIZER BIG-VMEM-CODE (NEW-SYMBOL-FORM OLD-SYMBOL-FORM &ENVIRONMENT ENV) (* |;;| 
"Allow for differences between 4-byte pointers and 3-byte pointers..") (COND ((FMEMB :4-BYTE (
COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\\\, NEW-SYMBOL-FORM))) (T (BQUOTE (\\\, 
OLD-SYMBOL-FORM)))))
(DEFOPTIMIZER SETSTKNAMEENTRY (CODEARRAY OFFSET VAL &ENVIRONMENT ENV) (* |;;| 
"Set the name entry for a name-table entry.") (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE
 ENV)) (BQUOTE (LET ((BASE (|fetch| (ARRAYP BASE) |of| (\\\, CODEARRAY))) (VALUE (\\\, VAL))) (COND ((
FIXP VALUE) (* \; "A 20-byte atom #.  Make it an atom.") (\\PUTBASEPTR BASE (\\\, OFFSET) (\\VAG2 
|\\AtomHI| VALUE))) (T (* \; "A 3-byte atom.  Just use it.") (\\PUTBASEPTR BASE (\\\, OFFSET) VALUE)))
))) (T (BQUOTE (LET ((BASE (|fetch| (ARRAYP BASE) |of| (\\\, CODEARRAY)))) (\\PUTBASE BASE (\\\, 
OFFSET) (\\\, VAL)))))))
(DEFOPTIMIZER SETSTKNTOFFSETENTRY (BASE OFFSET VAL &ENVIRONMENT ENV) (* |;;| 
"Set the offset entry for a name-table entry.") (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE
 ENV)) (BQUOTE (\\PUTBASEFIXP (\\\, BASE) (\\\, OFFSET) (\\\, VAL)))) (T (BQUOTE (\\PUTBASE (\\\, BASE
) (\\\, OFFSET) (\\\, VAL))))))
(DEFOPTIMIZER GETSTKNAMEENTRY (BASE OFFSET &ENVIRONMENT ENV) (* |;;| 
"Get a name entry out of a name table.  BASE is the start of the name table; OFFSET is in words, not bytes or name entries."
) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\\GETBASEPTR (\\\, BASE) (
\\\, OFFSET)))) (T (BQUOTE (\\GETBASE (\\\, BASE) (\\\, OFFSET))))))
(DEFOPTIMIZER GETSTKNTOFFSETENTRY (BASE OFFSET &ENVIRONMENT ENV) (COND ((FMEMB :3-BYTE (
COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\\GETBASEFIXP (\\\, BASE) (\\\, OFFSET)))) (T (BQUOTE
 (\\GETBASE (\\\, BASE) (\\\, OFFSET))))))
(DEFOPTIMIZER WORDSPERNAMEENTRY (&ENVIRONMENT ENV) (* |;;| 
"Number of words in a name-table \"Name\" entry--the space for the symbol.  1 for old symbol systems, 2 for 3-byte-atom systesm."
) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (PROGN 2))) ((AND 
CROSSCOMPILING (FMEMB :3-BYTE-INIT (COMPILER::ENV-TARGET-ARCHITECTURE ENV))) (BQUOTE (PROGN 2))) (T (
BQUOTE (PROGN 1)))))
(DEFOPTIMIZER SETSTKNTOFFSET (BASE OFFSET TYPE VAL &ENVIRONMENT ENV) (* |;;| 
"Set the offset entry for a name-table entry, from the symbol to fill in plus the variable-type marker value SHIFTED LEFT 14 BITS ALREADY."
) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (PROGN (\\FIXCODENUM (\\\, 
BASE) (IDIFFERENCE (\\\, OFFSET) BYTESPERWORD) (\\\, TYPE)) (\\FIXCODENUM (\\\, BASE) (\\\, OFFSET) (
\\\, VAL))))) (T (BQUOTE (\\FIXCODENUM (\\\, BASE) (\\\, OFFSET) (IPLUS (\\\, TYPE) (\\\, VAL)))))))
(DEFOPTIMIZER SETSTKNAME-RAW (BASE OFFSET VAL &ENVIRONMENT ENV) (* |;;| 
"Set the name entry for a name-table entry. This version works with raw storage, as opposed to SETSTKNAMEENTRY, which works on an ARRAYP."
) (* |;;| "If this optimizer changes, change SETSTKNAMEENTRY as well.") (COND ((FMEMB :3-BYTE (
COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (LET ((VALUE (\\\, VAL))) (COND ((FIXP VALUE) (* \; 
"A 20-byte atom #.  Make it an atom.") (\\PUTBASEPTR (\\\, BASE) (\\\, OFFSET) (\\VAG2 |\\AtomHI| 
VALUE))) (T (* \; "A 3-byte atom.  Just use it.") (\\PUTBASEPTR (\\\, BASE) (\\\, OFFSET) VALUE)))))) 
(T (BQUOTE (\\PUTBASE (\\\, BASE) (\\\, OFFSET) (\\\, VAL))))))
(DEFOPTIMIZER SETSTKNTOFFSET-RAW (BASE OFFSET TYPE VAL &ENVIRONMENT ENV) (* |;;| 
"Set the offset entry for a name-table entry.  This version works on raw storage, vs SETSTKNAMEOFFSETENTRY, which is supposed to work on codearrays.  Any changes here should be made there, as well.  TYPE must already be shifted left by 14 bits."
) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (PROGN (\\PUTBASE (\\\, BASE)
 (\\\, OFFSET) (\\\, TYPE)) (\\PUTBASE (\\\, BASE) (IPLUS (\\\, OFFSET) 1) (\\\, VAL))))) (T (BQUOTE (
\\PUTBASE (\\\, BASE) (\\\, OFFSET) (IPLUS (\\\, TYPE) (\\\, VAL)))))))
(DEFOPTIMIZER NEW-SYMBOL-CODE (NEW-SYMBOL-FORM OLD-SYMBOL-FORM &ENVIRONMENT ENV) (* |;;| 
"Allow for differences between 3-byte atoms and 2-byte atoms.") (COND ((FMEMB :3-BYTE (
COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\\\, NEW-SYMBOL-FORM))) (T (BQUOTE (\\\, 
OLD-SYMBOL-FORM)))))
(DEFOPTIMIZER MAKE-NTENTRY (TYPE OFFSET &ENVIRONMENT ENV) (COND ((FMEMB :3-BYTE (
COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (IPLUS (CONSTANT (LLSH (\\\, TYPE) 16)) (\\\, OFFSET))
)) (T (BQUOTE (IPLUS (CONSTANT (\\\, TYPE)) (\\\, OFFSET))))))
(DEFOPTIMIZER NULL-NTENTRY (VALUE &ENVIRONMENT ENV) (* |;;| 
"Predicate:  Is  VALUE a null entry in a name table?  I.e., does it result from fetching the entry at the end that`s all zeros?  For 2-byte atoms, that's the same as being zero.  For 3-byte atoms, it's the same as being NIL."
) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (NULL (\\\, VALUE)))) (T (
BQUOTE (EQ (\\\, VALUE) 0)))))
(DEFOPTIMIZER NTSLOT-VARTYPE (X &ENVIRONMENT ENV) (* |;;| 
"Given the contents of a name-table Offset entry, return the variable-type bits at the top of the entry.  THE RESULT IS RETURNED SHEFTED LEFT 14 BITS, THE USUAL REPRESENTATION."
) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (LOGAND 49153 (LRSH (\\\, X) 
16)))) (T (BQUOTE (LOGAND (\\\, X) 49152)))))
(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) 207) (LLSH (LOGAND NEWVALUE 3) 4)))) (FRAMENAME (\\VAG2 (LOGAND (CODELT2 DATUM
 8) 4095) (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| (\\STKMIN DATUM))) (FRAMENAME# (PROGN 8)))))
(RECORD OPCODE (OP# OPCODENAME OPNARGS OPPRINT LEVADJ UFNFN UNIMPL))
(GLOBALVARS \\OPCODES)
(RPAQQ PVARCODE 32768)
(RPAQQ FVARCODE 49152)
(RPAQQ IVARCODE 0)
(RPAQQ VARCODEMASK 49152)
(CONSTANTS PVARCODE FVARCODE IVARCODE VARCODEMASK)
(RPAQQ \\NT.IVARCODE 0)
(RPAQQ \\NT.PVARCODE 2)
(RPAQQ \\NT.FVARCODE 3)
(CONSTANTS \\NT.IVARCODE \\NT.PVARCODE \\NT.FVARCODE)
(PUTPROP (QUOTE LLCODE) (QUOTE IMPORTDATE) (IDATE "19-Jan-1993 10:45:33"))

(RPAQQ \\ERRORMESSAGELIST ("SYSTEM ERROR" " " "STACK OVERFLOW" "ILLEGAL RETURN" "ARG NOT LIST" 
"HARD DISK ERROR" "ATTEMPT TO SET NIL OR T" "ATTEMPT TO RPLAC NIL" "UNDEFINED OR ILLEGAL GO" 
"FILE WON'T OPEN" "NON-NUMERIC ARG" "ATOM TOO LONG" "ATOM HASH TABLE FULL" "FILE NOT OPEN" 
"ARG NOT LITATOM" "! too many files open" "END OF FILE" "ERROR" "BREAK" "ILLEGAL STACK ARG" 
"FAULT IN EVAL" "ARRAYS FULL" "FILE SYSTEM RESOURCES EXCEEDED" "FILE NOT FOUND" "BAD SYSOUT FILE" 
"UNUSUAL CDR ARG LIST" "HASH TABLE FULL" "ILLEGAL ARG" "ARG NOT ARRAY" "ILLEGAL OR IMPOSSIBLE BLOCK" 
"STACK PTR HAS BEEN RELEASED" "STORAGE FULL" "ATTEMPT TO USE ITEM OF INCORRECT TYPE" 
"ILLEGAL DATA TYPE NUMBER" "DATA TYPES FULL" "ATTEMPT TO BIND NIL OR T" 
"! too many user interrupt characters" "! read-macro context error" "ILLEGAL READTABLE" 
"ILLEGAL TERMINAL TABLE" "! swapblock too big for buffer" "PROTECTION VIOLATION" "BAD FILE NAME" 
"USER BREAK" "UNBOUND ATOM" "UNDEFINED CAR OF FORM" "UNDEFINED FUNCTION" "CONTROL-E" 
"FLOATING UNDERFLOW" "FLOATING OVERFLOW" "OVERFLOW" "ARG NOT HARRAY" "TOO MANY ARGUMENTS"))
(DEFOPTIMIZER LISPERROR (MESSAGE ARG) (BQUOTE (\\LISPERROR (\\\, ARG) (\\\, (CL:IF (CL:STRINGP MESSAGE
) (FOR X IN \\ERRORMESSAGELIST AS I FROM 0 WHEN (CL:EQUAL X MESSAGE) DO (RETURN I) FINALLY (RETURN (
HELP "Unknown error message" (LIST MESSAGE ARG)))) MESSAGE)))))
(PUTPROP (QUOTE AERROR) (QUOTE IMPORTDATE) (IDATE "16-May-1990 11:58:35"))

(RECORD BASEBYTESTREAM STREAM (SUBRECORD STREAM) (ACCESSFNS ((BIASOFFST (|fetch| (STREAM FW6) |of| 
DATUM) (|replace| (STREAM FW6) |of| DATUM |with| NEWVALUE)) (BBSNCHARS (|fetch| (STREAM FW7) |of| 
DATUM) (|replace| (STREAM FW7) |of| DATUM |with| NEWVALUE)) (WRITEXTENSIONFN (|fetch| (STREAM F1) |of|
 DATUM) (|replace| (STREAM F1) |of| DATUM |with| NEWVALUE)))))
(PUTPROPS \\INSTREAMARG MACRO ((STRM NOERRORFLG) (\\GETSTREAM STRM (QUOTE INPUT) NOERRORFLG)))
(PUTPROPS \\OUTSTREAMARG MACRO ((STRM NOERRORFLG) (\\GETSTREAM STRM (QUOTE OUTPUT) NOERRORFLG)))
(PUTPROPS \\STREAMARG MACRO (OPENLAMBDA (STRM NOERRORFLG) (COND (NOERRORFLG (\\GETSTREAM STRM NIL T)) 
(T (\\DTEST STRM (QUOTE STREAM))))))
(PUTPROP (QUOTE AOFD) (QUOTE IMPORTDATE) (IDATE "13-Sep-1990 16:39:58"))

(PUTPROPS .SPACECHECK. MACRO ((STRM N) (AND \\THISFILELINELENGTH (IGREATERP (IPLUS N (|fetch| 
CHARPOSITION |of| STRM)) \\THISFILELINELENGTH) (FRESHLINE STRM))))
(PUTPROPS \\CHECKRADIX MACRO (LAMBDA (R) (COND ((OR (NOT (SMALLP R)) (ILESSP R 1) (IGREATERP R 36)) (
\\INVALID.RADIX R)) (T R))))
(PUTPROPS \\XCCSFILEOUTCHARFN MACRO ((OUTSTREAM CHARCODE) (* |;;;| 
"Encoder for XCCS format.  Default decoder.") (COND ((EQ CHARCODE (CHARCODE EOL)) (COND ((NOT (
\\RUNCODED OUTSTREAM)) (* \; "Charset is a constant 0") (\\BOUT OUTSTREAM (\\CHARSET (CHARCODE EOL))))
 ((EQ (\\CHARSET (CHARCODE EOL)) (|ffetch| (STREAM CHARSET) |of| OUTSTREAM))) (T (\\BOUT OUTSTREAM 
NSCHARSETSHIFT) (\\BOUT OUTSTREAM (|freplace| (STREAM CHARSET) |of| OUTSTREAM |with| (\\CHARSET (
CHARCODE EOL)))))) (\\BOUT OUTSTREAM (SELECTC (|ffetch| EOLCONVENTION |of| OUTSTREAM) (CR.EOLC (
CHARCODE CR)) (LF.EOLC (CHARCODE LF)) (CRLF.EOLC (\\BOUT OUTSTREAM (CHARCODE CR)) (* |;;| 
"Don't put out high-order byte preceding LF.  The CRLF is EOL only if the bytes are immediately adjacent in the stream, with no additional encoding bytes"
) (CHARCODE LF)) (SHOULDNT))) (|freplace| CHARPOSITION |of| OUTSTREAM |with| 0)) (T (COND ((NOT (
\\RUNCODED OUTSTREAM)) (\\BOUT OUTSTREAM (\\CHARSET CHARCODE)) (\\BOUT OUTSTREAM (\\CHAR8CODE CHARCODE
))) ((EQ (\\CHARSET CHARCODE) (|ffetch| (STREAM CHARSET) |of| OUTSTREAM)) (\\BOUT OUTSTREAM (
\\CHAR8CODE CHARCODE))) (T (\\BOUT OUTSTREAM NSCHARSETSHIFT) (\\BOUT OUTSTREAM (|freplace| (STREAM 
CHARSET) |of| OUTSTREAM |with| (\\CHARSET CHARCODE))) (\\BOUT OUTSTREAM (\\CHAR8CODE CHARCODE)))) (
|freplace| CHARPOSITION |of| OUTSTREAM |with| (PROGN (* \; "Ugh.  Don't overflow") (IPLUS16 (|ffetch| 
CHARPOSITION |of| OUTSTREAM) 1)))))))
(PUTPROP (QUOTE APRINT) (QUOTE IMPORTDATE) (IDATE "17-Jan-2020 05:51:20"))

(GLOBALVARS \\BCPLDISPLAY)
(ACCESSFNS LINEBUFFER ((LPARCOUNT (|fetch| FW6 |of| DATUM) (|replace| FW6 |of| DATUM |with| NEWVALUE))
 (LBRKCOUNT (|fetch| FW7 |of| DATUM) (|replace| FW7 |of| DATUM |with| NEWVALUE)) (LINEBUFSTATE (
|fetch| F5 |of| DATUM) (|replace| F5 |of| DATUM |with| NEWVALUE)) (* \; "F4 is free.  EJS, 7/8/85") (
KEYBOARDSTREAM (|fetch| F2 |of| DATUM) (|replace| F2 |of| DATUM |with| NEWVALUE)) (PEEKEDCHAR (|fetch|
 F3 |of| DATUM) (|replace| F3 |of| DATUM |with| NEWVALUE)) (* \; "Character read by PEEKC") (LBFLAGS (
|fetch| FW9 |of| DATUM) (|replace| FW9 |of| DATUM |with| NEWVALUE)) (* |;;| 
"True if peeked char was echoed when peeked.  Could use this to determine whether to echo later or not, but that would be incompatible with Interlisp-10, so this field not used"
)) (ACCESSFNS LINEBUFFER ((LBFLAGBASE (LOCF (|fetch| LBFLAGS |of| DATUM)))) (BLOCKRECORD LBFLAGBASE ((
PEEKEDECHOFLG FLAG) (INSTRINGP FLAG)))))
(RPAQQ LINEBUFFERSTATES (FILLING.LBS READING.LBS RETYPING.LBS))
(RPAQQ FILLING.LBS 0)
(RPAQQ READING.LBS 1)
(RPAQQ RETYPING.LBS 2)
(CONSTANTS FILLING.LBS READING.LBS RETYPING.LBS)
(PUTPROPS \\INTERMP MACRO ((OFD) (EQ OFD \\LINEBUF.OFD)))
(PUTPROPS \\OUTTERMP MACRO ((OFD) (EQ OFD \\TERM.OFD)))
(GLOBALVARS \\DEFAULTLINEBUF)
(PUTPROP (QUOTE ATERM) (QUOTE IMPORTDATE) (IDATE "16-May-1990 12:08:04"))

(DATATYPE HARRAYP ((NULLSLOTS WORD) (* \; "Number of NIL-NIL slots, which break chains") (LASTINDEX 
WORD) (* \; 
"Slot offset of last slot.  Used in probe computations computations.  Microcode support for \\ADDBASE4 would help"
) (HARRAYPBASE POINTER) (RECLAIMABLE FLAG) (* \; "True if keys can go away when no other refs") (
OVERFLOWACTION POINTER) (NUMSLOTS WORD) (* \; 
"The maximum number of logical slots--returned by HARRAYSIZE") (NUMKEYS WORD) (* \; 
"The number of distinct keys in the array") (HASHBITSFN POINTER) (EQUIVFN POINTER) (HASHUSERDATA 
POINTER)))
(PUTPROPS \\EQHASHINGBITS MACRO (OPENLAMBDA (X) (* \; 
"Spread out objects whose low bits are in small arithmetic progression, esp atoms") (LOGXOR (\\HILOC X
) (LOGXOR (LLSH (LOGAND (\\LOLOC X) 8191) 3) (LRSH (\\LOLOC X) 9)))))
(PUTPROPS \\ADDBASE2 MACRO (OPENLAMBDA (BASE N) (\\ADDBASE (\\ADDBASE BASE N) N)))
(PUTPROPS \\ADDBASE4 MACRO (OPENLAMBDA (BASE N) (\\ADDBASE2 (\\ADDBASE2 BASE N) N)))
(PUTPROPS HUNKSIZEFROMNUMBER MACRO ((NTYPX) (FOLDLO (|fetch| DTDSIZE |of| (\\GETDTD NTYPX)) 
WORDSPERCELL)))
(PUTPROPS \\BYTELT DMACRO (OPENLAMBDA (A J) (\\GETBASEBYTE (|fetch| (ARRAYP BASE) |of| A) (IPLUS (
|fetch| (ARRAYP OFFST) |of| A) J))))
(PUTPROPS \\BYTESETA DMACRO (OPENLAMBDA (A J V) (\\PUTBASEBYTE (|fetch| (ARRAYP BASE) |of| A) (IPLUS (
|fetch| (ARRAYP OFFST) |of| A) J) V)))
(PUTPROPS \\WORDELT DMACRO (OPENLAMBDA (A J) (CHECK (AND (ARRAYP A) (EQ 0 (|fetch| (ARRAYP ORIG) |of| 
A)) (EQ \\ST.POS16 (|fetch| (ARRAYP TYP) |of| A)))) (CHECK (IGREATERP (|fetch| (ARRAYP LENGTH) |of| A)
 J)) (\\GETBASE (|fetch| (ARRAYP BASE) |of| A) (IPLUS (|fetch| (ARRAYP OFFST) |of| A) J))))
(RPAQQ BLOCKGCTYPECONSTANTS ((CODEBLOCK.GCT 2) (PTRBLOCK.GCT 1) (UNBOXEDBLOCK.GCT 0)))
(RPAQQ CODEBLOCK.GCT 2)
(RPAQQ PTRBLOCK.GCT 1)
(RPAQQ UNBOXEDBLOCK.GCT 0)
(CONSTANTS (CODEBLOCK.GCT 2) (PTRBLOCK.GCT 1) (UNBOXEDBLOCK.GCT 0))
(RPAQQ ARRAYCONSTANTS (|\\ArrayBlockHeaderCells| |\\ArrayBlockHeaderWords| |\\ArrayBlockTrailerCells| 
|\\ArrayBlockTrailerWords| (|\\ArrayBlockOverheadCells| (IPLUS |\\ArrayBlockHeaderCells| 
|\\ArrayBlockTrailerCells|)) (|\\ArrayBlockOverheadWords| (IPLUS |\\ArrayBlockHeaderWords| 
|\\ArrayBlockTrailerWords|)) |\\ArrayBlockLinkingCells| (|\\MinArrayBlockSize| (IPLUS 
|\\ArrayBlockOverheadCells| |\\ArrayBlockLinkingCells|)) (|\\MaxArrayBlockSize| 65535) (
|\\MaxArrayNCells| (IDIFFERENCE |\\MaxArrayBlockSize| |\\ArrayBlockOverheadCells|)) |\\MaxArrayLen| (
\\ABPASSWORDSHIFT 3) (|\\ArrayBlockPassword| (LRSH 43690 \\ABPASSWORDSHIFT)) (|\\FreeArrayFlagWord| (
LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) (LLSH UNBOXEDBLOCK.GCT 1))) (
|\\UsedArrayFlagWord| (LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) 1)) (
|\\CodeArrayFlagWord| (LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) (LLSH CODEBLOCK.GCT 1) 1)
)))
(RPAQQ |\\ArrayBlockHeaderCells| 1)
(RPAQQ |\\ArrayBlockHeaderWords| 2)
(RPAQQ |\\ArrayBlockTrailerCells| 1)
(RPAQQ |\\ArrayBlockTrailerWords| 2)
(RPAQ |\\ArrayBlockOverheadCells| (IPLUS |\\ArrayBlockHeaderCells| |\\ArrayBlockTrailerCells|))
(RPAQ |\\ArrayBlockOverheadWords| (IPLUS |\\ArrayBlockHeaderWords| |\\ArrayBlockTrailerWords|))
(RPAQQ |\\ArrayBlockLinkingCells| 2)
(RPAQ |\\MinArrayBlockSize| (IPLUS |\\ArrayBlockOverheadCells| |\\ArrayBlockLinkingCells|))
(RPAQQ |\\MaxArrayBlockSize| 65535)
(RPAQ |\\MaxArrayNCells| (IDIFFERENCE |\\MaxArrayBlockSize| |\\ArrayBlockOverheadCells|))
(RPAQQ |\\MaxArrayLen| 65535)
(RPAQQ \\ABPASSWORDSHIFT 3)
(RPAQ |\\ArrayBlockPassword| (LRSH 43690 \\ABPASSWORDSHIFT))
(RPAQ |\\FreeArrayFlagWord| (LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) (LLSH 
UNBOXEDBLOCK.GCT 1)))
(RPAQ |\\UsedArrayFlagWord| (LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) 1))
(RPAQ |\\CodeArrayFlagWord| (LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) (LLSH CODEBLOCK.GCT
 1) 1))
(CONSTANTS |\\ArrayBlockHeaderCells| |\\ArrayBlockHeaderWords| |\\ArrayBlockTrailerCells| 
|\\ArrayBlockTrailerWords| (|\\ArrayBlockOverheadCells| (IPLUS |\\ArrayBlockHeaderCells| 
|\\ArrayBlockTrailerCells|)) (|\\ArrayBlockOverheadWords| (IPLUS |\\ArrayBlockHeaderWords| 
|\\ArrayBlockTrailerWords|)) |\\ArrayBlockLinkingCells| (|\\MinArrayBlockSize| (IPLUS 
|\\ArrayBlockOverheadCells| |\\ArrayBlockLinkingCells|)) (|\\MaxArrayBlockSize| 65535) (
|\\MaxArrayNCells| (IDIFFERENCE |\\MaxArrayBlockSize| |\\ArrayBlockOverheadCells|)) |\\MaxArrayLen| (
\\ABPASSWORDSHIFT 3) (|\\ArrayBlockPassword| (LRSH 43690 \\ABPASSWORDSHIFT)) (|\\FreeArrayFlagWord| (
LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) (LLSH UNBOXEDBLOCK.GCT 1))) (
|\\UsedArrayFlagWord| (LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) 1)) (
|\\CodeArrayFlagWord| (LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) (LLSH CODEBLOCK.GCT 1) 1)
))
(RPAQQ ARRAYTYPES ((\\ST.BYTE 0) (\\ST.POS16 1) (\\ST.INT32 2) (\\ST.CODE 4) (\\ST.PTR 6) (\\ST.FLOAT 
7) (\\ST.BIT 8) (\\ST.PTR2 11)))
(RPAQQ \\ST.BYTE 0)
(RPAQQ \\ST.POS16 1)
(RPAQQ \\ST.INT32 2)
(RPAQQ \\ST.CODE 4)
(RPAQQ \\ST.PTR 6)
(RPAQQ \\ST.FLOAT 7)
(RPAQQ \\ST.BIT 8)
(RPAQQ \\ST.PTR2 11)
(CONSTANTS (\\ST.BYTE 0) (\\ST.POS16 1) (\\ST.INT32 2) (\\ST.CODE 4) (\\ST.PTR 6) (\\ST.FLOAT 7) (
\\ST.BIT 8) (\\ST.PTR2 11))
(RPAQQ \\MAX.CELLSPERHUNK 64)
(CONSTANTS \\MAX.CELLSPERHUNK)
(RPAQQ \\IN.MAKEINIT NIL)
(CONSTANTS (\\IN.MAKEINIT))
(BLOCKRECORD SEQUENCEDESCRIPTOR ((ORIG BITS 1) (NIL BITS 1) (READONLY FLAG) (NIL BITS 1) (BASE POINTER
) (TYP BITS 4) (NIL BITS 4) (LENGTH BITS 24) (OFFST FIXP)))
(DATATYPE ARRAYP ((* |;;| "Describes an INTERLISP ARRAYP, as opposed to a CL array.") (ORIG BITS 1) (*
 \; "Origin, 0 or 1") (NIL BITS 1) (READONLY FLAG) (* \; "probably no READONLY arrays now") (NIL BITS 
1) (BASE POINTER) (TYP BITS 4) (* \; "Type of the contents") (NIL BITS 4) (LENGTH BITS 24) (* \; 
"Array's length") (OFFST FIXP) (* \; "Offset from BASE where the data really starts.")) (* |;;| 
"note that while ARRAYP is a DATATYPE, the allocation of it actually happens at MAKEINIT time under INITDATATYPE{NAMES}"
))
(BLOCKRECORD ARRAYBLOCK ((PASSWORD BITS 13) (GCTYPE BITS 2) (* \; "Unboxed, Pointers, or Code") (INUSE
 FLAG) (ARLEN WORD) (FWD FULLXPOINTER) (* \; "Only when on free list") (BKWD FULLXPOINTER)) (
BLOCKRECORD ARRAYBLOCK ((ABFLAGS WORD) (* \; "Used for header and trailer"))) (ACCESSFNS ARRAYBLOCK ((
DAT (\\ADDBASE DATUM |\\ArrayBlockHeaderWords|)) (TRAILER (\\ADDBASE2 DATUM (IDIFFERENCE (|fetch| (
ARRAYBLOCK ARLEN) |of| DATUM) |\\ArrayBlockTrailerCells|))))) (TYPE? (AND (EQ 0 (NTYPX DATUM)) (IGEQ (
\\HILOC DATUM) |\\FirstArraySegment|))))
(GLOBALVARS |\\NxtArrayPage| \\FREEBLOCKBUCKETS \\HUNKING?)
(PUTPROPS HUNKSIZEFROMNUMBER MACRO ((NTYPX) (FOLDLO (|fetch| DTDSIZE |of| (\\GETDTD NTYPX)) 
WORDSPERCELL)))
(PUTPROP (QUOTE LLARRAYELT) (QUOTE IMPORTDATE) (IDATE "15-Sep-1994 11:08:59"))

(DEFOPTIMIZER PUTBASEPTRX (&REST ARGS) (CONS (QUOTE (OPENLAMBDA (DATUM OFFSET NEWVALUE) (
UNINTERRUPTABLY (\\PUTBASE DATUM OFFSET (LOGOR (LOGAND 61440 (\\GETBASE DATUM OFFSET)) (LOGAND (
\\HILOC NEWVALUE) 4095))) (\\PUTBASE DATUM (ADD1 OFFSET) (\\LOLOC NEWVALUE)) NEWVALUE))) ARGS))
(RPAQQ \\SMALLP 1)
(RPAQQ \\FIXP 2)
(RPAQQ \\FLOATP 3)
(RPAQQ \\LITATOM 4)
(RPAQQ \\LISTP 5)
(RPAQQ \\ARRAYP 6)
(RPAQQ \\STACKP 8)
(RPAQQ \\VMEMPAGEP 10)
(RPAQQ \\STREAM 11)
(RPAQQ \\NEW-ATOM 21)
(CONSTANTS \\SMALLP \\FIXP \\FLOATP \\LITATOM \\LISTP \\ARRAYP \\STACKP \\VMEMPAGEP \\STREAM 
\\NEW-ATOM)
(RPAQQ \\BUILT-IN-SYSTEM-TYPES ((SMALLP) (FIXP 2) (FLOATP 2) (LITATOM) (LISTP 4 (0 2)) (ARRAYP 6 (0)) 
(STRINGP 6 (0)) (STACKP 2 NIL \\RECLAIMSTACKP) (CHARACTER) (VMEMPAGEP 256 NIL RELEASINGVMEMPAGE) (
STREAM) (BITMAP) (COMPILED-CLOSURE 4 (0 2)) (ONED-ARRAY 8 (0)) (TWOD-ARRAY 10 (0)) (GENERAL-ARRAY 10 (
0 8)) (BIGNUM) (RATIO) (COMPLEX) (PATHNAME) (NEW-ATOM 10 (2 4 6)) (FILLER22) (FILLER23) (FILLER24) (
FILLER25) (FILLER26) (FILLER27) (FILLER28) (FILLER29) (FILLER30)))
(BLOCKRECORD DTD ((NIL BITS 2) (DTDOBSOLETE FLAG) (* \; 
"True for type of a redeclared datatype--not allowed to allocate more of these") (DTDFINALIZABLE FLAG)
 (* \; "True if finalization exists for this type") (DTDNAME POINTER) (* \; "Type name -- a symbol ") 
(DTDCNT0 WORD) (* \; "Incremental box count -- this plus DTDOLDCNT is the true box count") (DTDSIZE 
WORD) (* \; "Length of datum in words") (DTDFREE FULLXPOINTER) (* \; 
"Pointer to first object on free chain, or NIL.  Not used for LISTP") (DTDLOCKEDP FLAG) (* \; 
"True if objects of this type must be locked down (not pagefault)") (DTDHUNKP FLAG) (* \; 
"True if this type is used as an array hunk type") (DTDGCTYPE BITS 2) (* \; 
"For hunk datatypes, is analogous to arrayblock's GCTYPE") (DTDDESCRS POINTER) (DTDTYPESPECS POINTER) 
(DTDPTRS POINTER) (* \; 
"List of word offsets inside datum where reference-counted pointers are stored -- used by GC") (
DTDOLDCNT FIXP) (* \; "'Box count' -- number of objects of this type ever allocated") (DTDNEXTPAGE 
FIXP) (* \; 
"Currently only for LISTP pages -- page number of next page on chain of non-full cons pages") (
DTDTYPEENTRY WORD) (* |;;| 
"The word stored in the type table for objects of this type.  Hi bits have numberp tags, ref countable, etc."
) (DTDSUPERTYPE WORD) (* \; "Type number of immediate supertype, or zero if none")) (ACCESSFNS DTD ((
DTDCNTLOC (\\ADDBASE DATUM 4)) (DTDCNT (IPLUS (|fetch| DTDOLDCNT DATUM) (|fetch| DTDCNT0 DATUM)) (
UNINTERRUPTABLY (|replace| DTDOLDCNT |of| DATUM |with| NEWVALUE) (|replace| DTDCNT0 |of| DATUM |with| 
0))))))
(PUTPROPS \\GETDTD MACRO ((|typeNum|) (ADDBASE |\\DTDSpaceBase| (ITIMES |typeNum| 18))))
(DEFOPTIMIZER \\TYPEMASK.UFN (&REST X) (LET ((CE (CONSTANTEXPRESSIONP (CADR X)))) (|if| CE |then| (
BQUOTE ((OPCODES TYPEMASK.N (\\\, (CAR CE))) (\\\, (CAR X)))) |else| (QUOTE IGNOREMACRO))))
(RPAQQ \\GUARDSTORAGEFULL 128)
(RPAQQ \\GUARD1STORAGEFULL 64)
(CONSTANTS \\GUARDSTORAGEFULL \\GUARD1STORAGEFULL)
(GLOBALVARS |\\NxtMDSPage| |\\LeastMDSPage| |\\SecondArrayPage| |\\SecondMDSPage| \\MDSFREELISTPAGE 
|\\MaxSysTypeNum| |\\MaxTypeNumber| \\STORAGEFULL \\INTERRUPTSTATE \\PENDINGINTERRUPT)
(PUTPROP (QUOTE LLDATATYPE) (QUOTE IMPORTDATE) (IDATE "28-Jun-1999 16:57:50"))

(ACCESSFNS POINTER ((PAGE# (IPLUS (LLSH (\\HILOC DATUM) 8) (LRSH (\\LOLOC DATUM) 8))) (WORDINPAGE (
LOGAND (\\LOLOC DATUM) 255)) (CELLINPAGE (LRSH (|fetch| WORDINPAGE |of| DATUM) 1)) (BYTEINPAGE (LLSH (
|fetch| WORDINPAGE |of| DATUM) 1)) (SEGMENT# (\\HILOC DATUM)) (WORDINSEGMENT (\\LOLOC DATUM)) (
CELLINSEGMENT (LRSH (|fetch| WORDINSEGMENT |of| DATUM) 1)) (WORD# (|fetch| WORDINPAGE |of| DATUM)) (
DBLWORD# (|fetch| CELLINPAGE |of| DATUM)) (PAGEBASE (\\VAG2 (\\HILOC DATUM) (LOGAND (\\LOLOC DATUM) 
65280)))) (CREATE (\\VAG2 (LRSH PAGE# 8) (LLSH (LOGAND PAGE# 255) 8))))
(ACCESSFNS WORD ((HIBYTE (LRSH DATUM 8)) (LOBYTE (LOGAND DATUM 255))) (CREATE (IPLUS (LLSH HIBYTE 8) 
LOBYTE)))
(PUTPROPS PTRGTP MACRO (OPENLAMBDA (X Y) (OR (IGREATERP (\\HILOC X) (\\HILOC Y)) (AND (EQ (\\HILOC X) 
(\\HILOC Y)) (IGREATERP (\\LOLOC X) (\\LOLOC Y))))))
(PUTPROPS .COERCE.TO.SMALLPOSP. DMACRO (OPENLAMBDA (X) (COND ((SMALLPOSP X) X) (T (\\ILLEGAL.ARG X))))
)
(PUTPROPS .COERCE.TO.BYTE. DMACRO (OPENLAMBDA (X) (COND ((AND (SMALLPOSP X) (ILESSP X (CONSTANT (LLSH 
1 BITSPERBYTE)))) X) (T (\\ILLEGAL.ARG X)))))
(BLOCKRECORD LISTP ((* |;;| "Describes a CONS cell.") (CAR POINTER) (CDR POINTER)) (CREATE (CREATECELL
 \\LISTP)) (* |;;| "FOLLOWING ARE CDR-CODE FIELDS") (BLOCKRECORD LISTP ((CDRCODE BITS 4) (CARFIELD 
XPOINTER))) (* |;;| "For chaining together free cells on a page:") (BLOCKRECORD LISTP ((NEXTFREE BYTE)
 (NIL BITS 24))) (ACCESSFNS LISTP ((FULLCARFIELD NIL (\\PUTBASEPTR DATUM 0 NEWVALUE)))) (* |;;| 
"because replace of XPOINTER is slow, the CAR field is stored with PUTBASEPTR, even though that smashes the hi byte"
))
(BLOCKRECORD CONSPAGE ((* |;;| 
"Describes a page of CONS cells, which (when free) are chained together thru the top byte.") (NIL 2 
FIXP) (* \; "Empty cells, space for another 2 CONS cells if we can figure out how.") (CNT BYTE) (* \; 
"# of cells free on this page") (NEXTCELL BYTE) (* \; 
"WORD offset of next free cell (not guaranteed to be 0 if no free cells)") (NIL WORD) (* \; "Padding")
 (NEXTPAGE FIXP) (* \; "Next CONS page on the DTD's free list, for searching for cells.")))
(RPAQQ CONSCONSTANTS (\\CDR.ONPAGE \\CDR.NIL \\CDR.INDIRECT \\CDR.MAXINDIRECT \\CONSPAGE.LAST))
(RPAQQ \\CDR.ONPAGE 8)
(RPAQQ \\CDR.NIL 8)
(RPAQQ \\CDR.INDIRECT 0)
(RPAQQ \\CDR.MAXINDIRECT 7)
(RPAQQ \\CONSPAGE.LAST 65535)
(CONSTANTS \\CDR.ONPAGE \\CDR.NIL \\CDR.INDIRECT \\CDR.MAXINDIRECT \\CONSPAGE.LAST)
(PUTPROPS LOCAL MACRO ((X) X))
(PUTPROPS ALLOCAL MACRO ((X) X))
(PUTPROP (QUOTE LLNEW) (QUOTE IMPORTDATE) (IDATE " 2-Feb-1995 16:21:44"))

(PUTPROPS CHECK MACRO (ARGS (COND ((AND (BOUNDP (QUOTE CHECK)) CHECK) (CONS (QUOTE PROGN) (|for| I 
|in| ARGS |collect| (LIST (QUOTE OR) I (LIST (QUOTE RAID) (KWOTE (LIST (QUOTE |Check-failure:|) I)))))
)) (T (CONS COMMENTFLG ARGS)))))
(PUTPROPS |\\StatsZero| BYTEMACRO (OPENLAMBDA (N) (\\PUTBASE N 0 0) (\\PUTBASE N 1 0)))
(PUTPROPS |\\StatsAdd1| DMACRO (OPENLAMBDA (A) (PROG ((LO (IPLUS16 (\\GETBASE A 1) 1))) (DECLARE (
LOCALVARS LO)) (* \; "Increment double word at A by 1") (\\PUTBASE A 1 LO) (COND ((EQ LO 0) (\\PUTBASE
 A 0 (ADD1 (\\GETBASE A 0))))))))
(PUTPROPS IPLUS16 MACRO ((X Y) (* \; "Kludge to do 16-bit plus") (\\LOLOC (\\ADDBASE X Y))))
(PUTPROPS SMALLPOSP MACRO (OPENLAMBDA (X) (AND (SMALLP X) (IGEQ X 0))))
(PROGN (PUTPROPS SETXVAR MACRO (X (BQUOTE (SETQ.NOREF \, (CADAR X) \, (CADR X))))) (PUTPROPS SETXVAR 
DMACRO (X (OR (AND (EQ (CAAR X) (QUOTE QUOTE)) (LITATOM (CADAR X))) (SHOULDNT)) (GLOBALVARS \\VALSPACE
) (LIST (QUOTE SETQ.NOREF) (CADAR X) (CADR X)))))
(PUTPROPS SETQ.NOREF DMACRO ((VAR VAL) (\\PUTBASEPTR (LOCF (|fetch| (LITATOM VALUE) |of| (QUOTE VAR)))
 0 VAL)))
(PROGN (PUTPROPS IEQ MACRO ((X Y) (IEQP X Y))) (PUTPROPS IEQ DMACRO (= . EQ)))
(RPAQQ |WordsPerPage| 256)
(CONSTANTS |WordsPerPage|)
(ACCESSFNS LITATOM ((DEFINITIONCELL (\\DEFCELL DATUM)) (PROPCELL (\\PROPCELL DATUM)) (VCELL (\\VALCELL
 DATUM)) (PNAMECELL (\\PNAMECELL DATUM))) (* |;;| 
"VCELL can also be accessed directly from a value index via the record VALINDEX (as in \\SETGLOBALVAL.UFN) --- Similarly, PNAMEINDEX accesses PNAMECELL for use by \\MKATOM and UNCOPYATOM"
) (TYPE? (LITATOM DATUM)) (BLOCKRECORD PROPCELL ((NIL BITS 4) (* \; "former flags locations") (
PROPLIST POINTER) (NIL BITS 8) (* \; "Package byte") (NIL BITS 8) (* \; "Flags from defcell") (* |;;| 
"PROPCell flags:") (NIL BITS 1) (GENSYMP FLAG) (FATPNAMEP FLAG) (NIL BITS 5) (* |;;| 
"Filler for final cell:") (NIL BITS 8))))
(SYNONYM CL:SYMBOL (LITATOM))
(ACCESSFNS VALINDEX ((VCELL (COND ((AND (FIXP DATUM) (ILESSP DATUM 65535)) (* \; 
"Xerox Lisp traditional symbol") (\\ADDBASE2 \\PNPSPACE (IPLUS \\NEWATOM-VALOFFSET (ITIMES 10 DATUM)))
) (T (* \; "New symbol") (* \; "'90/07/19 ON") (\\ADDBASE DATUM \\NEWATOM-VALOFFSET))))))
(BLOCKRECORD VCELL ((VALUE FULLPOINTER)))
(BLOCKRECORD DEFINITIONCELL ((CCODEP FLAG) (FASTP FLAG) (ARGTYPE BITS 2) (* \; "Former flag location")
 (DEFPOINTER POINTER) (NIL POINTER) (* \; "Proplist cell") (NIL BITS 8) (* \; "package") (* |;;| 
"DEFCELL flags overflow from top 4 bits of the real cell:") (NIL BITS 4) (PSEUDOCODEP FLAG) (NIL BITS 
3) (* |;;| "proplist falgs and filler:") (NIL BITS 16)) (BLOCKRECORD DEFINITIONCELL ((DEFCELLFLAGS 
BITS 4) (NIL POINTER) (* \; "defn ptr") (NIL BITS 4) (NIL POINTER) (* \; "filler for proplist ptr") (
NIL BITS 8) (AUXDEFCELLFLAGS BYTE) (NIL BITS 16))))
(BLOCKRECORD FNHEADER ((STKMIN WORD) (NA SIGNEDWORD) (PV SIGNEDWORD) (STARTPC WORD) (CLOSUREP FLAG) (*
 \; "T if this is a \"compiled closure\"") (BYTESWAPPED FLAG) (* \; 
"T if, on 386, we reswapped the code section of this function for faster access.") (ARGTYPE BITS 2) (*
 \; "0 = LAMBDA") (* \; "2 = LAMBDA nospread") (* \; "1 = NLAMBDA") (* \; "3 = NLAMBDA nospread") (* 
|;;| "4 NIL BITS USED TO BE HERE.") (\#FRAMENAME XPOINTER) (NTSIZE WORD) (* \; 
"Size of the Name Table, IN WORDS.  This value is always rounded up to the next Quad-word in size, and there' guaranteed to be one entry of zeros in the length."
) (NLOCALS BYTE) (FVAROFFSET BYTE)) (ACCESSFNS FNHEADER ((LSTARP (ILESSP (|fetch| (FNHEADER NA) |of| 
DATUM) 0)) (OVERHEADWORDS (PROGN 8)) (NATIVE (PROGN NIL)) (* \; 
"T if this is a NATIVE-code function (never true!)") (ALIGNED (IPLUS (|fetch| (FNHEADER NTSIZE) |of| 
DATUM) (|fetch| (FNHEADER OVERHEADWORDS) |of| T))) (FIXED NIL (|replace| (FNHEADER STKMIN) |of| DATUM 
|with| (\\STKMIN DATUM T))) (NPVARWORDS (UNFOLD (ADD1 (|fetch| (FNHEADER PV) |of| DATUM)) WORDSPERQUAD
)) (FRAMENAME (|fetch| (FNHEADER \#FRAMENAME) |of| DATUM) (UNINTERRUPTABLY (CHECK (NEQ (\\HILOC DATUM)
 \\STACKHI)) (\\DELREF (|fetch| (FNHEADER \#FRAMENAME) |of| DATUM)) (\\ADDREF NEWVALUE) (|replace| (
FNHEADER \#FRAMENAME) |of| DATUM |with| NEWVALUE))))))
(BLOCKRECORD PNAMECELL ((NIL BITS 4) (PNAMEBASE XPOINTER) (NIL POINTER) (* \; "val, def, prop cells") 
(NIL POINTER) (NIL POINTER) (PACKAGEINDEX BYTE) (NIL BITS 24) (* \; "filler for other flags")) (
BLOCKRECORD PNAMECELL ((FULLPNAMEBASE FULLXPOINTER) (* \; "Replacing this smashes PACKAGEINDEX to 0"))
) (ACCESSFNS PNAMECELL ((PACKAGE (LET ((I (FETCH (PNAMECELL PACKAGEINDEX) OF DATUM))) (* \; 
"This ugly construct allows cl:symbol-package to run in the init, where *PACKAGE-FROM-INDEX* is not yet bound."
) (COND ((EQ 0 I) NIL) (T (CL:AREF *PACKAGE-FROM-INDEX* I)))) (REPLACE (PNAMECELL PACKAGEINDEX) OF 
DATUM WITH (IF (NULL NEWVALUE) THEN *UNINTERNED-PACKAGE-INDEX* ELSE (CL::%PACKAGE-INDEX NEWVALUE))))))
)
(ACCESSFNS PACKAGEINDEX ((PACKAGE (IF (EQ 0 DATUM) (* \; 
"This ugly construct allows cl:symbol-package to run in the init, where *PACKAGE-FROM-INDEX* is not yet bound."
) THEN NIL ELSE (CL:AREF *PACKAGE-FROM-INDEX* DATUM)))))
(BLOCKRECORD PNAMEBASE ((PNAMELENGTH BYTE) (* \; "Length is always here, be the pname thin or fat") (
PNAMEFATPADDINGBYTE BYTE) (* \; 
"This byte is zero for fat pnames so that the pname chars are word-aligned")))
(ACCESSFNS PNAMEINDEX ((PNAMECELL (COND ((AND (FIXP DATUM) (ILESSP DATUM 65535)) (* \; 
"Xerox Lisp traditional symbol") (\\ADDBASE \\OLDATOMSPACE (IPLUS \\NEWATOM-PNAMEOFFSET (ITIMES 10 
DATUM)))) (T (* \; "New symbol") (* \; "'90/07/19 ON") (\\ADDBASE DATUM \\NEWATOM-PNAMEOFFSET))))))
(BLOCKRECORD NEW-ATOM ((* |;;| 
"An extended symbol, for expanding atom space.  Kept in its own datatype.") (PNAME XPOINTER) (* \; 
"PNAME, same as litatom.") (VALUE POINTER) (DEF POINTER) (PROPLIST POINTER) (* |;;| 
"Flags that used to be above the pointers, e.g. package, ccodep, gensymp:") (NIL BITS 32)))
(PUTPROPS \\DEFCELL MACRO ((ATOM) (\\ATOMCELL ATOM \\DEF.HI)))
(PUTPROPS \\VALCELL MACRO ((ATOM) (\\ATOMCELL ATOM \\VAL.HI)))
(PUTPROPS \\PNAMECELL MACRO ((ATOM) (\\ATOMCELL ATOM \\PNAME.HI)))
(PUTPROPS \\ATOMVALINDEX DMACRO (OPENLAMBDA (X) (COND ((EQ (NTYPX X) \\LITATOM) (* \; 
"Original litatoms") (\\LOLOC X)) ((EQ (NTYPX X) \\NEW-ATOM) (* \; "new 3-byte symbols") X) (T (
SHOULDNT)))))
(PUTPROPS \\ATOMDEFINDEX DMACRO (OPENLAMBDA (X) (COND ((EQ (NTYPX X) \\LITATOM) (* \; 
"Original litatoms") (\\LOLOC X)) ((EQ (NTYPX X) \\NEW-ATOM) (* \; "new 3-byte symbols") X) (T (
SHOULDNT)))))
(PUTPROPS \\ATOMPNAMEINDEX DMACRO (OPENLAMBDA (X) (COND ((EQ (NTYPX X) \\LITATOM) (* \; 
"Original litatoms") (\\LOLOC X)) ((EQ (NTYPX X) \\NEW-ATOM) (* \; "new 3-byte symbols") X) (T (
SHOULDNT)))))
(PUTPROPS \\ATOMPROPINDEX DMACRO ((X) (COND ((EQ (NTYPX X) \\LITATOM) (* \; "Original litatoms") (
\\LOLOC X)) ((EQ (NTYPX X) \\NEW-ATOM) (* \; "new 3-byte symbols") X) (T (SHOULDNT)))))
(PUTPROPS \\INDEXATOMPNAME DMACRO (OPENLAMBDA (X) (COND ((FIXP X) (* \; 
"Xerox Lisp traditional symbol") (COND ((SMALLP X) (\\VAG2 |\\AtomHI| X)) (T (\\VAG2 (LRSH X 16) (
LOGAND X 65535))))) (T (* \; "New symbol") X))))
(PUTPROPS \\INDEXATOMVAL DMACRO (OPENLAMBDA (X) (COND ((FIXP X) (* \; "Xerox Lisp traditional symbol")
 (COND ((SMALLP X) (\\VAG2 |\\AtomHI| X)) (T (\\VAG2 (LRSH X 16) (LOGAND X 65535))))) (T (* \; 
"New symbol") X))))
(PUTPROPS \\INDEXATOMDEF DMACRO (OPENLAMBDA (X) (COND ((FIXP X) (* \; "Xerox Lisp traditional symbol")
 (COND ((SMALLP X) (\\VAG2 |\\AtomHI| X)) (T (\\VAG2 (LRSH X 16) (LOGAND X 65535))))) (T (* \; 
"New symbol") X))))
(PUTPROPS \\ATOMNUMBER DMACRO (= . \\LOLOC))
(GLOBALVARS |\\NxtPnByte| |\\CurPnPage| |\\NxtAtomPage| |\\AtomFrLst| |\\OneCharAtomBase| 
\\PNAMES.IN.BLOCKS? \\SCRATCHSTRING COMPILEATPUTDFLG)
(RPAQQ \\PNAMELIMIT 255)
(RPAQQ |\\CharsPerPnPage| 512)
(CONSTANTS (\\PNAMELIMIT 255) (|\\CharsPerPnPage| 512))
(RPAQQ \\NEWATOM-PNAMEOFFSET 0)
(RPAQQ \\NEWATOM-VALOFFSET 2)
(RPAQQ \\NEWATOM-DEFOFFSET 4)
(RPAQQ \\NEWATOM-PLISTOFFSET 6)
(RPAQQ \\NEWATOM-TYPE# 21)
(CONSTANTS (\\NEWATOM-PNAMEOFFSET 0) (\\NEWATOM-VALOFFSET 2) (\\NEWATOM-DEFOFFSET 4) (
\\NEWATOM-PLISTOFFSET 6) (\\NEWATOM-TYPE# 21))
(PUTPROPS \\MOVEWORDS MACRO (OPENLAMBDA (SBASE SOFFSET DBASE DOFFSET NWORDS) (\\BLT (\\ADDBASE DBASE 
DOFFSET) (\\ADDBASE SBASE SOFFSET) NWORDS)))
(PUTPROP (QUOTE LLBASIC) (QUOTE IMPORTDATE) (IDATE "31-Jan-1998 09:55:50"))

(ACCESSFNS STRINGP ((XREADONLY (|fetch| (ARRAY-HEADER READ-ONLY-P) |of| DATUM) (|replace| (
ARRAY-HEADER READ-ONLY-P) |of| DATUM |with| NEWVALUE)) (XBASE ((OPENLAMBDA (STRING) (COND ((|fetch| (
ARRAY-HEADER INDIRECT-P) |of| STRING) (%ARRAY-BASE STRING)) (T (|fetch| (ARRAY-HEADER BASE) |of| 
STRING)))) DATUM) ((OPENLAMBDA (STRING NV) (|replace| (ARRAY-HEADER INDIRECT-P) |of| STRING |with| NIL
) (|replace| (ARRAY-HEADER BASE) |of| STRING |with| NV) NV) DATUM NEWVALUE)) (TYP ((OPENLAMBDA (STRING
) (SELECTC (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) (%ARRAY-TYPE-NUMBER STRING)) (T (
|fetch| (ARRAY-HEADER TYPE-NUMBER) |of| STRING))) (%THIN-CHAR-TYPENUMBER \\ST.BYTE) (
%FAT-CHAR-TYPENUMBER \\ST.POS16) (SHOULDNT "Unknown type-number"))) DATUM) ((OPENLAMBDA (STRING NV) (
LET ((%NEW-TYPE-NUMBER (SELECTC NV (\\ST.BYTE %THIN-CHAR-TYPENUMBER) (\\ST.POS16 %FAT-CHAR-TYPENUMBER)
 (SHOULDNT "Unknown typ value")))) (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) (
%SET-ARRAY-TYPE-NUMBER STRING %NEW-TYPE-NUMBER)) (T (|replace| (ARRAY-HEADER TYPE-NUMBER) |of| STRING 
|with| %NEW-TYPE-NUMBER))))) DATUM NEWVALUE)) (LENGTH (|fetch| (ARRAY-HEADER FILL-POINTER) |of| DATUM)
 ((OPENLAMBDA (STRING NV) (|replace| (ARRAY-HEADER FILL-POINTER) |of| STRING |with| NV) (|replace| (
ARRAY-HEADER TOTAL-SIZE) |of| STRING |with| NV) (COND ((%GENERAL-ARRAY-P STRING) (|freplace| (
GENERAL-ARRAY DIMS) |of| STRING |with| (LIST NV)))) NV) DATUM NEWVALUE)) (OFFST ((OPENLAMBDA (STRING) 
(COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) (%ARRAY-OFFSET STRING)) (T (|fetch| (
ARRAY-HEADER OFFSET) |of| STRING)))) DATUM) ((OPENLAMBDA (STRING NV) (COND ((NOT (EQ 0 NV)) (|replace|
 (ARRAY-HEADER DISPLACED-P) |of| STRING |with| T))) (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| 
STRING) (%SET-ARRAY-OFFSET STRING NV)) (T (|replace| (ARRAY-HEADER OFFSET) |of| STRING |with| NV)))) 
DATUM NEWVALUE)) (* |;;| "The rest of these fields only appear when smashing") (XFLAGS (LOGAND (
|fetch| (ARRAY-HEADER FLAGS) |of| DATUM) 15) ((OPENLAMBDA (STRING) (|replace| (ARRAY-HEADER 
ADJUSTABLE-P) |of| STRING |with| NIL) (|replace| (ARRAY-HEADER DISPLACED-P) |of| STRING |with| NIL) (
|replace| (ARRAY-HEADER FILL-POINTER-P) |of| STRING |with| NIL) (|replace| (ARRAY-HEADER EXTENDABLE-P)
 |of| STRING |with| NIL)) DATUM))) (ACCESSFNS STRINGP ((ORIG ((OPENLAMBDA (STRING) 1) DATUM) ((
OPENLAMBDA (STRING NV) (COND ((NOT (EQ NV 1)) (ERROR "Il:stringp's are always origin 1"))) NV) DATUM 
NEWVALUE)) (* \; "An inoperative field") (SUBSTRINGED ((OPENLAMBDA (STRING) NIL) DATUM) ((OPENLAMBDA (
STRING NV) (OR (NULL NV) (ERROR "Substringed field not supported"))) DATUM NEWVALUE)) (READONLY (
|ffetch| (STRINGP XREADONLY) |of| DATUM) (|freplace| (STRINGP XREADONLY) |of| DATUM |with| NEWVALUE)) 
(FATSTRINGP ((OPENLAMBDA (STRING) (EQ (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) (
%ARRAY-TYPE-NUMBER STRING)) (T (|fetch| (ARRAY-HEADER TYPE-NUMBER) |of| STRING))) %FAT-CHAR-TYPENUMBER
)) DATUM) ((OPENLAMBDA (STRING NV) (LET ((%NEW-TYPE-NUMBER (COND (NV %FAT-CHAR-TYPENUMBER) (T 
%THIN-CHAR-TYPENUMBER)))) (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) (
%SET-ARRAY-TYPE-NUMBER STRING %NEW-TYPE-NUMBER)) (T (|replace| (ARRAY-HEADER TYPE-NUMBER) |of| STRING 
|with| %NEW-TYPE-NUMBER))))) DATUM NEWVALUE)) (BASE (|ffetch| (STRINGP XBASE) |of| DATUM) (|freplace| 
(STRINGP XBASE) |of| DATUM |with| NEWVALUE)))) (CREATE (|create| ONED-ARRAY BASE _ XBASE READ-ONLY-P _
 XREADONLY STRING-P _ T DISPLACED-P _ (NOT (EQ OFFST 0)) TYPE-NUMBER _ (COND ((EQ TYP \\ST.POS16) 
%FAT-CHAR-TYPENUMBER) (T %THIN-CHAR-TYPENUMBER)) OFFSET _ OFFST FILL-POINTER _ LENGTH TOTAL-SIZE _ 
LENGTH)) (TYPE? (CL:STRINGP DATUM)) OFFST _ 0 TYP _ \\ST.BYTE LENGTH _ 0)
(GLOBALVARS |\\OneCharAtomBase|)
(PUTDEF (QUOTE \\NUMSTR) (QUOTE RESOURCES) (QUOTE (NEW (ALLOCSTRING 128))))
(PUTDEF (QUOTE \\NUMSTR1) (QUOTE RESOURCES) (QUOTE (NEW (CONCAT))))
(PUTDEF (QUOTE \\PNAMESTRING) (QUOTE RESOURCES) (QUOTE (NEW (ALLOCSTRING \\PNAMELIMIT NIL NIL 
\\FATPNAMESTRINGP))))
(RPAQQ \\FATPNAMESTRINGP T)
(CONSTANTS (\\FATPNAMESTRINGP T))
(PUTPROPS \\PNAMESTRINGPUTCHAR MACRO ((BASE OFFSET CODE) (* \; 
"For stuffing chars into resource \\PNAMESTRING") (\\PUTBASECHAR \\FATPNAMESTRINGP BASE OFFSET CODE)))
(DEFOPTIMIZER FCHARACTER (NUM) (BQUOTE ((OPENLAMBDA (N) (COND ((IGREATERP N \\MAXTHINCHAR) (* \; 
"The character we're getting is NOT a thin character -- do it the hard way") (CHARACTER N)) ((
IGREATERP N (CHARCODE 9)) (\\ADDBASE |\\OneCharAtomBase| (IDIFFERENCE N 10))) ((IGEQ N (CHARCODE 0)) (
IDIFFERENCE N (CHARCODE 0))) (T (* \; "The common case -- just add on the one-atom base.") (\\ADDBASE 
|\\OneCharAtomBase| N)))) (\\\, NUM))))
(I.S.OPR (QUOTE |inpname|) NIL (QUOTE (SUBPAIR (QUOTE ($$END $$BODY $$FATP $$BASE $$OFFSET)) (LIST (
GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (BQUOTE (|bind| $$OFFSET _ 0 
$$BODY _ BODY $$BASE $$END $$FATP |declare| (LOCALVARS $$END $$BODY $$FATP $$BASE $$OFFSET) |first| (
PROG NIL $$RETRY (COND ((STRINGP $$BODY) (SETQ $$BASE (|ffetch| (STRINGP BASE) |of| $$BODY)) (SETQ 
$$OFFSET (SUB1 (|ffetch| (STRINGP OFFST) |of| $$BODY))) (SETQ $$END (IPLUS $$OFFSET (|ffetch| (STRINGP
 LENGTH) |of| $$BODY))) (SETQ $$FATP (|ffetch| (STRINGP FATSTRINGP) |of| $$BODY))) ((LITATOM $$BODY) (
SETQ $$BASE (|ffetch| (LITATOM PNAMEBASE) |of| $$BODY)) (SETQ $$END (|ffetch| (PNAMEBASE PNAMELENGTH) 
|of| $$BASE)) (SETQ $$FATP (|ffetch| (LITATOM FATPNAMEP) |of| $$BODY))) (T (SETQ $$BODY (MKSTRING 
$$BODY)) (GO $$RETRY)))) |eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (
GO $$OUT)) (SETQ I.V. (COND ($$FATP (\\GETBASEFAT $$BASE $$OFFSET)) (T (\\GETBASETHIN $$BASE $$OFFSET)
))))))) T)
(I.S.OPR (QUOTE |inatom|) NIL (QUOTE (SUBPAIR (QUOTE ($$OFFSET $$BODY $$BASE $$END $$FATP)) (LIST (
GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$OFFSET _ 0 
$$BODY _ BODY $$BASE $$END $$FATP |declare| (LOCALVARS $$OFFSET $$BODY $$BASE $$END $$FATP) |first| (
SETQ $$BASE (|ffetch| (LITATOM PNAMEBASE) |of| $$BODY)) (SETQ $$END (|ffetch| (PNAMEBASE PNAMELENGTH) 
|of| $$BASE)) (SETQ $$FATP (|ffetch| (LITATOM FATPNAMEP) |of| $$BODY)) |eachtime| (SETQ $$OFFSET (ADD1
 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (COND ($$FATP (\\GETBASEFAT $$BASE 
$$OFFSET)) (T (\\GETBASETHIN $$BASE $$OFFSET)))))))) T)
(I.S.OPR (QUOTE |instring|) NIL (QUOTE (SUBPAIR (QUOTE ($$BODY $$END $$OFFSET $$BASE $$FATP)) (LIST (
GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$BODY _ BODY 
$$END $$OFFSET $$BASE $$FATP |declare| (LOCALVARS $$BODY $$END $$OFFSET $$BASE $$FATP) |first| (SETQ 
$$OFFSET (SUB1 (|ffetch| (STRINGP OFFST) |of| $$BODY))) (SETQ $$BASE (|ffetch| (STRINGP BASE) |of| 
$$BODY)) (SETQ $$END (IPLUS $$OFFSET (|ffetch| (STRINGP LENGTH) |of| $$BODY))) (SETQ $$FATP (|ffetch| 
(STRINGP FATSTRINGP) |of| $$BODY)) |eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET
 $$END) (GO $$OUT)) (SETQ I.V. (COND ($$FATP (\\GETBASEFAT $$BASE $$OFFSET)) (T (\\GETBASETHIN $$BASE 
$$OFFSET)))))))) T)
(I.S.OPR (QUOTE |infatatom|) NIL (QUOTE (SUBPAIR (QUOTE ($$OFFSET $$BODY $$BASE $$END)) (LIST (
GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$OFFSET _ 0 $$BODY _ BODY 
$$BASE $$END |declare| (LOCALVARS $$OFFSET $$BODY $$BASE $$END) |first| (SETQ $$BASE (|ffetch| (
LITATOM PNAMEBASE) |of| $$BODY)) (SETQ $$END (|ffetch| (PNAMEBASE PNAMELENGTH) |of| $$BASE)) 
|eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (
\\GETBASEFAT $$BASE $$OFFSET)))))) T)
(I.S.OPR (QUOTE |inthinatom|) NIL (QUOTE (SUBPAIR (QUOTE ($$OFFSET $$BODY $$BASE $$END)) (LIST (
GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$OFFSET _ 0 $$BODY _ BODY 
$$BASE $$END |declare| (LOCALVARS $$OFFSET $$BODY $$BASE $$END) |first| (SETQ $$BASE (|ffetch| (
LITATOM PNAMEBASE) |of| $$BODY)) (SETQ $$END (|ffetch| (PNAMEBASE PNAMELENGTH) |of| $$BASE)) 
|eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (
\\GETBASETHIN $$BASE $$OFFSET)))))) T)
(I.S.OPR (QUOTE |infatstring|) NIL (QUOTE (SUBPAIR (QUOTE ($$BODY $$END $$OFFSET $$BASE)) (LIST (
GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$BODY _ BODY $$END $$OFFSET 
$$BASE |declare| (LOCALVARS $$BODY $$END $$OFFSET $$BASE) |first| (SETQ $$OFFSET (SUB1 (|ffetch| (
STRINGP OFFST) |of| $$BODY))) (SETQ $$BASE (|ffetch| (STRINGP BASE) |of| $$BODY)) (SETQ $$END (IPLUS 
$$OFFSET (|ffetch| (STRINGP LENGTH) |of| $$BODY))) |eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (
IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (\\GETBASEFAT $$BASE $$OFFSET)))))) T)
(I.S.OPR (QUOTE |inthinstring|) NIL (QUOTE (SUBPAIR (QUOTE ($$BODY $$END $$OFFSET $$BASE)) (LIST (
GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$BODY _ BODY $$END $$OFFSET 
$$BASE |declare| (LOCALVARS $$BODY $$END $$OFFSET $$BASE) |first| (SETQ $$OFFSET (SUB1 (|ffetch| (
STRINGP OFFST) |of| $$BODY))) (SETQ $$BASE (|ffetch| (STRINGP BASE) |of| $$BODY)) (SETQ $$END (IPLUS 
$$OFFSET (|ffetch| (STRINGP LENGTH) |of| $$BODY))) |eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (
IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (\\GETBASETHIN $$BASE $$OFFSET)))))) T)
(PUTPROPS \\CHARCODEP DMACRO (OPENLAMBDA (X) (* \; 
"used to also say (ILEQ X \\MAXFATCHAR), but that's implied by the first two clauses") (AND (SMALLP X)
 (IGEQ X 0))))
(PUTPROPS \\FATCHARCODEP DMACRO (OPENLAMBDA (X) (* \; 
"Used to also say (ILEQ X \\MAXFATCHAR), but that's implied by the first two clauses") (AND (SMALLP X)
 (IGREATERP X \\MAXTHINCHAR))))
(PUTPROPS \\THINCHARCODEP DMACRO (OPENLAMBDA (X) (AND (SMALLP X) (IGEQ X 0) (ILEQ X \\MAXTHINCHAR))))
(PUTPROPS \\GETBASEFAT MACRO (= . \\GETBASE))
(PUTPROPS \\GETBASETHIN MACRO (= . \\GETBASEBYTE))
(PUTPROPS \\PUTBASEFAT MACRO (= . \\PUTBASE))
(PUTPROPS \\PUTBASETHIN MACRO (= . \\PUTBASEBYTE))
(PUTPROPS \\PUTBASECHAR MACRO (OPENLAMBDA (FATP BASE OFFSET CODE) (COND (FATP (\\PUTBASEFAT BASE 
OFFSET CODE)) (T (\\PUTBASETHIN BASE OFFSET CODE)))))
(PUTPROPS \\GETBASECHAR MACRO ((FATP BASE N) (COND (FATP (\\GETBASEFAT BASE N)) (T (\\GETBASETHIN BASE
 N)))))
(PUTPROPS \\CHARSET MACRO ((CHARCODE) (LRSH CHARCODE 8)))
(PUTPROPS \\CHAR8CODE MACRO ((CHARCODE) (LOGAND CHARCODE 255)))
(RPAQQ \\CHARMASK 255)
(RPAQQ \\MAXCHAR 255)
(RPAQQ \\MAXTHINCHAR 255)
(RPAQQ \\MAXFATCHAR 65535)
(RPAQQ \\MAXCHARSET 255)
(RPAQQ NSCHARSETSHIFT 255)
(RPAQQ \#STRINGPWORDS 4)
(CONSTANTS (\\CHARMASK 255) (\\MAXCHAR 255) (\\MAXTHINCHAR 255) (\\MAXFATCHAR 65535) (\\MAXCHARSET 255
) (NSCHARSETSHIFT 255) (\#STRINGPWORDS 4))
(PUTPROPS \\NATOMCHARS DMACRO ((AT) (|fetch| (LITATOM PNAMELENGTH) |of| AT)))
(PUTPROPS \\NSTRINGCHARS DMACRO ((S) (|fetch| (STRINGP LENGTH) |of| S)))
(PUTPROP (QUOTE LLCHAR) (QUOTE IMPORTDATE) (IDATE "11-Nov-2018 13:08:04"))

(ACCESSFNS BF ((BFBLOCK (ADDSTACKBASE DATUM))) (* \; "basic frame pointer") (BLOCKRECORD BFBLOCK ((
FLAGS BITS 3) (NIL BITS 3) (RESIDUAL FLAG) (* \; "true if this is not a full BF") (PADDING BITS 1) (
USECNT BITS 8) (IVAR WORD))) (TYPE? (IEQ (|fetch| (BF FLAGS) |of| DATUM) \\STK.BF)) (ACCESSFNS BF ((
NARGS (IDIFFERENCE (FOLDLO (IDIFFERENCE DATUM (|fetch| (BF IVAR) |of| DATUM)) WORDSPERCELL) (|fetch| (
BF PADDING) |of| DATUM))) (SIZE (IPLUS 2 (IDIFFERENCE DATUM (|fetch| (BF IVAR) |of| DATUM)))) (CHECKED
 (AND (|type?| BF DATUM) (|for| I |from| (|fetch| (BF IVAR) |of| DATUM) |to| (IDIFFERENCE DATUM 2) 
|by| 2 |always| (IEQ \\STK.NOTFLAG (|fetch| (BF FLAGS) |of| I))))))))
(ACCESSFNS FX ((FXBLOCK (ADDSTACKBASE DATUM))) (* \; "frame extension index") (BLOCKRECORD FXBLOCK ((
FLAGS BITS 3) (* \; "= \\STK.FX") (FAST FLAG) (NIL FLAG) (INCALL FLAG) (* \; 
"set when fncall microcode has to punt") (VALIDNAMETABLE FLAG) (* \; 
"if on, NAMETABLE field is filled in.  If off, is same as FNHEADER") (NOPUSH FLAG) (* \; 
"when returning to this frame, don't push a value.  Set by interrupt code") (USECNT BITS 8) (\#ALINK 
WORD) (* \; "low bit is SLOWP") (FNHEADER FULLXPOINTER) (NEXTBLOCK WORD) (PC WORD) (NAMETABLE# 
FULLXPOINTER) (\#BLINK WORD) (\#CLINK WORD))) (BLOCKRECORD FXBLOCK ((FLAGBYTE BYTE) (NIL BYTE) (NIL 
BITS 15) (* \; "most of the bits of #ALINK") (SLOWP FLAG) (* \; 
"if on, then BLINK and CLINK fields are valid.  If off, they are implicit") (NIL FULLXPOINTER 2) (
NAMETABHI WORD) (NAMETABLO WORD))) (TYPE? (IEQ (|fetch| (FX FLAGS) |of| DATUM) \\STK.FX)) (ACCESSFNS 
FX ((NAMETABLE (COND ((|fetch| (FX VALIDNAMETABLE) |of| DATUM) (|fetch| (FX NAMETABLE#) |of| DATUM)) (
T (|fetch| (FX FNHEADER) |of| DATUM))) (PROGN (|replace| (FX FAST) |of| DATUM |with| NIL) (|replace| (
FX NAMETABLE#) |of| DATUM |with| NEWVALUE) (|replace| (FX VALIDNAMETABLE) |of| DATUM |with| T))) (
FRAMENAME (|fetch| (FNHEADER FRAMENAME) |of| (|fetch| (FX NAMETABLE) |of| DATUM))) (INVALIDP (EQ DATUM
 0)) (* \; "true when A/CLink points at nobody, i.e. FX is bottom of stack") (FASTP (NOT (|fetch| (FX 
SLOWP) |of| DATUM)) (PROGN (CHECK (NULL NEWVALUE)) (COND ((|fetch| (FX FASTP) |of| DATUM) (|replace| (
FX \#BLINK) |of| DATUM |with| (|fetch| (FX DUMMYBF) |of| DATUM)) (|replace| (FX \#CLINK) |of| DATUM 
|with| (|fetch| (FX \#ALINK) |of| DATUM)) (|replace| (FX SLOWP) |of| DATUM |with| T))))) (BLINK (COND 
((|fetch| (FX FASTP) |of| DATUM) (|fetch| (FX DUMMYBF) |of| DATUM)) (T (|fetch| (FX \#BLINK) |of| 
DATUM))) (PROGN (|replace| (FX \#BLINK) |of| DATUM |with| NEWVALUE) (COND ((|fetch| (FX FASTP) |of| 
DATUM) (|replace| (FX \#CLINK) |of| DATUM |with| (|fetch| (FX \#ALINK) |of| DATUM)) (|replace| (FX 
SLOWP) |of| DATUM |with| T))))) (CLINK (IDIFFERENCE (COND ((|fetch| (FX FASTP) |of| DATUM) (|fetch| (
FX \#ALINK) |of| DATUM)) (T (|fetch| (FX \#CLINK) |of| DATUM))) \\#ALINK.OFFSET) (PROGN (|replace| (FX
 \#CLINK) |of| DATUM |with| (IPLUS NEWVALUE \\#ALINK.OFFSET)) (COND ((|fetch| (FX FASTP) |of| DATUM) (
|replace| (FX \#BLINK) |of| DATUM |with| (|fetch| (FX DUMMYBF) |of| DATUM)) (|replace| (FX SLOWP) |of|
 DATUM |with| T))))) (ALINK (IDIFFERENCE (FLOOR (|fetch| (FX \#ALINK) |of| DATUM) WORDSPERCELL) 
\\#ALINK.OFFSET) (PROGN (COND ((|fetch| (FX FASTP) |of| DATUM) (|replace| (FX \#BLINK) |of| DATUM 
|with| (|fetch| (FX DUMMYBF) |of| DATUM)) (|replace| (FX \#CLINK) |of| DATUM |with| (|fetch| (FX 
\#ALINK) |of| DATUM)))) (|replace| (FX \#ALINK) |of| DATUM |with| (IPLUS NEWVALUE \\#ALINK.OFFSET (
SUB1 WORDSPERCELL))))) (ACLINK (SHOULDNT) (PROGN (COND ((|fetch| (FX FASTP) |of| DATUM) (|replace| (FX
 \#BLINK) |of| DATUM |with| (|fetch| (FX DUMMYBF) |of| DATUM)))) (|replace| (FX \#CLINK) |of| DATUM 
|with| (IPLUS NEWVALUE \\#ALINK.OFFSET)) (|replace| (FX \#ALINK) |of| DATUM |with| (IPLUS NEWVALUE 
\\#ALINK.OFFSET (SUB1 WORDSPERCELL))))) (* \; 
"replaces A & C Links at once more efficiently than separately") (DUMMYBF (IDIFFERENCE DATUM 
WORDSPERCELL)) (* |;;| 
"This is either an actual BF or \"residual\" BF that provides enough BF to find its IVAR slot.  This means that when a FX is copied, the cell preceding the FX is copied too."
) (IVAR (|fetch| (BF IVAR) |of| (|fetch| (FX DUMMYBF) |of| DATUM))) (CHECKED (AND (|type?| FX DATUM) (
OR (IEQ (|fetch| (FX DUMMYBF) |of| DATUM) (|fetch| (FX BLINK) |of| DATUM)) (AND (|fetch| (BF RESIDUAL)
 |of| (|fetch| (FX DUMMYBF) |of| DATUM)) (IEQ (|fetch| (BF IVAR) |of| (|fetch| (FX DUMMYBF) |of| DATUM
)) (|fetch| (BF IVAR) |of| (|fetch| (FX BLINK) |of| DATUM))))))) (FIRSTPVAR (IPLUS DATUM (|fetch| (FX 
FXSIZE) |of| T))) (* \; "stack offset of PVAR0") (FXSIZE (PROGN 10)) (* \; 
"fixed overhead from flags thru clink") (PADDING (PROGN 4)) (* \; 
"doublecell of garbage for microcode use") (FIRSTTEMP (IPLUS (|fetch| (FX FIRSTPVAR) |of| DATUM) (
|fetch| (FX NPVARWORDS) |of| DATUM) (|fetch| (FX PADDING) |of| DATUM))) (* \; 
"note that NPVARWORDS is obtained from the FNHEADER") (SIZE (IDIFFERENCE (|fetch| (FX NEXTBLOCK) |of| 
DATUM) DATUM)))))
(ACCESSFNS FSB (* |;;| "FREE STACK BLOCK -- ") (* |;;| " A piece of stack space that's free.") (* |;;|
 "The first word contains 120000Q") (* |;;| "The 2nd word is the size of the block, in words.") ((
FSBBLOCK (ADDSTACKBASE DATUM)) (CHECKED (IEQ (|fetch| (FSB FLAGWORD) |of| DATUM) \\STK.FSB.WORD))) (
BLOCKRECORD FSBBLOCK ((FLAGS BITS 3) (DUMMY BITS 13) (SIZE WORD))) (BLOCKRECORD FSBBLOCK ((FLAGWORD 
WORD) (SIZE WORD))) (* \; "free stack block") (TYPE? (IEQ (|fetch| (FSB FLAGS) |of| DATUM) \\STK.FSB))
)
(ACCESSFNS STK ((STKBLOCK (ADDSTACKBASE DATUM))) (* \; "unspecified stack block") (BLOCKRECORD 
STKBLOCK ((FLAGS BITS 3))) (BLOCKRECORD STKBLOCK ((FLAGWORD WORD))))
(RPAQQ \\#ALINK.OFFSET 10)
(CONSTANTS \\#ALINK.OFFSET)
(GLOBALVARS \\PENDINGINTERRUPT \\KBDSTACKBASE \\MISCSTACKBASE \\STACKOVERFLOW)
(PUTPROPS \\MYALINK DMACRO (NIL ((OPCODES MYALINK))))
(PUTPROPS ADDSTACKBASE DMACRO (= . STACKADDBASE))
(PUTPROPS STACKADDBASE DMACRO ((N) (VAG2 \\STACKHI N)))
(PUTPROPS STACKGETBASE DMACRO ((N) (\\GETBASE (STACKADDBASE N) 0)))
(PUTPROPS STACKGETBASEPTR DMACRO ((N) (\\GETBASEPTR (STACKADDBASE N) 0)))
(PUTPROPS STACKPUTBASE DMACRO ((N V) (\\PUTBASE (STACKADDBASE N) 0 V)))
(PUTPROPS STACKPUTBASEPTR DMACRO ((N V) (\\PUTBASEPTR (STACKADDBASE N) 0 V)))
(PUTPROPS \\MISCAPPLY* MACRO ((FN ARG1 ARG2) (UNINTERRUPTABLY (|replace| (IFPAGE MISCSTACKFN) |of| 
|\\InterfacePage| |with| FN) (|replace| (IFPAGE MISCSTACKARG1) |of| |\\InterfacePage| |with| ARG1) (
|replace| (IFPAGE MISCSTACKARG2) |of| |\\InterfacePage| |with| ARG2) (\\CONTEXTSWITCH |\\MiscFXP|) (
|fetch| (IFPAGE MISCSTACKRESULT) |of| |\\InterfacePage|))))
(BLOCKRECORD STACKP ((STACKP0 WORD) (EDFXP WORD)) (BLOCKRECORD STACKP ((STACKPOINTER FULLXPOINTER))) (
TYPE? (STACKP DATUM)))
(RPAQQ STACKTYPES (\\STK.GUARD \\STK.FX \\STK.BF \\STK.NOTFLAG \\STK.FSB \\STK.FLAGS.SHIFT (
\\STK.FSB.WORD (LLSH \\STK.FSB \\STK.FLAGS.SHIFT)) (\\STK.GUARD.WORD (LLSH \\STK.GUARD 
\\STK.FLAGS.SHIFT)) (\\STK.BF.WORD (LLSH \\STK.BF \\STK.FLAGS.SHIFT))))
(RPAQQ \\STK.GUARD 7)
(RPAQQ \\STK.FX 6)
(RPAQQ \\STK.BF 4)
(RPAQQ \\STK.NOTFLAG 0)
(RPAQQ \\STK.FSB 5)
(RPAQQ \\STK.FLAGS.SHIFT 13)
(RPAQ \\STK.FSB.WORD (LLSH \\STK.FSB \\STK.FLAGS.SHIFT))
(RPAQ \\STK.GUARD.WORD (LLSH \\STK.GUARD \\STK.FLAGS.SHIFT))
(RPAQ \\STK.BF.WORD (LLSH \\STK.BF \\STK.FLAGS.SHIFT))
(CONSTANTS \\STK.GUARD \\STK.FX \\STK.BF \\STK.NOTFLAG \\STK.FSB \\STK.FLAGS.SHIFT (\\STK.FSB.WORD (
LLSH \\STK.FSB \\STK.FLAGS.SHIFT)) (\\STK.GUARD.WORD (LLSH \\STK.GUARD \\STK.FLAGS.SHIFT)) (
\\STK.BF.WORD (LLSH \\STK.BF \\STK.FLAGS.SHIFT)))
(RPAQQ |\\StackAreaSize| 768)
(RPAQ |\\InitStackSize| (ITIMES |\\StackAreaSize| 12))
(CONSTANTS |\\StackAreaSize| (|\\InitStackSize| (ITIMES |\\StackAreaSize| 12)))
(RPAQQ \\MAXSAFEUSECOUNT 200)
(CONSTANTS \\MAXSAFEUSECOUNT)
(BLOCKRECORD NAMETABLESLOT ((VARTYPE BYTE) (VAROFFSET BYTE)))
(BLOCKRECORD FVARSLOT ((BINDLO WORD) (BINDHI WORD)) (ACCESSFNS FVARSLOT ((LOOKEDUP (EVENP (|fetch| 
BINDLO |of| DATUM))) (BINDINGPTR (\\VAG2 (|fetch| BINDHI |of| DATUM) (|fetch| BINDLO |of| DATUM)) (
PROGN (|replace| BINDLO |of| DATUM |with| (\\LOLOC NEWVALUE)) (|replace| BINDHI |of| DATUM |with| (
\\HILOC NEWVALUE)))))))
(BLOCKRECORD PVARSLOT ((PVHI BITS 4) (PVVALUE XPOINTER)) (ACCESSFNS PVARSLOT ((BOUND (EQ (|fetch| (
PVARSLOT PVHI) |of| DATUM) 0) (|if| (NULL NEWVALUE) |then| (|replace| (PVARSLOT PVHI) |of| DATUM 
|with| 255) |else| (ERROR "Illegal replace" NEWVALUE))))))
(BLOCKRECORD STKTEMPSLOT ((STKTMPHI BITS 4) (VALUE XPOINTER)) (ACCESSFNS STKTEMPSLOT ((BINDINGPTRP (
NEQ (|fetch| STKTMPHI |of| DATUM) 0)))))
(BLOCKRECORD BINDMARKSLOT ((BINDMARKP FLAG) (NIL BITS 15)) (BLOCKRECORD BINDMARKSLOT ((BINDNEGVALUES 
WORD) (BINDLASTPVAR WORD))) (ACCESSFNS BINDMARKSLOT ((BINDNVALUES (PROGN (* \; 
"Value stored in high half is one's complement of number of values bound") (LOGXOR (|fetch| 
BINDNEGVALUES |of| DATUM) 65535))))))
(RPAQQ \\NT.IVAR 0)
(RPAQQ \\NT.PVAR 128)
(RPAQQ \\NT.FVAR 192)
(CONSTANTS \\NT.IVAR \\NT.PVAR \\NT.FVAR)
(PUTPROP (QUOTE LLSTK) (QUOTE IMPORTDATE) (IDATE " 6-Jan-1993 18:07:37"))

(PUTPROPS WORDCONTENTS BYTEMACRO ((PTR) (\\GETBASE PTR 0)))
(PUTPROPS SETWORDCONTENTS BYTEMACRO ((PTR N) (\\PUTBASE PTR 0 N)))
(PUTPROPS WORDOFFSET BYTEMACRO ((PTR N) (\\ADDBASE PTR N)))
(PUTPROPS \\RELEASECPAGE MACRO ((STREAM) (PROGN (* \; "Must be under an UNINTERRUPTABLY !") (COND ((
|fetch| CBUFDIRTY |of| STREAM) (\\SETIODIRTY STREAM (|fetch| CPAGE |of| STREAM)) (|replace| CBUFDIRTY 
|of| STREAM |with| NIL))) (|replace| CBUFSIZE |of| STREAM |with| 0) (|replace| CBUFPTR |of| STREAM 
|with| NIL))))
(PUTPROP (QUOTE PMAP) (QUOTE IMPORTDATE) (IDATE " 3-Feb-2002 14:11:02"))

(PUTPROPS ADDREF MACRO (OPENLAMBDA (PTR) (PROG1 PTR (\\ADDREF PTR))))
(PUTPROPS \\ADDREF DMACRO ((X) ((OPCODES GCREF 0) X)))
(PUTPROPS DELETEREF MACRO (OPENLAMBDA (PTR) (PROG1 PTR (\\DELREF PTR))))
(PUTPROPS \\DELREF DMACRO ((X) ((OPCODES GCREF 1) X)))
(PUTPROPS SCANREF MACRO (= . \\STKREF))
(PUTPROPS \\STKREF DMACRO ((X) ((OPCODES GCREF 2) X)))
(PUTPROPS UNSCANREF MACRO ((PTR) (\\HTFIND PTR 3)))
(PUTPROPS CREATEREF MACRO (= . \\CREATEREF))
(PUTPROPS \\CREATEREF MACRO (OPENLAMBDA (PTR) (PROG1 (\\DELREF PTR) (.INCREMENT.ALLOCATION.COUNT. 1)))
)
(PUTPROPS .INCREMENT.ALLOCATION.COUNT. MACRO (OPENLAMBDA (N) (DECLARE (GLOBALVARS \\RECLAIM.COUNTDOWN)
) (AND \\RECLAIM.COUNTDOWN (COND ((IGREATERP \\RECLAIM.COUNTDOWN N) (SETQ \\RECLAIM.COUNTDOWN (
IDIFFERENCE \\RECLAIM.COUNTDOWN N))) (T (SETQ \\RECLAIM.COUNTDOWN) (\\DORECLAIM))))))
(PUTPROPS .CHECK.ALLOCATION.COUNT. MACRO (OPENLAMBDA (N) (DECLARE (GLOBALVARS \\RECLAIM.COUNTDOWN)) (
AND \\RECLAIM.COUNTDOWN (COND ((NOT (IGREATERP \\RECLAIM.COUNTDOWN N)) (SETQ \\RECLAIM.COUNTDOWN) (
\\DORECLAIM))))))
(PUTPROPS \\GCDISABLED MACRO (NIL (PROGN (DECLARE (GLOBALVARS \\GCDISABLED)) \\GCDISABLED)))
(BLOCKRECORD HTOVERFLOW ((CASE BITS 4) (PTR XPOINTER)) (ACCESSFNS HTOVERFLOW ((CLEAR NIL (\\PUTBASEPTR
 DATUM 0 NIL)))))
(BLOCKRECORD GC ((CNT BITS 15) (STKBIT FLAG) (HIBITS BITS 15) (LINKP FLAG) (NXTPTR FIXP)) (BLOCKRECORD
 GC ((STKCNT WORD))) (ACCESSFNS GC ((EMPTY (EQ 0 (\\GETBASEFIXP DATUM 0)) (\\PUTBASEFIXP DATUM 0 0)) (
CONTENTS (\\GETBASEFIXP DATUM 0) (\\PUTBASEFIXP DATUM 0 NEWVALUE)) (LINKPTR (LOGAND (\\GETBASEFIXP 
DATUM 0) -2) (\\PUTBASEFIXP DATUM 0 (LOGOR NEWVALUE 1))))))
(BLOCKRECORD HTCOLL ((* |;;| 
"An entry in the GC collision table.  NEXTFREE is initialized to 2 by INITGC, as part of the MAKEINIT."
) (FREEPTR FIXP) (* \; "The GC table entry") (NEXTFREE FIXP) (* \; 
"If the entry is in use, points to the next entry in this collision chain.  If not, offset (in 1/2-entries) of the next free one on the chain."
)))
(PUTPROP (QUOTE LLGC) (QUOTE IMPORTDATE) (IDATE "19-Oct-1994 12:30:11"))

(PUTPROPS \\SYNCODE DMACRO (OPENLAMBDA (TABLE CHAR) (CHECK (|type?| CHARTABLE TABLE)) (* \; 
"0 is either NONE.TC, REAL.CCE, or OTHER.RC") (COND ((IGREATERP CHAR \\MAXTHINCHAR) (OR (AND (|fetch| 
(CHARTABLE NSCHARHASH) |of| TABLE) (GETHASH CHAR (|fetch| (CHARTABLE NSCHARHASH) |of| TABLE))) 0)) (T 
(\\GETBASEBYTE TABLE CHAR)))))
(PUTPROPS \\SETSYNCODE DMACRO (LAMBDA (TABLE CHAR CODE) (CHECK (|type?| CHARTABLE TABLE)) (* \; 
"0 is REAL.CCE, NONE.TC, OTHER.RC") (COND ((ILEQ CHAR \\MAXTHINCHAR) (\\PUTBASEBYTE TABLE CHAR CODE)) 
(T (\\SETFATSYNCODE TABLE CHAR CODE)))))
(DATATYPE CHARTABLE ((CHARSET0 256 BYTE) (NSCHARHASH FULLPOINTER)))
(RPAQQ CCECHOMODES (REAL.CCE IGNORE.CCE SIMULATE.CCE INDICATE.CCE))
(RPAQQ REAL.CCE 0)
(RPAQQ IGNORE.CCE 8)
(RPAQQ SIMULATE.CCE 16)
(RPAQQ INDICATE.CCE 24)
(CONSTANTS REAL.CCE IGNORE.CCE SIMULATE.CCE INDICATE.CCE)
(RPAQQ TERMCLASSES (NONE.TC EOL.TC CHARDELETE.TC WORDDELETE.TC WORDSEPR.TC LINEDELETE.TC RETYPE.TC 
CTRLV.TC))
(RPAQQ NONE.TC 0)
(RPAQQ EOL.TC 1)
(RPAQQ CHARDELETE.TC 2)
(RPAQQ WORDDELETE.TC 6)
(RPAQQ WORDSEPR.TC 7)
(RPAQQ LINEDELETE.TC 3)
(RPAQQ RETYPE.TC 4)
(RPAQQ CTRLV.TC 5)
(CONSTANTS NONE.TC EOL.TC CHARDELETE.TC WORDDELETE.TC WORDSEPR.TC LINEDELETE.TC RETYPE.TC CTRLV.TC)
(ACCESSFNS TERMCODE ((CCECHO (LOGAND DATUM 24)) (TERMCLASS (LOGAND DATUM 7))) (* \; 
"We assume that values are appropriately shifted") (CREATE (LOGOR CCECHO TERMCLASS)))
(DATATYPE TERMTABLEP (TERMSA RAISEFLG DELCHARECHO LINEDELETE 1STCHDEL NTHCHDEL POSTCHDEL EMPTYCHDEL (
CONTROLFLG FLAG) (ECHOFLG FLAG)) TERMSA _ (|create| CHARTABLE))
(PUTPROPS \\GETREADMACRODEF MACRO ((C TBL) (GETHASH C (|fetch| READMACRODEFS |of| TBL))))
(PUTPROPS \\GTREADTABLE MACRO (ARGS (COND ((LITATOM (CAR ARGS)) (SUBPAIR (QUOTE (X . FLG)) ARGS (QUOTE
 (SELECTQ X ((NIL T) (\\DTEST *READTABLE* (QUOTE READTABLEP))) (\\GTREADTABLE1 X . FLG))))) (T (QUOTE 
IGNOREMACRO)))))
(PUTPROPS \\GTREADTABLE1 DMACRO (ARGS (COND ((NULL (CDR ARGS)) (LIST (QUOTE \\DTEST) (CAR ARGS) (QUOTE
 (QUOTE READTABLEP)))) (T (QUOTE IGNOREMACRO)))))
(RPAQQ MACROBIT 8)
(RPAQQ BREAKBIT 16)
(RPAQQ STOPATOMBIT 32)
(RPAQQ ESCAPEBIT 64)
(RPAQQ INNERESCAPEBIT 4)
(CONSTANTS MACROBIT BREAKBIT STOPATOMBIT ESCAPEBIT INNERESCAPEBIT)
(RPAQQ READCODEMASKS ((CONTEXTMASK (LOGOR MACROBIT STOPATOMBIT BREAKBIT 1)) (WAKEUPMASK (LOGOR 
MACROBIT 2))))
(RPAQ CONTEXTMASK (LOGOR MACROBIT STOPATOMBIT BREAKBIT 1))
(RPAQ WAKEUPMASK (LOGOR MACROBIT 2))
(CONSTANTS (CONTEXTMASK (LOGOR MACROBIT STOPATOMBIT BREAKBIT 1)) (WAKEUPMASK (LOGOR MACROBIT 2)))
(RPAQQ READMACROCONTEXTS ((ALWAYS.RMC (LOGOR MACROBIT STOPATOMBIT BREAKBIT 0)) (FIRST.RMC (LOGOR 
MACROBIT 0)) (ALONE.RMC (LOGOR MACROBIT 1))))
(RPAQ ALWAYS.RMC (LOGOR MACROBIT STOPATOMBIT BREAKBIT 0))
(RPAQ FIRST.RMC (LOGOR MACROBIT 0))
(RPAQ ALONE.RMC (LOGOR MACROBIT 1))
(CONSTANTS (ALWAYS.RMC (LOGOR MACROBIT STOPATOMBIT BREAKBIT 0)) (FIRST.RMC (LOGOR MACROBIT 0)) (
ALONE.RMC (LOGOR MACROBIT 1)))
(RPAQQ READCLASSES ((OTHER.RC 0) (SEPRCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT 0)) (BREAKCHAR.RC (LOGOR 
ESCAPEBIT STOPATOMBIT BREAKBIT 0)) (STRINGDELIM.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 1)) (
LEFTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 2)) (RIGHTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT 
BREAKBIT 3)) (LEFTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 4)) (RIGHTBRACKET.RC (LOGOR 
ESCAPEBIT STOPATOMBIT BREAKBIT 5)) (ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 6)) (MULTIPLE-ESCAPE.RC 
(LOGOR ESCAPEBIT INNERESCAPEBIT 7)) (PACKAGEDELIM.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 1))))
(RPAQQ OTHER.RC 0)
(RPAQ SEPRCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT 0))
(RPAQ BREAKCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 0))
(RPAQ STRINGDELIM.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 1))
(RPAQ LEFTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 2))
(RPAQ RIGHTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 3))
(RPAQ LEFTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 4))
(RPAQ RIGHTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 5))
(RPAQ ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 6))
(RPAQ MULTIPLE-ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 7))
(RPAQ PACKAGEDELIM.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 1))
(CONSTANTS (OTHER.RC 0) (SEPRCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT 0)) (BREAKCHAR.RC (LOGOR ESCAPEBIT 
STOPATOMBIT BREAKBIT 0)) (STRINGDELIM.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 1)) (LEFTPAREN.RC (
LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 2)) (RIGHTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 3)) (
LEFTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 4)) (RIGHTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT
 BREAKBIT 5)) (ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 6)) (MULTIPLE-ESCAPE.RC (LOGOR ESCAPEBIT 
INNERESCAPEBIT 7)) (PACKAGEDELIM.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 1)))
(RPAQQ READMACROWAKEUPS ((IMMEDIATE.RMW (LOGOR MACROBIT 2)) (NONIMMEDIATE.RMW (LOGOR MACROBIT 0))))
(RPAQ IMMEDIATE.RMW (LOGOR MACROBIT 2))
(RPAQ NONIMMEDIATE.RMW (LOGOR MACROBIT 0))
(CONSTANTS (IMMEDIATE.RMW (LOGOR MACROBIT 2)) (NONIMMEDIATE.RMW (LOGOR MACROBIT 0)))
(RPAQQ READMACROESCAPES ((ESC.RME ESCAPEBIT) (NOESC.RME 0)))
(RPAQ ESC.RME ESCAPEBIT)
(RPAQQ NOESC.RME 0)
(CONSTANTS (ESC.RME ESCAPEBIT) (NOESC.RME 0))
(ACCESSFNS READCODE ((ESCAPE (LOGAND DATUM ESCAPEBIT)) (ESCQUOTE (BITTEST DATUM ESCAPEBIT)) (STOPATOM 
(BITTEST DATUM STOPATOMBIT)) (INNERESCQUOTE (BITTEST DATUM (LOGOR STOPATOMBIT INNERESCAPEBIT))) (
MACROCONTEXT (LOGAND DATUM CONTEXTMASK)) (MACROP (BITTEST DATUM MACROBIT)) (WAKEUP (LOGAND DATUM 
WAKEUPMASK)) (BREAK (BITTEST DATUM BREAKBIT))))
(RECORD READMACRODEF (MACROTYPE . MACROFN))
(DATATYPE READTABLEP ((READSA POINTER) (* \; "A CHARTABLE defining syntax of each char") (
READMACRODEFS POINTER) (* \; "A hash table associating macro chars with macro definitions") (
READMACROFLG FLAG) (* \; 
"True if read macros are enabled (turned off by Interlisp's crufty READMACROS function)") (ESCAPEFLG 
FLAG) (* \; 
"True if the char(s) with escape syntax are enabled (turned off by Interlisp's crufty ESCAPE function)"
) (COMMONLISP FLAG) (* \; 
"True if table is a Common Lisp read table and hence must obey Common Lisp syntax rules") (NUMBERBASE 
BITS 5) (* \; "Not used") (CASEINSENSITIVE FLAG) (* \; 
"If true, unescaped lowercase chars are converted to uppercase in symbols") (COMMONNUMSYNTAX FLAG) (* 
\; 
"True if number notation includes Common Lisp numbers: rationals as a/b, and the dfls exponent markers"
) (USESILPACKAGE FLAG) (* \; "If true, IL:READ ignores *PACKAGE* and reads in the IL package") (NIL 5 
FLAG) (DISPATCHMACRODEFS POINTER) (* \; 
"An a-list of dispatching macro char and its dispatch definitions") (HASHMACROCHAR BYTE) (* \; 
"The character code used in this read table for the # dispatch macro") (ESCAPECHAR BYTE) (* \; 
"The character code used in this read table for single escape") (MULTESCAPECHAR BYTE) (* \; 
"The character code used in this read table for multiple escape") (PACKAGECHAR BYTE) (* \; 
"The character code used in this read table for package delimiter") (READTBLNAME POINTER) (* \; 
"The canonical 'name' of this read table")) READSA _ (|create| CHARTABLE))
(PUTPROP (QUOTE ATBL) (QUOTE IMPORTDATE) (IDATE "12-Feb-2021 22:55:58"))

(DATATYPE STREAM ((* |;;| 
"First 8 words are fixed for BIN, BOUT opcodes.  Used to require length of whole datatype be multiple of 4, but Dolphin dead now."
) (COFFSET WORD) (* \; "Offset in CPPTR of next bin or bout") (CBUFSIZE WORD) (* \; 
"Offset past last byte in that buffer") (PEEKEDCHARP FLAG) (* \; 
"if true, PEEKEDCHAR contains value of recent call to unread-char") (ACCESSBITS BITS 3) (* \; 
"What kind of access file is open for (read, write, append)") (CBUFPTR POINTER) (* \; 
"Pointer to current buffer") (BYTESIZE BYTE) (* \; "Byte size of stream, always 8 for now") (CHARSET 
BYTE) (* \; 
"the current character set for this stream.  If 255, stream is not runcoded, so read-char consumes two bytes every time"
) (PEEKEDCHAR WORD) (* \; "value of unread-char call") (CHARPOSITION WORD) (* \; 
"Used by POSITION etc.") (CBUFMAXSIZE WORD) (* \; 
"on output, the size of the physical buffer--can't extend beyond this") (* |;;| 
"-------- Above fields (8 words) potentially known to microcode.  --------") (NONDEFAULTDATEFLG FLAG) 
(REVALIDATEFLG FLAG) (MULTIBUFFERHINT FLAG) (* \; 
"True if stream likes to read and write more than one buffer at a time") (USERCLOSEABLE FLAG) (* \; 
"Can be closed by CLOSEF;  NIL for terminal, dribble...") (FULLFILENAME POINTER) (* \; 
"Name by which file is known to user") (BINABLE FLAG) (* \; "BIN punts unless this bit on") (BOUTABLE 
FLAG) (* \; "BOUT punts unless this bit on") (EXTENDABLE FLAG) (* \; 
"BOUT punts when COFFSET ge CBUFFSIZE unless this bit set and COFFSET lt 512") (CBUFDIRTY FLAG) (* \; 
"true if BOUT has sullied the current buffer") (DEVICE POINTER) (* \; "FDEV of this guy") (USERVISIBLE
 FLAG) (* \; "Listed by OPENP;  NIL for terminal, dribble ...") (EOLCONVENTION BITS 2) (* \; 
"End-of-line convention") (NOTXCCS FLAG) (* \; "True if the character encoding format is not XCCS.") (
VALIDATION POINTER) (* \; 
"A number somehow identifying file, used to determine if file has changed in our absence") (CPAGE 
POINTER) (* \; "CPAGE,,COFFSET constitutes current file pointer for most randaccess streams") (EPAGE 
POINTER) (EOFFSET WORD) (* \; "Page, byte offset of eof") (LINELENGTH WORD) (* \; 
"LINELENGTH of stream, or -1 for no line length") (* |;;| 
"----Following are device-specific fields----") (* |;;| 
"Available for device-specific uses, NOT for application use.") (F1 POINTER) (F2 POINTER) (F3 POINTER)
 (F4 POINTER) (F5 POINTER) (FW6 WORD) (FW7 WORD) (FW8 WORD) (FW9 WORD) (F10 POINTER) (* |;;| 
"----Following only filled in for open streams----") (STRMBINFN POINTER) (* \; 
"Either the BIN fn from the FDEV, or a trap") (STRMBOUTFN POINTER) (* \; 
"Either the BIN fn from the FDEV, or a trap") (OUTCHARFN POINTER) (* \; 
"Called by \\OUTCHAR, the normal character printer.") (ENDOFSTREAMOP POINTER) (* \; 
"Called if EOF and we try to read.") (OTHERPROPS POINTER) (* \; "PROP LIST for holding other info.") (
IMAGEOPS POINTER) (* \; "Image operations vector") (IMAGEDATA POINTER) (* \; 
"Image instance variables--format depends on IMAGEOPS value") (BUFFS POINTER) (* \; 
"Buffer chain for pmapped streams") (MAXBUFFERS WORD) (* \; 
"Max # of buffers the system will allocate.") (LASTCCODE WORD) (* \; 
"After READ, RATOM, etc, the charcode that will be returned (as a character) by LASTC.  If there is none, this field is 65535."
) (EXTRASTREAMOP POINTER) (* \; "For use of applications programs, not devices")) (BLOCKRECORD STREAM 
((NIL 2 WORD) (UCODEFLAGS1 BITS 1) (* |;;| "respecification of access bits:") (RANDOMWRITEABLE FLAG) (
* \; "File open for output (access = OUTPUT or BOTH)") (APPENDABLE FLAG) (* \; 
"File open for append (OUTPUT or APPEND or BOTH)") (READABLE FLAG) (* \; 
"File open for read (READ or BOTH)") (NIL POINTER))) (BLOCKRECORD STREAM ((NIL 4 WORD) (NIL BITS 14) (
* |;;| "JIS character encoding format specific, overrides CHARSET field.") (IN.KANJIIN FLAG) (* \; 
"True if input stream is in Kanji-in mode.") (OUT.KANJIIN FLAG) (* \; 
"True if output stream is in Kanji-in mode."))) (ACCESSFNS STREAM ((ACCESS \\GETACCESS \\SETACCESS) (
FULLNAME (OR (|fetch| (STREAM FULLFILENAME) |of| DATUM) DATUM)) (NAMEDP (AND (|fetch| (STREAM 
FULLFILENAME) |of| DATUM) T)))) (ACCESSFNS STREAM (EXTERNALFORMAT (LISTGET (|ffetch| (STREAM 
OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT)) (LET ((PROPS (|ffetch| (STREAM OTHERPROPS) |of| DATUM)
)) (|freplace| (STREAM NOTXCCS) |of| DATUM |with| T) (COND (PROPS (LISTPUT PROPS (QUOTE EXTERNALFORMAT
) NEWVALUE)) (T (|freplace| (STREAM OTHERPROPS) |of| DATUM |with| (LIST (QUOTE EXTERNALFORMAT) 
NEWVALUE)))) (|freplace| (STREAM OUTCHARFN) |of| DATUM |with| (|ffetch| (EXTERNALFORMAT FILEOUTCHARFN)
 |of| NEWVALUE)) (AND (|ffetch| (EXTERNALFORMAT EOLVALID) |of| NEWVALUE) (|freplace| (STREAM 
EOLCONVENTION) |of| DATUM |with| (|ffetch| (EXTERNALFORMAT EOL) |of| NEWVALUE)))))) (ACCESSFNS STREAM 
(EXTERNALFORMAT.NAME (LISTGET (|ffetch| (STREAM OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT.NAME)) (
LET ((PROPS (|ffetch| (STREAM OTHERPROPS) |of| DATUM)) (NAME (COND ((LITATOM NEWVALUE) NEWVALUE) (T (
MKATOM NEWVALUE))))) (|freplace| (STREAM NOTXCCS) |of| DATUM |with| T) (COND (PROPS (LISTPUT PROPS (
QUOTE EXTERNALFORMAT.NAME) NAME)) (T (|freplace| (STREAM OTHERPROPS) |of| DATUM |with| (LIST (QUOTE 
EXTERNALFORMAT.NAME) NAME))))))) (ACCESSFNS STREAM (INCCODEFN (LET ((XFMT (LISTGET (|ffetch| (STREAM 
OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT)))) (AND (|type?| EXTERNALFORMAT XFMT) (|fetch| (
EXTERNALFORMAT INCCODEFN) |of| XFMT))))) (ACCESSFNS STREAM (PEEKCCODEFN (LET ((XFMT (LISTGET (|ffetch|
 (STREAM OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT)))) (AND (|type?| EXTERNALFORMAT XFMT) (|fetch|
 (EXTERNALFORMAT PEEKCCODEFN) |of| XFMT))))) (ACCESSFNS STREAM (BACKCHARFN (LET ((XFMT (LISTGET (
|ffetch| (STREAM OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT)))) (AND (|type?| EXTERNALFORMAT XFMT) 
(|fetch| (EXTERNALFORMAT BACKCHARFN) |of| XFMT))))) (ACCESSFNS STREAM (FILEOUTCHARFN (|ffetch| (STREAM
 OUTCHARFN) |of| DATUM))) (SYNONYM CBUFPTR (CPPTR)) USERCLOSEABLE _ T USERVISIBLE _ T ACCESSBITS _ 
|NoBits| CPAGE _ 0 EPAGE _ 0 BUFFS _ NIL BYTESIZE _ 8 CBUFPTR _ NIL MAXBUFFERS _ (LET NIL (DECLARE (
GLOBALVARS \\STREAM.DEFAULT.MAXBUFFERS)) \\STREAM.DEFAULT.MAXBUFFERS) CHARPOSITION _ 0 LINELENGTH _ (
LET NIL (DECLARE (GLOBALVARS FILELINELENGTH)) FILELINELENGTH) OUTCHARFN _ (FUNCTION \\FILEOUTCHARFN) 
ENDOFSTREAMOP _ (FUNCTION \\EOSERROR) IMAGEOPS _ \\NOIMAGEOPS EOLCONVENTION _ (SELECTQ (SYSTEMTYPE) (D
 CR.EOLC) (VAX LF.EOLC) (JERICHO CRLF.EOLC) CR.EOLC) STRMBINFN _ (FUNCTION \\STREAM.NOT.OPEN) 
STRMBOUTFN _ (FUNCTION \\STREAM.NOT.OPEN) LASTCCODE _ 65535 NOTXCCS _ NIL)
(PUTPROPS STREAMOP MACRO (ARGS (CONS (QUOTE SPREADAPPLY*) (CONS (COND ((EQ (CAR (LISTP (CAR ARGS))) (
QUOTE QUOTE)) (LIST (QUOTE |fetch|) (CADAR ARGS) (QUOTE |of|) (CADR ARGS))) (T (HELP 
"STREAMOP - OPNAME not quoted:" ARGS))) (CDDR ARGS)))))
(RPAQQ |AppendBit| 2)
(RPAQQ |NoBits| 0)
(RPAQQ |ReadBit| 1)
(RPAQQ |WriteBit| 4)
(RPAQ |OutputBits| (LOGOR |AppendBit| |WriteBit|))
(RPAQ |BothBits| (LOGOR |ReadBit| |OutputBits|))
(RPAQQ \\NORUNCODE 255)
(CONSTANTS |AppendBit| |NoBits| |ReadBit| |WriteBit| (|OutputBits| (LOGOR |AppendBit| |WriteBit|)) (
|BothBits| (LOGOR |ReadBit| |OutputBits|)) \\NORUNCODE)
(PUTPROPS |TestMasked| MACRO ((BITS MASK) (NEQ (LOGAND BITS MASK) 0)))
(PUTPROPS APPENDABLE MACRO ((STREAM) (|TestMasked| (|fetch| ACCESSBITS |of| STREAM) |AppendBit|)))
(PUTPROPS APPENDONLY MACRO ((STREAM) (EQ (|fetch| ACCESSBITS |of| STREAM) |AppendBit|)))
(PUTPROPS DIRTYABLE MACRO ((STREAM) (|TestMasked| (|fetch| ACCESSBITS |of| STREAM) (CONSTANT (LOGOR 
|AppendBit| |WriteBit|)))))
(PUTPROPS OPENED MACRO ((STREAM) (NEQ (|fetch| ACCESSBITS |of| STREAM) |NoBits|)))
(PUTPROPS OVERWRITEABLE MACRO ((STREAM) (|TestMasked| (|fetch| ACCESSBITS |of| STREAM) |WriteBit|)))
(PUTPROPS READABLE MACRO ((STREAM) (|TestMasked| (|fetch| ACCESSBITS |of| STREAM) |ReadBit|)))
(PUTPROPS READONLY MACRO ((STREAM) (EQ (|fetch| ACCESSBITS |of| STREAM) |ReadBit|)))
(PUTPROPS WRITEABLE MACRO ((STREAM) (OR (OVERWRITEABLE STREAM) (AND (APPENDABLE STREAM) (\\EOFP STREAM
)))))
(PUTPROPS \\RUNCODED MACRO (OPENLAMBDA (STREAM) (* |;;| 
"returns NIL is the stream is not runcoded, that is, if the stream has 16 bit bytes explicitly represented"
) (* \; "note that neq is ok since charsets are known to be SMALLP's") (NEQ (|fetch| CHARSET |of| 
STREAM) \\NORUNCODE)))
(RPAQQ EOLCONVENTIONS ((CR.EOLC 0) (LF.EOLC 1) (CRLF.EOLC 2)))
(RPAQQ CR.EOLC 0)
(RPAQQ LF.EOLC 1)
(RPAQQ CRLF.EOLC 2)
(CONSTANTS (CR.EOLC 0) (LF.EOLC 1) (CRLF.EOLC 2))
(PUTPROPS FDEVOP DMACRO (ARGS (LET ((OPNAME (CAR ARGS)) (METHOD-DEVICE (CADR ARGS)) (TAIL (CDDR ARGS))
) (COND ((AND (LISTP OPNAME) (EQ (CAR OPNAME) (QUOTE QUOTE))) (BQUOTE (SPREADAPPLY* (|fetch| (FDEV (
\\\, (CADR OPNAME))) |of| (\\\, METHOD-DEVICE)) (\\\,@ TAIL)))) (T (ERROR "OPNAME not quoted: " OPNAME
))))))
(PUTPROPS \\RECOGNIZE-HACK DMACRO (ARGS (LET ((NAME (CAR ARGS)) (RECOG (CADR ARGS)) (DEVICE (CADDR 
ARGS))) (BQUOTE (|if| (|type?| STREAM (\\\, NAME)) |then| (\\\, NAME) |else| (FDEVOP (QUOTE 
GETFILENAME) (\\\, DEVICE) (\\\, NAME) (\\\, RECOG) (\\\, DEVICE)))))))
(DATATYPE FDEV ((RESETABLE FLAG) (* \; "Obsolete") (RANDOMACCESSP FLAG) (NODIRECTORIES FLAG) (
PAGEMAPPED FLAG) (* \; "True if i/o handled by pmap routines") (FDBINABLE FLAG) (* \; 
"Copied as a microcode flag for INPUT streams formed on this device") (FDBOUTABLE FLAG) (FDEXTENDABLE 
FLAG) (BUFFERED FLAG) (* \; 
"True implies that the device supports the BIN & BOUT uCode conventions, and implements the GETNEXTBUFFER method"
) (DEVICENAME POINTER) (* \; "Identifying name somehow") (REMOTEP FLAG) (* \; 
"true if device not local to machine") (SUBDIRECTORIES FLAG) (* \; 
"true if device has real subdirectories") (INPUT-INDIRECTED FLAG) (* \; 
"True for devices that indirect their input stream.  Method INPUTSTREAM fetches it") (
OUTPUT-INDIRECTED FLAG) (* \; 
"True for devices that indirect their output stream.  Method OUTPUTSTREAM fetches it") (DEVICEINFO 
POINTER) (* \; "arbitrary device-specific info stored here") (OPENFILELST POINTER) (* \; 
"Default place to keep list of streams open on this device") (* |;;| 
"-----Rest of record consists of device \"methods\"-----") (* |;;| 
"-----Following fields required of all devices-----") (HOSTNAMEP POINTER) (* \; 
"(hostname {device}) => T if hostname is valid.  If device is given, return a FDEV for this {new} host, or T to use existing device"
) (EVENTFN POINTER) (* \; "(device event), called before/after logout, sysout, makesys") (* |;;| 
"-----Following fields required of all named devices, e.g., ones that open files-----") (
DIRECTORYNAMEP POINTER) (* \; "(host/dir) => true if directory exists on host") (OPENFILE POINTER) (* 
\; "(name access recog otherinfo device) => new stream open on this device, or NIL if name not found")
 (CLOSEFILE POINTER) (* \; "(stream) => closes stream, returns it") (REOPENFILE POINTER) (* \; 
"(name access recog otherinfo device stream) like openfile, but called after logout to revalidate file, so optionally uses info in old stream to keep this opening like the previous"
) (GETFILENAME POINTER) (* \; "(name recog device) => full file name") (DELETEFILE POINTER) (* \; 
"(name) => deletes file so named, returning name, or NIL on failure.  RECOG=OLDEST") (GENERATEFILES 
POINTER) (* \; 
"(device pattern) => generator object for files matching pattern.  Car of object is generator function, cdr is arbitrary state.  Generator fn returns next file, or NIL when finished"
) (RENAMEFILE POINTER) (* \; 
"(olddevice oldfile newdevice newfile) to rename file on this (olddevice) to a potentially different device."
) (OPENP POINTER) (* \; 
"(name access dev) => stream if name is open for access, or all open streams if name = NIL") (
REGISTERFILE POINTER) (* \; "(stream dev) => registers stream on its device") (UNREGISTERFILE POINTER)
 (* \; "(stream dev) => unregisters a stream from its device") (FREEPAGECOUNT POINTER) (* \; 
"(host/dir dev) => # of free pages on host/dir") (MAKEDIRECTORY POINTER) (* \; "(host/dir dev)") (
CHECKFILENAME POINTER) (* \; "(name dev) => name if it is well-formed file name for dev") (HOSTALIVEP 
POINTER) (* \; 
"(host dev) => true if host is alive, i.e., responsive;  only defined if REMOTEP is true") (
BREAKCONNECTION POINTER) (* \; "(host fastp dev) => closes connections to host") (* |;;| 
"-----The following are required methods for operating on open streams-----") (BIN POINTER) (* \; 
"(stream) => next byte of input") (BOUT POINTER) (* \; "(stream byte) output byte to stream") (PEEKBIN
 POINTER) (* \; "(stream) => next byte without advancing position in stream") (READCHAR POINTER) (* \;
 "(stream) => next input char") (WRITECHAR POINTER) (* \; "(stream char) => writes char to stream") (
PEEKCHAR POINTER) (UNREADCHAR POINTER) (READP POINTER) (* \; 
"(stream flag) => T if there is input available from stream right now") (EOFP POINTER) (* \; 
"(stream) => T if BIN would signal eof.") (BLOCKIN POINTER) (* \; "(stream buffer byteoffset nbytes)")
 (BLOCKOUT POINTER) (* \; "(stream buffer byteoffset nbytes)") (FORCEOUTPUT POINTER) (* \; 
"(stream waitForFinish) flushes out to device anything that is buffered awaiting transmission") (
GETFILEINFO POINTER) (* \; 
"(stream/name attribute device) => value of attribute for open stream or name of closed file") (
SETFILEINFO POINTER) (* \; 
"(stream/name attribute newvalue device) sets attribute of open stream or closed file of given name") 
(CHARSETFN POINTER) (* \; 
"(stream charset) => access function for the charset slot, for benefit of indirect streams.  See IMCHARSET for changing it on a file."
) (INPUTSTREAM POINTER) (* \; "(stream) => indirected input stream") (OUTPUTSTREAM POINTER) (* \; 
"(stream) => indirected output stream") (* |;;| 
"-----Following are required of random-access streams-----") (GETFILEPTR POINTER) (GETEOFPTR POINTER) 
(SETFILEPTR POINTER) (BACKFILEPTR POINTER) (* \; 
"(stream) backs up `fileptr' by one.  Stream is only required to be able to do this once, i.e.  one-character buffer suffices"
) (SETEOFPTR POINTER) (* \; "(stream length) => truncates or lengthens stream to indicated length") (
LASTC POINTER) (* \; "Should be possible only if RANDOMACCESSP") (* |;;| 
"-----Following used for buffered streams-----") (GETNEXTBUFFER POINTER) (* \; 
"(stream whatfor noerrorflg) => Disposes of current buffer and optionally reads next.  whatfor is READ or WRITE.  Can cause EOF error unless noerrorflg"
) (RELEASEBUFFER POINTER) (* \; "(stream) => Does whatever appropriate when CBUFPTR is released") (* 
|;;| "-----Following used for pagemapped streams-----") (READPAGES POINTER) (* \; 
"(stream firstpage# buflist) => # of bytes read, starting at firstpage#, reading into buflist, a list of buffers or a single buffer (the usual case)"
) (WRITEPAGES POINTER) (* \; 
"(stream firstpage# buflist) writes from buflist to stream starting at firstpage# of stream") (
TRUNCATEFILE POINTER) (* \; 
"(stream page offset) make stream's eof be at page,offset, discarding anything after it") (* |;;| 
"-----For window system, argh-----") (WINDOWOPS POINTER) (* \; "window system operations") (WINDOWDATA
 POINTER) (* \; "data for window systems") (* |;;| 
"-----For any stream (here to not recompile everything)-----") (READCHARCODE POINTER) (* \; 
"Read a character code from the stream (cf BIN for bytes).")) DIRECTORYNAMEP _ (FUNCTION NILL) 
HOSTNAMEP _ (FUNCTION NILL) READP _ (FUNCTION \\GENERIC.READP) SETFILEPTR _ (FUNCTION 
\\IS.NOT.RANDACCESSP) GETFILEPTR _ (FUNCTION \\ILLEGAL.DEVICEOP) GETEOFPTR _ (FUNCTION 
\\IS.NOT.RANDACCESSP) EOFP _ (FUNCTION \\ILLEGAL.DEVICEOP) BLOCKIN _ (FUNCTION \\GENERIC.BINS) 
BLOCKOUT _ (FUNCTION \\GENERIC.BOUTS) RENAMEFILE _ (FUNCTION \\GENERIC.RENAMEFILE) FORCEOUTPUT _ (
FUNCTION NILL) REGISTERFILE _ (FUNCTION NILL) OPENP _ (FUNCTION NILL) UNREGISTERFILE _ (FUNCTION NILL)
 READCHAR _ (FUNCTION \\GENERIC.READCHAR) WRITECHAR _ (FUNCTION \\GENERIC.WRITECHAR) PEEKCHAR _ (
FUNCTION \\GENERIC.PEEKCHAR) UNREADCHAR _ (FUNCTION \\GENERIC.UNREADCHAR) CHARSETFN _ (FUNCTION 
\\GENERIC.CHARSET) BREAKCONNECTION _ (FUNCTION NILL) READCHARCODE _ (FUNCTION \\GENERIC.READCCODE))
(RECORD FILEGENOBJ (NEXTFILEFN FILEINFOFN . GENFILESTATE))
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* \; 
"If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream.") (EOL 
BITS 2) (NIL BITS 1) (INCCODEFN POINTER) (* \; "Called with two arguments -- STREAM and COUNTP") (
PEEKCCODEFN POINTER) (* \; "Called with three arguments -- STREAM, NOERROR and COUNTP") (BACKCHARFN 
POINTER) (* \; "Called with two arguments -- STREAM and COUNTP") (FILEOUTCHARFN POINTER) (* \; 
"Called with two arguments -- STREAM and CHARCODE")) EOLVALID _ NIL)
(PUTPROPS \\OUTCHAR DMACRO (OPENLAMBDA (STREAM CHARCODE) (STREAMOP (QUOTE OUTCHARFN) STREAM STREAM 
CHARCODE)))
(PUTPROPS \\DEVICE-OPEN-STREAMS MACRO (ARGS (LET ((DEVICE (CAR ARGS))) (BQUOTE (FDEVOP (QUOTE OPENP) (
\\\, DEVICE) NIL NIL (\\\, DEVICE))))))
(PUTPROPS \\CONVERT-PATHNAME DMACRO (OPENLAMBDA (PATHNAME?) (* |;;| 
"Coerce pathnames to Interlisp strings, for the benefit of antediluvian Interlisp-D file fns") (
CL:TYPECASE PATHNAME? (PATHNAME (INTERLISP-NAMESTRING PATHNAME?)) (T PATHNAME?))))
(DEFOPTIMIZER ACCESS-CHARSET (STREAM &OPTIONAL NEWVALUE) (BQUOTE ((OPENLAMBDA (STRM) (FDEVOP (QUOTE 
CHARSETFN) (|fetch| (STREAM DEVICE) |of| STRM) STRM (\\\, NEWVALUE))) (\\\, STREAM))))
(PUTPROPS \\DECFILEPTR MACRO ((STREAM X) (\\INCFILEPTR STREAM (IMINUS X))))
(PUTPROPS \\GETFILEPTR MACRO (OPENLAMBDA (STRM) (FDEVOP (QUOTE GETFILEPTR) (|fetch| DEVICE |of| STRM) 
STRM)))
(PUTPROPS \\SIGNEDWIN MACRO ((STREAM) (SIGNED (\\WIN STREAM) BITSPERWORD)))
(PUTPROPS \\SIGNEDWOUT MACRO ((STREAM N) (\\WOUT STREAM (UNSIGNED N BITSPERWORD))))
(PUTPROPS \\WIN MACRO (OPENLAMBDA (STREAM) (|create| WORD HIBYTE _ (\\BIN STREAM) LOBYTE _ (\\BIN 
STREAM))))
(PUTPROPS \\WOUT MACRO (OPENLAMBDA (STREAM W) (\\BOUT STREAM (|fetch| HIBYTE |of| W)) (\\BOUT STREAM (
|fetch| LOBYTE |of| W))))
(PUTPROPS \\BINS BYTEMACRO (OPENLAMBDA (STRM BASE OFF NBYTES) (FDEVOP (QUOTE BLOCKIN) (|fetch| (STREAM
 DEVICE) |of| STRM) STRM BASE OFF NBYTES)))
(PUTPROPS \\BOUTS BYTEMACRO (OPENLAMBDA (STRM BASE OFF NBYTES) (FDEVOP (QUOTE BLOCKOUT) (|fetch| (
STREAM DEVICE) |of| STRM) STRM BASE OFF NBYTES)))
(PUTPROPS \\EOFP BYTEMACRO (OPENLAMBDA (STRM) (FDEVOP (QUOTE EOFP) (|fetch| (STREAM DEVICE) |of| STRM)
 STRM)))
(PUTPROPS SIZE.FROM.LENGTH MACRO (LAMBDA (LEN) (DECLARE (LOCALVARS LEN)) (AND LEN (FOLDHI LEN 
BYTESPERPAGE))))
(RPAQQ |BitsPerByte| 8)
(RPAQ |ByteOffsetSize| (SELECTQ (SYSTEMTYPE) (VAX 10) 9))
(RPAQQ |WordsPerPage| 256)
(CONSTANTS |BitsPerByte| (|ByteOffsetSize| (SELECTQ (SYSTEMTYPE) (VAX 10) 9)) |WordsPerPage|)
(RPAQ \\MAXFILEPTR (SUB1 (LLSH 1 30)))
(CONSTANTS (\\MAXFILEPTR (SUB1 (LLSH 1 30))))
(ACCESSFNS BYTEPTR ((PAGE (FOLDLO DATUM BYTESPERPAGE)) (OFFSET (MOD DATUM BYTESPERPAGE))) (TYPE? (AND 
(FIXP DATUM) (IGEQ DATUM 0) (ILEQ DATUM \\MAXFILEPTR))) (CREATE (IPLUS (UNFOLD PAGE BYTESPERPAGE) 
OFFSET)))
(PUTPROP (QUOTE FILEIO) (QUOTE IMPORTDATE) (IDATE "13-Aug-2020 11:43:08"))

(BLOCKRECORD FIXP ((HINUM WORD) (LONUM WORD)) (CREATE (CREATECELL \\FIXP)) (TYPE? (EQ (NTYPX DATUM) 
\\FIXP)))
(RPAQQ MAX.SMALL.INTEGER 65535)
(RPAQQ MAX.POS.HINUM 32767)
(CONSTANTS (MAX.SMALL.INTEGER 65535) (MAX.POS.HINUM 32767))
(PUTPROPS .UNBOX. MACRO (ARGS (LET ((ARG-FORM (CAR ARGS)) (HIGH-VAR (CADR ARGS)) (LOW-VAR (CADDR ARGS)
) (BIGNUM-FORM (CADDDR ARGS))) (BQUOTE (PROG NIL UBLP (SELECTC (NTYPX (\\\, ARG-FORM)) (\\FIXP (SETQ (
\\\, HIGH-VAR) (|ffetch| (FIXP HINUM) |of| (\\\, ARG-FORM))) (SETQ (\\\, LOW-VAR) (|ffetch| (FIXP 
LONUM) |of| (\\\, ARG-FORM)))) (\\SMALLP (COND ((ILEQ 0 (\\\, ARG-FORM)) (SETQ (\\\, HIGH-VAR) 0) (
SETQ (\\\, LOW-VAR) (\\\, ARG-FORM))) (T (SETQ (\\\, HIGH-VAR) 65535) (SETQ (\\\, LOW-VAR) (\\LOLOC (
\\\, ARG-FORM)))))) (\\FLOATP (SETQ (\\\, ARG-FORM) (\\FIXP.FROM.FLOATP (\\\, ARG-FORM))) (GO UBLP)) (
COND ((TYPENAMEP (\\\, ARG-FORM) (QUOTE RATIO)) (SETQ (\\\, ARG-FORM) (IQUOTIENT (CL::RATIO-NUMERATOR 
(\\\, ARG-FORM)) (CL::RATIO-DENOMINATOR (\\\, ARG-FORM)))) (GO UBLP)) (\\\,@ (COND (BIGNUM-FORM (
BQUOTE (((CL:INTEGERP (\\\, ARG-FORM)) (\\\, BIGNUM-FORM))))) (T (BQUOTE (((CL:INTEGERP (\\\, ARG-FORM
)) (\\ILLEGAL.ARG (\\\, ARG-FORM)))))))) (T (CL::%NOT-NONCOMPLEX-NUMBER-ERROR (\\\, ARG-FORM))))))))))
(PUTPROPS .NEGATE. MACRO ((HY LY) (COND ((EQ 0 LY) (AND (NEQ HY 0) (SETQ HY (ADD1 (IDIFFERENCE 
MAX.SMALL.INTEGER HY))))) (T (SETQ HY (IDIFFERENCE MAX.SMALL.INTEGER HY)) (SETQ LY (ADD1 (IDIFFERENCE 
MAX.SMALL.INTEGER LY)))))))
(PUTPROPS .LLSH1. MACRO ((HI LO) (* \; "shift the pair left one, assuming no overflow") (SETQ HI (LLSH
 HI 1)) (SETQ LO (LLSH (COND ((IGREATERP LO MAX.POS.HINUM) (|add| HI 1) (LOGAND LO MAX.POS.HINUM)) (T 
LO)) 1))))
(PUTPROPS .LRSH1. MACRO ((HI LO) (SETQ LO (LRSH LO 1)) (COND ((NEQ (LOGAND HI 1) 0) (SETQ LO (IPLUS LO
 \\SIGNBIT)))) (SETQ HI (LRSH HI 1))))
(PUTPROPS .BOXIPLUS. MACRO (OPENLAMBDA (X Y) (PROG ((HX (\\GETBASE X 0)) (LX (\\GETBASE X 1)) HY LY) (
.UNBOX. Y HY LY) (SETQ HX (COND ((IGREATERP HX (IDIFFERENCE MAX.SMALL.INTEGER HY)) (IDIFFERENCE HX (
ADD1 (IDIFFERENCE MAX.SMALL.INTEGER HY)))) (T (IPLUS HX HY)))) (* |Add| |high| |parts|) (\\PUTBASE X 1
 (COND ((IGREATERP LX (IDIFFERENCE MAX.SMALL.INTEGER LY)) (* |Carry| |into| |high| |part.|) (SETQ HX (
COND ((EQ HX MAX.SMALL.INTEGER) 0) (T (ADD1 HX)))) (IDIFFERENCE LX (ADD1 (IDIFFERENCE 
MAX.SMALL.INTEGER LY)))) (T (IPLUS LX LY)))) (\\PUTBASE X 0 HX) (RETURN X))))
(PUTPROPS |PutUnboxed| DMACRO (= . \\PUTFIXP))
(PUTPROP (QUOTE LLARITH) (QUOTE IMPORTDATE) (IDATE "16-May-1990 18:47:56"))

(PUTPROPS POLYEVAL DMACRO ((X COEFFS DEGREE) (* \; 
"execute the POLYEVAL opcode on the value X, the array COEFFS with degree DEGREE") (\\FLOATBOX ((
OPCODES UBFLOAT3 0) (\\FLOATUNBOX X) (|fetch| (ARRAYP BASE) |of| COEFFS) DEGREE))))
(BLOCKRECORD FLOATP ((SIGNBIT BITS 1) (EXPONENT BITS 8) (HIFRACTION BITS 7) (LOFRACTION BITS 16)) (
BLOCKRECORD FLOATP ((HIWORD WORD) (LOWORD WORD))) (BLOCKRECORD FLOATP ((NIL BITS 9) (LONGFRACTION BITS
 23))) (BLOCKRECORD FLOATP ((FLOATCONTENTS BITS 32))) (BLOCKRECORD FLOATP ((NIL BITS 1) (
HIWORDNOSIGNBIT BITS 15))) (CREATE (\\FLOATBOX (\\VAG2 (LOGOR (LLSH SIGNBIT (PLUS 7 8)) (LLSH EXPONENT
 7) HIFRACTION) LOFRACTION))) LOFRACTION _ 0 HIFRACTION _ 0 EXPONENT _ 0 SIGNBIT _ 0 (ACCESSFNS FLOATP
 ((EXP (LOGAND (LRSH (\\HILOC (\\FLOATUNBOX DATUM)) 7) 255)) (HIFRAC (LOGAND (\\HILOC (\\FLOATUNBOX 
DATUM)) 127)))))
(RPAQQ MAX.DIGITS.ACCURACY 9)
(CONSTANTS (MAX.DIGITS.ACCURACY 9))
(PUTPROPS \\CALLER.ARGS MACRO (X (LET ((ARGS (CAR X)) (FORMS (CDR X))) (BQUOTE (PROGN (\\SLOWRETURN) (
LET ((AL (\\MYALINK)) NEXT (\\\,@ (|for| VAR |in| ARGS |collect| (COND ((LISTP VAR) (LIST (CAR VAR) 0)
) (T VAR))))) (DECLARE (\\\,@ (|for| VAR |in| ARGS |when| (LISTP VAR) |collect| (BQUOTE (TYPE (\\\, (
SELECTQ (CADR VAR) ((FLOATING FLOATP) (CADR VAR)) (HELP))) (\\\, (CAR VAR))))))) (SETQ NEXT (|fetch| (
FX NEXTBLOCK) |of| AL)) (\\\,@ (|for| X |in| (REVERSE ARGS) |collect| (LET ((FORMS (BQUOTE (
\\.GETBASE32 \\STACKSPACE (SETQ NEXT (IDIFFERENCE NEXT WORDSPERCELL)))))) (COND ((LISTP X) (BQUOTE (
SETQ (\\\, (CAR X)) (\\FLOATBOX (\\\, FORMS))))) (T (BQUOTE (SETQ (\\\, X) (\\\, FORMS)))))))) (
\\MAKEFREEBLOCK NEXT (TIMES (\\\, (LENGTH ARGS)) WORDSPERCELL)) (|replace| (FX NEXTBLOCK) |of| AL 
|with| NEXT) (PROGN (\\\,@ FORMS))))))))
(PUTPROP (QUOTE LLFLOAT) (QUOTE IMPORTDATE) (IDATE "16-May-1990 19:26:51"))

(DEFOPTIMIZER FONTPROP (&REST ARGS) (SELECTQ (AND (EQ (CAADR ARGS) (QUOTE QUOTE)) (CADADR ARGS)) (
ASCENT (LIST (QUOTE FONTASCENT) (CAR ARGS))) (DESCENT (LIST (QUOTE FONTDESCENT) (CAR ARGS))) (HEIGHT (
LIST (QUOTE FONTHEIGHT) (CAR ARGS))) (QUOTE IGNOREMACRO)))
(DATATYPE FONTCLASS ((PRETTYFONT# BYTE) DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME))
(DATATYPE FONTDESCRIPTOR ((FONTDEVICE POINTER) (FONTFAMILY POINTER) (FONTSIZE POINTER) (FONTFACE 
POINTER) (|\\SFAscent| WORD) (|\\SFDescent| WORD) (|\\SFHeight| WORD) (ROTATION WORD) (FBBOX 
SIGNEDWORD) (FBBOY SIGNEDWORD) (FBBDX SIGNEDWORD) (FBBDY SIGNEDWORD) (|\\SFLKerns| POINTER) (
|\\SFRWidths| POINTER) (FONTDEVICESPEC POINTER) (* \; 
"Holds the spec by which the font is known to the printing device, if coercion has been done") (
OTHERDEVICEFONTPROPS POINTER) (* \; "For individual devices to hang special information") (FONTSCALE 
POINTER) (\\SFFACECODE BITS 8) (FONTAVGCHARWIDTH WORD) (* \; 
"Set in FONTCREATE, used to fix up the linelength when DSPFONT is called") (FONTIMAGEWIDTHS POINTER) (
* \; 
"This is the image width, as opposed to the advanced width;  initial hack for accents, kerning.  Fields is referenced by FONTCREATE."
) (FONTCHARSETVECTOR POINTER) (* \; 
"A 256-pointer block, with one pointer per 'character set' --each group of 256 character codes.  Each pointer is either NIL if there's no info for that charset, or is a CHARSETINFO, containing widths, char bitmap, etc for the characters in that charset."
) (FONTEXTRAFIELD2 POINTER)) FONTCHARSETVECTOR _ (\\CREATEFONTCHARSETVECTOR))
(RECORD FONTFACE (WEIGHT SLOPE EXPANSION) (ACCESSFNS ((COLOR (CDDDR DATUM) (RPLACD (CDDR DATUM) 
NEWVALUE)) (BACKCOLOR (COND ((CDDDR DATUM) (CAR (CDDDR DATUM)))) (PROGN (COND ((NULL (CDDDR DATUM)) (
RPLACD (CDDR DATUM) (LIST NIL NIL)))) (RPLACA (CDDDR DATUM) NEWVALUE))) (FORECOLOR (COND ((CDDDR DATUM
) (CADR (CDDDR DATUM)))) (PROGN (COND ((NULL (CDDDR DATUM)) (RPLACD (CDDR DATUM) (LIST NIL NIL)))) (
RPLACA (CDR (CDDDR DATUM)) NEWVALUE))))) WEIGHT _ (QUOTE MEDIUM) SLOPE _ (QUOTE REGULAR) EXPANSION _ (
QUOTE REGULAR) (TYPE? LISTP))
(DATATYPE CHARSETINFO (WIDTHS (* \; 
"The advance-width of each character, an array indexed by charcode.  Usually the same as the imagewidth, but can differ for accents, kerns kerns.  This is what should be used for stringwidth calculations."
) OFFSETS (* \; "Offset of each character into the image bitmap;  X value of left edge") IMAGEWIDTHS (
* \; "imagewidths is not automagically allocated since it is not always needed") CHARSETBITMAP (* \; 
"Bitmap containing the character images, indexed by OFFSETS") YWIDTHS (CHARSETASCENT WORD) (* \; 
"Max ascent for all characters in this CHARSET") (CHARSETDESCENT WORD) (* \; 
"Max descent for all characters in this CHARSET") LEFTKERN) WIDTHS _ (\\CREATECSINFOELEMENT) OFFSETS _
 (\\CREATECSINFOELEMENT))
(PUTPROPS FONTASCENT MACRO ((FONTSPEC) (|ffetch| |\\SFAscent| |of| (\\GETFONTDESC FONTSPEC))))
(PUTPROPS FONTDESCENT MACRO ((FONTSPEC) (|ffetch| |\\SFDescent| |of| (\\GETFONTDESC FONTSPEC))))
(PUTPROPS FONTHEIGHT MACRO ((FONTSPEC) (|ffetch| |\\SFHeight| |of| (\\GETFONTDESC FONTSPEC))))
(PUTPROPS \\FGETOFFSET DMACRO ((OFFSETSBLOCK CHAR8CODE) (\\GETBASE OFFSETSBLOCK CHAR8CODE)))
(PUTPROPS \\FSETOFFSET DMACRO ((OFFSETSBLOCK CHAR8CODE OFFSET) (\\PUTBASE OFFSETSBLOCK CHAR8CODE 
OFFSET)))
(PUTPROPS \\FGETWIDTH DMACRO ((WIDTHSBLOCK CHAR8CODE) (\\GETBASE WIDTHSBLOCK CHAR8CODE)))
(PUTPROPS \\FSETWIDTH DMACRO ((WIDTHSBLOCK INDEX WIDTH) (\\PUTBASE WIDTHSBLOCK INDEX WIDTH)))
(PUTPROPS \\FGETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE) (\\FGETWIDTH (|ffetch| (CHARSETINFO 
WIDTHS) |of| (\\GETCHARSETINFO (\\CHARSET CHARCODE) FONTDESC)) (\\CHAR8CODE CHARCODE))))
(PUTPROPS \\FSETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE WIDTH) (\\FSETWIDTH (|ffetch| (
CHARSETINFO WIDTHS) |of| (\\GETCHARSETINFO (\\CHARSET CHARCODE) FONTDESC)) (\\CHAR8CODE CHARCODE) 
WIDTH)))
(PUTPROPS \\FGETIMAGEWIDTH MACRO ((IMAGEWIDTHSBLOCK CHAR8CODE) (\\GETBASE IMAGEWIDTHSBLOCK CHAR8CODE))
)
(PUTPROPS \\FSETIMAGEWIDTH DMACRO ((WIDTHSBLOCK INDEX WIDTH) (\\PUTBASE WIDTHSBLOCK INDEX WIDTH)))
(PUTPROPS \\GETCHARSETINFO MACRO ((CHARSET FONTDESC NOSLUG?) (* |;;| 
"fetches the charsetinfo for charset CHARSET in fontdescriptor FONTDESC.  If NIL, then creates the required charset."
) (* |;;| 
"NOSLUG?  means don't create an empty (slug) csinfo if the charset is not found, just return NIL") (OR
 (\\GETBASEPTR (|ffetch| FONTCHARSETVECTOR |of| FONTDESC) (UNFOLD CHARSET 2)) (\\CREATECHARSET CHARSET
 FONTDESC NOSLUG?))))
(PUTPROPS \\CREATECSINFOELEMENT MACRO (NIL (\\ALLOCBLOCK (FOLDHI (IPLUS \\MAXTHINCHAR 3) WORDSPERCELL)
)))
(PUTPROPS \\CREATEFONTCHARSETVECTOR MACRO (NIL (* \; "Allocates a block for the character set records"
) (\\ALLOCBLOCK (ADD1 \\MAXCHARSET) T)))
(DEFMACRO \\CREATEKERNELEMENT NIL (BQUOTE (CL:MAKE-ARRAY (IPLUS \\MAXTHINCHAR 3) :ELEMENT-TYPE (QUOTE 
(SIGNED-BYTE 16)) :INITIAL-ELEMENT 0)))
(DEFMACRO \\FSETLEFTKERN (LEFTKERNBLOCK INDEX KERNVALUE) (BQUOTE (CL:SETF (CL:AREF (\\\, LEFTKERNBLOCK
) (\\\, INDEX)) (\\\, KERNVALUE))))
(DEFMACRO \\FGETLEFTKERN (LEFTKERNBLOCK CHAR8CODE) (BQUOTE (CL:AREF (\\\, LEFTKERNBLOCK) (\\\, 
CHAR8CODE))))
(RPAQQ \\MAXNSCHAR 65535)
(CONSTANTS (\\MAXNSCHAR 65535))
(PUTPROP (QUOTE FONT) (QUOTE IMPORTDATE) (IDATE " 9-Feb-2021 11:39:44"))

(BLOCKRECORD KEYACTION ((* |;;| 
"KEYACTION Table:  For interpreting keystrokes.  Stored as a 8-cell block of untyped pointer hunk storage."
) FLAGS (* \; 
"Flag byte per key# (one for down-transtion, 1 for up-.) to describe whether lockshifting occrrs, you ignore the transition, etc."
) CODES (* \; "Table of character codes generated by each key when no shift key is pressed.") 
SHIFTCODES (* \; "Table of character codes generated by each key when the shift key is pressed.") 
ARMED (* \; "Not sure...") INTERRUPTLIST (* \; "List of armed interrupts?") ALTGRAPHCODES (* \; 
"Table of codes to be generated when the ALT-GRAPH key is pressed.") DEADKEYLIST (* \; 
"Block of dead-key handlers, with the nominal up-transition fields filled by the shifted-case tables.  Each \"table\" is an ALIST of orignal code => accented code.  no entry means punt the accent.."
)) FLAGS _ (\\ALLOCBLOCK (FOLDHI (IPLUS \\NKEYS \\NKEYS) BYTESPERCELL)) CODES _ (\\ALLOCBLOCK (FOLDHI 
(PLUS \\NKEYS \\NKEYS) WORDSPERCELL)) SHIFTCODES _ (\\ALLOCBLOCK (FOLDHI (PLUS \\NKEYS \\NKEYS) 
WORDSPERCELL)) ARMED _ (\\ALLOCBLOCK (FOLDHI (ADD1 \\MAXTHINCHAR) BITSPERCELL)) ALTGRAPHCODES _ (
\\ALLOCBLOCK (FOLDHI (PLUS \\NKEYS \\NKEYS) WORDSPERCELL)) DEADKEYLIST _ (\\ALLOCBLOCK (PLUS \\NKEYS 
\\NKEYS \\NKEYS \\NKEYS) T) (CREATE (\\ALLOCBLOCK 7 PTRBLOCK.GCT)) (TYPE? (AND (\\BLOCKDATAP DATUM) (
IGEQ (\\#BLOCKDATACELLS DATUM) 5) (OR (NULL (FETCH (KEYACTION INTERRUPTLIST) OF DATUM)) (LISTP (FETCH 
INTERRUPTLIST OF DATUM))) (\\BLOCKDATAP (FETCH (KEYACTION FLAGS) DATUM)) (\\BLOCKDATAP (FETCH (
KEYACTION CODES) DATUM)) (\\BLOCKDATAP (FETCH (KEYACTION ARMED) DATUM)))))
(RPAQQ \\NKEYS 112)
(CONSTANTS \\NKEYS)
(DEFOPTIMIZER KEYDOWNP (KEYNAME) (BQUOTE (\\NEWKEYDOWNP (\\KEYNAMETONUMBER (\\\, KEYNAME)))))
(PUTPROPS XKEYDOWNP MACRO ((KEYNAME) (KEYDOWNP1 (\\KEYNAMETONUMBER KEYNAME))))
(PUTPROPS KEYDOWNP1 MACRO (OPENLAMBDA (KEYNUMBER) (DECLARE (GLOBALVARS \\EM.KBDAD0 \\EM.KBDAD1 
\\EM.KBDAD2 \\EM.KBDAD3 \\EM.UTILIN \\EM.KBDAD4 \\EM.KBDAD5)) (PROG NIL (RETURN (EQ 0 (LOGAND (LRSH (
LLSH 1 15) (PROGN (* (IMOD KEYNUMBER BITSPERWORD) - GETD |cause| IMOD |and| BITSPERWORD |not| 
|exported| |to| |user|) (LOGAND KEYNUMBER 15))) (\\GETBASE (SELECTQ (PROGN (* (FOLDLO KEYNUMBER 
BITSPERWORD) GETD |follows| |since| FOLDLO |and| BITSPERWORD |not| |exported| |to| |user|) (LRSH 
KEYNUMBER 4)) (0 \\EM.KBDAD0) (1 \\EM.KBDAD1) (2 \\EM.KBDAD2) (3 \\EM.KBDAD3) (4 \\EM.UTILIN) (5 (OR 
\\EM.KBDAD4 (RETURN))) (6 (OR \\EM.KBDAD5 (RETURN))) (RETURN)) 0)))))))
(PUTPROPS \\NEWKEYDOWNP MACRO ((KEYNUMBER) (EQ 0 (\\GETBASEBIT \\LASTKEYSTATE KEYNUMBER))))
(GLOBALVARS \\KEYBOARD.DEVICE \\KEYBOARD.STREAM)
(RPAQQ HARDCURSORHEIGHT 16)
(RPAQQ HARDCURSORWIDTH 16)
(CONSTANTS (HARDCURSORHEIGHT 16) (HARDCURSORWIDTH 16))
(ADDTOVAR GLOBALVARS LASTMOUSEX LASTMOUSEY LASTSCREEN LASTMOUSEBUTTONS LASTMOUSETIME LASTKEYBOARD)
(PUTPROPS \\SETMOUSEXY MACRO ((XPOS YPOS) (PROGN (SELECTC \\MACHINETYPE (\\DAYBREAK (
|\\DoveMisc.SetMousePosition| XPOS YPOS)) (\\MAIKO (SUBRCALL SETMOUSEXY XPOS YPOS)) (\\DANDELION (|do|
 (PROGN (|replace| (IOPAGE NEWMOUSEX) |of| \\IOPAGE |with| XPOS) (|replace| (IOPAGE NEWMOUSEY) |of| 
\\IOPAGE |with| YPOS)) |repeatuntil| (ILESSP (|fetch| (IOPAGE NEWMOUSESTATE) |of| \\IOPAGE) 32768)) (*
 \; "smash position until mouse says it is not busy") (|replace| (IOPAGE NEWMOUSEX) |of| \\IOPAGE 
|with| XPOS) (|replace| (IOPAGE NEWMOUSEY) |of| \\IOPAGE |with| YPOS) (|replace| (IOPAGE NEWMOUSESTATE
) |of| \\IOPAGE |with| 32768)) NIL) (PROGN (\\PUTBASE \\EM.MOUSEX 0 XPOS) (\\PUTBASE \\EM.MOUSEY 0 
YPOS)))))
(GLOBALVARS \\EM.MOUSEX \\EM.MOUSEY \\EM.CURSORX \\EM.CURSORY \\EM.UTILIN \\EM.REALUTILIN \\EM.KBDAD0 
\\EM.KBDAD1 \\EM.KBDAD2 \\EM.KBDAD3 \\EM.KBDAD4 \\EM.KBDAD5 \\EM.DISPINTERRUPT \\EM.DISPLAYHEAD 
\\EM.CURSORBITMAP \\MACHINETYPE \\DEFAULTKEYACTION \\COMMANDKEYACTION \\CURRENTKEYACTION 
\\PERIODIC.INTERRUPT \\PERIODIC.INTERRUPT.FREQUENCY)
(PUTPROP (QUOTE LLKEY) (QUOTE IMPORTDATE) (IDATE "13-Feb-2021 23:24:49"))

(DATATYPE PILOTBBT ((PBTDESTLO WORD) (PBTDESTHI WORD) (PBTDESTBIT WORD) (PBTDESTBPL SIGNEDWORD) (
PBTSOURCELO WORD) (PBTSOURCEHI WORD) (PBTSOURCEBIT WORD) (PBTSOURCEBPL SIGNEDWORD) (PBTWIDTH WORD) (
PBTHEIGHT WORD) (PBTFLAGS WORD) (NIL 5 WORD)) (BLOCKRECORD PILOTBBT ((NIL 7 WORD) (NIL BITS 4) (
PBTGRAYOFFSET BITS 4) (PBTGRAYWIDTHLESSONE BITS 4) (PBTGRAYHEIGHTLESSONE BITS 4) (NIL 2 WORD) (
PBTBACKWARD FLAG) (PBTDISJOINT FLAG) (PBTDISJOINTITEMS FLAG) (PBTUSEGRAY FLAG) (PBTSOURCETYPE BITS 1) 
(PBTOPERATION BITS 2) (NIL BITS 9))) (ACCESSFNS PILOTBBT ((PBTSOURCE (\\VAG2 (|fetch| PBTSOURCEHI |of|
 DATUM) (|fetch| PBTSOURCELO |of| DATUM)) (PROGN (|replace| PBTSOURCEHI |of| DATUM |with| (\\HILOC 
NEWVALUE)) (|replace| PBTSOURCELO |of| DATUM |with| (\\LOLOC NEWVALUE)))) (PBTDEST (\\VAG2 (|fetch| 
PBTDESTHI |of| DATUM) (|fetch| PBTDESTLO |of| DATUM)) (PROGN (|replace| PBTDESTHI |of| DATUM |with| (
\\HILOC NEWVALUE)) (|replace| PBTDESTLO |of| DATUM |with| (\\LOLOC NEWVALUE)))))) (SYSTEM))
(DATATYPE \\DISPLAYDATA (DDXPOSITION DDYPOSITION DDXOFFSET DDYOFFSET |DDDestination| 
|DDClippingRegion| DDFONT |DDSlowPrintingCase| DDWIDTHSCACHE DDOFFSETSCACHE DDCOLOR DDLINEFEED 
|DDRightMargin| |DDLeftMargin| |DDScroll| DDOPERATION DDSOURCETYPE (|DDClippingLeft| WORD) (
|DDClippingRight| WORD) (|DDClippingBottom| WORD) (|DDClippingTop| WORD) (NIL WORD) (DDHELDFLG FLAG) (
XWINDOWHINT XPOINTER) (DDPILOTBBT POINTER) DDXSCALE DDYSCALE DDCHARIMAGEWIDTHS DDEOLFN DDPAGEFULLFN 
|DDTexture| DDMICAXPOS DDMICAYPOS DDMICARIGHTMARGIN DDCHARSET (DDCHARSETASCENT WORD) (DDCHARSETDESCENT
 WORD) DDCHARHEIGHTDELTA (DDSPACEWIDTH WORD)) DDPILOTBBT _ (|create| PILOTBBT PBTDISJOINT _ T) 
|DDLeftMargin| _ 0 |DDRightMargin| _ SCREENWIDTH DDXPOSITION _ 0 DDYPOSITION _ 0 DDXOFFSET _ 0 
DDYOFFSET _ 0 |DDClippingRegion| _ (|create| REGION) |DDDestination| _ |ScreenBitMap| DDXSCALE _ 1 
DDYSCALE _ 1 |DDTexture| _ 0 (ACCESSFNS ((DDFOREGROUNDCOLOR (PROG ((VAL (|fetch| (\\DISPLAYDATA 
DDCOLOR) |of| DATUM))) (OR (FIXP VAL) (BITMAPP VAL) (AND (NULL VAL) 1) (CAR VAL) (MAXIMUMCOLOR (
BITSPERPIXEL (|fetch| (\\DISPLAYDATA |DDDestination|) |of| DATUM)))))) (DDBACKGROUNDCOLOR (OR (|fetch|
 (\\DISPLAYDATA |DDTexture|) |of| DATUM) 0)))) (SYSTEM))
(RECORD DISPLAYSTATE (ONOFF))
(RECORD DISPLAYINFO (DITYPE DIWIDTH DIHEIGHT DIBITSPERPIXEL DIWSOPS))
(PUTPROPS \\GETDISPLAYDATA MACRO (ARGS (COND ((CADR ARGS) (SUBPAIR (QUOTE (STRM STRMVAR)) ARGS (QUOTE 
(\\DTEST (|fetch| (STREAM IMAGEDATA) |of| (SETQ STRMVAR (\\OUTSTREAMARG STRM))) (QUOTE \\DISPLAYDATA))
))) (T (SUBST (CAR ARGS) (QUOTE STRM) (QUOTE (\\DTEST (|fetch| (STREAM IMAGEDATA) |of| (\\OUTSTREAMARG
 STRM)) (QUOTE \\DISPLAYDATA))))))))
(PUTPROPS \\BITMASK MACRO ((N) (\\WORDELT BITMASKARRAY (LOGAND N 15))))
(PUTPROPS \\4BITMASK MACRO ((N) (\\WORDELT 4BITMASKARRAY (LOGAND N 3))))
(PUTPROPS \\NOTBITMASK MACRO ((N) (DECLARE (GLOBALVARS NOTBITMASKARRAY)) (\\WORDELT NOTBITMASKARRAY (
LOGAND N 15))))
(PUTPROPS \\NOT4BITMASK MACRO ((N) (\\WORDELT NOT4BITMASKARRAY (LOGAND N 3))))
(GLOBALVARS BITMASKARRAY NOTBITMASKARRAY 4BITMASKARRAY NOT4BITMASKARRAY)
(RPAQQ WORDMASK 65535)
(CONSTANTS (WORDMASK 65535))
(PUTPROPS \\INVALIDATEDISPLAYCACHE MACRO ((DISPLAYDATA) (* |This| |marks| |the| |character-printing| 
|caches| |of| |the| |displaystream| |as| |invalid.| |Needed| |when| |the| |font| |or| Y |position| 
|changes|) (|freplace| (\\DISPLAYDATA DDCHARSET) |of| DISPLAYDATA |with| MAX.SMALLP) (|freplace| (
\\DISPLAYDATA DDCHARSETASCENT) |of| DISPLAYDATA |with| MAX.SMALLP)))
(PUTPROPS \\DSPGETCHARWIDTH MACRO ((CHARCODE DD) (\\FGETWIDTH (|ffetch| (\\DISPLAYDATA DDWIDTHSCACHE) 
|of| DD) CHARCODE)))
(PUTPROPS \\DSPGETCHARIMAGEWIDTH MACRO ((CHARCODE DD) (\\FGETIMAGEWIDTH (|ffetch| (\\DISPLAYDATA 
DDCHARIMAGEWIDTHS) |of| DD) CHARCODE)))
(PUTPROPS \\DSPGETCHAROFFSET MACRO ((CHARCODE DD) (\\GETBASE (|ffetch| (\\DISPLAYDATA DDOFFSETSCACHE) 
|of| DD) CHARCODE)))
(PUTPROPS \\CONVERTOP MACRO ((OP) (* |rrb| "14-NOV-80 11:14") (* |Only| |for| |alto| |bitblt| !!) (
SELECTQ OP (|replace| 0 |of| NIL |with| NIL) (PAINT 1) (INVERT 2) (ERASE 3) 0)))
(PUTPROPS |\\SFInvert| MACRO ((|BitMap| \y) (* |corrects| |for| |the| |fact| |that| |alto| |bitmaps| 
|are| |stored| |with| 0\,0 |as| |upper| |left| |while| |lisp| |bitmaps| |have| 0\,0 |as| |lower| 
|left.| |The| |correction| |is| |actually| |off| |by| |one| (|greater|) |because| \a |majority| |of| 
|the| |places| |that| |it| |is| |called| |actually| |need| |one| |more| |than| |corrected| Y |value.|)
 (IDIFFERENCE (|fetch| (BITMAP BITMAPHEIGHT) |of| |BitMap|) \y)))
(PUTPROPS |\\SFReplicate| MACRO (LAMBDA (|pattern|) (LOGOR |pattern| (LLSH |pattern| 8) (SETQ 
|pattern| (LLSH |pattern| 4)) (LLSH |pattern| 8))))
(PUTPROPS \\SETPBTFUNCTION MACRO (OPENLAMBDA (BBT |SourceType| |Operation|) (PROGN (|replace| (
PILOTBBT PBTOPERATION) |of| BBT |with| (SELECTQ |Operation| (ERASE 1) (PAINT 2) (INVERT 3) 0)) (
|replace| (PILOTBBT PBTSOURCETYPE) |of| BBT |with| (COND ((EQ (EQ |SourceType| (QUOTE INVERT)) (EQ 
|Operation| (QUOTE ERASE))) 0) (T 1))))))
(PUTPROPS \\BITBLT1 MACRO ((|bbt|) (|BitBltSUBR| |bbt|)))
(PUTPROP (QUOTE BITBLT) (QUOTE MACRO) (QUOTE (= . BKBITBLT)))
(PROGN (PUTPROPS \\INSURETOPWDS DMACRO (OPENLAMBDA (DS) (OR (EQ DS \\TOPWDS) (COND ((FMEMB (
DSPDESTINATION NIL DS) \\SCREENBITMAPS) (\\TOTOPWDS DS)))))) (PUTPROPS \\INSURETOPWDS MACRO ((DS) (* 
|For| |non-window| |implementations|) (PROGN))))
(PUTPROPS .WHILE.TOP.DS. MACRO ((FIRST . REST) (PROG (DISPINTERRUPT SOFTCURSORUP) (* FIRST |should| 
|be| \a |displaystream| |and| \a |variable.| |This| |macro| |may| |also| |take| \a |soft| |cursor| 
|down,| |similar| |to| |the| |way| .WHILE.CURSOR.DOWN. |does,| |but| |only| |if| |FIRST's| 
|destination| |is| |the| |same| |as| |the| |soft| |cursor's| |destination.| *) (COND (\\SOFTCURSORP (
SETQ SOFTCURSORUP (AND \\SOFTCURSORUPP (EQ (DSPDESTINATION NIL FIRST) \\CURSORDESTINATION))) (COND (
SOFTCURSORUP (SETQ DISPINTERRUPT (\\GETBASE \\EM.DISPINTERRUPT 0)) (\\PUTBASE \\EM.DISPINTERRUPT 0 0) 
(\\SOFTCURSORDOWN))))) (\\INSURETOPWDS FIRST) (PROGN . REST) (COND (SOFTCURSORUP (
\\SOFTCURSORUPCURRENT) (\\PUTBASE \\EM.DISPINTERRUPT 0 DISPINTERRUPT))))))
(PUTPROPS .WHILE.CURSOR.DOWN. MACRO ((FIRST . REST) (PROG (DISPINTERRUPT SOFTCURSORUP) (* |This| 
|macro| |should| |wrap| |around| |any| |code| |that| |draws| |or| |bitblts| |directly| |from| |or| 
|to| \a |screen| |bitmap.| E.\g. DRAWGRAYBOX |in| HLDISPLAY |which| |puts| |up| \a |shadow| |box| 
|during| GETREGION. |The| |purpose| |of| |this| |macro| |is| |that| \a |soft| (|e.g.| |color|) 
|cursor's| |bits| |not| |be| |taken| |to| |be| |screen| |bits| |while| FIRST & REST |are| |done.| *) (
COND (\\SOFTCURSORP (SETQ SOFTCURSORUP \\SOFTCURSORUPP) (COND (SOFTCURSORUP (SETQ DISPINTERRUPT (
\\GETBASE \\EM.DISPINTERRUPT 0)) (\\PUTBASE \\EM.DISPINTERRUPT 0 0) (\\SOFTCURSORDOWN))))) (PROGN 
FIRST . REST) (COND (SOFTCURSORUP (\\SOFTCURSORUPCURRENT) (\\PUTBASE \\EM.DISPINTERRUPT 0 
DISPINTERRUPT))))))
(ADDTOVAR GLOBALVARS \\TOPWDS)
(DEFOPTIMIZER TTYDISPLAYSTREAM (&REST X) (COND ((NULL (CAR X)) (QUOTE \\TERM.OFD)) (T (QUOTE 
IGNOREMACRO))))
(GLOBALVARS BELLCNT BELLRATE TTYBACKGROUNDFNS |\\DisplayStoppedForLogout| \\CARET.UP)
(PUTPROPS \\CHECKCARET MACRO ((X) (AND \\CARET.UP (\\CARET.DOWN X))))
(PUTPROPS \\DSPTRANSFORMX MACRO ((X DD) (* |transforms| |an| \x |coordinate| |into| |the| 
|destination| |coordinate.|) (IPLUS X (|fetch| (\\DISPLAYDATA DDXOFFSET) |of| DD))))
(PUTPROPS \\DSPTRANSFORMY MACRO ((Y DD) (* |transforms| |an| \y |coordinate| |into| |the| 
|destination| |coordinate.|) (IPLUS Y (|fetch| (\\DISPLAYDATA DDYOFFSET) |of| DD))))
(PUTPROPS \\OFFSETBOTTOM MACRO ((X) (* |gives| |the| |destination| |coordinate| |address| |of| |the| 
|origin.|) (|fetch| (\\DISPLAYDATA DDYOFFSET) |of| X)))
(PUTPROPS \\OFFSETLEFT MACRO ((DD) (* |returns| |the| \x |origin| |of| |display| |data| |destination| 
|coordinates.|) (|fetch| (\\DISPLAYDATA DDXOFFSET) |of| DD)))
(PUTPROPS DISPLAYINITIALIZEDP MACRO (NIL (* |always| |initialized| |now|) T))
(PUTPROPS DISPLAYSTARTEDP MACRO (NIL |\\DisplayStarted|))
(GLOBALVARS |\\DisplayStarted| |\\DisplayStreamsInitialized| |\\DisplayInitialed| WHOLEDISPLAY 
WHOLESCREEN SCREENWIDTH SCREENHEIGHT)
(PUTPROP (QUOTE LLDISPLAY) (QUOTE IMPORTDATE) (IDATE "18-Apr-1994 00:20:42"))

(RECORD REGION (LEFT BOTTOM WIDTH HEIGHT) LEFT _ -16383 BOTTOM _ -16383 WIDTH _ 32767 HEIGHT _ 32767 (
ACCESSFNS ((TOP (IPLUS (|fetch| (REGION BOTTOM) |of| DATUM) (|fetch| (REGION HEIGHT) |of| DATUM) -1)) 
(PTOP (IPLUS (|fetch| (REGION BOTTOM) |of| DATUM) (|fetch| (REGION HEIGHT) |of| DATUM))) (RIGHT (IPLUS
 (|fetch| (REGION LEFT) |of| DATUM) (|fetch| (REGION WIDTH) |of| DATUM) -1)) (PRIGHT (IPLUS (|fetch| (
REGION LEFT) |of| DATUM) (|fetch| (REGION WIDTH) |of| DATUM))))) (TYPE? (AND (EQLENGTH DATUM 4) (EVERY
 DATUM (FUNCTION NUMBERP)))) (SYSTEM))
(DATATYPE BITMAP ((BITMAPBASE POINTER) (BITMAPRASTERWIDTH WORD) (BITMAPHEIGHT WORD) (BITMAPWIDTH WORD)
 (BITMAPBITSPERPIXEL WORD)) BITMAPBITSPERPIXEL _ 1 (BLOCKRECORD BITMAP ((|BitMapHiLoc| WORD) (
|BitMapLoLoc| WORD)) (* \; "overlay initial pointer")) (SYSTEM))
(BLOCKRECORD BITMAPWORD ((BITS WORD)) (SYSTEM))
(RECORD POSITION (XCOORD . YCOORD) (TYPE? (AND (LISTP DATUM) (NUMBERP (CAR DATUM)) (NUMBERP (CDR DATUM
)))) (SYSTEM))
(DATATYPE CURSOR (CUIMAGE CUMASK CUHOTSPOTX CUHOTSPOTY CUDATA) (ACCESSFNS ((CUBITSPERPIXEL (|fetch| (
BITMAP BITMAPBITSPERPIXEL) |of| (|fetch| (CURSOR CUIMAGE) |of| DATUM))))) (SYSTEM))
(RECORD MOUSEEVENT (MOUSEX MOUSEY MOUSEBUTTONS KEYBOARD MOUSETIME) (SYSTEM))
(RECORD SCREENREGION (SCREEN . REGION) (SUBRECORD REGION) (TYPE? (AND (LISTP DATUM) (|type?| SCREEN (
CAR DATUM)) (|type?| REGION (CDR DATUM)))) (SYSTEM))
(RECORD SCREENPOSITION (SCREEN . POSITION) (SUBRECORD POSITION) (TYPE? (AND (LISTP DATUM) (|type?| 
SCREEN (CAR DATUM)) (|type?| POSITION (CDR DATUM)))) (SYSTEM))
(PUTPROPS CURSORBITMAP MACRO (NIL |CursorBitMap|))
(RPAQQ HARDCURSORHEIGHT 16)
(RPAQQ HARDCURSORWIDTH 16)
(CONSTANTS (HARDCURSORHEIGHT 16) (HARDCURSORWIDTH 16))
(ADDTOVAR GLOBALVARS |CursorBitMap|)
(ARRAYRECORD POLYNOMIAL (A B C D) (CREATE (ARRAY 4 (QUOTE FLOATP))) (SYSTEM))
(RECORD SPLINE (\#KNOTS SPLINEX SPLINEY SPLINEDX SPLINEDY SPLINEDDX SPLINEDDY SPLINEDDDX SPLINEDDDY))
(PUTPROPS HALF MACRO ((X) (LRSH X 1)))
(PUTPROPS \\FILLCIRCLEBLT MACRO (OPENLAMBDA (CX CY X Y) (* \; 
"calls bitblt twice to fill in one line of the circle.") (\\LINEBLT FCBBT (IDIFFERENCE CX X) (IPLUS CY
 Y) (IPLUS CX X) DESTINATIONBASE RASTERWIDTH LEFT RIGHT BOTTOM TOP GRAYWIDTH GRAYHEIGHT GRAYBASE NBITS
) (\\LINEBLT FCBBT (IDIFFERENCE CX X) (IDIFFERENCE CY Y) (IPLUS CX X) DESTINATIONBASE RASTERWIDTH LEFT
 RIGHT BOTTOM TOP GRAYWIDTH GRAYHEIGHT GRAYBASE NBITS)))
(PUTDEF (QUOTE BITMAPS) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO (X (VARS . X))))))
(PUTDEF (QUOTE CURSORS) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO (X (E (MAPC (QUOTE X) (QUOTE 
PRINTCURSOR))))))))
(ADDTOVAR GLOBALVARS SCREENHEIGHT SCREENWIDTH |ScreenBitMap|)
(RPAQQ BLACKSHADE 65535)
(RPAQQ WHITESHADE 0)
(CONSTANTS (BLACKSHADE 65535) (WHITESHADE 0))
(RPAQQ GRAYSHADE 43605)
(ADDTOVAR GLOBALVARS GRAYSHADE)
(RECORD HLS (HUE LIGHTNESS SATURATION))
(RECORD RGB (RED GREEN BLUE))
(PUTPROP (QUOTE ADISPLAY) (QUOTE IMPORTDATE) (IDATE "15-Sep-1994 17:07:04"))

(ADDTOVAR SYSSPECVARS \\INTERRUPTABLE)
(PUTPROPS UNINTERRUPTABLY INFO EVAL)
(PUTPROPS UNINTERRUPTABLY DMACRO ((X . Y) ((LAMBDA (\\INTERRUPTABLE) (PROGN X . Y)) NIL)))
(ADDTOVAR PRETTYPRINTMACROS (UNINTERRUPTABLY LAMBDA (FORM) (PROG ((POS (IPLUS 4 (POSITION)))) (PRIN1 
"(") (PRIN2 (CAR FORM)) (OR (EQ COMMENTFLG (CAAR (SETQ FORM (CDR FORM)))) (TAB POS 0)) (PRINTDEF FORM 
POS T T FNSLST) (PRIN1 ")"))))
(BLOCKRECORD INTERRUPTSTATE ((* |;;| 
"This is the structure used to communicate between the emulator and Lisp re interrupts.  There is a bit per interrupt type, plus space for the character code that caused a keyboard interrupt."
) (* |;;| "This must match the INTSTAT definition in lispemul.h") (* |;;| "PENDING-INTERRUPT FLAGS:") 
(LOGMSGSPENDING FLAG) (* \; " Log/Console msgs need printing.") (ETHERINTERRUPT FLAG) (* \; 
"Ether packet read finished.") (IOINTERRUPT FLAG) (GCDISABLED FLAG) (* \; "No mroe room in GC tables."
) (VMEMFULL FLAG) (* \; "VMEM is full!!") (STACKOVERFLOW FLAG) (* \; "Stack overflowed.") (STORAGEFULL
 FLAG) (* \; "Ran out of storage, atoms, etc.") (WAITINGINTERRUPT FLAG) (* |;;| 
"INTERRUPTS-IN-PROCESS MASK:") (P-LOGMSGSPENDING FLAG) (* \; " Log/Console msgs need printing.") (
P-ETHERINTERRUPT FLAG) (* \; "Ether packet read finished.") (P-IOINTERRUPT FLAG) (P-GCDISABLED FLAG) (
* \; "No mroe room in GC tables.") (P-VMEMFULL FLAG) (* \; "VMEM is full!!") (P-STACKOVERFLOW FLAG) (*
 \; "Stack overflowed.") (P-STORAGEFULL FLAG) (* \; "Ran out of storage, atoms, etc.") (
P-WAITINGINTERRUPT FLAG) (INTCHARCODE WORD)) (BLOCKRECORD INTERRUPTSTATE ((* |;;| 
"Alternative view of the structure:") (PENDING BITS 8) (* \; "Pending-interrupt flags") (IN-PROGRESS 
BITS 8) (* \; "Mask to prevent re-interrupt for an interrupt in progress") (NIL WORD))))
(PUTPROPS \\TAKEINTERRUPT DMACRO ((PREFORM POSTFORM) (DECLARE (GLOBALVARS \\PENDINGINTERRUPT)) (COND (
(AND \\PENDINGINTERRUPT (INTERRUPTABLE~=NILUPTHESTACK)) PREFORM ((LAMBDA (\\INTERRUPTABLE) (
\\CALLINTERRUPTED)) T) POSTFORM))))
(PUTPROP (QUOTE AINTERRUPT) (QUOTE IMPORTDATE) (IDATE "17-Sep-1992 10:42:38"))

(PUTPROPS UNLESSRDSYS MACRO ((NORMAL RDSYS) NORMAL))
(PUTPROPS UNLESSINEW MACRO ((NORMAL I-NEW) NORMAL))
(PUTPROPS 1ST MACRO ((A . B) A))
(PUTPROPS 2ND MACRO ((A B . C) B))
(PUTPROPS LOCAL MACRO ((X) X))
(PUTPROPS ALLOCAL MACRO ((X) X))
(PUTPROPS ADDBASE DMACRO (= . \\ADDBASE))
(PUTPROPS GETBASE DMACRO (= . \\GETBASE))
(PUTPROPS GETBASEBYTE DMACRO (= . \\GETBASEBYTE))
(PUTPROPS GETBASEPTR DMACRO (= . \\GETBASEPTR))
(PUTPROPS HILOC DMACRO (= . \\HILOC))
(PUTPROPS LOLOC DMACRO (= . \\LOLOC))
(PUTPROPS PUTBASE DMACRO (= . \\PUTBASE))
(PUTPROPS PUTBASEBYTE DMACRO (= . \\PUTBASEBYTE))
(PUTPROPS PUTBASEPTR DMACRO (= . \\PUTBASEPTR))
(PUTPROPS REPLACEPTRFIELD DMACRO (= . \\RPLPTR))
(PUTPROPS VAG2 DMACRO (= . \\VAG2))
(PUTPROPS PAGEBASE MACRO ((PTR) (|fetch| (POINTER PAGEBASE) |of| PTR)))
(PUTPROPS PAGELOC MACRO (OPENLAMBDA (PTR) (IPLUS (LLSH (\\HILOC PTR) 8) (LRSH (\\LOLOC PTR) 8))))
(PUTPROP (QUOTE RENAMEMACROS) (QUOTE IMPORTDATE) (IDATE "27-Apr-1994 15:43:27"))

(PUTPROPS MOUSESTATE MACRO (ARGS (LIST (QUOTE PROGN) (QUOTE (GETMOUSESTATE)) (MOUSESTATE-EXPR (CAR 
ARGS) T))))
(PUTPROPS LASTMOUSESTATE MACRO (ARGS (MOUSESTATE-EXPR (CAR ARGS) T)))
(PUTPROPS UNTILMOUSESTATE MACRO (ARGS (COND ((AND (CDR ARGS) (CADR ARGS) (NEQ (CADR ARGS) T)) (* 
|time| |argument| |is| |given| |and| |is| |not| T |or| NIL\; |compile| |in| |time| |keeping| |loop.|) 
(LIST (QUOTE PROG) (LIST (LIST (QUOTE TIMEOUT) (LIST (QUOTE IPLUS) (QUOTE (CLOCK 0)) (LIST (QUOTE OR) 
(LIST (QUOTE NUMBERP) (CADR ARGS)) 100))) (QUOTE (NOWTIME (CLOCK 0)))) (QUOTE LP) (LIST (QUOTE COND) (
LIST (CONS (QUOTE MOUSESTATE) (LIST (CAR ARGS) T)) (QUOTE (RETURN T)))) (QUOTE (COND ((IGREATERP (
CLOCK0 NOWTIME) TIMEOUT) (RETURN NIL)) (T (\\BACKGROUND)))) (QUOTE (GO LP)))) (T (LIST (QUOTE PROG) 
NIL (QUOTE LP) (LIST (QUOTE COND) (LIST (CONS (QUOTE MOUSESTATE) (LIST (CAR ARGS) T)) (QUOTE (RETURN T
)))) (QUOTE (\\BACKGROUND)) (QUOTE (GO LP)))))))
(PUTPROPS KEYSETSTATE MACRO (ARGS (LIST (QUOTE PROGN) (QUOTE (GETMOUSESTATE)) (MOUSESTATE-EXPR (CAR 
ARGS)))))
(PUTPROPS LASTKEYSETSTATE MACRO (ARGS (MOUSESTATE-EXPR (CAR ARGS))))
(PUTPROPS WITHIN MACRO ((A B C) (AND (IGEQ A B) (ILESSP A (IPLUS B C)))))
(ADDTOVAR GLOBALVARS LASTMOUSEX LASTMOUSEY LASTMOUSEBUTTONS)
(PUTPROPS IABS MACRO (OPENLAMBDA (A) (COND ((IGEQ A 0) A) (T (IMINUS A)))))
(PUTPROP (QUOTE HLDISPLAY) (QUOTE IMPORTDATE) (IDATE "15-Mar-1994 10:48:02"))

(PUTPROPS .COPYKEYDOWNP. MACRO (NIL (OR (KEYDOWNP (QUOTE LSHIFT)) (KEYDOWNP (QUOTE RSHIFT)) (KEYDOWNP 
(QUOTE COPY)))))
(PUTPROPS WSOP MACRO (ARGS (LET ((METHOD (CADR (CAR ARGS))) (DISPLAY (CADR ARGS)) (OTHERARGS (CDDR 
ARGS))) (BQUOTE (SPREADAPPLY* (|fetch| (WSOPS (\\\, METHOD)) |of| (|fetch| (FDEV WINDOWOPS) |of| (\\\,
 DISPLAY))) (\\\, DISPLAY) (\\\,@ OTHERARGS))))))
(PUTPROPS \\COERCETODS MACRO (OPENLAMBDA (X) (COND ((|type?| WINDOW X) (|fetch| (WINDOW DSP) |of| X)) 
(T (\\ILLEGAL.ARG X)))))
(PUTPROPS .WHILE.ON.TOP. MACRO ((FIRST . REST) (UNINTERRUPTABLY (\\INTERNALTOTOPW FIRST) . REST)))
(PUTPROPS WINDOWOP DMACRO (ARGS (LET ((OPNAME (CAR ARGS)) (METHOD-DEVICE (CADR ARGS)) (TAIL (CDDR ARGS
))) (COND ((AND (LISTP OPNAME) (EQ (CAR OPNAME) (QUOTE QUOTE))) (BQUOTE (SPREADAPPLY* (|fetch| (SCREEN
 (\\\, (CADR OPNAME))) |of| (\\\, METHOD-DEVICE)) (\\\, METHOD-DEVICE) (\\\,@ TAIL)))) (T (ERROR 
"OPNAME not quoted: " OPNAME))))))
(RPAQQ |MinWindowWidth| 26)
(RPAQQ |MinWindowHeight| 16)
(CONSTANTS (|MinWindowWidth| 26) (|MinWindowHeight| 16))
(DATATYPE WINDOW (DSP (* \; "The display stream you use to actually printto the window.") NEXTW (* \; 
"Next window in the open-window list") SAVE (* \; "Saved image from anything this window's on top of")
 REG (* \; "Screen region this window occupies") BUTTONEVENTFN (* \; 
"FN called when left/middle mouse button goes up/down") RIGHTBUTTONFN (* \; 
"FN called when right mouse button goes up/down") CURSORINFN (* \; 
"Fn called when mouse enters window") CURSOROUTFN (* \; "Called when mouse leaves window") 
CURSORMOVEDFN (* \; "Called when mouse moves in window") REPAINTFN (* \; 
"Redisplay part of thie window") RESHAPEFN (* \; "Called when window is reshaped") EXTENT (* \; 
"Scrolling limits") USERDATA (* \; "Proplist to hold other window properites") VERTSCROLLREG (* \; 
"Region of vert scroll bar") HORIZSCROLLREG (* \; "Tegion of horiz scroll bar") SCROLLFN (* \; 
"Fn to scroll this window") VERTSCROLLWINDOW (* \; "Vert scroll bar") HORIZSCROLLWINDOW (* \; 
"Horiz scroll bar") CLOSEFN (* \; "Called at close time") MOVEFN (* \; "Called when window is moved") 
WTITLE (* \; "Window's title string, if any") NEWREGIONFN (* \; "Called to get new window shape") 
WBORDER (* \; "Window border-width, in pixels") PROCESS (* \; 
"Medley process associated with this window") WINDOWENTRYFN (* \; 
"Fn to call when kbd focus is switched here") SCREEN (* \; "Screen this window appears on") (
NATIVE-HANDLE FIXP) (* \; 
"Uniterpreted place for native window to store a C pointer to its private info") (NATIVE-INFO1 FIXP) (
* \; "Reserved in case the pointer must be 64 bits") (NATIVE-W1 WORD) (* \; 
"Word for use by native handler") (NATIVE-W2 WORD) (* \; "Word for use by native handler") (NATIVE-P1 
POINTER) (* \; "Lisp pointer for use by native handler")) BUTTONEVENTFN _ (FUNCTION TOTOPW) WBORDER _ 
|WBorder| WINDOWENTRYFN _ (FUNCTION GIVE.TTY.PROCESS) (SYSTEM))
(DATATYPE SCREEN (SCONOFF SCDESTINATION SCWIDTH SCHEIGHT SCTOPW SCTOPWDS SCTITLEDS SCFDEV SCDS SCDATA 
(* |;;| "Space for native window manager interface to use.") (HANDLE FIXP) (* \; 
"Handle for emulator to store info about display for C code use.") (HANDLE2 FIXP) (* \; 
"Reserved in case HANDLE needs to be 64 bits on the C side.") (NATIVE-INFO POINTER) (* \; 
"POINTER for the private use of the emulator window code") NATIVETYPE (* \; 
"Symbol to tell what kind of native window system we're using.") (* |;;| 
"- - - Functional interface to screen management - - -") WINIMAGEOPS (* \; 
"IMAGEOPS to be used in display streas on this kind of screen") WINFDEV (* \; 
"FDEV for display streams on this screen") CREATEWFN (* \; "Create a window") OPENWFN (* \; 
"Open a window") CLOSEWFN (* \; "Close a window") MOVEWFN (* \; "Move a window") RELMOVEWFN (* \; 
"Move window, relative") SHRINKWFN (* \; "Shrink window to icon") EXPANDWFN (* \; 
"Expand icon to window") SHAPEWFN (* \; "Reshape a window") REDISPLAYFN (* \; 
"Redisplay (part of) a window") GETWINDOWPROPFN (* \; "Get window property value") PUTWINDOWPROPFN (* 
\; "Set window property value") BURYWFN (* \; "Move window behind all others") TOTOPWFN (* \; 
"Move iwindow in front of all others") IMPORTWFN (* \; 
"Take a native window and save its state internally") EXPORTWFN (* \; 
"Take a saved window state and open it on this screen, filling in screen and methods as needed.") 
DESTROYFN (* \; "Destroy this window, for GC finaliszation") SETCURSORFN (* \; 
"Set the cursor for this window.") PROMPTW (* \; "The prompt window for this screen") SHOWGCFN (* \; 
"Show GC indication; called with ON/OFF arg, t=>show gcing status, NIL=>turn off GC indicator.") 
DSPCREATEFN (* \; "Create a displaystream on this screen.") BBTTOWIN (* \; 
"BITBLT from a lisp bitmap to a window") BBTFROMWIN (* \; "BITBLT from a window to a lisp bitmap") 
BBTWINWIN (* \; "BITBLT from a window to another window.") SCCURSOR (* \; 
"CURSOR that's in effect for this screen by default.") SCKEYBOARD (* \; 
"Something about which keyboard we're receiving from.") SCDEPTH (* \; 
"# of bits per pixel on the screen.  THIS WILL REPLACE SCBITSPERPIXEL ASAP.") SCCLOSEDOWN (* \; 
"Close down this screen cleanly, saving window state.") SCCLOSESCREEN (* \; 
"Close down thie screen cleanly, no state saving.") SCREOPEN (* \; "Reopen this screen?") SCCARETFLASH
 (* \; "Function to flash thecaret.") SCGETSCREENPOSITION (* \; "GETSCREENPOSITION") 
SCGETBOXSCREENPOSITION (* \; "GETBOXPOSITION") SCGETSCREENREGION (* \; "GETREGION") SCMOVEPOINTER (* 
\; "\\CURSORPOSITION")) SCONOFF _ (QUOTE OFF) (ACCESSFNS ((SCBITSPERPIXEL (COND ((|fetch| (SCREEN 
SCDESTINATION) |of| DATUM) (|fetch| (BITMAP BITMAPBITSPERPIXEL) |of| (|fetch| (SCREEN SCDESTINATION) 
|of| DATUM))) (T 1))) (SCREGION (|create| REGION LEFT _ 0 BOTTOM _ 0 WIDTH _ (|fetch| (SCREEN SCWIDTH)
 |of| DATUM) HEIGHT _ (|fetch| (SCREEN SCHEIGHT) |of| DATUM))))) (SYSTEM))
(GLOBALVARS WINDOWUSERFORMS ENDOFWINDOWUSERFORMS PROMPTWINDOW)
(PUTPROP (QUOTE WINDOW) (QUOTE IMPORTDATE) (IDATE " 9-Apr-2000 17:36:29"))

(PUTPROPS NNLITATOM MACRO (OPENLAMBDA (X) (AND X (LITATOM X))))
(PUTPROPS \\NULL.OR.FIXP MACRO (OPENLAMBDA (X) (OR (NULL X) (FIXP X))))
(PUTPROPS \\CHECKTYPE MACRO (X (PROG ((VAR (CAR X)) (PRED (CADR X))) (|if| (AND (LISTP PRED) (MEMB (
CAR PRED) (QUOTE (QUOTE FUNCTION)))) |then| (SETQ PRED (LIST (CADR PRED) VAR))) (RETURN (SUBPAIR (
QUOTE (MSG VAR PRED)) (LIST (CONCAT "
 is not a suitable value for the variable:  " VAR) VAR PRED) (QUOTE (|until| PRED |do| (SETQ VAR (
ERROR VAR MSG)))))))))
(PUTPROPS CANONICAL.TIMERUNITS MACRO (OPENLAMBDA (X) (* |Checks| |for| |common| |abbreviations| 
|before| |calling| |\\CanonicalizeTimerUnits|) (SELECTQ X ((TICKS MILLISECONDS SECONDS) (* |These| 
|are| |the| |canonical| |forms|) X) (NIL (QUOTE MILLISECONDS)) (|\\CanonicalizeTimerUnits| X))))
(PUTPROPS \\MACRO.EVAL DMACRO (Z (PROG ((X (EXPANDMACRO (CAR Z) T))) (|if| (EQ X (CAR Z)) |then| (
ERROR "No macro property -- \\MACRO.EVAL" X) |else| (RETURN (EVAL X))))))
(DEFOPTIMIZER \\MACRO.MX (FORM) FORM)
(PUTPROP (QUOTE MACROAUX) (QUOTE IMPORTDATE) (IDATE "16-May-1990 20:26:31"))

(RPAQQ MASK0WORD1\'S 32767)
(RPAQQ MASK1WORD0\'S 32768)
(RPAQQ MASKWORD1\'S 65535)
(RPAQQ MASKHALFWORD1\'S 255)
(RPAQQ BITSPERHALFWORD 8)
(CONSTANTS MASK0WORD1\'S MASK1WORD0\'S MASKWORD1\'S MASKHALFWORD1\'S BITSPERHALFWORD)
(PUTPROPS EQZEROP MACRO ((X) (EQ 0 X)))
(PUTPROPS \\MOVETOBOX DMACRO (OPENLAMBDA (N D) (SELECTC (NTYPX N) (\\SMALLP (|replace| (FIXP HINUM) 
|of| D |with| 0) (|replace| (FIXP LONUM) |of| D |with| N)) (\\FIXP (|replace| (FIXP HINUM) |of| D 
|with| (|fetch| (FIXP HINUM) |of| N)) (|replace| (FIXP LONUM) |of| D |with| (|fetch| (FIXP LONUM) |of|
 N))) (\\ILLEGAL.ARG N))))
(PUTPROPS .XUNBOX. MACRO ((X HX LX) (|until| (SETQ LX (SELECTC (NTYPX X) (\\SMALLP (COND ((IGEQ X 0) (
SETQ HX 0) X) (T (SETQ HX MASKWORD1\'S) (\\LOLOC X)))) (\\FIXP (SETQ HX (|fetch| (FIXP HINUM) |of| X))
 (|fetch| (FIXP LONUM) |of| X)) NIL)) |do| (SETQ X (LISPERROR "ILLEGAL ARG" X T)))))
(PUTPROPS .XLLSH. MACRO ((HI LO N) (|if| (IGEQ N BITSPERWORD) |then| (* \; 
"Jump 16 bits in a single bound!") (SETQ HI LO) (SETQ LO 0) (SETQ N (IDIFFERENCE N BITSPERWORD))) (
|if| (IGEQ N BITSPERHALFWORD) |then| (* \; "Jump 8 bits in a single bound!") (SETQ HI (LOGOR (
.LOHALFWORDHI. HI) (.HIHALFWORDLO. LO))) (SETQ LO (.LOHALFWORDHI. LO)) (SETQ N (IDIFFERENCE N 
BITSPERHALFWORD))) (|if| (IGEQ N 4) |then| (* \; "Jump 4 bits in a single bound!") (SETQ HI (LOGOR (
LRSH LO (CONSTANT (IDIFFERENCE BITSPERWORD 4))) (LLSH (LOGAND HI (CONSTANT (MASK.1\'S 0 (IDIFFERENCE 
BITSPERWORD 4)))) 4))) (SETQ LO (LLSH (LOGAND LO (CONSTANT (MASK.1\'S 0 (IDIFFERENCE BITSPERWORD 4))))
 4)) (SETQ N (IDIFFERENCE N 4))) (* \; 
"MASK0WORD1'S should be same as (SUB1 (LSH 1 (SUB1 BITSPERWORD)))") (FRPTQ N (SETQ HI (LLSH (LOGAND HI
 MASK0WORD1\'S) 1)) (SETQ LO (LLSH (|if| (IGEQ LO MASK1WORD0\'S) |then| (|add| HI 1) (LOGAND LO 
MASK0WORD1\'S) |else| LO) 1)))))
(PUTPROPS .XLLSH1. MACRO ((HI LO) (SETQ HI (LLSH (LOGAND HI MASK0WORD1\'S) 1)) (SETQ LO (LSH (COND ((
IGEQ LO MASK1WORD0\'S) (SETQ HI (LOGOR HI 1)) (LOGAND LO MASK0WORD1\'S)) (T LO)) 1))))
(PUTPROPS .XLRSH. MACRO ((HI LO N) (|if| (IGEQ N BITSPERWORD) |then| (* \; 
"Jump 10 bits in a single bound!") (SETQ LO HI) (SETQ HI 0) (SETQ N (IDIFFERENCE N BITSPERWORD))) (
|if| (IGEQ N BITSPERHALFWORD) |then| (* \; "Jump 8 bits in a single bound!") (SETQ LO (LOGOR (
.HIHALFWORDLO. LO) (.LOHALFWORDHI. HI))) (SETQ HI (.HIHALFWORDLO. HI)) (SETQ N (IDIFFERENCE N 
BITSPERHALFWORD))) (|if| (IGEQ N 4) |then| (* \; "Jump 4 bits in a single bound!") (SETQ LO (LOGOR (
LLSH (LOGAND HI (CONSTANT (MASK.1\'S 0 4))) (CONSTANT (IDIFFERENCE BITSPERWORD 4))) (LRSH LO 4))) (
SETQ HI (LRSH HI 4)) (SETQ N (IDIFFERENCE N 4))) (* \; "MASK1WORD0'S should be same as \\SIGNBIT") (
FRPTQ N (SETQ LO (|if| (ODDP HI) |then| (LOGOR (LRSH LO 1) MASK1WORD0\'S) |else| (LRSH LO 1))) (SETQ 
HI (LRSH HI 1)))))
(PUTPROPS .ADD.2WORD.INTEGERS. MACRO ((HX LX HY LY) (* \; "Ignores carry out of high-order word") (
SETQ HX (.SUMSMALLMOD. HX HY)) (SETQ LX (.SUMSMALLMOD. LX LY (SETQ HX (|if| (EQ HX MAX.SMALL.INTEGER) 
|then| 0 |else| (ADD1 HX)))))))
(PUTPROPS .SUB.2WORD.INTEGERS. MACRO ((HX LX HY LY) (* \; "Ignores carry out of high-order word") (
SETQ HX (.DIFFERENCESMALLMOD. HX HY)) (SETQ LX (.DIFFERENCESMALLMOD. LX LY (SETQ HX (|if| (EQ HX 0) 
|then| MAX.SMALL.INTEGER |else| (SUB1 HX)))))))
(PUTPROPS .32BITMUL. MACRO ((HR LR X Y) (PROG (HX LX HY LY) (|if| (ILESSP X Y) |then| (|swap| X Y)) (*
 \; "Y is the lesser of the two now") (.XUNBOX. X HX LX) (.XUNBOX. Y HY LY) LP (|if| (ODDP LY) |then| 
(.ADD.2WORD.INTEGERS. HR LR HX LX)) (|if| (EQ HY 0) |then| (SETQ LY (LRSH LY 1)) (|if| (EQ LY 0) 
|then| (RETURN)) |else| (.LRSH1. HY LY)) (* \; 
"Trim off highest bits, so that left-shifting doesn't generate FIXPs") (SETQ HX (LOGAND HX 
MASK0WORD1\'S)) (.LLSH1. HX LX) (GO LP))))
(PUTPROPS .SUMSMALLMOD. MACRO ((X Y OVERFLOWFORM) ((LAMBDA (|\\SumSmallModVar|) (DECLARE (LOCALVARS 
|\\SumSmallModVar|)) (IF (ILEQ X |\\SumSmallModVar|) THEN (IPLUS X Y) ELSE OVERFLOWFORM (IDIFFERENCE X
 (ADD1 |\\SumSmallModVar|)))) (IDIFFERENCE MAX.SMALL.INTEGER Y))))
(PUTPROPS .DIFFERENCESMALLMOD. MACRO ((X Y BORROWFORM) (IF (NOT (IGREATERP Y X)) THEN (IDIFFERENCE X Y
) ELSE BORROWFORM (ADD1 (IDIFFERENCE MAX.SMALL.INTEGER (IDIFFERENCE Y X))))))
(PUTPROPS \\GETBASENIBBLE DMACRO (OPENLAMBDA (BASE OFFST) ((LAMBDA (|\\Byte|) (DECLARE (LOCALVARS 
|\\Byte|)) (|if| (ODDP OFFST) |then| (LOGAND |\\Byte| (CONSTANT (MASK.1\'S 0 BITSPERNIBBLE))) |else| (
LRSH |\\Byte| BITSPERNIBBLE))) (\\GETBASEBYTE BASE (FOLDLO OFFST NIBBLESPERBYTE)))))
(PUTPROPS \\PUTBASENIBBLE DMACRO (OPENLAMBDA (BASE OFFST VAL) ((LAMBDA (|\\ByteNo|) (DECLARE (
LOCALVARS |\\ByteNo|)) ((LAMBDA (|\\Byte|) (DECLARE (LOCALVARS |\\Byte|)) (\\PUTBASEBYTE BASE 
|\\ByteNo| (|if| (ODDP OFFST) |then| (LOGOR (LOGAND |\\Byte| (CONSTANT (MASK.1\'S BITSPERNIBBLE 
BITSPERNIBBLE))) VAL) |else| (LOGOR (LOGAND |\\Byte| (CONSTANT (MASK.1\'S 0 BITSPERNIBBLE))) (LLSH VAL
 BITSPERNIBBLE))))) (\\GETBASEBYTE BASE |\\ByteNo|))) (FOLDLO OFFST NIBBLESPERBYTE))))
(PUTPROPS \\GETBASEBIT DMACRO (OPENLAMBDA (BASE OFFST) ((LAMBDA (|\\ByteNo| |\\BitMask|) (DECLARE (
LOCALVARS |\\ByteNo| |\\BitMask|)) (|if| (EQ 0 (LOGAND |\\BitMask| (\\GETBASEBYTE BASE |\\ByteNo|))) 
|then| 0 |else| 1)) (FOLDLO OFFST BITSPERBYTE) (MASK.1\'S (IDIFFERENCE (CONSTANT (SUB1 BITSPERBYTE)) (
IMOD OFFST BITSPERBYTE)) 1))))
(PUTPROPS \\PUTBASEBIT DMACRO (OPENLAMBDA (BASE OFFST VAL) ((LAMBDA (|\\ByteNo| |\\BitMask| |\\Byte|) 
(DECLARE (LOCALVARS |\\ByteNo| |\\BitMask| |\\Byte|)) (SETQ |\\Byte| (\\GETBASEBYTE BASE |\\ByteNo|)) 
(|if| (|if| (EQ 0 (LOGAND |\\BitMask| |\\Byte|)) |then| (NOT (EQ 0 VAL)) |else| (EQ 0 VAL)) |then| (
\\PUTBASEBYTE BASE |\\ByteNo| (LOGXOR |\\BitMask| |\\Byte|))) VAL) (FOLDLO OFFST BITSPERBYTE) (
MASK.1\'S (IDIFFERENCE (CONSTANT (SUB1 BITSPERBYTE)) (IMOD OFFST BITSPERBYTE)) 1))))
(PUTPROP (QUOTE ADDARITH) (QUOTE IMPORTDATE) (IDATE "16-May-1990 11:46:37"))

(RPAQQ \\MAXFILEPAGE 65534)
(CONSTANTS \\MAXFILEPAGE)
(PUTPROP (QUOTE LLFAULT) (QUOTE IMPORTDATE) (IDATE "10-Feb-2021 22:44:43"))

(PUTPROPS \\UPDATETIMERS MACRO (NIL (* * |Moves| |excess| |time| |from| |the| |processor| |clock| |to|
 |our| |software| |clocks.| |Needs| |to| |be| |run| |often,| |uninterruptably,| |preferably| |from| 
|the| |vertical| |retrace| |interrupt|) (* |Get| |processor| |clock|) (PROG ((EXCESS (\\BOXIDIFFERENCE
 (\\RCLK (LOCF (|fetch| RCLKTEMP0 |of| \\MISCSTATS))) (LOCF (|fetch| BASECLOCK |of| \\MISCSTATS))))) (
RETURN (COND ((OR (IGEQ EXCESS \\RCLKSECOND) (ILESSP EXCESS 0)) (* |More| |than| |one| |second| |has| 
|elapsed| |since| |we| |updated| |clocks|) (\\BOXIPLUS (LOCF (|fetch| BASECLOCK |of| \\MISCSTATS)) 
\\RCLKSECOND) (* |Increment| |base| |by| |one| |second|) (\\BOXIPLUS (LOCF (|fetch| MILLISECONDSCLOCK 
|of| \\MISCSTATS)) 1000) (* |Increment| |clocks| |by| 1 |second|) (\\BOXIPLUS (LOCF (|fetch| 
SECONDSCLOCK |of| \\MISCSTATS)) 1) T))))))
(RPAQQ \\RTCSECONDS 378)
(RPAQQ \\RTCMILLISECONDS 380)
(RPAQQ \\RTCBASE 382)
(RPAQQ \\OFFSET.SECONDS 0)
(RPAQQ \\OFFSET.MILLISECONDS 2)
(RPAQQ \\OFFSET.BASE 4)
(RPAQQ \\ALTO.RCLKSECOND 1680000)
(RPAQQ \\ALTO.RCLKMILLISECOND 1680)
(RPAQQ \\DLION.RCLKMILLISECOND 35)
(RPAQQ \\DLION.RCLKSECOND 34746)
(RPAQQ \\DOVE.RCLKMILLISECOND 63)
(RPAQQ \\DOVE.RCLKSECOND 62500)
(CONSTANTS (\\RTCSECONDS 378) (\\RTCMILLISECONDS 380) (\\RTCBASE 382) (\\OFFSET.SECONDS 0) (
\\OFFSET.MILLISECONDS 2) (\\OFFSET.BASE 4) (\\ALTO.RCLKSECOND 1680000) (\\ALTO.RCLKMILLISECOND 1680) (
\\DLION.RCLKMILLISECOND 35) (\\DLION.RCLKSECOND 34746) (\\DOVE.RCLKMILLISECOND 63) (\\DOVE.RCLKSECOND 
62500))
(PUTPROPS ALTO.TO.LISP.DATE MACRO ((DATE) (LOGXOR DATE -2147483648)))
(PUTPROPS LISP.TO.ALTO.DATE MACRO ((DATE) (LOGXOR DATE -2147483648)))
(PUTPROP (QUOTE LLTIMER) (QUOTE IMPORTDATE) (IDATE "16-May-1990 20:13:11"))

(RECORD BRUSH (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR) BRUSHSHAPE _ (QUOTE ROUND) BRUSHSIZE _ 1)
(PUTPROPS IMAGEOP MACRO (ARGS (CONS (QUOTE SPREADAPPLY*) (CONS (COND ((EQ (CAR (LISTP (CAR ARGS))) (
QUOTE QUOTE)) (LIST (QUOTE |fetch|) (LIST (QUOTE IMAGEOPS) (CADAR ARGS)) (QUOTE |of|) (LIST (QUOTE 
|fetch|) (QUOTE (STREAM IMAGEOPS)) (QUOTE |of|) (CADR ARGS)))) (T (HELP "IMAGEOP - OPNAME not quoted:"
 ARGS))) (CDDR ARGS)))))
(DATATYPE IMAGEOPS (IMAGETYPE IMCLOSEFN IMXPOSITION IMYPOSITION IMFONT IMLEFTMARGIN IMRIGHTMARGIN 
IMLINEFEED IMDRAWLINE IMDRAWCURVE IMDRAWCIRCLE IMDRAWELLIPSE IMFILLCIRCLE IMBLTSHADE IMBITBLT 
IMNEWPAGE IMMOVETO IMSCALE IMTERPRI IMTOPMARGIN IMBOTTOMMARGIN IMSPACEFACTOR IMFONTCREATE IMOPERATION 
IMCOLOR IMSTRINGWIDTH IMCHARWIDTH IMCHARWIDTHY IMBACKCOLOR IMBITMAPSIZE IMCLIPPINGREGION IMRESET 
IMDRAWPOLYGON IMFILLPOLYGON IMSCALEDBITBLT IMWRITEPIXEL IMCHARSET IMROTATE IMDRAWARC IMTRANSLATE 
IMSCALE2 IMPUSHSTATE IMPOPSTATE IMDEFAULTSTATE IMDRAWPOINT IMBLTCHAR IMXOFFSET IMYOFFSET) IMCLOSEFN _ 
(FUNCTION NILL) IMTERPRI _ (FUNCTION (LAMBDA (STREAM) (\\OUTCHAR STREAM (CHARCODE EOL)))) IMNEWPAGE _ 
(FUNCTION (LAMBDA (STREAM) (\\OUTCHAR STREAM (CHARCODE ^L)))) IMOPERATION _ (FUNCTION NILL) IMCOLOR _ 
(FUNCTION NILL) IMCLIPPINGREGION _ (FUNCTION NILL) IMRESET _ (FUNCTION NILL) IMBACKCOLOR _ (FUNCTION 
NILL) IMSTRINGWIDTH _ (FUNCTION (LAMBDA (STREAM STR RDTBL) (STRINGWIDTH STR (DSPFONT NIL STREAM) RDTBL
 RDTBL))) IMCHARWIDTH _ (FUNCTION (LAMBDA (STREAM CHARCODE) (CHARWIDTH CHARCODE (DSPFONT NIL STREAM)))
) IMMOVETO _ (FUNCTION (LAMBDA (STREAM X Y) (IMAGEOP (QUOTE IMXPOSITION) STREAM STREAM X) (IMAGEOP (
QUOTE IMYPOSITION) STREAM STREAM Y))) IMBITMAPSIZE _ (FUNCTION (LAMBDA (STREAM BITMAP DIMENSION) (
SELECTQ DIMENSION (WIDTH (TIMES (DSPSCALE NIL STREAM) (BITMAPWIDTH BITMAP))) (HEIGHT (TIMES (DSPSCALE 
NIL STREAM) (BITMAPHEIGHT BITMAP))) (NIL (CONS (TIMES (DSPSCALE NIL STREAM) (BITMAPWIDTH BITMAP)) (
TIMES (DSPSCALE NIL STREAM) (BITMAPHEIGHT BITMAP)))) (\\ILLEGAL.ARG DIMENSION)))) IMWRITEPIXEL _ (
FUNCTION NILL) IMCHARSET _ (FUNCTION NILL) IMXPOSITION _ (FUNCTION NILL) IMYPOSITION _ (FUNCTION NILL)
 IMFONT _ (FUNCTION NILL) IMLEFTMARGIN _ (FUNCTION NILL) IMRIGHTMARGIN _ (FUNCTION NILL) IMLINEFEED _ 
(FUNCTION NILL) IMDRAWLINE _ (FUNCTION NILL) IMDRAWCURVE _ (FUNCTION NILL) IMDRAWCIRCLE _ (FUNCTION 
NILL) IMDRAWELLIPSE _ (FUNCTION NILL) IMFILLCIRCLE _ (FUNCTION NILL) IMBLTSHADE _ (FUNCTION NILL) 
IMBITBLT _ (FUNCTION NILL) IMSCALE _ (FUNCTION NILL) IMTOPMARGIN _ (FUNCTION NILL) IMBOTTOMMARGIN _ (
FUNCTION NILL) IMSPACEFACTOR _ (FUNCTION NILL) IMFONTCREATE _ (FUNCTION NILL) IMCHARWIDTHY _ (FUNCTION
 NILL) IMDRAWPOLYGON _ (FUNCTION \\DRAWPOLYGON.GENERIC) IMDRAWPOINT _ (FUNCTION \\DRAWPOINT.GENERIC) 
IMFILLPOLYGON _ (FUNCTION NILL) IMSCALEDBITBLT _ (FUNCTION NILL) IMROTATE _ (FUNCTION NILL) IMDRAWARC 
_ (FUNCTION NILL) IMTRANSLATE _ (FUNCTION NILL) IMPUSHSTATE _ (FUNCTION NILL) IMPOPSTATE _ (FUNCTION 
NILL) IMSCALE2 _ (FUNCTION NILL) IMDEFAULTSTATE _ (FUNCTION NILL) IMBLTCHAR _ (FUNCTION \\MEDW.BLTCHAR
) IMXOFFSET _ (FUNCTION \\MEDW.XOFFSET) IMYOFFSET _ (FUNCTION \\MEDW.YOFFSET))
(GLOBALVARS \\NOIMAGEOPS)
(PUTPROP (QUOTE IMAGEIO) (QUOTE IMPORTDATE) (IDATE "28-Jun-1999 16:33:59"))

(DATATYPE PROCESS ((PROCFX0 WORD) (* \; "= \\STACKHI to make this look like a STACKP") (PROCFX WORD) (
* \; "Stack pointer to this context when it is asleep") (PROCSTATUS BYTE) (* \; "Running or waiting") 
(PROCNAME POINTER) (* \; "Name for convenience in type-in reference") (PROCPRIORITY BYTE) (* \; 
"Priority level, 0-4.  Not currently used.") (PROCQUEUE POINTER) (* \; 
"Queue of processes at the same priority") (NIL BYTE) (NEXTPROCHANDLE POINTER) (* \; 
"Pointer to next one") (PROCTIMERSET FLAG) (* \; "True if PROCWAKEUPTIMER has an interesting value") (
PROCBEINGDELETED FLAG) (* \; "True if proc was deleted, but hasn't been removed from \\PROCESSES yet")
 (PROCDELETED FLAG) (PROCSYSTEMP FLAG) (PROCNEVERSTARTED FLAG) (NIL FLAG) (NIL FLAG) (NIL FLAG) (
PROCWAKEUPTIMER POINTER) (* \; "a largep recording the time this proc last went to sleep") (
PROCTIMERLINK POINTER) (* \; "For linking proc in timer queue") (PROCTIMERBOX POINTER) (* \; 
"Scratch box to use for PROCWAKEUPTIMER when user does not give one explicitly") (WAKEREASON POINTER) 
(* \; "Reason process is being run.  From WAKE.PROCESS or timer or event wakeup;  T from simple BLOCK"
) (PROCEVENTORLOCK POINTER) (* \; "EVENT or MONITOR lock that this proc is waiting for") (PROCFORM 
POINTER) (* \; "Form to EVAL to start it going") (RESTARTABLE POINTER) (* \; 
"T = autorestart on error, HARDRESET = restart only on hard reset, NIL = never restart") (PROCWINDOW 
POINTER) (* \; "Window this process lives in, if any") (PROCFINISHED POINTER) (* \; 
"True if proc finished.  Value is indication of how: NORMAL, DELETED, ERROR") (PROCRESULT POINTER) (* 
\; "Value it returned if it finished normally") (PROCFINISHEVENT POINTER) (* \; 
"Optional EVENT to be notified when proc finishes") (PROCMAILBOX POINTER) (* \; "Message queue") (
PROCDRIBBLEOUTPUT POINTER) (* \; "Binding for *DRIBBLE-OUTPUT* in this process") (PROCINFOHOOK POINTER
) (* \; "Optional user fn that displays info about process") (PROCTYPEAHEAD POINTER) (* \; 
"Buffer of typeahead destined for this proc") (PROCREMOTEINFO POINTER) (* \; "For Enterprise") (
PROCUSERDATA POINTER) (* \; "For PROCESSPROP") (PROCEVENTLINK POINTER) (* \; 
"Used to maintain EVENT queues") (PROCAFTEREXIT POINTER) (* \; 
"What to do with this process when coming back from a LOGOUT, etc") (PROCBEFOREEXIT POINTER) (* \; 
"If DON'T, can't logout") (PROCOWNEDLOCKS POINTER) (* \; "Pointer to first lock I currently own") (
PROCEVAPPLYRESULT POINTER) (* \; "For PROCESS.EVAL and PROCESS.APPLY when WAITFORRESULT is true") (
PROCTTYENTRYFN POINTER) (* \; "Is applied to a process when it becomes the tty process") (
PROCTTYEXITFN POINTER) (* \; "Is applied to a process when it ceases to be the tty process") (
PROCHARDRESETINFO POINTER) (* \; "HARDRESET stores info about unwind-protect cleanups here") (
PROCRESTARTFORM POINTER) (* \; "use this instead of PROCFORM when restarting") (PROCOLDTTYPROC POINTER
) (* \; "Process that had the tty when we got it") (NIL POINTER) (* \; "For expansion")) PROCTIMERBOX 
_ (CREATECELL \\FIXP) PROCFX0 _ \\STACKHI)
(PUTPROPS THIS.PROCESS MACRO (NIL \\RUNNING.PROCESS))
(PUTPROPS TTY.PROCESS MACRO (X (COND ((CAR X) (QUOTE IGNOREMACRO)) (T (QUOTE \\TTY.PROCESS)))))
(PUTPROPS TTY.PROCESSP MACRO (X (COND ((CAR X) (QUOTE IGNOREMACRO)) (T (QUOTE (OR (NULL (THIS.PROCESS)
) (EQ (THIS.PROCESS) (TTY.PROCESS))))))))
(GLOBALVARS \\RUNNING.PROCESS \\TTY.PROCESS \\PROC.RESTARTME \\PROC.RESETME \\PROC.ABORTME)
(PUTPROP (QUOTE PROC) (QUOTE IMPORTDATE) (IDATE "17-Jun-1999 21:58:52"))

(PUTPROPS \\BACKCHAR MACRO (OPENLAMBDA (STREAM) (* \; "Backs up over an NS character") (\\BACKNSCHAR 
STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256))))
(PUTPROPS \\BACKNSCHAR MACRO ((ST SHIFTEDCHARSET COUNTERVAR) (COND ((\\XCCSP ST) (\\BACKXCCSCHAR ST 
SHIFTEDCHARSET COUNTERVAR)) (T (COND ((QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR (
CL:FUNCALL (|ffetch| (STREAM BACKCHARFN) |of| ST) ST T)))) (T (CL:FUNCALL (|ffetch| (STREAM BACKCHARFN
) |of| ST) ST NIL)))))))
(PUTPROPS \\CHECKEOLC MACRO (OPENLAMBDA (CH EOLC STREAM PEEKBINFLG COUNTERVAR) (* |;;| 
"Subtracts number of bytes read from COUNTERVAR, which may be NIL.  In fact, should be NIL if PEEKBINFLG is T."
) (SELCHARQ CH (CR (SELECTC EOLC (CR.EOLC (CHARCODE EOL)) (CRLF.EOLC (COND (PEEKBINFLG (* |;;| 
"T from PEEKC, compile-time constant.  In this case, must leave the fileptr where it was, except for possibly advancing over character set shifts"
) (COND ((EQ (CHARCODE LF) (UNINTERRUPTABLY (\\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256)) (* 
|;;| 
"Read the NS CR.  We know that there aren't any font-shift characters in front of the CR, because they would have already been read by the \\NSPEEK that got the CR character.  Since we are going to NS back the CR character, we don't need to update the counter variable"
) (PROG1 (\\PEEKBIN STREAM T) (* |;;| 
"LF must be in next BYTE after NS CR, regardless of coding.  Character-set shifting bytes can't intervene.  Then we back up over the CR that was \\NSINed above."
) (\\BACKNSCHAR STREAM)))) (CHARCODE EOL)) (T (CHARCODE CR)))) ((EQ (CHARCODE LF) (\\PEEKBIN STREAM T)
) (\\BIN STREAM) (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (SUB1 COUNTERVAR))) (CHARCODE EOL)) (T (
CHARCODE CR)))) (CHARCODE CR))) (LF (COND ((EQ EOLC LF.EOLC) (CHARCODE EOL)) (T (CHARCODE LF)))) CH)))
(PUTPROPS \\INCHAR MACRO (OPENLAMBDA (STREAM COUNTERVAR) (* \; "returns a 16 bit character code") (
\\CHECKEOLC (\\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256) NIL COUNTERVAR) (FFETCH EOLCONVENTION 
OF STREAM) STREAM NIL COUNTERVAR)))
(PUTPROPS \\INCCODE MACRO (OPENLAMBDA (STREAM COUNTERVAR) (* \; "returns a 16 bit character code") (
\\CHECKEOLC (\\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256) NIL COUNTERVAR) (|ffetch| 
EOLCONVENTION |of| STREAM) STREAM NIL COUNTERVAR)))
(PUTPROPS \\PEEKCCODE MACRO (OPENLAMBDA (STREAM NOERROR) (\\CHECKEOLC (\\NSPEEK STREAM (UNFOLD (
ACCESS-CHARSET STREAM) 256) NIL NOERROR) (|ffetch| EOLCONVENTION |of| STREAM) STREAM T)))
(PUTPROPS \\NSIN MACRO ((ST SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR) (* |;;;| 
"Dispatches to the appropriate character code decoder.  If you want to support a new character encoding format, you have to write a decoder and add it here."
) (COND ((\\XCCSP ST) (\\XCCSIN ST SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR)) (T (COND ((QUOTE COUNTERVAR
) (CL:MULTIPLE-VALUE-BIND (CODE NUM) (CL:FUNCALL (|ffetch| (STREAM INCCODEFN) |of| ST) ST T) (AND NUM 
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR NUM))) CODE)) (T (CL:FUNCALL (|ffetch| (STREAM INCCODEFN) 
|of| ST) ST NIL)))))))
(PUTPROPS \\NSPEEK MACRO ((ST SHIFTEDCSET SHIFTEDCSETVAR NOERROR COUNTERVAR) (* |;;;| 
"Dispatches to the appropriate character code decoder.  If you want to support a new character encoding format, you have to write a decoder and add it here."
) (COND ((\\XCCSP ST) (\\XCCSPEEK ST (UNFOLD (ACCESS-CHARSET ST) 256) NIL NOERROR)) (T (COND ((QUOTE 
COUNTERVAR) (CL:MULTIPLE-VALUE-BIND (CODE NUM) (CL:FUNCALL (|ffetch| (STREAM PEEKCCODEFN) |of| ST) ST 
NOERROR T) (AND NUM (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR NUM))) CODE)) (T (CL:FUNCALL (|ffetch| (
STREAM PEEKCCODEFN) |of| ST) ST NOERROR NIL)))))))
(PUTPROPS NUMERIC-CHARSET MACRO (= . ACCESS-CHARSET))
(PUTPROPS \\CONV.JIS.TO.XCCS MACRO (OPENLAMBDA (KU TEN) (* |;;;| 
"Some character code is not equivalent between JIS and XCCS.  In such case, we have to convert the character to corresponding XCCS."
) (COND ((\\NOT.EQUIVALENT.TO.XCCS KU) (\\DO.CONV.JIS.TO.XCCS KU TEN)) (T (LOGOR (UNFOLD KU 256) TEN))
)))
(PUTPROPS \\DO.CONV.JIS.TO.XCCS MACRO ((KU TEN) (* |;;;| 
" Convert a JIS code divided into KU (high 8 bit) and TEN (low 8 bit) to an corresponding XCCS code.")
 (COND ((\\INVALID.TENP TEN) *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (SELECTQ KU ((33 34 38) (* \; 
"1, 2 and 6 KU") (LET* ((CONVTABLE (\\EXTARACT.CONV.TABLE KU)) (SET (\\EXTRACT.SET TEN CONVTABLE)) (
CODE (\\EXTRACT.CODE TEN CONVTABLE))) (COND ((NEQ SET 255) (LOGOR (UNFOLD SET 256) CODE)) (T (COND ((
EQ CODE 255) (* \; "Not defined in JIS.") *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (* \; 
"Defined in JIS but the displayable font is not assigned in the corresponding code in XCCS.") (COND (
*REPLACE-NO-FONT-CODE* *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (\\EXTRACT.NO.FONT.CODE (LOGOR (UNFOLD KU 
256) TEN)))))))))) (35 (* \; "3 KU") (* \; 
"Alpha numeric codes are all defined as single byte codes in XCCS.") TEN) (40 (* \; "8 KU") (COND ((< 
0 TEN 33) (COND (*REPLACE-NO-FONT-CODE* *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (\\EXTRACT.NO.FONT.CODE (
LOGOR KU TEN))))) (T *DEFAULT-NOT-CONVERTED-FAT-CODE*))) (116 (* \; "84 KU") (COND ((< 0 TEN 5) (LOGOR
 29952 TEN)) (T *DEFAULT-NOT-CONVERTED-FAT-CODE*))) (117 (* \; "85 KU") (COND ((< 0 TEN 28) (LOGOR 
29696 TEN)) (T *DEFAULT-NOT-CONVERTED-FAT-CODE*))) *DEFAULT-NOT-CONVERTED-FAT-CODE*)))))
(PUTPROPS \\CONV.XCCS.TO.JIS MACRO (OPENLAMBDA (OUTSTREAM CC) (* |;;;| 
"Returns JIS code corresponding to XCCS charcode.  Handle HANKAKU as well as ZENKAKU.  If OUTSTREAM wants to convert ZENKAKUKANA to HANKAKUKANA, do so.  Never returns two byte charcode for alpha-numeric character, they are all treated as single byte characode."
) (OR (COND ((\\ASCIIP CC) CC) ((\\NOT.EQUIVALENT.TO.JIS CC) (\\DO.CONV.XCCS.TO.JIS CC)) ((
\\CONV.HANKAKU.TO.ZENKAKUP OUTSTREAM) (* \; 
"ZENKAKUKANA comes here, because their charcodes are equiavalent to JIS.") (\\CONV.ZENKAKU.KANA CC)) (
T CC)) CC)))
(PUTPROPS \\DO.CONV.XCCS.TO.JIS MACRO ((CC) (GETHASH CC *XCCS-TO-JIS-CONV-TABLE*)))
(PUTPROPS \\ASCIIP MACRO (OPENLAMBDA (CC) (AND (EQ (FOLDLO CC 256) 0) (< (LOGAND CC 255) 128))))
(PUTPROPS \\NOT.EQUIVALENT.TO.JIS MACRO (OPENLAMBDA (CC) (OR (EQ (FOLDLO CC 256) 0) (EQ (FOLDLO CC 256
) 33) (EQ (FOLDLO CC 256) 34) (EQ (FOLDLO CC 256) 38) (EQ (FOLDLO CC 256) 40) (EQ (FOLDLO CC 256) 239)
 (EQ (FOLDLO CC 256) 241))))
(PUTPROPS \\CONV.HANKAKU.TO.ZENKAKUP MACRO ((OUTSTREAM) (STREAMPROP OUTSTREAM :HTOZP)))
(PUTPROPS \\CONV.ZENKAKU.KANA MACRO ((CHAR) (GETHASH CHAR *ZENKAKU-TO-HANKAKU-CONV-TABLE*)))
(PUTPROPS \\XCCSIN MACRO ((STREAM SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR) (* |;;;| 
"returns a 16 bit character code.  SHIFTEDCSET is STREAM's char set left shifted 8, SHIFTEDCSETVAR if non-NIL is the variable to set if char set changes.  COUNTERVAR if non-NIL is decremented by number of bytes read.  Doesn't do EOL conversion -- \\INCHAR and \\INCCODE do that."
) (LET ((CHAR (\\BIN STREAM)) SCSET) (COND ((EQ CHAR NSCHARSETSHIFT) (* \; "Shifting character sets") 
(ACCESS-CHARSET STREAM (SETQ SCSET (COND ((NEQ NSCHARSETSHIFT (SETQ CHAR (\\BIN STREAM))) (AND (QUOTE 
COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2))) CHAR) ((PROGN (* \; 
"2 shift-bytes means not run-encoded") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE 
COUNTERVAR 3))) (EQ 0 (\\BIN STREAM))) \\NORUNCODE) (T (\\NSIN.24BITENCODING.ERROR STREAM))))) (SETQ 
CHAR (\\BIN STREAM)) (SETQ SCSET (COND ((QUOTE SHIFTEDCSETVAR) (* \; "CHARSETVAR=NIL means don't set")
 (SETQ SHIFTEDCSETVAR (UNFOLD SCSET 256))) (T (UNFOLD SCSET 256))))) (T (SETQ SCSET SHIFTEDCSET))) (
COND ((EQ SCSET (UNFOLD \\NORUNCODE 256)) (* \; 
"just read two bytes and combine them to a 16 bit value") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (
IDIFFERENCE COUNTERVAR 2))) (LOGOR (UNFOLD CHAR 256) (\\BIN STREAM))) (CHAR (AND (QUOTE COUNTERVAR) (
SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 1))) (AND CHAR (LOGOR SCSET CHAR)))))))
(PUTPROPS \\XCCSPEEK MACRO ((STREAM SHIFTEDCSET SHIFTEDCSETVAR NOERROR COUNTERVAR) (* |;;| 
"Returns a 16 bit character code.  Doesn't do EOL conversion--\\INCHAR does that.  May actually read the character-set shift, storing the result in the stream.  COUNTERVAR, if given, is updated to reflect any such bytes that are actually read"
) (PROG ((CHAR (\\PEEKBIN STREAM NOERROR)) SCSET) (COND ((NULL CHAR) (RETURN NIL)) ((EQ CHAR 
NSCHARSETSHIFT) (* \; "CHARSETVAR=NIL means don't set") (\\BIN STREAM) (* \; 
"Consume the char shift byte") (ACCESS-CHARSET STREAM (SETQ SCSET (COND ((NEQ NSCHARSETSHIFT (SETQ 
CHAR (\\BIN STREAM))) (* \; 
"Note: no eof error check on this \\BIN -- an eof in the middle of a charset shift is an error") (AND 
(QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2))) CHAR) ((PROGN (* \; 
"2 shift-bytes means not run-encoded") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE 
COUNTERVAR 3))) (EQ 0 (\\BIN STREAM))) \\NORUNCODE) (T (\\NSIN.24BITENCODING.ERROR STREAM))))) (SETQ 
SCSET (COND ((QUOTE SHIFTEDCSETVAR) (* \; "CHARSETVAR=NIL means don't set") (SETQ SHIFTEDCSETVAR (
UNFOLD SCSET 256))) (T (UNFOLD SCSET 256)))) (COND ((NULL (SETQ CHAR (\\PEEKBIN STREAM NOERROR))) (
RETURN NIL)))) (T (SETQ SCSET SHIFTEDCSET))) (RETURN (COND ((EQ SCSET (UNFOLD \\NORUNCODE 256)) (* 
|;;| 
"just peek two bytes and combine them to a 16 bit value.  Again, is an error if we hit eof in mid-character"
) (\\BIN STREAM) (PROG1 (LOGOR (UNFOLD CHAR 256) (\\PEEKBIN STREAM NOERROR)) (\\BACKFILEPTR STREAM))) 
(T (LOGOR SHIFTEDCSET CHAR)))))))
(PUTPROPS \\BACKXCCSCHAR MACRO ((STREAM SHIFTEDCHARSET COUNTERVAR) (AND (\\BACKFILEPTR STREAM) (COND (
(COND (SHIFTEDCHARSET (EQ SHIFTEDCHARSET (UNFOLD \\NORUNCODE 256))) (T (EQ \\NORUNCODE (ACCESS-CHARSET
 STREAM)))) (COND ((\\BACKFILEPTR STREAM) (AND (QUOTE COUNTERVAR) (|add| COUNTERVAR 2)) T) ((QUOTE 
COUNTERVAR) (|add| COUNTERVAR 1)))) ((QUOTE COUNTERVAR) (|add| COUNTERVAR 1))))))
(PUTPROPS \\XCCSP MACRO (OPENLAMBDA (ST) (NOT (|ffetch| (STREAM NOTXCCS) |of| (\\DTEST ST (QUOTE 
STREAM))))))
(PUTPROPS \\EXTRACT.NO.FONT.CODE MACRO ((JISCODE) (CDR (ASSOC JISCODE *JIS-TO-XCCS-CONV-NO-FONT-TABLE*
))))
(PUTPROPS \\EXTARACT.CONV.TABLE MACRO ((KU) (CDR (ASSOC KU *JIS-TO-XCCS-CONV-TABLE-LIST*))))
(PUTPROPS \\NOT.EQUIVALENT.TO.XCCS MACRO ((KU) (* |;;;| 
" The JIS codes which are not equiavelent to XCCS reside in 1, 2, 3, 6, 8 and 84 KU.  Although from 84-5 to 94-94 inclusive are not defined in JIS, that is they are GAIJI, they are also handled here."
) (OR (EQ KU 33) (EQ KU 34) (EQ KU 35) (EQ KU 38) (EQ KU 40) (EQ KU 116) (EQ KU 117))))
(PUTPROPS \\EXTRACT.SET MACRO ((TEN TABLE) (ELT TABLE (IDIFFERENCE (UNFOLD (IDIFFERENCE TEN 32) 2) 1))
))
(PUTPROPS \\EXTRACT.CODE MACRO ((TEN TABLE) (ELT TABLE (UNFOLD (IDIFFERENCE TEN 32) 2))))
(PUTPROPS \\CHNAGE.KI.MODE MACRO (OPENLAMBDA (ST INPUTFLG ENTERP) (* |;;;| 
"INPUTFLG is true if \\CHNAGE.KI.MODE is called in the context in which ST is an input stream.") (COND
 (INPUTFLG (COND (ENTERP (|freplace| (STREAM IN.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| T)) (
T (|freplace| (STREAM IN.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| NIL)))) (T (COND (ENTERP (
|freplace| (STREAM OUT.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| T)) (T (|freplace| (STREAM 
OUT.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| NIL)))))))
(PUTPROPS \\KIMODEP MACRO (OPENLAMBDA (ST INPUTFLG) (* |;;;| 
"INPUTFLG is true if \\KIMODEP is called in the context in which ST is an input stream.") (COND (
INPUTFLG (|ffetch| (STREAM IN.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)))) (T (|ffetch| (STREAM 
OUT.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)))))))
(PUTPROPS \\HANKAKUP MACRO ((CHAR) (< 160 CHAR 224)))
(PUTPROPS \\KANJIP MACRO ((CHAR) (< 12158 CHAR 29733)))
(PUTPROPS \\NOTGAIJIP MACRO ((CHAR) (OR (< 8480 CHAR 10305) (< 12158 CHAR 29733))))
(PUTPROPS \\INVALID.TENP MACRO (OPENLAMBDA (TEN) (OR (< TEN 33) (< 126 TEN))))
(PUTPROPS \\CONV.HANKAKU.KANA MACRO ((CHAR) (GETHASH CHAR *HANKAKU-TO-ZENKAKU-CONV-TABLE*)))
(PUTPROPS \\OUTKI MACRO ((STREAM) (\\BOUT OUTSTREAM (CHARCODE ESC)) (\\BOUT OUTSTREAM (CHARCODE $)) (
\\BOUT OUTSTREAM (CHARCODE B))))
(PUTPROPS \\OUTKO MACRO ((STREAM) (\\BOUT OUTSTREAM (CHARCODE ESC)) (\\BOUT OUTSTREAM (CHARCODE \()) (
\\BOUT OUTSTREAM (CHARCODE J))))
(PUTPROPS \\CONV.SJIS.TO.JIS MACRO (OPENLAMBDA (HI LO) (* |;;;| 
"Convert Shift-JIS to JIS.  The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of JIS code respectively."
) (SETQ CH1 (IDIFFERENCE HI (COND ((> HI 159) 177) (T 113)))) (SETQ CH1 (IPLUS (UNFOLD CH1 2) 1)) (
SETQ CH2 (COND ((> LO 158) (PROG1 (IDIFFERENCE LO 126) (SETQ CH1 (IPLUS CH1 1)))) (T (IDIFFERENCE LO (
COND ((> LO 126) (IPLUS 31 1)) (T 31))))))))
(PUTPROPS \\CONV.JIS.TO.SJIS MACRO (OPENLAMBDA (HI LO) (* |;;;| 
"Convert JIS to Shift-JIS.  The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of Shift-JIS code respectively."
) (SETQ CH2 (COND ((ODDP HI) (SETQ CH2 (IPLUS LO 31)) (COND ((>= CH2 127) (IPLUS CH2 1)) (T CH2))) (T 
(IPLUS LO 126)))) (SETQ CH1 (IPLUS (FOLDLO (IDIFFERENCE HI 33) 2) 129)) (AND (> CH1 159) (SETQ CH1 (
IPLUS CH1 64)))))
(PUTPROPS \\SJIS.KANJI.FIRST.BYTEP MACRO (OPENLAMBDA (CHAR) (OR (< 127 CHAR 160) (< 223 CHAR 256))))
(PUTPROPS \\EUC.KANJI.FIRST.BYTEP MACRO ((CHAR) (< 160 CHAR 255)))
(PUTPROPS \\GAIJIP MACRO ((CHAR) (EQ CHAR 143)))
(PUTPROPS \\EUC.HANKAKUP MACRO ((CHAR) (EQ CHAR 142)))
(PUTPROP (QUOTE LLREAD) (QUOTE IMPORTDATE) (IDATE " 4-Feb-2021 17:06:41"))

(PUTPROPS EMPASSWORDLOC DMACRO (LAMBDA NIL (* |lmm| "24-MAR-83 06:46") (|fetch| (IFPAGE |UserPswdAddr|
) |of| |\\InterfacePage|)))
(PUTPROPS \\DECRYPT.PWD.CHAR MACRO ((CHAR) (LOGXOR CHAR 73)))
(PUTPROP (QUOTE PASSWORDS) (QUOTE IMPORTDATE) (IDATE "16-May-1990 21:02:21"))

(RPAQQ MICASPERINCH 2540)
(RPAQQ MICASPERMILLIMETER 100)
(CONSTANTS (MICASPERINCH 2540) (MICASPERMILLIMETER 100))
(PUTPROP (QUOTE INTERPRESS) (QUOTE IMPORTDATE) (IDATE "16-Apr-2018 21:56:38"))

(RPAQ MICASPERPT (FQUOTIENT 2540 72))
(RPAQQ IHALFMICASPERPT 17)
(RPAQQ IMICASPERPT 35)
(CONSTANTS (MICASPERPT (FQUOTIENT 2540 72)) (IHALFMICASPERPT 17) (IMICASPERPT 35))
(DEFMACRO \\MICASTOPTS (MICAS) (COND ((NUMBERP MICAS) (QUOTIENT MICAS MICASPERPT)) (T (BQUOTE (
QUOTIENT (\\\, MICAS) MICASPERPT)))))
(PUTPROP (QUOTE HARDCOPY) (QUOTE IMPORTDATE) (IDATE "16-Apr-2018 22:15:08"))

(FILESLOAD (SYSLOAD FROM VALUEOF DIRECTORIES) CMLARRAY-SUPPORT)
(PUTPROP (QUOTE CMLARRAY) (QUOTE IMPORTDATE) (IDATE " 6-Jan-1993 12:21:21"))

(RPAQQ \\MISCN-TABLE-LIST ((USER-SUBR 0 \\USER-SUBR-UFN T) (CL:VALUES 1 CL::VALUES-UFN NIL) (CL:SXHASH
 2 CL::SXHASH-UFN NIL) (CL::EQLHASHBITSFN 3 CL::EQLHASHBITSFN-UFN NIL) (STRINGHASHBITS 4 
\\STRINGHASHBITS-UFN NIL) (STRING-EQUAL-HASHBITS 5 \\STRING-EQUAL-HASHBITS-UFN NIL) (CL:VALUES-LIST 6 
CL::VALUES-LIST-UFN NIL) (|LCFetchMethod| 7 |LCFetchMethod| NIL) (|LCFetchMethodOrHelp| 8 NIL NIL) (
|LCFindVarIndex| 9 NIL NIL) (|LCGetIVValue| 10 NIL NIL) (|LCPutIVValue| 11 NIL NIL)))
(RPAQQ \\USER-SUBR-LIST ((DUMMY 10 DUMMY-UFN) (SAMPLE-USER-SUBR 0 SAMPLE-USER-SUBR-UFN)))
(RPAQQ \\INITSUBRS ((BACKGROUNDSUBR 6) (CHECKBCPLPASSWORD 7) (DISKPARTITION 8) (DSPBOUT 9) (DSPRATE 10
) (GATHERSTATS 11) (GETPACKETBUFFER 12) (LISPFINISH 13) (MOREVMEMFILE 14) (RAID 15) (READRAWPBI 16) (
WRITERAWPBI 17) (SETSCREENCOLOR 18) (SHOWDISPLAY 19) (PUPLEVEL1STATE 20) (WRITESTATS 21) (
CONTEXTSWITCH 22) (COPYSYS0SUBR 23) (WRITEMAP 24) (UFS-GETFILENAME 34) (UFS-DELETEFILE 35) (
UFS-RENAMEFILE 36) (COM-READPAGES 37) (COM-WRITEPAGES 38) (COM-TRUNCATEFILE 39) (UFS-DIRECTORYNAMEP 41
) (COM-GETFREEBLOCK 45) (SETUNIXTIME 48) (GETUNIXTIME 49) (COPYTIMESTATS 50) (UNIX-USERNAME 51) (
UNIX-FULLNAME 52) (UNIX-GETENV 53) (UNIX-GETPARM 54) (CHECK-SUM 55) (ETHER-SUSPEND 56) (ETHER-RESUME 
57) (ETHER-AVAILABLE 58) (ETHER-RESET 59) (ETHER-GET 60) (ETHER-SEND 61) (ETHER-SETFILTER 62) (
ETHER-CHECK 63) (DSPCURSOR 64) (SETMOUSEXY 65) (DSP-VIDEOCOLOR 66) (DSP-SCREENWIDTH 67) (
DSP-SCREENHEIGHT 68) (BITBLTSUB 69) (BLTCHAR 70) (TEDIT.BLTCHAR 71) (BITBLT.BITMAP 72) (
BLTSHADE.BITMAP 73) (RS232C-CMD 74) (RS232C-READ-INIT 75) (RS232C-WRITE 76) (KEYBOARDBEEP 80) (
KEYBOARDMAP 81) (KEYBOARDSTATE 82) (VMEMSAVE 89) (LISP-FINISH 90) (NEWPAGE 91) (DORECLAIM 92) (
DUMMY-135Q 93) (NATIVE-MEMORY-REFERENCE 94) (OLD-COMPILE-LOAD-NATIVE 95) (DISABLEGC 96) (
COM-SETFILEINFO 103) (COM-OPENFILE 104) (COM-CLOSEFILE 105) (DSK-GETFILENAME 106) (DSK-DELETEFILE 107)
 (DSK-RENAMEFILE 108) (COM-NEXT-FILE 110) (COM-FINISH-FINFO 111) (COM-GEN-FILES 112) (
DSK-DIRECTORYNAMEP 113) (COM-GETFILEINFO 114) (COM-CHANGEDIR 116) (UNIX-HANDLECOMM 117) (RPC-CALL 119)
 (MESSAGE-READP 120) (MESSAGE-READ 121) (MONITOR-CONTROL 128) (GET-NATIVE-ADDR-FROM-LISP-PTR 131) (
GET-LISP-PTR-FROM-NATIVE-ADDR 132) (LOAD-NATIVE-FILE 133) (SUSPEND-LISP 134) (NEW-BLTCHAR 135) (
COLOR-INIT 136) (COLOR-SCREENMODE 137) (COLOR-MAP 138) (COLOR-BASE 139) (|C-SlowBltChar| 140) (
UNCOLORIZE-BITMAP 141) (COLORIZE-BITMAP 142) (COLOR-8BPPDRAWLINE 143) (TCP-OP 144) (WITH-SYMBOL 145) (
CAUSE-INTERRUPT 146) (OPEN-SOCKET 160) (CLOSE-SOCKET 161) (READ-SOCKET 162) (WRITE-SOCKET 163) (
CALL-C-FUNCTION 167) (DLD-LINK 168) (DLD-UNLINK-BY-FILE 169) (DLD-UNLINK-BY-SYMBOL 170) (
DLD-GET-SYMBOL 171) (DLD-GET-FUNC 172) (DLD-FUNCTION-EXECUTABLE-P 173) (DLD-LIST-UNDEFINED-SYMBOLS 174
) (C-MALLOC 175) (C-FREE 176) (C-PUTBASEBYTE 177) (C-GETBASEBYTE 178) (CHAR-OPENFILE 200) (CHAR-BIN 
201) (CHAR-BOUT 202) (CHAR-IOCTL 203) (CHAR-CLOSEFILE 204) (CHAR-EOFP 205) (CHAR-READP 206) (CHAR-BINS
 207) (CHAR-BOUTS 208) (CHAR-FILLBUFFER 209)))
(PUTPROP (QUOTE LLSUBRS) (QUOTE IMPORTDATE) (IDATE "21-Feb-2021 21:20:11"))

STOP

\ No newline at end of file
+(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
(LISPXPRIN1 "EXPORTS GATHERED FROM {DSK}<home>larry>ilisp>medley>sources> ON 21-Mar-2021 21:59:51"  T)
(LISPXTERPRI T)
(RPAQQ MODARITHMACROS (CEIL FLOOR FOLDHI FOLDLO MODUP UNFOLD MOD))
(PUTPROPS CEIL MACRO ((X N) (FLOOR (IPLUS X (CONSTANT (SUB1 N))) N)))
(PUTPROPS FLOOR MACRO ((X N) (LOGAND X (CONSTANT (LOGXOR (SUB1 N) -1)))))
(PUTPROPS FOLDHI MACRO (X (PROG ((FORM (CAR X)) (DIVISOR (CAR (CONSTANTEXPRESSIONP (CADR X))))) (OR (
AND DIVISOR (POWEROFTWOP DIVISOR)) (\\ILLEGAL.ARG (CADR X))) (RETURN (LIST (QUOTE LRSH) (LIST (QUOTE 
IPLUS) FORM (SUB1 DIVISOR)) (SUB1 (INTEGERLENGTH DIVISOR)))))))
(PUTPROPS FOLDLO MACRO (X (PROG ((FORM (CAR X)) (DIVISOR (CAR (CONSTANTEXPRESSIONP (CADR X))))) (OR (
AND DIVISOR (POWEROFTWOP DIVISOR)) (\\ILLEGAL.ARG (CADR X))) (RETURN (LIST (QUOTE LRSH) FORM (SUB1 (
INTEGERLENGTH DIVISOR)))))))
(PUTPROPS MODUP MACRO (OPENLAMBDA (X N) (IDIFFERENCE (SUB1 N) (IMOD (SUB1 X) N))))
(PUTPROPS UNFOLD MACRO (X (PROG ((FORM (CAR X)) (DIVISOR (CAR (CONSTANTEXPRESSIONP (CADR X))))) (OR (
AND DIVISOR (POWEROFTWOP DIVISOR)) (\\ILLEGAL.ARG (CADR X))) (RETURN (LIST (QUOTE LLSH) FORM (SUB1 (
INTEGERLENGTH DIVISOR)))))))
(PUTPROPS MOD MACRO (= . IMOD))
(RPAQQ BITSPERNIBBLE 4)
(RPAQQ NIBBLESPERBYTE 2)
(RPAQQ BITSPERBYTE 8)
(RPAQQ BITSPERCELL 32)
(RPAQQ BITSPERWORD 16)
(RPAQQ BYTESPERCELL 4)
(RPAQQ BYTESPERPAGE 512)
(RPAQQ BYTESPERWORD 2)
(RPAQQ CELLSPERPAGE 128)
(RPAQQ CELLSPERSEGMENT 32768)
(RPAQQ PAGESPERSEGMENT 256)
(RPAQQ WORDSPERCELL 2)
(RPAQQ WORDSPERPAGE 256)
(RPAQQ WORDSPERSEGMENT 65536)
(RPAQQ WORDSPERQUAD 4)
(RPAQQ CELLSPERQUAD 2)
(RPAQQ BYTESPERQUAD 8)
(CONSTANTS BITSPERNIBBLE NIBBLESPERBYTE BITSPERBYTE BITSPERCELL BITSPERWORD BYTESPERCELL BYTESPERPAGE 
BYTESPERWORD CELLSPERPAGE CELLSPERSEGMENT PAGESPERSEGMENT WORDSPERCELL WORDSPERPAGE WORDSPERSEGMENT 
WORDSPERQUAD CELLSPERQUAD BYTESPERQUAD)
(RPAQQ INTEGERSIZECONSTANTS ((BITS.PER.SMALLP (ADD1 BITSPERWORD)) (SMALLP.LENGTH (SUB1 BITS.PER.SMALLP
)) (MAX.SMALLP (LOGOR (LSH 1 (SUB1 SMALLP.LENGTH)) (SUB1 (LSH 1 (SUB1 SMALLP.LENGTH))))) (MIN.SMALLP (
IDIFFERENCE -1 MAX.SMALLP)) (BITS.PER.FIXP BITSPERCELL) (FIXP.LENGTH (SUB1 BITS.PER.FIXP)) (MAX.FIXP (
LOGOR (LSH 1 (SUB1 FIXP.LENGTH)) (SUB1 (LSH 1 (SUB1 FIXP.LENGTH))))) (MIN.FIXP (IDIFFERENCE -1 
MAX.FIXP))))
(RPAQ BITS.PER.SMALLP (ADD1 BITSPERWORD))
(RPAQ SMALLP.LENGTH (SUB1 BITS.PER.SMALLP))
(RPAQ MAX.SMALLP (LOGOR (LSH 1 (SUB1 SMALLP.LENGTH)) (SUB1 (LSH 1 (SUB1 SMALLP.LENGTH)))))
(RPAQ MIN.SMALLP (IDIFFERENCE -1 MAX.SMALLP))
(RPAQ BITS.PER.FIXP BITSPERCELL)
(RPAQ FIXP.LENGTH (SUB1 BITS.PER.FIXP))
(RPAQ MAX.FIXP (LOGOR (LSH 1 (SUB1 FIXP.LENGTH)) (SUB1 (LSH 1 (SUB1 FIXP.LENGTH)))))
(RPAQ MIN.FIXP (IDIFFERENCE -1 MAX.FIXP))
(CONSTANTS (BITS.PER.SMALLP (ADD1 BITSPERWORD)) (SMALLP.LENGTH (SUB1 BITS.PER.SMALLP)) (MAX.SMALLP (
LOGOR (LSH 1 (SUB1 SMALLP.LENGTH)) (SUB1 (LSH 1 (SUB1 SMALLP.LENGTH))))) (MIN.SMALLP (IDIFFERENCE -1 
MAX.SMALLP)) (BITS.PER.FIXP BITSPERCELL) (FIXP.LENGTH (SUB1 BITS.PER.FIXP)) (MAX.FIXP (LOGOR (LSH 1 (
SUB1 FIXP.LENGTH)) (SUB1 (LSH 1 (SUB1 FIXP.LENGTH))))) (MIN.FIXP (IDIFFERENCE -1 MAX.FIXP)))
(PUTPROP (QUOTE MODARITH) (QUOTE IMPORTDATE) (IDATE "16-May-1990 20:46:21"))

(RPAQQ WINDFLG T)
(CONSTANTS (WINDFLG T))
(RPAQQ INITCONSTANTS ((* |;;;| "(LISPNAME VALUE BCPLNAME UCODENAME)") (CDRCODING 1 T T) (* \; 
"IF CDRCODING=0, CDR CODING IS OFF, OTHERWISE ON") (* |;;| "type numbers -- repeated on LLBASIC too") 
(\\SMALLP 1 SMALLTYPE |SmallType|) (\\FIXP 2 INTEGERTYPE |FixpType|) (\\FLOATP 3 FLTPTTYPE 
|FloatpType|) (\\LITATOM 4 ATOMTYPE |AtomType|) (\\LISTP 5 LISTTYPE |ListType|) (\\ARRAYP 6 
ARRAYPTRTYPE |ArrayType|) (\\STRINGP 7 STRINGPTRTYPE) (\\STACKP 8) (\\CHARACTERP 9) (\\VMEMPAGEP 10 
NIL |VMemPagePType|) (\\STREAM 11 NIL STREAMTYPE) (* |;;| 
"TYPE TABLE CONSTANTS - - - - - - - - - - - - - - - - - - - - - -") (\\TT.TYPEMASK 2047 |TTTypeMask| T
) (\\TT.NOREF 32768 NIL T) (\\TT.SYMBOLP 16384 NIL T) (\\TT.FIXP 8192) (\\TT.NUMBERP 4096) (\\TT.ATOM 
2048) (* |;;| "page map - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -") 
(|\\PMblockSize| 32 PMBLOCKSIZE) (|\\STATSsize| 8 T) (|\\NumPMTpages| 8) (|\\EmptyPMTEntry| 65535 T) (
|\\FirstVmemBlock| 2 T) (\\MAXVMPAGE 131069) (\\MAXVMSEGMENT 255) (* |;;| "interface page") (
|\\IFPValidKey| 5603 T) (* |;;| "MDS") (|\\FirstMDSPage| 32766) (* \; "Was 37776Q pre 16-meg intiial")
 (|\\MaxMDSPage| 524285) (|\\DefaultSecondMDSPage| 65532) (|\\MDSIncrement| 512) (|\\PagesPerMDSUnit| 
2) (* \; "(FOLDLO \\MDSIncrement WORDSPERPAGE)") (* |;;| "arrays") (\\ARRAYSPACE (46 0)) (
|\\FirstArraySegment| 46) (|\\FirstArrayPage| 11776) (\\ARRAYSPACE2 (64 0)) (
|\\DefaultSecondArrayPage| 32768) (* \; "Was 40000Q before 16meg initial") (* |;;| 
"stack block constants") (|\\StackMask| 57344 T T) (|\\FxtnBlock| 49152 T T) (|\\GuardBlock| 57344 T T
) (|\\BFBlock| 32768 T T) (|\\FreeStackBlock| 40960 T T) (|\\NotStackBlock| 0) (* \; 
"none of the above") (|\\MinExtraStackWords| 32 T T) (* |;;| "backspace kludge") (ERASECHARCODE 0 T) (
* |;;| "GC constants") (\\HT1CNT 1024 NIL T) (\\HTSTKBIT 512 NIL T) (\\HTCNTMASK 64512 NIL T) (
\\HTMAINSIZE 65536 NIL T) (\\HTCOLLSIZE 1048576 NIL T) (* \; "HTCOLL size in words") (\\HTENDFREE 1 
NIL T) (\\HTFREEPTR 0 NIL T) (* |;;| "pointers and lengths of various data spaces") (\\ATOMSPACE (0 0)
 (|ATOMspace| NIL) (|atomHiVal| NIL)) (|\\AtomHI| 0) (\\CHARHI 7) (* \; 
"overlap character space and the atom hash table space") (|\\AtomHashTable| (21 0) (|AHTspace| 
|AHTbase|)) (|\\AtomHTpages| 256 AHTSIZE) (|\\LastAtomPage| 255) (|\\MaxAtomFrLst| 65535) (
\\SMALLPOSPSPACE (14 0)) (|\\SmallPosHi| 14 |SMALLPOSspace| |smallpl|) (\\SMALLNEGSPACE (15 0)) (
|\\SmallNegHi| 15 |SMALLNEGspace| |smallneg|) (|\\NumSmallPages| 512) (* |;;| 
"PNAME SPACEin the old world; used for initial atoms now.") (\\PNPSPACE (8 0) (|PNPspace| |PNPbase|)) 
(\\PNAME.HI 8) (\\OLDATOMSPACE (44 0)) (* \; "NEW ATOM SPACE") (\\ATOM.HI 44) (* \; 
"HI PART OF NEW ATOM SPACE") (* |;;| "Definitions in old atom world") (\\DEFSPACE (10 0) (|DEFspace| 
|DEFbase|) (|DEFspace| |DEFbase|)) (\\DEF.HI 10) (\\VALSPACE (12 0) (|TOPVALspace| |TOPVALbase|) (
|VALspace| |VALbase|)) (\\VAL.HI 12) (\\PLISTSPACE (2 0) (|PLISTspace| |PLISTbase|)) (\\PLIST.HI 2) (
\\PAGEMAP (5 0) (|PAGEMAPspace| |PAGEMAPbase|)) (|\\NumPageMapPages| 256) (|\\PageMapTBL| (20 512) (
|PMTspace| |PMTbase|)) (|\\InterfacePage| (20 0) (|INTERFACEspace| |INTERFACEbase|) (|INTERFACEspace| 
|INTERFACEbase|)) (\\IOPAGE (0 65280)) (|\\DoveIORegion| (0 16384)) (\\IOCBPAGE (0 256)) (\\FPTOVP (2 
0)) (|\\MDSTypeTable| (24 0) (|MDSTYPEspace| |MDSTYPEbase|) (|MDSTYPEspace| |MDSTYPEbase|)) (
|\\MDSTTsize| 1024 T) (* \; "in Pages") (\\MISCSTATS (20 2560) (|STATSspace| |MISCSTATSbase|)) (
|\\UFNTable| (20 3072) NIL (|STATSspace| |UFNTablebase|)) (|\\UFNTableSize| 2) (|\\DTDSpaceBase| (20 
4096) (|DTDspace| |DTDbase|) (|DTDspace| |DTDbase|)) (|\\DTDSize| 18 T) (\\LISTPDTD (20 4186)) (
|\\EndTypeNumber| 2047) (\\LOCKEDPAGETABLE (20 28672)) (|\\NumLPTPages| 16) (\\STACKSPACE (1 0) (
|STACKspace| NIL) (|STACKspace| NIL)) (|\\GuardStackAddr| 61440) (|\\LastStackAddr| 65534) (\\STACKHI 
1 T T) (\\HTMAIN (22 0) (|HTMAINspace| |HTMAINbase|) (|HTMAINspace| |HTMAINbase|)) (|\\HTMAINnpages| 
256 T) (\\HTOVERFLOW (23 0) NIL (NIL |HTOVERFLOWbase|)) (\\HTBIGCOUNT (23 32768)) (\\HTCOLL (28 0) NIL
 (|HTCOLLspace| |HTCOLLbase|)) (\\DISPLAYREGION (18 0)) (|\\D1BCPLspace| 0 T |LEmubrHiVal|) (
|\\D0BCPLspace| 0 T) (* |;;| "Interface Page locations") (|\\CurrentFXP| 0 T T) (|\\ResetFXP| 1 T T) (
|\\SubovFXP| 2 T T) (|\\KbdFXP| 3 T T) (|\\HardReturnFXP| 4 T T) (\\GCFXP 5) (\\FAULTFXP 6 T T) (
|\\MiscFXP| 14 T T) (|\\TeleRaidFXP| 24 T T) (* |;;| "emulator segment locations") (DCB.EM 272) (
DISPINTERRUPT.EM 273) (CURSORBITMAP.EM 281) (KBDAD0.EM 65052) (KBDAD1.EM 65053) (KBDAD2.EM 65054) (
KBDAD3.EM 65055) (UTILIN.EM 65048) (CURSORX.EM 278) (CURSORY.EM 279) (MOUSEX.EM 276) (MOUSEY.EM 277) (
|\\LispKeyMask| 8192 T T) (|\\BcplKeyMask| 4352 T T) (* \; "Machine types") (\\MAIKO 3) (\\DOLPHIN 4) 
(\\DORADO 5) (\\DANDELION 6) (\\DAYBREAK 8) (* |;;| "FOR DLION (AND DAYBREAK)") (\\VP.DISPLAY 4608) (
\\NP.DISPLAY 202) (* \; "for Dorado display 1024x808 pixels / (16 pixels/word x 256 words/page)") (
\\NP.WIDEDOVEDISPLAY 243) (* \; "Wide Dove display 1152x864 pixels") (\\WIDEDOVEDISPLAYWIDTH 1152) (
\\RP.AFTERDISPLAY 206) (* \; "Includes 4 pages for cursor") (\\RP.AFTERDOVEDISPLAY 243) (* \; 
"if big screen") (\\RP.DISPLAY 0) (\\RP.TEMPDISPLAY 2561) (\\RP.MISCLOCKED 2804) (* \; 
"(+ \\RP.TEMPDISPLAY \\NP.WIDEDOVEDISPLAY)") (\\RP.STACK 768) (\\VP.STACK 256) (\\RP.MAP 256) (
\\NP.MAP 256) (\\RP.IOPAGE 512) (* \; 
"The DOVE IOCBPAGE can go anywhere, but should be under the 1mbyte range") (\\RP.DOVEIOCBPAGE 543) (
\\RP.DOVEIORGN 544) (\\VP.DOVEIORGN 64) (\\DOVEIORGNSIZE 64) (\\VP.IOPAGE 255) (\\VP.IFPAGE 5120) (
\\VP.FPTOVP 512) (\\NP.FPTOVP 4096) (\\RP.FPTOVP 1024) (\\RP.STARTBUFFERS 640) (\\VP.TYPETABLE 6144) (
\\NP.TYPETABLE 1024) (\\RP.TYPETABLE 5120) (\\VP.GCTABLE 5632) (\\NP.GCTABLE 256) (\\RP.GCTABLE 6144) 
(\\VP.GCOVERFLOW 5888) (\\NP.GCOVERFLOW 1) (\\RP.GCOVERFLOW 6400) (\\FP.IFPAGE 2) (\\VP.IOCBS 1) (
\\VP.PRIMARYMAP 5122) (\\VP.SECONDARYMAP 1280) (\\VP.LPT 5232) (\\VP.INITSCRATCH 8) (\\VP.RPT 128) (
\\VP.BUFFERS 218) (* \; "DLion processor commands") (\\DL.PROCESSORBUSY 32768) (\\DL.SETTOD 32769) (
\\DL.READTOD 32770) (\\DL.READPID 32771) (\\DL.BOOTBUTTON 32772)))
(RPAQQ MISCSTATSLAYOUT ((STARTTIME FIXP |MSstrtTime|) (TOTALTIME FIXP) (SWAPWAITTIME FIXP T) (
PAGEFAULTS FIXP T) (SWAPWRITES FIXP T) (DISKIOTIME FIXP T) (DISKOPS FIXP T) (KEYBOARDWAITTIME FIXP T) 
(GCTIME FIXP T) (NETIOTIME FIXP T) (NETIOOPS FIXP T) (SWAPTEMP0 FIXP) (SWAPTEMP1 FIXP) (RCLKSECOND 
FIXP) (SECONDSCLOCK FIXP) (MILLISECONDSCLOCK FIXP) (BASECLOCK FIXP) (RCLKTEMP0 FIXP) (SECONDSTMP FIXP)
 (MILLISECONDSTMP FIXP) (BASETMP FIXP) (EXCESSTIMETMP FIXP) (CLOCKTEMP0 FIXP) (DISKTEMP0 FIXP) (
DISKTEMP1 FIXP) (TELERAIDTEMP1 FIXP) (TELERAIDTEMP2 FIXP) (TELERAIDTEMP3 FIXP) (LASTUSERACTION FIXP) (
DLMOUSETIMER FIXP) (DLMOUSETEMP FIXP)))
(RPAQQ IFPAGELAYOUT ((|CurrentFXP| WORD) (* \; 
"First 7 items are FX values for user and 6 system contexts.") (|ResetFXP| WORD) (|SubovFXP| WORD) (
|KbdFXP| WORD) (|HardReturnFXP| WORD) (GCFXP WORD) (FAULTFXP WORD) (|EndOfStack| WORD) (* \; 
"Stack high-water mark: address of guard block at current end of stack") (|LVersion| WORD) (* \; 
"Lisp version, followed by min versions of microcode and Bcpl compatible with this Lisp") (
|MinRVersion| WORD) (|MinBVersion| WORD) (|RVersion| WORD) (* \; 
"Bcpl fills in the actual microcode, Bcpl versions.") (|BVersion| WORD) (|MachineType| WORD) (
|MiscFXP| WORD) (* \; "FX for MISC context") (|Key| WORD) (* \; "= IFPValidKey if vmem consistent.") (
|SerialNumber| WORD) (* \; "Pup host number (Dorado/Dolphin)") (|EmulatorSpace| WORD) (* \; 
"Hiloc of bcpl space (always zero now)") (|ScreenWidth| WORD) (|NxtPMAddr| WORD) (* \; 
"Next page to be allocated in secondary page map table") (|NActivePages| WORD) (* \; 
"Length of vmem in use") (|NDirtyPages| WORD) (* \; "not used, but maintained as = NActivePages") (
|filePnPMP0| WORD) (* \; 
"Sysout page number of first page of secondary page map table (\\PAGEMAP), which is where the secondary map pages themselves live"
) (|filePnPMT0| WORD) (* \; "Sysout page number of first page of primary page map table") (TELERAIDFXP
 WORD) (* \; "FX for TeleRaid server context") (NATIVE-START-MEM-PAGE WORD) (* \; 
"Unix page where native code starts") (NATIVE-LENGTH-PAGE WORD) (* \; 
"Unix page length of native code") (NATIVE-PAGE-OFFSET WORD) (* \; 
"Lisp Disk Page offset  of native code") (|UserNameAddr| WORD) (* \; 
"Addresses in bcpl space (seg 0) of global user name and password") (|UserPswdAddr| WORD) (|StackBase|
 WORD) (* \; "Stack address where user stack starts") (FAULTHI WORD) (* \; 
"Microcode for page fault stores fault address here, then does context switch to FAULTFXP") (FAULTLO 
WORD) (DEVCONFIG WORD) (* \; "IT'S FOR KB,DISP TYPE") (* \; 
"Formerly REALPAGETABLE, back when it was always in Bcpl space.") (RPTSIZE WORD) (* \; 
"Number of entries in Real Page Table") (RPOFFSET WORD) (* \; "RP-RPOFFSET => index in table") (
MAXETHERBYTES WORD) (* \; "Number of bytes available in a pbi, not counting encapsulation (Dorado)") (
EMBUFVP WORD) (* \; "VP of a one-page emulator buffer") (|NSHost0| WORD) (* \; 
"Machine's 48-bit NS host number.  Lisp manages to compute this on all machines except Dolphin, where Bcpl fills it in."
) (|NSHost1| WORD) (|NSHost2| WORD) (|MDSZone| WORD) (* \; 
"Obsolete -- was used by Dolphin 10MB network code.") (|MDSZoneLength| WORD) (EMUBUFFERS WORD) (* \; 
"Buffer space in segment 0 for swapping/disk activity") (EMUBUFLENGTH WORD) (* \; 
"Number of words of said space") (LASTNUMCHARS WORD) (* \; "No longer used?") (SYSDISK WORD) (* \; 
"Address of sysDisk in Bcpl space -- disk obj for boot partition.") (ISFMAP WORD) (* |;;| 
"The following 4 are for \\MISCAPPLY* -- note that they are not ref counted, so don't pass the only pointer to something this way!"
) (MISCSTACKFN FULLXPOINTER) (MISCSTACKARG1 FULLXPOINTER) (MISCSTACKARG2 FULLXPOINTER) (
MISCSTACKRESULT FULLXPOINTER) (|NRealPages| WORD) (* \; "Number pages of real memory") (
|LastLockedFilePage| WORD) (* \; 
"Last page of vmem that is locked--booting has to load at least that far.") (|LastDominoFilePage| WORD
) (* \; "Last sysout page reserved for Dandelion microcode") (|FPTOVPStart| WORD) (* \; 
"Sysout page where FPTOVP starts") (FAKEMOUSEBITS WORD) (* \; 
"Used to implement fake middle button on 2-button Dandelion.") (|DL24BitAddressable| WORD) (* \; 
"non-zero if DLion capable of addressing 32MB virtual memory") (REALPAGETABLEPTR FULLXPOINTER) (* \; 
"Address of real page table, set up by Bcpl (but not chained together)") (|DLLastVmemPage| WORD) (* \;
 "DLion booting microcode puts length of vmem file here.") (|FullSpaceUsed| WORD) (* \; 
"Non-zero if vmem beyond initial 8MB has been allocated.") (FAKEKBDAD4 WORD) (FAKEKBDAD5 WORD) (* |;;|
 
"The following 9 items (6 words and 3 pointers) are 3 3-element vectors for the Dorado extended virtual memory code--indexed by 0,1,2 according to which of up to 3 virtual memory backing files you're working with."
) (|XVmemFmapBase| WORD) (* \; 
"Bcpl stores isf map pointer to each partition here.  First is redundant with ISFMAP field above.") (
NIL WORD) (NIL WORD) (|XVmemFmapHighBase| WORD) (* \; 
"Bcpl stores the highest vm page contained in this or earlier partition.") (NIL WORD) (NIL WORD) (
|XVmemDiskBase| FULLXPOINTER) (* \; 
"Lisp stores disk objects here (just a convenient non-faulting contiguous block of storage).") (NIL 
FULLXPOINTER) (NIL FULLXPOINTER)))
(RPAQQ MAIKO.IFPAGELAYOUT ((|CurrentFXP| WORD) (* \; 
"First 7 items are FX values for user and 6 system contexts.") (|ResetFXP| WORD) (|SubovFXP| WORD) (
|KbdFXP| WORD) (|HardReturnFXP| WORD) (GCFXP WORD) (FAULTFXP WORD) (|EndOfStack| WORD) (* \; 
"Stack high-water mark: address of guard block at current end of stack") (|LVersion| WORD) (* \; 
"Lisp version, followed by min versions of microcode and Bcpl compatible with this Lisp") (
|MinRVersion| WORD) (|MinBVersion| WORD) (|RVersion| WORD) (* \; 
"Bcpl fills in the actual microcode, Bcpl versions.") (|BVersion| WORD) (|MachineType| WORD) (
|MiscFXP| WORD) (* \; "FX for MISC context") (|Key| WORD) (* \; "= IFPValidKey if vmem consistent.") (
|SerialNumber| WORD) (* \; "Pup host number (Dorado/Dolphin)") (|EmulatorSpace| WORD) (* \; 
"Hiloc of bcpl space (always zero now)") (|ScreenWidth| WORD) (|NxtPMAddr| WORD) (* \; 
"Next page to be allocated in secondary page map table") (NIL WORD) (* \; 
"WAS NActivePages, Length of vmem in use") (NIL WORD) (* \; 
"WAS NDirtyPages, not used, but maintained as = NActivePages") (|filePnPMP0| WORD) (* \; 
"Sysout page number of first page of secondary page map table (\\PAGEMAP), which is where the secondary map pages themselves live"
) (|filePnPMT0| WORD) (* \; "Sysout page number of first page of primary page map table") (TELERAIDFXP
 WORD) (* \; "FX for TeleRaid server context") (NATIVE-START-MEM-PAGE WORD) (* \; 
"Unix page where native code starts") (NATIVE-LENGTH-PAGE WORD) (* \; 
"Unix page length of native code") (NATIVE-PAGE-OFFSET WORD) (* \; 
"Lisp Disk Page offset  of native code") (|UserNameAddr| WORD) (* \; 
"Addresses in bcpl space (seg 0) of global user name and password") (|UserPswdAddr| WORD) (|StackBase|
 WORD) (* \; "Stack address where user stack starts") (FAULTHI WORD) (* \; 
"Microcode for page fault stores fault address here, then does context switch to FAULTFXP") (FAULTLO 
WORD) (DEVCONFIG WORD) (* \; "IT'S FOR KB,DISP TYPE") (* \; 
"Formerly REALPAGETABLE, back when it was always in Bcpl space.") (RPTSIZE WORD) (* \; 
"Number of entries in Real Page Table") (RPOFFSET WORD) (* \; "RP-RPOFFSET => index in table") (
MAXETHERBYTES WORD) (* \; "Number of bytes available in a pbi, not counting encapsulation (Dorado)") (
EMBUFVP WORD) (* \; "VP of a one-page emulator buffer") (|NSHost0| WORD) (* \; 
"Machine's 48-bit NS host number.  Lisp manages to compute this on all machines except Dolphin, where Bcpl fills it in."
) (|NSHost1| WORD) (|NSHost2| WORD) (|MDSZone| WORD) (* \; 
"Obsolete -- was used by Dolphin 10MB network code.") (|MDSZoneLength| WORD) (EMUBUFFERS WORD) (* \; 
"Buffer space in segment 0 for swapping/disk activity") (EMUBUFLENGTH WORD) (* \; 
"Number of words of said space") (* |;;| 
"The following 2 are available if NEW_STOARGE is specified in C") (|ProcessSize| WORD) (* \; 
"Process size for which can be use as LISP space") (|StorageFullState| WORD) (* \; 
"Save last storage state") (ISFMAP WORD) (* |;;| 
"The following 4 are for \\MISCAPPLY* -- note that they are not ref counted, so don't pass the only pointer to something this way!"
) (MISCSTACKFN FULLXPOINTER) (MISCSTACKARG1 FULLXPOINTER) (MISCSTACKARG2 FULLXPOINTER) (
MISCSTACKRESULT FULLXPOINTER) (|NRealPages| WORD) (* \; "Number pages of real memory") (
|LastLockedFilePage| WORD) (* \; 
"Last page of vmem that is locked--booting has to load at least that far.") (|LastDominoFilePage| WORD
) (* \; "Last sysout page reserved for Dandelion microcode") (|FPTOVPStart| WORD) (* \; 
"Sysout page where FPTOVP starts") (FAKEMOUSEBITS WORD) (* \; 
"Used to implement fake middle button on 2-button Dandelion.") (|DL24BitAddressable| WORD) (* \; 
"non-zero if DLion capable of addressing 32MB virtual memory") (REALPAGETABLEPTR FULLXPOINTER) (* \; 
"Address of real page table, set up by Bcpl (but not chained together)") (SYSDISK WORD) (* \; 
"WAS DLLastVmemPage, DLion booting microcode puts length of vmem file here.") (|FullSpaceUsed| WORD) (
* \; "Non-zero if vmem beyond initial 8MB has been allocated.") (FAKEKBDAD4 WORD) (FAKEKBDAD5 WORD) (*
 |;;| 
"The following 9 items (6 words and 3 pointers) are 3 3-element vectors for the Dorado extended virtual memory code--indexed by 0,1,2 according to which of up to 3 virtual memory backing files you're working with."
) (|XVmemFmapBase| WORD) (* \; 
"Bcpl stores isf map pointer to each partition here.  First is redundant with ISFMAP field above.") (
NIL WORD) (NIL WORD) (|XVmemFmapHighBase| WORD) (* \; 
"Bcpl stores the highest vm page contained in this or earlier partition.") (NIL WORD) (NIL WORD) (
|XVmemDiskBase| FULLXPOINTER) (* \; 
"Lisp stores disk objects here (just a convenient non-faulting contiguous block of storage).") (NIL 
FULLXPOINTER) (NIL FULLXPOINTER) (|DLLastVmemPage| FIXP) (* \; 
"DLion booting microcode puts length of vmem file here.") (|NActivePages| FIXP) (* \; 
"Length of vmem in use") (|NDirtyPages| FIXP) (* \; "not used, but maintained as = NActivePages")))
(RPAQQ IOPAGELAYOUT ((NIL 18 WORD) (DLMAINTPANEL WORD NIL T) (DLFLOPPYCMD WORD) (DLTTYPORTCMD WORD) (
DLPROCESSORCMD WORD) (NEWMOUSESTATE WORD) (DLBEEPCMD WORD) (DLRS232CMISCCOMMAND WORD) (DLRS232CPUTFLAG
 WORD) (DLRS232CGETFLAG WORD) (NIL 6 WORD) (DLFLOPPY WORD) (DLTTYOUT WORD) (NIL 1 WORD) (DLTTYIN WORD)
 (NIL 1 WORD) (DLPROCESSOR2 WORD) (DLPROCESSOR1 WORD) (DLPROCESSOR0 WORD) (NEWMOUSEX WORD) (NEWMOUSEY 
WORD) (DLBEEPFREQ WORD) (DLRS232CPARAMETERCSBLO WORD) (DLRS232CPARAMETERCSBHI WORD) (
DLRS232CSETRS366STATUS 3 WORD) (DLRS232CPUTCSBLO WORD) (DLRS232CPUTCSBHI WORD) (DLRS232CGETCSBLO WORD)
 (DLRS232CGETCSBHI WORD) (DLRS232CDEVICESTATUS WORD) (DLRS232CPARAMETEROUTCOME WORD) (DLTODVALID WORD)
 (DLTODLO WORD NIL T) (DLTODHI WORD) (DLTODLO2 WORD) (DLMOUSEX WORD NIL T) (DLMOUSEY WORD NIL T) (
DLUTILIN WORD NIL T) (DLKBDAD0 WORD NIL T) (DLKBDAD1 WORD NIL T) (DLKBDAD2 WORD NIL T) (DLKBDAD3 WORD 
NIL T) (DLKBDAD4 WORD NIL T) (DLKBDAD5 WORD NIL T) (DLLSEPIMAGECSB 32 WORD) (DLIOPHARDWARECONFIG WORD)
 (NIL 11 WORD) (DLRS232CPARAMETERCSBLO.11 WORD) (DLRS232CPARAMETERCSBHI.11 WORD) (
DLRS232CSETRS366STATUS.11 14 WORD) (NIL 60 WORD) (DLMAGTAPE 4 WORD) (DLETHERNET 12 WORD NIL T) (NIL 31
 WORD) (DLDISPINTERRUPT WORD NIL T) (DLDISPCONTROL WORD) (DLDISPBORDER WORD) (DLCURSORX WORD NIL T) (
DLCURSORY WORD NIL T) (DLCURSORBITMAP 16 WORD NIL T)))
(RPAQQ CDRCODING 1)
(RPAQQ \\SMALLP 1)
(RPAQQ \\FIXP 2)
(RPAQQ \\FLOATP 3)
(RPAQQ \\LITATOM 4)
(RPAQQ \\LISTP 5)
(RPAQQ \\ARRAYP 6)
(RPAQQ \\STRINGP 7)
(RPAQQ \\STACKP 8)
(RPAQQ \\CHARACTERP 9)
(RPAQQ \\VMEMPAGEP 10)
(RPAQQ \\STREAM 11)
(RPAQQ \\TT.TYPEMASK 2047)
(RPAQQ \\TT.NOREF 32768)
(RPAQQ \\TT.SYMBOLP 16384)
(RPAQQ \\TT.FIXP 8192)
(RPAQQ \\TT.NUMBERP 4096)
(RPAQQ \\TT.ATOM 2048)
(RPAQQ |\\PMblockSize| 32)
(RPAQQ |\\STATSsize| 8)
(RPAQQ |\\NumPMTpages| 8)
(RPAQQ |\\EmptyPMTEntry| 65535)
(RPAQQ |\\FirstVmemBlock| 2)
(RPAQQ \\MAXVMPAGE 131069)
(RPAQQ \\MAXVMSEGMENT 255)
(RPAQQ |\\IFPValidKey| 5603)
(RPAQQ |\\FirstMDSPage| 32766)
(RPAQQ |\\MaxMDSPage| 524285)
(RPAQQ |\\DefaultSecondMDSPage| 65532)
(RPAQQ |\\MDSIncrement| 512)
(RPAQQ |\\PagesPerMDSUnit| 2)
(RPAQQ |\\FirstArraySegment| 46)
(RPAQQ |\\FirstArrayPage| 11776)
(RPAQQ |\\DefaultSecondArrayPage| 32768)
(RPAQQ |\\StackMask| 57344)
(RPAQQ |\\FxtnBlock| 49152)
(RPAQQ |\\GuardBlock| 57344)
(RPAQQ |\\BFBlock| 32768)
(RPAQQ |\\FreeStackBlock| 40960)
(RPAQQ |\\NotStackBlock| 0)
(RPAQQ |\\MinExtraStackWords| 32)
(RPAQQ ERASECHARCODE 0)
(RPAQQ \\HT1CNT 1024)
(RPAQQ \\HTSTKBIT 512)
(RPAQQ \\HTCNTMASK 64512)
(RPAQQ \\HTMAINSIZE 65536)
(RPAQQ \\HTCOLLSIZE 1048576)
(RPAQQ \\HTENDFREE 1)
(RPAQQ \\HTFREEPTR 0)
(RPAQQ |\\AtomHI| 0)
(RPAQQ \\CHARHI 7)
(RPAQQ |\\AtomHTpages| 256)
(RPAQQ |\\LastAtomPage| 255)
(RPAQQ |\\MaxAtomFrLst| 65535)
(RPAQQ |\\SmallPosHi| 14)
(RPAQQ |\\SmallNegHi| 15)
(RPAQQ |\\NumSmallPages| 512)
(RPAQQ \\PNAME.HI 8)
(RPAQQ \\ATOM.HI 44)
(RPAQQ \\DEF.HI 10)
(RPAQQ \\VAL.HI 12)
(RPAQQ \\PLIST.HI 2)
(RPAQQ |\\NumPageMapPages| 256)
(RPAQQ |\\MDSTTsize| 1024)
(RPAQQ |\\UFNTableSize| 2)
(RPAQQ |\\DTDSize| 18)
(RPAQQ |\\EndTypeNumber| 2047)
(RPAQQ |\\NumLPTPages| 16)
(RPAQQ |\\GuardStackAddr| 61440)
(RPAQQ |\\LastStackAddr| 65534)
(RPAQQ \\STACKHI 1)
(RPAQQ |\\HTMAINnpages| 256)
(RPAQQ |\\D1BCPLspace| 0)
(RPAQQ |\\D0BCPLspace| 0)
(RPAQQ |\\CurrentFXP| 0)
(RPAQQ |\\ResetFXP| 1)
(RPAQQ |\\SubovFXP| 2)
(RPAQQ |\\KbdFXP| 3)
(RPAQQ |\\HardReturnFXP| 4)
(RPAQQ \\GCFXP 5)
(RPAQQ \\FAULTFXP 6)
(RPAQQ |\\MiscFXP| 14)
(RPAQQ |\\TeleRaidFXP| 24)
(RPAQQ DCB.EM 272)
(RPAQQ DISPINTERRUPT.EM 273)
(RPAQQ CURSORBITMAP.EM 281)
(RPAQQ KBDAD0.EM 65052)
(RPAQQ KBDAD1.EM 65053)
(RPAQQ KBDAD2.EM 65054)
(RPAQQ KBDAD3.EM 65055)
(RPAQQ UTILIN.EM 65048)
(RPAQQ CURSORX.EM 278)
(RPAQQ CURSORY.EM 279)
(RPAQQ MOUSEX.EM 276)
(RPAQQ MOUSEY.EM 277)
(RPAQQ |\\LispKeyMask| 8192)
(RPAQQ |\\BcplKeyMask| 4352)
(RPAQQ \\MAIKO 3)
(RPAQQ \\DOLPHIN 4)
(RPAQQ \\DORADO 5)
(RPAQQ \\DANDELION 6)
(RPAQQ \\DAYBREAK 8)
(RPAQQ \\VP.DISPLAY 4608)
(RPAQQ \\NP.DISPLAY 202)
(RPAQQ \\NP.WIDEDOVEDISPLAY 243)
(RPAQQ \\WIDEDOVEDISPLAYWIDTH 1152)
(RPAQQ \\RP.AFTERDISPLAY 206)
(RPAQQ \\RP.AFTERDOVEDISPLAY 243)
(RPAQQ \\RP.DISPLAY 0)
(RPAQQ \\RP.TEMPDISPLAY 2561)
(RPAQQ \\RP.MISCLOCKED 2804)
(RPAQQ \\RP.STACK 768)
(RPAQQ \\VP.STACK 256)
(RPAQQ \\RP.MAP 256)
(RPAQQ \\NP.MAP 256)
(RPAQQ \\RP.IOPAGE 512)
(RPAQQ \\RP.DOVEIOCBPAGE 543)
(RPAQQ \\RP.DOVEIORGN 544)
(RPAQQ \\VP.DOVEIORGN 64)
(RPAQQ \\DOVEIORGNSIZE 64)
(RPAQQ \\VP.IOPAGE 255)
(RPAQQ \\VP.IFPAGE 5120)
(RPAQQ \\VP.FPTOVP 512)
(RPAQQ \\NP.FPTOVP 4096)
(RPAQQ \\RP.FPTOVP 1024)
(RPAQQ \\RP.STARTBUFFERS 640)
(RPAQQ \\VP.TYPETABLE 6144)
(RPAQQ \\NP.TYPETABLE 1024)
(RPAQQ \\RP.TYPETABLE 5120)
(RPAQQ \\VP.GCTABLE 5632)
(RPAQQ \\NP.GCTABLE 256)
(RPAQQ \\RP.GCTABLE 6144)
(RPAQQ \\VP.GCOVERFLOW 5888)
(RPAQQ \\NP.GCOVERFLOW 1)
(RPAQQ \\RP.GCOVERFLOW 6400)
(RPAQQ \\FP.IFPAGE 2)
(RPAQQ \\VP.IOCBS 1)
(RPAQQ \\VP.PRIMARYMAP 5122)
(RPAQQ \\VP.SECONDARYMAP 1280)
(RPAQQ \\VP.LPT 5232)
(RPAQQ \\VP.INITSCRATCH 8)
(RPAQQ \\VP.RPT 128)
(RPAQQ \\VP.BUFFERS 218)
(RPAQQ \\DL.PROCESSORBUSY 32768)
(RPAQQ \\DL.SETTOD 32769)
(RPAQQ \\DL.READTOD 32770)
(RPAQQ \\DL.READPID 32771)
(RPAQQ \\DL.BOOTBUTTON 32772)
(CONSTANTS (CDRCODING 1) (\\SMALLP 1) (\\FIXP 2) (\\FLOATP 3) (\\LITATOM 4) (\\LISTP 5) (\\ARRAYP 6) (
\\STRINGP 7) (\\STACKP 8) (\\CHARACTERP 9) (\\VMEMPAGEP 10) (\\STREAM 11) (\\TT.TYPEMASK 2047) (
\\TT.NOREF 32768) (\\TT.SYMBOLP 16384) (\\TT.FIXP 8192) (\\TT.NUMBERP 4096) (\\TT.ATOM 2048) (
|\\PMblockSize| 32) (|\\STATSsize| 8) (|\\NumPMTpages| 8) (|\\EmptyPMTEntry| 65535) (
|\\FirstVmemBlock| 2) (\\MAXVMPAGE 131069) (\\MAXVMSEGMENT 255) (|\\IFPValidKey| 5603) (
|\\FirstMDSPage| 32766) (|\\MaxMDSPage| 524285) (|\\DefaultSecondMDSPage| 65532) (|\\MDSIncrement| 512
) (|\\PagesPerMDSUnit| 2) (|\\FirstArraySegment| 46) (|\\FirstArrayPage| 11776) (
|\\DefaultSecondArrayPage| 32768) (|\\StackMask| 57344) (|\\FxtnBlock| 49152) (|\\GuardBlock| 57344) (
|\\BFBlock| 32768) (|\\FreeStackBlock| 40960) (|\\NotStackBlock| 0) (|\\MinExtraStackWords| 32) (
ERASECHARCODE 0) (\\HT1CNT 1024) (\\HTSTKBIT 512) (\\HTCNTMASK 64512) (\\HTMAINSIZE 65536) (
\\HTCOLLSIZE 1048576) (\\HTENDFREE 1) (\\HTFREEPTR 0) (|\\AtomHI| 0) (\\CHARHI 7) (|\\AtomHTpages| 256
) (|\\LastAtomPage| 255) (|\\MaxAtomFrLst| 65535) (|\\SmallPosHi| 14) (|\\SmallNegHi| 15) (
|\\NumSmallPages| 512) (\\PNAME.HI 8) (\\ATOM.HI 44) (\\DEF.HI 10) (\\VAL.HI 12) (\\PLIST.HI 2) (
|\\NumPageMapPages| 256) (|\\MDSTTsize| 1024) (|\\UFNTableSize| 2) (|\\DTDSize| 18) (|\\EndTypeNumber|
 2047) (|\\NumLPTPages| 16) (|\\GuardStackAddr| 61440) (|\\LastStackAddr| 65534) (\\STACKHI 1) (
|\\HTMAINnpages| 256) (|\\D1BCPLspace| 0) (|\\D0BCPLspace| 0) (|\\CurrentFXP| 0) (|\\ResetFXP| 1) (
|\\SubovFXP| 2) (|\\KbdFXP| 3) (|\\HardReturnFXP| 4) (\\GCFXP 5) (\\FAULTFXP 6) (|\\MiscFXP| 14) (
|\\TeleRaidFXP| 24) (DCB.EM 272) (DISPINTERRUPT.EM 273) (CURSORBITMAP.EM 281) (KBDAD0.EM 65052) (
KBDAD1.EM 65053) (KBDAD2.EM 65054) (KBDAD3.EM 65055) (UTILIN.EM 65048) (CURSORX.EM 278) (CURSORY.EM 
279) (MOUSEX.EM 276) (MOUSEY.EM 277) (|\\LispKeyMask| 8192) (|\\BcplKeyMask| 4352) (\\MAIKO 3) (
\\DOLPHIN 4) (\\DORADO 5) (\\DANDELION 6) (\\DAYBREAK 8) (\\VP.DISPLAY 4608) (\\NP.DISPLAY 202) (
\\NP.WIDEDOVEDISPLAY 243) (\\WIDEDOVEDISPLAYWIDTH 1152) (\\RP.AFTERDISPLAY 206) (\\RP.AFTERDOVEDISPLAY
 243) (\\RP.DISPLAY 0) (\\RP.TEMPDISPLAY 2561) (\\RP.MISCLOCKED 2804) (\\RP.STACK 768) (\\VP.STACK 256
) (\\RP.MAP 256) (\\NP.MAP 256) (\\RP.IOPAGE 512) (\\RP.DOVEIOCBPAGE 543) (\\RP.DOVEIORGN 544) (
\\VP.DOVEIORGN 64) (\\DOVEIORGNSIZE 64) (\\VP.IOPAGE 255) (\\VP.IFPAGE 5120) (\\VP.FPTOVP 512) (
\\NP.FPTOVP 4096) (\\RP.FPTOVP 1024) (\\RP.STARTBUFFERS 640) (\\VP.TYPETABLE 6144) (\\NP.TYPETABLE 
1024) (\\RP.TYPETABLE 5120) (\\VP.GCTABLE 5632) (\\NP.GCTABLE 256) (\\RP.GCTABLE 6144) (
\\VP.GCOVERFLOW 5888) (\\NP.GCOVERFLOW 1) (\\RP.GCOVERFLOW 6400) (\\FP.IFPAGE 2) (\\VP.IOCBS 1) (
\\VP.PRIMARYMAP 5122) (\\VP.SECONDARYMAP 1280) (\\VP.LPT 5232) (\\VP.INITSCRATCH 8) (\\VP.RPT 128) (
\\VP.BUFFERS 218) (\\DL.PROCESSORBUSY 32768) (\\DL.SETTOD 32769) (\\DL.READTOD 32770) (\\DL.READPID 
32771) (\\DL.BOOTBUTTON 32772))
(RPAQQ \\MPERRORS ((\\MP.OBSOLETEVMEM 1) (\\MP.INVALIDVMEM 2 "Vmem inconsistent at startup") (
\\MP.IOCBPAGE 3 "No place for IOCB page at startup") (\\MP.MOB 4 "Map out of bounds") (
\\MP.INVALIDADDR 5) (\\MP.INVALIDVP 6) (\\MP.CHAIN.UNAVAIL 7 
"Unavailable page on real page table chain") (\\MP.SELECTLOOP 8 "Loop in \\SELECTREALPAGE") (
\\MP.NEWPAGE 9 "Attempt to allocate already existing page") (\\MP.NEWMAPPAGE 10 
"\\DONEWPAGE failed to allocate new map page") (\\MP.BADLOCKED 11 
"Locked page occupies a file page needed to lock another") (\\MP.CLOCK0 12 
"Arg to CLOCK0 not an integer box") (\\MP.RESIDENT 13 "Fault on resident page") (\\MP.STACKFAULT 14 
"Fault on stack") (\\MP.VMEMTOOLONG 16 "Attempt to extend Vmem File beyond fixed limit (8mb)") (
\\MP.WRITING.LOCKED.PAGE 17 "Writing a locked page with UPDATEKEY = T") (\\MP.UNINTERRUPTABLE 18 
"Error in uninterruptable system code") (\\MP.STACKFULL 19) (\\MP.MDSFULL 20) (\\MP.UNKNOWN.UFN 21) (
\\MP.ATOMSFULL 22) (\\MP.PNAMESFULL 23) (\\MP.USECOUNTOVERFLOW 24) (\\MP.MDSFULLWARNING 25) (
\\MP.BADMDSFREELIST 26) (\\MP.BADARRAYBLOCK 27) (\\MP.BADDELETEBLOCK 28) (\\MP.BADARRAYRECLAIM 29) (
\\MP.BIGREFCNTMISSING 30 "PTR refcnt previously overflowed, but not found in table.") (
\\MP.BIGREFCNTALREADYPRESENT 31 "PTR already in overflow table") (\\MP.DELREF0 32) (\\MP.PROCERROR 33)
 (\\MP.PROCNOFRAME 34 "Failed to build frame for PROCESS use") (\\MP.32MBINUSE 35) (\\MP.TOPUNWOUND 36
 "Unexpected (RETTO T)") (\\MP.STACKRELEASED 37) (\\MP.FLUSHLOCKED 38) (\\MP.MAPNOTLOCKED 39) (
\\MP.UNLOCKINGMAP 40) (\\MP.SWAPDISKERROR 41 "Hard Disk Error in swapper") (\\MP.BADRUNTABLE 42 
"Malformed run table for vmem file")))
(RPAQQ \\MP.OBSOLETEVMEM 1)
(RPAQ \\MP.INVALIDVMEM 2 "Vmem inconsistent at startup")
(RPAQ \\MP.IOCBPAGE 3 "No place for IOCB page at startup")
(RPAQ \\MP.MOB 4 "Map out of bounds")
(RPAQQ \\MP.INVALIDADDR 5)
(RPAQQ \\MP.INVALIDVP 6)
(RPAQ \\MP.CHAIN.UNAVAIL 7 "Unavailable page on real page table chain")
(RPAQ \\MP.SELECTLOOP 8 "Loop in \\SELECTREALPAGE")
(RPAQ \\MP.NEWPAGE 9 "Attempt to allocate already existing page")
(RPAQ \\MP.NEWMAPPAGE 10 "\\DONEWPAGE failed to allocate new map page")
(RPAQ \\MP.BADLOCKED 11 "Locked page occupies a file page needed to lock another")
(RPAQ \\MP.CLOCK0 12 "Arg to CLOCK0 not an integer box")
(RPAQ \\MP.RESIDENT 13 "Fault on resident page")
(RPAQ \\MP.STACKFAULT 14 "Fault on stack")
(RPAQ \\MP.VMEMTOOLONG 16 "Attempt to extend Vmem File beyond fixed limit (8mb)")
(RPAQ \\MP.WRITING.LOCKED.PAGE 17 "Writing a locked page with UPDATEKEY = T")
(RPAQ \\MP.UNINTERRUPTABLE 18 "Error in uninterruptable system code")
(RPAQQ \\MP.STACKFULL 19)
(RPAQQ \\MP.MDSFULL 20)
(RPAQQ \\MP.UNKNOWN.UFN 21)
(RPAQQ \\MP.ATOMSFULL 22)
(RPAQQ \\MP.PNAMESFULL 23)
(RPAQQ \\MP.USECOUNTOVERFLOW 24)
(RPAQQ \\MP.MDSFULLWARNING 25)
(RPAQQ \\MP.BADMDSFREELIST 26)
(RPAQQ \\MP.BADARRAYBLOCK 27)
(RPAQQ \\MP.BADDELETEBLOCK 28)
(RPAQQ \\MP.BADARRAYRECLAIM 29)
(RPAQ \\MP.BIGREFCNTMISSING 30 "PTR refcnt previously overflowed, but not found in table.")
(RPAQ \\MP.BIGREFCNTALREADYPRESENT 31 "PTR already in overflow table")
(RPAQQ \\MP.DELREF0 32)
(RPAQQ \\MP.PROCERROR 33)
(RPAQ \\MP.PROCNOFRAME 34 "Failed to build frame for PROCESS use")
(RPAQQ \\MP.32MBINUSE 35)
(RPAQ \\MP.TOPUNWOUND 36 "Unexpected (RETTO T)")
(RPAQQ \\MP.STACKRELEASED 37)
(RPAQQ \\MP.FLUSHLOCKED 38)
(RPAQQ \\MP.MAPNOTLOCKED 39)
(RPAQQ \\MP.UNLOCKINGMAP 40)
(RPAQ \\MP.SWAPDISKERROR 41 "Hard Disk Error in swapper")
(RPAQ \\MP.BADRUNTABLE 42 "Malformed run table for vmem file")
(CONSTANTS (\\MP.OBSOLETEVMEM 1) (\\MP.INVALIDVMEM 2 "Vmem inconsistent at startup") (\\MP.IOCBPAGE 3 
"No place for IOCB page at startup") (\\MP.MOB 4 "Map out of bounds") (\\MP.INVALIDADDR 5) (
\\MP.INVALIDVP 6) (\\MP.CHAIN.UNAVAIL 7 "Unavailable page on real page table chain") (\\MP.SELECTLOOP 
8 "Loop in \\SELECTREALPAGE") (\\MP.NEWPAGE 9 "Attempt to allocate already existing page") (
\\MP.NEWMAPPAGE 10 "\\DONEWPAGE failed to allocate new map page") (\\MP.BADLOCKED 11 
"Locked page occupies a file page needed to lock another") (\\MP.CLOCK0 12 
"Arg to CLOCK0 not an integer box") (\\MP.RESIDENT 13 "Fault on resident page") (\\MP.STACKFAULT 14 
"Fault on stack") (\\MP.VMEMTOOLONG 16 "Attempt to extend Vmem File beyond fixed limit (8mb)") (
\\MP.WRITING.LOCKED.PAGE 17 "Writing a locked page with UPDATEKEY = T") (\\MP.UNINTERRUPTABLE 18 
"Error in uninterruptable system code") (\\MP.STACKFULL 19) (\\MP.MDSFULL 20) (\\MP.UNKNOWN.UFN 21) (
\\MP.ATOMSFULL 22) (\\MP.PNAMESFULL 23) (\\MP.USECOUNTOVERFLOW 24) (\\MP.MDSFULLWARNING 25) (
\\MP.BADMDSFREELIST 26) (\\MP.BADARRAYBLOCK 27) (\\MP.BADDELETEBLOCK 28) (\\MP.BADARRAYRECLAIM 29) (
\\MP.BIGREFCNTMISSING 30 "PTR refcnt previously overflowed, but not found in table.") (
\\MP.BIGREFCNTALREADYPRESENT 31 "PTR already in overflow table") (\\MP.DELREF0 32) (\\MP.PROCERROR 33)
 (\\MP.PROCNOFRAME 34 "Failed to build frame for PROCESS use") (\\MP.32MBINUSE 35) (\\MP.TOPUNWOUND 36
 "Unexpected (RETTO T)") (\\MP.STACKRELEASED 37) (\\MP.FLUSHLOCKED 38) (\\MP.MAPNOTLOCKED 39) (
\\MP.UNLOCKINGMAP 40) (\\MP.SWAPDISKERROR 41 "Hard Disk Error in swapper") (\\MP.BADRUNTABLE 42 
"Malformed run table for vmem file"))
(GLOBALVARS \\ARRAYSPACE \\ARRAYSPACE2 \\ATOMSPACE |\\AtomHashTable| \\SMALLPOSPSPACE \\SMALLNEGSPACE 
\\PNPSPACE \\OLDATOMSPACE \\DEFSPACE \\VALSPACE \\PLISTSPACE \\PAGEMAP |\\PageMapTBL| 
|\\InterfacePage| \\IOPAGE |\\DoveIORegion| \\IOCBPAGE \\FPTOVP |\\MDSTypeTable| \\MISCSTATS 
|\\UFNTable| |\\DTDSpaceBase| \\LISTPDTD \\LOCKEDPAGETABLE \\STACKSPACE \\HTMAIN \\HTOVERFLOW 
\\HTBIGCOUNT \\HTCOLL \\DISPLAYREGION)
(BLOCKRECORD MISCSTATS ((STARTTIME FIXP) (TOTALTIME FIXP) (SWAPWAITTIME FIXP) (PAGEFAULTS FIXP) (
SWAPWRITES FIXP) (DISKIOTIME FIXP) (DISKOPS FIXP) (KEYBOARDWAITTIME FIXP) (GCTIME FIXP) (NETIOTIME 
FIXP) (NETIOOPS FIXP) (SWAPTEMP0 FIXP) (SWAPTEMP1 FIXP) (RCLKSECOND FIXP) (SECONDSCLOCK FIXP) (
MILLISECONDSCLOCK FIXP) (BASECLOCK FIXP) (RCLKTEMP0 FIXP) (SECONDSTMP FIXP) (MILLISECONDSTMP FIXP) (
BASETMP FIXP) (EXCESSTIMETMP FIXP) (CLOCKTEMP0 FIXP) (DISKTEMP0 FIXP) (DISKTEMP1 FIXP) (TELERAIDTEMP1 
FIXP) (TELERAIDTEMP2 FIXP) (TELERAIDTEMP3 FIXP) (LASTUSERACTION FIXP) (DLMOUSETIMER FIXP) (DLMOUSETEMP
 FIXP)) (CREATE (\\ALLOCBLOCK 31)))
(BLOCKRECORD IFPAGE ((|CurrentFXP| WORD) (* \; 
"First 7 items are FX values for user and 6 system contexts.") (|ResetFXP| WORD) (|SubovFXP| WORD) (
|KbdFXP| WORD) (|HardReturnFXP| WORD) (GCFXP WORD) (FAULTFXP WORD) (|EndOfStack| WORD) (* \; 
"Stack high-water mark: address of guard block at current end of stack") (|LVersion| WORD) (* \; 
"Lisp version, followed by min versions of microcode and Bcpl compatible with this Lisp") (
|MinRVersion| WORD) (|MinBVersion| WORD) (|RVersion| WORD) (* \; 
"Bcpl fills in the actual microcode, Bcpl versions.") (|BVersion| WORD) (|MachineType| WORD) (
|MiscFXP| WORD) (* \; "FX for MISC context") (|Key| WORD) (* \; "= IFPValidKey if vmem consistent.") (
|SerialNumber| WORD) (* \; "Pup host number (Dorado/Dolphin)") (|EmulatorSpace| WORD) (* \; 
"Hiloc of bcpl space (always zero now)") (|ScreenWidth| WORD) (|NxtPMAddr| WORD) (* \; 
"Next page to be allocated in secondary page map table") (NIL WORD) (* \; 
"WAS NActivePages, Length of vmem in use") (NIL WORD) (* \; 
"WAS NDirtyPages, not used, but maintained as = NActivePages") (|filePnPMP0| WORD) (* \; 
"Sysout page number of first page of secondary page map table (\\PAGEMAP), which is where the secondary map pages themselves live"
) (|filePnPMT0| WORD) (* \; "Sysout page number of first page of primary page map table") (TELERAIDFXP
 WORD) (* \; "FX for TeleRaid server context") (NATIVE-START-MEM-PAGE WORD) (* \; 
"Unix page where native code starts") (NATIVE-LENGTH-PAGE WORD) (* \; 
"Unix page length of native code") (NATIVE-PAGE-OFFSET WORD) (* \; 
"Lisp Disk Page offset  of native code") (|UserNameAddr| WORD) (* \; 
"Addresses in bcpl space (seg 0) of global user name and password") (|UserPswdAddr| WORD) (|StackBase|
 WORD) (* \; "Stack address where user stack starts") (FAULTHI WORD) (* \; 
"Microcode for page fault stores fault address here, then does context switch to FAULTFXP") (FAULTLO 
WORD) (DEVCONFIG WORD) (* \; "IT'S FOR KB,DISP TYPE") (* \; 
"Formerly REALPAGETABLE, back when it was always in Bcpl space.") (RPTSIZE WORD) (* \; 
"Number of entries in Real Page Table") (RPOFFSET WORD) (* \; "RP-RPOFFSET => index in table") (
MAXETHERBYTES WORD) (* \; "Number of bytes available in a pbi, not counting encapsulation (Dorado)") (
EMBUFVP WORD) (* \; "VP of a one-page emulator buffer") (|NSHost0| WORD) (* \; 
"Machine's 48-bit NS host number.  Lisp manages to compute this on all machines except Dolphin, where Bcpl fills it in."
) (|NSHost1| WORD) (|NSHost2| WORD) (|MDSZone| WORD) (* \; 
"Obsolete -- was used by Dolphin 10MB network code.") (|MDSZoneLength| WORD) (EMUBUFFERS WORD) (* \; 
"Buffer space in segment 0 for swapping/disk activity") (EMUBUFLENGTH WORD) (* \; 
"Number of words of said space") (* |;;| 
"The following 2 are available if NEW_STOARGE is specified in C") (|ProcessSize| WORD) (* \; 
"Process size for which can be use as LISP space") (|StorageFullState| WORD) (* \; 
"Save last storage state") (ISFMAP WORD) (* |;;| 
"The following 4 are for \\MISCAPPLY* -- note that they are not ref counted, so don't pass the only pointer to something this way!"
) (MISCSTACKFN FULLXPOINTER) (MISCSTACKARG1 FULLXPOINTER) (MISCSTACKARG2 FULLXPOINTER) (
MISCSTACKRESULT FULLXPOINTER) (|NRealPages| WORD) (* \; "Number pages of real memory") (
|LastLockedFilePage| WORD) (* \; 
"Last page of vmem that is locked--booting has to load at least that far.") (|LastDominoFilePage| WORD
) (* \; "Last sysout page reserved for Dandelion microcode") (|FPTOVPStart| WORD) (* \; 
"Sysout page where FPTOVP starts") (FAKEMOUSEBITS WORD) (* \; 
"Used to implement fake middle button on 2-button Dandelion.") (|DL24BitAddressable| WORD) (* \; 
"non-zero if DLion capable of addressing 32MB virtual memory") (REALPAGETABLEPTR FULLXPOINTER) (* \; 
"Address of real page table, set up by Bcpl (but not chained together)") (SYSDISK WORD) (* \; 
"WAS DLLastVmemPage, DLion booting microcode puts length of vmem file here.") (|FullSpaceUsed| WORD) (
* \; "Non-zero if vmem beyond initial 8MB has been allocated.") (FAKEKBDAD4 WORD) (FAKEKBDAD5 WORD) (*
 |;;| 
"The following 9 items (6 words and 3 pointers) are 3 3-element vectors for the Dorado extended virtual memory code--indexed by 0,1,2 according to which of up to 3 virtual memory backing files you're working with."
) (|XVmemFmapBase| WORD) (* \; 
"Bcpl stores isf map pointer to each partition here.  First is redundant with ISFMAP field above.") (
NIL WORD) (NIL WORD) (|XVmemFmapHighBase| WORD) (* \; 
"Bcpl stores the highest vm page contained in this or earlier partition.") (NIL WORD) (NIL WORD) (
|XVmemDiskBase| FULLXPOINTER) (* \; 
"Lisp stores disk objects here (just a convenient non-faulting contiguous block of storage).") (NIL 
FULLXPOINTER) (NIL FULLXPOINTER) (|DLLastVmemPage| FIXP) (* \; 
"DLion booting microcode puts length of vmem file here.") (|NActivePages| FIXP) (* \; 
"Length of vmem in use") (|NDirtyPages| FIXP) (* \; "not used, but maintained as = NActivePages")) (
CREATE (\\ALLOCBLOCK 43)))
(BLOCKRECORD IOPAGE ((NIL 18 WORD) (DLMAINTPANEL WORD) (DLFLOPPYCMD WORD) (DLTTYPORTCMD WORD) (
DLPROCESSORCMD WORD) (NEWMOUSESTATE WORD) (DLBEEPCMD WORD) (DLRS232CMISCCOMMAND WORD) (DLRS232CPUTFLAG
 WORD) (DLRS232CGETFLAG WORD) (NIL 6 WORD) (DLFLOPPY WORD) (DLTTYOUT WORD) (NIL 1 WORD) (DLTTYIN WORD)
 (NIL 1 WORD) (DLPROCESSOR2 WORD) (DLPROCESSOR1 WORD) (DLPROCESSOR0 WORD) (NEWMOUSEX WORD) (NEWMOUSEY 
WORD) (DLBEEPFREQ WORD) (DLRS232CPARAMETERCSBLO WORD) (DLRS232CPARAMETERCSBHI WORD) (
DLRS232CSETRS366STATUS 3 WORD) (DLRS232CPUTCSBLO WORD) (DLRS232CPUTCSBHI WORD) (DLRS232CGETCSBLO WORD)
 (DLRS232CGETCSBHI WORD) (DLRS232CDEVICESTATUS WORD) (DLRS232CPARAMETEROUTCOME WORD) (DLTODVALID WORD)
 (DLTODLO WORD) (DLTODHI WORD) (DLTODLO2 WORD) (DLMOUSEX WORD) (DLMOUSEY WORD) (DLUTILIN WORD) (
DLKBDAD0 WORD) (DLKBDAD1 WORD) (DLKBDAD2 WORD) (DLKBDAD3 WORD) (DLKBDAD4 WORD) (DLKBDAD5 WORD) (
DLLSEPIMAGECSB 32 WORD) (DLIOPHARDWARECONFIG WORD) (NIL 11 WORD) (DLRS232CPARAMETERCSBLO.11 WORD) (
DLRS232CPARAMETERCSBHI.11 WORD) (DLRS232CSETRS366STATUS.11 14 WORD) (NIL 60 WORD) (DLMAGTAPE 4 WORD) (
DLETHERNET 12 WORD) (NIL 31 WORD) (DLDISPINTERRUPT WORD) (DLDISPCONTROL WORD) (DLDISPBORDER WORD) (
DLCURSORX WORD) (DLCURSORY WORD) (DLCURSORBITMAP 16 WORD)) (ACCESSFNS IOPAGE ((DLCURSORBITMAPPTR (
\\ADDBASE DATUM 240)) (DLCURSORYPTR (\\ADDBASE DATUM 239)) (DLCURSORXPTR (\\ADDBASE DATUM 238)) (
DLDISPINTERRUPTPTR (\\ADDBASE DATUM 235)) (DLETHERNETPTR (\\ADDBASE DATUM 192)) (DLKBDAD5PTR (
\\ADDBASE DATUM 67)) (DLKBDAD4PTR (\\ADDBASE DATUM 66)) (DLKBDAD3PTR (\\ADDBASE DATUM 65)) (
DLKBDAD2PTR (\\ADDBASE DATUM 64)) (DLKBDAD1PTR (\\ADDBASE DATUM 63)) (DLKBDAD0PTR (\\ADDBASE DATUM 62)
) (DLUTILINPTR (\\ADDBASE DATUM 61)) (DLMOUSEYPTR (\\ADDBASE DATUM 60)) (DLMOUSEXPTR (\\ADDBASE DATUM 
59)) (DLTODLOPTR (\\ADDBASE DATUM 56)) (DLMAINTPANELPTR (\\ADDBASE DATUM 18)))) (CREATE (\\ALLOCBLOCK 
128)))
(PUTPROPS EMADDRESS MACRO (ARGS ((LAMBDA (ADDR) (COND ((EQ |\\D1BCPLspace| |\\D0BCPLspace|) (LIST (
LIST (QUOTE OPCODES) (QUOTE GCONST) 0 0 (LRSH ADDR 8) (LOGAND ADDR 255)))) (T (BQUOTE (\\VAG2 (|fetch|
 |EmulatorSpace| |of| |\\InterfacePage|) \, ADDR))))) (EVAL (CAR ARGS)))))
(PUTPROPS EMGETBASE MACRO ((OFFSET) (\\GETBASE (EMADDRESS OFFSET) 0)))
(PUTPROPS EMPUTBASE MACRO ((OFFSET VAL) (\\PUTBASE (EMADDRESS OFFSET) 0 VAL)))
(PUTPROPS EMULATORSEGMENT MACRO (NIL (|fetch| |EmulatorSpace| |of| |\\InterfacePage|)))
(PUTPROPS EMPOINTER MACRO (X (COND ((NEQ |\\D1BCPLspace| |\\D0BCPLspace|) (LIST (QUOTE \\VAG2) (QUOTE 
(|fetch| (IFPAGE |EmulatorSpace|) |of| |\\InterfacePage|)) (CAR X))) ((ZEROP (CAR X)) NIL) (T (LIST (
QUOTE \\VAG2) |\\D0BCPLspace| (CAR X))))))
(PUTPROPS EMADDRESSP MACRO (X (LIST (QUOTE EQ) (LIST (QUOTE \\HILOC) (CAR X)) (COND ((EQ 
|\\D1BCPLspace| |\\D0BCPLspace|) |\\D0BCPLspace|) (T (QUOTE (|fetch| (IFPAGE |EmulatorSpace|) |of| 
|\\InterfacePage|)))))))
(PUTPROP (QUOTE LLPARAMS) (QUOTE IMPORTDATE) (IDATE " 7-Feb-2021 11:52:02"))

(DATATYPE COMPILED-CLOSURE (FNHEADER ENVIRONMENT))
(RPAQQ \\COMPILED-CLOSURE 13)
(CONSTANTS \\COMPILED-CLOSURE)
(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)))))
(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))))))))
(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)))
(PUTPROPS BYTESPERNAMEENTRY MACRO (NIL (UNFOLD (CONSTANT (WORDSPERNAMEENTRY)) BYTESPERWORD)))
(PUTPROPS BYTESPERNTOFFSETENTRY MACRO (NIL (UNFOLD (WORDSPERNAMEENTRY) BYTESPERWORD)))
(PUTPROPS GETNAMEENTRY MACRO (OPENLAMBDA (DEF LC) (LET ((NUMBER 0)) (* |;;| 
"Must ALWAYS be called with DEF really being either a FNHEADER or a nametable pseudo-fnheader.  Never use addbase to offset from it.  This is because CODEBASEELT checks the BYTESWAPPED flag in the fnheader...."
) (FOR I FROM 0 TO (CONSTANT (SUB1 (BYTESPERNAMEENTRY))) DO (SETQ NUMBER (LOGOR (LLSH NUMBER 
BITSPERBYTE) (CODEBASELT DEF (IPLUS LC I))))) NUMBER)))
(PUTPROPS GETNTFLAGS MACRO (OPENLAMBDA (DEF LC) (CODEBASELT DEF LC)))
(PUTPROPS GETNTOFFSET MACRO (OPENLAMBDA (DEF LC) (NTSLOT-OFFSET (GETNTOFFSETENTRY DEF LC))))
(PUTPROPS GETNTOFFSETENTRY MACRO (OPENLAMBDA (DEF LC) (LET ((NUMBER 0)) (|for| I |from| 0 |to| (
CONSTANT (SUB1 (BYTESPERNTOFFSETENTRY))) |do| (SETQ NUMBER (LOGOR (LLSH NUMBER BITSPERBYTE) (
CODEBASELT DEF (IPLUS LC I))))) NUMBER)))
(PUTPROPS GETNTTAG MACRO (OPENLAMBDA (DEF LC) (CODEBASELT DEF (ADD1 LC))))
(PUTPROPS SETNAMEENTRY MACRO (OPENLAMBDA (DEF LC VALUE) (FOR I FROM (CONSTANT (SUB1 (BYTESPERNAMEENTRY
))) TO 0 BY -1 DO (CODEBASESETA DEF (IPLUS LC I) (LOGAND VALUE (CONSTANT (SUB1 (LLSH 1 BITSPERBYTE))))
) (SETQ VALUE (LRSH VALUE BITSPERBYTE)))))
(PUTPROPS WORDSPERNTOFFSETENTRY MACRO (NIL (WORDSPERNAMEENTRY)))
(PUTPROPS NTSLOT-OFFSET MACRO ((X) (LOGAND 255 X)))
(DEFMACRO NEW-SYMBOL-CODE (NEW-SYMBOL-FORM OLD-SYMBOL-FORM) (* |;;| 
"Use one form or another, depending on whether we're compiling for new 3-byte atoms or old 2-byte atom numbers."
) (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) (* \; "NEW ATOMS") (BQUOTE (\\\, 
NEW-SYMBOL-FORM))) (T (BQUOTE (\\\, OLD-SYMBOL-FORM)))))
(DEFOPTIMIZER BIG-VMEM-CODE (NEW-SYMBOL-FORM OLD-SYMBOL-FORM &ENVIRONMENT ENV) (* |;;| 
"Allow for differences between 4-byte pointers and 3-byte pointers..") (COND ((FMEMB :4-BYTE (
COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\\\, NEW-SYMBOL-FORM))) (T (BQUOTE (\\\, 
OLD-SYMBOL-FORM)))))
(DEFOPTIMIZER SETSTKNAMEENTRY (CODEARRAY OFFSET VAL &ENVIRONMENT ENV) (* |;;| 
"Set the name entry for a name-table entry.") (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE
 ENV)) (BQUOTE (LET ((BASE (|fetch| (ARRAYP BASE) |of| (\\\, CODEARRAY))) (VALUE (\\\, VAL))) (COND ((
FIXP VALUE) (* \; "A 20-byte atom #.  Make it an atom.") (\\PUTBASEPTR BASE (\\\, OFFSET) (\\VAG2 
|\\AtomHI| VALUE))) (T (* \; "A 3-byte atom.  Just use it.") (\\PUTBASEPTR BASE (\\\, OFFSET) VALUE)))
))) (T (BQUOTE (LET ((BASE (|fetch| (ARRAYP BASE) |of| (\\\, CODEARRAY)))) (\\PUTBASE BASE (\\\, 
OFFSET) (\\\, VAL)))))))
(DEFOPTIMIZER SETSTKNTOFFSETENTRY (BASE OFFSET VAL &ENVIRONMENT ENV) (* |;;| 
"Set the offset entry for a name-table entry.") (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE
 ENV)) (BQUOTE (\\PUTBASEFIXP (\\\, BASE) (\\\, OFFSET) (\\\, VAL)))) (T (BQUOTE (\\PUTBASE (\\\, BASE
) (\\\, OFFSET) (\\\, VAL))))))
(DEFOPTIMIZER GETSTKNAMEENTRY (BASE OFFSET &ENVIRONMENT ENV) (* |;;| 
"Get a name entry out of a name table.  BASE is the start of the name table; OFFSET is in words, not bytes or name entries."
) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\\GETBASEPTR (\\\, BASE) (
\\\, OFFSET)))) (T (BQUOTE (\\GETBASE (\\\, BASE) (\\\, OFFSET))))))
(DEFOPTIMIZER GETSTKNTOFFSETENTRY (BASE OFFSET &ENVIRONMENT ENV) (COND ((FMEMB :3-BYTE (
COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\\GETBASEFIXP (\\\, BASE) (\\\, OFFSET)))) (T (BQUOTE
 (\\GETBASE (\\\, BASE) (\\\, OFFSET))))))
(DEFOPTIMIZER WORDSPERNAMEENTRY (&ENVIRONMENT ENV) (* |;;| 
"Number of words in a name-table \"Name\" entry--the space for the symbol.  1 for old symbol systems, 2 for 3-byte-atom systesm."
) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (PROGN 2))) ((AND 
CROSSCOMPILING (FMEMB :3-BYTE-INIT (COMPILER::ENV-TARGET-ARCHITECTURE ENV))) (BQUOTE (PROGN 2))) (T (
BQUOTE (PROGN 1)))))
(DEFOPTIMIZER SETSTKNTOFFSET (BASE OFFSET TYPE VAL &ENVIRONMENT ENV) (* |;;| 
"Set the offset entry for a name-table entry, from the symbol to fill in plus the variable-type marker value SHIFTED LEFT 14 BITS ALREADY."
) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (PROGN (\\FIXCODENUM (\\\, 
BASE) (IDIFFERENCE (\\\, OFFSET) BYTESPERWORD) (\\\, TYPE)) (\\FIXCODENUM (\\\, BASE) (\\\, OFFSET) (
\\\, VAL))))) (T (BQUOTE (\\FIXCODENUM (\\\, BASE) (\\\, OFFSET) (IPLUS (\\\, TYPE) (\\\, VAL)))))))
(DEFOPTIMIZER SETSTKNAME-RAW (BASE OFFSET VAL &ENVIRONMENT ENV) (* |;;| 
"Set the name entry for a name-table entry. This version works with raw storage, as opposed to SETSTKNAMEENTRY, which works on an ARRAYP."
) (* |;;| "If this optimizer changes, change SETSTKNAMEENTRY as well.") (COND ((FMEMB :3-BYTE (
COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (LET ((VALUE (\\\, VAL))) (COND ((FIXP VALUE) (* \; 
"A 20-byte atom #.  Make it an atom.") (\\PUTBASEPTR (\\\, BASE) (\\\, OFFSET) (\\VAG2 |\\AtomHI| 
VALUE))) (T (* \; "A 3-byte atom.  Just use it.") (\\PUTBASEPTR (\\\, BASE) (\\\, OFFSET) VALUE)))))) 
(T (BQUOTE (\\PUTBASE (\\\, BASE) (\\\, OFFSET) (\\\, VAL))))))
(DEFOPTIMIZER SETSTKNTOFFSET-RAW (BASE OFFSET TYPE VAL &ENVIRONMENT ENV) (* |;;| 
"Set the offset entry for a name-table entry.  This version works on raw storage, vs SETSTKNAMEOFFSETENTRY, which is supposed to work on codearrays.  Any changes here should be made there, as well.  TYPE must already be shifted left by 14 bits."
) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (PROGN (\\PUTBASE (\\\, BASE)
 (\\\, OFFSET) (\\\, TYPE)) (\\PUTBASE (\\\, BASE) (IPLUS (\\\, OFFSET) 1) (\\\, VAL))))) (T (BQUOTE (
\\PUTBASE (\\\, BASE) (\\\, OFFSET) (IPLUS (\\\, TYPE) (\\\, VAL)))))))
(DEFOPTIMIZER NEW-SYMBOL-CODE (NEW-SYMBOL-FORM OLD-SYMBOL-FORM &ENVIRONMENT ENV) (* |;;| 
"Allow for differences between 3-byte atoms and 2-byte atoms.") (COND ((FMEMB :3-BYTE (
COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\\\, NEW-SYMBOL-FORM))) (T (BQUOTE (\\\, 
OLD-SYMBOL-FORM)))))
(DEFOPTIMIZER MAKE-NTENTRY (TYPE OFFSET &ENVIRONMENT ENV) (COND ((FMEMB :3-BYTE (
COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (IPLUS (CONSTANT (LLSH (\\\, TYPE) 16)) (\\\, OFFSET))
)) (T (BQUOTE (IPLUS (CONSTANT (\\\, TYPE)) (\\\, OFFSET))))))
(DEFOPTIMIZER NULL-NTENTRY (VALUE &ENVIRONMENT ENV) (* |;;| 
"Predicate:  Is  VALUE a null entry in a name table?  I.e., does it result from fetching the entry at the end that`s all zeros?  For 2-byte atoms, that's the same as being zero.  For 3-byte atoms, it's the same as being NIL."
) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (NULL (\\\, VALUE)))) (T (
BQUOTE (EQ (\\\, VALUE) 0)))))
(DEFOPTIMIZER NTSLOT-VARTYPE (X &ENVIRONMENT ENV) (* |;;| 
"Given the contents of a name-table Offset entry, return the variable-type bits at the top of the entry.  THE RESULT IS RETURNED SHEFTED LEFT 14 BITS, THE USUAL REPRESENTATION."
) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (LOGAND 49153 (LRSH (\\\, X) 
16)))) (T (BQUOTE (LOGAND (\\\, X) 49152)))))
(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) 207) (LLSH (LOGAND NEWVALUE 3) 4)))) (FRAMENAME (\\VAG2 (LOGAND (CODELT2 DATUM
 8) 4095) (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| (\\STKMIN DATUM))) (FRAMENAME# (PROGN 8)))))
(RECORD OPCODE (OP# OPCODENAME OPNARGS OPPRINT LEVADJ UFNFN UNIMPL))
(GLOBALVARS \\OPCODES)
(RPAQQ PVARCODE 32768)
(RPAQQ FVARCODE 49152)
(RPAQQ IVARCODE 0)
(RPAQQ VARCODEMASK 49152)
(CONSTANTS PVARCODE FVARCODE IVARCODE VARCODEMASK)
(RPAQQ \\NT.IVARCODE 0)
(RPAQQ \\NT.PVARCODE 2)
(RPAQQ \\NT.FVARCODE 3)
(CONSTANTS \\NT.IVARCODE \\NT.PVARCODE \\NT.FVARCODE)
(PUTPROP (QUOTE LLCODE) (QUOTE IMPORTDATE) (IDATE "19-Jan-1993 10:45:33"))

(RPAQQ \\ERRORMESSAGELIST ("SYSTEM ERROR" " " "STACK OVERFLOW" "ILLEGAL RETURN" "ARG NOT LIST" 
"HARD DISK ERROR" "ATTEMPT TO SET NIL OR T" "ATTEMPT TO RPLAC NIL" "UNDEFINED OR ILLEGAL GO" 
"FILE WON'T OPEN" "NON-NUMERIC ARG" "ATOM TOO LONG" "ATOM HASH TABLE FULL" "FILE NOT OPEN" 
"ARG NOT LITATOM" "! too many files open" "END OF FILE" "ERROR" "BREAK" "ILLEGAL STACK ARG" 
"FAULT IN EVAL" "ARRAYS FULL" "FILE SYSTEM RESOURCES EXCEEDED" "FILE NOT FOUND" "BAD SYSOUT FILE" 
"UNUSUAL CDR ARG LIST" "HASH TABLE FULL" "ILLEGAL ARG" "ARG NOT ARRAY" "ILLEGAL OR IMPOSSIBLE BLOCK" 
"STACK PTR HAS BEEN RELEASED" "STORAGE FULL" "ATTEMPT TO USE ITEM OF INCORRECT TYPE" 
"ILLEGAL DATA TYPE NUMBER" "DATA TYPES FULL" "ATTEMPT TO BIND NIL OR T" 
"! too many user interrupt characters" "! read-macro context error" "ILLEGAL READTABLE" 
"ILLEGAL TERMINAL TABLE" "! swapblock too big for buffer" "PROTECTION VIOLATION" "BAD FILE NAME" 
"USER BREAK" "UNBOUND ATOM" "UNDEFINED CAR OF FORM" "UNDEFINED FUNCTION" "CONTROL-E" 
"FLOATING UNDERFLOW" "FLOATING OVERFLOW" "OVERFLOW" "ARG NOT HARRAY" "TOO MANY ARGUMENTS"))
(DEFOPTIMIZER LISPERROR (MESSAGE ARG) (BQUOTE (\\LISPERROR (\\\, ARG) (\\\, (CL:IF (CL:STRINGP MESSAGE
) (FOR X IN \\ERRORMESSAGELIST AS I FROM 0 WHEN (CL:EQUAL X MESSAGE) DO (RETURN I) FINALLY (RETURN (
HELP "Unknown error message" (LIST MESSAGE ARG)))) MESSAGE)))))
(PUTPROP (QUOTE AERROR) (QUOTE IMPORTDATE) (IDATE "16-May-1990 11:58:35"))

(RECORD BASEBYTESTREAM STREAM (SUBRECORD STREAM) (ACCESSFNS ((BIASOFFST (|fetch| (STREAM FW6) |of| 
DATUM) (|replace| (STREAM FW6) |of| DATUM |with| NEWVALUE)) (BBSNCHARS (|fetch| (STREAM FW7) |of| 
DATUM) (|replace| (STREAM FW7) |of| DATUM |with| NEWVALUE)) (WRITEXTENSIONFN (|fetch| (STREAM F1) |of|
 DATUM) (|replace| (STREAM F1) |of| DATUM |with| NEWVALUE)))))
(PUTPROPS \\INSTREAMARG MACRO ((STRM NOERRORFLG) (\\GETSTREAM STRM (QUOTE INPUT) NOERRORFLG)))
(PUTPROPS \\OUTSTREAMARG MACRO ((STRM NOERRORFLG) (\\GETSTREAM STRM (QUOTE OUTPUT) NOERRORFLG)))
(PUTPROPS \\STREAMARG MACRO (OPENLAMBDA (STRM NOERRORFLG) (COND (NOERRORFLG (\\GETSTREAM STRM NIL T)) 
(T (\\DTEST STRM (QUOTE STREAM))))))
(PUTPROP (QUOTE AOFD) (QUOTE IMPORTDATE) (IDATE "13-Sep-1990 16:39:58"))

(PUTPROPS .SPACECHECK. MACRO ((STRM N) (AND \\THISFILELINELENGTH (IGREATERP (IPLUS N (|fetch| 
CHARPOSITION |of| STRM)) \\THISFILELINELENGTH) (FRESHLINE STRM))))
(PUTPROPS \\CHECKRADIX MACRO (LAMBDA (R) (COND ((OR (NOT (SMALLP R)) (ILESSP R 1) (IGREATERP R 36)) (
\\INVALID.RADIX R)) (T R))))
(PUTPROPS \\XCCSFILEOUTCHARFN MACRO ((OUTSTREAM CHARCODE) (* |;;;| 
"Encoder for XCCS format.  Default decoder.") (COND ((EQ CHARCODE (CHARCODE EOL)) (COND ((NOT (
\\RUNCODED OUTSTREAM)) (* \; "Charset is a constant 0") (\\BOUT OUTSTREAM (\\CHARSET (CHARCODE EOL))))
 ((EQ (\\CHARSET (CHARCODE EOL)) (|ffetch| (STREAM CHARSET) |of| OUTSTREAM))) (T (\\BOUT OUTSTREAM 
NSCHARSETSHIFT) (\\BOUT OUTSTREAM (|freplace| (STREAM CHARSET) |of| OUTSTREAM |with| (\\CHARSET (
CHARCODE EOL)))))) (\\BOUT OUTSTREAM (SELECTC (|ffetch| EOLCONVENTION |of| OUTSTREAM) (CR.EOLC (
CHARCODE CR)) (LF.EOLC (CHARCODE LF)) (CRLF.EOLC (\\BOUT OUTSTREAM (CHARCODE CR)) (* |;;| 
"Don't put out high-order byte preceding LF.  The CRLF is EOL only if the bytes are immediately adjacent in the stream, with no additional encoding bytes"
) (CHARCODE LF)) (SHOULDNT))) (|freplace| CHARPOSITION |of| OUTSTREAM |with| 0)) (T (COND ((NOT (
\\RUNCODED OUTSTREAM)) (\\BOUT OUTSTREAM (\\CHARSET CHARCODE)) (\\BOUT OUTSTREAM (\\CHAR8CODE CHARCODE
))) ((EQ (\\CHARSET CHARCODE) (|ffetch| (STREAM CHARSET) |of| OUTSTREAM)) (\\BOUT OUTSTREAM (
\\CHAR8CODE CHARCODE))) (T (\\BOUT OUTSTREAM NSCHARSETSHIFT) (\\BOUT OUTSTREAM (|freplace| (STREAM 
CHARSET) |of| OUTSTREAM |with| (\\CHARSET CHARCODE))) (\\BOUT OUTSTREAM (\\CHAR8CODE CHARCODE)))) (
|freplace| CHARPOSITION |of| OUTSTREAM |with| (PROGN (* \; "Ugh.  Don't overflow") (IPLUS16 (|ffetch| 
CHARPOSITION |of| OUTSTREAM) 1)))))))
(PUTPROP (QUOTE APRINT) (QUOTE IMPORTDATE) (IDATE "17-Jan-2020 05:51:20"))

(GLOBALVARS \\BCPLDISPLAY)
(ACCESSFNS LINEBUFFER ((LPARCOUNT (|fetch| FW6 |of| DATUM) (|replace| FW6 |of| DATUM |with| NEWVALUE))
 (LBRKCOUNT (|fetch| FW7 |of| DATUM) (|replace| FW7 |of| DATUM |with| NEWVALUE)) (LINEBUFSTATE (
|fetch| F5 |of| DATUM) (|replace| F5 |of| DATUM |with| NEWVALUE)) (* \; "F4 is free.  EJS, 7/8/85") (
KEYBOARDSTREAM (|fetch| F2 |of| DATUM) (|replace| F2 |of| DATUM |with| NEWVALUE)) (PEEKEDCHAR (|fetch|
 F3 |of| DATUM) (|replace| F3 |of| DATUM |with| NEWVALUE)) (* \; "Character read by PEEKC") (LBFLAGS (
|fetch| FW9 |of| DATUM) (|replace| FW9 |of| DATUM |with| NEWVALUE)) (* |;;| 
"True if peeked char was echoed when peeked.  Could use this to determine whether to echo later or not, but that would be incompatible with Interlisp-10, so this field not used"
)) (ACCESSFNS LINEBUFFER ((LBFLAGBASE (LOCF (|fetch| LBFLAGS |of| DATUM)))) (BLOCKRECORD LBFLAGBASE ((
PEEKEDECHOFLG FLAG) (INSTRINGP FLAG)))))
(RPAQQ LINEBUFFERSTATES (FILLING.LBS READING.LBS RETYPING.LBS))
(RPAQQ FILLING.LBS 0)
(RPAQQ READING.LBS 1)
(RPAQQ RETYPING.LBS 2)
(CONSTANTS FILLING.LBS READING.LBS RETYPING.LBS)
(PUTPROPS \\INTERMP MACRO ((OFD) (EQ OFD \\LINEBUF.OFD)))
(PUTPROPS \\OUTTERMP MACRO ((OFD) (EQ OFD \\TERM.OFD)))
(GLOBALVARS \\DEFAULTLINEBUF)
(PUTPROP (QUOTE ATERM) (QUOTE IMPORTDATE) (IDATE "16-May-1990 12:08:04"))

(DATATYPE HARRAYP ((NULLSLOTS WORD) (* \; "Number of NIL-NIL slots, which break chains") (LASTINDEX 
WORD) (* \; 
"Slot offset of last slot.  Used in probe computations computations.  Microcode support for \\ADDBASE4 would help"
) (HARRAYPBASE POINTER) (RECLAIMABLE FLAG) (* \; "True if keys can go away when no other refs") (
OVERFLOWACTION POINTER) (NUMSLOTS WORD) (* \; 
"The maximum number of logical slots--returned by HARRAYSIZE") (NUMKEYS WORD) (* \; 
"The number of distinct keys in the array") (HASHBITSFN POINTER) (EQUIVFN POINTER) (HASHUSERDATA 
POINTER)))
(PUTPROPS \\EQHASHINGBITS MACRO (OPENLAMBDA (X) (* \; 
"Spread out objects whose low bits are in small arithmetic progression, esp atoms") (LOGXOR (\\HILOC X
) (LOGXOR (LLSH (LOGAND (\\LOLOC X) 8191) 3) (LRSH (\\LOLOC X) 9)))))
(PUTPROPS \\ADDBASE2 MACRO (OPENLAMBDA (BASE N) (\\ADDBASE (\\ADDBASE BASE N) N)))
(PUTPROPS \\ADDBASE4 MACRO (OPENLAMBDA (BASE N) (\\ADDBASE2 (\\ADDBASE2 BASE N) N)))
(PUTPROPS HUNKSIZEFROMNUMBER MACRO ((NTYPX) (FOLDLO (|fetch| DTDSIZE |of| (\\GETDTD NTYPX)) 
WORDSPERCELL)))
(PUTPROPS \\BYTELT DMACRO (OPENLAMBDA (A J) (\\GETBASEBYTE (|fetch| (ARRAYP BASE) |of| A) (IPLUS (
|fetch| (ARRAYP OFFST) |of| A) J))))
(PUTPROPS \\BYTESETA DMACRO (OPENLAMBDA (A J V) (\\PUTBASEBYTE (|fetch| (ARRAYP BASE) |of| A) (IPLUS (
|fetch| (ARRAYP OFFST) |of| A) J) V)))
(PUTPROPS \\WORDELT DMACRO (OPENLAMBDA (A J) (CHECK (AND (ARRAYP A) (EQ 0 (|fetch| (ARRAYP ORIG) |of| 
A)) (EQ \\ST.POS16 (|fetch| (ARRAYP TYP) |of| A)))) (CHECK (IGREATERP (|fetch| (ARRAYP LENGTH) |of| A)
 J)) (\\GETBASE (|fetch| (ARRAYP BASE) |of| A) (IPLUS (|fetch| (ARRAYP OFFST) |of| A) J))))
(RPAQQ BLOCKGCTYPECONSTANTS ((CODEBLOCK.GCT 2) (PTRBLOCK.GCT 1) (UNBOXEDBLOCK.GCT 0)))
(RPAQQ CODEBLOCK.GCT 2)
(RPAQQ PTRBLOCK.GCT 1)
(RPAQQ UNBOXEDBLOCK.GCT 0)
(CONSTANTS (CODEBLOCK.GCT 2) (PTRBLOCK.GCT 1) (UNBOXEDBLOCK.GCT 0))
(RPAQQ ARRAYCONSTANTS (|\\ArrayBlockHeaderCells| |\\ArrayBlockHeaderWords| |\\ArrayBlockTrailerCells| 
|\\ArrayBlockTrailerWords| (|\\ArrayBlockOverheadCells| (IPLUS |\\ArrayBlockHeaderCells| 
|\\ArrayBlockTrailerCells|)) (|\\ArrayBlockOverheadWords| (IPLUS |\\ArrayBlockHeaderWords| 
|\\ArrayBlockTrailerWords|)) |\\ArrayBlockLinkingCells| (|\\MinArrayBlockSize| (IPLUS 
|\\ArrayBlockOverheadCells| |\\ArrayBlockLinkingCells|)) (|\\MaxArrayBlockSize| 65535) (
|\\MaxArrayNCells| (IDIFFERENCE |\\MaxArrayBlockSize| |\\ArrayBlockOverheadCells|)) |\\MaxArrayLen| (
\\ABPASSWORDSHIFT 3) (|\\ArrayBlockPassword| (LRSH 43690 \\ABPASSWORDSHIFT)) (|\\FreeArrayFlagWord| (
LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) (LLSH UNBOXEDBLOCK.GCT 1))) (
|\\UsedArrayFlagWord| (LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) 1)) (
|\\CodeArrayFlagWord| (LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) (LLSH CODEBLOCK.GCT 1) 1)
)))
(RPAQQ |\\ArrayBlockHeaderCells| 1)
(RPAQQ |\\ArrayBlockHeaderWords| 2)
(RPAQQ |\\ArrayBlockTrailerCells| 1)
(RPAQQ |\\ArrayBlockTrailerWords| 2)
(RPAQ |\\ArrayBlockOverheadCells| (IPLUS |\\ArrayBlockHeaderCells| |\\ArrayBlockTrailerCells|))
(RPAQ |\\ArrayBlockOverheadWords| (IPLUS |\\ArrayBlockHeaderWords| |\\ArrayBlockTrailerWords|))
(RPAQQ |\\ArrayBlockLinkingCells| 2)
(RPAQ |\\MinArrayBlockSize| (IPLUS |\\ArrayBlockOverheadCells| |\\ArrayBlockLinkingCells|))
(RPAQQ |\\MaxArrayBlockSize| 65535)
(RPAQ |\\MaxArrayNCells| (IDIFFERENCE |\\MaxArrayBlockSize| |\\ArrayBlockOverheadCells|))
(RPAQQ |\\MaxArrayLen| 65535)
(RPAQQ \\ABPASSWORDSHIFT 3)
(RPAQ |\\ArrayBlockPassword| (LRSH 43690 \\ABPASSWORDSHIFT))
(RPAQ |\\FreeArrayFlagWord| (LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) (LLSH 
UNBOXEDBLOCK.GCT 1)))
(RPAQ |\\UsedArrayFlagWord| (LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) 1))
(RPAQ |\\CodeArrayFlagWord| (LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) (LLSH CODEBLOCK.GCT
 1) 1))
(CONSTANTS |\\ArrayBlockHeaderCells| |\\ArrayBlockHeaderWords| |\\ArrayBlockTrailerCells| 
|\\ArrayBlockTrailerWords| (|\\ArrayBlockOverheadCells| (IPLUS |\\ArrayBlockHeaderCells| 
|\\ArrayBlockTrailerCells|)) (|\\ArrayBlockOverheadWords| (IPLUS |\\ArrayBlockHeaderWords| 
|\\ArrayBlockTrailerWords|)) |\\ArrayBlockLinkingCells| (|\\MinArrayBlockSize| (IPLUS 
|\\ArrayBlockOverheadCells| |\\ArrayBlockLinkingCells|)) (|\\MaxArrayBlockSize| 65535) (
|\\MaxArrayNCells| (IDIFFERENCE |\\MaxArrayBlockSize| |\\ArrayBlockOverheadCells|)) |\\MaxArrayLen| (
\\ABPASSWORDSHIFT 3) (|\\ArrayBlockPassword| (LRSH 43690 \\ABPASSWORDSHIFT)) (|\\FreeArrayFlagWord| (
LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) (LLSH UNBOXEDBLOCK.GCT 1))) (
|\\UsedArrayFlagWord| (LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) 1)) (
|\\CodeArrayFlagWord| (LOGOR (LLSH |\\ArrayBlockPassword| \\ABPASSWORDSHIFT) (LLSH CODEBLOCK.GCT 1) 1)
))
(RPAQQ ARRAYTYPES ((\\ST.BYTE 0) (\\ST.POS16 1) (\\ST.INT32 2) (\\ST.CODE 4) (\\ST.PTR 6) (\\ST.FLOAT 
7) (\\ST.BIT 8) (\\ST.PTR2 11)))
(RPAQQ \\ST.BYTE 0)
(RPAQQ \\ST.POS16 1)
(RPAQQ \\ST.INT32 2)
(RPAQQ \\ST.CODE 4)
(RPAQQ \\ST.PTR 6)
(RPAQQ \\ST.FLOAT 7)
(RPAQQ \\ST.BIT 8)
(RPAQQ \\ST.PTR2 11)
(CONSTANTS (\\ST.BYTE 0) (\\ST.POS16 1) (\\ST.INT32 2) (\\ST.CODE 4) (\\ST.PTR 6) (\\ST.FLOAT 7) (
\\ST.BIT 8) (\\ST.PTR2 11))
(RPAQQ \\MAX.CELLSPERHUNK 64)
(CONSTANTS \\MAX.CELLSPERHUNK)
(RPAQQ \\IN.MAKEINIT NIL)
(CONSTANTS (\\IN.MAKEINIT))
(BLOCKRECORD SEQUENCEDESCRIPTOR ((ORIG BITS 1) (NIL BITS 1) (READONLY FLAG) (NIL BITS 1) (BASE POINTER
) (TYP BITS 4) (NIL BITS 4) (LENGTH BITS 24) (OFFST FIXP)))
(DATATYPE ARRAYP ((* |;;| "Describes an INTERLISP ARRAYP, as opposed to a CL array.") (ORIG BITS 1) (*
 \; "Origin, 0 or 1") (NIL BITS 1) (READONLY FLAG) (* \; "probably no READONLY arrays now") (NIL BITS 
1) (BASE POINTER) (TYP BITS 4) (* \; "Type of the contents") (NIL BITS 4) (LENGTH BITS 24) (* \; 
"Array's length") (OFFST FIXP) (* \; "Offset from BASE where the data really starts.")) (* |;;| 
"note that while ARRAYP is a DATATYPE, the allocation of it actually happens at MAKEINIT time under INITDATATYPE{NAMES}"
))
(BLOCKRECORD ARRAYBLOCK ((PASSWORD BITS 13) (GCTYPE BITS 2) (* \; "Unboxed, Pointers, or Code") (INUSE
 FLAG) (ARLEN WORD) (FWD FULLXPOINTER) (* \; "Only when on free list") (BKWD FULLXPOINTER)) (
BLOCKRECORD ARRAYBLOCK ((ABFLAGS WORD) (* \; "Used for header and trailer"))) (ACCESSFNS ARRAYBLOCK ((
DAT (\\ADDBASE DATUM |\\ArrayBlockHeaderWords|)) (TRAILER (\\ADDBASE2 DATUM (IDIFFERENCE (|fetch| (
ARRAYBLOCK ARLEN) |of| DATUM) |\\ArrayBlockTrailerCells|))))) (TYPE? (AND (EQ 0 (NTYPX DATUM)) (IGEQ (
\\HILOC DATUM) |\\FirstArraySegment|))))
(GLOBALVARS |\\NxtArrayPage| \\FREEBLOCKBUCKETS \\HUNKING?)
(PUTPROPS HUNKSIZEFROMNUMBER MACRO ((NTYPX) (FOLDLO (|fetch| DTDSIZE |of| (\\GETDTD NTYPX)) 
WORDSPERCELL)))
(PUTPROP (QUOTE LLARRAYELT) (QUOTE IMPORTDATE) (IDATE "15-Sep-1994 11:08:59"))

(DEFOPTIMIZER PUTBASEPTRX (&REST ARGS) (CONS (QUOTE (OPENLAMBDA (DATUM OFFSET NEWVALUE) (
UNINTERRUPTABLY (\\PUTBASE DATUM OFFSET (LOGOR (LOGAND 61440 (\\GETBASE DATUM OFFSET)) (LOGAND (
\\HILOC NEWVALUE) 4095))) (\\PUTBASE DATUM (ADD1 OFFSET) (\\LOLOC NEWVALUE)) NEWVALUE))) ARGS))
(RPAQQ \\SMALLP 1)
(RPAQQ \\FIXP 2)
(RPAQQ \\FLOATP 3)
(RPAQQ \\LITATOM 4)
(RPAQQ \\LISTP 5)
(RPAQQ \\ARRAYP 6)
(RPAQQ \\STACKP 8)
(RPAQQ \\VMEMPAGEP 10)
(RPAQQ \\STREAM 11)
(RPAQQ \\NEW-ATOM 21)
(CONSTANTS \\SMALLP \\FIXP \\FLOATP \\LITATOM \\LISTP \\ARRAYP \\STACKP \\VMEMPAGEP \\STREAM 
\\NEW-ATOM)
(RPAQQ \\BUILT-IN-SYSTEM-TYPES ((SMALLP) (FIXP 2) (FLOATP 2) (LITATOM) (LISTP 4 (0 2)) (ARRAYP 6 (0)) 
(STRINGP 6 (0)) (STACKP 2 NIL \\RECLAIMSTACKP) (CHARACTER) (VMEMPAGEP 256 NIL RELEASINGVMEMPAGE) (
STREAM) (BITMAP) (COMPILED-CLOSURE 4 (0 2)) (ONED-ARRAY 8 (0)) (TWOD-ARRAY 10 (0)) (GENERAL-ARRAY 10 (
0 8)) (BIGNUM) (RATIO) (COMPLEX) (PATHNAME) (NEW-ATOM 10 (2 4 6)) (FILLER22) (FILLER23) (FILLER24) (
FILLER25) (FILLER26) (FILLER27) (FILLER28) (FILLER29) (FILLER30)))
(BLOCKRECORD DTD ((NIL BITS 2) (DTDOBSOLETE FLAG) (* \; 
"True for type of a redeclared datatype--not allowed to allocate more of these") (DTDFINALIZABLE FLAG)
 (* \; "True if finalization exists for this type") (DTDNAME POINTER) (* \; "Type name -- a symbol ") 
(DTDCNT0 WORD) (* \; "Incremental box count -- this plus DTDOLDCNT is the true box count") (DTDSIZE 
WORD) (* \; "Length of datum in words") (DTDFREE FULLXPOINTER) (* \; 
"Pointer to first object on free chain, or NIL.  Not used for LISTP") (DTDLOCKEDP FLAG) (* \; 
"True if objects of this type must be locked down (not pagefault)") (DTDHUNKP FLAG) (* \; 
"True if this type is used as an array hunk type") (DTDGCTYPE BITS 2) (* \; 
"For hunk datatypes, is analogous to arrayblock's GCTYPE") (DTDDESCRS POINTER) (DTDTYPESPECS POINTER) 
(DTDPTRS POINTER) (* \; 
"List of word offsets inside datum where reference-counted pointers are stored -- used by GC") (
DTDOLDCNT FIXP) (* \; "'Box count' -- number of objects of this type ever allocated") (DTDNEXTPAGE 
FIXP) (* \; 
"Currently only for LISTP pages -- page number of next page on chain of non-full cons pages") (
DTDTYPEENTRY WORD) (* |;;| 
"The word stored in the type table for objects of this type.  Hi bits have numberp tags, ref countable, etc."
) (DTDSUPERTYPE WORD) (* \; "Type number of immediate supertype, or zero if none")) (ACCESSFNS DTD ((
DTDCNTLOC (\\ADDBASE DATUM 4)) (DTDCNT (IPLUS (|fetch| DTDOLDCNT DATUM) (|fetch| DTDCNT0 DATUM)) (
UNINTERRUPTABLY (|replace| DTDOLDCNT |of| DATUM |with| NEWVALUE) (|replace| DTDCNT0 |of| DATUM |with| 
0))))))
(PUTPROPS \\GETDTD MACRO ((|typeNum|) (ADDBASE |\\DTDSpaceBase| (ITIMES |typeNum| 18))))
(DEFOPTIMIZER \\TYPEMASK.UFN (&REST X) (LET ((CE (CONSTANTEXPRESSIONP (CADR X)))) (|if| CE |then| (
BQUOTE ((OPCODES TYPEMASK.N (\\\, (CAR CE))) (\\\, (CAR X)))) |else| (QUOTE IGNOREMACRO))))
(RPAQQ \\GUARDSTORAGEFULL 128)
(RPAQQ \\GUARD1STORAGEFULL 64)
(CONSTANTS \\GUARDSTORAGEFULL \\GUARD1STORAGEFULL)
(GLOBALVARS |\\NxtMDSPage| |\\LeastMDSPage| |\\SecondArrayPage| |\\SecondMDSPage| \\MDSFREELISTPAGE 
|\\MaxSysTypeNum| |\\MaxTypeNumber| \\STORAGEFULL \\INTERRUPTSTATE \\PENDINGINTERRUPT)
(PUTPROP (QUOTE LLDATATYPE) (QUOTE IMPORTDATE) (IDATE "28-Jun-1999 16:57:50"))

(ACCESSFNS POINTER ((PAGE# (IPLUS (LLSH (\\HILOC DATUM) 8) (LRSH (\\LOLOC DATUM) 8))) (WORDINPAGE (
LOGAND (\\LOLOC DATUM) 255)) (CELLINPAGE (LRSH (|fetch| WORDINPAGE |of| DATUM) 1)) (BYTEINPAGE (LLSH (
|fetch| WORDINPAGE |of| DATUM) 1)) (SEGMENT# (\\HILOC DATUM)) (WORDINSEGMENT (\\LOLOC DATUM)) (
CELLINSEGMENT (LRSH (|fetch| WORDINSEGMENT |of| DATUM) 1)) (WORD# (|fetch| WORDINPAGE |of| DATUM)) (
DBLWORD# (|fetch| CELLINPAGE |of| DATUM)) (PAGEBASE (\\VAG2 (\\HILOC DATUM) (LOGAND (\\LOLOC DATUM) 
65280)))) (CREATE (\\VAG2 (LRSH PAGE# 8) (LLSH (LOGAND PAGE# 255) 8))))
(ACCESSFNS WORD ((HIBYTE (LRSH DATUM 8)) (LOBYTE (LOGAND DATUM 255))) (CREATE (IPLUS (LLSH HIBYTE 8) 
LOBYTE)))
(PUTPROPS PTRGTP MACRO (OPENLAMBDA (X Y) (OR (IGREATERP (\\HILOC X) (\\HILOC Y)) (AND (EQ (\\HILOC X) 
(\\HILOC Y)) (IGREATERP (\\LOLOC X) (\\LOLOC Y))))))
(PUTPROPS .COERCE.TO.SMALLPOSP. DMACRO (OPENLAMBDA (X) (COND ((SMALLPOSP X) X) (T (\\ILLEGAL.ARG X))))
)
(PUTPROPS .COERCE.TO.BYTE. DMACRO (OPENLAMBDA (X) (COND ((AND (SMALLPOSP X) (ILESSP X (CONSTANT (LLSH 
1 BITSPERBYTE)))) X) (T (\\ILLEGAL.ARG X)))))
(BLOCKRECORD LISTP ((* |;;| "Describes a CONS cell.") (CAR POINTER) (CDR POINTER)) (CREATE (CREATECELL
 \\LISTP)) (* |;;| "FOLLOWING ARE CDR-CODE FIELDS") (BLOCKRECORD LISTP ((CDRCODE BITS 4) (CARFIELD 
XPOINTER))) (* |;;| "For chaining together free cells on a page:") (BLOCKRECORD LISTP ((NEXTFREE BYTE)
 (NIL BITS 24))) (ACCESSFNS LISTP ((FULLCARFIELD NIL (\\PUTBASEPTR DATUM 0 NEWVALUE)))) (* |;;| 
"because replace of XPOINTER is slow, the CAR field is stored with PUTBASEPTR, even though that smashes the hi byte"
))
(BLOCKRECORD CONSPAGE ((* |;;| 
"Describes a page of CONS cells, which (when free) are chained together thru the top byte.") (NIL 2 
FIXP) (* \; "Empty cells, space for another 2 CONS cells if we can figure out how.") (CNT BYTE) (* \; 
"# of cells free on this page") (NEXTCELL BYTE) (* \; 
"WORD offset of next free cell (not guaranteed to be 0 if no free cells)") (NIL WORD) (* \; "Padding")
 (NEXTPAGE FIXP) (* \; "Next CONS page on the DTD's free list, for searching for cells.")))
(RPAQQ CONSCONSTANTS (\\CDR.ONPAGE \\CDR.NIL \\CDR.INDIRECT \\CDR.MAXINDIRECT \\CONSPAGE.LAST))
(RPAQQ \\CDR.ONPAGE 8)
(RPAQQ \\CDR.NIL 8)
(RPAQQ \\CDR.INDIRECT 0)
(RPAQQ \\CDR.MAXINDIRECT 7)
(RPAQQ \\CONSPAGE.LAST 65535)
(CONSTANTS \\CDR.ONPAGE \\CDR.NIL \\CDR.INDIRECT \\CDR.MAXINDIRECT \\CONSPAGE.LAST)
(PUTPROPS LOCAL MACRO ((X) X))
(PUTPROPS ALLOCAL MACRO ((X) X))
(PUTPROP (QUOTE LLNEW) (QUOTE IMPORTDATE) (IDATE " 2-Feb-1995 16:21:44"))

(PUTPROPS CHECK MACRO (ARGS (COND ((AND (BOUNDP (QUOTE CHECK)) CHECK) (CONS (QUOTE PROGN) (|for| I 
|in| ARGS |collect| (LIST (QUOTE OR) I (LIST (QUOTE RAID) (KWOTE (LIST (QUOTE |Check-failure:|) I)))))
)) (T (CONS COMMENTFLG ARGS)))))
(PUTPROPS |\\StatsZero| BYTEMACRO (OPENLAMBDA (N) (\\PUTBASE N 0 0) (\\PUTBASE N 1 0)))
(PUTPROPS |\\StatsAdd1| DMACRO (OPENLAMBDA (A) (PROG ((LO (IPLUS16 (\\GETBASE A 1) 1))) (DECLARE (
LOCALVARS LO)) (* \; "Increment double word at A by 1") (\\PUTBASE A 1 LO) (COND ((EQ LO 0) (\\PUTBASE
 A 0 (ADD1 (\\GETBASE A 0))))))))
(PUTPROPS IPLUS16 MACRO ((X Y) (* \; "Kludge to do 16-bit plus") (\\LOLOC (\\ADDBASE X Y))))
(PUTPROPS SMALLPOSP MACRO (OPENLAMBDA (X) (AND (SMALLP X) (IGEQ X 0))))
(PROGN (PUTPROPS SETXVAR MACRO (X (BQUOTE (SETQ.NOREF \, (CADAR X) \, (CADR X))))) (PUTPROPS SETXVAR 
DMACRO (X (OR (AND (EQ (CAAR X) (QUOTE QUOTE)) (LITATOM (CADAR X))) (SHOULDNT)) (GLOBALVARS \\VALSPACE
) (LIST (QUOTE SETQ.NOREF) (CADAR X) (CADR X)))))
(PUTPROPS SETQ.NOREF DMACRO ((VAR VAL) (\\PUTBASEPTR (LOCF (|fetch| (LITATOM VALUE) |of| (QUOTE VAR)))
 0 VAL)))
(PROGN (PUTPROPS IEQ MACRO ((X Y) (IEQP X Y))) (PUTPROPS IEQ DMACRO (= . EQ)))
(RPAQQ |WordsPerPage| 256)
(CONSTANTS |WordsPerPage|)
(ACCESSFNS LITATOM ((DEFINITIONCELL (\\DEFCELL DATUM)) (PROPCELL (\\PROPCELL DATUM)) (VCELL (\\VALCELL
 DATUM)) (PNAMECELL (\\PNAMECELL DATUM))) (* |;;| 
"VCELL can also be accessed directly from a value index via the record VALINDEX (as in \\SETGLOBALVAL.UFN) --- Similarly, PNAMEINDEX accesses PNAMECELL for use by \\MKATOM and UNCOPYATOM"
) (TYPE? (LITATOM DATUM)) (BLOCKRECORD PROPCELL ((NIL BITS 4) (* \; "former flags locations") (
PROPLIST POINTER) (NIL BITS 8) (* \; "Package byte") (NIL BITS 8) (* \; "Flags from defcell") (* |;;| 
"PROPCell flags:") (NIL BITS 1) (GENSYMP FLAG) (FATPNAMEP FLAG) (NIL BITS 5) (* |;;| 
"Filler for final cell:") (NIL BITS 8))))
(SYNONYM CL:SYMBOL (LITATOM))
(ACCESSFNS VALINDEX ((VCELL (COND ((AND (FIXP DATUM) (ILESSP DATUM 65535)) (* \; 
"Xerox Lisp traditional symbol") (\\ADDBASE2 \\PNPSPACE (IPLUS \\NEWATOM-VALOFFSET (ITIMES 10 DATUM)))
) (T (* \; "New symbol") (* \; "'90/07/19 ON") (\\ADDBASE DATUM \\NEWATOM-VALOFFSET))))))
(BLOCKRECORD VCELL ((VALUE FULLPOINTER)))
(BLOCKRECORD DEFINITIONCELL ((CCODEP FLAG) (FASTP FLAG) (ARGTYPE BITS 2) (* \; "Former flag location")
 (DEFPOINTER POINTER) (NIL POINTER) (* \; "Proplist cell") (NIL BITS 8) (* \; "package") (* |;;| 
"DEFCELL flags overflow from top 4 bits of the real cell:") (NIL BITS 4) (PSEUDOCODEP FLAG) (NIL BITS 
3) (* |;;| "proplist falgs and filler:") (NIL BITS 16)) (BLOCKRECORD DEFINITIONCELL ((DEFCELLFLAGS 
BITS 4) (NIL POINTER) (* \; "defn ptr") (NIL BITS 4) (NIL POINTER) (* \; "filler for proplist ptr") (
NIL BITS 8) (AUXDEFCELLFLAGS BYTE) (NIL BITS 16))))
(BLOCKRECORD FNHEADER ((STKMIN WORD) (NA SIGNEDWORD) (PV SIGNEDWORD) (STARTPC WORD) (CLOSUREP FLAG) (*
 \; "T if this is a \"compiled closure\"") (BYTESWAPPED FLAG) (* \; 
"T if, on 386, we reswapped the code section of this function for faster access.") (ARGTYPE BITS 2) (*
 \; "0 = LAMBDA") (* \; "2 = LAMBDA nospread") (* \; "1 = NLAMBDA") (* \; "3 = NLAMBDA nospread") (* 
|;;| "4 NIL BITS USED TO BE HERE.") (\#FRAMENAME XPOINTER) (NTSIZE WORD) (* \; 
"Size of the Name Table, IN WORDS.  This value is always rounded up to the next Quad-word in size, and there' guaranteed to be one entry of zeros in the length."
) (NLOCALS BYTE) (FVAROFFSET BYTE)) (ACCESSFNS FNHEADER ((LSTARP (ILESSP (|fetch| (FNHEADER NA) |of| 
DATUM) 0)) (OVERHEADWORDS (PROGN 8)) (NATIVE (PROGN NIL)) (* \; 
"T if this is a NATIVE-code function (never true!)") (ALIGNED (IPLUS (|fetch| (FNHEADER NTSIZE) |of| 
DATUM) (|fetch| (FNHEADER OVERHEADWORDS) |of| T))) (FIXED NIL (|replace| (FNHEADER STKMIN) |of| DATUM 
|with| (\\STKMIN DATUM T))) (NPVARWORDS (UNFOLD (ADD1 (|fetch| (FNHEADER PV) |of| DATUM)) WORDSPERQUAD
)) (FRAMENAME (|fetch| (FNHEADER \#FRAMENAME) |of| DATUM) (UNINTERRUPTABLY (CHECK (NEQ (\\HILOC DATUM)
 \\STACKHI)) (\\DELREF (|fetch| (FNHEADER \#FRAMENAME) |of| DATUM)) (\\ADDREF NEWVALUE) (|replace| (
FNHEADER \#FRAMENAME) |of| DATUM |with| NEWVALUE))))))
(BLOCKRECORD PNAMECELL ((NIL BITS 4) (PNAMEBASE XPOINTER) (NIL POINTER) (* \; "val, def, prop cells") 
(NIL POINTER) (NIL POINTER) (PACKAGEINDEX BYTE) (NIL BITS 24) (* \; "filler for other flags")) (
BLOCKRECORD PNAMECELL ((FULLPNAMEBASE FULLXPOINTER) (* \; "Replacing this smashes PACKAGEINDEX to 0"))
) (ACCESSFNS PNAMECELL ((PACKAGE (LET ((I (FETCH (PNAMECELL PACKAGEINDEX) OF DATUM))) (* \; 
"This ugly construct allows cl:symbol-package to run in the init, where *PACKAGE-FROM-INDEX* is not yet bound."
) (COND ((EQ 0 I) NIL) (T (CL:AREF *PACKAGE-FROM-INDEX* I)))) (REPLACE (PNAMECELL PACKAGEINDEX) OF 
DATUM WITH (IF (NULL NEWVALUE) THEN *UNINTERNED-PACKAGE-INDEX* ELSE (CL::%PACKAGE-INDEX NEWVALUE))))))
)
(ACCESSFNS PACKAGEINDEX ((PACKAGE (IF (EQ 0 DATUM) (* \; 
"This ugly construct allows cl:symbol-package to run in the init, where *PACKAGE-FROM-INDEX* is not yet bound."
) THEN NIL ELSE (CL:AREF *PACKAGE-FROM-INDEX* DATUM)))))
(BLOCKRECORD PNAMEBASE ((PNAMELENGTH BYTE) (* \; "Length is always here, be the pname thin or fat") (
PNAMEFATPADDINGBYTE BYTE) (* \; 
"This byte is zero for fat pnames so that the pname chars are word-aligned")))
(ACCESSFNS PNAMEINDEX ((PNAMECELL (COND ((AND (FIXP DATUM) (ILESSP DATUM 65535)) (* \; 
"Xerox Lisp traditional symbol") (\\ADDBASE \\OLDATOMSPACE (IPLUS \\NEWATOM-PNAMEOFFSET (ITIMES 10 
DATUM)))) (T (* \; "New symbol") (* \; "'90/07/19 ON") (\\ADDBASE DATUM \\NEWATOM-PNAMEOFFSET))))))
(BLOCKRECORD NEW-ATOM ((* |;;| 
"An extended symbol, for expanding atom space.  Kept in its own datatype.") (PNAME XPOINTER) (* \; 
"PNAME, same as litatom.") (VALUE POINTER) (DEF POINTER) (PROPLIST POINTER) (* |;;| 
"Flags that used to be above the pointers, e.g. package, ccodep, gensymp:") (NIL BITS 32)))
(PUTPROPS \\DEFCELL MACRO ((ATOM) (\\ATOMCELL ATOM \\DEF.HI)))
(PUTPROPS \\VALCELL MACRO ((ATOM) (\\ATOMCELL ATOM \\VAL.HI)))
(PUTPROPS \\PNAMECELL MACRO ((ATOM) (\\ATOMCELL ATOM \\PNAME.HI)))
(PUTPROPS \\ATOMVALINDEX DMACRO (OPENLAMBDA (X) (COND ((EQ (NTYPX X) \\LITATOM) (* \; 
"Original litatoms") (\\LOLOC X)) ((EQ (NTYPX X) \\NEW-ATOM) (* \; "new 3-byte symbols") X) (T (
SHOULDNT)))))
(PUTPROPS \\ATOMDEFINDEX DMACRO (OPENLAMBDA (X) (COND ((EQ (NTYPX X) \\LITATOM) (* \; 
"Original litatoms") (\\LOLOC X)) ((EQ (NTYPX X) \\NEW-ATOM) (* \; "new 3-byte symbols") X) (T (
SHOULDNT)))))
(PUTPROPS \\ATOMPNAMEINDEX DMACRO (OPENLAMBDA (X) (COND ((EQ (NTYPX X) \\LITATOM) (* \; 
"Original litatoms") (\\LOLOC X)) ((EQ (NTYPX X) \\NEW-ATOM) (* \; "new 3-byte symbols") X) (T (
SHOULDNT)))))
(PUTPROPS \\ATOMPROPINDEX DMACRO ((X) (COND ((EQ (NTYPX X) \\LITATOM) (* \; "Original litatoms") (
\\LOLOC X)) ((EQ (NTYPX X) \\NEW-ATOM) (* \; "new 3-byte symbols") X) (T (SHOULDNT)))))
(PUTPROPS \\INDEXATOMPNAME DMACRO (OPENLAMBDA (X) (COND ((FIXP X) (* \; 
"Xerox Lisp traditional symbol") (COND ((SMALLP X) (\\VAG2 |\\AtomHI| X)) (T (\\VAG2 (LRSH X 16) (
LOGAND X 65535))))) (T (* \; "New symbol") X))))
(PUTPROPS \\INDEXATOMVAL DMACRO (OPENLAMBDA (X) (COND ((FIXP X) (* \; "Xerox Lisp traditional symbol")
 (COND ((SMALLP X) (\\VAG2 |\\AtomHI| X)) (T (\\VAG2 (LRSH X 16) (LOGAND X 65535))))) (T (* \; 
"New symbol") X))))
(PUTPROPS \\INDEXATOMDEF DMACRO (OPENLAMBDA (X) (COND ((FIXP X) (* \; "Xerox Lisp traditional symbol")
 (COND ((SMALLP X) (\\VAG2 |\\AtomHI| X)) (T (\\VAG2 (LRSH X 16) (LOGAND X 65535))))) (T (* \; 
"New symbol") X))))
(PUTPROPS \\ATOMNUMBER DMACRO (= . \\LOLOC))
(GLOBALVARS |\\NxtPnByte| |\\CurPnPage| |\\NxtAtomPage| |\\AtomFrLst| |\\OneCharAtomBase| 
\\PNAMES.IN.BLOCKS? \\SCRATCHSTRING COMPILEATPUTDFLG)
(RPAQQ \\PNAMELIMIT 255)
(RPAQQ |\\CharsPerPnPage| 512)
(CONSTANTS (\\PNAMELIMIT 255) (|\\CharsPerPnPage| 512))
(RPAQQ \\NEWATOM-PNAMEOFFSET 0)
(RPAQQ \\NEWATOM-VALOFFSET 2)
(RPAQQ \\NEWATOM-DEFOFFSET 4)
(RPAQQ \\NEWATOM-PLISTOFFSET 6)
(RPAQQ \\NEWATOM-TYPE# 21)
(CONSTANTS (\\NEWATOM-PNAMEOFFSET 0) (\\NEWATOM-VALOFFSET 2) (\\NEWATOM-DEFOFFSET 4) (
\\NEWATOM-PLISTOFFSET 6) (\\NEWATOM-TYPE# 21))
(PUTPROPS \\MOVEWORDS MACRO (OPENLAMBDA (SBASE SOFFSET DBASE DOFFSET NWORDS) (\\BLT (\\ADDBASE DBASE 
DOFFSET) (\\ADDBASE SBASE SOFFSET) NWORDS)))
(PUTPROP (QUOTE LLBASIC) (QUOTE IMPORTDATE) (IDATE "31-Jan-1998 09:55:50"))

(ACCESSFNS STRINGP ((XREADONLY (|fetch| (ARRAY-HEADER READ-ONLY-P) |of| DATUM) (|replace| (
ARRAY-HEADER READ-ONLY-P) |of| DATUM |with| NEWVALUE)) (XBASE ((OPENLAMBDA (STRING) (COND ((|fetch| (
ARRAY-HEADER INDIRECT-P) |of| STRING) (%ARRAY-BASE STRING)) (T (|fetch| (ARRAY-HEADER BASE) |of| 
STRING)))) DATUM) ((OPENLAMBDA (STRING NV) (|replace| (ARRAY-HEADER INDIRECT-P) |of| STRING |with| NIL
) (|replace| (ARRAY-HEADER BASE) |of| STRING |with| NV) NV) DATUM NEWVALUE)) (TYP ((OPENLAMBDA (STRING
) (SELECTC (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) (%ARRAY-TYPE-NUMBER STRING)) (T (
|fetch| (ARRAY-HEADER TYPE-NUMBER) |of| STRING))) (%THIN-CHAR-TYPENUMBER \\ST.BYTE) (
%FAT-CHAR-TYPENUMBER \\ST.POS16) (SHOULDNT "Unknown type-number"))) DATUM) ((OPENLAMBDA (STRING NV) (
LET ((%NEW-TYPE-NUMBER (SELECTC NV (\\ST.BYTE %THIN-CHAR-TYPENUMBER) (\\ST.POS16 %FAT-CHAR-TYPENUMBER)
 (SHOULDNT "Unknown typ value")))) (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) (
%SET-ARRAY-TYPE-NUMBER STRING %NEW-TYPE-NUMBER)) (T (|replace| (ARRAY-HEADER TYPE-NUMBER) |of| STRING 
|with| %NEW-TYPE-NUMBER))))) DATUM NEWVALUE)) (LENGTH (|fetch| (ARRAY-HEADER FILL-POINTER) |of| DATUM)
 ((OPENLAMBDA (STRING NV) (|replace| (ARRAY-HEADER FILL-POINTER) |of| STRING |with| NV) (|replace| (
ARRAY-HEADER TOTAL-SIZE) |of| STRING |with| NV) (COND ((%GENERAL-ARRAY-P STRING) (|freplace| (
GENERAL-ARRAY DIMS) |of| STRING |with| (LIST NV)))) NV) DATUM NEWVALUE)) (OFFST ((OPENLAMBDA (STRING) 
(COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) (%ARRAY-OFFSET STRING)) (T (|fetch| (
ARRAY-HEADER OFFSET) |of| STRING)))) DATUM) ((OPENLAMBDA (STRING NV) (COND ((NOT (EQ 0 NV)) (|replace|
 (ARRAY-HEADER DISPLACED-P) |of| STRING |with| T))) (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| 
STRING) (%SET-ARRAY-OFFSET STRING NV)) (T (|replace| (ARRAY-HEADER OFFSET) |of| STRING |with| NV)))) 
DATUM NEWVALUE)) (* |;;| "The rest of these fields only appear when smashing") (XFLAGS (LOGAND (
|fetch| (ARRAY-HEADER FLAGS) |of| DATUM) 15) ((OPENLAMBDA (STRING) (|replace| (ARRAY-HEADER 
ADJUSTABLE-P) |of| STRING |with| NIL) (|replace| (ARRAY-HEADER DISPLACED-P) |of| STRING |with| NIL) (
|replace| (ARRAY-HEADER FILL-POINTER-P) |of| STRING |with| NIL) (|replace| (ARRAY-HEADER EXTENDABLE-P)
 |of| STRING |with| NIL)) DATUM))) (ACCESSFNS STRINGP ((ORIG ((OPENLAMBDA (STRING) 1) DATUM) ((
OPENLAMBDA (STRING NV) (COND ((NOT (EQ NV 1)) (ERROR "Il:stringp's are always origin 1"))) NV) DATUM 
NEWVALUE)) (* \; "An inoperative field") (SUBSTRINGED ((OPENLAMBDA (STRING) NIL) DATUM) ((OPENLAMBDA (
STRING NV) (OR (NULL NV) (ERROR "Substringed field not supported"))) DATUM NEWVALUE)) (READONLY (
|ffetch| (STRINGP XREADONLY) |of| DATUM) (|freplace| (STRINGP XREADONLY) |of| DATUM |with| NEWVALUE)) 
(FATSTRINGP ((OPENLAMBDA (STRING) (EQ (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) (
%ARRAY-TYPE-NUMBER STRING)) (T (|fetch| (ARRAY-HEADER TYPE-NUMBER) |of| STRING))) %FAT-CHAR-TYPENUMBER
)) DATUM) ((OPENLAMBDA (STRING NV) (LET ((%NEW-TYPE-NUMBER (COND (NV %FAT-CHAR-TYPENUMBER) (T 
%THIN-CHAR-TYPENUMBER)))) (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) (
%SET-ARRAY-TYPE-NUMBER STRING %NEW-TYPE-NUMBER)) (T (|replace| (ARRAY-HEADER TYPE-NUMBER) |of| STRING 
|with| %NEW-TYPE-NUMBER))))) DATUM NEWVALUE)) (BASE (|ffetch| (STRINGP XBASE) |of| DATUM) (|freplace| 
(STRINGP XBASE) |of| DATUM |with| NEWVALUE)))) (CREATE (|create| ONED-ARRAY BASE _ XBASE READ-ONLY-P _
 XREADONLY STRING-P _ T DISPLACED-P _ (NOT (EQ OFFST 0)) TYPE-NUMBER _ (COND ((EQ TYP \\ST.POS16) 
%FAT-CHAR-TYPENUMBER) (T %THIN-CHAR-TYPENUMBER)) OFFSET _ OFFST FILL-POINTER _ LENGTH TOTAL-SIZE _ 
LENGTH)) (TYPE? (CL:STRINGP DATUM)) OFFST _ 0 TYP _ \\ST.BYTE LENGTH _ 0)
(GLOBALVARS |\\OneCharAtomBase|)
(PUTDEF (QUOTE \\NUMSTR) (QUOTE RESOURCES) (QUOTE (NEW (ALLOCSTRING 128))))
(PUTDEF (QUOTE \\NUMSTR1) (QUOTE RESOURCES) (QUOTE (NEW (CONCAT))))
(PUTDEF (QUOTE \\PNAMESTRING) (QUOTE RESOURCES) (QUOTE (NEW (ALLOCSTRING \\PNAMELIMIT NIL NIL 
\\FATPNAMESTRINGP))))
(RPAQQ \\FATPNAMESTRINGP T)
(CONSTANTS (\\FATPNAMESTRINGP T))
(PUTPROPS \\PNAMESTRINGPUTCHAR MACRO ((BASE OFFSET CODE) (* \; 
"For stuffing chars into resource \\PNAMESTRING") (\\PUTBASECHAR \\FATPNAMESTRINGP BASE OFFSET CODE)))
(DEFOPTIMIZER FCHARACTER (NUM) (BQUOTE ((OPENLAMBDA (N) (COND ((IGREATERP N \\MAXTHINCHAR) (* \; 
"The character we're getting is NOT a thin character -- do it the hard way") (CHARACTER N)) ((
IGREATERP N (CHARCODE 9)) (\\ADDBASE |\\OneCharAtomBase| (IDIFFERENCE N 10))) ((IGEQ N (CHARCODE 0)) (
IDIFFERENCE N (CHARCODE 0))) (T (* \; "The common case -- just add on the one-atom base.") (\\ADDBASE 
|\\OneCharAtomBase| N)))) (\\\, NUM))))
(I.S.OPR (QUOTE |inpname|) NIL (QUOTE (SUBPAIR (QUOTE ($$END $$BODY $$FATP $$BASE $$OFFSET)) (LIST (
GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (BQUOTE (|bind| $$OFFSET _ 0 
$$BODY _ BODY $$BASE $$END $$FATP |declare| (LOCALVARS $$END $$BODY $$FATP $$BASE $$OFFSET) |first| (
PROG NIL $$RETRY (COND ((STRINGP $$BODY) (SETQ $$BASE (|ffetch| (STRINGP BASE) |of| $$BODY)) (SETQ 
$$OFFSET (SUB1 (|ffetch| (STRINGP OFFST) |of| $$BODY))) (SETQ $$END (IPLUS $$OFFSET (|ffetch| (STRINGP
 LENGTH) |of| $$BODY))) (SETQ $$FATP (|ffetch| (STRINGP FATSTRINGP) |of| $$BODY))) ((LITATOM $$BODY) (
SETQ $$BASE (|ffetch| (LITATOM PNAMEBASE) |of| $$BODY)) (SETQ $$END (|ffetch| (PNAMEBASE PNAMELENGTH) 
|of| $$BASE)) (SETQ $$FATP (|ffetch| (LITATOM FATPNAMEP) |of| $$BODY))) (T (SETQ $$BODY (MKSTRING 
$$BODY)) (GO $$RETRY)))) |eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (
GO $$OUT)) (SETQ I.V. (COND ($$FATP (\\GETBASEFAT $$BASE $$OFFSET)) (T (\\GETBASETHIN $$BASE $$OFFSET)
))))))) T)
(I.S.OPR (QUOTE |inatom|) NIL (QUOTE (SUBPAIR (QUOTE ($$OFFSET $$BODY $$BASE $$END $$FATP)) (LIST (
GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$OFFSET _ 0 
$$BODY _ BODY $$BASE $$END $$FATP |declare| (LOCALVARS $$OFFSET $$BODY $$BASE $$END $$FATP) |first| (
SETQ $$BASE (|ffetch| (LITATOM PNAMEBASE) |of| $$BODY)) (SETQ $$END (|ffetch| (PNAMEBASE PNAMELENGTH) 
|of| $$BASE)) (SETQ $$FATP (|ffetch| (LITATOM FATPNAMEP) |of| $$BODY)) |eachtime| (SETQ $$OFFSET (ADD1
 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (COND ($$FATP (\\GETBASEFAT $$BASE 
$$OFFSET)) (T (\\GETBASETHIN $$BASE $$OFFSET)))))))) T)
(I.S.OPR (QUOTE |instring|) NIL (QUOTE (SUBPAIR (QUOTE ($$BODY $$END $$OFFSET $$BASE $$FATP)) (LIST (
GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$BODY _ BODY 
$$END $$OFFSET $$BASE $$FATP |declare| (LOCALVARS $$BODY $$END $$OFFSET $$BASE $$FATP) |first| (SETQ 
$$OFFSET (SUB1 (|ffetch| (STRINGP OFFST) |of| $$BODY))) (SETQ $$BASE (|ffetch| (STRINGP BASE) |of| 
$$BODY)) (SETQ $$END (IPLUS $$OFFSET (|ffetch| (STRINGP LENGTH) |of| $$BODY))) (SETQ $$FATP (|ffetch| 
(STRINGP FATSTRINGP) |of| $$BODY)) |eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET
 $$END) (GO $$OUT)) (SETQ I.V. (COND ($$FATP (\\GETBASEFAT $$BASE $$OFFSET)) (T (\\GETBASETHIN $$BASE 
$$OFFSET)))))))) T)
(I.S.OPR (QUOTE |infatatom|) NIL (QUOTE (SUBPAIR (QUOTE ($$OFFSET $$BODY $$BASE $$END)) (LIST (
GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$OFFSET _ 0 $$BODY _ BODY 
$$BASE $$END |declare| (LOCALVARS $$OFFSET $$BODY $$BASE $$END) |first| (SETQ $$BASE (|ffetch| (
LITATOM PNAMEBASE) |of| $$BODY)) (SETQ $$END (|ffetch| (PNAMEBASE PNAMELENGTH) |of| $$BASE)) 
|eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (
\\GETBASEFAT $$BASE $$OFFSET)))))) T)
(I.S.OPR (QUOTE |inthinatom|) NIL (QUOTE (SUBPAIR (QUOTE ($$OFFSET $$BODY $$BASE $$END)) (LIST (
GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$OFFSET _ 0 $$BODY _ BODY 
$$BASE $$END |declare| (LOCALVARS $$OFFSET $$BODY $$BASE $$END) |first| (SETQ $$BASE (|ffetch| (
LITATOM PNAMEBASE) |of| $$BODY)) (SETQ $$END (|ffetch| (PNAMEBASE PNAMELENGTH) |of| $$BASE)) 
|eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (
\\GETBASETHIN $$BASE $$OFFSET)))))) T)
(I.S.OPR (QUOTE |infatstring|) NIL (QUOTE (SUBPAIR (QUOTE ($$BODY $$END $$OFFSET $$BASE)) (LIST (
GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$BODY _ BODY $$END $$OFFSET 
$$BASE |declare| (LOCALVARS $$BODY $$END $$OFFSET $$BASE) |first| (SETQ $$OFFSET (SUB1 (|ffetch| (
STRINGP OFFST) |of| $$BODY))) (SETQ $$BASE (|ffetch| (STRINGP BASE) |of| $$BODY)) (SETQ $$END (IPLUS 
$$OFFSET (|ffetch| (STRINGP LENGTH) |of| $$BODY))) |eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (
IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (\\GETBASEFAT $$BASE $$OFFSET)))))) T)
(I.S.OPR (QUOTE |inthinstring|) NIL (QUOTE (SUBPAIR (QUOTE ($$BODY $$END $$OFFSET $$BASE)) (LIST (
GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$BODY _ BODY $$END $$OFFSET 
$$BASE |declare| (LOCALVARS $$BODY $$END $$OFFSET $$BASE) |first| (SETQ $$OFFSET (SUB1 (|ffetch| (
STRINGP OFFST) |of| $$BODY))) (SETQ $$BASE (|ffetch| (STRINGP BASE) |of| $$BODY)) (SETQ $$END (IPLUS 
$$OFFSET (|ffetch| (STRINGP LENGTH) |of| $$BODY))) |eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (
IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (\\GETBASETHIN $$BASE $$OFFSET)))))) T)
(PUTPROPS \\CHARCODEP DMACRO (OPENLAMBDA (X) (* \; 
"used to also say (ILEQ X \\MAXFATCHAR), but that's implied by the first two clauses") (AND (SMALLP X)
 (IGEQ X 0))))
(PUTPROPS \\FATCHARCODEP DMACRO (OPENLAMBDA (X) (* \; 
"Used to also say (ILEQ X \\MAXFATCHAR), but that's implied by the first two clauses") (AND (SMALLP X)
 (IGREATERP X \\MAXTHINCHAR))))
(PUTPROPS \\THINCHARCODEP DMACRO (OPENLAMBDA (X) (AND (SMALLP X) (IGEQ X 0) (ILEQ X \\MAXTHINCHAR))))
(PUTPROPS \\GETBASEFAT MACRO (= . \\GETBASE))
(PUTPROPS \\GETBASETHIN MACRO (= . \\GETBASEBYTE))
(PUTPROPS \\PUTBASEFAT MACRO (= . \\PUTBASE))
(PUTPROPS \\PUTBASETHIN MACRO (= . \\PUTBASEBYTE))
(PUTPROPS \\PUTBASECHAR MACRO (OPENLAMBDA (FATP BASE OFFSET CODE) (COND (FATP (\\PUTBASEFAT BASE 
OFFSET CODE)) (T (\\PUTBASETHIN BASE OFFSET CODE)))))
(PUTPROPS \\GETBASECHAR MACRO ((FATP BASE N) (COND (FATP (\\GETBASEFAT BASE N)) (T (\\GETBASETHIN BASE
 N)))))
(PUTPROPS \\CHARSET MACRO ((CHARCODE) (LRSH CHARCODE 8)))
(PUTPROPS \\CHAR8CODE MACRO ((CHARCODE) (LOGAND CHARCODE 255)))
(RPAQQ \\CHARMASK 255)
(RPAQQ \\MAXCHAR 255)
(RPAQQ \\MAXTHINCHAR 255)
(RPAQQ \\MAXFATCHAR 65535)
(RPAQQ \\MAXCHARSET 255)
(RPAQQ NSCHARSETSHIFT 255)
(RPAQQ \#STRINGPWORDS 4)
(CONSTANTS (\\CHARMASK 255) (\\MAXCHAR 255) (\\MAXTHINCHAR 255) (\\MAXFATCHAR 65535) (\\MAXCHARSET 255
) (NSCHARSETSHIFT 255) (\#STRINGPWORDS 4))
(PUTPROPS \\NATOMCHARS DMACRO ((AT) (|fetch| (LITATOM PNAMELENGTH) |of| AT)))
(PUTPROPS \\NSTRINGCHARS DMACRO ((S) (|fetch| (STRINGP LENGTH) |of| S)))
(PUTPROP (QUOTE LLCHAR) (QUOTE IMPORTDATE) (IDATE "11-Nov-2018 13:08:04"))

(ACCESSFNS BF ((BFBLOCK (ADDSTACKBASE DATUM))) (* \; "basic frame pointer") (BLOCKRECORD BFBLOCK ((
FLAGS BITS 3) (NIL BITS 3) (RESIDUAL FLAG) (* \; "true if this is not a full BF") (PADDING BITS 1) (
USECNT BITS 8) (IVAR WORD))) (TYPE? (IEQ (|fetch| (BF FLAGS) |of| DATUM) \\STK.BF)) (ACCESSFNS BF ((
NARGS (IDIFFERENCE (FOLDLO (IDIFFERENCE DATUM (|fetch| (BF IVAR) |of| DATUM)) WORDSPERCELL) (|fetch| (
BF PADDING) |of| DATUM))) (SIZE (IPLUS 2 (IDIFFERENCE DATUM (|fetch| (BF IVAR) |of| DATUM)))) (CHECKED
 (AND (|type?| BF DATUM) (|for| I |from| (|fetch| (BF IVAR) |of| DATUM) |to| (IDIFFERENCE DATUM 2) 
|by| 2 |always| (IEQ \\STK.NOTFLAG (|fetch| (BF FLAGS) |of| I))))))))
(ACCESSFNS FX ((FXBLOCK (ADDSTACKBASE DATUM))) (* \; "frame extension index") (BLOCKRECORD FXBLOCK ((
FLAGS BITS 3) (* \; "= \\STK.FX") (FAST FLAG) (NIL FLAG) (INCALL FLAG) (* \; 
"set when fncall microcode has to punt") (VALIDNAMETABLE FLAG) (* \; 
"if on, NAMETABLE field is filled in.  If off, is same as FNHEADER") (NOPUSH FLAG) (* \; 
"when returning to this frame, don't push a value.  Set by interrupt code") (USECNT BITS 8) (\#ALINK 
WORD) (* \; "low bit is SLOWP") (FNHEADER FULLXPOINTER) (NEXTBLOCK WORD) (PC WORD) (NAMETABLE# 
FULLXPOINTER) (\#BLINK WORD) (\#CLINK WORD))) (BLOCKRECORD FXBLOCK ((FLAGBYTE BYTE) (NIL BYTE) (NIL 
BITS 15) (* \; "most of the bits of #ALINK") (SLOWP FLAG) (* \; 
"if on, then BLINK and CLINK fields are valid.  If off, they are implicit") (NIL FULLXPOINTER 2) (
NAMETABHI WORD) (NAMETABLO WORD))) (TYPE? (IEQ (|fetch| (FX FLAGS) |of| DATUM) \\STK.FX)) (ACCESSFNS 
FX ((NAMETABLE (COND ((|fetch| (FX VALIDNAMETABLE) |of| DATUM) (|fetch| (FX NAMETABLE#) |of| DATUM)) (
T (|fetch| (FX FNHEADER) |of| DATUM))) (PROGN (|replace| (FX FAST) |of| DATUM |with| NIL) (|replace| (
FX NAMETABLE#) |of| DATUM |with| NEWVALUE) (|replace| (FX VALIDNAMETABLE) |of| DATUM |with| T))) (
FRAMENAME (|fetch| (FNHEADER FRAMENAME) |of| (|fetch| (FX NAMETABLE) |of| DATUM))) (INVALIDP (EQ DATUM
 0)) (* \; "true when A/CLink points at nobody, i.e. FX is bottom of stack") (FASTP (NOT (|fetch| (FX 
SLOWP) |of| DATUM)) (PROGN (CHECK (NULL NEWVALUE)) (COND ((|fetch| (FX FASTP) |of| DATUM) (|replace| (
FX \#BLINK) |of| DATUM |with| (|fetch| (FX DUMMYBF) |of| DATUM)) (|replace| (FX \#CLINK) |of| DATUM 
|with| (|fetch| (FX \#ALINK) |of| DATUM)) (|replace| (FX SLOWP) |of| DATUM |with| T))))) (BLINK (COND 
((|fetch| (FX FASTP) |of| DATUM) (|fetch| (FX DUMMYBF) |of| DATUM)) (T (|fetch| (FX \#BLINK) |of| 
DATUM))) (PROGN (|replace| (FX \#BLINK) |of| DATUM |with| NEWVALUE) (COND ((|fetch| (FX FASTP) |of| 
DATUM) (|replace| (FX \#CLINK) |of| DATUM |with| (|fetch| (FX \#ALINK) |of| DATUM)) (|replace| (FX 
SLOWP) |of| DATUM |with| T))))) (CLINK (IDIFFERENCE (COND ((|fetch| (FX FASTP) |of| DATUM) (|fetch| (
FX \#ALINK) |of| DATUM)) (T (|fetch| (FX \#CLINK) |of| DATUM))) \\#ALINK.OFFSET) (PROGN (|replace| (FX
 \#CLINK) |of| DATUM |with| (IPLUS NEWVALUE \\#ALINK.OFFSET)) (COND ((|fetch| (FX FASTP) |of| DATUM) (
|replace| (FX \#BLINK) |of| DATUM |with| (|fetch| (FX DUMMYBF) |of| DATUM)) (|replace| (FX SLOWP) |of|
 DATUM |with| T))))) (ALINK (IDIFFERENCE (FLOOR (|fetch| (FX \#ALINK) |of| DATUM) WORDSPERCELL) 
\\#ALINK.OFFSET) (PROGN (COND ((|fetch| (FX FASTP) |of| DATUM) (|replace| (FX \#BLINK) |of| DATUM 
|with| (|fetch| (FX DUMMYBF) |of| DATUM)) (|replace| (FX \#CLINK) |of| DATUM |with| (|fetch| (FX 
\#ALINK) |of| DATUM)))) (|replace| (FX \#ALINK) |of| DATUM |with| (IPLUS NEWVALUE \\#ALINK.OFFSET (
SUB1 WORDSPERCELL))))) (ACLINK (SHOULDNT) (PROGN (COND ((|fetch| (FX FASTP) |of| DATUM) (|replace| (FX
 \#BLINK) |of| DATUM |with| (|fetch| (FX DUMMYBF) |of| DATUM)))) (|replace| (FX \#CLINK) |of| DATUM 
|with| (IPLUS NEWVALUE \\#ALINK.OFFSET)) (|replace| (FX \#ALINK) |of| DATUM |with| (IPLUS NEWVALUE 
\\#ALINK.OFFSET (SUB1 WORDSPERCELL))))) (* \; 
"replaces A & C Links at once more efficiently than separately") (DUMMYBF (IDIFFERENCE DATUM 
WORDSPERCELL)) (* |;;| 
"This is either an actual BF or \"residual\" BF that provides enough BF to find its IVAR slot.  This means that when a FX is copied, the cell preceding the FX is copied too."
) (IVAR (|fetch| (BF IVAR) |of| (|fetch| (FX DUMMYBF) |of| DATUM))) (CHECKED (AND (|type?| FX DATUM) (
OR (IEQ (|fetch| (FX DUMMYBF) |of| DATUM) (|fetch| (FX BLINK) |of| DATUM)) (AND (|fetch| (BF RESIDUAL)
 |of| (|fetch| (FX DUMMYBF) |of| DATUM)) (IEQ (|fetch| (BF IVAR) |of| (|fetch| (FX DUMMYBF) |of| DATUM
)) (|fetch| (BF IVAR) |of| (|fetch| (FX BLINK) |of| DATUM))))))) (FIRSTPVAR (IPLUS DATUM (|fetch| (FX 
FXSIZE) |of| T))) (* \; "stack offset of PVAR0") (FXSIZE (PROGN 10)) (* \; 
"fixed overhead from flags thru clink") (PADDING (PROGN 4)) (* \; 
"doublecell of garbage for microcode use") (FIRSTTEMP (IPLUS (|fetch| (FX FIRSTPVAR) |of| DATUM) (
|fetch| (FX NPVARWORDS) |of| DATUM) (|fetch| (FX PADDING) |of| DATUM))) (* \; 
"note that NPVARWORDS is obtained from the FNHEADER") (SIZE (IDIFFERENCE (|fetch| (FX NEXTBLOCK) |of| 
DATUM) DATUM)))))
(ACCESSFNS FSB (* |;;| "FREE STACK BLOCK -- ") (* |;;| " A piece of stack space that's free.") (* |;;|
 "The first word contains 120000Q") (* |;;| "The 2nd word is the size of the block, in words.") ((
FSBBLOCK (ADDSTACKBASE DATUM)) (CHECKED (IEQ (|fetch| (FSB FLAGWORD) |of| DATUM) \\STK.FSB.WORD))) (
BLOCKRECORD FSBBLOCK ((FLAGS BITS 3) (DUMMY BITS 13) (SIZE WORD))) (BLOCKRECORD FSBBLOCK ((FLAGWORD 
WORD) (SIZE WORD))) (* \; "free stack block") (TYPE? (IEQ (|fetch| (FSB FLAGS) |of| DATUM) \\STK.FSB))
)
(ACCESSFNS STK ((STKBLOCK (ADDSTACKBASE DATUM))) (* \; "unspecified stack block") (BLOCKRECORD 
STKBLOCK ((FLAGS BITS 3))) (BLOCKRECORD STKBLOCK ((FLAGWORD WORD))))
(RPAQQ \\#ALINK.OFFSET 10)
(CONSTANTS \\#ALINK.OFFSET)
(GLOBALVARS \\PENDINGINTERRUPT \\KBDSTACKBASE \\MISCSTACKBASE \\STACKOVERFLOW)
(PUTPROPS \\MYALINK DMACRO (NIL ((OPCODES MYALINK))))
(PUTPROPS ADDSTACKBASE DMACRO (= . STACKADDBASE))
(PUTPROPS STACKADDBASE DMACRO ((N) (VAG2 \\STACKHI N)))
(PUTPROPS STACKGETBASE DMACRO ((N) (\\GETBASE (STACKADDBASE N) 0)))
(PUTPROPS STACKGETBASEPTR DMACRO ((N) (\\GETBASEPTR (STACKADDBASE N) 0)))
(PUTPROPS STACKPUTBASE DMACRO ((N V) (\\PUTBASE (STACKADDBASE N) 0 V)))
(PUTPROPS STACKPUTBASEPTR DMACRO ((N V) (\\PUTBASEPTR (STACKADDBASE N) 0 V)))
(PUTPROPS \\MISCAPPLY* MACRO ((FN ARG1 ARG2) (UNINTERRUPTABLY (|replace| (IFPAGE MISCSTACKFN) |of| 
|\\InterfacePage| |with| FN) (|replace| (IFPAGE MISCSTACKARG1) |of| |\\InterfacePage| |with| ARG1) (
|replace| (IFPAGE MISCSTACKARG2) |of| |\\InterfacePage| |with| ARG2) (\\CONTEXTSWITCH |\\MiscFXP|) (
|fetch| (IFPAGE MISCSTACKRESULT) |of| |\\InterfacePage|))))
(BLOCKRECORD STACKP ((STACKP0 WORD) (EDFXP WORD)) (BLOCKRECORD STACKP ((STACKPOINTER FULLXPOINTER))) (
TYPE? (STACKP DATUM)))
(RPAQQ STACKTYPES (\\STK.GUARD \\STK.FX \\STK.BF \\STK.NOTFLAG \\STK.FSB \\STK.FLAGS.SHIFT (
\\STK.FSB.WORD (LLSH \\STK.FSB \\STK.FLAGS.SHIFT)) (\\STK.GUARD.WORD (LLSH \\STK.GUARD 
\\STK.FLAGS.SHIFT)) (\\STK.BF.WORD (LLSH \\STK.BF \\STK.FLAGS.SHIFT))))
(RPAQQ \\STK.GUARD 7)
(RPAQQ \\STK.FX 6)
(RPAQQ \\STK.BF 4)
(RPAQQ \\STK.NOTFLAG 0)
(RPAQQ \\STK.FSB 5)
(RPAQQ \\STK.FLAGS.SHIFT 13)
(RPAQ \\STK.FSB.WORD (LLSH \\STK.FSB \\STK.FLAGS.SHIFT))
(RPAQ \\STK.GUARD.WORD (LLSH \\STK.GUARD \\STK.FLAGS.SHIFT))
(RPAQ \\STK.BF.WORD (LLSH \\STK.BF \\STK.FLAGS.SHIFT))
(CONSTANTS \\STK.GUARD \\STK.FX \\STK.BF \\STK.NOTFLAG \\STK.FSB \\STK.FLAGS.SHIFT (\\STK.FSB.WORD (
LLSH \\STK.FSB \\STK.FLAGS.SHIFT)) (\\STK.GUARD.WORD (LLSH \\STK.GUARD \\STK.FLAGS.SHIFT)) (
\\STK.BF.WORD (LLSH \\STK.BF \\STK.FLAGS.SHIFT)))
(RPAQQ |\\StackAreaSize| 768)
(RPAQ |\\InitStackSize| (ITIMES |\\StackAreaSize| 12))
(CONSTANTS |\\StackAreaSize| (|\\InitStackSize| (ITIMES |\\StackAreaSize| 12)))
(RPAQQ \\MAXSAFEUSECOUNT 200)
(CONSTANTS \\MAXSAFEUSECOUNT)
(BLOCKRECORD NAMETABLESLOT ((VARTYPE BYTE) (VAROFFSET BYTE)))
(BLOCKRECORD FVARSLOT ((BINDLO WORD) (BINDHI WORD)) (ACCESSFNS FVARSLOT ((LOOKEDUP (EVENP (|fetch| 
BINDLO |of| DATUM))) (BINDINGPTR (\\VAG2 (|fetch| BINDHI |of| DATUM) (|fetch| BINDLO |of| DATUM)) (
PROGN (|replace| BINDLO |of| DATUM |with| (\\LOLOC NEWVALUE)) (|replace| BINDHI |of| DATUM |with| (
\\HILOC NEWVALUE)))))))
(BLOCKRECORD PVARSLOT ((PVHI BITS 4) (PVVALUE XPOINTER)) (ACCESSFNS PVARSLOT ((BOUND (EQ (|fetch| (
PVARSLOT PVHI) |of| DATUM) 0) (|if| (NULL NEWVALUE) |then| (|replace| (PVARSLOT PVHI) |of| DATUM 
|with| 255) |else| (ERROR "Illegal replace" NEWVALUE))))))
(BLOCKRECORD STKTEMPSLOT ((STKTMPHI BITS 4) (VALUE XPOINTER)) (ACCESSFNS STKTEMPSLOT ((BINDINGPTRP (
NEQ (|fetch| STKTMPHI |of| DATUM) 0)))))
(BLOCKRECORD BINDMARKSLOT ((BINDMARKP FLAG) (NIL BITS 15)) (BLOCKRECORD BINDMARKSLOT ((BINDNEGVALUES 
WORD) (BINDLASTPVAR WORD))) (ACCESSFNS BINDMARKSLOT ((BINDNVALUES (PROGN (* \; 
"Value stored in high half is one's complement of number of values bound") (LOGXOR (|fetch| 
BINDNEGVALUES |of| DATUM) 65535))))))
(RPAQQ \\NT.IVAR 0)
(RPAQQ \\NT.PVAR 128)
(RPAQQ \\NT.FVAR 192)
(CONSTANTS \\NT.IVAR \\NT.PVAR \\NT.FVAR)
(PUTPROP (QUOTE LLSTK) (QUOTE IMPORTDATE) (IDATE " 6-Jan-1993 18:07:37"))

(PUTPROPS WORDCONTENTS BYTEMACRO ((PTR) (\\GETBASE PTR 0)))
(PUTPROPS SETWORDCONTENTS BYTEMACRO ((PTR N) (\\PUTBASE PTR 0 N)))
(PUTPROPS WORDOFFSET BYTEMACRO ((PTR N) (\\ADDBASE PTR N)))
(PUTPROPS \\RELEASECPAGE MACRO ((STREAM) (PROGN (* \; "Must be under an UNINTERRUPTABLY !") (COND ((
|fetch| CBUFDIRTY |of| STREAM) (\\SETIODIRTY STREAM (|fetch| CPAGE |of| STREAM)) (|replace| CBUFDIRTY 
|of| STREAM |with| NIL))) (|replace| CBUFSIZE |of| STREAM |with| 0) (|replace| CBUFPTR |of| STREAM 
|with| NIL))))
(PUTPROP (QUOTE PMAP) (QUOTE IMPORTDATE) (IDATE " 3-Feb-2002 14:11:02"))

(PUTPROPS ADDREF MACRO (OPENLAMBDA (PTR) (PROG1 PTR (\\ADDREF PTR))))
(PUTPROPS \\ADDREF DMACRO ((X) ((OPCODES GCREF 0) X)))
(PUTPROPS DELETEREF MACRO (OPENLAMBDA (PTR) (PROG1 PTR (\\DELREF PTR))))
(PUTPROPS \\DELREF DMACRO ((X) ((OPCODES GCREF 1) X)))
(PUTPROPS SCANREF MACRO (= . \\STKREF))
(PUTPROPS \\STKREF DMACRO ((X) ((OPCODES GCREF 2) X)))
(PUTPROPS UNSCANREF MACRO ((PTR) (\\HTFIND PTR 3)))
(PUTPROPS CREATEREF MACRO (= . \\CREATEREF))
(PUTPROPS \\CREATEREF MACRO (OPENLAMBDA (PTR) (PROG1 (\\DELREF PTR) (.INCREMENT.ALLOCATION.COUNT. 1)))
)
(PUTPROPS .INCREMENT.ALLOCATION.COUNT. MACRO (OPENLAMBDA (N) (DECLARE (GLOBALVARS \\RECLAIM.COUNTDOWN)
) (AND \\RECLAIM.COUNTDOWN (COND ((IGREATERP \\RECLAIM.COUNTDOWN N) (SETQ \\RECLAIM.COUNTDOWN (
IDIFFERENCE \\RECLAIM.COUNTDOWN N))) (T (SETQ \\RECLAIM.COUNTDOWN) (\\DORECLAIM))))))
(PUTPROPS .CHECK.ALLOCATION.COUNT. MACRO (OPENLAMBDA (N) (DECLARE (GLOBALVARS \\RECLAIM.COUNTDOWN)) (
AND \\RECLAIM.COUNTDOWN (COND ((NOT (IGREATERP \\RECLAIM.COUNTDOWN N)) (SETQ \\RECLAIM.COUNTDOWN) (
\\DORECLAIM))))))
(PUTPROPS \\GCDISABLED MACRO (NIL (PROGN (DECLARE (GLOBALVARS \\GCDISABLED)) \\GCDISABLED)))
(BLOCKRECORD HTOVERFLOW ((CASE BITS 4) (PTR XPOINTER)) (ACCESSFNS HTOVERFLOW ((CLEAR NIL (\\PUTBASEPTR
 DATUM 0 NIL)))))
(BLOCKRECORD GC ((CNT BITS 15) (STKBIT FLAG) (HIBITS BITS 15) (LINKP FLAG) (NXTPTR FIXP)) (BLOCKRECORD
 GC ((STKCNT WORD))) (ACCESSFNS GC ((EMPTY (EQ 0 (\\GETBASEFIXP DATUM 0)) (\\PUTBASEFIXP DATUM 0 0)) (
CONTENTS (\\GETBASEFIXP DATUM 0) (\\PUTBASEFIXP DATUM 0 NEWVALUE)) (LINKPTR (LOGAND (\\GETBASEFIXP 
DATUM 0) -2) (\\PUTBASEFIXP DATUM 0 (LOGOR NEWVALUE 1))))))
(BLOCKRECORD HTCOLL ((* |;;| 
"An entry in the GC collision table.  NEXTFREE is initialized to 2 by INITGC, as part of the MAKEINIT."
) (FREEPTR FIXP) (* \; "The GC table entry") (NEXTFREE FIXP) (* \; 
"If the entry is in use, points to the next entry in this collision chain.  If not, offset (in 1/2-entries) of the next free one on the chain."
)))
(PUTPROP (QUOTE LLGC) (QUOTE IMPORTDATE) (IDATE "19-Oct-1994 12:30:11"))

(PUTPROPS \\SYNCODE DMACRO (OPENLAMBDA (TABLE CHAR) (CHECK (|type?| CHARTABLE TABLE)) (* \; 
"0 is either NONE.TC, REAL.CCE, or OTHER.RC") (COND ((IGREATERP CHAR \\MAXTHINCHAR) (OR (AND (|fetch| 
(CHARTABLE NSCHARHASH) |of| TABLE) (GETHASH CHAR (|fetch| (CHARTABLE NSCHARHASH) |of| TABLE))) 0)) (T 
(\\GETBASEBYTE TABLE CHAR)))))
(PUTPROPS \\SETSYNCODE DMACRO (LAMBDA (TABLE CHAR CODE) (CHECK (|type?| CHARTABLE TABLE)) (* \; 
"0 is REAL.CCE, NONE.TC, OTHER.RC") (COND ((ILEQ CHAR \\MAXTHINCHAR) (\\PUTBASEBYTE TABLE CHAR CODE)) 
(T (\\SETFATSYNCODE TABLE CHAR CODE)))))
(DATATYPE CHARTABLE ((CHARSET0 256 BYTE) (NSCHARHASH FULLPOINTER)))
(RPAQQ CCECHOMODES (REAL.CCE IGNORE.CCE SIMULATE.CCE INDICATE.CCE))
(RPAQQ REAL.CCE 0)
(RPAQQ IGNORE.CCE 8)
(RPAQQ SIMULATE.CCE 16)
(RPAQQ INDICATE.CCE 24)
(CONSTANTS REAL.CCE IGNORE.CCE SIMULATE.CCE INDICATE.CCE)
(RPAQQ TERMCLASSES (NONE.TC EOL.TC CHARDELETE.TC WORDDELETE.TC WORDSEPR.TC LINEDELETE.TC RETYPE.TC 
CTRLV.TC))
(RPAQQ NONE.TC 0)
(RPAQQ EOL.TC 1)
(RPAQQ CHARDELETE.TC 2)
(RPAQQ WORDDELETE.TC 6)
(RPAQQ WORDSEPR.TC 7)
(RPAQQ LINEDELETE.TC 3)
(RPAQQ RETYPE.TC 4)
(RPAQQ CTRLV.TC 5)
(CONSTANTS NONE.TC EOL.TC CHARDELETE.TC WORDDELETE.TC WORDSEPR.TC LINEDELETE.TC RETYPE.TC CTRLV.TC)
(ACCESSFNS TERMCODE ((CCECHO (LOGAND DATUM 24)) (TERMCLASS (LOGAND DATUM 7))) (* \; 
"We assume that values are appropriately shifted") (CREATE (LOGOR CCECHO TERMCLASS)))
(DATATYPE TERMTABLEP (TERMSA RAISEFLG DELCHARECHO LINEDELETE 1STCHDEL NTHCHDEL POSTCHDEL EMPTYCHDEL (
CONTROLFLG FLAG) (ECHOFLG FLAG)) TERMSA _ (|create| CHARTABLE))
(PUTPROPS \\GETREADMACRODEF MACRO ((C TBL) (GETHASH C (|fetch| READMACRODEFS |of| TBL))))
(PUTPROPS \\GTREADTABLE MACRO (ARGS (COND ((LITATOM (CAR ARGS)) (SUBPAIR (QUOTE (X . FLG)) ARGS (QUOTE
 (SELECTQ X ((NIL T) (\\DTEST *READTABLE* (QUOTE READTABLEP))) (\\GTREADTABLE1 X . FLG))))) (T (QUOTE 
IGNOREMACRO)))))
(PUTPROPS \\GTREADTABLE1 DMACRO (ARGS (COND ((NULL (CDR ARGS)) (LIST (QUOTE \\DTEST) (CAR ARGS) (QUOTE
 (QUOTE READTABLEP)))) (T (QUOTE IGNOREMACRO)))))
(RPAQQ MACROBIT 8)
(RPAQQ BREAKBIT 16)
(RPAQQ STOPATOMBIT 32)
(RPAQQ ESCAPEBIT 64)
(RPAQQ INNERESCAPEBIT 4)
(CONSTANTS MACROBIT BREAKBIT STOPATOMBIT ESCAPEBIT INNERESCAPEBIT)
(RPAQQ READCODEMASKS ((CONTEXTMASK (LOGOR MACROBIT STOPATOMBIT BREAKBIT 1)) (WAKEUPMASK (LOGOR 
MACROBIT 2))))
(RPAQ CONTEXTMASK (LOGOR MACROBIT STOPATOMBIT BREAKBIT 1))
(RPAQ WAKEUPMASK (LOGOR MACROBIT 2))
(CONSTANTS (CONTEXTMASK (LOGOR MACROBIT STOPATOMBIT BREAKBIT 1)) (WAKEUPMASK (LOGOR MACROBIT 2)))
(RPAQQ READMACROCONTEXTS ((ALWAYS.RMC (LOGOR MACROBIT STOPATOMBIT BREAKBIT 0)) (FIRST.RMC (LOGOR 
MACROBIT 0)) (ALONE.RMC (LOGOR MACROBIT 1))))
(RPAQ ALWAYS.RMC (LOGOR MACROBIT STOPATOMBIT BREAKBIT 0))
(RPAQ FIRST.RMC (LOGOR MACROBIT 0))
(RPAQ ALONE.RMC (LOGOR MACROBIT 1))
(CONSTANTS (ALWAYS.RMC (LOGOR MACROBIT STOPATOMBIT BREAKBIT 0)) (FIRST.RMC (LOGOR MACROBIT 0)) (
ALONE.RMC (LOGOR MACROBIT 1)))
(RPAQQ READCLASSES ((OTHER.RC 0) (SEPRCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT 0)) (BREAKCHAR.RC (LOGOR 
ESCAPEBIT STOPATOMBIT BREAKBIT 0)) (STRINGDELIM.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 1)) (
LEFTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 2)) (RIGHTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT 
BREAKBIT 3)) (LEFTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 4)) (RIGHTBRACKET.RC (LOGOR 
ESCAPEBIT STOPATOMBIT BREAKBIT 5)) (ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 6)) (MULTIPLE-ESCAPE.RC 
(LOGOR ESCAPEBIT INNERESCAPEBIT 7)) (PACKAGEDELIM.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 1))))
(RPAQQ OTHER.RC 0)
(RPAQ SEPRCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT 0))
(RPAQ BREAKCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 0))
(RPAQ STRINGDELIM.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 1))
(RPAQ LEFTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 2))
(RPAQ RIGHTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 3))
(RPAQ LEFTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 4))
(RPAQ RIGHTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 5))
(RPAQ ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 6))
(RPAQ MULTIPLE-ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 7))
(RPAQ PACKAGEDELIM.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 1))
(CONSTANTS (OTHER.RC 0) (SEPRCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT 0)) (BREAKCHAR.RC (LOGOR ESCAPEBIT 
STOPATOMBIT BREAKBIT 0)) (STRINGDELIM.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 1)) (LEFTPAREN.RC (
LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 2)) (RIGHTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 3)) (
LEFTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 4)) (RIGHTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT
 BREAKBIT 5)) (ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 6)) (MULTIPLE-ESCAPE.RC (LOGOR ESCAPEBIT 
INNERESCAPEBIT 7)) (PACKAGEDELIM.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 1)))
(RPAQQ READMACROWAKEUPS ((IMMEDIATE.RMW (LOGOR MACROBIT 2)) (NONIMMEDIATE.RMW (LOGOR MACROBIT 0))))
(RPAQ IMMEDIATE.RMW (LOGOR MACROBIT 2))
(RPAQ NONIMMEDIATE.RMW (LOGOR MACROBIT 0))
(CONSTANTS (IMMEDIATE.RMW (LOGOR MACROBIT 2)) (NONIMMEDIATE.RMW (LOGOR MACROBIT 0)))
(RPAQQ READMACROESCAPES ((ESC.RME ESCAPEBIT) (NOESC.RME 0)))
(RPAQ ESC.RME ESCAPEBIT)
(RPAQQ NOESC.RME 0)
(CONSTANTS (ESC.RME ESCAPEBIT) (NOESC.RME 0))
(ACCESSFNS READCODE ((ESCAPE (LOGAND DATUM ESCAPEBIT)) (ESCQUOTE (BITTEST DATUM ESCAPEBIT)) (STOPATOM 
(BITTEST DATUM STOPATOMBIT)) (INNERESCQUOTE (BITTEST DATUM (LOGOR STOPATOMBIT INNERESCAPEBIT))) (
MACROCONTEXT (LOGAND DATUM CONTEXTMASK)) (MACROP (BITTEST DATUM MACROBIT)) (WAKEUP (LOGAND DATUM 
WAKEUPMASK)) (BREAK (BITTEST DATUM BREAKBIT))))
(RECORD READMACRODEF (MACROTYPE . MACROFN))
(DATATYPE READTABLEP ((READSA POINTER) (* \; "A CHARTABLE defining syntax of each char") (
READMACRODEFS POINTER) (* \; "A hash table associating macro chars with macro definitions") (
READMACROFLG FLAG) (* \; 
"True if read macros are enabled (turned off by Interlisp's crufty READMACROS function)") (ESCAPEFLG 
FLAG) (* \; 
"True if the char(s) with escape syntax are enabled (turned off by Interlisp's crufty ESCAPE function)"
) (COMMONLISP FLAG) (* \; 
"True if table is a Common Lisp read table and hence must obey Common Lisp syntax rules") (NUMBERBASE 
BITS 5) (* \; "Not used") (CASEINSENSITIVE FLAG) (* \; 
"If true, unescaped lowercase chars are converted to uppercase in symbols") (COMMONNUMSYNTAX FLAG) (* 
\; 
"True if number notation includes Common Lisp numbers: rationals as a/b, and the dfls exponent markers"
) (USESILPACKAGE FLAG) (* \; "If true, IL:READ ignores *PACKAGE* and reads in the IL package") (NIL 5 
FLAG) (DISPATCHMACRODEFS POINTER) (* \; 
"An a-list of dispatching macro char and its dispatch definitions") (HASHMACROCHAR BYTE) (* \; 
"The character code used in this read table for the # dispatch macro") (ESCAPECHAR BYTE) (* \; 
"The character code used in this read table for single escape") (MULTESCAPECHAR BYTE) (* \; 
"The character code used in this read table for multiple escape") (PACKAGECHAR BYTE) (* \; 
"The character code used in this read table for package delimiter") (READTBLNAME POINTER) (* \; 
"The canonical 'name' of this read table")) READSA _ (|create| CHARTABLE))
(PUTPROP (QUOTE ATBL) (QUOTE IMPORTDATE) (IDATE "12-Feb-2021 22:55:58"))

(DATATYPE STREAM ((* |;;| 
"First 8 words are fixed for BIN, BOUT opcodes.  Used to require length of whole datatype be multiple of 4, but Dolphin dead now."
) (COFFSET WORD) (* \; "Offset in CPPTR of next bin or bout") (CBUFSIZE WORD) (* \; 
"Offset past last byte in that buffer") (PEEKEDCHARP FLAG) (* \; 
"if true, PEEKEDCHAR contains value of recent call to unread-char") (ACCESSBITS BITS 3) (* \; 
"What kind of access file is open for (read, write, append)") (CBUFPTR POINTER) (* \; 
"Pointer to current buffer") (BYTESIZE BYTE) (* \; "Byte size of stream, always 8 for now") (CHARSET 
BYTE) (* \; 
"the current character set for this stream.  If 255, stream is not runcoded, so read-char consumes two bytes every time"
) (PEEKEDCHAR WORD) (* \; "value of unread-char call") (CHARPOSITION WORD) (* \; 
"Used by POSITION etc.") (CBUFMAXSIZE WORD) (* \; 
"on output, the size of the physical buffer--can't extend beyond this") (* |;;| 
"-------- Above fields (8 words) potentially known to microcode.  --------") (NONDEFAULTDATEFLG FLAG) 
(REVALIDATEFLG FLAG) (MULTIBUFFERHINT FLAG) (* \; 
"True if stream likes to read and write more than one buffer at a time") (USERCLOSEABLE FLAG) (* \; 
"Can be closed by CLOSEF;  NIL for terminal, dribble...") (FULLFILENAME POINTER) (* \; 
"Name by which file is known to user") (BINABLE FLAG) (* \; "BIN punts unless this bit on") (BOUTABLE 
FLAG) (* \; "BOUT punts unless this bit on") (EXTENDABLE FLAG) (* \; 
"BOUT punts when COFFSET ge CBUFFSIZE unless this bit set and COFFSET lt 512") (CBUFDIRTY FLAG) (* \; 
"true if BOUT has sullied the current buffer") (DEVICE POINTER) (* \; "FDEV of this guy") (USERVISIBLE
 FLAG) (* \; "Listed by OPENP;  NIL for terminal, dribble ...") (EOLCONVENTION BITS 2) (* \; 
"End-of-line convention") (NOTXCCS FLAG) (* \; "True if the character encoding format is not XCCS.") (
VALIDATION POINTER) (* \; 
"A number somehow identifying file, used to determine if file has changed in our absence") (CPAGE 
POINTER) (* \; "CPAGE,,COFFSET constitutes current file pointer for most randaccess streams") (EPAGE 
POINTER) (EOFFSET WORD) (* \; "Page, byte offset of eof") (LINELENGTH WORD) (* \; 
"LINELENGTH of stream, or -1 for no line length") (* |;;| 
"----Following are device-specific fields----") (* |;;| 
"Available for device-specific uses, NOT for application use.") (F1 POINTER) (F2 POINTER) (F3 POINTER)
 (F4 POINTER) (F5 POINTER) (FW6 WORD) (FW7 WORD) (FW8 WORD) (FW9 WORD) (F10 POINTER) (* |;;| 
"----Following only filled in for open streams----") (STRMBINFN POINTER) (* \; 
"Either the BIN fn from the FDEV, or a trap") (STRMBOUTFN POINTER) (* \; 
"Either the BIN fn from the FDEV, or a trap") (OUTCHARFN POINTER) (* \; 
"Called by \\OUTCHAR, the normal character printer.") (ENDOFSTREAMOP POINTER) (* \; 
"Called if EOF and we try to read.") (OTHERPROPS POINTER) (* \; "PROP LIST for holding other info.") (
IMAGEOPS POINTER) (* \; "Image operations vector") (IMAGEDATA POINTER) (* \; 
"Image instance variables--format depends on IMAGEOPS value") (BUFFS POINTER) (* \; 
"Buffer chain for pmapped streams") (MAXBUFFERS WORD) (* \; 
"Max # of buffers the system will allocate.") (LASTCCODE WORD) (* \; 
"After READ, RATOM, etc, the charcode that will be returned (as a character) by LASTC.  If there is none, this field is 65535."
) (EXTRASTREAMOP POINTER) (* \; "For use of applications programs, not devices")) (BLOCKRECORD STREAM 
((NIL 2 WORD) (UCODEFLAGS1 BITS 1) (* |;;| "respecification of access bits:") (RANDOMWRITEABLE FLAG) (
* \; "File open for output (access = OUTPUT or BOTH)") (APPENDABLE FLAG) (* \; 
"File open for append (OUTPUT or APPEND or BOTH)") (READABLE FLAG) (* \; 
"File open for read (READ or BOTH)") (NIL POINTER))) (BLOCKRECORD STREAM ((NIL 4 WORD) (NIL BITS 14) (
* |;;| "JIS character encoding format specific, overrides CHARSET field.") (IN.KANJIIN FLAG) (* \; 
"True if input stream is in Kanji-in mode.") (OUT.KANJIIN FLAG) (* \; 
"True if output stream is in Kanji-in mode."))) (ACCESSFNS STREAM ((ACCESS \\GETACCESS \\SETACCESS) (
FULLNAME (OR (|fetch| (STREAM FULLFILENAME) |of| DATUM) DATUM)) (NAMEDP (AND (|fetch| (STREAM 
FULLFILENAME) |of| DATUM) T)))) (ACCESSFNS STREAM (EXTERNALFORMAT (LISTGET (|ffetch| (STREAM 
OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT)) (LET ((PROPS (|ffetch| (STREAM OTHERPROPS) |of| DATUM)
)) (|freplace| (STREAM NOTXCCS) |of| DATUM |with| T) (COND (PROPS (LISTPUT PROPS (QUOTE EXTERNALFORMAT
) NEWVALUE)) (T (|freplace| (STREAM OTHERPROPS) |of| DATUM |with| (LIST (QUOTE EXTERNALFORMAT) 
NEWVALUE)))) (|freplace| (STREAM OUTCHARFN) |of| DATUM |with| (|ffetch| (EXTERNALFORMAT FILEOUTCHARFN)
 |of| NEWVALUE)) (AND (|ffetch| (EXTERNALFORMAT EOLVALID) |of| NEWVALUE) (|freplace| (STREAM 
EOLCONVENTION) |of| DATUM |with| (|ffetch| (EXTERNALFORMAT EOL) |of| NEWVALUE)))))) (ACCESSFNS STREAM 
(EXTERNALFORMAT.NAME (LISTGET (|ffetch| (STREAM OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT.NAME)) (
LET ((PROPS (|ffetch| (STREAM OTHERPROPS) |of| DATUM)) (NAME (COND ((LITATOM NEWVALUE) NEWVALUE) (T (
MKATOM NEWVALUE))))) (|freplace| (STREAM NOTXCCS) |of| DATUM |with| T) (COND (PROPS (LISTPUT PROPS (
QUOTE EXTERNALFORMAT.NAME) NAME)) (T (|freplace| (STREAM OTHERPROPS) |of| DATUM |with| (LIST (QUOTE 
EXTERNALFORMAT.NAME) NAME))))))) (ACCESSFNS STREAM (INCCODEFN (LET ((XFMT (LISTGET (|ffetch| (STREAM 
OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT)))) (AND (|type?| EXTERNALFORMAT XFMT) (|fetch| (
EXTERNALFORMAT INCCODEFN) |of| XFMT))))) (ACCESSFNS STREAM (PEEKCCODEFN (LET ((XFMT (LISTGET (|ffetch|
 (STREAM OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT)))) (AND (|type?| EXTERNALFORMAT XFMT) (|fetch|
 (EXTERNALFORMAT PEEKCCODEFN) |of| XFMT))))) (ACCESSFNS STREAM (BACKCHARFN (LET ((XFMT (LISTGET (
|ffetch| (STREAM OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT)))) (AND (|type?| EXTERNALFORMAT XFMT) 
(|fetch| (EXTERNALFORMAT BACKCHARFN) |of| XFMT))))) (ACCESSFNS STREAM (FILEOUTCHARFN (|ffetch| (STREAM
 OUTCHARFN) |of| DATUM))) (SYNONYM CBUFPTR (CPPTR)) USERCLOSEABLE _ T USERVISIBLE _ T ACCESSBITS _ 
|NoBits| CPAGE _ 0 EPAGE _ 0 BUFFS _ NIL BYTESIZE _ 8 CBUFPTR _ NIL MAXBUFFERS _ (LET NIL (DECLARE (
GLOBALVARS \\STREAM.DEFAULT.MAXBUFFERS)) \\STREAM.DEFAULT.MAXBUFFERS) CHARPOSITION _ 0 LINELENGTH _ (
LET NIL (DECLARE (GLOBALVARS FILELINELENGTH)) FILELINELENGTH) OUTCHARFN _ (FUNCTION \\FILEOUTCHARFN) 
ENDOFSTREAMOP _ (FUNCTION \\EOSERROR) IMAGEOPS _ \\NOIMAGEOPS EOLCONVENTION _ (SELECTQ (SYSTEMTYPE) (D
 CR.EOLC) (VAX LF.EOLC) (JERICHO CRLF.EOLC) CR.EOLC) STRMBINFN _ (FUNCTION \\STREAM.NOT.OPEN) 
STRMBOUTFN _ (FUNCTION \\STREAM.NOT.OPEN) LASTCCODE _ 65535 NOTXCCS _ NIL)
(PUTPROPS STREAMOP MACRO (ARGS (CONS (QUOTE SPREADAPPLY*) (CONS (COND ((EQ (CAR (LISTP (CAR ARGS))) (
QUOTE QUOTE)) (LIST (QUOTE |fetch|) (CADAR ARGS) (QUOTE |of|) (CADR ARGS))) (T (HELP 
"STREAMOP - OPNAME not quoted:" ARGS))) (CDDR ARGS)))))
(RPAQQ |AppendBit| 2)
(RPAQQ |NoBits| 0)
(RPAQQ |ReadBit| 1)
(RPAQQ |WriteBit| 4)
(RPAQ |OutputBits| (LOGOR |AppendBit| |WriteBit|))
(RPAQ |BothBits| (LOGOR |ReadBit| |OutputBits|))
(RPAQQ \\NORUNCODE 255)
(CONSTANTS |AppendBit| |NoBits| |ReadBit| |WriteBit| (|OutputBits| (LOGOR |AppendBit| |WriteBit|)) (
|BothBits| (LOGOR |ReadBit| |OutputBits|)) \\NORUNCODE)
(PUTPROPS |TestMasked| MACRO ((BITS MASK) (NEQ (LOGAND BITS MASK) 0)))
(PUTPROPS APPENDABLE MACRO ((STREAM) (|TestMasked| (|fetch| ACCESSBITS |of| STREAM) |AppendBit|)))
(PUTPROPS APPENDONLY MACRO ((STREAM) (EQ (|fetch| ACCESSBITS |of| STREAM) |AppendBit|)))
(PUTPROPS DIRTYABLE MACRO ((STREAM) (|TestMasked| (|fetch| ACCESSBITS |of| STREAM) (CONSTANT (LOGOR 
|AppendBit| |WriteBit|)))))
(PUTPROPS OPENED MACRO ((STREAM) (NEQ (|fetch| ACCESSBITS |of| STREAM) |NoBits|)))
(PUTPROPS OVERWRITEABLE MACRO ((STREAM) (|TestMasked| (|fetch| ACCESSBITS |of| STREAM) |WriteBit|)))
(PUTPROPS READABLE MACRO ((STREAM) (|TestMasked| (|fetch| ACCESSBITS |of| STREAM) |ReadBit|)))
(PUTPROPS READONLY MACRO ((STREAM) (EQ (|fetch| ACCESSBITS |of| STREAM) |ReadBit|)))
(PUTPROPS WRITEABLE MACRO ((STREAM) (OR (OVERWRITEABLE STREAM) (AND (APPENDABLE STREAM) (\\EOFP STREAM
)))))
(PUTPROPS \\RUNCODED MACRO (OPENLAMBDA (STREAM) (* |;;| 
"returns NIL is the stream is not runcoded, that is, if the stream has 16 bit bytes explicitly represented"
) (* \; "note that neq is ok since charsets are known to be SMALLP's") (NEQ (|fetch| CHARSET |of| 
STREAM) \\NORUNCODE)))
(RPAQQ EOLCONVENTIONS ((CR.EOLC 0) (LF.EOLC 1) (CRLF.EOLC 2)))
(RPAQQ CR.EOLC 0)
(RPAQQ LF.EOLC 1)
(RPAQQ CRLF.EOLC 2)
(CONSTANTS (CR.EOLC 0) (LF.EOLC 1) (CRLF.EOLC 2))
(PUTPROPS FDEVOP DMACRO (ARGS (LET ((OPNAME (CAR ARGS)) (METHOD-DEVICE (CADR ARGS)) (TAIL (CDDR ARGS))
) (COND ((AND (LISTP OPNAME) (EQ (CAR OPNAME) (QUOTE QUOTE))) (BQUOTE (SPREADAPPLY* (|fetch| (FDEV (
\\\, (CADR OPNAME))) |of| (\\\, METHOD-DEVICE)) (\\\,@ TAIL)))) (T (ERROR "OPNAME not quoted: " OPNAME
))))))
(PUTPROPS \\RECOGNIZE-HACK DMACRO (ARGS (LET ((NAME (CAR ARGS)) (RECOG (CADR ARGS)) (DEVICE (CADDR 
ARGS))) (BQUOTE (|if| (|type?| STREAM (\\\, NAME)) |then| (\\\, NAME) |else| (FDEVOP (QUOTE 
GETFILENAME) (\\\, DEVICE) (\\\, NAME) (\\\, RECOG) (\\\, DEVICE)))))))
(DATATYPE FDEV ((RESETABLE FLAG) (* \; "Obsolete") (RANDOMACCESSP FLAG) (NODIRECTORIES FLAG) (
PAGEMAPPED FLAG) (* \; "True if i/o handled by pmap routines") (FDBINABLE FLAG) (* \; 
"Copied as a microcode flag for INPUT streams formed on this device") (FDBOUTABLE FLAG) (FDEXTENDABLE 
FLAG) (BUFFERED FLAG) (* \; 
"True implies that the device supports the BIN & BOUT uCode conventions, and implements the GETNEXTBUFFER method"
) (DEVICENAME POINTER) (* \; "Identifying name somehow") (REMOTEP FLAG) (* \; 
"true if device not local to machine") (SUBDIRECTORIES FLAG) (* \; 
"true if device has real subdirectories") (INPUT-INDIRECTED FLAG) (* \; 
"True for devices that indirect their input stream.  Method INPUTSTREAM fetches it") (
OUTPUT-INDIRECTED FLAG) (* \; 
"True for devices that indirect their output stream.  Method OUTPUTSTREAM fetches it") (DEVICEINFO 
POINTER) (* \; "arbitrary device-specific info stored here") (OPENFILELST POINTER) (* \; 
"Default place to keep list of streams open on this device") (* |;;| 
"-----Rest of record consists of device \"methods\"-----") (* |;;| 
"-----Following fields required of all devices-----") (HOSTNAMEP POINTER) (* \; 
"(hostname {device}) => T if hostname is valid.  If device is given, return a FDEV for this {new} host, or T to use existing device"
) (EVENTFN POINTER) (* \; "(device event), called before/after logout, sysout, makesys") (* |;;| 
"-----Following fields required of all named devices, e.g., ones that open files-----") (
DIRECTORYNAMEP POINTER) (* \; "(host/dir) => true if directory exists on host") (OPENFILE POINTER) (* 
\; "(name access recog otherinfo device) => new stream open on this device, or NIL if name not found")
 (CLOSEFILE POINTER) (* \; "(stream) => closes stream, returns it") (REOPENFILE POINTER) (* \; 
"(name access recog otherinfo device stream) like openfile, but called after logout to revalidate file, so optionally uses info in old stream to keep this opening like the previous"
) (GETFILENAME POINTER) (* \; "(name recog device) => full file name") (DELETEFILE POINTER) (* \; 
"(name) => deletes file so named, returning name, or NIL on failure.  RECOG=OLDEST") (GENERATEFILES 
POINTER) (* \; 
"(device pattern) => generator object for files matching pattern.  Car of object is generator function, cdr is arbitrary state.  Generator fn returns next file, or NIL when finished"
) (RENAMEFILE POINTER) (* \; 
"(olddevice oldfile newdevice newfile) to rename file on this (olddevice) to a potentially different device."
) (OPENP POINTER) (* \; 
"(name access dev) => stream if name is open for access, or all open streams if name = NIL") (
REGISTERFILE POINTER) (* \; "(stream dev) => registers stream on its device") (UNREGISTERFILE POINTER)
 (* \; "(stream dev) => unregisters a stream from its device") (FREEPAGECOUNT POINTER) (* \; 
"(host/dir dev) => # of free pages on host/dir") (MAKEDIRECTORY POINTER) (* \; "(host/dir dev)") (
CHECKFILENAME POINTER) (* \; "(name dev) => name if it is well-formed file name for dev") (HOSTALIVEP 
POINTER) (* \; 
"(host dev) => true if host is alive, i.e., responsive;  only defined if REMOTEP is true") (
BREAKCONNECTION POINTER) (* \; "(host fastp dev) => closes connections to host") (* |;;| 
"-----The following are required methods for operating on open streams-----") (BIN POINTER) (* \; 
"(stream) => next byte of input") (BOUT POINTER) (* \; "(stream byte) output byte to stream") (PEEKBIN
 POINTER) (* \; "(stream) => next byte without advancing position in stream") (READCHAR POINTER) (* \;
 "(stream) => next input char") (WRITECHAR POINTER) (* \; "(stream char) => writes char to stream") (
PEEKCHAR POINTER) (UNREADCHAR POINTER) (READP POINTER) (* \; 
"(stream flag) => T if there is input available from stream right now") (EOFP POINTER) (* \; 
"(stream) => T if BIN would signal eof.") (BLOCKIN POINTER) (* \; "(stream buffer byteoffset nbytes)")
 (BLOCKOUT POINTER) (* \; "(stream buffer byteoffset nbytes)") (FORCEOUTPUT POINTER) (* \; 
"(stream waitForFinish) flushes out to device anything that is buffered awaiting transmission") (
GETFILEINFO POINTER) (* \; 
"(stream/name attribute device) => value of attribute for open stream or name of closed file") (
SETFILEINFO POINTER) (* \; 
"(stream/name attribute newvalue device) sets attribute of open stream or closed file of given name") 
(CHARSETFN POINTER) (* \; 
"(stream charset) => access function for the charset slot, for benefit of indirect streams.  See IMCHARSET for changing it on a file."
) (INPUTSTREAM POINTER) (* \; "(stream) => indirected input stream") (OUTPUTSTREAM POINTER) (* \; 
"(stream) => indirected output stream") (* |;;| 
"-----Following are required of random-access streams-----") (GETFILEPTR POINTER) (GETEOFPTR POINTER) 
(SETFILEPTR POINTER) (BACKFILEPTR POINTER) (* \; 
"(stream) backs up `fileptr' by one.  Stream is only required to be able to do this once, i.e.  one-character buffer suffices"
) (SETEOFPTR POINTER) (* \; "(stream length) => truncates or lengthens stream to indicated length") (
LASTC POINTER) (* \; "Should be possible only if RANDOMACCESSP") (* |;;| 
"-----Following used for buffered streams-----") (GETNEXTBUFFER POINTER) (* \; 
"(stream whatfor noerrorflg) => Disposes of current buffer and optionally reads next.  whatfor is READ or WRITE.  Can cause EOF error unless noerrorflg"
) (RELEASEBUFFER POINTER) (* \; "(stream) => Does whatever appropriate when CBUFPTR is released") (* 
|;;| "-----Following used for pagemapped streams-----") (READPAGES POINTER) (* \; 
"(stream firstpage# buflist) => # of bytes read, starting at firstpage#, reading into buflist, a list of buffers or a single buffer (the usual case)"
) (WRITEPAGES POINTER) (* \; 
"(stream firstpage# buflist) writes from buflist to stream starting at firstpage# of stream") (
TRUNCATEFILE POINTER) (* \; 
"(stream page offset) make stream's eof be at page,offset, discarding anything after it") (* |;;| 
"-----For window system, argh-----") (WINDOWOPS POINTER) (* \; "window system operations") (WINDOWDATA
 POINTER) (* \; "data for window systems") (* |;;| 
"-----For any stream (here to not recompile everything)-----") (READCHARCODE POINTER) (* \; 
"Read a character code from the stream (cf BIN for bytes).")) DIRECTORYNAMEP _ (FUNCTION NILL) 
HOSTNAMEP _ (FUNCTION NILL) READP _ (FUNCTION \\GENERIC.READP) SETFILEPTR _ (FUNCTION 
\\IS.NOT.RANDACCESSP) GETFILEPTR _ (FUNCTION \\ILLEGAL.DEVICEOP) GETEOFPTR _ (FUNCTION 
\\IS.NOT.RANDACCESSP) EOFP _ (FUNCTION \\ILLEGAL.DEVICEOP) BLOCKIN _ (FUNCTION \\GENERIC.BINS) 
BLOCKOUT _ (FUNCTION \\GENERIC.BOUTS) RENAMEFILE _ (FUNCTION \\GENERIC.RENAMEFILE) FORCEOUTPUT _ (
FUNCTION NILL) REGISTERFILE _ (FUNCTION NILL) OPENP _ (FUNCTION NILL) UNREGISTERFILE _ (FUNCTION NILL)
 READCHAR _ (FUNCTION \\GENERIC.READCHAR) WRITECHAR _ (FUNCTION \\GENERIC.WRITECHAR) PEEKCHAR _ (
FUNCTION \\GENERIC.PEEKCHAR) UNREADCHAR _ (FUNCTION \\GENERIC.UNREADCHAR) CHARSETFN _ (FUNCTION 
\\GENERIC.CHARSET) BREAKCONNECTION _ (FUNCTION NILL) READCHARCODE _ (FUNCTION \\GENERIC.READCCODE))
(RECORD FILEGENOBJ (NEXTFILEFN FILEINFOFN . GENFILESTATE))
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* \; 
"If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream.") (EOL 
BITS 2) (NIL BITS 1) (INCCODEFN POINTER) (* \; "Called with two arguments -- STREAM and COUNTP") (
PEEKCCODEFN POINTER) (* \; "Called with three arguments -- STREAM, NOERROR and COUNTP") (BACKCHARFN 
POINTER) (* \; "Called with two arguments -- STREAM and COUNTP") (FILEOUTCHARFN POINTER) (* \; 
"Called with two arguments -- STREAM and CHARCODE")) EOLVALID _ NIL)
(PUTPROPS \\OUTCHAR DMACRO (OPENLAMBDA (STREAM CHARCODE) (STREAMOP (QUOTE OUTCHARFN) STREAM STREAM 
CHARCODE)))
(PUTPROPS \\DEVICE-OPEN-STREAMS MACRO (ARGS (LET ((DEVICE (CAR ARGS))) (BQUOTE (FDEVOP (QUOTE OPENP) (
\\\, DEVICE) NIL NIL (\\\, DEVICE))))))
(PUTPROPS \\CONVERT-PATHNAME DMACRO (OPENLAMBDA (PATHNAME?) (* |;;| 
"Coerce pathnames to Interlisp strings, for the benefit of antediluvian Interlisp-D file fns") (
CL:TYPECASE PATHNAME? (PATHNAME (INTERLISP-NAMESTRING PATHNAME?)) (T PATHNAME?))))
(DEFOPTIMIZER ACCESS-CHARSET (STREAM &OPTIONAL NEWVALUE) (BQUOTE ((OPENLAMBDA (STRM) (FDEVOP (QUOTE 
CHARSETFN) (|fetch| (STREAM DEVICE) |of| STRM) STRM (\\\, NEWVALUE))) (\\\, STREAM))))
(PUTPROPS \\DECFILEPTR MACRO ((STREAM X) (\\INCFILEPTR STREAM (IMINUS X))))
(PUTPROPS \\GETFILEPTR MACRO (OPENLAMBDA (STRM) (FDEVOP (QUOTE GETFILEPTR) (|fetch| DEVICE |of| STRM) 
STRM)))
(PUTPROPS \\SIGNEDWIN MACRO ((STREAM) (SIGNED (\\WIN STREAM) BITSPERWORD)))
(PUTPROPS \\SIGNEDWOUT MACRO ((STREAM N) (\\WOUT STREAM (UNSIGNED N BITSPERWORD))))
(PUTPROPS \\WIN MACRO (OPENLAMBDA (STREAM) (|create| WORD HIBYTE _ (\\BIN STREAM) LOBYTE _ (\\BIN 
STREAM))))
(PUTPROPS \\WOUT MACRO (OPENLAMBDA (STREAM W) (\\BOUT STREAM (|fetch| HIBYTE |of| W)) (\\BOUT STREAM (
|fetch| LOBYTE |of| W))))
(PUTPROPS \\BINS BYTEMACRO (OPENLAMBDA (STRM BASE OFF NBYTES) (FDEVOP (QUOTE BLOCKIN) (|fetch| (STREAM
 DEVICE) |of| STRM) STRM BASE OFF NBYTES)))
(PUTPROPS \\BOUTS BYTEMACRO (OPENLAMBDA (STRM BASE OFF NBYTES) (FDEVOP (QUOTE BLOCKOUT) (|fetch| (
STREAM DEVICE) |of| STRM) STRM BASE OFF NBYTES)))
(PUTPROPS \\EOFP BYTEMACRO (OPENLAMBDA (STRM) (FDEVOP (QUOTE EOFP) (|fetch| (STREAM DEVICE) |of| STRM)
 STRM)))
(PUTPROPS SIZE.FROM.LENGTH MACRO (LAMBDA (LEN) (DECLARE (LOCALVARS LEN)) (AND LEN (FOLDHI LEN 
BYTESPERPAGE))))
(RPAQQ |BitsPerByte| 8)
(RPAQ |ByteOffsetSize| (SELECTQ (SYSTEMTYPE) (VAX 10) 9))
(RPAQQ |WordsPerPage| 256)
(CONSTANTS |BitsPerByte| (|ByteOffsetSize| (SELECTQ (SYSTEMTYPE) (VAX 10) 9)) |WordsPerPage|)
(RPAQ \\MAXFILEPTR (SUB1 (LLSH 1 30)))
(CONSTANTS (\\MAXFILEPTR (SUB1 (LLSH 1 30))))
(ACCESSFNS BYTEPTR ((PAGE (FOLDLO DATUM BYTESPERPAGE)) (OFFSET (MOD DATUM BYTESPERPAGE))) (TYPE? (AND 
(FIXP DATUM) (IGEQ DATUM 0) (ILEQ DATUM \\MAXFILEPTR))) (CREATE (IPLUS (UNFOLD PAGE BYTESPERPAGE) 
OFFSET)))
(PUTPROP (QUOTE FILEIO) (QUOTE IMPORTDATE) (IDATE "13-Aug-2020 11:43:08"))

(BLOCKRECORD FIXP ((HINUM WORD) (LONUM WORD)) (CREATE (CREATECELL \\FIXP)) (TYPE? (EQ (NTYPX DATUM) 
\\FIXP)))
(RPAQQ MAX.SMALL.INTEGER 65535)
(RPAQQ MAX.POS.HINUM 32767)
(CONSTANTS (MAX.SMALL.INTEGER 65535) (MAX.POS.HINUM 32767))
(PUTPROPS .UNBOX. MACRO (ARGS (LET ((ARG-FORM (CAR ARGS)) (HIGH-VAR (CADR ARGS)) (LOW-VAR (CADDR ARGS)
) (BIGNUM-FORM (CADDDR ARGS))) (BQUOTE (PROG NIL UBLP (SELECTC (NTYPX (\\\, ARG-FORM)) (\\FIXP (SETQ (
\\\, HIGH-VAR) (|ffetch| (FIXP HINUM) |of| (\\\, ARG-FORM))) (SETQ (\\\, LOW-VAR) (|ffetch| (FIXP 
LONUM) |of| (\\\, ARG-FORM)))) (\\SMALLP (COND ((ILEQ 0 (\\\, ARG-FORM)) (SETQ (\\\, HIGH-VAR) 0) (
SETQ (\\\, LOW-VAR) (\\\, ARG-FORM))) (T (SETQ (\\\, HIGH-VAR) 65535) (SETQ (\\\, LOW-VAR) (\\LOLOC (
\\\, ARG-FORM)))))) (\\FLOATP (SETQ (\\\, ARG-FORM) (\\FIXP.FROM.FLOATP (\\\, ARG-FORM))) (GO UBLP)) (
COND ((TYPENAMEP (\\\, ARG-FORM) (QUOTE RATIO)) (SETQ (\\\, ARG-FORM) (IQUOTIENT (CL::RATIO-NUMERATOR 
(\\\, ARG-FORM)) (CL::RATIO-DENOMINATOR (\\\, ARG-FORM)))) (GO UBLP)) (\\\,@ (COND (BIGNUM-FORM (
BQUOTE (((CL:INTEGERP (\\\, ARG-FORM)) (\\\, BIGNUM-FORM))))) (T (BQUOTE (((CL:INTEGERP (\\\, ARG-FORM
)) (\\ILLEGAL.ARG (\\\, ARG-FORM)))))))) (T (CL::%NOT-NONCOMPLEX-NUMBER-ERROR (\\\, ARG-FORM))))))))))
(PUTPROPS .NEGATE. MACRO ((HY LY) (COND ((EQ 0 LY) (AND (NEQ HY 0) (SETQ HY (ADD1 (IDIFFERENCE 
MAX.SMALL.INTEGER HY))))) (T (SETQ HY (IDIFFERENCE MAX.SMALL.INTEGER HY)) (SETQ LY (ADD1 (IDIFFERENCE 
MAX.SMALL.INTEGER LY)))))))
(PUTPROPS .LLSH1. MACRO ((HI LO) (* \; "shift the pair left one, assuming no overflow") (SETQ HI (LLSH
 HI 1)) (SETQ LO (LLSH (COND ((IGREATERP LO MAX.POS.HINUM) (|add| HI 1) (LOGAND LO MAX.POS.HINUM)) (T 
LO)) 1))))
(PUTPROPS .LRSH1. MACRO ((HI LO) (SETQ LO (LRSH LO 1)) (COND ((NEQ (LOGAND HI 1) 0) (SETQ LO (IPLUS LO
 \\SIGNBIT)))) (SETQ HI (LRSH HI 1))))
(PUTPROPS .BOXIPLUS. MACRO (OPENLAMBDA (X Y) (PROG ((HX (\\GETBASE X 0)) (LX (\\GETBASE X 1)) HY LY) (
.UNBOX. Y HY LY) (SETQ HX (COND ((IGREATERP HX (IDIFFERENCE MAX.SMALL.INTEGER HY)) (IDIFFERENCE HX (
ADD1 (IDIFFERENCE MAX.SMALL.INTEGER HY)))) (T (IPLUS HX HY)))) (* |Add| |high| |parts|) (\\PUTBASE X 1
 (COND ((IGREATERP LX (IDIFFERENCE MAX.SMALL.INTEGER LY)) (* |Carry| |into| |high| |part.|) (SETQ HX (
COND ((EQ HX MAX.SMALL.INTEGER) 0) (T (ADD1 HX)))) (IDIFFERENCE LX (ADD1 (IDIFFERENCE 
MAX.SMALL.INTEGER LY)))) (T (IPLUS LX LY)))) (\\PUTBASE X 0 HX) (RETURN X))))
(PUTPROPS |PutUnboxed| DMACRO (= . \\PUTFIXP))
(PUTPROP (QUOTE LLARITH) (QUOTE IMPORTDATE) (IDATE "16-May-1990 18:47:56"))

(PUTPROPS POLYEVAL DMACRO ((X COEFFS DEGREE) (* \; 
"execute the POLYEVAL opcode on the value X, the array COEFFS with degree DEGREE") (\\FLOATBOX ((
OPCODES UBFLOAT3 0) (\\FLOATUNBOX X) (|fetch| (ARRAYP BASE) |of| COEFFS) DEGREE))))
(BLOCKRECORD FLOATP ((SIGNBIT BITS 1) (EXPONENT BITS 8) (HIFRACTION BITS 7) (LOFRACTION BITS 16)) (
BLOCKRECORD FLOATP ((HIWORD WORD) (LOWORD WORD))) (BLOCKRECORD FLOATP ((NIL BITS 9) (LONGFRACTION BITS
 23))) (BLOCKRECORD FLOATP ((FLOATCONTENTS BITS 32))) (BLOCKRECORD FLOATP ((NIL BITS 1) (
HIWORDNOSIGNBIT BITS 15))) (CREATE (\\FLOATBOX (\\VAG2 (LOGOR (LLSH SIGNBIT (PLUS 7 8)) (LLSH EXPONENT
 7) HIFRACTION) LOFRACTION))) LOFRACTION _ 0 HIFRACTION _ 0 EXPONENT _ 0 SIGNBIT _ 0 (ACCESSFNS FLOATP
 ((EXP (LOGAND (LRSH (\\HILOC (\\FLOATUNBOX DATUM)) 7) 255)) (HIFRAC (LOGAND (\\HILOC (\\FLOATUNBOX 
DATUM)) 127)))))
(RPAQQ MAX.DIGITS.ACCURACY 9)
(CONSTANTS (MAX.DIGITS.ACCURACY 9))
(PUTPROPS \\CALLER.ARGS MACRO (X (LET ((ARGS (CAR X)) (FORMS (CDR X))) (BQUOTE (PROGN (\\SLOWRETURN) (
LET ((AL (\\MYALINK)) NEXT (\\\,@ (|for| VAR |in| ARGS |collect| (COND ((LISTP VAR) (LIST (CAR VAR) 0)
) (T VAR))))) (DECLARE (\\\,@ (|for| VAR |in| ARGS |when| (LISTP VAR) |collect| (BQUOTE (TYPE (\\\, (
SELECTQ (CADR VAR) ((FLOATING FLOATP) (CADR VAR)) (HELP))) (\\\, (CAR VAR))))))) (SETQ NEXT (|fetch| (
FX NEXTBLOCK) |of| AL)) (\\\,@ (|for| X |in| (REVERSE ARGS) |collect| (LET ((FORMS (BQUOTE (
\\.GETBASE32 \\STACKSPACE (SETQ NEXT (IDIFFERENCE NEXT WORDSPERCELL)))))) (COND ((LISTP X) (BQUOTE (
SETQ (\\\, (CAR X)) (\\FLOATBOX (\\\, FORMS))))) (T (BQUOTE (SETQ (\\\, X) (\\\, FORMS)))))))) (
\\MAKEFREEBLOCK NEXT (TIMES (\\\, (LENGTH ARGS)) WORDSPERCELL)) (|replace| (FX NEXTBLOCK) |of| AL 
|with| NEXT) (PROGN (\\\,@ FORMS))))))))
(PUTPROP (QUOTE LLFLOAT) (QUOTE IMPORTDATE) (IDATE "16-May-1990 19:26:51"))

(DEFOPTIMIZER FONTPROP (&REST ARGS) (SELECTQ (AND (EQ (CAADR ARGS) (QUOTE QUOTE)) (CADADR ARGS)) (
ASCENT (LIST (QUOTE FONTASCENT) (CAR ARGS))) (DESCENT (LIST (QUOTE FONTDESCENT) (CAR ARGS))) (HEIGHT (
LIST (QUOTE FONTHEIGHT) (CAR ARGS))) (QUOTE IGNOREMACRO)))
(DATATYPE FONTCLASS ((PRETTYFONT# BYTE) DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME))
(DATATYPE FONTDESCRIPTOR ((FONTDEVICE POINTER) (FONTFAMILY POINTER) (FONTSIZE POINTER) (FONTFACE 
POINTER) (|\\SFAscent| WORD) (|\\SFDescent| WORD) (|\\SFHeight| WORD) (ROTATION WORD) (FBBOX 
SIGNEDWORD) (FBBOY SIGNEDWORD) (FBBDX SIGNEDWORD) (FBBDY SIGNEDWORD) (|\\SFLKerns| POINTER) (
|\\SFRWidths| POINTER) (FONTDEVICESPEC POINTER) (* \; 
"Holds the spec by which the font is known to the printing device, if coercion has been done") (
OTHERDEVICEFONTPROPS POINTER) (* \; "For individual devices to hang special information") (FONTSCALE 
POINTER) (\\SFFACECODE BITS 8) (FONTAVGCHARWIDTH WORD) (* \; 
"Set in FONTCREATE, used to fix up the linelength when DSPFONT is called") (FONTIMAGEWIDTHS POINTER) (
* \; 
"This is the image width, as opposed to the advanced width;  initial hack for accents, kerning.  Fields is referenced by FONTCREATE."
) (FONTCHARSETVECTOR POINTER) (* \; 
"A 256-pointer block, with one pointer per 'character set' --each group of 256 character codes.  Each pointer is either NIL if there's no info for that charset, or is a CHARSETINFO, containing widths, char bitmap, etc for the characters in that charset."
) (FONTEXTRAFIELD2 POINTER)) FONTCHARSETVECTOR _ (\\CREATEFONTCHARSETVECTOR))
(RECORD FONTFACE (WEIGHT SLOPE EXPANSION) (ACCESSFNS ((COLOR (CDDDR DATUM) (RPLACD (CDDR DATUM) 
NEWVALUE)) (BACKCOLOR (COND ((CDDDR DATUM) (CAR (CDDDR DATUM)))) (PROGN (COND ((NULL (CDDDR DATUM)) (
RPLACD (CDDR DATUM) (LIST NIL NIL)))) (RPLACA (CDDDR DATUM) NEWVALUE))) (FORECOLOR (COND ((CDDDR DATUM
) (CADR (CDDDR DATUM)))) (PROGN (COND ((NULL (CDDDR DATUM)) (RPLACD (CDDR DATUM) (LIST NIL NIL)))) (
RPLACA (CDR (CDDDR DATUM)) NEWVALUE))))) WEIGHT _ (QUOTE MEDIUM) SLOPE _ (QUOTE REGULAR) EXPANSION _ (
QUOTE REGULAR) (TYPE? LISTP))
(DATATYPE CHARSETINFO (WIDTHS (* \; 
"The advance-width of each character, an array indexed by charcode.  Usually the same as the imagewidth, but can differ for accents, kerns kerns.  This is what should be used for stringwidth calculations."
) OFFSETS (* \; "Offset of each character into the image bitmap;  X value of left edge") IMAGEWIDTHS (
* \; "imagewidths is not automagically allocated since it is not always needed") CHARSETBITMAP (* \; 
"Bitmap containing the character images, indexed by OFFSETS") YWIDTHS (CHARSETASCENT WORD) (* \; 
"Max ascent for all characters in this CHARSET") (CHARSETDESCENT WORD) (* \; 
"Max descent for all characters in this CHARSET") LEFTKERN) WIDTHS _ (\\CREATECSINFOELEMENT) OFFSETS _
 (\\CREATECSINFOELEMENT))
(PUTPROPS FONTASCENT MACRO ((FONTSPEC) (|ffetch| |\\SFAscent| |of| (\\GETFONTDESC FONTSPEC))))
(PUTPROPS FONTDESCENT MACRO ((FONTSPEC) (|ffetch| |\\SFDescent| |of| (\\GETFONTDESC FONTSPEC))))
(PUTPROPS FONTHEIGHT MACRO ((FONTSPEC) (|ffetch| |\\SFHeight| |of| (\\GETFONTDESC FONTSPEC))))
(PUTPROPS \\FGETOFFSET DMACRO ((OFFSETSBLOCK CHAR8CODE) (\\GETBASE OFFSETSBLOCK CHAR8CODE)))
(PUTPROPS \\FSETOFFSET DMACRO ((OFFSETSBLOCK CHAR8CODE OFFSET) (\\PUTBASE OFFSETSBLOCK CHAR8CODE 
OFFSET)))
(PUTPROPS \\FGETWIDTH DMACRO ((WIDTHSBLOCK CHAR8CODE) (\\GETBASE WIDTHSBLOCK CHAR8CODE)))
(PUTPROPS \\FSETWIDTH DMACRO ((WIDTHSBLOCK INDEX WIDTH) (\\PUTBASE WIDTHSBLOCK INDEX WIDTH)))
(PUTPROPS \\FGETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE) (\\FGETWIDTH (|ffetch| (CHARSETINFO 
WIDTHS) |of| (\\GETCHARSETINFO (\\CHARSET CHARCODE) FONTDESC)) (\\CHAR8CODE CHARCODE))))
(PUTPROPS \\FSETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE WIDTH) (\\FSETWIDTH (|ffetch| (
CHARSETINFO WIDTHS) |of| (\\GETCHARSETINFO (\\CHARSET CHARCODE) FONTDESC)) (\\CHAR8CODE CHARCODE) 
WIDTH)))
(PUTPROPS \\FGETIMAGEWIDTH MACRO ((IMAGEWIDTHSBLOCK CHAR8CODE) (\\GETBASE IMAGEWIDTHSBLOCK CHAR8CODE))
)
(PUTPROPS \\FSETIMAGEWIDTH DMACRO ((WIDTHSBLOCK INDEX WIDTH) (\\PUTBASE WIDTHSBLOCK INDEX WIDTH)))
(PUTPROPS \\GETCHARSETINFO MACRO ((CHARSET FONTDESC NOSLUG?) (* |;;| 
"fetches the charsetinfo for charset CHARSET in fontdescriptor FONTDESC.  If NIL, then creates the required charset."
) (* |;;| 
"NOSLUG?  means don't create an empty (slug) csinfo if the charset is not found, just return NIL") (OR
 (\\GETBASEPTR (|ffetch| FONTCHARSETVECTOR |of| FONTDESC) (UNFOLD CHARSET 2)) (\\CREATECHARSET CHARSET
 FONTDESC NOSLUG?))))
(PUTPROPS \\CREATECSINFOELEMENT MACRO (NIL (\\ALLOCBLOCK (FOLDHI (IPLUS \\MAXTHINCHAR 3) WORDSPERCELL)
)))
(PUTPROPS \\CREATEFONTCHARSETVECTOR MACRO (NIL (* \; "Allocates a block for the character set records"
) (\\ALLOCBLOCK (ADD1 \\MAXCHARSET) T)))
(DEFMACRO \\CREATEKERNELEMENT NIL (BQUOTE (CL:MAKE-ARRAY (IPLUS \\MAXTHINCHAR 3) :ELEMENT-TYPE (QUOTE 
(SIGNED-BYTE 16)) :INITIAL-ELEMENT 0)))
(DEFMACRO \\FSETLEFTKERN (LEFTKERNBLOCK INDEX KERNVALUE) (BQUOTE (CL:SETF (CL:AREF (\\\, LEFTKERNBLOCK
) (\\\, INDEX)) (\\\, KERNVALUE))))
(DEFMACRO \\FGETLEFTKERN (LEFTKERNBLOCK CHAR8CODE) (BQUOTE (CL:AREF (\\\, LEFTKERNBLOCK) (\\\, 
CHAR8CODE))))
(RPAQQ \\MAXNSCHAR 65535)
(CONSTANTS (\\MAXNSCHAR 65535))
(PUTPROP (QUOTE FONT) (QUOTE IMPORTDATE) (IDATE " 9-Feb-2021 11:39:44"))

(BLOCKRECORD KEYACTION ((* |;;| 
"KEYACTION Table:  For interpreting keystrokes.  Stored as a 8-cell block of untyped pointer hunk storage."
) FLAGS (* \; 
"Flag byte per key# (one for down-transtion, 1 for up-.) to describe whether lockshifting occrrs, you ignore the transition, etc."
) CODES (* \; "Table of character codes generated by each key when no shift key is pressed.") 
SHIFTCODES (* \; "Table of character codes generated by each key when the shift key is pressed.") 
ARMED (* \; "Not sure...") INTERRUPTLIST (* \; "List of armed interrupts?") ALTGRAPHCODES (* \; 
"Table of codes to be generated when the ALT-GRAPH key is pressed.") DEADKEYLIST (* \; 
"Block of dead-key handlers, with the nominal up-transition fields filled by the shifted-case tables.  Each \"table\" is an ALIST of orignal code => accented code.  no entry means punt the accent.."
)) FLAGS _ (\\ALLOCBLOCK (FOLDHI (IPLUS \\NKEYS \\NKEYS) BYTESPERCELL)) CODES _ (\\ALLOCBLOCK (FOLDHI 
(PLUS \\NKEYS \\NKEYS) WORDSPERCELL)) SHIFTCODES _ (\\ALLOCBLOCK (FOLDHI (PLUS \\NKEYS \\NKEYS) 
WORDSPERCELL)) ARMED _ (\\ALLOCBLOCK (FOLDHI (ADD1 \\MAXTHINCHAR) BITSPERCELL)) ALTGRAPHCODES _ (
\\ALLOCBLOCK (FOLDHI (PLUS \\NKEYS \\NKEYS) WORDSPERCELL)) DEADKEYLIST _ (\\ALLOCBLOCK (PLUS \\NKEYS 
\\NKEYS \\NKEYS \\NKEYS) T) (CREATE (\\ALLOCBLOCK 7 PTRBLOCK.GCT)) (TYPE? (AND (\\BLOCKDATAP DATUM) (
IGEQ (\\#BLOCKDATACELLS DATUM) 5) (OR (NULL (FETCH (KEYACTION INTERRUPTLIST) OF DATUM)) (LISTP (FETCH 
INTERRUPTLIST OF DATUM))) (\\BLOCKDATAP (FETCH (KEYACTION FLAGS) DATUM)) (\\BLOCKDATAP (FETCH (
KEYACTION CODES) DATUM)) (\\BLOCKDATAP (FETCH (KEYACTION ARMED) DATUM)))))
(RPAQQ \\NKEYS 112)
(CONSTANTS \\NKEYS)
(DEFOPTIMIZER KEYDOWNP (KEYNAME) (BQUOTE (\\NEWKEYDOWNP (\\KEYNAMETONUMBER (\\\, KEYNAME)))))
(PUTPROPS XKEYDOWNP MACRO ((KEYNAME) (KEYDOWNP1 (\\KEYNAMETONUMBER KEYNAME))))
(PUTPROPS KEYDOWNP1 MACRO (OPENLAMBDA (KEYNUMBER) (DECLARE (GLOBALVARS \\EM.KBDAD0 \\EM.KBDAD1 
\\EM.KBDAD2 \\EM.KBDAD3 \\EM.UTILIN \\EM.KBDAD4 \\EM.KBDAD5)) (PROG NIL (RETURN (EQ 0 (LOGAND (LRSH (
LLSH 1 15) (PROGN (* (IMOD KEYNUMBER BITSPERWORD) - GETD |cause| IMOD |and| BITSPERWORD |not| 
|exported| |to| |user|) (LOGAND KEYNUMBER 15))) (\\GETBASE (SELECTQ (PROGN (* (FOLDLO KEYNUMBER 
BITSPERWORD) GETD |follows| |since| FOLDLO |and| BITSPERWORD |not| |exported| |to| |user|) (LRSH 
KEYNUMBER 4)) (0 \\EM.KBDAD0) (1 \\EM.KBDAD1) (2 \\EM.KBDAD2) (3 \\EM.KBDAD3) (4 \\EM.UTILIN) (5 (OR 
\\EM.KBDAD4 (RETURN))) (6 (OR \\EM.KBDAD5 (RETURN))) (RETURN)) 0)))))))
(PUTPROPS \\NEWKEYDOWNP MACRO ((KEYNUMBER) (EQ 0 (\\GETBASEBIT \\LASTKEYSTATE KEYNUMBER))))
(GLOBALVARS \\KEYBOARD.DEVICE \\KEYBOARD.STREAM)
(RPAQQ HARDCURSORHEIGHT 16)
(RPAQQ HARDCURSORWIDTH 16)
(CONSTANTS (HARDCURSORHEIGHT 16) (HARDCURSORWIDTH 16))
(ADDTOVAR GLOBALVARS LASTMOUSEX LASTMOUSEY LASTSCREEN LASTMOUSEBUTTONS LASTMOUSETIME LASTKEYBOARD)
(PUTPROPS \\SETMOUSEXY MACRO ((XPOS YPOS) (PROGN (SELECTC \\MACHINETYPE (\\DAYBREAK (
|\\DoveMisc.SetMousePosition| XPOS YPOS)) (\\MAIKO (SUBRCALL SETMOUSEXY XPOS YPOS)) (\\DANDELION (|do|
 (PROGN (|replace| (IOPAGE NEWMOUSEX) |of| \\IOPAGE |with| XPOS) (|replace| (IOPAGE NEWMOUSEY) |of| 
\\IOPAGE |with| YPOS)) |repeatuntil| (ILESSP (|fetch| (IOPAGE NEWMOUSESTATE) |of| \\IOPAGE) 32768)) (*
 \; "smash position until mouse says it is not busy") (|replace| (IOPAGE NEWMOUSEX) |of| \\IOPAGE 
|with| XPOS) (|replace| (IOPAGE NEWMOUSEY) |of| \\IOPAGE |with| YPOS) (|replace| (IOPAGE NEWMOUSESTATE
) |of| \\IOPAGE |with| 32768)) NIL) (PROGN (\\PUTBASE \\EM.MOUSEX 0 XPOS) (\\PUTBASE \\EM.MOUSEY 0 
YPOS)))))
(GLOBALVARS \\EM.MOUSEX \\EM.MOUSEY \\EM.CURSORX \\EM.CURSORY \\EM.UTILIN \\EM.REALUTILIN \\EM.KBDAD0 
\\EM.KBDAD1 \\EM.KBDAD2 \\EM.KBDAD3 \\EM.KBDAD4 \\EM.KBDAD5 \\EM.DISPINTERRUPT \\EM.DISPLAYHEAD 
\\EM.CURSORBITMAP \\MACHINETYPE \\DEFAULTKEYACTION \\COMMANDKEYACTION \\CURRENTKEYACTION 
\\PERIODIC.INTERRUPT \\PERIODIC.INTERRUPT.FREQUENCY)
(PUTPROP (QUOTE LLKEY) (QUOTE IMPORTDATE) (IDATE "13-Feb-2021 23:24:49"))

(DATATYPE PILOTBBT ((PBTDESTLO WORD) (PBTDESTHI WORD) (PBTDESTBIT WORD) (PBTDESTBPL SIGNEDWORD) (
PBTSOURCELO WORD) (PBTSOURCEHI WORD) (PBTSOURCEBIT WORD) (PBTSOURCEBPL SIGNEDWORD) (PBTWIDTH WORD) (
PBTHEIGHT WORD) (PBTFLAGS WORD) (NIL 5 WORD)) (BLOCKRECORD PILOTBBT ((NIL 7 WORD) (NIL BITS 4) (
PBTGRAYOFFSET BITS 4) (PBTGRAYWIDTHLESSONE BITS 4) (PBTGRAYHEIGHTLESSONE BITS 4) (NIL 2 WORD) (
PBTBACKWARD FLAG) (PBTDISJOINT FLAG) (PBTDISJOINTITEMS FLAG) (PBTUSEGRAY FLAG) (PBTSOURCETYPE BITS 1) 
(PBTOPERATION BITS 2) (NIL BITS 9))) (ACCESSFNS PILOTBBT ((PBTSOURCE (\\VAG2 (|fetch| PBTSOURCEHI |of|
 DATUM) (|fetch| PBTSOURCELO |of| DATUM)) (PROGN (|replace| PBTSOURCEHI |of| DATUM |with| (\\HILOC 
NEWVALUE)) (|replace| PBTSOURCELO |of| DATUM |with| (\\LOLOC NEWVALUE)))) (PBTDEST (\\VAG2 (|fetch| 
PBTDESTHI |of| DATUM) (|fetch| PBTDESTLO |of| DATUM)) (PROGN (|replace| PBTDESTHI |of| DATUM |with| (
\\HILOC NEWVALUE)) (|replace| PBTDESTLO |of| DATUM |with| (\\LOLOC NEWVALUE)))))) (SYSTEM))
(DATATYPE \\DISPLAYDATA (DDXPOSITION DDYPOSITION DDXOFFSET DDYOFFSET |DDDestination| 
|DDClippingRegion| DDFONT |DDSlowPrintingCase| DDWIDTHSCACHE DDOFFSETSCACHE DDCOLOR DDLINEFEED 
|DDRightMargin| |DDLeftMargin| |DDScroll| DDOPERATION DDSOURCETYPE (|DDClippingLeft| WORD) (
|DDClippingRight| WORD) (|DDClippingBottom| WORD) (|DDClippingTop| WORD) (NIL WORD) (DDHELDFLG FLAG) (
XWINDOWHINT XPOINTER) (DDPILOTBBT POINTER) DDXSCALE DDYSCALE DDCHARIMAGEWIDTHS DDEOLFN DDPAGEFULLFN 
|DDTexture| DDMICAXPOS DDMICAYPOS DDMICARIGHTMARGIN DDCHARSET (DDCHARSETASCENT WORD) (DDCHARSETDESCENT
 WORD) DDCHARHEIGHTDELTA (DDSPACEWIDTH WORD)) DDPILOTBBT _ (|create| PILOTBBT PBTDISJOINT _ T) 
|DDLeftMargin| _ 0 |DDRightMargin| _ SCREENWIDTH DDXPOSITION _ 0 DDYPOSITION _ 0 DDXOFFSET _ 0 
DDYOFFSET _ 0 |DDClippingRegion| _ (|create| REGION) |DDDestination| _ |ScreenBitMap| DDXSCALE _ 1 
DDYSCALE _ 1 |DDTexture| _ 0 (ACCESSFNS ((DDFOREGROUNDCOLOR (PROG ((VAL (|fetch| (\\DISPLAYDATA 
DDCOLOR) |of| DATUM))) (OR (FIXP VAL) (BITMAPP VAL) (AND (NULL VAL) 1) (CAR VAL) (MAXIMUMCOLOR (
BITSPERPIXEL (|fetch| (\\DISPLAYDATA |DDDestination|) |of| DATUM)))))) (DDBACKGROUNDCOLOR (OR (|fetch|
 (\\DISPLAYDATA |DDTexture|) |of| DATUM) 0)))) (SYSTEM))
(RECORD DISPLAYSTATE (ONOFF))
(RECORD DISPLAYINFO (DITYPE DIWIDTH DIHEIGHT DIBITSPERPIXEL DIWSOPS))
(PUTPROPS \\GETDISPLAYDATA MACRO (ARGS (COND ((CADR ARGS) (SUBPAIR (QUOTE (STRM STRMVAR)) ARGS (QUOTE 
(\\DTEST (|fetch| (STREAM IMAGEDATA) |of| (SETQ STRMVAR (\\OUTSTREAMARG STRM))) (QUOTE \\DISPLAYDATA))
))) (T (SUBST (CAR ARGS) (QUOTE STRM) (QUOTE (\\DTEST (|fetch| (STREAM IMAGEDATA) |of| (\\OUTSTREAMARG
 STRM)) (QUOTE \\DISPLAYDATA))))))))
(PUTPROPS \\BITMASK MACRO ((N) (\\WORDELT BITMASKARRAY (LOGAND N 15))))
(PUTPROPS \\4BITMASK MACRO ((N) (\\WORDELT 4BITMASKARRAY (LOGAND N 3))))
(PUTPROPS \\NOTBITMASK MACRO ((N) (DECLARE (GLOBALVARS NOTBITMASKARRAY)) (\\WORDELT NOTBITMASKARRAY (
LOGAND N 15))))
(PUTPROPS \\NOT4BITMASK MACRO ((N) (\\WORDELT NOT4BITMASKARRAY (LOGAND N 3))))
(GLOBALVARS BITMASKARRAY NOTBITMASKARRAY 4BITMASKARRAY NOT4BITMASKARRAY)
(RPAQQ WORDMASK 65535)
(CONSTANTS (WORDMASK 65535))
(PUTPROPS \\INVALIDATEDISPLAYCACHE MACRO ((DISPLAYDATA) (* |This| |marks| |the| |character-printing| 
|caches| |of| |the| |displaystream| |as| |invalid.| |Needed| |when| |the| |font| |or| Y |position| 
|changes|) (|freplace| (\\DISPLAYDATA DDCHARSET) |of| DISPLAYDATA |with| MAX.SMALLP) (|freplace| (
\\DISPLAYDATA DDCHARSETASCENT) |of| DISPLAYDATA |with| MAX.SMALLP)))
(PUTPROPS \\DSPGETCHARWIDTH MACRO ((CHARCODE DD) (\\FGETWIDTH (|ffetch| (\\DISPLAYDATA DDWIDTHSCACHE) 
|of| DD) CHARCODE)))
(PUTPROPS \\DSPGETCHARIMAGEWIDTH MACRO ((CHARCODE DD) (\\FGETIMAGEWIDTH (|ffetch| (\\DISPLAYDATA 
DDCHARIMAGEWIDTHS) |of| DD) CHARCODE)))
(PUTPROPS \\DSPGETCHAROFFSET MACRO ((CHARCODE DD) (\\GETBASE (|ffetch| (\\DISPLAYDATA DDOFFSETSCACHE) 
|of| DD) CHARCODE)))
(PUTPROPS \\CONVERTOP MACRO ((OP) (* |rrb| "14-NOV-80 11:14") (* |Only| |for| |alto| |bitblt| !!) (
SELECTQ OP (|replace| 0 |of| NIL |with| NIL) (PAINT 1) (INVERT 2) (ERASE 3) 0)))
(PUTPROPS |\\SFInvert| MACRO ((|BitMap| \y) (* |corrects| |for| |the| |fact| |that| |alto| |bitmaps| 
|are| |stored| |with| 0\,0 |as| |upper| |left| |while| |lisp| |bitmaps| |have| 0\,0 |as| |lower| 
|left.| |The| |correction| |is| |actually| |off| |by| |one| (|greater|) |because| \a |majority| |of| 
|the| |places| |that| |it| |is| |called| |actually| |need| |one| |more| |than| |corrected| Y |value.|)
 (IDIFFERENCE (|fetch| (BITMAP BITMAPHEIGHT) |of| |BitMap|) \y)))
(PUTPROPS |\\SFReplicate| MACRO (LAMBDA (|pattern|) (LOGOR |pattern| (LLSH |pattern| 8) (SETQ 
|pattern| (LLSH |pattern| 4)) (LLSH |pattern| 8))))
(PUTPROPS \\SETPBTFUNCTION MACRO (OPENLAMBDA (BBT |SourceType| |Operation|) (PROGN (|replace| (
PILOTBBT PBTOPERATION) |of| BBT |with| (SELECTQ |Operation| (ERASE 1) (PAINT 2) (INVERT 3) 0)) (
|replace| (PILOTBBT PBTSOURCETYPE) |of| BBT |with| (COND ((EQ (EQ |SourceType| (QUOTE INVERT)) (EQ 
|Operation| (QUOTE ERASE))) 0) (T 1))))))
(PUTPROPS \\BITBLT1 MACRO ((|bbt|) (|BitBltSUBR| |bbt|)))
(PUTPROP (QUOTE BITBLT) (QUOTE MACRO) (QUOTE (= . BKBITBLT)))
(PROGN (PUTPROPS \\INSURETOPWDS DMACRO (OPENLAMBDA (DS) (OR (EQ DS \\TOPWDS) (COND ((FMEMB (
DSPDESTINATION NIL DS) \\SCREENBITMAPS) (\\TOTOPWDS DS)))))) (PUTPROPS \\INSURETOPWDS MACRO ((DS) (* 
|For| |non-window| |implementations|) (PROGN))))
(PUTPROPS .WHILE.TOP.DS. MACRO ((FIRST . REST) (PROG (DISPINTERRUPT SOFTCURSORUP) (* FIRST |should| 
|be| \a |displaystream| |and| \a |variable.| |This| |macro| |may| |also| |take| \a |soft| |cursor| 
|down,| |similar| |to| |the| |way| .WHILE.CURSOR.DOWN. |does,| |but| |only| |if| |FIRST's| 
|destination| |is| |the| |same| |as| |the| |soft| |cursor's| |destination.| *) (COND (\\SOFTCURSORP (
SETQ SOFTCURSORUP (AND \\SOFTCURSORUPP (EQ (DSPDESTINATION NIL FIRST) \\CURSORDESTINATION))) (COND (
SOFTCURSORUP (SETQ DISPINTERRUPT (\\GETBASE \\EM.DISPINTERRUPT 0)) (\\PUTBASE \\EM.DISPINTERRUPT 0 0) 
(\\SOFTCURSORDOWN))))) (\\INSURETOPWDS FIRST) (PROGN . REST) (COND (SOFTCURSORUP (
\\SOFTCURSORUPCURRENT) (\\PUTBASE \\EM.DISPINTERRUPT 0 DISPINTERRUPT))))))
(PUTPROPS .WHILE.CURSOR.DOWN. MACRO ((FIRST . REST) (PROG (DISPINTERRUPT SOFTCURSORUP) (* |This| 
|macro| |should| |wrap| |around| |any| |code| |that| |draws| |or| |bitblts| |directly| |from| |or| 
|to| \a |screen| |bitmap.| E.\g. DRAWGRAYBOX |in| HLDISPLAY |which| |puts| |up| \a |shadow| |box| 
|during| GETREGION. |The| |purpose| |of| |this| |macro| |is| |that| \a |soft| (|e.g.| |color|) 
|cursor's| |bits| |not| |be| |taken| |to| |be| |screen| |bits| |while| FIRST & REST |are| |done.| *) (
COND (\\SOFTCURSORP (SETQ SOFTCURSORUP \\SOFTCURSORUPP) (COND (SOFTCURSORUP (SETQ DISPINTERRUPT (
\\GETBASE \\EM.DISPINTERRUPT 0)) (\\PUTBASE \\EM.DISPINTERRUPT 0 0) (\\SOFTCURSORDOWN))))) (PROGN 
FIRST . REST) (COND (SOFTCURSORUP (\\SOFTCURSORUPCURRENT) (\\PUTBASE \\EM.DISPINTERRUPT 0 
DISPINTERRUPT))))))
(ADDTOVAR GLOBALVARS \\TOPWDS)
(DEFOPTIMIZER TTYDISPLAYSTREAM (&REST X) (COND ((NULL (CAR X)) (QUOTE \\TERM.OFD)) (T (QUOTE 
IGNOREMACRO))))
(GLOBALVARS BELLCNT BELLRATE TTYBACKGROUNDFNS |\\DisplayStoppedForLogout| \\CARET.UP)
(PUTPROPS \\CHECKCARET MACRO ((X) (AND \\CARET.UP (\\CARET.DOWN X))))
(PUTPROPS \\DSPTRANSFORMX MACRO ((X DD) (* |transforms| |an| \x |coordinate| |into| |the| 
|destination| |coordinate.|) (IPLUS X (|fetch| (\\DISPLAYDATA DDXOFFSET) |of| DD))))
(PUTPROPS \\DSPTRANSFORMY MACRO ((Y DD) (* |transforms| |an| \y |coordinate| |into| |the| 
|destination| |coordinate.|) (IPLUS Y (|fetch| (\\DISPLAYDATA DDYOFFSET) |of| DD))))
(PUTPROPS \\OFFSETBOTTOM MACRO ((X) (* |gives| |the| |destination| |coordinate| |address| |of| |the| 
|origin.|) (|fetch| (\\DISPLAYDATA DDYOFFSET) |of| X)))
(PUTPROPS \\OFFSETLEFT MACRO ((DD) (* |returns| |the| \x |origin| |of| |display| |data| |destination| 
|coordinates.|) (|fetch| (\\DISPLAYDATA DDXOFFSET) |of| DD)))
(PUTPROPS DISPLAYINITIALIZEDP MACRO (NIL (* |always| |initialized| |now|) T))
(PUTPROPS DISPLAYSTARTEDP MACRO (NIL |\\DisplayStarted|))
(GLOBALVARS |\\DisplayStarted| |\\DisplayStreamsInitialized| |\\DisplayInitialed| WHOLEDISPLAY 
WHOLESCREEN SCREENWIDTH SCREENHEIGHT)
(PUTPROP (QUOTE LLDISPLAY) (QUOTE IMPORTDATE) (IDATE "18-Apr-1994 00:20:42"))

(RECORD REGION (LEFT BOTTOM WIDTH HEIGHT) LEFT _ -16383 BOTTOM _ -16383 WIDTH _ 32767 HEIGHT _ 32767 (
ACCESSFNS ((TOP (IPLUS (|fetch| (REGION BOTTOM) |of| DATUM) (|fetch| (REGION HEIGHT) |of| DATUM) -1)) 
(PTOP (IPLUS (|fetch| (REGION BOTTOM) |of| DATUM) (|fetch| (REGION HEIGHT) |of| DATUM))) (RIGHT (IPLUS
 (|fetch| (REGION LEFT) |of| DATUM) (|fetch| (REGION WIDTH) |of| DATUM) -1)) (PRIGHT (IPLUS (|fetch| (
REGION LEFT) |of| DATUM) (|fetch| (REGION WIDTH) |of| DATUM))))) (TYPE? (AND (EQLENGTH DATUM 4) (EVERY
 DATUM (FUNCTION NUMBERP)))) (SYSTEM))
(DATATYPE BITMAP ((BITMAPBASE POINTER) (BITMAPRASTERWIDTH WORD) (BITMAPHEIGHT WORD) (BITMAPWIDTH WORD)
 (BITMAPBITSPERPIXEL WORD)) BITMAPBITSPERPIXEL _ 1 (BLOCKRECORD BITMAP ((|BitMapHiLoc| WORD) (
|BitMapLoLoc| WORD)) (* \; "overlay initial pointer")) (SYSTEM))
(BLOCKRECORD BITMAPWORD ((BITS WORD)) (SYSTEM))
(RECORD POSITION (XCOORD . YCOORD) (TYPE? (AND (LISTP DATUM) (NUMBERP (CAR DATUM)) (NUMBERP (CDR DATUM
)))) (SYSTEM))
(DATATYPE CURSOR (CUIMAGE CUMASK CUHOTSPOTX CUHOTSPOTY CUDATA) (ACCESSFNS ((CUBITSPERPIXEL (|fetch| (
BITMAP BITMAPBITSPERPIXEL) |of| (|fetch| (CURSOR CUIMAGE) |of| DATUM))))) (SYSTEM))
(RECORD MOUSEEVENT (MOUSEX MOUSEY MOUSEBUTTONS KEYBOARD MOUSETIME) (SYSTEM))
(RECORD SCREENREGION (SCREEN . REGION) (SUBRECORD REGION) (TYPE? (AND (LISTP DATUM) (|type?| SCREEN (
CAR DATUM)) (|type?| REGION (CDR DATUM)))) (SYSTEM))
(RECORD SCREENPOSITION (SCREEN . POSITION) (SUBRECORD POSITION) (TYPE? (AND (LISTP DATUM) (|type?| 
SCREEN (CAR DATUM)) (|type?| POSITION (CDR DATUM)))) (SYSTEM))
(PUTPROPS CURSORBITMAP MACRO (NIL |CursorBitMap|))
(RPAQQ HARDCURSORHEIGHT 16)
(RPAQQ HARDCURSORWIDTH 16)
(CONSTANTS (HARDCURSORHEIGHT 16) (HARDCURSORWIDTH 16))
(ADDTOVAR GLOBALVARS |CursorBitMap|)
(ARRAYRECORD POLYNOMIAL (A B C D) (CREATE (ARRAY 4 (QUOTE FLOATP))) (SYSTEM))
(RECORD SPLINE (\#KNOTS SPLINEX SPLINEY SPLINEDX SPLINEDY SPLINEDDX SPLINEDDY SPLINEDDDX SPLINEDDDY))
(PUTPROPS HALF MACRO ((X) (LRSH X 1)))
(PUTPROPS \\FILLCIRCLEBLT MACRO (OPENLAMBDA (CX CY X Y) (* \; 
"calls bitblt twice to fill in one line of the circle.") (\\LINEBLT FCBBT (IDIFFERENCE CX X) (IPLUS CY
 Y) (IPLUS CX X) DESTINATIONBASE RASTERWIDTH LEFT RIGHT BOTTOM TOP GRAYWIDTH GRAYHEIGHT GRAYBASE NBITS
) (\\LINEBLT FCBBT (IDIFFERENCE CX X) (IDIFFERENCE CY Y) (IPLUS CX X) DESTINATIONBASE RASTERWIDTH LEFT
 RIGHT BOTTOM TOP GRAYWIDTH GRAYHEIGHT GRAYBASE NBITS)))
(PUTDEF (QUOTE BITMAPS) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO (X (VARS . X))))))
(PUTDEF (QUOTE CURSORS) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO (X (E (MAPC (QUOTE X) (QUOTE 
PRINTCURSOR))))))))
(ADDTOVAR GLOBALVARS SCREENHEIGHT SCREENWIDTH |ScreenBitMap|)
(RPAQQ BLACKSHADE 65535)
(RPAQQ WHITESHADE 0)
(CONSTANTS (BLACKSHADE 65535) (WHITESHADE 0))
(RPAQQ GRAYSHADE 43605)
(ADDTOVAR GLOBALVARS GRAYSHADE)
(RECORD HLS (HUE LIGHTNESS SATURATION))
(RECORD RGB (RED GREEN BLUE))
(PUTPROP (QUOTE ADISPLAY) (QUOTE IMPORTDATE) (IDATE "15-Sep-1994 17:07:04"))

(ADDTOVAR SYSSPECVARS \\INTERRUPTABLE)
(PUTPROPS UNINTERRUPTABLY INFO EVAL)
(PUTPROPS UNINTERRUPTABLY DMACRO ((X . Y) ((LAMBDA (\\INTERRUPTABLE) (PROGN X . Y)) NIL)))
(ADDTOVAR PRETTYPRINTMACROS (UNINTERRUPTABLY LAMBDA (FORM) (PROG ((POS (IPLUS 4 (POSITION)))) (PRIN1 
"(") (PRIN2 (CAR FORM)) (OR (EQ COMMENTFLG (CAAR (SETQ FORM (CDR FORM)))) (TAB POS 0)) (PRINTDEF FORM 
POS T T FNSLST) (PRIN1 ")"))))
(BLOCKRECORD INTERRUPTSTATE ((* |;;| 
"This is the structure used to communicate between the emulator and Lisp re interrupts.  There is a bit per interrupt type, plus space for the character code that caused a keyboard interrupt."
) (* |;;| "This must match the INTSTAT definition in lispemul.h") (* |;;| "PENDING-INTERRUPT FLAGS:") 
(LOGMSGSPENDING FLAG) (* \; " Log/Console msgs need printing.") (ETHERINTERRUPT FLAG) (* \; 
"Ether packet read finished.") (IOINTERRUPT FLAG) (GCDISABLED FLAG) (* \; "No mroe room in GC tables."
) (VMEMFULL FLAG) (* \; "VMEM is full!!") (STACKOVERFLOW FLAG) (* \; "Stack overflowed.") (STORAGEFULL
 FLAG) (* \; "Ran out of storage, atoms, etc.") (WAITINGINTERRUPT FLAG) (* |;;| 
"INTERRUPTS-IN-PROCESS MASK:") (P-LOGMSGSPENDING FLAG) (* \; " Log/Console msgs need printing.") (
P-ETHERINTERRUPT FLAG) (* \; "Ether packet read finished.") (P-IOINTERRUPT FLAG) (P-GCDISABLED FLAG) (
* \; "No mroe room in GC tables.") (P-VMEMFULL FLAG) (* \; "VMEM is full!!") (P-STACKOVERFLOW FLAG) (*
 \; "Stack overflowed.") (P-STORAGEFULL FLAG) (* \; "Ran out of storage, atoms, etc.") (
P-WAITINGINTERRUPT FLAG) (INTCHARCODE WORD)) (BLOCKRECORD INTERRUPTSTATE ((* |;;| 
"Alternative view of the structure:") (PENDING BITS 8) (* \; "Pending-interrupt flags") (IN-PROGRESS 
BITS 8) (* \; "Mask to prevent re-interrupt for an interrupt in progress") (NIL WORD))))
(PUTPROPS \\TAKEINTERRUPT DMACRO ((PREFORM POSTFORM) (DECLARE (GLOBALVARS \\PENDINGINTERRUPT)) (COND (
(AND \\PENDINGINTERRUPT (INTERRUPTABLE~=NILUPTHESTACK)) PREFORM ((LAMBDA (\\INTERRUPTABLE) (
\\CALLINTERRUPTED)) T) POSTFORM))))
(PUTPROP (QUOTE AINTERRUPT) (QUOTE IMPORTDATE) (IDATE "17-Sep-1992 10:42:38"))

(PUTPROPS UNLESSRDSYS MACRO ((NORMAL RDSYS) NORMAL))
(PUTPROPS UNLESSINEW MACRO ((NORMAL I-NEW) NORMAL))
(PUTPROPS 1ST MACRO ((A . B) A))
(PUTPROPS 2ND MACRO ((A B . C) B))
(PUTPROPS LOCAL MACRO ((X) X))
(PUTPROPS ALLOCAL MACRO ((X) X))
(PUTPROPS ADDBASE DMACRO (= . \\ADDBASE))
(PUTPROPS GETBASE DMACRO (= . \\GETBASE))
(PUTPROPS GETBASEBYTE DMACRO (= . \\GETBASEBYTE))
(PUTPROPS GETBASEPTR DMACRO (= . \\GETBASEPTR))
(PUTPROPS HILOC DMACRO (= . \\HILOC))
(PUTPROPS LOLOC DMACRO (= . \\LOLOC))
(PUTPROPS PUTBASE DMACRO (= . \\PUTBASE))
(PUTPROPS PUTBASEBYTE DMACRO (= . \\PUTBASEBYTE))
(PUTPROPS PUTBASEPTR DMACRO (= . \\PUTBASEPTR))
(PUTPROPS REPLACEPTRFIELD DMACRO (= . \\RPLPTR))
(PUTPROPS VAG2 DMACRO (= . \\VAG2))
(PUTPROPS PAGEBASE MACRO ((PTR) (|fetch| (POINTER PAGEBASE) |of| PTR)))
(PUTPROPS PAGELOC MACRO (OPENLAMBDA (PTR) (IPLUS (LLSH (\\HILOC PTR) 8) (LRSH (\\LOLOC PTR) 8))))
(PUTPROP (QUOTE RENAMEMACROS) (QUOTE IMPORTDATE) (IDATE "27-Apr-1994 15:43:27"))

(PUTPROPS MOUSESTATE MACRO (ARGS (LIST (QUOTE PROGN) (QUOTE (GETMOUSESTATE)) (MOUSESTATE-EXPR (CAR 
ARGS) T))))
(PUTPROPS LASTMOUSESTATE MACRO (ARGS (MOUSESTATE-EXPR (CAR ARGS) T)))
(PUTPROPS UNTILMOUSESTATE MACRO (ARGS (COND ((AND (CDR ARGS) (CADR ARGS) (NEQ (CADR ARGS) T)) (* 
|time| |argument| |is| |given| |and| |is| |not| T |or| NIL\; |compile| |in| |time| |keeping| |loop.|) 
(LIST (QUOTE PROG) (LIST (LIST (QUOTE TIMEOUT) (LIST (QUOTE IPLUS) (QUOTE (CLOCK 0)) (LIST (QUOTE OR) 
(LIST (QUOTE NUMBERP) (CADR ARGS)) 100))) (QUOTE (NOWTIME (CLOCK 0)))) (QUOTE LP) (LIST (QUOTE COND) (
LIST (CONS (QUOTE MOUSESTATE) (LIST (CAR ARGS) T)) (QUOTE (RETURN T)))) (QUOTE (COND ((IGREATERP (
CLOCK0 NOWTIME) TIMEOUT) (RETURN NIL)) (T (\\BACKGROUND)))) (QUOTE (GO LP)))) (T (LIST (QUOTE PROG) 
NIL (QUOTE LP) (LIST (QUOTE COND) (LIST (CONS (QUOTE MOUSESTATE) (LIST (CAR ARGS) T)) (QUOTE (RETURN T
)))) (QUOTE (\\BACKGROUND)) (QUOTE (GO LP)))))))
(PUTPROPS KEYSETSTATE MACRO (ARGS (LIST (QUOTE PROGN) (QUOTE (GETMOUSESTATE)) (MOUSESTATE-EXPR (CAR 
ARGS)))))
(PUTPROPS LASTKEYSETSTATE MACRO (ARGS (MOUSESTATE-EXPR (CAR ARGS))))
(PUTPROPS WITHIN MACRO ((A B C) (AND (IGEQ A B) (ILESSP A (IPLUS B C)))))
(ADDTOVAR GLOBALVARS LASTMOUSEX LASTMOUSEY LASTMOUSEBUTTONS)
(PUTPROPS IABS MACRO (OPENLAMBDA (A) (COND ((IGEQ A 0) A) (T (IMINUS A)))))
(PUTPROP (QUOTE HLDISPLAY) (QUOTE IMPORTDATE) (IDATE "15-Mar-1994 10:48:02"))

(PUTPROPS .COPYKEYDOWNP. MACRO (NIL (OR (KEYDOWNP (QUOTE LSHIFT)) (KEYDOWNP (QUOTE RSHIFT)) (KEYDOWNP 
(QUOTE COPY)))))
(PUTPROPS WSOP MACRO (ARGS (LET ((METHOD (CADR (CAR ARGS))) (DISPLAY (CADR ARGS)) (OTHERARGS (CDDR 
ARGS))) (BQUOTE (SPREADAPPLY* (|fetch| (WSOPS (\\\, METHOD)) |of| (|fetch| (FDEV WINDOWOPS) |of| (\\\,
 DISPLAY))) (\\\, DISPLAY) (\\\,@ OTHERARGS))))))
(PUTPROPS \\COERCETODS MACRO (OPENLAMBDA (X) (COND ((|type?| WINDOW X) (|fetch| (WINDOW DSP) |of| X)) 
(T (\\ILLEGAL.ARG X)))))
(PUTPROPS .WHILE.ON.TOP. MACRO ((FIRST . REST) (UNINTERRUPTABLY (\\INTERNALTOTOPW FIRST) . REST)))
(PUTPROPS WINDOWOP DMACRO (ARGS (LET ((OPNAME (CAR ARGS)) (METHOD-DEVICE (CADR ARGS)) (TAIL (CDDR ARGS
))) (COND ((AND (LISTP OPNAME) (EQ (CAR OPNAME) (QUOTE QUOTE))) (BQUOTE (SPREADAPPLY* (|fetch| (SCREEN
 (\\\, (CADR OPNAME))) |of| (\\\, METHOD-DEVICE)) (\\\, METHOD-DEVICE) (\\\,@ TAIL)))) (T (ERROR 
"OPNAME not quoted: " OPNAME))))))
(RPAQQ |MinWindowWidth| 26)
(RPAQQ |MinWindowHeight| 16)
(CONSTANTS (|MinWindowWidth| 26) (|MinWindowHeight| 16))
(DATATYPE WINDOW (DSP (* \; "The display stream you use to actually printto the window.") NEXTW (* \; 
"Next window in the open-window list") SAVE (* \; "Saved image from anything this window's on top of")
 REG (* \; "Screen region this window occupies") BUTTONEVENTFN (* \; 
"FN called when left/middle mouse button goes up/down") RIGHTBUTTONFN (* \; 
"FN called when right mouse button goes up/down") CURSORINFN (* \; 
"Fn called when mouse enters window") CURSOROUTFN (* \; "Called when mouse leaves window") 
CURSORMOVEDFN (* \; "Called when mouse moves in window") REPAINTFN (* \; 
"Redisplay part of thie window") RESHAPEFN (* \; "Called when window is reshaped") EXTENT (* \; 
"Scrolling limits") USERDATA (* \; "Proplist to hold other window properites") VERTSCROLLREG (* \; 
"Region of vert scroll bar") HORIZSCROLLREG (* \; "Tegion of horiz scroll bar") SCROLLFN (* \; 
"Fn to scroll this window") VERTSCROLLWINDOW (* \; "Vert scroll bar") HORIZSCROLLWINDOW (* \; 
"Horiz scroll bar") CLOSEFN (* \; "Called at close time") MOVEFN (* \; "Called when window is moved") 
WTITLE (* \; "Window's title string, if any") NEWREGIONFN (* \; "Called to get new window shape") 
WBORDER (* \; "Window border-width, in pixels") PROCESS (* \; 
"Medley process associated with this window") WINDOWENTRYFN (* \; 
"Fn to call when kbd focus is switched here") SCREEN (* \; "Screen this window appears on") (
NATIVE-HANDLE FIXP) (* \; 
"Uniterpreted place for native window to store a C pointer to its private info") (NATIVE-INFO1 FIXP) (
* \; "Reserved in case the pointer must be 64 bits") (NATIVE-W1 WORD) (* \; 
"Word for use by native handler") (NATIVE-W2 WORD) (* \; "Word for use by native handler") (NATIVE-P1 
POINTER) (* \; "Lisp pointer for use by native handler")) BUTTONEVENTFN _ (FUNCTION TOTOPW) WBORDER _ 
|WBorder| WINDOWENTRYFN _ (FUNCTION GIVE.TTY.PROCESS) (SYSTEM))
(DATATYPE SCREEN (SCONOFF SCDESTINATION SCWIDTH SCHEIGHT SCTOPW SCTOPWDS SCTITLEDS SCFDEV SCDS SCDATA 
(* |;;| "Space for native window manager interface to use.") (HANDLE FIXP) (* \; 
"Handle for emulator to store info about display for C code use.") (HANDLE2 FIXP) (* \; 
"Reserved in case HANDLE needs to be 64 bits on the C side.") (NATIVE-INFO POINTER) (* \; 
"POINTER for the private use of the emulator window code") NATIVETYPE (* \; 
"Symbol to tell what kind of native window system we're using.") (* |;;| 
"- - - Functional interface to screen management - - -") WINIMAGEOPS (* \; 
"IMAGEOPS to be used in display streas on this kind of screen") WINFDEV (* \; 
"FDEV for display streams on this screen") CREATEWFN (* \; "Create a window") OPENWFN (* \; 
"Open a window") CLOSEWFN (* \; "Close a window") MOVEWFN (* \; "Move a window") RELMOVEWFN (* \; 
"Move window, relative") SHRINKWFN (* \; "Shrink window to icon") EXPANDWFN (* \; 
"Expand icon to window") SHAPEWFN (* \; "Reshape a window") REDISPLAYFN (* \; 
"Redisplay (part of) a window") GETWINDOWPROPFN (* \; "Get window property value") PUTWINDOWPROPFN (* 
\; "Set window property value") BURYWFN (* \; "Move window behind all others") TOTOPWFN (* \; 
"Move iwindow in front of all others") IMPORTWFN (* \; 
"Take a native window and save its state internally") EXPORTWFN (* \; 
"Take a saved window state and open it on this screen, filling in screen and methods as needed.") 
DESTROYFN (* \; "Destroy this window, for GC finaliszation") SETCURSORFN (* \; 
"Set the cursor for this window.") PROMPTW (* \; "The prompt window for this screen") SHOWGCFN (* \; 
"Show GC indication; called with ON/OFF arg, t=>show gcing status, NIL=>turn off GC indicator.") 
DSPCREATEFN (* \; "Create a displaystream on this screen.") BBTTOWIN (* \; 
"BITBLT from a lisp bitmap to a window") BBTFROMWIN (* \; "BITBLT from a window to a lisp bitmap") 
BBTWINWIN (* \; "BITBLT from a window to another window.") SCCURSOR (* \; 
"CURSOR that's in effect for this screen by default.") SCKEYBOARD (* \; 
"Something about which keyboard we're receiving from.") SCDEPTH (* \; 
"# of bits per pixel on the screen.  THIS WILL REPLACE SCBITSPERPIXEL ASAP.") SCCLOSEDOWN (* \; 
"Close down this screen cleanly, saving window state.") SCCLOSESCREEN (* \; 
"Close down thie screen cleanly, no state saving.") SCREOPEN (* \; "Reopen this screen?") SCCARETFLASH
 (* \; "Function to flash thecaret.") SCGETSCREENPOSITION (* \; "GETSCREENPOSITION") 
SCGETBOXSCREENPOSITION (* \; "GETBOXPOSITION") SCGETSCREENREGION (* \; "GETREGION") SCMOVEPOINTER (* 
\; "\\CURSORPOSITION")) SCONOFF _ (QUOTE OFF) (ACCESSFNS ((SCBITSPERPIXEL (COND ((|fetch| (SCREEN 
SCDESTINATION) |of| DATUM) (|fetch| (BITMAP BITMAPBITSPERPIXEL) |of| (|fetch| (SCREEN SCDESTINATION) 
|of| DATUM))) (T 1))) (SCREGION (|create| REGION LEFT _ 0 BOTTOM _ 0 WIDTH _ (|fetch| (SCREEN SCWIDTH)
 |of| DATUM) HEIGHT _ (|fetch| (SCREEN SCHEIGHT) |of| DATUM))))) (SYSTEM))
(GLOBALVARS WINDOWUSERFORMS ENDOFWINDOWUSERFORMS PROMPTWINDOW)
(PUTPROP (QUOTE WINDOW) (QUOTE IMPORTDATE) (IDATE " 9-Apr-2000 17:36:29"))

(PUTPROPS NNLITATOM MACRO (OPENLAMBDA (X) (AND X (LITATOM X))))
(PUTPROPS \\NULL.OR.FIXP MACRO (OPENLAMBDA (X) (OR (NULL X) (FIXP X))))
(PUTPROPS \\CHECKTYPE MACRO (X (PROG ((VAR (CAR X)) (PRED (CADR X))) (|if| (AND (LISTP PRED) (MEMB (
CAR PRED) (QUOTE (QUOTE FUNCTION)))) |then| (SETQ PRED (LIST (CADR PRED) VAR))) (RETURN (SUBPAIR (
QUOTE (MSG VAR PRED)) (LIST (CONCAT "
 is not a suitable value for the variable:  " VAR) VAR PRED) (QUOTE (|until| PRED |do| (SETQ VAR (
ERROR VAR MSG)))))))))
(PUTPROPS CANONICAL.TIMERUNITS MACRO (OPENLAMBDA (X) (* |Checks| |for| |common| |abbreviations| 
|before| |calling| |\\CanonicalizeTimerUnits|) (SELECTQ X ((TICKS MILLISECONDS SECONDS) (* |These| 
|are| |the| |canonical| |forms|) X) (NIL (QUOTE MILLISECONDS)) (|\\CanonicalizeTimerUnits| X))))
(PUTPROPS \\MACRO.EVAL DMACRO (Z (PROG ((X (EXPANDMACRO (CAR Z) T))) (|if| (EQ X (CAR Z)) |then| (
ERROR "No macro property -- \\MACRO.EVAL" X) |else| (RETURN (EVAL X))))))
(DEFOPTIMIZER \\MACRO.MX (FORM) FORM)
(PUTPROP (QUOTE MACROAUX) (QUOTE IMPORTDATE) (IDATE "16-May-1990 20:26:31"))

(RPAQQ MASK0WORD1\'S 32767)
(RPAQQ MASK1WORD0\'S 32768)
(RPAQQ MASKWORD1\'S 65535)
(RPAQQ MASKHALFWORD1\'S 255)
(RPAQQ BITSPERHALFWORD 8)
(CONSTANTS MASK0WORD1\'S MASK1WORD0\'S MASKWORD1\'S MASKHALFWORD1\'S BITSPERHALFWORD)
(PUTPROPS EQZEROP MACRO ((X) (EQ 0 X)))
(PUTPROPS \\MOVETOBOX DMACRO (OPENLAMBDA (N D) (SELECTC (NTYPX N) (\\SMALLP (|replace| (FIXP HINUM) 
|of| D |with| 0) (|replace| (FIXP LONUM) |of| D |with| N)) (\\FIXP (|replace| (FIXP HINUM) |of| D 
|with| (|fetch| (FIXP HINUM) |of| N)) (|replace| (FIXP LONUM) |of| D |with| (|fetch| (FIXP LONUM) |of|
 N))) (\\ILLEGAL.ARG N))))
(PUTPROPS .XUNBOX. MACRO ((X HX LX) (|until| (SETQ LX (SELECTC (NTYPX X) (\\SMALLP (COND ((IGEQ X 0) (
SETQ HX 0) X) (T (SETQ HX MASKWORD1\'S) (\\LOLOC X)))) (\\FIXP (SETQ HX (|fetch| (FIXP HINUM) |of| X))
 (|fetch| (FIXP LONUM) |of| X)) NIL)) |do| (SETQ X (LISPERROR "ILLEGAL ARG" X T)))))
(PUTPROPS .XLLSH. MACRO ((HI LO N) (|if| (IGEQ N BITSPERWORD) |then| (* \; 
"Jump 16 bits in a single bound!") (SETQ HI LO) (SETQ LO 0) (SETQ N (IDIFFERENCE N BITSPERWORD))) (
|if| (IGEQ N BITSPERHALFWORD) |then| (* \; "Jump 8 bits in a single bound!") (SETQ HI (LOGOR (
.LOHALFWORDHI. HI) (.HIHALFWORDLO. LO))) (SETQ LO (.LOHALFWORDHI. LO)) (SETQ N (IDIFFERENCE N 
BITSPERHALFWORD))) (|if| (IGEQ N 4) |then| (* \; "Jump 4 bits in a single bound!") (SETQ HI (LOGOR (
LRSH LO (CONSTANT (IDIFFERENCE BITSPERWORD 4))) (LLSH (LOGAND HI (CONSTANT (MASK.1\'S 0 (IDIFFERENCE 
BITSPERWORD 4)))) 4))) (SETQ LO (LLSH (LOGAND LO (CONSTANT (MASK.1\'S 0 (IDIFFERENCE BITSPERWORD 4))))
 4)) (SETQ N (IDIFFERENCE N 4))) (* \; 
"MASK0WORD1'S should be same as (SUB1 (LSH 1 (SUB1 BITSPERWORD)))") (FRPTQ N (SETQ HI (LLSH (LOGAND HI
 MASK0WORD1\'S) 1)) (SETQ LO (LLSH (|if| (IGEQ LO MASK1WORD0\'S) |then| (|add| HI 1) (LOGAND LO 
MASK0WORD1\'S) |else| LO) 1)))))
(PUTPROPS .XLLSH1. MACRO ((HI LO) (SETQ HI (LLSH (LOGAND HI MASK0WORD1\'S) 1)) (SETQ LO (LSH (COND ((
IGEQ LO MASK1WORD0\'S) (SETQ HI (LOGOR HI 1)) (LOGAND LO MASK0WORD1\'S)) (T LO)) 1))))
(PUTPROPS .XLRSH. MACRO ((HI LO N) (|if| (IGEQ N BITSPERWORD) |then| (* \; 
"Jump 10 bits in a single bound!") (SETQ LO HI) (SETQ HI 0) (SETQ N (IDIFFERENCE N BITSPERWORD))) (
|if| (IGEQ N BITSPERHALFWORD) |then| (* \; "Jump 8 bits in a single bound!") (SETQ LO (LOGOR (
.HIHALFWORDLO. LO) (.LOHALFWORDHI. HI))) (SETQ HI (.HIHALFWORDLO. HI)) (SETQ N (IDIFFERENCE N 
BITSPERHALFWORD))) (|if| (IGEQ N 4) |then| (* \; "Jump 4 bits in a single bound!") (SETQ LO (LOGOR (
LLSH (LOGAND HI (CONSTANT (MASK.1\'S 0 4))) (CONSTANT (IDIFFERENCE BITSPERWORD 4))) (LRSH LO 4))) (
SETQ HI (LRSH HI 4)) (SETQ N (IDIFFERENCE N 4))) (* \; "MASK1WORD0'S should be same as \\SIGNBIT") (
FRPTQ N (SETQ LO (|if| (ODDP HI) |then| (LOGOR (LRSH LO 1) MASK1WORD0\'S) |else| (LRSH LO 1))) (SETQ 
HI (LRSH HI 1)))))
(PUTPROPS .ADD.2WORD.INTEGERS. MACRO ((HX LX HY LY) (* \; "Ignores carry out of high-order word") (
SETQ HX (.SUMSMALLMOD. HX HY)) (SETQ LX (.SUMSMALLMOD. LX LY (SETQ HX (|if| (EQ HX MAX.SMALL.INTEGER) 
|then| 0 |else| (ADD1 HX)))))))
(PUTPROPS .SUB.2WORD.INTEGERS. MACRO ((HX LX HY LY) (* \; "Ignores carry out of high-order word") (
SETQ HX (.DIFFERENCESMALLMOD. HX HY)) (SETQ LX (.DIFFERENCESMALLMOD. LX LY (SETQ HX (|if| (EQ HX 0) 
|then| MAX.SMALL.INTEGER |else| (SUB1 HX)))))))
(PUTPROPS .32BITMUL. MACRO ((HR LR X Y) (PROG (HX LX HY LY) (|if| (ILESSP X Y) |then| (|swap| X Y)) (*
 \; "Y is the lesser of the two now") (.XUNBOX. X HX LX) (.XUNBOX. Y HY LY) LP (|if| (ODDP LY) |then| 
(.ADD.2WORD.INTEGERS. HR LR HX LX)) (|if| (EQ HY 0) |then| (SETQ LY (LRSH LY 1)) (|if| (EQ LY 0) 
|then| (RETURN)) |else| (.LRSH1. HY LY)) (* \; 
"Trim off highest bits, so that left-shifting doesn't generate FIXPs") (SETQ HX (LOGAND HX 
MASK0WORD1\'S)) (.LLSH1. HX LX) (GO LP))))
(PUTPROPS .SUMSMALLMOD. MACRO ((X Y OVERFLOWFORM) ((LAMBDA (|\\SumSmallModVar|) (DECLARE (LOCALVARS 
|\\SumSmallModVar|)) (IF (ILEQ X |\\SumSmallModVar|) THEN (IPLUS X Y) ELSE OVERFLOWFORM (IDIFFERENCE X
 (ADD1 |\\SumSmallModVar|)))) (IDIFFERENCE MAX.SMALL.INTEGER Y))))
(PUTPROPS .DIFFERENCESMALLMOD. MACRO ((X Y BORROWFORM) (IF (NOT (IGREATERP Y X)) THEN (IDIFFERENCE X Y
) ELSE BORROWFORM (ADD1 (IDIFFERENCE MAX.SMALL.INTEGER (IDIFFERENCE Y X))))))
(PUTPROPS \\GETBASENIBBLE DMACRO (OPENLAMBDA (BASE OFFST) ((LAMBDA (|\\Byte|) (DECLARE (LOCALVARS 
|\\Byte|)) (|if| (ODDP OFFST) |then| (LOGAND |\\Byte| (CONSTANT (MASK.1\'S 0 BITSPERNIBBLE))) |else| (
LRSH |\\Byte| BITSPERNIBBLE))) (\\GETBASEBYTE BASE (FOLDLO OFFST NIBBLESPERBYTE)))))
(PUTPROPS \\PUTBASENIBBLE DMACRO (OPENLAMBDA (BASE OFFST VAL) ((LAMBDA (|\\ByteNo|) (DECLARE (
LOCALVARS |\\ByteNo|)) ((LAMBDA (|\\Byte|) (DECLARE (LOCALVARS |\\Byte|)) (\\PUTBASEBYTE BASE 
|\\ByteNo| (|if| (ODDP OFFST) |then| (LOGOR (LOGAND |\\Byte| (CONSTANT (MASK.1\'S BITSPERNIBBLE 
BITSPERNIBBLE))) VAL) |else| (LOGOR (LOGAND |\\Byte| (CONSTANT (MASK.1\'S 0 BITSPERNIBBLE))) (LLSH VAL
 BITSPERNIBBLE))))) (\\GETBASEBYTE BASE |\\ByteNo|))) (FOLDLO OFFST NIBBLESPERBYTE))))
(PUTPROPS \\GETBASEBIT DMACRO (OPENLAMBDA (BASE OFFST) ((LAMBDA (|\\ByteNo| |\\BitMask|) (DECLARE (
LOCALVARS |\\ByteNo| |\\BitMask|)) (|if| (EQ 0 (LOGAND |\\BitMask| (\\GETBASEBYTE BASE |\\ByteNo|))) 
|then| 0 |else| 1)) (FOLDLO OFFST BITSPERBYTE) (MASK.1\'S (IDIFFERENCE (CONSTANT (SUB1 BITSPERBYTE)) (
IMOD OFFST BITSPERBYTE)) 1))))
(PUTPROPS \\PUTBASEBIT DMACRO (OPENLAMBDA (BASE OFFST VAL) ((LAMBDA (|\\ByteNo| |\\BitMask| |\\Byte|) 
(DECLARE (LOCALVARS |\\ByteNo| |\\BitMask| |\\Byte|)) (SETQ |\\Byte| (\\GETBASEBYTE BASE |\\ByteNo|)) 
(|if| (|if| (EQ 0 (LOGAND |\\BitMask| |\\Byte|)) |then| (NOT (EQ 0 VAL)) |else| (EQ 0 VAL)) |then| (
\\PUTBASEBYTE BASE |\\ByteNo| (LOGXOR |\\BitMask| |\\Byte|))) VAL) (FOLDLO OFFST BITSPERBYTE) (
MASK.1\'S (IDIFFERENCE (CONSTANT (SUB1 BITSPERBYTE)) (IMOD OFFST BITSPERBYTE)) 1))))
(PUTPROP (QUOTE ADDARITH) (QUOTE IMPORTDATE) (IDATE "16-May-1990 11:46:37"))

(RPAQQ \\MAXFILEPAGE 65534)
(CONSTANTS \\MAXFILEPAGE)
(PUTPROP (QUOTE LLFAULT) (QUOTE IMPORTDATE) (IDATE "21-Mar-2021 21:33:01"))

(PUTPROPS \\UPDATETIMERS MACRO (NIL (* * |Moves| |excess| |time| |from| |the| |processor| |clock| |to|
 |our| |software| |clocks.| |Needs| |to| |be| |run| |often,| |uninterruptably,| |preferably| |from| 
|the| |vertical| |retrace| |interrupt|) (* |Get| |processor| |clock|) (PROG ((EXCESS (\\BOXIDIFFERENCE
 (\\RCLK (LOCF (|fetch| RCLKTEMP0 |of| \\MISCSTATS))) (LOCF (|fetch| BASECLOCK |of| \\MISCSTATS))))) (
RETURN (COND ((OR (IGEQ EXCESS \\RCLKSECOND) (ILESSP EXCESS 0)) (* |More| |than| |one| |second| |has| 
|elapsed| |since| |we| |updated| |clocks|) (\\BOXIPLUS (LOCF (|fetch| BASECLOCK |of| \\MISCSTATS)) 
\\RCLKSECOND) (* |Increment| |base| |by| |one| |second|) (\\BOXIPLUS (LOCF (|fetch| MILLISECONDSCLOCK 
|of| \\MISCSTATS)) 1000) (* |Increment| |clocks| |by| 1 |second|) (\\BOXIPLUS (LOCF (|fetch| 
SECONDSCLOCK |of| \\MISCSTATS)) 1) T))))))
(RPAQQ \\RTCSECONDS 378)
(RPAQQ \\RTCMILLISECONDS 380)
(RPAQQ \\RTCBASE 382)
(RPAQQ \\OFFSET.SECONDS 0)
(RPAQQ \\OFFSET.MILLISECONDS 2)
(RPAQQ \\OFFSET.BASE 4)
(RPAQQ \\ALTO.RCLKSECOND 1680000)
(RPAQQ \\ALTO.RCLKMILLISECOND 1680)
(RPAQQ \\DLION.RCLKMILLISECOND 35)
(RPAQQ \\DLION.RCLKSECOND 34746)
(RPAQQ \\DOVE.RCLKMILLISECOND 63)
(RPAQQ \\DOVE.RCLKSECOND 62500)
(CONSTANTS (\\RTCSECONDS 378) (\\RTCMILLISECONDS 380) (\\RTCBASE 382) (\\OFFSET.SECONDS 0) (
\\OFFSET.MILLISECONDS 2) (\\OFFSET.BASE 4) (\\ALTO.RCLKSECOND 1680000) (\\ALTO.RCLKMILLISECOND 1680) (
\\DLION.RCLKMILLISECOND 35) (\\DLION.RCLKSECOND 34746) (\\DOVE.RCLKMILLISECOND 63) (\\DOVE.RCLKSECOND 
62500))
(PUTPROPS ALTO.TO.LISP.DATE MACRO ((DATE) (LOGXOR DATE -2147483648)))
(PUTPROPS LISP.TO.ALTO.DATE MACRO ((DATE) (LOGXOR DATE -2147483648)))
(PUTPROP (QUOTE LLTIMER) (QUOTE IMPORTDATE) (IDATE "16-May-1990 20:13:11"))

(RECORD BRUSH (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR) BRUSHSHAPE _ (QUOTE ROUND) BRUSHSIZE _ 1)
(PUTPROPS IMAGEOP MACRO (ARGS (CONS (QUOTE SPREADAPPLY*) (CONS (COND ((EQ (CAR (LISTP (CAR ARGS))) (
QUOTE QUOTE)) (LIST (QUOTE |fetch|) (LIST (QUOTE IMAGEOPS) (CADAR ARGS)) (QUOTE |of|) (LIST (QUOTE 
|fetch|) (QUOTE (STREAM IMAGEOPS)) (QUOTE |of|) (CADR ARGS)))) (T (HELP "IMAGEOP - OPNAME not quoted:"
 ARGS))) (CDDR ARGS)))))
(DATATYPE IMAGEOPS (IMAGETYPE IMCLOSEFN IMXPOSITION IMYPOSITION IMFONT IMLEFTMARGIN IMRIGHTMARGIN 
IMLINEFEED IMDRAWLINE IMDRAWCURVE IMDRAWCIRCLE IMDRAWELLIPSE IMFILLCIRCLE IMBLTSHADE IMBITBLT 
IMNEWPAGE IMMOVETO IMSCALE IMTERPRI IMTOPMARGIN IMBOTTOMMARGIN IMSPACEFACTOR IMFONTCREATE IMOPERATION 
IMCOLOR IMSTRINGWIDTH IMCHARWIDTH IMCHARWIDTHY IMBACKCOLOR IMBITMAPSIZE IMCLIPPINGREGION IMRESET 
IMDRAWPOLYGON IMFILLPOLYGON IMSCALEDBITBLT IMWRITEPIXEL IMCHARSET IMROTATE IMDRAWARC IMTRANSLATE 
IMSCALE2 IMPUSHSTATE IMPOPSTATE IMDEFAULTSTATE IMDRAWPOINT IMBLTCHAR IMXOFFSET IMYOFFSET) IMCLOSEFN _ 
(FUNCTION NILL) IMTERPRI _ (FUNCTION (LAMBDA (STREAM) (\\OUTCHAR STREAM (CHARCODE EOL)))) IMNEWPAGE _ 
(FUNCTION (LAMBDA (STREAM) (\\OUTCHAR STREAM (CHARCODE ^L)))) IMOPERATION _ (FUNCTION NILL) IMCOLOR _ 
(FUNCTION NILL) IMCLIPPINGREGION _ (FUNCTION NILL) IMRESET _ (FUNCTION NILL) IMBACKCOLOR _ (FUNCTION 
NILL) IMSTRINGWIDTH _ (FUNCTION (LAMBDA (STREAM STR RDTBL) (STRINGWIDTH STR (DSPFONT NIL STREAM) RDTBL
 RDTBL))) IMCHARWIDTH _ (FUNCTION (LAMBDA (STREAM CHARCODE) (CHARWIDTH CHARCODE (DSPFONT NIL STREAM)))
) IMMOVETO _ (FUNCTION (LAMBDA (STREAM X Y) (IMAGEOP (QUOTE IMXPOSITION) STREAM STREAM X) (IMAGEOP (
QUOTE IMYPOSITION) STREAM STREAM Y))) IMBITMAPSIZE _ (FUNCTION (LAMBDA (STREAM BITMAP DIMENSION) (
SELECTQ DIMENSION (WIDTH (TIMES (DSPSCALE NIL STREAM) (BITMAPWIDTH BITMAP))) (HEIGHT (TIMES (DSPSCALE 
NIL STREAM) (BITMAPHEIGHT BITMAP))) (NIL (CONS (TIMES (DSPSCALE NIL STREAM) (BITMAPWIDTH BITMAP)) (
TIMES (DSPSCALE NIL STREAM) (BITMAPHEIGHT BITMAP)))) (\\ILLEGAL.ARG DIMENSION)))) IMWRITEPIXEL _ (
FUNCTION NILL) IMCHARSET _ (FUNCTION NILL) IMXPOSITION _ (FUNCTION NILL) IMYPOSITION _ (FUNCTION NILL)
 IMFONT _ (FUNCTION NILL) IMLEFTMARGIN _ (FUNCTION NILL) IMRIGHTMARGIN _ (FUNCTION NILL) IMLINEFEED _ 
(FUNCTION NILL) IMDRAWLINE _ (FUNCTION NILL) IMDRAWCURVE _ (FUNCTION NILL) IMDRAWCIRCLE _ (FUNCTION 
NILL) IMDRAWELLIPSE _ (FUNCTION NILL) IMFILLCIRCLE _ (FUNCTION NILL) IMBLTSHADE _ (FUNCTION NILL) 
IMBITBLT _ (FUNCTION NILL) IMSCALE _ (FUNCTION NILL) IMTOPMARGIN _ (FUNCTION NILL) IMBOTTOMMARGIN _ (
FUNCTION NILL) IMSPACEFACTOR _ (FUNCTION NILL) IMFONTCREATE _ (FUNCTION NILL) IMCHARWIDTHY _ (FUNCTION
 NILL) IMDRAWPOLYGON _ (FUNCTION \\DRAWPOLYGON.GENERIC) IMDRAWPOINT _ (FUNCTION \\DRAWPOINT.GENERIC) 
IMFILLPOLYGON _ (FUNCTION NILL) IMSCALEDBITBLT _ (FUNCTION NILL) IMROTATE _ (FUNCTION NILL) IMDRAWARC 
_ (FUNCTION NILL) IMTRANSLATE _ (FUNCTION NILL) IMPUSHSTATE _ (FUNCTION NILL) IMPOPSTATE _ (FUNCTION 
NILL) IMSCALE2 _ (FUNCTION NILL) IMDEFAULTSTATE _ (FUNCTION NILL) IMBLTCHAR _ (FUNCTION \\MEDW.BLTCHAR
) IMXOFFSET _ (FUNCTION \\MEDW.XOFFSET) IMYOFFSET _ (FUNCTION \\MEDW.YOFFSET))
(GLOBALVARS \\NOIMAGEOPS)
(PUTPROP (QUOTE IMAGEIO) (QUOTE IMPORTDATE) (IDATE "28-Jun-1999 16:33:59"))

(DATATYPE PROCESS ((PROCFX0 WORD) (* \; "= \\STACKHI to make this look like a STACKP") (PROCFX WORD) (
* \; "Stack pointer to this context when it is asleep") (PROCSTATUS BYTE) (* \; "Running or waiting") 
(PROCNAME POINTER) (* \; "Name for convenience in type-in reference") (PROCPRIORITY BYTE) (* \; 
"Priority level, 0-4.  Not currently used.") (PROCQUEUE POINTER) (* \; 
"Queue of processes at the same priority") (NIL BYTE) (NEXTPROCHANDLE POINTER) (* \; 
"Pointer to next one") (PROCTIMERSET FLAG) (* \; "True if PROCWAKEUPTIMER has an interesting value") (
PROCBEINGDELETED FLAG) (* \; "True if proc was deleted, but hasn't been removed from \\PROCESSES yet")
 (PROCDELETED FLAG) (PROCSYSTEMP FLAG) (PROCNEVERSTARTED FLAG) (NIL FLAG) (NIL FLAG) (NIL FLAG) (
PROCWAKEUPTIMER POINTER) (* \; "a largep recording the time this proc last went to sleep") (
PROCTIMERLINK POINTER) (* \; "For linking proc in timer queue") (PROCTIMERBOX POINTER) (* \; 
"Scratch box to use for PROCWAKEUPTIMER when user does not give one explicitly") (WAKEREASON POINTER) 
(* \; "Reason process is being run.  From WAKE.PROCESS or timer or event wakeup;  T from simple BLOCK"
) (PROCEVENTORLOCK POINTER) (* \; "EVENT or MONITOR lock that this proc is waiting for") (PROCFORM 
POINTER) (* \; "Form to EVAL to start it going") (RESTARTABLE POINTER) (* \; 
"T = autorestart on error, HARDRESET = restart only on hard reset, NIL = never restart") (PROCWINDOW 
POINTER) (* \; "Window this process lives in, if any") (PROCFINISHED POINTER) (* \; 
"True if proc finished.  Value is indication of how: NORMAL, DELETED, ERROR") (PROCRESULT POINTER) (* 
\; "Value it returned if it finished normally") (PROCFINISHEVENT POINTER) (* \; 
"Optional EVENT to be notified when proc finishes") (PROCMAILBOX POINTER) (* \; "Message queue") (
PROCDRIBBLEOUTPUT POINTER) (* \; "Binding for *DRIBBLE-OUTPUT* in this process") (PROCINFOHOOK POINTER
) (* \; "Optional user fn that displays info about process") (PROCTYPEAHEAD POINTER) (* \; 
"Buffer of typeahead destined for this proc") (PROCREMOTEINFO POINTER) (* \; "For Enterprise") (
PROCUSERDATA POINTER) (* \; "For PROCESSPROP") (PROCEVENTLINK POINTER) (* \; 
"Used to maintain EVENT queues") (PROCAFTEREXIT POINTER) (* \; 
"What to do with this process when coming back from a LOGOUT, etc") (PROCBEFOREEXIT POINTER) (* \; 
"If DON'T, can't logout") (PROCOWNEDLOCKS POINTER) (* \; "Pointer to first lock I currently own") (
PROCEVAPPLYRESULT POINTER) (* \; "For PROCESS.EVAL and PROCESS.APPLY when WAITFORRESULT is true") (
PROCTTYENTRYFN POINTER) (* \; "Is applied to a process when it becomes the tty process") (
PROCTTYEXITFN POINTER) (* \; "Is applied to a process when it ceases to be the tty process") (
PROCHARDRESETINFO POINTER) (* \; "HARDRESET stores info about unwind-protect cleanups here") (
PROCRESTARTFORM POINTER) (* \; "use this instead of PROCFORM when restarting") (PROCOLDTTYPROC POINTER
) (* \; "Process that had the tty when we got it") (NIL POINTER) (* \; "For expansion")) PROCTIMERBOX 
_ (CREATECELL \\FIXP) PROCFX0 _ \\STACKHI)
(PUTPROPS THIS.PROCESS MACRO (NIL \\RUNNING.PROCESS))
(PUTPROPS TTY.PROCESS MACRO (X (COND ((CAR X) (QUOTE IGNOREMACRO)) (T (QUOTE \\TTY.PROCESS)))))
(PUTPROPS TTY.PROCESSP MACRO (X (COND ((CAR X) (QUOTE IGNOREMACRO)) (T (QUOTE (OR (NULL (THIS.PROCESS)
) (EQ (THIS.PROCESS) (TTY.PROCESS))))))))
(GLOBALVARS \\RUNNING.PROCESS \\TTY.PROCESS \\PROC.RESTARTME \\PROC.RESETME \\PROC.ABORTME)
(PUTPROP (QUOTE PROC) (QUOTE IMPORTDATE) (IDATE "17-Jun-1999 21:58:52"))

(PUTPROPS \\BACKCHAR MACRO (OPENLAMBDA (STREAM) (* \; "Backs up over an NS character") (\\BACKNSCHAR 
STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256))))
(PUTPROPS \\BACKNSCHAR MACRO ((ST SHIFTEDCHARSET COUNTERVAR) (COND ((\\XCCSP ST) (\\BACKXCCSCHAR ST 
SHIFTEDCHARSET COUNTERVAR)) (T (COND ((QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR (
CL:FUNCALL (|ffetch| (STREAM BACKCHARFN) |of| ST) ST T)))) (T (CL:FUNCALL (|ffetch| (STREAM BACKCHARFN
) |of| ST) ST NIL)))))))
(PUTPROPS \\CHECKEOLC MACRO (OPENLAMBDA (CH EOLC STREAM PEEKBINFLG COUNTERVAR) (* |;;| 
"Subtracts number of bytes read from COUNTERVAR, which may be NIL.  In fact, should be NIL if PEEKBINFLG is T."
) (SELCHARQ CH (CR (SELECTC EOLC (CR.EOLC (CHARCODE EOL)) (CRLF.EOLC (COND (PEEKBINFLG (* |;;| 
"T from PEEKC, compile-time constant.  In this case, must leave the fileptr where it was, except for possibly advancing over character set shifts"
) (COND ((EQ (CHARCODE LF) (UNINTERRUPTABLY (\\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256)) (* 
|;;| 
"Read the NS CR.  We know that there aren't any font-shift characters in front of the CR, because they would have already been read by the \\NSPEEK that got the CR character.  Since we are going to NS back the CR character, we don't need to update the counter variable"
) (PROG1 (\\PEEKBIN STREAM T) (* |;;| 
"LF must be in next BYTE after NS CR, regardless of coding.  Character-set shifting bytes can't intervene.  Then we back up over the CR that was \\NSINed above."
) (\\BACKNSCHAR STREAM)))) (CHARCODE EOL)) (T (CHARCODE CR)))) ((EQ (CHARCODE LF) (\\PEEKBIN STREAM T)
) (\\BIN STREAM) (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (SUB1 COUNTERVAR))) (CHARCODE EOL)) (T (
CHARCODE CR)))) (CHARCODE CR))) (LF (COND ((EQ EOLC LF.EOLC) (CHARCODE EOL)) (T (CHARCODE LF)))) CH)))
(PUTPROPS \\INCHAR MACRO (OPENLAMBDA (STREAM COUNTERVAR) (* \; "returns a 16 bit character code") (
\\CHECKEOLC (\\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256) NIL COUNTERVAR) (FFETCH EOLCONVENTION 
OF STREAM) STREAM NIL COUNTERVAR)))
(PUTPROPS \\INCCODE MACRO (OPENLAMBDA (STREAM COUNTERVAR) (* \; "returns a 16 bit character code") (
\\CHECKEOLC (\\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256) NIL COUNTERVAR) (|ffetch| 
EOLCONVENTION |of| STREAM) STREAM NIL COUNTERVAR)))
(PUTPROPS \\PEEKCCODE MACRO (OPENLAMBDA (STREAM NOERROR) (\\CHECKEOLC (\\NSPEEK STREAM (UNFOLD (
ACCESS-CHARSET STREAM) 256) NIL NOERROR) (|ffetch| EOLCONVENTION |of| STREAM) STREAM T)))
(PUTPROPS \\NSIN MACRO ((ST SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR) (* |;;;| 
"Dispatches to the appropriate character code decoder.  If you want to support a new character encoding format, you have to write a decoder and add it here."
) (COND ((\\XCCSP ST) (\\XCCSIN ST SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR)) (T (COND ((QUOTE COUNTERVAR
) (CL:MULTIPLE-VALUE-BIND (CODE NUM) (CL:FUNCALL (|ffetch| (STREAM INCCODEFN) |of| ST) ST T) (AND NUM 
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR NUM))) CODE)) (T (CL:FUNCALL (|ffetch| (STREAM INCCODEFN) 
|of| ST) ST NIL)))))))
(PUTPROPS \\NSPEEK MACRO ((ST SHIFTEDCSET SHIFTEDCSETVAR NOERROR COUNTERVAR) (* |;;;| 
"Dispatches to the appropriate character code decoder.  If you want to support a new character encoding format, you have to write a decoder and add it here."
) (COND ((\\XCCSP ST) (\\XCCSPEEK ST (UNFOLD (ACCESS-CHARSET ST) 256) NIL NOERROR)) (T (COND ((QUOTE 
COUNTERVAR) (CL:MULTIPLE-VALUE-BIND (CODE NUM) (CL:FUNCALL (|ffetch| (STREAM PEEKCCODEFN) |of| ST) ST 
NOERROR T) (AND NUM (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR NUM))) CODE)) (T (CL:FUNCALL (|ffetch| (
STREAM PEEKCCODEFN) |of| ST) ST NOERROR NIL)))))))
(PUTPROPS NUMERIC-CHARSET MACRO (= . ACCESS-CHARSET))
(PUTPROPS \\CONV.JIS.TO.XCCS MACRO (OPENLAMBDA (KU TEN) (* |;;;| 
"Some character code is not equivalent between JIS and XCCS.  In such case, we have to convert the character to corresponding XCCS."
) (COND ((\\NOT.EQUIVALENT.TO.XCCS KU) (\\DO.CONV.JIS.TO.XCCS KU TEN)) (T (LOGOR (UNFOLD KU 256) TEN))
)))
(PUTPROPS \\DO.CONV.JIS.TO.XCCS MACRO ((KU TEN) (* |;;;| 
" Convert a JIS code divided into KU (high 8 bit) and TEN (low 8 bit) to an corresponding XCCS code.")
 (COND ((\\INVALID.TENP TEN) *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (SELECTQ KU ((33 34 38) (* \; 
"1, 2 and 6 KU") (LET* ((CONVTABLE (\\EXTARACT.CONV.TABLE KU)) (SET (\\EXTRACT.SET TEN CONVTABLE)) (
CODE (\\EXTRACT.CODE TEN CONVTABLE))) (COND ((NEQ SET 255) (LOGOR (UNFOLD SET 256) CODE)) (T (COND ((
EQ CODE 255) (* \; "Not defined in JIS.") *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (* \; 
"Defined in JIS but the displayable font is not assigned in the corresponding code in XCCS.") (COND (
*REPLACE-NO-FONT-CODE* *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (\\EXTRACT.NO.FONT.CODE (LOGOR (UNFOLD KU 
256) TEN)))))))))) (35 (* \; "3 KU") (* \; 
"Alpha numeric codes are all defined as single byte codes in XCCS.") TEN) (40 (* \; "8 KU") (COND ((< 
0 TEN 33) (COND (*REPLACE-NO-FONT-CODE* *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (\\EXTRACT.NO.FONT.CODE (
LOGOR KU TEN))))) (T *DEFAULT-NOT-CONVERTED-FAT-CODE*))) (116 (* \; "84 KU") (COND ((< 0 TEN 5) (LOGOR
 29952 TEN)) (T *DEFAULT-NOT-CONVERTED-FAT-CODE*))) (117 (* \; "85 KU") (COND ((< 0 TEN 28) (LOGOR 
29696 TEN)) (T *DEFAULT-NOT-CONVERTED-FAT-CODE*))) *DEFAULT-NOT-CONVERTED-FAT-CODE*)))))
(PUTPROPS \\CONV.XCCS.TO.JIS MACRO (OPENLAMBDA (OUTSTREAM CC) (* |;;;| 
"Returns JIS code corresponding to XCCS charcode.  Handle HANKAKU as well as ZENKAKU.  If OUTSTREAM wants to convert ZENKAKUKANA to HANKAKUKANA, do so.  Never returns two byte charcode for alpha-numeric character, they are all treated as single byte characode."
) (OR (COND ((\\ASCIIP CC) CC) ((\\NOT.EQUIVALENT.TO.JIS CC) (\\DO.CONV.XCCS.TO.JIS CC)) ((
\\CONV.HANKAKU.TO.ZENKAKUP OUTSTREAM) (* \; 
"ZENKAKUKANA comes here, because their charcodes are equiavalent to JIS.") (\\CONV.ZENKAKU.KANA CC)) (
T CC)) CC)))
(PUTPROPS \\DO.CONV.XCCS.TO.JIS MACRO ((CC) (GETHASH CC *XCCS-TO-JIS-CONV-TABLE*)))
(PUTPROPS \\ASCIIP MACRO (OPENLAMBDA (CC) (AND (EQ (FOLDLO CC 256) 0) (< (LOGAND CC 255) 128))))
(PUTPROPS \\NOT.EQUIVALENT.TO.JIS MACRO (OPENLAMBDA (CC) (OR (EQ (FOLDLO CC 256) 0) (EQ (FOLDLO CC 256
) 33) (EQ (FOLDLO CC 256) 34) (EQ (FOLDLO CC 256) 38) (EQ (FOLDLO CC 256) 40) (EQ (FOLDLO CC 256) 239)
 (EQ (FOLDLO CC 256) 241))))
(PUTPROPS \\CONV.HANKAKU.TO.ZENKAKUP MACRO ((OUTSTREAM) (STREAMPROP OUTSTREAM :HTOZP)))
(PUTPROPS \\CONV.ZENKAKU.KANA MACRO ((CHAR) (GETHASH CHAR *ZENKAKU-TO-HANKAKU-CONV-TABLE*)))
(PUTPROPS \\XCCSIN MACRO ((STREAM SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR) (* |;;;| 
"returns a 16 bit character code.  SHIFTEDCSET is STREAM's char set left shifted 8, SHIFTEDCSETVAR if non-NIL is the variable to set if char set changes.  COUNTERVAR if non-NIL is decremented by number of bytes read.  Doesn't do EOL conversion -- \\INCHAR and \\INCCODE do that."
) (LET ((CHAR (\\BIN STREAM)) SCSET) (COND ((EQ CHAR NSCHARSETSHIFT) (* \; "Shifting character sets") 
(ACCESS-CHARSET STREAM (SETQ SCSET (COND ((NEQ NSCHARSETSHIFT (SETQ CHAR (\\BIN STREAM))) (AND (QUOTE 
COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2))) CHAR) ((PROGN (* \; 
"2 shift-bytes means not run-encoded") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE 
COUNTERVAR 3))) (EQ 0 (\\BIN STREAM))) \\NORUNCODE) (T (\\NSIN.24BITENCODING.ERROR STREAM))))) (SETQ 
CHAR (\\BIN STREAM)) (SETQ SCSET (COND ((QUOTE SHIFTEDCSETVAR) (* \; "CHARSETVAR=NIL means don't set")
 (SETQ SHIFTEDCSETVAR (UNFOLD SCSET 256))) (T (UNFOLD SCSET 256))))) (T (SETQ SCSET SHIFTEDCSET))) (
COND ((EQ SCSET (UNFOLD \\NORUNCODE 256)) (* \; 
"just read two bytes and combine them to a 16 bit value") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (
IDIFFERENCE COUNTERVAR 2))) (LOGOR (UNFOLD CHAR 256) (\\BIN STREAM))) (CHAR (AND (QUOTE COUNTERVAR) (
SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 1))) (AND CHAR (LOGOR SCSET CHAR)))))))
(PUTPROPS \\XCCSPEEK MACRO ((STREAM SHIFTEDCSET SHIFTEDCSETVAR NOERROR COUNTERVAR) (* |;;| 
"Returns a 16 bit character code.  Doesn't do EOL conversion--\\INCHAR does that.  May actually read the character-set shift, storing the result in the stream.  COUNTERVAR, if given, is updated to reflect any such bytes that are actually read"
) (PROG ((CHAR (\\PEEKBIN STREAM NOERROR)) SCSET) (COND ((NULL CHAR) (RETURN NIL)) ((EQ CHAR 
NSCHARSETSHIFT) (* \; "CHARSETVAR=NIL means don't set") (\\BIN STREAM) (* \; 
"Consume the char shift byte") (ACCESS-CHARSET STREAM (SETQ SCSET (COND ((NEQ NSCHARSETSHIFT (SETQ 
CHAR (\\BIN STREAM))) (* \; 
"Note: no eof error check on this \\BIN -- an eof in the middle of a charset shift is an error") (AND 
(QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2))) CHAR) ((PROGN (* \; 
"2 shift-bytes means not run-encoded") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE 
COUNTERVAR 3))) (EQ 0 (\\BIN STREAM))) \\NORUNCODE) (T (\\NSIN.24BITENCODING.ERROR STREAM))))) (SETQ 
SCSET (COND ((QUOTE SHIFTEDCSETVAR) (* \; "CHARSETVAR=NIL means don't set") (SETQ SHIFTEDCSETVAR (
UNFOLD SCSET 256))) (T (UNFOLD SCSET 256)))) (COND ((NULL (SETQ CHAR (\\PEEKBIN STREAM NOERROR))) (
RETURN NIL)))) (T (SETQ SCSET SHIFTEDCSET))) (RETURN (COND ((EQ SCSET (UNFOLD \\NORUNCODE 256)) (* 
|;;| 
"just peek two bytes and combine them to a 16 bit value.  Again, is an error if we hit eof in mid-character"
) (\\BIN STREAM) (PROG1 (LOGOR (UNFOLD CHAR 256) (\\PEEKBIN STREAM NOERROR)) (\\BACKFILEPTR STREAM))) 
(T (LOGOR SHIFTEDCSET CHAR)))))))
(PUTPROPS \\BACKXCCSCHAR MACRO ((STREAM SHIFTEDCHARSET COUNTERVAR) (AND (\\BACKFILEPTR STREAM) (COND (
(COND (SHIFTEDCHARSET (EQ SHIFTEDCHARSET (UNFOLD \\NORUNCODE 256))) (T (EQ \\NORUNCODE (ACCESS-CHARSET
 STREAM)))) (COND ((\\BACKFILEPTR STREAM) (AND (QUOTE COUNTERVAR) (|add| COUNTERVAR 2)) T) ((QUOTE 
COUNTERVAR) (|add| COUNTERVAR 1)))) ((QUOTE COUNTERVAR) (|add| COUNTERVAR 1))))))
(PUTPROPS \\XCCSP MACRO (OPENLAMBDA (ST) (NOT (|ffetch| (STREAM NOTXCCS) |of| (\\DTEST ST (QUOTE 
STREAM))))))
(PUTPROPS \\EXTRACT.NO.FONT.CODE MACRO ((JISCODE) (CDR (ASSOC JISCODE *JIS-TO-XCCS-CONV-NO-FONT-TABLE*
))))
(PUTPROPS \\EXTARACT.CONV.TABLE MACRO ((KU) (CDR (ASSOC KU *JIS-TO-XCCS-CONV-TABLE-LIST*))))
(PUTPROPS \\NOT.EQUIVALENT.TO.XCCS MACRO ((KU) (* |;;;| 
" The JIS codes which are not equiavelent to XCCS reside in 1, 2, 3, 6, 8 and 84 KU.  Although from 84-5 to 94-94 inclusive are not defined in JIS, that is they are GAIJI, they are also handled here."
) (OR (EQ KU 33) (EQ KU 34) (EQ KU 35) (EQ KU 38) (EQ KU 40) (EQ KU 116) (EQ KU 117))))
(PUTPROPS \\EXTRACT.SET MACRO ((TEN TABLE) (ELT TABLE (IDIFFERENCE (UNFOLD (IDIFFERENCE TEN 32) 2) 1))
))
(PUTPROPS \\EXTRACT.CODE MACRO ((TEN TABLE) (ELT TABLE (UNFOLD (IDIFFERENCE TEN 32) 2))))
(PUTPROPS \\CHNAGE.KI.MODE MACRO (OPENLAMBDA (ST INPUTFLG ENTERP) (* |;;;| 
"INPUTFLG is true if \\CHNAGE.KI.MODE is called in the context in which ST is an input stream.") (COND
 (INPUTFLG (COND (ENTERP (|freplace| (STREAM IN.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| T)) (
T (|freplace| (STREAM IN.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| NIL)))) (T (COND (ENTERP (
|freplace| (STREAM OUT.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| T)) (T (|freplace| (STREAM 
OUT.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| NIL)))))))
(PUTPROPS \\KIMODEP MACRO (OPENLAMBDA (ST INPUTFLG) (* |;;;| 
"INPUTFLG is true if \\KIMODEP is called in the context in which ST is an input stream.") (COND (
INPUTFLG (|ffetch| (STREAM IN.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)))) (T (|ffetch| (STREAM 
OUT.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)))))))
(PUTPROPS \\HANKAKUP MACRO ((CHAR) (< 160 CHAR 224)))
(PUTPROPS \\KANJIP MACRO ((CHAR) (< 12158 CHAR 29733)))
(PUTPROPS \\NOTGAIJIP MACRO ((CHAR) (OR (< 8480 CHAR 10305) (< 12158 CHAR 29733))))
(PUTPROPS \\INVALID.TENP MACRO (OPENLAMBDA (TEN) (OR (< TEN 33) (< 126 TEN))))
(PUTPROPS \\CONV.HANKAKU.KANA MACRO ((CHAR) (GETHASH CHAR *HANKAKU-TO-ZENKAKU-CONV-TABLE*)))
(PUTPROPS \\OUTKI MACRO ((STREAM) (\\BOUT OUTSTREAM (CHARCODE ESC)) (\\BOUT OUTSTREAM (CHARCODE $)) (
\\BOUT OUTSTREAM (CHARCODE B))))
(PUTPROPS \\OUTKO MACRO ((STREAM) (\\BOUT OUTSTREAM (CHARCODE ESC)) (\\BOUT OUTSTREAM (CHARCODE \()) (
\\BOUT OUTSTREAM (CHARCODE J))))
(PUTPROPS \\CONV.SJIS.TO.JIS MACRO (OPENLAMBDA (HI LO) (* |;;;| 
"Convert Shift-JIS to JIS.  The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of JIS code respectively."
) (SETQ CH1 (IDIFFERENCE HI (COND ((> HI 159) 177) (T 113)))) (SETQ CH1 (IPLUS (UNFOLD CH1 2) 1)) (
SETQ CH2 (COND ((> LO 158) (PROG1 (IDIFFERENCE LO 126) (SETQ CH1 (IPLUS CH1 1)))) (T (IDIFFERENCE LO (
COND ((> LO 126) (IPLUS 31 1)) (T 31))))))))
(PUTPROPS \\CONV.JIS.TO.SJIS MACRO (OPENLAMBDA (HI LO) (* |;;;| 
"Convert JIS to Shift-JIS.  The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of Shift-JIS code respectively."
) (SETQ CH2 (COND ((ODDP HI) (SETQ CH2 (IPLUS LO 31)) (COND ((>= CH2 127) (IPLUS CH2 1)) (T CH2))) (T 
(IPLUS LO 126)))) (SETQ CH1 (IPLUS (FOLDLO (IDIFFERENCE HI 33) 2) 129)) (AND (> CH1 159) (SETQ CH1 (
IPLUS CH1 64)))))
(PUTPROPS \\SJIS.KANJI.FIRST.BYTEP MACRO (OPENLAMBDA (CHAR) (OR (< 127 CHAR 160) (< 223 CHAR 256))))
(PUTPROPS \\EUC.KANJI.FIRST.BYTEP MACRO ((CHAR) (< 160 CHAR 255)))
(PUTPROPS \\GAIJIP MACRO ((CHAR) (EQ CHAR 143)))
(PUTPROPS \\EUC.HANKAKUP MACRO ((CHAR) (EQ CHAR 142)))
(PUTPROP (QUOTE LLREAD) (QUOTE IMPORTDATE) (IDATE " 4-Feb-2021 17:06:41"))

(PUTPROPS EMPASSWORDLOC DMACRO (LAMBDA NIL (* |lmm| "24-MAR-83 06:46") (|fetch| (IFPAGE |UserPswdAddr|
) |of| |\\InterfacePage|)))
(PUTPROPS \\DECRYPT.PWD.CHAR MACRO ((CHAR) (LOGXOR CHAR 73)))
(PUTPROP (QUOTE PASSWORDS) (QUOTE IMPORTDATE) (IDATE "16-May-1990 21:02:21"))

(RPAQQ MICASPERINCH 2540)
(RPAQQ MICASPERMILLIMETER 100)
(CONSTANTS (MICASPERINCH 2540) (MICASPERMILLIMETER 100))
(PUTPROP (QUOTE INTERPRESS) (QUOTE IMPORTDATE) (IDATE "16-Apr-2018 21:56:38"))

(RPAQ MICASPERPT (FQUOTIENT 2540 72))
(RPAQQ IHALFMICASPERPT 17)
(RPAQQ IMICASPERPT 35)
(CONSTANTS (MICASPERPT (FQUOTIENT 2540 72)) (IHALFMICASPERPT 17) (IMICASPERPT 35))
(DEFMACRO \\MICASTOPTS (MICAS) (COND ((NUMBERP MICAS) (QUOTIENT MICAS MICASPERPT)) (T (BQUOTE (
QUOTIENT (\\\, MICAS) MICASPERPT)))))
(PUTPROP (QUOTE HARDCOPY) (QUOTE IMPORTDATE) (IDATE "16-Apr-2018 22:15:08"))

(FILESLOAD (SYSLOAD FROM VALUEOF DIRECTORIES) CMLARRAY-SUPPORT)
(PUTPROP (QUOTE CMLARRAY) (QUOTE IMPORTDATE) (IDATE " 6-Jan-1993 12:21:21"))

(RPAQQ \\MISCN-TABLE-LIST ((USER-SUBR 0 \\USER-SUBR-UFN T) (CL:VALUES 1 CL::VALUES-UFN NIL) (CL:SXHASH
 2 CL::SXHASH-UFN NIL) (CL::EQLHASHBITSFN 3 CL::EQLHASHBITSFN-UFN NIL) (STRINGHASHBITS 4 
\\STRINGHASHBITS-UFN NIL) (STRING-EQUAL-HASHBITS 5 \\STRING-EQUAL-HASHBITS-UFN NIL) (CL:VALUES-LIST 6 
CL::VALUES-LIST-UFN NIL) (|LCFetchMethod| 7 |LCFetchMethod| NIL) (|LCFetchMethodOrHelp| 8 NIL NIL) (
|LCFindVarIndex| 9 NIL NIL) (|LCGetIVValue| 10 NIL NIL) (|LCPutIVValue| 11 NIL NIL)))
(RPAQQ \\USER-SUBR-LIST ((DUMMY 10 DUMMY-UFN) (SAMPLE-USER-SUBR 0 SAMPLE-USER-SUBR-UFN)))
(RPAQQ \\INITSUBRS ((BACKGROUNDSUBR 6) (CHECKBCPLPASSWORD 7) (DISKPARTITION 8) (DSPBOUT 9) (DSPRATE 10
) (GATHERSTATS 11) (GETPACKETBUFFER 12) (LISPFINISH 13) (MOREVMEMFILE 14) (RAID 15) (READRAWPBI 16) (
WRITERAWPBI 17) (SETSCREENCOLOR 18) (SHOWDISPLAY 19) (PUPLEVEL1STATE 20) (WRITESTATS 21) (
CONTEXTSWITCH 22) (COPYSYS0SUBR 23) (WRITEMAP 24) (UFS-GETFILENAME 34) (UFS-DELETEFILE 35) (
UFS-RENAMEFILE 36) (COM-READPAGES 37) (COM-WRITEPAGES 38) (COM-TRUNCATEFILE 39) (UFS-DIRECTORYNAMEP 41
) (COM-GETFREEBLOCK 45) (SETUNIXTIME 48) (GETUNIXTIME 49) (COPYTIMESTATS 50) (UNIX-USERNAME 51) (
UNIX-FULLNAME 52) (UNIX-GETENV 53) (UNIX-GETPARM 54) (CHECK-SUM 55) (ETHER-SUSPEND 56) (ETHER-RESUME 
57) (ETHER-AVAILABLE 58) (ETHER-RESET 59) (ETHER-GET 60) (ETHER-SEND 61) (ETHER-SETFILTER 62) (
ETHER-CHECK 63) (DSPCURSOR 64) (SETMOUSEXY 65) (DSP-VIDEOCOLOR 66) (DSP-SCREENWIDTH 67) (
DSP-SCREENHEIGHT 68) (BITBLTSUB 69) (BLTCHAR 70) (TEDIT.BLTCHAR 71) (BITBLT.BITMAP 72) (
BLTSHADE.BITMAP 73) (RS232C-CMD 74) (RS232C-READ-INIT 75) (RS232C-WRITE 76) (KEYBOARDBEEP 80) (
KEYBOARDMAP 81) (KEYBOARDSTATE 82) (VMEMSAVE 89) (LISP-FINISH 90) (NEWPAGE 91) (DORECLAIM 92) (
DUMMY-135Q 93) (NATIVE-MEMORY-REFERENCE 94) (OLD-COMPILE-LOAD-NATIVE 95) (DISABLEGC 96) (
COM-SETFILEINFO 103) (COM-OPENFILE 104) (COM-CLOSEFILE 105) (DSK-GETFILENAME 106) (DSK-DELETEFILE 107)
 (DSK-RENAMEFILE 108) (COM-NEXT-FILE 110) (COM-FINISH-FINFO 111) (COM-GEN-FILES 112) (
DSK-DIRECTORYNAMEP 113) (COM-GETFILEINFO 114) (COM-CHANGEDIR 116) (UNIX-HANDLECOMM 117) (RPC-CALL 119)
 (MESSAGE-READP 120) (MESSAGE-READ 121) (MONITOR-CONTROL 128) (GET-NATIVE-ADDR-FROM-LISP-PTR 131) (
GET-LISP-PTR-FROM-NATIVE-ADDR 132) (LOAD-NATIVE-FILE 133) (SUSPEND-LISP 134) (NEW-BLTCHAR 135) (
COLOR-INIT 136) (COLOR-SCREENMODE 137) (COLOR-MAP 138) (COLOR-BASE 139) (|C-SlowBltChar| 140) (
UNCOLORIZE-BITMAP 141) (COLORIZE-BITMAP 142) (COLOR-8BPPDRAWLINE 143) (TCP-OP 144) (WITH-SYMBOL 145) (
CAUSE-INTERRUPT 146) (OPEN-SOCKET 160) (CLOSE-SOCKET 161) (READ-SOCKET 162) (WRITE-SOCKET 163) (
CALL-C-FUNCTION 167) (DLD-LINK 168) (DLD-UNLINK-BY-FILE 169) (DLD-UNLINK-BY-SYMBOL 170) (
DLD-GET-SYMBOL 171) (DLD-GET-FUNC 172) (DLD-FUNCTION-EXECUTABLE-P 173) (DLD-LIST-UNDEFINED-SYMBOLS 174
) (C-MALLOC 175) (C-FREE 176) (C-PUTBASEBYTE 177) (C-GETBASEBYTE 178) (CHAR-OPENFILE 200) (CHAR-BIN 
201) (CHAR-BOUT 202) (CHAR-IOCTL 203) (CHAR-CLOSEFILE 204) (CHAR-EOFP 205) (CHAR-READP 206) (CHAR-BINS
 207) (CHAR-BOUTS 208) (CHAR-FILLBUFFER 209)))
(PUTPROP (QUOTE LLSUBRS) (QUOTE IMPORTDATE) (IDATE "17-Mar-2021 11:43:34"))

STOP

\ No newline at end of file
diff --git a/loadups/full.dribble b/loadups/full.dribble
index 60105e99..96e25793 100644
--- a/loadups/full.dribble
+++ b/loadups/full.dribble
@@ -1 +1 @@
-
Full loadup started at 12-Mar-2021 12:24:02 while connected to 
{DSK}<home>larry>ilisp>med>

loading POSTSCRIPTSTREAM

{DSK}<home>larry>ilisp>med>library>POSTSCRIPTSTREAM.LCOM;1
compiled on 14-May-2018 10:53:32
File created 14-May-2018 10:52:48
POSTSCRIPTSTREAMCOMS
Loading FULL fonts...
  Loading CLASSIC 8 10 12 
  Loading MODERN 8 10 12 
  Loading TERMINAL 8 10 12 
  Loading postscript fonts
FULL fonts loaded
loading CHAT

{DSK}<home>larry>ilisp>med>library>CHAT.LCOM;1
compiled on 25-Oct-93 12:23:25
File created 20-Jan-93 13:46:52
CHATCOMS

{DSK}<home>larry>ilisp>med>library>DMCHAT.LCOM;1
compiled on 25-Feb-93 18:08:53
File created 20-Jan-93 13:49:09
DMCHATCOMS

{DSK}<home>larry>ilisp>med>library>CHATTERMINAL.LCOM;1
compiled on 24-Feb-93 19:37:23
File created  4-Jul-90 02:21:01
CHATTERMINALCOMS
loading PRESS

{DSK}<home>larry>ilisp>med>library>PRESS.LCOM;1
compiled on  5-Feb-2021 22:18:09
File created  5-Feb-2021 22:18:06
PRESSCOMS
loading INTERPRESS

{DSK}<home>larry>ilisp>med>sources>INTERPRESS.LCOM;6
compiled on 16-Apr-2018 21:56:38
File created 16-Apr-2018 21:56:38
INTERPRESSCOMS
loading TEDIT

{DSK}<home>larry>ilisp>med>library>TEDIT.LCOM;1
compiled on 18-May-2018 09:16:24
File created 19-Apr-2018 12:22:03
TEDITCOMS

{DSK}<home>larry>ilisp>med>library>TEDITDCL.LCOM;1
compiled on 18-May-2018 09:17:04
File created 25-Aug-94 10:53:00
TEDITDCLCOMS

{DSK}<home>larry>ilisp>med>library>PCTREE.LCOM;1
compiled on 18-May-2018 09:19:35
File created 19-Apr-2018 12:19:49
PCTREECOMS

{DSK}<home>larry>ilisp>med>library>TEXTOFD.LCOM;1
compiled on 11-Feb-2001 12:06:43
File created 11-Feb-2001 12:06:42
TEXTOFDCOMS

{DSK}<home>larry>ilisp>med>library>TEDITCOMMAND.LCOM;1
compiled on 18-May-2018 09:16:59
File created 20-Apr-2018 08:07:35
TEDITCOMMANDCOMS

{DSK}<home>larry>ilisp>med>library>TEDITSCREEN.LCOM;1
compiled on 18-May-2018 09:18:38
File created 25-Aug-94 13:26:23
TEDITSCREENCOMS

{DSK}<home>larry>ilisp>med>library>TEDITABBREV.LCOM;1
compiled on  6-Aug-2020 14:52:14
File created  6-Aug-2020 14:52:14
TEDITABBREVCOMS

{DSK}<home>larry>ilisp>med>library>TEDITLOOKS.LCOM;1
compiled on 18-May-2018 09:17:44
File created 29-Jan-99 17:33:35
TEDITLOOKSCOMS

{DSK}<home>larry>ilisp>med>library>TEDITFIND.LCOM;1
compiled on 18-May-2018 09:17:21
File created  6-May-2018 17:34:44
TEDITFINDCOMS

{DSK}<home>larry>ilisp>med>library>TEDITHISTORY.LCOM;1
compiled on 18-May-2018 09:17:41
File created 29-Jan-99 17:34:39
TEDITHISTORYCOMS

{DSK}<home>larry>ilisp>med>library>TEDITFILE.LCOM;1
compiled on 18-May-2018 09:17:06
File created 19-May-2001 11:45:53
TEDITFILECOMS

{DSK}<home>larry>ilisp>med>library>TEDITWINDOW.LCOM;1
compiled on 18-May-2018 09:18:51
File created 21-Jun-99 20:00:42
TEDITWINDOWCOMS

{DSK}<home>larry>ilisp>med>library>TEDITSELECTION.LCOM;1
compiled on 18-May-2018 09:18:43
File created 25-Aug-94 10:56:07
TEDITSELECTIONCOMS

{DSK}<home>larry>ilisp>med>library>IMAGEOBJ.LCOM;1
compiled on  8-Feb-97 11:26:32
File created  7-Dec-95 13:21:56
IMAGEOBJCOMS

{DSK}<home>larry>ilisp>med>library>EDITBITMAP.LCOM;1
compiled on 25-Feb-93 18:10:27
File created 11-Jun-90 15:42:25
EDITBITMAPCOMS

{DSK}<home>larry>ilisp>med>library>READNUMBER.LCOM;1
compiled on 16-Aug-95 11:18:52
File created 25-May-93 00:28:30
READNUMBERCOMS

{DSK}<home>larry>ilisp>med>library>TFBRAVO.LCOM;1
compiled on 19-Apr-2018 12:19:55
File created 19-Apr-2018 12:19:55
TFBRAVOCOMS

{DSK}<home>larry>ilisp>med>library>TEDITHCPY.LCOM;1
compiled on 18-May-2018 09:17:32
File created 25-Aug-94 10:54:07
TEDITHCPYCOMS

{DSK}<home>larry>ilisp>med>library>TEDITPAGE.LCOM;1
compiled on 18-May-2018 09:18:32
File created 25-Aug-94 10:55:28
TEDITPAGECOMS

{DSK}<home>larry>ilisp>med>library>TEDITMENU.LCOM;1
compiled on  4-Jan-2021 13:48:55
File created  4-Jan-2021 13:48:43
TEDITMENUCOMS

{DSK}<home>larry>ilisp>med>library>TEDITFNKEYS.LCOM;1
compiled on 18-May-2018 09:17:25
File created  6-May-2018 17:15:13
TEDITFNKEYSCOMS
loading HRULE

{DSK}<home>larry>ilisp>med>library>HRULE.LCOM;1
compiled on 26-Feb-93 11:26:19
File created  8-Oct-92 16:50:21
HRULECOMS
loading TEDITCHAT

{DSK}<home>larry>ilisp>med>library>TEDITCHAT.LCOM;1
compiled on 18-May-2018 09:16:55
File created 28-Mar-94 16:05:24
IL:TEDITCHATCOMS
loading READNUMBER
loading EDITBITMAP
loading FILEBROWSER

{DSK}<home>larry>ilisp>med>library>FILEBROWSER.LCOM;1
compiled on 27-Feb-2021 20:08:26
File created 27-Feb-2021 20:08:26

{DSK}<home>larry>ilisp>med>library>TABLEBROWSER.LCOM;1
compiled on 20-Feb-2021 23:04:42
File created 20-Feb-2021 23:02:39
TABLEBROWSERCOMS
loading THINFILES

{DSK}<home>larry>ilisp>med>lispusers>THINFILES.LCOM;1
compiled on 26-Jun-99 00:47:00
File created  1-May-92 16:49:39
THINFILESCOMS
loading GRAPHER

{DSK}<home>larry>ilisp>med>library>GRAPHER.LCOM;1
compiled on 14-May-2018 10:24:43
File created 14-May-2018 10:24:38
GRAPHERCOMS
loading SPY

{DSK}<home>larry>ilisp>med>library>SPY.LCOM;1
compiled on 23-Aug-94 16:33:38
File created 29-Apr-94 14:13:52
SPYCOMS
loading WHERE-IS

{DSK}<home>larry>ilisp>med>library>WHERE-IS.DFASL;1
XCL Compiler output for source file {DSK}<python>lde>lispcore>library>WHERE-IS.;1
Source file created Wednesday, 13 June 1990, 1:16:15.
FASL file created Thursday, 21 January 1993, 18:52:55.


{DSK}<home>larry>ilisp>med>library>HASH-FILE.dfasl;1
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>HASH-FILE.;2
Source file created Monday, 11 June 1990, 16:16:54.
FASL file created Friday, 26 February 1993, 11:23:40.


{DSK}<home>larry>ilisp>med>library>CASH-FILE.DFASL;5
XCL Compiler output for source file {DSK}<usr>local>lde>lispcore>library>CASH-FILE.;2
Source file created 11-Jun-90 14:33:44
FASL file created Saturday, 19 September 2020, 22:04:31

loading COPYFILES

{DSK}<home>larry>ilisp>med>library>COPYFILES.LCOM;1
compiled on  6-Apr-2018 21:14:29
File created  6-Apr-2018 21:14:29
COPYFILESCOMS
loading MSANALYZE

{DSK}<home>larry>ilisp>med>library>MSANALYZE.DFASL;1
XCL Compiler output for source file {DSK}<home>larry>ilisp>medley>library>MSANALYZE.;2
Source file created  3-Mar-2021 10:31:16
FASL file created Wednesday, 3 March 2021, 10:31:16

loading MSPARSE

{DSK}<home>larry>ilisp>med>library>MSPARSE.DFASL;1
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSPARSE.;5
Source file created Wednesday, 15 August 1990, 13:00:12.
FASL file created Sunday, 28 February 1993, 23:24:50.

loading MASTERSCOPE

{DSK}<home>larry>ilisp>med>library>MASTERSCOPE.DFASL;4
XCL Compiler output for source file {DSK}<home>larry>ilisp>medley>library>MASTERSCOPE.;6
Source file created  7-Mar-2021 19:39:11
FASL file created Sunday, 7 March 2021, 20:20:40


{DSK}<home>larry>ilisp>med>library>MSCOMMON.DFASL;1
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSCOMMON.;3
Source file created Monday, 4 May 1992, 13:19:40.
FASL file created Sunday, 28 February 1993, 23:23:14.

loading UNIXPRINT

{DSK}<home>larry>ilisp>med>library>UNIXPRINT.DFASL;1
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXPRINT.;8
Source file created Friday, 4 May 2018, 17:18:00.
FASL file created Friday, 4 May 2018, 17:18:00.


{DSK}<home>larry>ilisp>med>library>UNIXCOMM.LCOM;1
compiled on 25-Apr-2018 07:31:56
File created 25-Apr-2018 07:31:56
UNIXCOMMCOMS
loading UNICODE

{DSK}<home>larry>ilisp>med>library>UNICODE.LCOM;18
compiled on  1-Feb-2021 18:00:30
File created  1-Feb-2021 18:00:30
UNICODECOMS
loading ISO8859IO

{DSK}<home>larry>ilisp>med>lispusers>ISO8859IO.LCOM;1
compiled on  9-Mar-99 18:20:33
File created  9-Mar-99 18:20:26
ISO8859IOCOMS
loading HELPSYS

{DSK}<home>larry>ilisp>med>lispusers>HELPSYS.LCOM;1
compiled on 27-Nov-2020 11:23:11
File created 27-Nov-2020 09:47:44
HELPSYSCOMS

{DSK}<home>larry>ilisp>med>lispusers>DINFO.LCOM;1
compiled on 14-Feb-2021 23:11:53
File created 14-Feb-2021 23:11:36
DINFOCOMS

{DSK}<home>larry>ilisp>med>library>HASH.LCOM;1
compiled on 26-Feb-93 11:22:10
File created 11-Jun-90 16:23:11
HASHCOMS

Reading IRM graph...OK.loading DINFO
loading CLIPBOARD

{DSK}<home>larry>ilisp>med>library>CLIPBOARD.LCOM;1
compiled on 23-Feb-2021 22:13:09
File created 23-Feb-2021 22:13:09
CLIPBOARDCOMS
loading MODERNIZE

{DSK}<home>larry>ilisp>med>lispusers>MODERNIZE.LCOM;1
compiled on 27-Feb-2021 18:14:36
File created 27-Feb-2021 18:14:36
MODERNIZECOMS
loading PRETTYFILEINDEX

{DSK}<home>larry>ilisp>med>lispusers>PRETTYFILEINDEX.LCOM;2
compiled on 28-Jun-99 17:13:58
File created 28-Jun-99 17:13:51
PRETTYFILEINDEXCOMS
loading WHO-LINE

{DSK}<home>larry>ilisp>med>lispusers>WHO-LINE.LCOM;1
compiled on 19-Feb-2001 11:57:34
File created 19-Feb-2001 11:53:32
WHO-LINECOMS
loading UNIXCOMM
loading UNIXCHAT

{DSK}<home>larry>ilisp>med>library>UNIXCHAT.LCOM;1
compiled on 21-Jan-93 18:45:15
File created 15-Aug-90 11:05:53
UNIXCHATCOMS
{DSK}<home>larry>ilisp>med>sources>LOADUP-FULL.LCOM;11 closed
\ No newline at end of file
+
Full loadup started at 21-Mar-2021 21:59:49 while connected to 
{DSK}<home>larry>ilisp>medley>

loading POSTSCRIPTSTREAM

{DSK}<home>larry>ilisp>medley>library>POSTSCRIPTSTREAM.LCOM;1
compiled on 14-May-2018 10:53:32
File created 14-May-2018 10:52:48
POSTSCRIPTSTREAMCOMS
Loading FULL fonts...
  Loading CLASSIC 8 10 12 
  Loading MODERN 8 10 12 
  Loading TERMINAL 8 10 12 
  Loading postscript fonts
FULL fonts loaded
loading CHAT

{DSK}<home>larry>ilisp>medley>library>CHAT.LCOM;1
compiled on 25-Oct-93 12:23:25
File created 20-Jan-93 13:46:52
CHATCOMS

{DSK}<home>larry>ilisp>medley>library>DMCHAT.LCOM;1
compiled on 25-Feb-93 18:08:53
File created 20-Jan-93 13:49:09
DMCHATCOMS

{DSK}<home>larry>ilisp>medley>library>CHATTERMINAL.LCOM;1
compiled on 24-Feb-93 19:37:23
File created  4-Jul-90 02:21:01
CHATTERMINALCOMS
loading PRESS

{DSK}<home>larry>ilisp>medley>library>PRESS.LCOM;1
compiled on  5-Feb-2021 22:18:09
File created  5-Feb-2021 22:18:06
PRESSCOMS
loading INTERPRESS

{DSK}<home>larry>ilisp>medley>sources>INTERPRESS.LCOM;6
compiled on 16-Apr-2018 21:56:38
File created 16-Apr-2018 21:56:38
INTERPRESSCOMS
loading TEDIT

{DSK}<home>larry>ilisp>medley>library>TEDIT.LCOM;1
compiled on 18-May-2018 09:16:24
File created 19-Apr-2018 12:22:03
TEDITCOMS

{DSK}<home>larry>ilisp>medley>library>TEDITDCL.LCOM;1
compiled on 18-May-2018 09:17:04
File created 25-Aug-94 10:53:00
TEDITDCLCOMS

{DSK}<home>larry>ilisp>medley>library>PCTREE.LCOM;1
compiled on 18-May-2018 09:19:35
File created 19-Apr-2018 12:19:49
PCTREECOMS

{DSK}<home>larry>ilisp>medley>library>TEXTOFD.LCOM;1
compiled on 11-Feb-2001 12:06:43
File created 11-Feb-2001 12:06:42
TEXTOFDCOMS

{DSK}<home>larry>ilisp>medley>library>TEDITCOMMAND.LCOM;1
compiled on 18-May-2018 09:16:59
File created 20-Apr-2018 08:07:35
TEDITCOMMANDCOMS

{DSK}<home>larry>ilisp>medley>library>TEDITSCREEN.LCOM;1
compiled on 18-May-2018 09:18:38
File created 25-Aug-94 13:26:23
TEDITSCREENCOMS

{DSK}<home>larry>ilisp>medley>library>TEDITABBREV.LCOM;1
compiled on  6-Aug-2020 14:52:14
File created  6-Aug-2020 14:52:14
TEDITABBREVCOMS

{DSK}<home>larry>ilisp>medley>library>TEDITLOOKS.LCOM;1
compiled on 18-May-2018 09:17:44
File created 29-Jan-99 17:33:35
TEDITLOOKSCOMS

{DSK}<home>larry>ilisp>medley>library>TEDITFIND.LCOM;1
compiled on 18-May-2018 09:17:21
File created  6-May-2018 17:34:44
TEDITFINDCOMS

{DSK}<home>larry>ilisp>medley>library>TEDITHISTORY.LCOM;1
compiled on 18-May-2018 09:17:41
File created 29-Jan-99 17:34:39
TEDITHISTORYCOMS

{DSK}<home>larry>ilisp>medley>library>TEDITFILE.LCOM;1
compiled on 18-May-2018 09:17:06
File created 19-May-2001 11:45:53
TEDITFILECOMS

{DSK}<home>larry>ilisp>medley>library>TEDITWINDOW.LCOM;1
compiled on 18-May-2018 09:18:51
File created 21-Jun-99 20:00:42
TEDITWINDOWCOMS

{DSK}<home>larry>ilisp>medley>library>TEDITSELECTION.LCOM;1
compiled on 18-May-2018 09:18:43
File created 25-Aug-94 10:56:07
TEDITSELECTIONCOMS

{DSK}<home>larry>ilisp>medley>library>IMAGEOBJ.LCOM;1
compiled on  8-Feb-97 11:26:32
File created  7-Dec-95 13:21:56
IMAGEOBJCOMS

{DSK}<home>larry>ilisp>medley>library>EDITBITMAP.LCOM;1
compiled on 25-Feb-93 18:10:27
File created 11-Jun-90 15:42:25
EDITBITMAPCOMS

{DSK}<home>larry>ilisp>medley>library>READNUMBER.LCOM;1
compiled on 16-Aug-95 11:18:52
File created 25-May-93 00:28:30
READNUMBERCOMS

{DSK}<home>larry>ilisp>medley>library>TFBRAVO.LCOM;1
compiled on 19-Apr-2018 12:19:55
File created 19-Apr-2018 12:19:55
TFBRAVOCOMS

{DSK}<home>larry>ilisp>medley>library>TEDITHCPY.LCOM;1
compiled on 18-May-2018 09:17:32
File created 25-Aug-94 10:54:07
TEDITHCPYCOMS

{DSK}<home>larry>ilisp>medley>library>TEDITPAGE.LCOM;1
compiled on 18-May-2018 09:18:32
File created 25-Aug-94 10:55:28
TEDITPAGECOMS

{DSK}<home>larry>ilisp>medley>library>TEDITMENU.LCOM;1
compiled on  4-Jan-2021 13:48:55
File created  4-Jan-2021 13:48:43
TEDITMENUCOMS

{DSK}<home>larry>ilisp>medley>library>TEDITFNKEYS.LCOM;1
compiled on 18-May-2018 09:17:25
File created  6-May-2018 17:15:13
TEDITFNKEYSCOMS
loading HRULE

{DSK}<home>larry>ilisp>medley>library>HRULE.LCOM;1
compiled on 26-Feb-93 11:26:19
File created  8-Oct-92 16:50:21
HRULECOMS
loading TEDITCHAT

{DSK}<home>larry>ilisp>medley>library>TEDITCHAT.LCOM;1
compiled on 18-May-2018 09:16:55
File created 28-Mar-94 16:05:24
IL:TEDITCHATCOMS
loading READNUMBER
loading EDITBITMAP
loading FILEBROWSER

{DSK}<home>larry>ilisp>medley>library>FILEBROWSER.LCOM;1
compiled on 27-Feb-2021 20:08:26
File created 27-Feb-2021 20:08:26

{DSK}<home>larry>ilisp>medley>library>TABLEBROWSER.LCOM;1
compiled on 20-Feb-2021 23:04:42
File created 20-Feb-2021 23:02:39
TABLEBROWSERCOMS
loading THINFILES

{DSK}<home>larry>ilisp>medley>lispusers>THINFILES.LCOM;1
compiled on 26-Jun-99 00:47:00
File created  1-May-92 16:49:39
THINFILESCOMS
loading GRAPHER

{DSK}<home>larry>ilisp>medley>library>GRAPHER.LCOM;1
compiled on 14-Mar-2021 20:40:31
File created 14-Mar-2021 20:40:30
GRAPHERCOMS
loading SPY

{DSK}<home>larry>ilisp>medley>library>SPY.LCOM;1
compiled on 23-Aug-94 16:33:38
File created 29-Apr-94 14:13:52
SPYCOMS
loading WHERE-IS

{DSK}<home>larry>ilisp>medley>library>WHERE-IS.DFASL;4
XCL Compiler output for source file {DSK}<python>lde>lispcore>library>WHERE-IS.;1
Source file created Wednesday, 13 June 1990, 1:16:15.
FASL file created Thursday, 21 January 1993, 18:52:55.


{DSK}<home>larry>ilisp>medley>library>HASH-FILE.dfasl;1
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>HASH-FILE.;2
Source file created Monday, 11 June 1990, 16:16:54.
FASL file created Friday, 26 February 1993, 11:23:40.


{DSK}<home>larry>ilisp>medley>library>CASH-FILE.DFASL;5
XCL Compiler output for source file {DSK}<usr>local>lde>lispcore>library>CASH-FILE.;2
Source file created 11-Jun-90 14:33:44
FASL file created Saturday, 19 September 2020, 22:04:31

loading COPYFILES

{DSK}<home>larry>ilisp>medley>library>COPYFILES.LCOM;1
compiled on  6-Apr-2018 21:14:29
File created  6-Apr-2018 21:14:29
COPYFILESCOMS
loading MSANALYZE

{DSK}<home>larry>ilisp>medley>library>MSANALYZE.DFASL;1
XCL Compiler output for source file {DSK}<home>larry>ilisp>medley>library>MSANALYZE.;2
Source file created  3-Mar-2021 10:31:16
FASL file created Wednesday, 3 March 2021, 10:31:16

loading MSPARSE

{DSK}<home>larry>ilisp>medley>library>MSPARSE.DFASL;1
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSPARSE.;5
Source file created Wednesday, 15 August 1990, 13:00:12.
FASL file created Sunday, 28 February 1993, 23:24:50.

loading MASTERSCOPE

{DSK}<home>larry>ilisp>medley>library>MASTERSCOPE.DFASL;4
XCL Compiler output for source file {DSK}<home>larry>ilisp>medley>library>MASTERSCOPE.;6
Source file created  7-Mar-2021 19:39:11
FASL file created Sunday, 7 March 2021, 20:20:40


{DSK}<home>larry>ilisp>medley>library>MSCOMMON.DFASL;1
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSCOMMON.;3
Source file created Monday, 4 May 1992, 13:19:40.
FASL file created Sunday, 28 February 1993, 23:23:14.

loading UNIXPRINT

{DSK}<home>larry>ilisp>medley>library>UNIXPRINT.DFASL;1
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXPRINT.;8
Source file created Friday, 4 May 2018, 17:18:00.
FASL file created Friday, 4 May 2018, 17:18:00.


{DSK}<home>larry>ilisp>medley>library>UNIXCOMM.LCOM;1
compiled on 25-Apr-2018 07:31:56
File created 25-Apr-2018 07:31:56
UNIXCOMMCOMS
loading UNICODE

{DSK}<home>larry>ilisp>medley>library>UNICODE.LCOM;18
compiled on  1-Feb-2021 18:00:30
File created  1-Feb-2021 18:00:30
UNICODECOMS
loading ISO8859IO

{DSK}<home>larry>ilisp>medley>lispusers>ISO8859IO.LCOM;1
compiled on  9-Mar-99 18:20:33
File created  9-Mar-99 18:20:26
ISO8859IOCOMS
loading HELPSYS

{DSK}<home>larry>ilisp>medley>lispusers>HELPSYS.LCOM;1
compiled on 27-Nov-2020 11:23:11
File created 27-Nov-2020 09:47:44
HELPSYSCOMS

{DSK}<home>larry>ilisp>medley>lispusers>DINFO.LCOM;1
compiled on 14-Feb-2021 23:11:53
File created 14-Feb-2021 23:11:36
DINFOCOMS

{DSK}<home>larry>ilisp>medley>library>HASH.LCOM;1
compiled on 26-Feb-93 11:22:10
File created 11-Jun-90 16:23:11
HASHCOMS

Reading IRM graph...OK.loading DINFO
loading CLIPBOARD

{DSK}<home>larry>ilisp>medley>library>CLIPBOARD.LCOM;1
compiled on 23-Feb-2021 22:13:09
File created 23-Feb-2021 22:13:09
CLIPBOARDCOMS
loading MODERNIZE

{DSK}<home>larry>ilisp>medley>lispusers>MODERNIZE.LCOM;1
compiled on 14-Mar-2021 20:33:34
File created 14-Mar-2021 20:33:34
MODERNIZECOMS
loading PRETTYFILEINDEX

{DSK}<home>larry>ilisp>medley>lispusers>PRETTYFILEINDEX.LCOM;2
compiled on 28-Jun-99 17:13:58
File created 28-Jun-99 17:13:51
PRETTYFILEINDEXCOMS
loading WHO-LINE

{DSK}<home>larry>ilisp>medley>lispusers>WHO-LINE.LCOM;1
compiled on 19-Feb-2001 11:57:34
File created 19-Feb-2001 11:53:32
WHO-LINECOMS
loading UNIXCOMM
loading UNIXCHAT

{DSK}<home>larry>ilisp>medley>library>UNIXCHAT.LCOM;1
compiled on 21-Jan-93 18:45:15
File created 15-Aug-90 11:05:53
UNIXCHATCOMS
{DSK}<home>larry>ilisp>medley>sources>LOADUP-FULL.LCOM;11 closed
\ No newline at end of file
diff --git a/loadups/full.sysout b/loadups/full.sysout
index 089683e3..73555568 100644
Binary files a/loadups/full.sysout and b/loadups/full.sysout differ
diff --git a/loadups/lisp.dribble b/loadups/lisp.dribble
index 3c2970ae..c039b6e0 100644
--- a/loadups/lisp.dribble
+++ b/loadups/lisp.dribble
@@ -1 +1 @@
-
{DSK}<home>larry>ilisp>med>sources>LOADUP-LISP.LCOM;1
compiled on  6-Mar-2021 20:47:30
File created  6-Mar-2021 20:47:27
"ENDLOADUP redefined"
LOADUP-LISPCOMS

{DSK}<home>larry>ilisp>med>sources>LISP-PACKAGE.LCOM;1
compiled on 25-Jan-98 15:03:32
File created 16-May-90 18:44:49
IL:LISP-PACKAGECOMS

{DSK}<home>larry>ilisp>med>sources>FASL-PACKAGE.LCOM;1
compiled on 25-Jan-98 13:21:46
File created 16-May-90 16:33:38
IL:FASL-PACKAGECOMS

{DSK}<home>larry>ilisp>med>sources>D-ASSEM-PACKAGE.LCOM;1
compiled on 25-Jan-98 12:20:01
File created  8-Jan-91 00:37:24
IL:D-ASSEM-PACKAGECOMS

{DSK}<home>larry>ilisp>med>sources>COMPILER-PACKAGE.LCOM;1
compiled on 25-Jan-98 11:43:48
File created 16-May-90 15:03:20
IL:COMPILER-PACKAGECOMS

{DSK}<home>larry>ilisp>med>sources>ERROR-RUNTIME.LCOM;1
compiled on 25-Jan-98 13:15:12
File created 16-May-90 16:27:39

{DSK}<home>larry>ilisp>med>sources>CMLARITH.LCOM;1
compiled on 25-Jan-98 09:40:28
File created  4-Jan-93 17:38:48

{DSK}<home>larry>ilisp>med>sources>CONDITION-HIERARCHY.LCOM;1
compiled on 25-Jan-98 11:43:54
File created 22-Aug-90 09:45:58

{DSK}<home>larry>ilisp>med>sources>CONDITION-HIERARCHY-SI.LCOM;1
compiled on 25-Jan-98 11:52:40
File created 16-May-90 15:05:52

{DSK}<home>larry>ilisp>med>sources>CONDITION-HIERARCHY-POST-SI.LCOM;1
compiled on 25-Jan-98 11:52:26
File created 16-May-90 15:05:05

{DSK}<home>larry>ilisp>med>sources>CONDITION-HIERARCHY-IL.LCOM;1
compiled on 25-Jan-98 11:50:25
File created 16-May-90 15:04:10

{DSK}<home>larry>ilisp>med>sources>CMLHASH.LCOM;1
compiled on 25-Jan-98 10:17:44
File created 16-May-90 13:25:03

{DSK}<home>larry>ilisp>med>sources>D-ASSEM.LCOM;1
compiled on 25-Jan-98 12:01:26
File created  1-Dec-92 02:18:56

{DSK}<home>larry>ilisp>med>sources>FASLOAD.LCOM;1
compiled on 31-Jan-98 09:39:23
File created 25-Nov-92 12:35:33

{DSK}<home>larry>ilisp>med>sources>DEFFER-RUNTIME.LCOM;1
compiled on 25-Jan-98 12:24:48
File created 16-May-90 15:30:14

{DSK}<home>larry>ilisp>med>sources>CMLPRINT.LCOM;1
compiled on 25-Jan-98 10:30:50
File created 16-May-90 14:19:58

{DSK}<home>larry>ilisp>med>sources>CLSTREAMS.LCOM;1
compiled on 25-Jan-98 09:36:01
File created  3-Apr-91 15:11:53

{DSK}<home>larry>ilisp>med>sources>CMLSTRING.LCOM;1
compiled on 25-Jan-98 11:21:16
File created 16-May-90 14:45:59

{DSK}<home>larry>ilisp>med>sources>CMLSYMBOL.LCOM;1
compiled on 25-Jan-98 11:30:38
File created 16-May-90 14:47:55

{DSK}<home>larry>ilisp>med>sources>CMLTYPES.LCOM;1
compiled on 25-Jan-98 11:31:44
File created  4-Jan-93 17:55:42

{DSK}<home>larry>ilisp>med>sources>CMLSEQCOMMON.LCOM;1
compiled on 25-Jan-98 10:35:19
File created 16-May-90 14:28:05

{DSK}<home>larry>ilisp>med>sources>CMLSEQMAPPERS.LCOM;1
compiled on 25-Jan-98 10:40:02
File created 16-May-90 14:31:36

{DSK}<home>larry>ilisp>med>sources>CMLPATHNAME.LCOM;1
compiled on 25-Jan-98 10:28:38
File created 28-Sep-90 15:14:19

{DSK}<home>larry>ilisp>med>sources>CMLFILESYS.LCOM;1
compiled on 25-Jan-98 10:07:48
File created  8-Jun-90 16:41:26

{DSK}<home>larry>ilisp>med>sources>CMLDEFFER.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>CMLDEFFER.;1
Source file created Sunday, 3 June 1990, 23:11:46.
FASL file created Wednesday, 28 January 1998, 16:41:48.


{DSK}<home>larry>ilisp>med>sources>ERROR-RUNTIME-AFTER-FASL.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>ERROR-RUNTIME-AFTER-FASL.;1
Source file created Wednesday, 16 May 1990, 16:14:06.
FASL file created Sunday, 25 January 1998, 13:18:10.


{DSK}<home>larry>ilisp>med>sources>WRAPPERS.LCOM;1
compiled on 26-Jan-98 13:55:56
File created  2-Feb-94 14:15:09

{DSK}<home>larry>ilisp>med>sources>STACKFNS.LCOM;1
compiled on 26-Jan-98 13:41:05
File created 17-May-90 15:48:43
STACKFNSCOMS
STACKFNSCOMS

{DSK}<home>larry>ilisp>med>sources>CMLMVS.LCOM;1
compiled on 25-Jan-98 10:25:04
File created 16-May-90 13:35:04

{DSK}<home>larry>ilisp>med>sources>MACROS.LCOM;1
compiled on 25-Jan-98 17:37:48
File created 16-May-90 20:28:24

{DSK}<home>larry>ilisp>med>sources>MACROAUX.LCOM;1
compiled on 25-Jan-98 17:37:05
File created 16-May-90 20:26:31

{DSK}<home>larry>ilisp>med>sources>UNWINDMACROS.LCOM;1
compiled on 26-Jan-98 13:53:42
File created 17-May-90 16:11:33

{DSK}<home>larry>ilisp>med>sources>COMMON.LCOM;1
compiled on 25-Jan-98 11:40:32
File created 16-May-90 14:58:17

{DSK}<home>larry>ilisp>med>sources>XCLC-RUNTIME.LCOM;1
compiled on 26-Jan-98 14:00:44
File created 23-May-90 13:18:14

{DSK}<home>larry>ilisp>med>sources>CL-ERROR.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>CL-ERROR.;1
Source file created Wednesday, 21 August 1991, 17:03:40.
FASL file created Sunday, 25 January 1998, 9:28:09.


{DSK}<home>larry>ilisp>med>sources>AFONT.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>AFONT.;1
Source file created Wednesday, 16 May 1990, 11:47:29.
FASL file created Sunday, 25 January 1998, 8:22:42.


{DSK}<home>larry>ilisp>med>sources>EDIT.LCOM;1
compiled on 25-Jan-98 13:09:41
File created 16-May-90 16:23:16
EDITCOMS

{DSK}<home>larry>ilisp>med>sources>WEDIT.LCOM;1
compiled on 26-Jan-98 13:54:04
File created 23-Oct-91 16:39:18
WEDITCOMS

{DSK}<home>larry>ilisp>med>sources>PRETTY.LCOM;7
compiled on 21-Feb-2021 10:59:08
File created 21-Feb-2021 10:59:08
PRETTYCOMS

{DSK}<home>larry>ilisp>med>sources>DSPRINTDEF.LCOM;1
compiled on 25-Jan-98 12:58:43
File created 19-Jan-93 10:27:05
DSPRINTDEFCOMS

{DSK}<home>larry>ilisp>med>sources>NEWPRINTDEF.LCOM;2
compiled on 31-Dec-2000 11:53:35
File created 31-Dec-2000 11:53:33
NEWPRINTDEFCOMS

{DSK}<home>larry>ilisp>med>sources>FONTPROFILE.LCOM;1
compiled on 14-May-2018 00:04:35
File created 28-Jun-99 22:10:46
FONTPROFILECOMS

{DSK}<home>larry>ilisp>med>sources>SPELLFILE.LCOM;1
compiled on 26-Jan-98 13:37:13
File created 28-Apr-92 15:38:21
SPELLFILECOMS

{DSK}<home>larry>ilisp>med>sources>PRINTFN.LCOM;4
compiled on 16-Apr-2018 21:40:32
File created 16-Apr-2018 21:40:32
PRINTFNCOMS

{DSK}<home>larry>ilisp>med>sources>LOADFNS.LCOM;10
compiled on 16-Apr-2018 17:38:16
File created 16-Apr-2018 17:38:16
LOADFNSCOMS

{DSK}<home>larry>ilisp>med>sources>DIRECTORY.LCOM;1
compiled on 25-Jan-98 12:34:36
File created 30-Apr-92 15:04:56
DIRECTORYCOMS

{DSK}<home>larry>ilisp>med>sources>FILEPKG.LCOM;1
compiled on 12-Feb-2021 17:16:06
File created 12-Feb-2021 17:16:04
FILEPKGCOMS

{DSK}<home>larry>ilisp>med>sources>RESOURCE.LCOM;1
compiled on 26-Jan-98 13:30:19
File created 16-May-90 21:31:50
RESOURCECOMS

{DSK}<home>larry>ilisp>med>sources>MOD44IO.LCOM;1
compiled on 25-Jan-98 17:52:51
File created 21-Jan-91 23:56:42
MOD44IOCOMS

{DSK}<home>larry>ilisp>med>sources>HIST.LCOM;1
compiled on 25-Jan-98 14:10:10
File created 10-Jul-91 12:07:43
HISTCOMS

{DSK}<home>larry>ilisp>med>sources>UNDO.LCOM;1
compiled on 26-Jan-98 13:53:32
File created 17-May-90 16:09:40
UNDOCOMS

{DSK}<home>larry>ilisp>med>sources>SPELL.LCOM;1
compiled on 26-Jan-98 13:37:04
File created 17-May-90 11:20:15
SPELLCOMS

{DSK}<home>larry>ilisp>med>sources>DWIM.LCOM;1
compiled on 25-Jan-98 13:01:22
File created 25-Feb-91 12:14:19
DWIMCOMS

{DSK}<home>larry>ilisp>med>sources>WTFIX.LCOM;1
compiled on 26-Jan-98 13:56:09
File created 18-May-90 01:12:06
WTFIXCOMS

{DSK}<home>larry>ilisp>med>sources>CLISP.LCOM;1
compiled on 25-Jan-98 09:32:34
File created 16-May-90 12:27:02

{DSK}<home>larry>ilisp>med>sources>DWIMIFY.LCOM;1
compiled on 25-Jan-98 13:03:32
File created 16-May-90 16:21:27
DWIMIFYCOMS

{DSK}<home>larry>ilisp>med>sources>CLISPIFY.LCOM;1
compiled on 25-Jan-98 09:33:48
File created 16-May-90 12:28:58
CLISPIFYCOMS

{DSK}<home>larry>ilisp>med>sources>RECORD.LCOM;1
compiled on 26-Jan-98 13:29:01
File created 19-Jan-93 11:15:39
RECORDCOMS

{DSK}<home>larry>ilisp>med>sources>GAINSPACE.LCOM;1
compiled on 25-Jan-98 14:03:59
File created 16-May-90 18:05:30
GAINSPACECOMS

{DSK}<home>larry>ilisp>med>sources>COROUTINE.LCOM;1
compiled on 25-Jan-98 11:56:27
File created 16-May-90 15:10:30

{DSK}<home>larry>ilisp>med>sources>ARGLIST.LCOM;1
compiled on 25-Jan-98 08:30:09
File created 16-May-90 12:03:44
ARGLISTCOMS

{DSK}<home>larry>ilisp>med>sources>ASKUSER.LCOM;6
compiled on 12-Feb-2021 17:00:05
File created 12-Feb-2021 17:00:02
ASKUSERCOMS

{DSK}<home>larry>ilisp>med>sources>SYSPRETTY.LCOM;1
compiled on 26-Jan-98 13:41:07
File created 17-May-90 15:50:03
SYSPRETTYCOMS

{DSK}<home>larry>ilisp>med>sources>COMPARE.LCOM;1
compiled on 25-Jan-98 11:41:10
File created 16-May-90 14:59:25
COMPARECOMS

{DSK}<home>larry>ilisp>med>sources>CMLSTEP.LCOM;1
compiled on 25-Jan-98 11:20:57
File created 16-May-90 14:44:40

{DSK}<home>larry>ilisp>med>sources>CMLDOC.LCOM;1
compiled on 25-Jan-98 09:59:44
File created 16-May-90 13:06:35

{DSK}<home>larry>ilisp>med>sources>CMLPARSE.LCOM;1
compiled on 25-Jan-98 10:27:38
File created  8-Jun-90 14:57:22

{DSK}<home>larry>ilisp>med>sources>CMLSETF.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>CMLSETF.;1
Source file created Wednesday, 13 June 1990, 0:19:02.
FASL file created Sunday, 25 January 1998, 10:52:44.


{DSK}<home>larry>ilisp>med>sources>CMLPRED.LCOM;1
compiled on 25-Jan-98 10:30:39
File created 16-May-90 14:19:02

{DSK}<home>larry>ilisp>med>sources>CMLREAD.LCOM;1
compiled on 25-Jan-98 10:32:12
File created 19-Jan-93 10:25:51

{DSK}<home>larry>ilisp>med>sources>WALKER.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>WALKER.;1
Source file created Thursday, 17 May 1990, 16:04:34.
FASL file created Monday, 26 January 1998, 13:53:47.


{DSK}<home>larry>ilisp>med>sources>CMLSEQFINDER.LCOM;1
compiled on 25-Jan-98 10:35:46
File created 16-May-90 14:29:23

{DSK}<home>larry>ilisp>med>sources>CMLSEQMODIFY.LCOM;1
compiled on 25-Jan-98 10:41:41
File created 16-May-90 14:33:28

{DSK}<home>larry>ilisp>med>sources>CMLSORT.LCOM;1
compiled on 25-Jan-98 11:18:04
File created 16-May-90 14:41:22

{DSK}<home>larry>ilisp>med>sources>DEFSTRUCT.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>DEFSTRUCT.;1
Source file created Monday, 4 January 1993, 18:06:34.
FASL file created Sunday, 25 January 1998, 12:25:14.


{DSK}<home>larry>ilisp>med>sources>CMLMISCIO.LCOM;1
compiled on 25-Jan-98 10:24:15
File created 16-May-90 13:33:00

{DSK}<home>larry>ilisp>med>sources>CMLCOMPILE.LCOM;1
compiled on 25-Jan-98 09:55:54
File created  2-Jul-90 20:24:02

{DSK}<home>larry>ilisp>med>sources>CMLDESTRUCT.LCOM;1
compiled on 25-Jan-98 09:59:34
File created 16-May-90 13:05:47

{DSK}<home>larry>ilisp>med>sources>CMLFORMAT.LCOM;1
compiled on 28-Jan-98 09:47:46
File created 16-May-90 13:19:59

{DSK}<home>larry>ilisp>med>sources>CMLENVIRONMENT.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>CMLENVIRONMENT.;1
Source file created Friday, 3 September 1993, 10:05:16.
FASL file created Sunday, 25 January 1998, 9:59:56.


{DSK}<home>larry>ilisp>med>sources>CMLLOAD.LCOM;1
compiled on 25-Jan-98 10:23:35
File created 13-Jul-90 18:00:23

{DSK}<home>larry>ilisp>med>sources>CMLFLOAT.LCOM;1
compiled on 25-Jan-98 10:08:08
File created 16-May-90 13:16:23

{DSK}<home>larry>ilisp>med>sources>CMLTIME.LCOM;1
compiled on 25-Jan-98 11:30:50
File created 16-May-90 14:48:46

{DSK}<home>larry>ilisp>med>sources>CMLRAND.LCOM;1
compiled on 25-Jan-98 10:31:47
File created 16-May-90 14:21:56

{DSK}<home>larry>ilisp>med>sources>CMLMODULES.DFASL;4
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>CMLMODULES.;2
Source file created Monday, 16 April 2018, 22:46:19.
FASL file created Monday, 16 April 2018, 22:46:19.


{DSK}<home>larry>ilisp>med>sources>PROFILE.LCOM;1
compiled on 26-Jan-98 13:28:16
File created 16-May-90 21:15:43

{DSK}<home>larry>ilisp>med>sources>CMLEXEC.LCOM;1
compiled on 25-Jan-98 10:04:21
File created 21-Jan-93 11:16:01

{DSK}<home>larry>ilisp>med>sources>CMLUNDO.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>CMLUNDO.;1
Source file created Wednesday, 16 May 1990, 14:43:00.
FASL file created Sunday, 25 January 1998, 11:35:46.


{DSK}<home>larry>ilisp>med>sources>EXEC-COMMANDS.LCOM;1
compiled on 25-Jan-98 13:18:25
File created 16-May-90 16:29:25

{DSK}<home>larry>ilisp>med>sources>DEBUGGER.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>DEBUGGER.;1
Source file created Friday, 16 August 1991, 17:43:08.
FASL file created Sunday, 25 January 1998, 12:20:29.


{DSK}<home>larry>ilisp>med>sources>IL-ERROR-STUFF.LCOM;1
compiled on 25-Jan-98 14:25:53
File created 16-May-90 18:18:52
IL-ERROR-STUFFCOMS
IL-ERROR-STUFFCOMS

{DSK}<home>larry>ilisp>med>sources>DEBUGEDIT.LCOM;1
compiled on 25-Jan-98 12:20:10
File created 16-May-90 15:24:15

{DSK}<home>larry>ilisp>med>sources>ADDARITH.LCOM;2
compiled on 25-Jan-98 02:08:33
File created 16-May-90 11:46:37

{DSK}<home>larry>ilisp>med>sources>HPRINT.LCOM;1
compiled on 25-Jan-98 14:21:19
File created  9-Oct-94 13:07:03

{DSK}<home>larry>ilisp>med>sources>AARITH.LCOM;2
compiled on 25-Jan-98 01:58:27
File created 16-May-90 11:41:16
AARITHCOMS

{DSK}<home>larry>ilisp>med>sources>ADISPLAY.LCOM;1
compiled on 28-Jan-98 10:53:47
File created 15-Sep-94 17:07:04
ADISPLAYCOMS

{DSK}<home>larry>ilisp>med>sources>HLDISPLAY.LCOM;1
compiled on 25-Jan-98 14:12:43
File created 15-Mar-94 10:48:02

{DSK}<home>larry>ilisp>med>sources>MENU.LCOM;1
compiled on 16-Jul-99 15:51:41
File created 16-Jul-99 15:51:36
MENUCOMS

{DSK}<home>larry>ilisp>med>sources>WINDOWOBJ.LCOM;1
compiled on 26-Jan-98 13:55:38
File created 19-Jan-93 11:26:14
WINDOWOBJCOMS

{DSK}<home>larry>ilisp>med>sources>WINDOWSCROLL.LCOM;1
compiled on 17-Feb-2021 13:49:06
File created 17-Feb-2021 13:49:06
WINDOWSCROLLCOMS

{DSK}<home>larry>ilisp>med>sources>WINDOW.LCOM;1
compiled on  9-Apr-2000 17:38:50
File created  9-Apr-2000 17:36:29

{DSK}<home>larry>ilisp>med>sources>PAINTW.LCOM;1
compiled on 16-Jul-99 15:49:39
File created 16-Jul-99 15:49:37

{DSK}<home>larry>ilisp>med>sources>WINDOWICON.LCOM;1
compiled on 26-Jan-98 13:55:34
File created  2-Feb-94 13:26:29
WINDOWICONCOMS

{DSK}<home>larry>ilisp>med>sources>ATTACHEDWINDOW.LCOM;1
compiled on 28-Jun-99 17:18:53
File created 28-Jun-99 17:18:50
ATTACHEDWINDOWCOMS

{DSK}<home>larry>ilisp>med>sources>XXGEOM.LCOM;1
compiled on 26-Jan-98 14:03:05
File created 19-Jan-93 11:30:54
XXGEOMCOMS

{DSK}<home>larry>ilisp>med>sources>XXFILL.LCOM;1
compiled on 26-Jan-98 14:02:40
File created 19-Jan-93 11:29:57
XXFILLCOMS

{DSK}<home>larry>ilisp>med>sources>DEXEC.LCOM;12
compiled on 13-Aug-2020 12:36:18
File created 13-Aug-2020 12:36:18

{DSK}<home>larry>ilisp>med>sources>INSPECT.LCOM;7
compiled on 21-Apr-2018 08:08:07
File created 21-Apr-2018 08:08:07
INSPECTCOMS

{DSK}<home>larry>ilisp>med>sources>DESCRIBE.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>DESCRIBE.;1
Source file created Wednesday, 16 May 1990, 15:27:33.
FASL file created Sunday, 25 January 1998, 12:32:53.


{DSK}<home>larry>ilisp>med>sources>CMLARRAYINSPECTOR.LCOM;1
compiled on 25-Jan-98 09:53:09
File created 31-Dec-93 12:26:35
CMLARRAYINSPECTORCOMS

{DSK}<home>larry>ilisp>med>sources>TWODINSPECTOR.LCOM;2
compiled on 19-Feb-2021 14:31:33
File created 19-Feb-2021 14:31:33
TWODINSPECTORCOMS

{DSK}<home>larry>ilisp>med>sources>FREEMENU.LCOM;1
compiled on 25-Jan-98 13:54:38
File created  6-Dec-94 10:55:40

{DSK}<home>larry>ilisp>med>sources>EDITINTERFACE.LCOM;1
compiled on 25-Jan-98 13:12:33
File created  7-Nov-91 18:15:13

{DSK}<home>larry>ilisp>med>sources>TTYIN.LCOM;1
compiled on 26-Jan-98 13:49:55
File created 24-May-91 11:33:53
TTYINCOMS

{DSK}<home>larry>ilisp>med>sources>BREAK-AND-TRACE.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>BREAK-AND-TRACE.;1
Source file created Wednesday, 16 May 1990, 12:01:43.
FASL file created Sunday, 25 January 1998, 9:14:16.


{DSK}<home>larry>ilisp>med>sources>FASDUMP.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>FASDUMP.;1
Source file created Friday, 11 January 1991, 16:23:30.
FASL file created Sunday, 25 January 1998, 13:18:44.


{DSK}<home>larry>ilisp>med>sources>XCL-COMPILER.LCOM;1
compiled on 26-Jan-98 13:56:11
File created 18-May-90 01:13:35
XCL-COMPILERCOMS

{DSK}<home>larry>ilisp>med>sources>XCLC-ENV-CTXT.LCOM;1
compiled on 26-Jan-98 13:58:55
File created 17-Jul-90 10:48:08

{DSK}<home>larry>ilisp>med>sources>XCLC-TREES.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>XCLC-TREES.;1
Source file created Wednesday, 23 May 1990, 13:17:15.
FASL file created Monday, 26 January 1998, 14:01:24.


{DSK}<home>larry>ilisp>med>sources>XCLC-TOP-LEVEL.DFASL;9
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;10
Source file created 19-Sep-2020 22:02:59
FASL file created Saturday, 19 September 2020, 22:02:59


{DSK}<home>larry>ilisp>med>sources>XCLC-ALPHA.LCOM;1
compiled on 26-Jan-98 13:56:23
File created 20-Jul-90 17:07:06

{DSK}<home>larry>ilisp>med>sources>XCLC-OPTIMIZERS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>XCLC-OPTIMIZERS.;1
Source file created Sunday, 3 June 1990, 22:30:55.
FASL file created Monday, 26 January 1998, 14:00:16.


{DSK}<home>larry>ilisp>med>sources>XCLC-ANALYZE.LCOM;1
compiled on 26-Jan-98 13:57:17
File created 18-May-90 01:25:52

{DSK}<home>larry>ilisp>med>sources>XCLC-META-EVAL.LCOM;1
compiled on 26-Jan-98 13:59:42
File created  9-Dec-91 03:12:25

{DSK}<home>larry>ilisp>med>sources>XCLC-TRANSFORMS.LCOM;1
compiled on 26-Jan-98 14:01:16
File created 10-Aug-92 13:17:53

{DSK}<home>larry>ilisp>med>sources>XCLC-DATABASE.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>XCLC-DATABASE.;1
Source file created Tuesday, 19 January 1993, 11:26:11.
FASL file created Monday, 26 January 1998, 13:58:14.


{DSK}<home>larry>ilisp>med>sources>XCLC-ANNOTATE.LCOM;1
compiled on 26-Jan-98 13:57:27
File created 18-May-90 01:28:45

{DSK}<home>larry>ilisp>med>sources>XCLC-GENCODE.LCOM;1
compiled on 26-Jan-98 13:59:08
File created  2-Oct-91 11:38:50

{DSK}<home>larry>ilisp>med>sources>XCLC-PEEPHOLE.LCOM;1
compiled on 26-Jan-98 14:00:34
File created 27-Aug-91 14:38:23

{DSK}<home>larry>ilisp>med>sources>ADVISE.dfasl;4
XCL Compiler output for source file {DSK}<lispcore>sources>ADVISE.;1
Source file created Wednesday, 16 May 1990, 11:45:00.
FASL file created Sunday, 25 January 1998, 8:20:23.


{DSK}<home>larry>ilisp>med>sources>DLAP.LCOM;1
compiled on 31-Jan-98 10:01:22
File created 25-Jan-93 16:56:13

{DSK}<home>larry>ilisp>med>sources>BYTECOMPILER.LCOM;1
compiled on 25-Jan-98 09:21:09
File created 26-Apr-91 17:25:53

{DSK}<home>larry>ilisp>med>sources>COMPILE.LCOM;1
compiled on 25-Jan-98 11:41:58
File created 27-Jul-90 11:15:42
COMPILECOMS

{DSK}<home>larry>ilisp>med>sources>HARDCOPY.LCOM;6
compiled on 16-Apr-2018 22:15:08
File created 16-Apr-2018 22:15:08
HARDCOPYCOMS

{DSK}<home>larry>ilisp>med>sources>LOGOW.DFASL;1
XCL Compiler output for source file {DSK}<tilde>sybalsky>lispcore>sources>LOGOW.;2
Source file created Sunday, 9 April 2000, 18:08:24.
FASL file created Sunday, 9 April 2000, 18:08:25.


{DSK}<home>larry>ilisp>med>sources>IDLER.LCOM;1
compiled on 25-Jan-98 14:24:39
File created 23-Mar-92 13:38:29
IDLERCOMS

{DSK}<home>larry>ilisp>med>sources>ICONW.LCOM;1
compiled on 25-Jan-98 14:23:21
File created 16-May-90 18:16:27
ICONWCOMS

{DSK}<home>larry>ilisp>med>sources>SEDIT.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT.;1
Source file created Friday, 25 January 1991, 17:01:33.
FASL file created Monday, 26 January 1998, 13:30:21.


{DSK}<home>larry>ilisp>med>sources>SEDIT-ACCESS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-ACCESS.;1
Source file created Tuesday, 19 January 1993, 11:16:06.
FASL file created Monday, 26 January 1998, 13:30:23.


{DSK}<home>larry>ilisp>med>sources>SEDIT-ATOMIC.DFASL;2
XCL Compiler output for source file {DSK}<usr>local>lde>lispcore>sources>SEDIT-ATOMIC.;3
Source file created 16-May-90 21:37:57
FASL file created Sunday, 20 September 2020, 21:00:28


{DSK}<home>larry>ilisp>med>sources>SEDIT-BASE.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-BASE.;1
Source file created Wednesday, 2 December 1992, 17:40:24.
FASL file created Monday, 26 January 1998, 13:31:04.


{DSK}<home>larry>ilisp>med>sources>SEDIT-COMMANDS.DFASL;3
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-COMMANDS.;3
Source file created Monday, 23 April 2018, 18:12:52.
FASL file created Monday, 23 April 2018, 18:13:51.


{DSK}<home>larry>ilisp>med>sources>SEDIT-COMMENTS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-COMMENTS.;1
Source file created Wednesday, 16 May 1990, 21:35:01.
FASL file created Monday, 26 January 1998, 13:32:56.


{DSK}<home>larry>ilisp>med>sources>SEDIT-EXPORTS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-EXPORTS.;1
Source file created Thursday, 17 May 1990, 10:49:21.
FASL file created Monday, 26 January 1998, 13:33:33.


{DSK}<home>larry>ilisp>med>sources>SEDIT-INDENT.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-INDENT.;1
Source file created Thursday, 17 May 1990, 10:52:22.
FASL file created Monday, 26 January 1998, 13:33:37.


{DSK}<home>larry>ilisp>med>sources>SEDIT-LIST-FORMATS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-LIST-FORMATS.;1
Source file created Thursday, 17 May 1990, 10:56:07.
FASL file created Monday, 26 January 1998, 13:34:54.


{DSK}<home>larry>ilisp>med>sources>SEDIT-LINEAR.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-LINEAR.;1
Source file created Thursday, 17 May 1990, 10:54:05.
FASL file created Monday, 26 January 1998, 13:33:51.


{DSK}<home>larry>ilisp>med>sources>SEDIT-LISTS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-LISTS.;1
Source file created Thursday, 17 May 1990, 10:58:06.
FASL file created Monday, 26 January 1998, 13:35:03.


{DSK}<home>larry>ilisp>med>sources>SEDIT-TERMINAL.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-TERMINAL.;1
Source file created Thursday, 17 May 1990, 10:59:38.
FASL file created Monday, 26 January 1998, 13:35:55.


{DSK}<home>larry>ilisp>med>sources>SEDIT-TOPLEVEL.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-TOPLEVEL.;1
Source file created Wednesday, 10 July 1991, 19:03:29.
FASL file created Monday, 26 January 1998, 13:36:04.


{DSK}<home>larry>ilisp>med>sources>SEDIT-WINDOW.DFASL;2
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;2
Source file created Monday, 14 May 2018, 14:12:02.
FASL file created Monday, 14 May 2018, 14:12:02.


{DSK}<home>larry>ilisp>med>sources>TIME.LCOM;4
compiled on 16-Apr-2018 23:05:17
File created 16-Apr-2018 23:05:10

{DSK}<home>larry>ilisp>med>sources>BRKDWN.LCOM;1
compiled on 25-Jan-98 09:16:08
File created 16-May-90 12:14:36
BRKDWNCOMS

{DSK}<home>larry>ilisp>med>sources>XCL-EXTRAS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>XCL-EXTRAS.;1
Source file created Friday, 18 May 1990, 1:03:51.
FASL file created Monday, 26 January 1998, 13:56:12.


{DSK}<home>larry>ilisp>med>sources>CMLPACKAGE.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>CMLPACKAGE.;1
Source file created Thursday, 14 June 1990, 1:35:57.
FASL file created Sunday, 25 January 1998, 10:25:22.


{DSK}<home>larry>ilisp>med>sources>CMLSMARTARGS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>CMLSMARTARGS.;2
Source file created Tuesday, 27 January 1998, 10:56:02.
FASL file created Tuesday, 27 January 1998, 10:58:59.


{DSK}<home>larry>ilisp>med>sources>IMPLICIT-KEY-HASH.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>IMPLICIT-KEY-HASH.;1
Source file created Wednesday, 16 May 1990, 18:10:26.
FASL file created Sunday, 25 January 1998, 14:31:31.


{DSK}<home>larry>ilisp>med>sources>CLOSURE-CACHE.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>CLOSURE-CACHE.;1
Source file created Wednesday, 16 May 1990, 12:24:08.
FASL file created Sunday, 25 January 1998, 9:35:47.


1> 
SHH(PROGN(IL:DRIBBLE)(IL:ENDLOADUP)(SETQ IL:MAKESYSNAME ':MEDLEY)(IL:MAKESYS
(IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE MEDLEYDIR))(IL:L-CASE (QUOTE
/tmp/lisp.sysout)))))
\ No newline at end of file
+MAIKOBITBLT bootloaded
MAIKOLOADUPFNS bootloaded
CMLREADTABLE bootloaded
CMLCHARACTER bootloaded
CMLLIST bootloaded
DMISC bootloaded
COMPATIBILITY bootloaded
APUTDQ bootloaded
LLDISPLAY bootloaded
FONT bootloaded
PASSWORDS bootloaded
UFSCALLC bootloaded
UFS bootloaded
DSK bootloaded
CMLARRAY bootloaded
PROC bootloaded
XCL-PACKAGE bootloaded
CONDITION-PACKAGE bootloaded
PACKAGE-STARTUP bootloaded
LLPACKAGE bootloaded
LLSYMBOL bootloaded
LLERROR bootloaded
LLRESTART bootloaded
CMLSPECIALFORMS bootloaded
CMLPROGV bootloaded
CMLEVAL bootloaded
CMLMACROS bootloaded
BOOTSTRAP bootloaded
MISC bootloaded
AINTERRUPT bootloaded
AERROR bootloaded
ABASIC bootloaded
APRINT bootloaded
ATERM bootloaded
VANILLADISK bootloaded
PMAP bootloaded
ADIR bootloaded
AOFD bootloaded
COREIO bootloaded
ACODE bootloaded
LLCODE bootloaded
ATBL bootloaded
DTDECLARE bootloaded
ASTACK bootloaded
LLTIMER bootloaded
LLKEY bootloaded
IOCHAR bootloaded
LLDATATYPE bootloaded
LLSTK bootloaded
LLCHAR bootloaded
LLREAD bootloaded
LLBIGNUM bootloaded
LLFLOAT bootloaded
LLARITH bootloaded
CMLSEQBASICS bootloaded
SETF-RUNTIME bootloaded
DEFSTRUCT-RUN-TIME bootloaded
LLMVS bootloaded
LLINTERP bootloaded
LLARRAYELT bootloaded
LLGC bootloaded
LLBASIC bootloaded
IMAGEIO bootloaded
FILEIO bootloaded
LLNEW bootloaded
LLBFS bootloaded
LLSUBRS bootloaded
LLFAULT bootloaded
PACKAGE-CONVERSION-TABLE bootloaded
loading ACODE
loading MACHINEINDEPENDENT
loading POSTLOADUP
loading LISP-PACKAGE

{DSK}<home>larry>ilisp>medley>sources>LISP-PACKAGE.LCOM;1
compiled on 25-Jan-98 15:03:32
File created 16-May-90 18:44:49
IL:LISP-PACKAGECOMS
loading FASL-PACKAGE

{DSK}<home>larry>ilisp>medley>sources>FASL-PACKAGE.LCOM;1
compiled on 25-Jan-98 13:21:46
File created 16-May-90 16:33:38
IL:FASL-PACKAGECOMS
loading D-ASSEM-PACKAGE

{DSK}<home>larry>ilisp>medley>sources>D-ASSEM-PACKAGE.LCOM;1
compiled on 25-Jan-98 12:20:01
File created  8-Jan-91 00:37:24
IL:D-ASSEM-PACKAGECOMS
loading COMPILER-PACKAGE

{DSK}<home>larry>ilisp>medley>sources>COMPILER-PACKAGE.LCOM;1
compiled on 25-Jan-98 11:43:48
File created 16-May-90 15:03:20
IL:COMPILER-PACKAGECOMS
loading ERROR-RUNTIME

{DSK}<home>larry>ilisp>medley>sources>ERROR-RUNTIME.LCOM;1
compiled on 25-Jan-98 13:15:12
File created 16-May-90 16:27:39
loading CMLARITH

{DSK}<home>larry>ilisp>medley>sources>CMLARITH.LCOM;1
compiled on 25-Jan-98 09:40:28
File created  4-Jan-93 17:38:48
loading CONDITION-HIERARCHY

{DSK}<home>larry>ilisp>medley>sources>CONDITION-HIERARCHY.LCOM;1
compiled on 25-Jan-98 11:43:54
File created 22-Aug-90 09:45:58

{DSK}<home>larry>ilisp>medley>sources>CONDITION-HIERARCHY-SI.LCOM;1
compiled on 25-Jan-98 11:52:40
File created 16-May-90 15:05:52

{DSK}<home>larry>ilisp>medley>sources>CONDITION-HIERARCHY-POST-SI.LCOM;1
compiled on 25-Jan-98 11:52:26
File created 16-May-90 15:05:05

{DSK}<home>larry>ilisp>medley>sources>CONDITION-HIERARCHY-IL.LCOM;1
compiled on 25-Jan-98 11:50:25
File created 16-May-90 15:04:10
loading CMLHASH

{DSK}<home>larry>ilisp>medley>sources>CMLHASH.LCOM;1
compiled on 25-Jan-98 10:17:44
File created 16-May-90 13:25:03
loading D-ASSEM

{DSK}<home>larry>ilisp>medley>sources>D-ASSEM.LCOM;1
compiled on 25-Jan-98 12:01:26
File created  1-Dec-92 02:18:56
loading FASLOAD

{DSK}<home>larry>ilisp>medley>sources>FASLOAD.LCOM;1
compiled on 31-Jan-98 09:39:23
File created 25-Nov-92 12:35:33
loading DEFFER-RUNTIME

{DSK}<home>larry>ilisp>medley>sources>DEFFER-RUNTIME.LCOM;1
compiled on 25-Jan-98 12:24:48
File created 16-May-90 15:30:14
loading CMLPRINT

{DSK}<home>larry>ilisp>medley>sources>CMLPRINT.LCOM;1
compiled on 25-Jan-98 10:30:50
File created 16-May-90 14:19:58
loading CLSTREAMS

{DSK}<home>larry>ilisp>medley>sources>CLSTREAMS.LCOM;1
compiled on 25-Jan-98 09:36:01
File created  3-Apr-91 15:11:53
loading CMLSTRING

{DSK}<home>larry>ilisp>medley>sources>CMLSTRING.LCOM;1
compiled on 25-Jan-98 11:21:16
File created 16-May-90 14:45:59
loading CMLSYMBOL

{DSK}<home>larry>ilisp>medley>sources>CMLSYMBOL.LCOM;1
compiled on 25-Jan-98 11:30:38
File created 16-May-90 14:47:55
loading CMLTYPES

{DSK}<home>larry>ilisp>medley>sources>CMLTYPES.LCOM;1
compiled on 25-Jan-98 11:31:44
File created  4-Jan-93 17:55:42
loading CMLSEQCOMMON

{DSK}<home>larry>ilisp>medley>sources>CMLSEQCOMMON.LCOM;1
compiled on 25-Jan-98 10:35:19
File created 16-May-90 14:28:05
loading CMLSEQMAPPERS

{DSK}<home>larry>ilisp>medley>sources>CMLSEQMAPPERS.LCOM;1
compiled on 25-Jan-98 10:40:02
File created 16-May-90 14:31:36
loading CMLPATHNAME

{DSK}<home>larry>ilisp>medley>sources>CMLPATHNAME.LCOM;1
compiled on 25-Jan-98 10:28:38
File created 28-Sep-90 15:14:19
loading CMLFILESYS

{DSK}<home>larry>ilisp>medley>sources>CMLFILESYS.LCOM;1
compiled on 25-Jan-98 10:07:48
File created  8-Jun-90 16:41:26
loading CMLDEFFER

{DSK}<home>larry>ilisp>medley>sources>CMLDEFFER.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>CMLDEFFER.;1
Source file created Sunday, 3 June 1990, 23:11:46.
FASL file created Wednesday, 28 January 1998, 16:41:48.

loading ERROR-RUNTIME-AFTER-FASL

{DSK}<home>larry>ilisp>medley>sources>ERROR-RUNTIME-AFTER-FASL.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>ERROR-RUNTIME-AFTER-FASL.;1
Source file created Wednesday, 16 May 1990, 16:14:06.
FASL file created Sunday, 25 January 1998, 13:18:10.

loading WRAPPERS

{DSK}<home>larry>ilisp>medley>sources>WRAPPERS.LCOM;1
compiled on 26-Jan-98 13:55:56
File created  2-Feb-94 14:15:09
loading STACKFNS

{DSK}<home>larry>ilisp>medley>sources>STACKFNS.LCOM;1
compiled on 26-Jan-98 13:41:05
File created 17-May-90 15:48:43
STACKFNSCOMS
STACKFNSCOMS
loading CMLMVS

{DSK}<home>larry>ilisp>medley>sources>CMLMVS.LCOM;1
compiled on 25-Jan-98 10:25:04
File created 16-May-90 13:35:04
loading MACROS

{DSK}<home>larry>ilisp>medley>sources>MACROS.LCOM;1
compiled on 25-Jan-98 17:37:48
File created 16-May-90 20:28:24
loading MACROAUX

{DSK}<home>larry>ilisp>medley>sources>MACROAUX.LCOM;1
compiled on 25-Jan-98 17:37:05
File created 16-May-90 20:26:31
loading UNWINDMACROS

{DSK}<home>larry>ilisp>medley>sources>UNWINDMACROS.LCOM;1
compiled on 26-Jan-98 13:53:42
File created 17-May-90 16:11:33
loading COMMON

{DSK}<home>larry>ilisp>medley>sources>COMMON.LCOM;1
compiled on 25-Jan-98 11:40:32
File created 16-May-90 14:58:17
loading XCLC-RUNTIME

{DSK}<home>larry>ilisp>medley>sources>XCLC-RUNTIME.LCOM;1
compiled on 26-Jan-98 14:00:44
File created 23-May-90 13:18:14
loading CMLTYPES
loading CL-ERROR

{DSK}<home>larry>ilisp>medley>sources>CL-ERROR.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>CL-ERROR.;1
Source file created Wednesday, 21 August 1991, 17:03:40.
FASL file created Sunday, 25 January 1998, 9:28:09.

loading AFONT

{DSK}<home>larry>ilisp>medley>sources>AFONT.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>AFONT.;1
Source file created Wednesday, 16 May 1990, 11:47:29.
FASL file created Sunday, 25 January 1998, 8:22:42.

loading EDIT

{DSK}<home>larry>ilisp>medley>sources>EDIT.LCOM;1
compiled on 25-Jan-98 13:09:41
File created 16-May-90 16:23:16
EDITCOMS
loading WEDIT

{DSK}<home>larry>ilisp>medley>sources>WEDIT.LCOM;3
compiled on 26-Jan-98 13:54:04
File created 23-Oct-91 16:39:18
WEDITCOMS
loading PRETTY

{DSK}<home>larry>ilisp>medley>sources>PRETTY.LCOM;7
compiled on 21-Feb-2021 10:59:08
File created 21-Feb-2021 10:59:08
PRETTYCOMS
loading DSPRINTDEF

{DSK}<home>larry>ilisp>medley>sources>DSPRINTDEF.LCOM;1
compiled on 25-Jan-98 12:58:43
File created 19-Jan-93 10:27:05
DSPRINTDEFCOMS
loading NEWPRINTDEF

{DSK}<home>larry>ilisp>medley>sources>NEWPRINTDEF.LCOM;2
compiled on 31-Dec-2000 11:53:35
File created 31-Dec-2000 11:53:33
NEWPRINTDEFCOMS
loading FONTPROFILE

{DSK}<home>larry>ilisp>medley>sources>FONTPROFILE.LCOM;1
compiled on 14-May-2018 00:04:35
File created 28-Jun-99 22:10:46
FONTPROFILECOMS
loading SPELLFILE

{DSK}<home>larry>ilisp>medley>sources>SPELLFILE.LCOM;1
compiled on 26-Jan-98 13:37:13
File created 28-Apr-92 15:38:21
SPELLFILECOMS
loading PRINTFN

{DSK}<home>larry>ilisp>medley>sources>PRINTFN.LCOM;4
compiled on 16-Apr-2018 21:40:32
File created 16-Apr-2018 21:40:32
PRINTFNCOMS
loading LOADFNS

{DSK}<home>larry>ilisp>medley>sources>LOADFNS.LCOM;10
compiled on 16-Apr-2018 17:38:16
File created 16-Apr-2018 17:38:16
LOADFNSCOMS
loading DMISC
loading DIRECTORY

{DSK}<home>larry>ilisp>medley>sources>DIRECTORY.LCOM;1
compiled on 25-Jan-98 12:34:36
File created 30-Apr-92 15:04:56
DIRECTORYCOMS
loading SPELLFILE
loading FILEPKG

{DSK}<home>larry>ilisp>medley>sources>FILEPKG.LCOM;1
compiled on 12-Feb-2021 17:16:06
File created 12-Feb-2021 17:16:04
FILEPKGCOMS
loading RESOURCE

{DSK}<home>larry>ilisp>medley>sources>RESOURCE.LCOM;1
compiled on 26-Jan-98 13:30:19
File created 16-May-90 21:31:50
RESOURCECOMS
loading HIST

{DSK}<home>larry>ilisp>medley>sources>HIST.LCOM;1
compiled on 25-Jan-98 14:10:10
File created 10-Jul-91 12:07:43
HISTCOMS
loading UNDO

{DSK}<home>larry>ilisp>medley>sources>UNDO.LCOM;1
compiled on 26-Jan-98 13:53:32
File created 17-May-90 16:09:40
UNDOCOMS
loading SPELL

{DSK}<home>larry>ilisp>medley>sources>SPELL.LCOM;1
compiled on 26-Jan-98 13:37:04
File created 17-May-90 11:20:15
SPELLCOMS
loading DWIM

{DSK}<home>larry>ilisp>medley>sources>DWIM.LCOM;11
compiled on 15-Mar-2021 14:34:27
File created 15-Mar-2021 14:34:19
DWIMCOMS
loading WTFIX

{DSK}<home>larry>ilisp>medley>sources>WTFIX.LCOM;1
compiled on 26-Jan-98 13:56:09
File created 18-May-90 01:12:06
WTFIXCOMS
loading CLISP

{DSK}<home>larry>ilisp>medley>sources>CLISP.LCOM;1
compiled on 25-Jan-98 09:32:34
File created 16-May-90 12:27:02
loading DWIMIFY

{DSK}<home>larry>ilisp>medley>sources>DWIMIFY.LCOM;1
compiled on 25-Jan-98 13:03:32
File created 16-May-90 16:21:27
DWIMIFYCOMS
loading CLISPIFY

{DSK}<home>larry>ilisp>medley>sources>CLISPIFY.LCOM;1
compiled on 25-Jan-98 09:33:48
File created 16-May-90 12:28:58
CLISPIFYCOMS
loading RECORD

{DSK}<home>larry>ilisp>medley>sources>RECORD.LCOM;3
compiled on 26-Jan-98 13:29:01
File created 19-Jan-93 11:15:39
RECORDCOMS
loading GAINSPACE

{DSK}<home>larry>ilisp>medley>sources>GAINSPACE.LCOM;1
compiled on 25-Jan-98 14:03:59
File created 16-May-90 18:05:30
GAINSPACECOMS
loading COROUTINE

{DSK}<home>larry>ilisp>medley>sources>COROUTINE.LCOM;1
compiled on 25-Jan-98 11:56:27
File created 16-May-90 15:10:30
loading ARGLIST

{DSK}<home>larry>ilisp>medley>sources>ARGLIST.LCOM;1
compiled on 25-Jan-98 08:30:09
File created 16-May-90 12:03:44
ARGLISTCOMS
loading ASKUSER

{DSK}<home>larry>ilisp>medley>sources>ASKUSER.LCOM;6
compiled on 12-Feb-2021 17:00:05
File created 12-Feb-2021 17:00:02
ASKUSERCOMS
loading SYSPRETTY

{DSK}<home>larry>ilisp>medley>sources>SYSPRETTY.LCOM;1
compiled on 26-Jan-98 13:41:07
File created 17-May-90 15:50:03
SYSPRETTYCOMS
loading COMMON
loading COMPARE

{DSK}<home>larry>ilisp>medley>sources>COMPARE.LCOM;1
compiled on 25-Jan-98 11:41:10
File created 16-May-90 14:59:25
COMPARECOMS
loading CMLSTEP

{DSK}<home>larry>ilisp>medley>sources>CMLSTEP.LCOM;1
compiled on 25-Jan-98 11:20:57
File created 16-May-90 14:44:40
loading CMLDOC

{DSK}<home>larry>ilisp>medley>sources>CMLDOC.LCOM;1
compiled on 25-Jan-98 09:59:44
File created 16-May-90 13:06:35
loading CMLPARSE

{DSK}<home>larry>ilisp>medley>sources>CMLPARSE.LCOM;1
compiled on 25-Jan-98 10:27:38
File created  8-Jun-90 14:57:22
loading CMLSETF

{DSK}<home>larry>ilisp>medley>sources>CMLSETF.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>CMLSETF.;1
Source file created Wednesday, 13 June 1990, 0:19:02.
FASL file created Sunday, 25 January 1998, 10:52:44.

loading CMLPRED

{DSK}<home>larry>ilisp>medley>sources>CMLPRED.LCOM;1
compiled on 25-Jan-98 10:30:39
File created 16-May-90 14:19:02
loading CMLREAD

{DSK}<home>larry>ilisp>medley>sources>CMLREAD.LCOM;1
compiled on 25-Jan-98 10:32:12
File created 19-Jan-93 10:25:51
loading WALKER

{DSK}<home>larry>ilisp>medley>sources>WALKER.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>WALKER.;1
Source file created Thursday, 17 May 1990, 16:04:34.
FASL file created Monday, 26 January 1998, 13:53:47.

loading CMLSEQFINDER

{DSK}<home>larry>ilisp>medley>sources>CMLSEQFINDER.LCOM;1
compiled on 25-Jan-98 10:35:46
File created 16-May-90 14:29:23
loading CMLSEQMODIFY

{DSK}<home>larry>ilisp>medley>sources>CMLSEQMODIFY.LCOM;1
compiled on 25-Jan-98 10:41:41
File created 16-May-90 14:33:28
loading CMLSORT

{DSK}<home>larry>ilisp>medley>sources>CMLSORT.LCOM;1
compiled on 25-Jan-98 11:18:04
File created 16-May-90 14:41:22
loading DEFSTRUCT

{DSK}<home>larry>ilisp>medley>sources>DEFSTRUCT.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>DEFSTRUCT.;1
Source file created Monday, 4 January 1993, 18:06:34.
FASL file created Sunday, 25 January 1998, 12:25:14.

loading CMLMISCIO

{DSK}<home>larry>ilisp>medley>sources>CMLMISCIO.LCOM;1
compiled on 25-Jan-98 10:24:15
File created 16-May-90 13:33:00
loading CMLCOMPILE

{DSK}<home>larry>ilisp>medley>sources>CMLCOMPILE.LCOM;1
compiled on 25-Jan-98 09:55:54
File created  2-Jul-90 20:24:02
loading CMLDESTRUCT

{DSK}<home>larry>ilisp>medley>sources>CMLDESTRUCT.LCOM;1
compiled on 25-Jan-98 09:59:34
File created 16-May-90 13:05:47
loading CL-ERROR
loading CMLFORMAT

{DSK}<home>larry>ilisp>medley>sources>CMLFORMAT.LCOM;1
compiled on 28-Jan-98 09:47:46
File created 16-May-90 13:19:59
loading CMLENVIRONMENT

{DSK}<home>larry>ilisp>medley>sources>CMLENVIRONMENT.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>CMLENVIRONMENT.;1
Source file created Friday, 3 September 1993, 10:05:16.
FASL file created Sunday, 25 January 1998, 9:59:56.

loading CMLLOAD

{DSK}<home>larry>ilisp>medley>sources>CMLLOAD.LCOM;1
compiled on 25-Jan-98 10:23:35
File created 13-Jul-90 18:00:23
loading CMLFLOAT

{DSK}<home>larry>ilisp>medley>sources>CMLFLOAT.LCOM;1
compiled on 25-Jan-98 10:08:08
File created 16-May-90 13:16:23
loading CMLTIME

{DSK}<home>larry>ilisp>medley>sources>CMLTIME.LCOM;1
compiled on 25-Jan-98 11:30:50
File created 16-May-90 14:48:46
loading CMLRAND

{DSK}<home>larry>ilisp>medley>sources>CMLRAND.LCOM;1
compiled on 25-Jan-98 10:31:47
File created 16-May-90 14:21:56
loading CMLMODULES

{DSK}<home>larry>ilisp>medley>sources>CMLMODULES.DFASL;4
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>CMLMODULES.;2
Source file created Monday, 16 April 2018, 22:46:19.
FASL file created Monday, 16 April 2018, 22:46:19.

loading PROFILE

{DSK}<home>larry>ilisp>medley>sources>PROFILE.LCOM;1
compiled on 26-Jan-98 13:28:16
File created 16-May-90 21:15:43
loading CMLEXEC

{DSK}<home>larry>ilisp>medley>sources>CMLEXEC.LCOM;1
compiled on 25-Jan-98 10:04:21
File created 21-Jan-93 11:16:01

{DSK}<home>larry>ilisp>medley>sources>CMLUNDO.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>CMLUNDO.;1
Source file created Wednesday, 16 May 1990, 14:43:00.
FASL file created Sunday, 25 January 1998, 11:35:46.

loading EXEC-COMMANDS

{DSK}<home>larry>ilisp>medley>sources>EXEC-COMMANDS.LCOM;1
compiled on 25-Jan-98 13:18:25
File created 16-May-90 16:29:25
loading DEBUGGER

{DSK}<home>larry>ilisp>medley>sources>DEBUGGER.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>DEBUGGER.;1
Source file created Friday, 16 August 1991, 17:43:08.
FASL file created Sunday, 25 January 1998, 12:20:29.

loading IL-ERROR-STUFF

{DSK}<home>larry>ilisp>medley>sources>IL-ERROR-STUFF.LCOM;1
compiled on 25-Jan-98 14:25:53
File created 16-May-90 18:18:52
IL-ERROR-STUFFCOMS
IL-ERROR-STUFFCOMS
loading DEBUGEDIT

{DSK}<home>larry>ilisp>medley>sources>DEBUGEDIT.LCOM;1
compiled on 25-Jan-98 12:20:10
File created 16-May-90 15:24:15
loading ADDARITH

{DSK}<home>larry>ilisp>medley>sources>ADDARITH.LCOM;2
compiled on 25-Jan-98 02:08:33
File created 16-May-90 11:46:37
loading CMLPATHNAME
loading HPRINT

{DSK}<home>larry>ilisp>medley>sources>HPRINT.LCOM;1
compiled on 25-Jan-98 14:21:19
File created  9-Oct-94 13:07:03
loading AARITH

{DSK}<home>larry>ilisp>medley>sources>AARITH.LCOM;2
compiled on 25-Jan-98 01:58:27
File created 16-May-90 11:41:16
AARITHCOMS
loading ADISPLAY

{DSK}<home>larry>ilisp>medley>sources>ADISPLAY.LCOM;1
compiled on 28-Jan-98 10:53:47
File created 15-Sep-94 17:07:04
ADISPLAYCOMS
loading HLDISPLAY

{DSK}<home>larry>ilisp>medley>sources>HLDISPLAY.LCOM;1
compiled on 25-Jan-98 14:12:43
File created 15-Mar-94 10:48:02
loading MENU

{DSK}<home>larry>ilisp>medley>sources>MENU.LCOM;1
compiled on 16-Jul-99 15:51:41
File created 16-Jul-99 15:51:36
MENUCOMS
loading WINDOWOBJ

{DSK}<home>larry>ilisp>medley>sources>WINDOWOBJ.LCOM;1
compiled on 26-Jan-98 13:55:38
File created 19-Jan-93 11:26:14
WINDOWOBJCOMS
loading WINDOWSCROLL

{DSK}<home>larry>ilisp>medley>sources>WINDOWSCROLL.LCOM;1
compiled on 17-Feb-2021 13:49:06
File created 17-Feb-2021 13:49:06
WINDOWSCROLLCOMS
loading WINDOW

{DSK}<home>larry>ilisp>medley>sources>WINDOW.LCOM;1
compiled on  9-Apr-2000 17:38:50
File created  9-Apr-2000 17:36:29

{DSK}<home>larry>ilisp>medley>sources>PAINTW.LCOM;1
compiled on 16-Jul-99 15:49:39
File created 16-Jul-99 15:49:37
loading WINDOWICON

{DSK}<home>larry>ilisp>medley>sources>WINDOWICON.LCOM;1
compiled on 26-Jan-98 13:55:34
File created  2-Feb-94 13:26:29
WINDOWICONCOMS
loading PAINTW
loading ATTACHEDWINDOW

{DSK}<home>larry>ilisp>medley>sources>ATTACHEDWINDOW.LCOM;1
compiled on 28-Jun-99 17:18:53
File created 28-Jun-99 17:18:50
ATTACHEDWINDOWCOMS
loading XXGEOM

{DSK}<home>larry>ilisp>medley>sources>XXGEOM.LCOM;1
compiled on 26-Jan-98 14:03:05
File created 19-Jan-93 11:30:54
XXGEOMCOMS
loading XXFILL

{DSK}<home>larry>ilisp>medley>sources>XXFILL.LCOM;3
compiled on 26-Jan-98 14:02:40
File created 19-Jan-93 11:29:57
XXFILLCOMS
loading DEXEC

{DSK}<home>larry>ilisp>medley>sources>DEXEC.LCOM;12
compiled on 13-Aug-2020 12:36:18
File created 13-Aug-2020 12:36:18
loading INSPECT

{DSK}<home>larry>ilisp>medley>sources>INSPECT.LCOM;7
compiled on 21-Apr-2018 08:08:07
File created 21-Apr-2018 08:08:07
INSPECTCOMS
loading DESCRIBE

{DSK}<home>larry>ilisp>medley>sources>DESCRIBE.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>DESCRIBE.;1
Source file created Wednesday, 16 May 1990, 15:27:33.
FASL file created Sunday, 25 January 1998, 12:32:53.

loading CMLARRAYINSPECTOR

{DSK}<home>larry>ilisp>medley>sources>CMLARRAYINSPECTOR.LCOM;1
compiled on 25-Jan-98 09:53:09
File created 31-Dec-93 12:26:35
CMLARRAYINSPECTORCOMS

{DSK}<home>larry>ilisp>medley>sources>TWODINSPECTOR.LCOM;2
compiled on 19-Feb-2021 14:31:33
File created 19-Feb-2021 14:31:33
TWODINSPECTORCOMS

{DSK}<home>larry>ilisp>medley>sources>FREEMENU.LCOM;1
compiled on 25-Jan-98 13:54:38
File created  6-Dec-94 10:55:40
loading EDITINTERFACE

{DSK}<home>larry>ilisp>medley>sources>EDITINTERFACE.LCOM;1
compiled on 25-Jan-98 13:12:33
File created  7-Nov-91 18:15:13
loading TTYIN

{DSK}<home>larry>ilisp>medley>sources>TTYIN.LCOM;1
compiled on 26-Jan-98 13:49:55
File created 24-May-91 11:33:53
TTYINCOMS
loading BREAK-AND-TRACE

{DSK}<home>larry>ilisp>medley>sources>BREAK-AND-TRACE.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>BREAK-AND-TRACE.;1
Source file created Wednesday, 16 May 1990, 12:01:43.
FASL file created Sunday, 25 January 1998, 9:14:16.

loading FASDUMP

{DSK}<home>larry>ilisp>medley>sources>FASDUMP.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>FASDUMP.;1
Source file created Friday, 11 January 1991, 16:23:30.
FASL file created Sunday, 25 January 1998, 13:18:44.

loading XCL-COMPILER

{DSK}<home>larry>ilisp>medley>sources>XCL-COMPILER.LCOM;1
compiled on 26-Jan-98 13:56:11
File created 18-May-90 01:13:35
XCL-COMPILERCOMS

{DSK}<home>larry>ilisp>medley>sources>XCLC-ENV-CTXT.LCOM;1
compiled on 26-Jan-98 13:58:55
File created 17-Jul-90 10:48:08

{DSK}<home>larry>ilisp>medley>sources>XCLC-TREES.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>XCLC-TREES.;1
Source file created Wednesday, 23 May 1990, 13:17:15.
FASL file created Monday, 26 January 1998, 14:01:24.


{DSK}<home>larry>ilisp>medley>sources>XCLC-TOP-LEVEL.DFASL;9
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;10
Source file created 19-Sep-2020 22:02:59
FASL file created Saturday, 19 September 2020, 22:02:59


{DSK}<home>larry>ilisp>medley>sources>XCLC-ALPHA.LCOM;1
compiled on 26-Jan-98 13:56:23
File created 20-Jul-90 17:07:06

{DSK}<home>larry>ilisp>medley>sources>XCLC-OPTIMIZERS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>XCLC-OPTIMIZERS.;1
Source file created Sunday, 3 June 1990, 22:30:55.
FASL file created Monday, 26 January 1998, 14:00:16.


{DSK}<home>larry>ilisp>medley>sources>XCLC-ANALYZE.LCOM;1
compiled on 26-Jan-98 13:57:17
File created 18-May-90 01:25:52

{DSK}<home>larry>ilisp>medley>sources>XCLC-META-EVAL.LCOM;1
compiled on 26-Jan-98 13:59:42
File created  9-Dec-91 03:12:25

{DSK}<home>larry>ilisp>medley>sources>XCLC-TRANSFORMS.LCOM;1
compiled on 26-Jan-98 14:01:16
File created 10-Aug-92 13:17:53

{DSK}<home>larry>ilisp>medley>sources>XCLC-DATABASE.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>XCLC-DATABASE.;1
Source file created Tuesday, 19 January 1993, 11:26:11.
FASL file created Monday, 26 January 1998, 13:58:14.


{DSK}<home>larry>ilisp>medley>sources>XCLC-ANNOTATE.LCOM;1
compiled on 26-Jan-98 13:57:27
File created 18-May-90 01:28:45

{DSK}<home>larry>ilisp>medley>sources>XCLC-GENCODE.LCOM;1
compiled on 26-Jan-98 13:59:08
File created  2-Oct-91 11:38:50

{DSK}<home>larry>ilisp>medley>sources>XCLC-PEEPHOLE.LCOM;1
compiled on 26-Jan-98 14:00:34
File created 27-Aug-91 14:38:23
loading ADVISE

{DSK}<home>larry>ilisp>medley>sources>ADVISE.dfasl;4
XCL Compiler output for source file {DSK}<lispcore>sources>ADVISE.;1
Source file created Wednesday, 16 May 1990, 11:45:00.
FASL file created Sunday, 25 January 1998, 8:20:23.

loading DLAP

{DSK}<home>larry>ilisp>medley>sources>DLAP.LCOM;1
compiled on 31-Jan-98 10:01:22
File created 25-Jan-93 16:56:13
loading BYTECOMPILER

{DSK}<home>larry>ilisp>medley>sources>BYTECOMPILER.LCOM;1
compiled on 25-Jan-98 09:21:09
File created 26-Apr-91 17:25:53
loading COMPILE

{DSK}<home>larry>ilisp>medley>sources>COMPILE.LCOM;1
compiled on 25-Jan-98 11:41:58
File created 27-Jul-90 11:15:42
COMPILECOMS
loading HARDCOPY

{DSK}<home>larry>ilisp>medley>sources>HARDCOPY.LCOM;6
compiled on 16-Apr-2018 22:15:08
File created 16-Apr-2018 22:15:08
HARDCOPYCOMS
loading LOGOW

{DSK}<home>larry>ilisp>medley>sources>LOGOW.DFASL;1
XCL Compiler output for source file {DSK}<tilde>sybalsky>lispcore>sources>LOGOW.;2
Source file created Sunday, 9 April 2000, 18:08:24.
FASL file created Sunday, 9 April 2000, 18:08:25.

loading IDLER

{DSK}<home>larry>ilisp>medley>sources>IDLER.LCOM;1
compiled on 25-Jan-98 14:24:39
File created 23-Mar-92 13:38:29
IDLERCOMS
loading ICONW

{DSK}<home>larry>ilisp>medley>sources>ICONW.LCOM;1
compiled on 25-Jan-98 14:23:21
File created 16-May-90 18:16:27
ICONWCOMS
loading FREEMENU
loading SEDIT

{DSK}<home>larry>ilisp>medley>sources>SEDIT.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT.;1
Source file created Friday, 25 January 1991, 17:01:33.
FASL file created Monday, 26 January 1998, 13:30:21.


{DSK}<home>larry>ilisp>medley>sources>SEDIT-ACCESS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-ACCESS.;1
Source file created Tuesday, 19 January 1993, 11:16:06.
FASL file created Monday, 26 January 1998, 13:30:23.


{DSK}<home>larry>ilisp>medley>sources>SEDIT-ATOMIC.DFASL;2
XCL Compiler output for source file {DSK}<usr>local>lde>lispcore>sources>SEDIT-ATOMIC.;3
Source file created 16-May-90 21:37:57
FASL file created Sunday, 20 September 2020, 21:00:28


{DSK}<home>larry>ilisp>medley>sources>SEDIT-BASE.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-BASE.;1
Source file created Wednesday, 2 December 1992, 17:40:24.
FASL file created Monday, 26 January 1998, 13:31:04.


{DSK}<home>larry>ilisp>medley>sources>SEDIT-COMMANDS.DFASL;3
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-COMMANDS.;3
Source file created Monday, 23 April 2018, 18:12:52.
FASL file created Monday, 23 April 2018, 18:13:51.


{DSK}<home>larry>ilisp>medley>sources>SEDIT-COMMENTS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-COMMENTS.;1
Source file created Wednesday, 16 May 1990, 21:35:01.
FASL file created Monday, 26 January 1998, 13:32:56.


{DSK}<home>larry>ilisp>medley>sources>SEDIT-EXPORTS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-EXPORTS.;1
Source file created Thursday, 17 May 1990, 10:49:21.
FASL file created Monday, 26 January 1998, 13:33:33.


{DSK}<home>larry>ilisp>medley>sources>SEDIT-INDENT.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-INDENT.;1
Source file created Thursday, 17 May 1990, 10:52:22.
FASL file created Monday, 26 January 1998, 13:33:37.


{DSK}<home>larry>ilisp>medley>sources>SEDIT-LIST-FORMATS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-LIST-FORMATS.;1
Source file created Thursday, 17 May 1990, 10:56:07.
FASL file created Monday, 26 January 1998, 13:34:54.


{DSK}<home>larry>ilisp>medley>sources>SEDIT-LINEAR.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-LINEAR.;1
Source file created Thursday, 17 May 1990, 10:54:05.
FASL file created Monday, 26 January 1998, 13:33:51.


{DSK}<home>larry>ilisp>medley>sources>SEDIT-LISTS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-LISTS.;1
Source file created Thursday, 17 May 1990, 10:58:06.
FASL file created Monday, 26 January 1998, 13:35:03.


{DSK}<home>larry>ilisp>medley>sources>SEDIT-TERMINAL.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-TERMINAL.;1
Source file created Thursday, 17 May 1990, 10:59:38.
FASL file created Monday, 26 January 1998, 13:35:55.


{DSK}<home>larry>ilisp>medley>sources>SEDIT-TOPLEVEL.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-TOPLEVEL.;1
Source file created Wednesday, 10 July 1991, 19:03:29.
FASL file created Monday, 26 January 1998, 13:36:04.


{DSK}<home>larry>ilisp>medley>sources>SEDIT-WINDOW.DFASL;2
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;2
Source file created Monday, 14 May 2018, 14:12:02.
FASL file created Monday, 14 May 2018, 14:12:02.

loading DSK
loading UFS
loading UFSCALLC
loading MAIKOBITBLT
loading TIME

{DSK}<home>larry>ilisp>medley>sources>TIME.LCOM;4
compiled on 16-Apr-2018 23:05:17
File created 16-Apr-2018 23:05:10
loading BRKDWN

{DSK}<home>larry>ilisp>medley>sources>BRKDWN.LCOM;1
compiled on 25-Jan-98 09:16:08
File created 16-May-90 12:14:36
BRKDWNCOMS
loading XCL-EXTRAS

{DSK}<home>larry>ilisp>medley>sources>XCL-EXTRAS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>XCL-EXTRAS.;1
Source file created Friday, 18 May 1990, 1:03:51.
FASL file created Monday, 26 January 1998, 13:56:12.

loading CMLPACKAGE

{DSK}<home>larry>ilisp>medley>sources>CMLPACKAGE.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>CMLPACKAGE.;1
Source file created Thursday, 14 June 1990, 1:35:57.
FASL file created Sunday, 25 January 1998, 10:25:22.

loading CMLSMARTARGS

{DSK}<home>larry>ilisp>medley>sources>CMLSMARTARGS.DFASL;1
XCL Compiler output for source file {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>CMLSMARTARGS.;2
Source file created Tuesday, 27 January 1998, 10:56:02.
FASL file created Tuesday, 27 January 1998, 10:58:59.

loading IMPLICIT-KEY-HASH

{DSK}<home>larry>ilisp>medley>sources>IMPLICIT-KEY-HASH.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>IMPLICIT-KEY-HASH.;1
Source file created Wednesday, 16 May 1990, 18:10:26.
FASL file created Sunday, 25 January 1998, 14:31:31.

loading CLOSURE-CACHE

{DSK}<home>larry>ilisp>medley>sources>CLOSURE-CACHE.DFASL;1
XCL Compiler output for source file {DSK}<lispcore>sources>CLOSURE-CACHE.;1
Source file created Wednesday, 16 May 1990, 12:24:08.
FASL file created Sunday, 25 January 1998, 9:35:47.

\ No newline at end of file
diff --git a/loadups/lisp.sysout b/loadups/lisp.sysout
index 09ae517c..49a0701b 100644
Binary files a/loadups/lisp.sysout and b/loadups/lisp.sysout differ
diff --git a/loadups/whereis.dribble b/loadups/whereis.dribble
index 8331167d..dca93c14 100644
--- a/loadups/whereis.dribble
+++ b/loadups/whereis.dribble
@@ -1,786 +1,784 @@
-;;; {DSK}<home>larry>ilisp>med>sources>10MBDECLS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>10MBDRIVER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>AARITH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>ABASIC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>ACODE.;6 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>ADDARITH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>ADIR.;8 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>ADISPLAY.;7 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>ADVISE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>AERROR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>AFONT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>AINTERRUPT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>AOFD.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>APRINT.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>APUTDQ.;5 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>ARGLIST.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>ASKUSER.;6 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>ASTACK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>ATBL.;8 .
-Warning: Error attempting to LOADVARS (IL:CCECHOMODES IL:TERMCLASSES IL:READCODEMASKS IL:READMACROCONTEXTS IL:READCLASSES IL:READMACROWAKEUPS IL:READMACROESCAPES) from {DSK}<home>larry>ilisp>med>sources>ATBL.;8.
+;;; {DSK}<home>larry>ilisp>medley>sources>10MBDECLS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>10MBDRIVER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>AARITH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>ABASIC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>ACODE.;7 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>ADDARITH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>ADIR.;30 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>ADISPLAY.;7 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>ADVISE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>AERROR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>AFONT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>AINTERRUPT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>AOFD.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>APRINT.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>APUTDQ.;6 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>ARGLIST.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>ASKUSER.;6 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>ASTACK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>ATBL.;8 .
+Warning: Error attempting to LOADVARS (IL:CCECHOMODES IL:TERMCLASSES IL:READCODEMASKS IL:READMACROCONTEXTS IL:READCLASSES IL:READMACROWAKEUPS IL:READMACROESCAPES) from {DSK}<home>larry>ilisp>medley>sources>ATBL.;8.
 .. done.
-;;; {DSK}<home>larry>ilisp>med>sources>ATERM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>ATTACHEDWINDOW.;3 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>AUTHENTICATION.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>BOOTSTRAP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>BREAK-AND-TRACE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>BRKDWN.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>BSP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>BYTECOMPILER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CL-ERROR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CLEARINGHOUSE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CLISP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CLISPIFY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CLOSURE-CACHE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CLSTREAMS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLARITH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLARRAY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLARRAY-SUPPORT.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLARRAYINSPECTOR.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLCHARACTER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLCOMPILE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLDEFFER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLDESTRUCT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLDOC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLENVIRONMENT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLEVAL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLEXEC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLFILESYS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLFLOAT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLFORMAT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLHASH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLLIST.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLLOAD.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLMACROS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLMISCIO.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLMODULES.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLMVS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLPACKAGE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLPARSE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLPATHNAME.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLPRED.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLPRINT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLPROGV.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLRAND.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLREAD.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLREADTABLE.;4 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLSEQ.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLSEQBASICS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLSEQCOMMON.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLSEQFINDER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLSEQMAPPERS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLSEQMODIFY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLSETF.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLSMARTARGS.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLSORT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLSPECIALFORMS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLSTEP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLSTRING.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLSYMBOL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLTIME.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLTYPES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLUNDO.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CMLWALK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>COMMENT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>COMMON.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>COMPARE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>COMPATIBILITY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>COMPILE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>COMPILER-PACKAGE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CONDITION-HIERARCHY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CONDITION-HIERARCHY-IL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CONDITION-HIERARCHY-POST-SI.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CONDITION-HIERARCHY-SI.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>CONDITION-PACKAGE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>COREIO.;4 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>COROUTINE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>COURIER.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>D-ASSEM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>D-ASSEM-PACKAGE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DEBUGEDIT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DEBUGGER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DEFFER-RUNTIME.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DEFPACKAGE-IMPORT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DEFSTRUCT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DEFSTRUCT-RUN-TIME.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DESCRIBE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DEXEC.;10 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DFILE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DIRECTORY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DISKDLION.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DISKVMEMDECLS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DLAP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DMISC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DPUPFTP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DSK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DSKDISPLAY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DSPRINTDEF.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DTDECLARE.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DWIM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>DWIMIFY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>EDIT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>EDITINTERFACE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>ERROR-RUNTIME.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>ERROR-RUNTIME-AFTER-FASL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>EXEC-COMMANDS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>FASDUMP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>FASL-PACKAGE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>FASL-SUPPORT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>FASLOAD.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>FILEIO.;10 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>FILEPKG.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>FILESETS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>FONT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>FONTPROFILE.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>FONTPROFILEPATCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>FREEMENU.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>GAINSPACE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>HARDCOPY.;6 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>HIST.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>HLDISPLAY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>HPRINT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>ICONW.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>IDLER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>IL-ERROR-STUFF.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>IMAGEIO.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>IMPLICIT-KEY-HASH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>INSPECT.;7 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>INSPECT-CLOSURE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>INTERPRESS.;6 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>IOCHAR.;5 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LEAF.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LISP-PACKAGE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLARITH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLARRAYELT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLBASIC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLBFS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLBIGNUM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLCHAR.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLCODE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLDATATYPE.;12 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLDISPLAY.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLERROR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLETHER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLFAULT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLFLOAT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLGC.;3 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLINTERP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLKEY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLMVS.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLNEW.;15 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLNS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLNSDECLS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLPACKAGE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLPARAMS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLREAD.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLRESTART.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLSTK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLSUBRS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLSYMBOL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LLTIMER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LOADFNS.;7 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LOADUP-FULL.;10 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LOADUP-LISP.;3 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LOCALFILE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>LOGOW.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>MACHINEINDEPENDENT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>MACROAUX.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>MACROAUX-OPTIMIZERS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>MACROS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>MAIKOBITBLT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>MAIKOETHER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>MAIKOINIT.;1 .Warning: Error attempting to LOADVARS (IL:MAIKOINITCOMS) from {DSK}<home>larry>ilisp>med>sources>MAIKOINIT.;1.
-;;; {DSK}<home>larry>ilisp>med>sources>MAIKOLOADUPFNS.;3 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>MAKEINIT.;3 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>MAPATOMS.;3 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>MEM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>MENU.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>MISC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>MOD44IO.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>MODARITH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>NEWPRINTDEF.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>NSFILING.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>NSPRINT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>PACKAGE-CONVERSION-TABLE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>PACKAGE-STARTUP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>PAINTW.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>PASSWORDS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>PMAP.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>POSTLOADUP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>PRETTY.;7 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>PRINTFN.;4 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>PROC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>PROFILE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>PUP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>READSYS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>RECORD.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>RENAMEFNS.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>RENAMEMACROS.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>RESOURCE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-ACCESS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-ATOMIC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-BASE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-COMMANDS.;3 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-COMMENTS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-CONVERT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-DEBUG.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-DECLS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-EXPORTS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-INDENT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-LINEAR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-LIST-FORMATS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-LISTS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-TERMINAL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-TOPLEVEL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SEDIT-WINDOW.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SETF-RUNTIME.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SPELL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SPELLFILE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SPP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SPPDECLS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>STACKFNS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>SYSPRETTY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>TIME.;3 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>TRSERVER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>TTYIN.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>TWODINSPECTOR.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>UFS.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>UFSCALLC.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>UNDO.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>UNWINDMACROS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>VANILLADISK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>VMEM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>WALKER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>WEDIT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>WINDOW.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>WINDOWICON.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>WINDOWOBJ.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>WINDOWSCROLL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>WRAPPERS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>WTFIX.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCL-COMPILER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCL-EXTRAS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCL-PACKAGE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCLC-ALPHA.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCLC-ANALYZE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCLC-ANNOTATE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCLC-DATABASE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCLC-ENV-CTXT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCLC-GENCODE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCLC-META-EVAL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCLC-OPTIMIZERS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCLC-PEEPHOLE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCLC-RUNTIME.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCLC-TOP-LEVEL.;10 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCLC-TRANSFORMS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XCLC-TREES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XXFILL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>sources>XXGEOM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>BIGBITMAPS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>BROWSER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>CASH-FILE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>CHARCODETABLES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>CHARDEVICE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>CHARS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>CHAT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>CHATDECLS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>CHATSERVER-EMACS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>CHATTERMINAL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>CLIPBOARD.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>CMLFLOATARRAY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>COLOR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>COPYFILES.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>DANDELIONKEYBOARDS.;3 .Warning: Error attempting to LOADVARS (IL:DANDELIONKEYBOARDSCOMS) from {DSK}<home>larry>ilisp>med>library>DANDELIONKEYBOARDS.;3.
-;;; {DSK}<home>larry>ilisp>med>library>DATABASEFNS.;3 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>DEDIT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>DEDITPP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>DES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>DMCHAT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>DORADOKEYBOARDS.;3 .Warning: Error attempting to LOADVARS (IL:DORADOKEYBOARDSCOMS) from {DSK}<home>larry>ilisp>med>library>DORADOKEYBOARDS.;3.
-;;; {DSK}<home>larry>ilisp>med>library>DOSPRINT.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>DOVEKEYBOARDS.;3 .Warning: Error attempting to LOADVARS (IL:DOVEKEYBOARDSCOMS) from {DSK}<home>larry>ilisp>med>library>DOVEKEYBOARDS.;3.
-;;; {DSK}<home>larry>ilisp>med>library>DOVERS232C.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>EDITBITMAP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>ETHERRECORDS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>FILE-UPDATE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>FILEBROWSER.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>FONTSAMPLE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>FOREIGN-FUNCTIONS.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>FX-80DRIVER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>GCHAX.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>GRAPHER.;4 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>GRAPHZOOM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>HASH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>HASH-FILE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>HRULE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>IMAGEOBJ.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>KEYBOARDCONFIGS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>KEYBOARDEDITOR.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>lafite> .Warning: Error attempting to LOADVARS (IL:NILCOMS) from {DSK}<home>larry>ilisp>med>library>lafite>.
-;;; {DSK}<home>larry>ilisp>med>library>LLCOLOR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>LOAD-SKETCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>MAIKOCOLOR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>MAIKOKEYBOARDS.;3 .Warning: Error attempting to LOADVARS (IL:MAIKOKEYBOARDSCOMS) from {DSK}<home>larry>ilisp>med>library>MAIKOKEYBOARDS.;3.
-;;; {DSK}<home>larry>ilisp>med>library>MASTERSCOPE.;5 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>MATCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>MATMULT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>MSANALYZE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>MSCOMMON.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>MSPARSE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>new> .Warning: Error attempting to LOADVARS (IL:NILCOMS) from {DSK}<home>larry>ilisp>med>library>new>.
-;;; {DSK}<home>larry>ilisp>med>library>NSCHAT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>NSMAINTAIN.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>patches> .Warning: Error attempting to LOADVARS (IL:NILCOMS) from {DSK}<home>larry>ilisp>med>library>patches>.
-;;; {DSK}<home>larry>ilisp>med>library>PCTREE.;4 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>POSTSCRIPTSTREAM.;3 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>PRESS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>RDSYS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>READNUMBER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>REMOTEVMEM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>SAMEDIR.;10 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>SCALEBITMAP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>SEDIT-COMMONLISP.;2 .Warning: Error attempting to LOADVARS (IL:SEDIT-COMMONLISPCOMS) from {DSK}<home>larry>ilisp>med>library>SEDIT-COMMONLISP.;2.
-;;; {DSK}<home>larry>ilisp>med>library>SKETCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>SKETCHBMELT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>SKETCHEDIT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>SKETCHELEMENTS.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>SKETCHOBJ.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>SKETCHOPS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>SKETCHSTREAM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>SPY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>SYSEDIT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TABLEBROWSER.;3 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TABLEBROWSERDECLS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TBDECLS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDIT.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDITABBREV.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDITCHAT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDITCOMMAND.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDITDCL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDITFILE.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDITFIND.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDITFNKEYS.;4 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDITHCPY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDITHISTORY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDITLOOKS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDITMENU.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDITPAGE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDITSCREEN.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDITSELECTION.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEDITWINDOW.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TELERAID.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEXEC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TEXTMODULES.;1 .
-{DSK}<home>larry>ilisp>med>library>SEDIT-COMMONLISP.DFASL;2
+;;; {DSK}<home>larry>ilisp>medley>sources>ATERM.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>ATTACHEDWINDOW.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>AUTHENTICATION.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>BOOTSTRAP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>BREAK-AND-TRACE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>BRKDWN.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>BSP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>BYTECOMPILER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CL-ERROR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CLEARINGHOUSE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CLISP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CLISPIFY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CLOSURE-CACHE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CLSTREAMS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLARITH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLARRAY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLARRAY-SUPPORT.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLARRAYINSPECTOR.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLCHARACTER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLCOMPILE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLDEFFER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLDESTRUCT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLDOC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLENVIRONMENT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLEVAL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLEXEC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLFILESYS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLFLOAT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLFORMAT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLHASH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLLIST.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLLOAD.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLMACROS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLMISCIO.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLMODULES.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLMVS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLPACKAGE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLPARSE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLPATHNAME.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLPRED.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLPRINT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLPROGV.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLRAND.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLREAD.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLREADTABLE.;4 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLSEQ.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLSEQBASICS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLSEQCOMMON.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLSEQFINDER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLSEQMAPPERS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLSEQMODIFY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLSETF.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLSMARTARGS.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLSORT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLSPECIALFORMS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLSTEP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLSTRING.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLSYMBOL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLTIME.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLTYPES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLUNDO.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CMLWALK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>COMMENT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>COMMON.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>COMPARE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>COMPATIBILITY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>COMPILE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>COMPILER-PACKAGE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CONDITION-HIERARCHY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CONDITION-HIERARCHY-IL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CONDITION-HIERARCHY-POST-SI.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CONDITION-HIERARCHY-SI.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>CONDITION-PACKAGE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>COREIO.;4 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>COROUTINE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>COURIER.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>D-ASSEM.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>D-ASSEM-PACKAGE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DEBUGEDIT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DEBUGGER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DEFFER-RUNTIME.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DEFPACKAGE-IMPORT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DEFSTRUCT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DEFSTRUCT-RUN-TIME.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DESCRIBE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DEXEC.;10 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DFILE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DIRECTORY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DISKDLION.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DISKVMEMDECLS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DLAP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DMISC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DPUPFTP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DSK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DSKDISPLAY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DSPRINTDEF.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DTDECLARE.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DWIM.;10 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>DWIMIFY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>EDIT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>EDITINTERFACE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>ERROR-RUNTIME.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>ERROR-RUNTIME-AFTER-FASL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>EXEC-COMMANDS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>FASDUMP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>FASL-PACKAGE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>FASL-SUPPORT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>FASLOAD.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>FILEIO.;10 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>FILEPKG.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>FILESETS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>FONT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>FONTPROFILE.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>FONTPROFILEPATCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>FREEMENU.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>GAINSPACE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>HARDCOPY.;6 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>HIST.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>HLDISPLAY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>HPRINT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>ICONW.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>IDLER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>IL-ERROR-STUFF.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>IMAGEIO.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>IMPLICIT-KEY-HASH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>INSPECT.;7 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>INSPECT-CLOSURE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>INTERPRESS.;6 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>IOCHAR.;5 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LEAF.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LISP-PACKAGE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLARITH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLARRAYELT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLBASIC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLBFS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLBIGNUM.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLCHAR.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLCODE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLDATATYPE.;12 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLDISPLAY.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLERROR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLETHER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLFAULT.;10 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLFLOAT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLGC.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLINTERP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLKEY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLMVS.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLNEW.;15 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLNS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLNSDECLS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLPACKAGE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLPARAMS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLREAD.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLRESTART.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLSTK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLSUBRS.;7 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLSYMBOL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LLTIMER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LOADFNS.;7 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LOADUP-FULL.;10 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LOADUP-LISP.;7 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LOCALFILE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>LOGOW.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>MACHINEINDEPENDENT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>MACROAUX.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>MACROAUX-OPTIMIZERS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>MACROS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>MAIKOBITBLT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>MAIKOETHER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>MAIKOINIT.;1 .Warning: Error attempting to LOADVARS (IL:MAIKOINITCOMS) from {DSK}<home>larry>ilisp>medley>sources>MAIKOINIT.;1.
+;;; {DSK}<home>larry>ilisp>medley>sources>MAIKOLOADUPFNS.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>MAKEINIT.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>MAPATOMS.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>MEM.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>MENU.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>MISC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>MOD44IO.;4 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>MODARITH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>NEWPRINTDEF.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>NSFILING.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>NSPRINT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>PACKAGE-CONVERSION-TABLE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>PACKAGE-STARTUP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>PAINTW.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>PASSWORDS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>PMAP.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>POSTLOADUP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>PRETTY.;7 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>PRINTFN.;4 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>PROC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>PROFILE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>PUP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>READSYS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>RECORD.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>RENAMEFNS.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>RENAMEMACROS.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>RESOURCE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-ACCESS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-ATOMIC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-BASE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-COMMANDS.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-COMMENTS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-CONVERT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-DEBUG.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-DECLS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-EXPORTS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-INDENT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-LINEAR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-LIST-FORMATS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-LISTS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-TERMINAL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-TOPLEVEL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SEDIT-WINDOW.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SETF-RUNTIME.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SPELL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SPELLFILE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SPP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SPPDECLS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>STACKFNS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>SYSPRETTY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>TIME.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>TRSERVER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>TTYIN.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>TWODINSPECTOR.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>UFS.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>UFSCALLC.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>UNDO.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>UNWINDMACROS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>VANILLADISK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>VMEM.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>WALKER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>WEDIT.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>WINDOW.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>WINDOWICON.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>WINDOWOBJ.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>WINDOWSCROLL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>WRAPPERS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>WTFIX.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCL-COMPILER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCL-EXTRAS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCL-PACKAGE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCLC-ALPHA.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCLC-ANALYZE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCLC-ANNOTATE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCLC-DATABASE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCLC-ENV-CTXT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCLC-GENCODE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCLC-META-EVAL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCLC-OPTIMIZERS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCLC-PEEPHOLE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCLC-RUNTIME.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCLC-TOP-LEVEL.;10 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCLC-TRANSFORMS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XCLC-TREES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XXFILL.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>sources>XXGEOM.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>BIGBITMAPS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>BROWSER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>CASH-FILE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>CHARCODETABLES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>CHARDEVICE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>CHARS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>CHAT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>CHATDECLS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>CHATSERVER-EMACS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>CHATTERMINAL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>CLIPBOARD.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>CMLFLOATARRAY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>COLOR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>COPYFILES.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>DANDELIONKEYBOARDS.;3 .Warning: Error attempting to LOADVARS (IL:DANDELIONKEYBOARDSCOMS) from {DSK}<home>larry>ilisp>medley>library>DANDELIONKEYBOARDS.;3.
+;;; {DSK}<home>larry>ilisp>medley>library>DATABASEFNS.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>DEDIT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>DEDITPP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>DES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>DMCHAT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>DORADOKEYBOARDS.;3 .Warning: Error attempting to LOADVARS (IL:DORADOKEYBOARDSCOMS) from {DSK}<home>larry>ilisp>medley>library>DORADOKEYBOARDS.;3.
+;;; {DSK}<home>larry>ilisp>medley>library>DOSPRINT.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>DOVEKEYBOARDS.;3 .Warning: Error attempting to LOADVARS (IL:DOVEKEYBOARDSCOMS) from {DSK}<home>larry>ilisp>medley>library>DOVEKEYBOARDS.;3.
+;;; {DSK}<home>larry>ilisp>medley>library>DOVERS232C.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>EDITBITMAP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>ETHERRECORDS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>FILE-UPDATE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>FILEBROWSER.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>FONTSAMPLE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>FOREIGN-FUNCTIONS.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>FX-80DRIVER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>GCHAX.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>GRAPHER.;4 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>GRAPHZOOM.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>HASH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>HASH-FILE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>HRULE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>IMAGEOBJ.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>KEYBOARDCONFIGS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>KEYBOARDEDITOR.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>lafite> .Warning: Error attempting to LOADVARS (IL:NILCOMS) from {DSK}<home>larry>ilisp>medley>library>lafite>.
+;;; {DSK}<home>larry>ilisp>medley>library>LLCOLOR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>LOAD-SKETCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>MAIKOCOLOR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>MAIKOKEYBOARDS.;3 .Warning: Error attempting to LOADVARS (IL:MAIKOKEYBOARDSCOMS) from {DSK}<home>larry>ilisp>medley>library>MAIKOKEYBOARDS.;3.
+;;; {DSK}<home>larry>ilisp>medley>library>MASTERSCOPE.;5 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>MATCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>MATMULT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>MSANALYZE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>MSCOMMON.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>MSPARSE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>NSCHAT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>NSMAINTAIN.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>patches> .Warning: Error attempting to LOADVARS (IL:NILCOMS) from {DSK}<home>larry>ilisp>medley>library>patches>.
+;;; {DSK}<home>larry>ilisp>medley>library>PCTREE.;4 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>POSTSCRIPTSTREAM.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>PRESS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>RDSYS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>READNUMBER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>REMOTEVMEM.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>SAMEDIR.;10 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>SCALEBITMAP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>SEDIT-COMMONLISP.;2 .Warning: Error attempting to LOADVARS (IL:SEDIT-COMMONLISPCOMS) from {DSK}<home>larry>ilisp>medley>library>SEDIT-COMMONLISP.;2.
+;;; {DSK}<home>larry>ilisp>medley>library>SKETCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>SKETCHBMELT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>SKETCHEDIT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>SKETCHELEMENTS.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>SKETCHOBJ.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>SKETCHOPS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>SKETCHSTREAM.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>SPY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>SYSEDIT.;8 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TABLEBROWSER.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TABLEBROWSERDECLS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TBDECLS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDIT.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDITABBREV.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDITCHAT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDITCOMMAND.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDITDCL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDITFILE.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDITFIND.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDITFNKEYS.;4 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDITHCPY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDITHISTORY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDITLOOKS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDITMENU.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDITPAGE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDITSCREEN.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDITSELECTION.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEDITWINDOW.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TELERAID.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEXEC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TEXTMODULES.;1 .
+{DSK}<home>larry>ilisp>medley>library>SEDIT-COMMONLISP.DFASL;2
 XCL Compiler output for source file {DSK}<home>larry>ilisp>medley>SEDIT-COMMONLISP.;1
 Source file created  4-Jan-2021 22:52:01
 FASL file created Monday, 4 January 2021, 22:52:13
 
 
-{DSK}<home>larry>ilisp>med>library>TEXTMODULES.DFASL;1
+{DSK}<home>larry>ilisp>medley>library>TEXTMODULES.DFASL;1
 XCL Compiler output for source file {DSK}<king>export>lispcore>library>TEXTMODULES.;1
 Source file created Wednesday, 16 January 1991, 9:07:18.
 FASL file created Tuesday, 12 July 1994, 12:31:02.
 
 .. done.
-;;; {DSK}<home>larry>ilisp>med>library>TEXTOFD.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TFBRAVO.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>TTYCHAT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>UNICODE.;167 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>UNIXCHAT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>UNIXCOMM.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>UNIXPRINT.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>UNIXTELNET.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>VIRTUALKEYBOARDS.;9 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>VT100KP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>VTCHAT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>WHERE-IS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>library>XCCS.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>ACCESS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>ACE> .Warning: Error attempting to LOADVARS (IL:NILCOMS) from {DSK}<home>larry>ilisp>med>lispusers>ACE>.
-;;; {DSK}<home>larry>ilisp>med>lispusers>ADDRESSBOOK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>AIREGIONS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>AIREGIONS-DEMO.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>AISBLT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>ANALYZER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>ARCHIVEBROWSER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>ARCHIVETOOL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>ARMODES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>autosamedir.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>AUXMENU.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>BACKGROUNDIMAGES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>BACKGROUNDMENU.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>BICLOCK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>BIGGER-FONT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>BITMAP-GALLERY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>bitmapfns.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>BLACKBOX.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>BLOCKS-HKB.;1 .Warning: Couldn't find IL:BLOCKS-HKBCOMS on {DSK}<home>larry>ilisp>med>lispusers>BLOCKS-HKB.;1.
-;;; {DSK}<home>larry>ilisp>med>lispusers>BMENCODE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>BOYERMOORE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>BRKDWNREPORT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>bsearch.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>BUTTONS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>C150STREAM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>CALENDAR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>canvasconverter.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>CD.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>CHATEMACS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>CHATSERVER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>CHATSERVER-NS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>CHATSERVER-RS232.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>CHATSERVER-TCP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>checkset.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>circlprint.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>CL-TTYEDIT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COLOR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COLORDEMO.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COLORNNCC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COLOROBJ.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COLORPOLYGONS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COMMENTHACKS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COMMON-MAKE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COMMWINDOW.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COMPARE-PATHS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COMPAREDIRECTORIES.;275 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COMPARESOURCES.;3 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>comparetext.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>compilebang.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COURIERDEFS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COURIEREVALSERVE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COURIERIMAGESTREAM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COURIERSERVE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>COURIERSERVEPATCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>CROCK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DANDELIONUFO.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DANDELIONUFO4096.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DATATYPESPLUS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DATE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DATEFNS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DATEFORMAT-EDITOR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DATESORT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DEBUGGER-CONTEXT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DECL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DEDITHARDCOPY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DEFAULTICON.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DEFAULTSUBITEMFN.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DEFINERPRINT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DIALPHONE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DICOLOR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DICT-WINDOW-TYPES.;1 .Warning: Error attempting to LOADVARS (IL:DICT-WINDOW-TYPESCOMS) from {DSK}<home>larry>ilisp>med>lispusers>DICT-WINDOW-TYPES.;1.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DICTTOOL.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DIGEST.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DIGI-CLOCK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DINFO.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DIRGRAPHER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DLIONFNKEYS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DOC-OBJECTS.;7 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>document.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>donz.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DORADOCOLOR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DPUPFTPPATCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DSPSCALE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>dumper.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>DUMPLOAD.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>EDITBG.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>EDITFONT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>EDITKEYS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>EMACS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>ENDNOTE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>EQUATIONFORMS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>EQUATIONS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>ETHERBOOT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>EVALOBJ.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>EYECON.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>FASTEDITBM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>FILECACHE-FIX.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>FileCacheMsgWindow.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>FILENAMES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>FILEWATCH.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>FILLREGION.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>FIND-CITATION.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>FINGER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>FM-CREATOR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>fm-creator-examples> .Warning: Error attempting to LOADVARS (IL:NILCOMS) from {DSK}<home>larry>ilisp>med>lispusers>fm-creator-examples>.
-;;; {DSK}<home>larry>ilisp>med>lispusers>FONTDECLS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>FONTSAMPLER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>FORMACRO.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>FTPSERVERPATCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>GENERIC-INIT.;1 .Warning: Error attempting to LOADVARS (IL:GENERIC-INITCOMS) from {DSK}<home>larry>ilisp>med>lispusers>GENERIC-INIT.;1.
-;;; {DSK}<home>larry>ilisp>med>lispusers>GRAPHCALLS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>GraphGroup.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>GREP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>GRID-ICONS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>H-ENV.;1 .Warning: Couldn't find IL:H-ENVCOMS on {DSK}<home>larry>ilisp>med>lispusers>H-ENV.;1.
-;;; {DSK}<home>larry>ilisp>med>lispusers>H-LOAD.;1 .Warning: Couldn't find IL:H-LOADCOMS on {DSK}<home>larry>ilisp>med>lispusers>H-LOAD.;1.
-;;; {DSK}<home>larry>ilisp>med>lispusers>H-PATCHES.;1 .Warning: Couldn't find IL:H-PATCHESCOMS on {DSK}<home>larry>ilisp>med>lispusers>H-PATCHES.;1.
-;;; {DSK}<home>larry>ilisp>med>lispusers>H-SOURCE.;1 .Warning: Couldn't find IL:H-SOURCECOMS on {DSK}<home>larry>ilisp>med>lispusers>H-SOURCE.;1.
-;;; {DSK}<home>larry>ilisp>med>lispusers>HANOI.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>HARDCOPY-RETAIN.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>HASHBUFFER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>HASHDATUM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>HEADLINE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>HELPSYS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>HGRAPH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>HISTMENU.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>HOSTUP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>HPGL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>HYPERDESK-INIT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>HYPERDESK-LOG.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>IDEASKETCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>IDLEDRAIN.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>IDLEHAX.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>IDLESWAP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>INDEX.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>INSPECTCODE-TEDIT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>IPTALK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>IRISCONSTANTS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>IRISDEMOFNS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>IRISIO.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>IRISLIB.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>IRISNET.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>IRISSTREAM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>IRISVIEW.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>ISO8859IO.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>KEYOBJ.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>KINETIC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>KOTOLOGO.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LABEL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LAFITE-INDENT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LAFITEABBREV.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LAFITEPRIVATEDL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LAFITETIMEDDELETE.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LAMBDATRAN.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LAYOUT-SEDIT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LIFE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LISPNERD.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LOADIRIS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LOADMENUITEMS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LoadPatches.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LOGIC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LOGIC-DEVEL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LOGIC-UNIFIER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LOGTIME.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LOOKUPINFILES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>LUPINE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MACINTERFACE.;50 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MACWINDOW.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MAGNIFIER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MAILSHARE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MAKEGRAPH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MANAGER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MANDELBROT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MATHSERVER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>mathserverplot.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MATHTONS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MATRIXOPS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MESATOLISP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MICROTEK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MICROTEKPRINT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MIME.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MISSILE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MODERNIZE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MONITOR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MTP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>MULTIPLE-HARDCOPY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>NEATICONS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>NGROUP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>NOTECARDS-4045XLPPATCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>NOTEPAD.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>NOTEPAD-CORESTYLES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>NOVAFONT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>NSALLOCATION.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>NSCOPYFILE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>NSDISPLAYSIZES.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>NSPROTECTION.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>NSREADERPATCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>NSROUTINGHASH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>NSTALK.;1 .Warning: Error attempting to LOADVARS (IL:NSTALKCOMS) from {DSK}<home>larry>ilisp>med>lispusers>NSTALK.;1.
-;;; {DSK}<home>larry>ilisp>med>lispusers>NSTALKGAP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>NSTHASIZE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>OSS-LYRIC-PATCHES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PAC-MAN-IDLE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PACKED-STRUCTURE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PACMAN.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PAGEHOLD.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PARSER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PARSERG.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PATCH-LARGEIPBITMAP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PATCH-TWOSIDED.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PCMEMTEST.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PHONE-DIRECTORY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PIECE-MENUS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PIXELBLT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PLAINTEXTSTREAM.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PLAY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PLOT.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PLOTANDNC-PATCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PLOTBOXPATCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PLOTEXAMPLES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PLOTINSKETCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PLOTOBJECTS.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PLOTOBJECTS1.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PLOTOBJECTS2.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PORT-CLFILE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>POSTSCRIPT> .Warning: Error attempting to LOADVARS (IL:NILCOMS) from {DSK}<home>larry>ilisp>med>lispusers>POSTSCRIPT>.
-;;; {DSK}<home>larry>ilisp>med>lispusers>POSTSCRIPT-old> .Warning: Error attempting to LOADVARS (IL:NILCOMS) from {DSK}<home>larry>ilisp>med>lispusers>POSTSCRIPT-old>.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PP-CODE-FILE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PREEMPTIVE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PRESSFROMNS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PRETTYFILEINDEX.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PRINTERMENU.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PROGRAMCHAT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PROMPTREMINDERS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PROOFREADER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PS-PATCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PS-RS232.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PS-SEND.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PS-SKETCH-PATCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PS-TTY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>PSCFONT-FIX-FILENAME.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>QEDIT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>QIX.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>READAIS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>READAPPLEFONT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>READBRUSH.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>READDATATYPE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>READDISPLAYFONT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>READEBCDIC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>READINTERPRESS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>REGION.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>REGISTER-MACHINE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>REMOTEPSW.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>RPC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>RPCCOMMON.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>RPCDECLS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>RPCLOWLEVEL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>RPCOS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>RPCPORTMAPPER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>RPCRPC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>RPCSTRUCT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>RPCXDR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>RS232CNETWORK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SCREENPAPER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SEARCHMENU.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SEDIT-COMMONLISP.;1 .(SEDIT-COMMONLISPCOMS reset)
+;;; {DSK}<home>larry>ilisp>medley>library>TEXTOFD.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TFBRAVO.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>TTYCHAT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>UNICODE.;167 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>UNIXCHAT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>UNIXCOMM.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>UNIXPRINT.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>UNIXTELNET.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>VIRTUALKEYBOARDS.;9 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>VT100KP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>VTCHAT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>WHERE-IS.;4 ... done.
+;;; {DSK}<home>larry>ilisp>medley>library>XCCS.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>ACCESS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>ACE> .Warning: Error attempting to LOADVARS (IL:NILCOMS) from {DSK}<home>larry>ilisp>medley>lispusers>ACE>.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>ADDRESSBOOK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>AIREGIONS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>AIREGIONS-DEMO.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>AISBLT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>ANALYZER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>ARCHIVEBROWSER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>ARCHIVETOOL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>ARMODES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>autosamedir.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>AUXMENU.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>BACKGROUNDIMAGES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>BACKGROUNDMENU.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>BICLOCK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>BIGGER-FONT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>BITMAP-GALLERY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>bitmapfns.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>BLACKBOX.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>BLOCKS-HKB.;1 .Warning: Couldn't find IL:BLOCKS-HKBCOMS on {DSK}<home>larry>ilisp>medley>lispusers>BLOCKS-HKB.;1.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>BMENCODE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>BOYERMOORE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>BRKDWNREPORT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>bsearch.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>BUTTONS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>C150STREAM.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>CALENDAR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>canvasconverter.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>CD.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>CHATEMACS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>CHATSERVER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>CHATSERVER-NS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>CHATSERVER-RS232.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>CHATSERVER-TCP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>checkset.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>circlprint.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>CL-TTYEDIT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>COLORDEMO.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>COLORNNCC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>COLOROBJ.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>COLORPOLYGONS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>COMMENTHACKS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>COMMON-MAKE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>COMMWINDOW.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>COMPARE-PATHS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>COMPAREDIRECTORIES.;275 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>COMPARESOURCES.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>comparetext.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>compilebang.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>COURIERDEFS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>COURIEREVALSERVE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>COURIERIMAGESTREAM.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>COURIERSERVE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>COURIERSERVEPATCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>CROCK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DANDELIONUFO.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DANDELIONUFO4096.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DATATYPESPLUS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DATE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DATEFNS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DATEFORMAT-EDITOR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DATESORT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DEBUGGER-CONTEXT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DECL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DEDITHARDCOPY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DEFAULTICON.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DEFAULTSUBITEMFN.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DEFINERPRINT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DIALPHONE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DICOLOR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DICT-WINDOW-TYPES.;1 .Warning: Error attempting to LOADVARS (IL:DICT-WINDOW-TYPESCOMS) from {DSK}<home>larry>ilisp>medley>lispusers>DICT-WINDOW-TYPES.;1.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DICTTOOL.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DIGEST.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DIGI-CLOCK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DINFO.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DIRGRAPHER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DLIONFNKEYS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DOC-OBJECTS.;7 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>document.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>donz.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DORADOCOLOR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DPUPFTPPATCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DSPSCALE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>dumper.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>DUMPLOAD.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>EDITBG.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>EDITFONT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>EDITKEYS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>EMACS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>ENDNOTE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>EQUATIONFORMS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>EQUATIONS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>ETHERBOOT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>EVALOBJ.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>EYECON.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>FASTEDITBM.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>FILECACHE-FIX.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>FileCacheMsgWindow.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>FILENAMES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>FILEWATCH.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>FILLREGION.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>FIND-CITATION.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>FINGER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>FM-CREATOR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>fm-creator-examples> .Warning: Error attempting to LOADVARS (IL:NILCOMS) from {DSK}<home>larry>ilisp>medley>lispusers>fm-creator-examples>.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>FONTDECLS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>FONTSAMPLER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>FORMACRO.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>FTPSERVERPATCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>GENERIC-INIT.;1 .Warning: Error attempting to LOADVARS (IL:GENERIC-INITCOMS) from {DSK}<home>larry>ilisp>medley>lispusers>GENERIC-INIT.;1.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>GRAPHCALLS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>GraphGroup.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>GREP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>GRID-ICONS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>H-ENV.;1 .Warning: Couldn't find IL:H-ENVCOMS on {DSK}<home>larry>ilisp>medley>lispusers>H-ENV.;1.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>H-LOAD.;1 .Warning: Couldn't find IL:H-LOADCOMS on {DSK}<home>larry>ilisp>medley>lispusers>H-LOAD.;1.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>H-PATCHES.;1 .Warning: Couldn't find IL:H-PATCHESCOMS on {DSK}<home>larry>ilisp>medley>lispusers>H-PATCHES.;1.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>H-SOURCE.;1 .Warning: Couldn't find IL:H-SOURCECOMS on {DSK}<home>larry>ilisp>medley>lispusers>H-SOURCE.;1.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>HANOI.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>HARDCOPY-RETAIN.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>HASHBUFFER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>HASHDATUM.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>HEADLINE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>HELPSYS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>HGRAPH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>HISTMENU.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>HOSTUP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>HPGL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>HYPERDESK-INIT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>HYPERDESK-LOG.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>IDEASKETCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>IDLEDRAIN.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>IDLEHAX.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>IDLESWAP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>INDEX.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>INSPECTCODE-TEDIT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>IPTALK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>IRISCONSTANTS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>IRISDEMOFNS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>IRISIO.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>IRISLIB.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>IRISNET.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>IRISSTREAM.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>IRISVIEW.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>ISO8859IO.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>KEYOBJ.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>KINETIC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>KOTOLOGO.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LABEL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LAFITE-INDENT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LAFITEABBREV.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LAFITEPRIVATEDL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LAFITETIMEDDELETE.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LAMBDATRAN.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LAYOUT-SEDIT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LIFE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LISPNERD.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LOADIRIS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LOADMENUITEMS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LoadPatches.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LOGIC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LOGIC-DEVEL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LOGIC-UNIFIER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LOGTIME.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LOOKUPINFILES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>LUPINE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MACINTERFACE.;50 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MACWINDOW.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MAGNIFIER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MAILSHARE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MAKEGRAPH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MANAGER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MANDELBROT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MATHSERVER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>mathserverplot.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MATHTONS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MATRIXOPS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MESATOLISP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MICROTEK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MICROTEKPRINT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MIME.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MISSILE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MODERNIZE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MONITOR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MTP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>MULTIPLE-HARDCOPY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>NEATICONS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>NGROUP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>NOTECARDS-4045XLPPATCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>NOTEPAD.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>NOTEPAD-CORESTYLES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>NOVAFONT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>NSALLOCATION.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>NSCOPYFILE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>NSDISPLAYSIZES.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>NSPROTECTION.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>NSREADERPATCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>NSROUTINGHASH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>NSTALK.;1 .Warning: Error attempting to LOADVARS (IL:NSTALKCOMS) from {DSK}<home>larry>ilisp>medley>lispusers>NSTALK.;1.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>NSTALKGAP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>NSTHASIZE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>OSS-LYRIC-PATCHES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PAC-MAN-IDLE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PACKED-STRUCTURE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PACMAN.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PAGEHOLD.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PARSER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PARSERG.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PATCH-LARGEIPBITMAP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PATCH-TWOSIDED.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PCMEMTEST.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PHONE-DIRECTORY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PIECE-MENUS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PIXELBLT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PLAINTEXTSTREAM.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PLAY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PLOT.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PLOTANDNC-PATCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PLOTBOXPATCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PLOTEXAMPLES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PLOTINSKETCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PLOTOBJECTS.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PLOTOBJECTS1.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PLOTOBJECTS2.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PORT-CLFILE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>POSTSCRIPT> .Warning: Error attempting to LOADVARS (IL:NILCOMS) from {DSK}<home>larry>ilisp>medley>lispusers>POSTSCRIPT>.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>POSTSCRIPT-old> .Warning: Error attempting to LOADVARS (IL:NILCOMS) from {DSK}<home>larry>ilisp>medley>lispusers>POSTSCRIPT-old>.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PP-CODE-FILE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PREEMPTIVE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PRESSFROMNS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PRETTYFILEINDEX.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PRINTERMENU.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PROGRAMCHAT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PROMPTREMINDERS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PROOFREADER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PS-PATCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PS-RS232.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PS-SEND.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PS-SKETCH-PATCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PS-TTY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>PSCFONT-FIX-FILENAME.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>QEDIT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>QIX.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>READAIS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>READAPPLEFONT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>READBRUSH.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>READDATATYPE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>READDISPLAYFONT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>READEBCDIC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>READINTERPRESS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>REGION.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>REGISTER-MACHINE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>REMOTEPSW.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>RPC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>RPCCOMMON.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>RPCDECLS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>RPCLOWLEVEL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>RPCOS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>RPCPORTMAPPER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>RPCRPC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>RPCSTRUCT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>RPCXDR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>RS232CNETWORK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SCREENPAPER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SEARCHMENU.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SEDIT-COMMONLISP.;1 .(SEDIT-COMMONLISPCOMS reset)
 .. done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SEDIT-MENU-ALWAYS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SEDIT-PATCHES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SEDIT-PROFILE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SETDEFAULTPRINTER.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SFFONT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SHOWTIME.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SIMPLECHAT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SIMPLIFY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SINGLEFILEINDEX.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SKETCHCOLOR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SKETCHTALK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SNAPW-ICON.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SOLID-MOVEW.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SOLITAIRE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>STARBG.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>STEP-COMMAND-MENU.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>STORAGE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>STREAMDECLS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>STYLESHEET.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SUPERPARENTHESES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>SYSTATS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TALK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TALKGAP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TCPTIME.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TEDIT-CLOSE-ON-SHRINK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TEDIT-LINE-NUMBERING.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>tedit-process-killer.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TEDITDORADOKEYS.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TEDITKEY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TEDITTALK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TEK4010.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TEK4010CHAT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>THINFILES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TILED-SEDIT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>tkdorado.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TMAX.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TMAX-DATE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TMAX-ENDNOTE.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TMAX-INDEX.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TMAX-NGRAPH.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TMAX-NGROUP.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TMAX-NUMBER.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TMAX-XREF.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>tmenu.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TRAJECTORY-FOLLOWER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TRANSOR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TRANSOR-LOADTRAN.;1 .Warning: Couldn't find IL:TRANSOR-LOADTRANCOMS on {DSK}<home>larry>ilisp>med>lispusers>TRANSOR-LOADTRAN.;1.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TRICKLE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TSET.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TTYTALK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TURBO-WINDOWS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>TWODGRAPHICS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>UNBOXEDOPS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>UNDIGESTIFY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>UNIFIER.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>UPCSTATS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>UTILISOPRS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>UUENCODE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>VANILLA-INIT.;1 .Warning: Error attempting to LOADVARS (IL:VANILLA-INITCOMS) from {DSK}<home>larry>ilisp>med>lispusers>VANILLA-INIT.;1.
-;;; {DSK}<home>larry>ilisp>med>lispusers>VSTATS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>WALKFILES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>WDWHACKS.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>WHEELSCROLL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>WHO-LINE.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>WHOCALLS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>WINK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>WORDNERD.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>XCL-BRIDGE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>XORCURSORPATCH.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>lispusers>XREF.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>ABC.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>ARCLEANUP.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>AREDIT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>ARHACK.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>ARINDEX.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>ARQUERY.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>arreport-test.;1 .Warning: Error attempting to LOADVARS (IL:ARREPORT-TESTCOMS) from {DSK}<home>larry>ilisp>med>internal>library>arreport-test.;1.
-;;; {DSK}<home>larry>ilisp>med>internal>library>ARSREPORT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>CALENDARHACKS.;3 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>CHANGECONTROL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>COMPTEST.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>CONDITIONGRAPH.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>DICOLOR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>DO-TEST.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>DUMPFILE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>FASL-DEBUG.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>FLOAT-ARRAY-SUPPORT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>GIVE-AND-TAKE.;2 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>MACROTEST.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>MACROTESTAUX.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>MAILCLIENT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>MAINTAIN.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>MAKE-EXPORTS-ALL.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>MAKE-TCP-EXPORTS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>MEDLEY-UTILS.;3 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>MESATYPES.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>msx.;1 .Warning: Error attempting to LOADVARS (IL:MSXCOMS) from {DSK}<home>larry>ilisp>med>internal>library>msx.;1.
-;;; {DSK}<home>larry>ilisp>med>internal>library>MULTI-COMPILE.;4 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>NATIVE-TRANSLATOR.;1 .Warning: Error attempting to LOADVARS (IL:NATIVE-TRANSLATORCOMS) from {DSK}<home>larry>ilisp>med>internal>library>NATIVE-TRANSLATOR.;1.
-;;; {DSK}<home>larry>ilisp>med>internal>library>NATIVE-TRANSLATOR-PACKAGE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>NSTOASCIIDISPLAYFONT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>PEANO.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>READ-PRINT-PROFILE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>RELEASETOOLS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>SMART-TRICKLE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>SPLICE.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>TAR.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>TYPEHAX.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>WHEREIS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>internal>library>XCLC-DEBUG.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>greetfiles>INIT.;1 .Warning: Error attempting to LOADVARS (IL:INITCOMS) from {DSK}<home>larry>ilisp>med>greetfiles>INIT.;1.
-;;; {DSK}<home>larry>ilisp>med>greetfiles>LOCAL-INIT.;45 ... done.
-;;; {DSK}<home>larry>ilisp>med>greetfiles>PARC-INIT.;21 ... done.
-;;; {DSK}<home>larry>ilisp>med>greetfiles>SIMPLE-INIT.;3 ... done.
-;;; {DSK}<home>larry>ilisp>med>docs>Documentation Tools>IMINDEX.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>docs>Documentation Tools>IMNAME.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>docs>Documentation Tools>IMTEDIT.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>docs>Documentation Tools>IMTOOLS.;1 ... done.
-;;; {DSK}<home>larry>ilisp>med>docs>Documentation Tools>IMTRAN.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SEDIT-MENU-ALWAYS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SEDIT-PATCHES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SEDIT-PROFILE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SETDEFAULTPRINTER.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SFFONT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SHOWTIME.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SIMPLECHAT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SIMPLIFY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SINGLEFILEINDEX.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SKETCHCOLOR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SKETCHTALK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SNAPW-ICON.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SOLID-MOVEW.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SOLITAIRE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>STARBG.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>STEP-COMMAND-MENU.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>STORAGE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>STREAMDECLS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>STYLESHEET.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SUPERPARENTHESES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>SYSTATS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TALK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TALKGAP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TCPTIME.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TEDIT-CLOSE-ON-SHRINK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TEDIT-LINE-NUMBERING.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>tedit-process-killer.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TEDITDORADOKEYS.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TEDITKEY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TEDITTALK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TEK4010.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TEK4010CHAT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>THINFILES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TILED-SEDIT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>tkdorado.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TMAX.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TMAX-DATE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TMAX-ENDNOTE.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TMAX-INDEX.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TMAX-NGRAPH.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TMAX-NGROUP.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TMAX-NUMBER.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TMAX-XREF.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>tmenu.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TRAJECTORY-FOLLOWER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TRANSOR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TRANSOR-LOADTRAN.;1 .Warning: Couldn't find IL:TRANSOR-LOADTRANCOMS on {DSK}<home>larry>ilisp>medley>lispusers>TRANSOR-LOADTRAN.;1.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TRICKLE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TSET.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TTYTALK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TURBO-WINDOWS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>TWODGRAPHICS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>UNBOXEDOPS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>UNDIGESTIFY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>UNIFIER.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>UPCSTATS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>UTILISOPRS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>UUENCODE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>VANILLA-INIT.;1 .Warning: Error attempting to LOADVARS (IL:VANILLA-INITCOMS) from {DSK}<home>larry>ilisp>medley>lispusers>VANILLA-INIT.;1.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>VSTATS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>WALKFILES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>WDWHACKS.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>WHEELSCROLL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>WHO-LINE.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>WHOCALLS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>WINK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>WORDNERD.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>XCL-BRIDGE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>XORCURSORPATCH.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>lispusers>XREF.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>ABC.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>ARCLEANUP.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>AREDIT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>ARHACK.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>ARINDEX.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>ARQUERY.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>arreport-test.;1 .Warning: Error attempting to LOADVARS (IL:ARREPORT-TESTCOMS) from {DSK}<home>larry>ilisp>medley>internal>library>arreport-test.;1.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>ARSREPORT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>CALENDARHACKS.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>CHANGECONTROL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>COMPTEST.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>CONDITIONGRAPH.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>DICOLOR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>DO-TEST.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>DUMPFILE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>FASL-DEBUG.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>FLOAT-ARRAY-SUPPORT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>GIVE-AND-TAKE.;2 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>MACROTEST.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>MACROTESTAUX.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>MAILCLIENT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>MAINTAIN.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>MAKE-EXPORTS-ALL.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>MAKE-TCP-EXPORTS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>MEDLEY-UTILS.;11 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>MESATYPES.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>msx.;1 .Warning: Error attempting to LOADVARS (IL:MSXCOMS) from {DSK}<home>larry>ilisp>medley>internal>library>msx.;1.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>MULTI-COMPILE.;4 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>NATIVE-TRANSLATOR.;1 .Warning: Error attempting to LOADVARS (IL:NATIVE-TRANSLATORCOMS) from {DSK}<home>larry>ilisp>medley>internal>library>NATIVE-TRANSLATOR.;1.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>NATIVE-TRANSLATOR-PACKAGE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>NSTOASCIIDISPLAYFONT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>PEANO.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>READ-PRINT-PROFILE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>RELEASETOOLS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>SMART-TRICKLE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>SPLICE.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>TAR.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>TYPEHAX.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>WHEREIS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>internal>library>XCLC-DEBUG.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>greetfiles>INIT.;1 .Warning: Error attempting to LOADVARS (IL:INITCOMS) from {DSK}<home>larry>ilisp>medley>greetfiles>INIT.;1.
+;;; {DSK}<home>larry>ilisp>medley>greetfiles>LOCAL-INIT.;45 ... done.
+;;; {DSK}<home>larry>ilisp>medley>greetfiles>PARC-INIT.;21 ... done.
+;;; {DSK}<home>larry>ilisp>medley>greetfiles>SIMPLE-INIT.;3 ... done.
+;;; {DSK}<home>larry>ilisp>medley>docs>Documentation Tools>IMINDEX.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>docs>Documentation Tools>IMNAME.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>docs>Documentation Tools>IMTEDIT.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>docs>Documentation Tools>IMTOOLS.;1 ... done.
+;;; {DSK}<home>larry>ilisp>medley>docs>Documentation Tools>IMTRAN.;1 ... done.
diff --git a/loadups/whereis.hash b/loadups/whereis.hash
index d88a1514..46622cd4 100644
Binary files a/loadups/whereis.hash and b/loadups/whereis.hash differ
diff --git a/sources/ADIR b/sources/ADIR
index 882e745c..653327eb 100644
--- a/sources/ADIR
+++ b/sources/ADIR
@@ -1 +1 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "15-Mar-2021 14:21:13" {DSK}<home>larry>ilisp>medley>sources>ADIR.;11 61680  

      changes to%:  (FNS DELFILE FULLNAME INFILE INFILEP IOFILE OPENFILE OPENSTREAM OUTFILE OUTFILEP
                         RENAMEFILE SIMPLE.FINDFILE UNPACKFILENAME UNPACKFILENAME.STRING LASTCHPOS 
                         \UPF.NEXTPOS \UPF.TEMPFILEP FILENAMEFIELD PACKFILENAME PACKFILENAME.STRING 
                         LOGOUT MAKESYS SYSOUT SAVEVM HERALD INTERPRET.REM.CM \USEREVENT USERNAME 
                         SETUSERNAME)

      previous date%: "15-Mar-2021 12:41:13" {DSK}<home>larry>ilisp>medley>sources>ADIR.;9)


(* ; "
Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corporation.
")

(PRETTYCOMPRINT ADIRCOMS)

(RPAQQ ADIRCOMS
       [[COMS                                                (* ; "user-level i/o routines")
              (FNS DELFILE FULLNAME INFILE INFILEP IOFILE OPENFILE OPENSTREAM OUTFILE OUTFILEP 
                   RENAMEFILE SIMPLE.FINDFILE)
              (CONSTANTS (MULTIPLE.STREAMS.PER.FILE.ALLOWED T))
              (P (MOVD? 'SIMPLE.FINDFILE 'FINDFILE NIL T))
              (DECLARE%: DONTEVAL@LOAD DOCOPY (P 

                                       (* ;; "for the benefit of the call to PATHNAMEP in OPENSTREAM.  PATHNAMEP (and pathnames) get defined much later in the loadup.")

                                                 (MOVD? 'NILL 'CL:PATHNAMEP]
        (COMS (FNS UNPACKFILENAME UNPACKFILENAME.STRING LASTCHPOS \UPF.NEXTPOS \UPF.TEMPFILEP 
                   FILENAMEFIELD PACKFILENAME PACKFILENAME.STRING)
              (DECLARE%: DONTCOPY (MACROS CANONICAL.DIRECTORY UNPACKFILE1.DIRECTORY 
                                         PACKFILENAME.ASSEMBLE UNPACKFILE1))
              (VARS \FILENAME.SYNTAX)
              (GLOBALVARS \FILENAME.SYNTAX))
        (COMS                                                (* ; 
                                                           "saving and restoring system state")
              (FNS LOGOUT MAKESYS SYSOUT SAVEVM HERALD INTERPRET.REM.CM \USEREVENT)
              (ADDVARS (AROUNDEXITFNS))
              (INITVARS (HERALDSTRING "")
                     (\USERNAME))
              (GLOBALVARS HERALDSTRING USERNAME \USERNAME AROUNDEXITFNS)
              (FNS USERNAME SETUSERNAME))
        (LOCALVARS . T)
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
                                                                FILEIO))
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML)
                                                                             (LAMA 
                                                                                  PACKFILENAME.STRING
                                                                                   PACKFILENAME])



(* ; "user-level i/o routines")

(DEFINEQ

(DELFILE
  [LAMBDA (FILE)                                         (* bvm%: "23-Oct-85 11:20")
    (AND FILE (NEQ FILE T)
         (\DELETEFILE FILE])

(FULLNAME
  [LAMBDA (X RECOG)                                      (* rmk%: "22-AUG-83 13:33")
    (COND
       ((type? STREAM X)
        (fetch (STREAM FULLNAME) of X))
       (T (SELECTQ RECOG
              (NIL (SETQQ RECOG OLD))
              ((OLD OLD/NEW NEW OLDEST))
              (\ILLEGAL.ARG RECOG))
          (\GETFILENAME X RECOG])

(INFILE
  [LAMBDA (FILE)                                         (* rmk%: " 3-OCT-79 14:23")
    (INPUT (OPENFILE FILE 'INPUT 'OLD])

(INFILEP
  [LAMBDA (FILE)                                         (* rmk%: " 9-OCT-79 22:39")
    (\GETFILENAME FILE 'OLD])

(IOFILE
  [LAMBDA (FILE)                                         (* rmk%: " 5-SEP-81 13:54")
    (OPENFILE FILE 'BOTH 'OLD])

(OPENFILE
  [LAMBDA (FILE ACCESS RECOG PARAMETERS OPTIONAL)        (* ; "Edited 23-May-91 19:12 by jds")
    (if MULTIPLE.STREAMS.PER.FILE.ALLOWED
        then (OPENSTREAM FILE ACCESS RECOG PARAMETERS OPTIONAL)
      else (fetch (STREAM FULLNAME) of (OPENSTREAM FILE ACCESS RECOG PARAMETERS 
                                                          OPTIONAL])

(OPENSTREAM
  [LAMBDA (FILE ACCESS RECOG PARAMETERS OBSOLETE)        (* hdj "28-Aug-86 14:50")
    (PROG (REC OLDSTREAM STREAM)
          (SELECTQ ACCESS
              ((INPUT OUTPUT BOTH APPEND))
              (\ILLEGAL.ARG ACCESS))
          (SETQ REC (SELECTQ RECOG
                        ((EXACT NEW OLD OLD/NEW OLDEST) 
                             RECOG)
                        (NIL (SELECTQ ACCESS
                                 (INPUT 'OLD)
                                 (OUTPUT 'NEW)
                                 'OLD/NEW))
                        (\ILLEGAL.ARG RECOG)))
          (if (OR (LISTP OBSOLETE)
                      (AND PARAMETERS (NLISTP PARAMETERS)))
              then 

                    (* ;; "used to have OPENFILE/OPENSTREAM with BYTESIZE and PARAMETERS.  Now it will take PARAMETERS, and generally ignore the BYTESIZE")

                    (SETQ PARAMETERS (APPEND (SELECTQ PARAMETERS
                                                 (7 '((TYPE TEXT)))
                                                 (8 '((TYPE BINARY)))
                                                 NIL)
                                            OBSOLETE)))
          (COND
             ((OR (EQ FILE T)
                  (NULL FILE))

              (* ;; "Handle T and NIL separately, cause they can return the terminal streams, for which the search isn't necessary and the \ADDOFD shouldn't be done.")

              (SETQ STREAM (\GETSTREAM FILE ACCESS))
              (\DO.PARAMS.AT.OPEN STREAM ACCESS PARAMETERS)
              (RETURN STREAM)))

     (* ;; "Explicitly test for PATHNAMEP, as PATHNAMEP will have a NILL def early in the loadup, and the tests in \CONVERT-PATHNAME won't break anything")

     (* ;; "Pavel changed a call to (PATHNAMEP FILE) into (TYPEP FILE `PATHNAME) because PATHNAMEP didn't have a NILL defn early in the loadup and TYPEP has an optimizer on it that compiles away the call to TYPEP which also has no defn early in the loadup.")

     (* ;; "Pavel also added the call to MKSTRING below as a temporary hack to get around the fact that the Interlisp string functions can't yet handle Common Lisp simple-strings.")

          (if (TYPEP FILE 'PATHNAME)
              then (SETQ FILE (\CONVERT-PATHNAME FILE)))

     (* ;; "We open the file before looking to see whether it is already open.  This guarantees that we acquire the opening rights at the time we lookup the name.  We then check to see if it is currently open in Lisp.  If it is, we return the previous stream, which has the file's current state.  ")

     (* ;; "There are still potential problems: First, an interrupt can happen while we are doing the search which causes the file to be deleted or re-opened beneath us, BEFORE it gets added to \OPENFILES.  Second, a network device might not allow multiple openings of the file, even by the same guy with the same mode.")

          (SETQ STREAM (\OPENFILE FILE ACCESS REC PARAMETERS))
          (COND
             [[AND (NOT MULTIPLE.STREAMS.PER.FILE.ALLOWED)
                   (SETQ OLDSTREAM (\SEARCHOPENFILES (fetch FULLNAME of STREAM]

              (* ;; "There is already a stream open on the file.  Check that there is no conflict.  Eventually all this registration belongs in the device, so that we can have multiple streams open per file")

              (COND
                 ((AND (EQ ACCESS 'INPUT)
                       (EQ (fetch ACCESS of OLDSTREAM)
                           'INPUT))                          (* ; 
    "Dispose of the newly-obtained stream, This might be a noop, but a network device (LEAF) cares")
                  (OR (EQ STREAM OLDSTREAM)
                      (\CLOSEFILE STREAM))
                  (\DO.PARAMS.AT.OPEN OLDSTREAM ACCESS PARAMETERS)
                                                             (* ; "Do parameters on the old stream")
                  (RETURN OLDSTREAM))
                 (T (LISPERROR "FILE WON'T OPEN" FILE]
             (T (AND (NOT MULTIPLE.STREAMS.PER.FILE.ALLOWED)
                     (\ADDOFD STREAM))                       (* ; 
                                                       "Parameters done on new stream by \OPENFILE")
                (RETURN STREAM])

(OUTFILE
  [LAMBDA (FILE)                                         (* rmk%: " 3-OCT-79 14:24")
    (OUTPUT (OPENFILE FILE 'OUTPUT 'NEW])

(OUTFILEP
  [LAMBDA (FILE)                                         (* rmk%: " 9-OCT-79 22:39")
    (\GETFILENAME FILE 'NEW])

(RENAMEFILE
  [LAMBDA (OLDFILE NEWFILE)                              (* hdj " 4-Sep-86 16:56")
    (SETQ OLDFILE (\CONVERT-PATHNAME OLDFILE))
    (SETQ NEWFILE (\CONVERT-PATHNAME NEWFILE))
    (AND OLDFILE NEWFILE (NEQ OLDFILE T)
         (NEQ NEWFILE T)
         (\RENAMEFILE OLDFILE NEWFILE])

(SIMPLE.FINDFILE
  [LAMBDA (FILE DUMMY DIRLST)                            (* bvm%: "23-Oct-85 11:22")
    (OR (for DIR in DIRLST when (SETQ $$VAL (INFILEP (PACKFILENAME.STRING
                                                                      'DIRECTORY DIR 'BODY FILE)))
           do (RETURN $$VAL))
        (AND (NOT (MEMB NIL DIRLST))
             (INFILEP FILE])
)
(DECLARE%: EVAL@COMPILE 

(RPAQQ MULTIPLE.STREAMS.PER.FILE.ALLOWED T)


(CONSTANTS (MULTIPLE.STREAMS.PER.FILE.ALLOWED T))
)

(MOVD? 'SIMPLE.FINDFILE 'FINDFILE NIL T)
(DECLARE%: DONTEVAL@LOAD DOCOPY 


(* ;; "for the benefit of the call to PATHNAMEP in OPENSTREAM.  PATHNAMEP (and pathnames) get defined much later in the loadup.")


(MOVD? 'NILL 'CL:PATHNAMEP)
)
(DEFINEQ

(UNPACKFILENAME
  [LAMBDA (FILE ONEFIELDFLG OSTYPE)                      (* ; "Edited  6-Jan-88 13:13 by bvm:")
    (UNPACKFILENAME.STRING FILE ONEFIELDFLG NIL OSTYPE T])

(UNPACKFILENAME.STRING
  [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 30-Mar-90 22:37 by nm")

(* ;;; "Given a string or atom representation of a file name, unpack it into its component parts")

    (PROG ((POS 1)
           (LEN (NCHARS FILE))
           TEM BEYONDNAME BEYONDEXT VAL CODE HOSTP SUBDIREND FIRSTDOT SECONDDOT USEDSEMI)
          (COND
             ((NULL FILE)
              (RETURN NIL))
             ((OR (LITATOM FILE)
                  (STRINGP FILE)
                  (NUMBERP FILE)))
             ((TYPEP FILE 'PATHNAME)
              (RETURN (UNPACKPATHNAME.STRING FILE ONEFIELDFLG DIRFLG PACKFLG)))
             [(STREAMP FILE)                                 (* ; 
                                               "For streams, use full name.  If anonymous, fake it")
              (SETQ FILE (OR (ffetch FULLFILENAME of FILE)
                             (RETURN (COND
                                        (ONEFIELDFLG (AND (EQ ONEFIELDFLG 'NAME)
                                                          FILE))
                                        (T (LIST 'NAME FILE]
             (T (\ILLEGAL.ARG FILE)))
          (COND
             ((SELCHARQ (NTHCHARCODE FILE 1)
                   ({                                        (* ; "normal use in Interlisp-D")
                      (SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE })
                                                 FILE 2)
                                          0))))
                   (%[                                       (* ; 
                                                  "some Xerox and Arpanet systems use '[' for host")
                       (SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE "]")
                                                  FILE 2)
                                           0))))
                   (%(                                       (* ; 
                                                "this is the 'proposed standard' for Xerox servers")
                       (SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE ")")
                                                  FILE 2)
                                           0))))
                   NIL)
              (UNPACKFILE1 'HOST 2 TEM)
              [COND
                 ((EQ TEM -1)                                (* ; 
    "Started with the host field delimiter, but there was no corresponding terminating delimiter .")
                                                             (* ; 
                                           "I'm not sure why the name is dealt with the host name.")
                  (RETURN (DREVERSE VAL]
              (SETQ POS (IPLUS TEM 2))
              [if (EQ OSTYPE T)
                  then                                   (* ; 
                                                           "Use actual host to determine os type")
                        (SETQ OSTYPE (GETHOSTINFO (CAR VAL)
                                            'OSTYPE]
              (SETQ HOSTP T)))
          (COND
             ((SETQ TEM (LASTCHPOS (CHARCODE %:)
                               FILE POS))                    (* ; 
                                 "all device returned have DEVICE.END on it so that NIL: will work")
              (UNPACKFILE1 'DEVICE POS (if CLFLG
                                           then (SUB1 TEM)
                                         else TEM))
              (SETQ POS (ADD1 TEM))
              (SETQ HOSTP T)))
          (COND
             ((EQ DIRFLG 'RETURN)                            (* ; "assert that this is a directory; more forgiving about missing trailing delimiter. There are two distinct cases for the missing initial delimiter.  If HOST is also specified, it is dealt with as the true %"relative pathname%" by device dependent manner, otherwise it is dealt with following the %"incomplete file names%" convention.  In the first case, returns RELATIVEDIRECTORY instead of DIRECTORY and in the second case, returns SUBDIRECTORY.")
              (LET ((TYPE 'DIRECTORY)
                    (START (SELCHARQ (NTHCHARCODE FILE POS)
                                (NIL                         (* ; "just host, return")
                                     (RETURN (DREVERSE VAL)))
                                ((/ <)                       (* ; 
                                                    "Started with the initial directory delimiter.")
                                     (ADD1 POS))
                                POS))
                    END)
                   (SETQ END (SELCHARQ (NTHCHARCODE FILE -1)
                                  ((/ >) 
                                       [COND
                                          ((EQ START POS)    (* ; 
                                                         "Didn't start with a directory delimiter,")
                                           (COND
                                              ((NOT HOSTP)   (* ; "%"Incomplete file names%" case defined in IRM.  This is a subdirectory of the current connected directory")
                                               (SETQ TYPE 'SUBDIRECTORY))
                                              (T             (* ; "True %"relative pathname%".  The way to deal with it is dependent on the device on which HOST is implemented.")
                                                 (SETQ TYPE 'RELATIVEDIRECTORY]
                                       (COND
                                          ((EQ LEN POS)      (* ; 
                                       "Only the initial directory is specified (i.e. %"{DSK}/%").")
                                           (SETQ START POS)
                                           -1)
                                          (T -2)))
                                  (PROGN [COND
                                            [(EQ START POS)  (* ; 
                                            "Both of the initial and trail delimiters are omitted.")
                                             (COND
                                                ((NOT HOSTP) (* ; "%"Incomplete file names%" case defined in IRM.  This is a subdirectory of the current connected directory")
                                                 (SETQ TYPE 'SUBDIRECTORY))
                                                (T           (* ; "True %"relative pathname%".  The way to deal with it is dependent on the device on which HOST is implemented.")
                                                   (SETQ TYPE 'RELATIVEDIRECTORY]
                                            (T (COND
                                                  ((EQ LEN POS)
                                                             (* ; 
                                       "Only the initial directory is specified (i.e. %"{DSK}<%").")
                                                   (SETQ START POS]
                                         -1)))
                   (UNPACKFILE1.DIRECTORY TYPE START END))
              (RETURN (DREVERSE VAL)))
             ((SELCHARQ (NTHCHARCODE FILE POS)
                   (/                                        (* ; 
                                                "unix and the 'xerox standard' use / for delimiter")
                                                             (* ; 
                       "In the case of the {DSK}/FOO>BAR, FOO should be dealt with as a directory.")
                      (SETQ TEM (LASTCHPOS (CHARCODE (/ >))
                                       FILE
                                       (ADD1 POS)))
                      T)
                   ((< >)                                    (* ; 
             "Interlisp-D and most other Xerox systems, and Tops-20/Tenex use <>.  Jericho uses >>")
                                                             (* ; 
                       "In the case of the {DSK}<FOO/BAR, FOO should be dealt with as a directory.")
                        (SETQ TEM (LASTCHPOS (CHARCODE (> /))
                                         FILE
                                         (ADD1 POS)))
                        T)
                   NIL)

              (* ;; "allow {DSK}/etc   to be a directory specification.")

              (if TEM
                  then (UNPACKFILE1.DIRECTORY 'DIRECTORY (ADD1 POS)
                                  (SUB1 TEM))
                        (SETQ POS (ADD1 TEM))
                else 

                      (* ;; "{DSK}/foo: the directory is /, the name is foo")

                      (UNPACKFILE1.DIRECTORY 'DIRECTORY POS POS)
                      (SETQ POS (ADD1 POS)))
              (SETQ HOSTP T))
             ((SETQ TEM (LASTCHPOS (CHARCODE (/ >))
                               FILE POS))                    (* ; " {eris}abc>  relative")

              (* ;; 
        " This is the true %"relative pathname%".  Returns RELATIVEDIRECTORY instead of DIRECTORY.")

              [COND
                 ((NOT HOSTP)                                (* ; "%"Incomplete file names%" case.")
                  (UNPACKFILE1.DIRECTORY (if (EQ DIRFLG 'FIELD)
                                             then 'DIRECTORY
                                           else 'SUBDIRECTORY)
                         POS
                         (SUB1 TEM)))
                 (T                                          (* ; "True %"relative pathname%".")
                    (UNPACKFILE1.DIRECTORY (if (EQ DIRFLG 'FIELD)
                                               then 'DIRECTORY
                                             else 'RELATIVEDIRECTORY)
                           POS
                           (SUB1 TEM]
              (SETQ POS (ADD1 TEM))
              (SETQ HOSTP T)))
          (OR (SETQ CODE (NTHCHARCODE FILE (SETQ TEM POS)))
              (RETURN (DREVERSE VAL)))
          (if (EQ OSTYPE T)
              then                                       (* ; 
                                        "There wasn't a host field in the name, so we have no clue")
                    (SETQ OSTYPE NIL))
      NAMELP
          

     (* ;; "At this point, CODE is the TEM'th char of file name.  POS is the first character of the field we are currently working on.")

          (SELCHARQ CODE
               (%.                                           (* ; 
                          "Note position for later--we only want to deal with the last set of dots")
                   (if BEYONDNAME
                       then                              (* ; 
                                                 "no longer of interest (probably a bad name, too)")
                     elseif FIRSTDOT
                       then                              (* ; "We're recording the second dot")
                             (if SECONDDOT
                                 then                    (* ; 
                                                           "Note only the two most recent dots")
                                       (SETQ FIRSTDOT SECONDDOT))
                             (SETQ SECONDDOT TEM)
                     else (SETQ FIRSTDOT TEM)))
               ((! ; NIL)                                    (* ; 
                             "SUBDIRECTORY, NAME and EXTENSION fields definitely terminated by now")
                    (if (SELCHARQ CODE
                                 (!                          (* ; 
               "! is only a delimiter on IFS, so ignore it if we know the ostype is something else")
                                    (AND OSTYPE (NEQ OSTYPE 'IFS)))
                                 (;                          (* ; "If we've already parsed the extension, then we have a semi in the middle of the version.  Skip it unless it's ;T or ;S")
                                    [AND BEYONDEXT (NOT (\UPF.TEMPFILEP FILE (ADD1 TEM])
                                 NIL)
                        then (GO NEXTCHAR))
                    (if FIRSTDOT
                        then                             (* ; 
                                                        "Have a name and/or extension to parse now")
                        (if
                         [AND SECONDDOT
                              (NOT (if OSTYPE
                                       then              (* ; 
                                      "Known OS type must be Tops20 for second dot to mean version")
                                             (EQ OSTYPE 'TOPS20)
                                     else                (* ; 
                                "Unknown OS type, so check that %"version%" is numeric or wildcard")
                                           (AND [for I from (ADD1 SECONDDOT)
                                                   to (SUB1 TEM) bind CH
                                                   always (OR (DIGITCHARP (SETQ CH
                                                                               (NTHCHARCODE FILE I)))
                                                                  (EQ CH (CHARCODE *]
                                                (SELCHARQ CODE
                                                     (NIL    (* ; "end of file name, ok")
                                                          T)
                                                     (;      (* ; 
                                              "This semi-colon better not be introducing a version")
                                                        (\UPF.TEMPFILEP FILE (ADD1 TEM)))
                                                     NIL]
                            then                         (* ; 
                                                           "Second dot is not intoducing a version")
                                  (SETQ FIRSTDOT SECONDDOT)
                                  (SETQ SECONDDOT NIL))
                        (UNPACKFILE1 'NAME POS (SUB1 FIRSTDOT))
                        (SETQ POS (ADD1 (if SECONDDOT
                                            then (UNPACKFILE1 'EXTENSION (ADD1 FIRSTDOT)
                                                            (SUB1 SECONDDOT))
                                                  (SETQ BEYONDEXT T)
                                                  SECONDDOT
                                          else FIRSTDOT)))
                        (SETQ BEYONDNAME T)
                        (SETQ FIRSTDOT NIL))
                    (UNPACKFILE1 (COND
                                    ((NOT BEYONDNAME)
                                     (SETQQ BEYONDNAME NAME))
                                    ((NOT BEYONDEXT)
                                     'EXTENSION)
                                    ((AND (EQ BEYONDEXT (CHARCODE ";"))
                                          (\UPF.TEMPFILEP FILE POS)))
                                    (T                       (* ; 
                                                           "Everything after the semi was version")
                                       'VERSION))
                           POS
                           (SUB1 TEM))
                    (if (NULL CODE)
                        then                             (* ; "End of string")
                              (RETURN (DREVERSE VAL)))
                    (SETQ BEYONDEXT CODE)                    (* ; 
                                                  "Note the character that terminated the name/ext")
                    (SETQ POS (ADD1 TEM)))
               (%'                                           (* ; "Quoter")
                   (add TEM 1))
               NIL)
      NEXTCHAR
          (SETQ CODE (NTHCHARCODE FILE (add TEM 1)))
          (GO NAMELP])

(LASTCHPOS
  [LAMBDA (CH STR START)                              (* ; "Edited 17-May-88 13:43 by MASINTER")
    (PROG (RESULT NC)
          (OR START (SETQ START 1))
          (while (SETQ NC (NTHCHARCODE STR START)) do (COND
                                                                 ((EQMEMB NC CH)
                                                                  (SETQ RESULT START))
                                                                 ((EQ NC (CHARCODE %'))
                                                                  (add START 1)))
                                                             (add START 1))
          (RETURN RESULT])

(\UPF.NEXTPOS
  [LAMBDA (CHAR STRING POS)                              (* lmm " 5-Oct-84 18:41")
    (bind NCH while (SETQ NCH (NTHCHARCODE STRING POS)) do (COND
                                                                          ((EQMEMB NCH CHAR)
                                                                           (RETURN POS))
                                                                          ((EQ NCH (CHARCODE %'))
                                                                           (add POS 1)))
                                                                      (add POS 1])

(\UPF.TEMPFILEP
  [LAMBDA (FILENAME START)                               (* ; "Edited  6-Jan-88 13:12 by bvm:")

    (* ;; "Checks whether START denotes a temporary mark for Twenex filename beginning at START.  Returns the appropriate field name if so.  Not sure we should parse this junk any more, but this at least localizes it.")

    (SELCHARQ (NTHCHARCODE FILENAME START)
         ((T S)                                              (* ; "Funny temp stuff")
              (AND (EQ START (NCHARS FILENAME))
                   'TEMPORARY))
         NIL])

(FILENAMEFIELD
  [LAMBDA (FILE FIELDNAME)                               (* ; "Edited  6-Mar-90 19:38 by nm")
    (UNPACKFILENAME.STRING FILE (SELECTQ FIELDNAME
                                        ((VERSION GENERATION) 
                                             'VERSION)
                                        ((DEVICE STRUCTURE) 
                                             'DEVICE)
                                        FIELDNAME)
           'FIELD NIL T])

(PACKFILENAME
  [LAMBDA N                                              (* bvm%: " 5-Jul-85 15:40")
    (COND
       ((AND (EQ N 1)
             (LISTP (ARG N 1)))                              (* ; "spread argument list")
        (APPLY (FUNCTION PACKFILENAME)
               (ARG N 1)))
       (T (PACK (PACKFILENAME.ASSEMBLE])

(PACKFILENAME.STRING
  [LAMBDA N                                              (* bvm%: " 5-Jul-85 15:41")
    (COND
       ((AND (EQ N 1)
             (LISTP (ARG N 1)))                              (* ; "spread argument list")
        (APPLY (FUNCTION PACKFILENAME.STRING)
               (ARG N 1)))
       (T (CONCATLIST (PACKFILENAME.ASSEMBLE])
)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(PUTPROPS CANONICAL.DIRECTORY MACRO
          [OPENLAMBDA (SRCSTRING)
            (AND
             SRCSTRING
             (LET
              ((LEN (NCHARS SRCSTRING)))
              (COND
                 ((EQ LEN 1)
                  (if (STREQUAL SRCSTRING "/")
                      then "<"
                    else SRCSTRING))
                 (T
                  (LET*
                   ((FATP (ffetch (STRINGP FATSTRINGP) of SRCSTRING))
                    (DSTSTRING (ALLOCSTRING LEN NIL NIL (AND FATP T)))
                    (DSTBASE (ffetch (STRINGP BASE) of DSTSTRING))
                    (DSTPOS 0)
                    (NEXTPOS -1))
                   (if (NOT FATP)
                       then
                       [for SRCPOS from 1 to LEN bind CODE
                          first (while (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
                                                      (CHARCODE (< / >)))
                                       do (add SRCPOS 1))
                                (if (> SRCPOS LEN)
                                    then (RETURN "<"))
                          do (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
                                      ((> /) 
                                           (if (> DSTPOS NEXTPOS)
                                               then (\PUTBASETHIN DSTBASE DSTPOS (CHARCODE >))
                                                     (SETQ NEXTPOS (add DSTPOS 1))))
                                      (%' (\PUTBASETHIN DSTBASE DSTPOS CODE)
                                          (add DSTPOS 1)
                                          (if (NEQ SRCPOS LEN)
                                              then (\PUTBASETHIN DSTBASE DSTPOS
                                                              (NTHCHARCODE SRCSTRING (add SRCPOS
                                                                                            1)))
                                                    (add DSTPOS 1)))
                                      (PROGN (\PUTBASETHIN DSTBASE DSTPOS CODE)
                                             (add DSTPOS 1)))
                          finally (RETURN (if (EQ DSTPOS LEN)
                                                  then (if (EQMEMB (NTHCHARCODE DSTSTRING -1)
                                                                          (CHARCODE (> /)))
                                                               then (SUBSTRING DSTSTRING 1 -2)
                                                             else DSTSTRING)
                                                elseif (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
                                                                  (CHARCODE (> /)))
                                                  then (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
                                                else (SUBSTRING DSTSTRING 1 DSTPOS]
                     else
                     (for SRCPOS from 1 to LEN bind CODE
                        first (while (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
                                                    (CHARCODE (< / >))) do (add SRCPOS 1))
                        do (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
                                    ((> /) 
                                         (if (> DSTPOS NEXTPOS)
                                             then (\PUTBASEFAT DSTBASE DSTPOS (CHARCODE >))
                                                   (SETQ NEXTPOS (add DSTPOS 1))))
                                    (%' (\PUTBASEFAT DSTBASE DSTPOS CODE)
                                        (add DSTPOS 1)
                                        (if (NEQ SRCPOS LEN)
                                            then (\PUTBASEFAT DSTBASE DSTPOS
                                                            (NTHCHARCODE SRCSTRING (add SRCPOS 1)
                                                                   ))
                                                  (add DSTPOS 1)))
                                    (PROGN (\PUTBASEFAT DSTBASE DSTPOS CODE)
                                           (add DSTPOS 1)))
                        finally (RETURN (if (EQ DSTPOS LEN)
                                                then (if (EQMEMB (NTHCHARCODE DSTSTRING -1)
                                                                        (CHARCODE (> /)))
                                                             then (SUBSTRING DSTSTRING 1 -2)
                                                           else DSTSTRING)
                                              elseif (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
                                                                (CHARCODE (> /)))
                                                then (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
                                              else (SUBSTRING DSTSTRING 1 DSTPOS])

(PUTPROPS UNPACKFILE1.DIRECTORY MACRO [OPENLAMBDA (NAM ST END)
                                                (LET* ((OLDDIR (SUBSTRING FILE ST END))
                                                       (NEWDIR (CANONICAL.DIRECTORY OLDDIR)))
                                                      (COND
                                                         [(NOT ONEFIELDFLG)
                                                          (SETQ VAL
                                                           (CONS (COND
                                                                    (PACKFLG (AND NEWDIR (MKATOM
                                                                                          NEWDIR)))
                                                                    (T (OR NEWDIR "")))
                                                                 (CONS NAM VAL]
                                                         ((EQMEMB NAM ONEFIELDFLG)
                                                          (RETURN (COND
                                                                     (PACKFLG (AND NEWDIR
                                                                                   (MKATOM NEWDIR)))
                                                                     (T (OR NEWDIR ""])

(PUTPROPS PACKFILENAME.ASSEMBLE MACRO
          [NIL
           (PROG ((BLIP "")
                  (I 1)
                  HOST DEVICE STRUCTURE DIRECTORY SUBDIRECTORY RELATIVEDIRECTORY NAME EXTENSION 
                  VERSION TEMPORARY PROTECTION ACCOUNT PACKLIST VAR VAL TEMP)
                 (DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY SUBDIRECTORY NAME EXTENSION 
                                     VERSION TEMPORARY PROTECTION ACCOUNT))
             LP  (COND
                    ((<= I N)

                     (* ;; "Grab the next field-name / value pair and fold it into the filename:")

                     (COND
                        ((LISTP (SETQ VAR (ARG N I)))
                         (SETQ VAL (CDR VAR))
                         (SETQ VAR (CAR VAR)))
                        ((<= (SETQ I (ADD1 I))
                             N)
                         (SETQ VAL (ARG N I)))
                        (T (SETQ VAL)))
                     (OR (STRINGP VAL)
                         (ATOM VAL)
                         (EQ VAR 'BODY)
                         (\ILLEGAL.ARG VAL))
                     (SELECTQ VAR
                         (BODY (MAP (UNPACKFILENAME.STRING (COND
                                                                  ((LISTP VAL)
                                                                   (PACKFILENAME.STRING VAL))
                                                                  (T VAL))
                                           NIL
                                           'OK)
                                    [FUNCTION (LAMBDA (X)
                                                (SELECTQ (CAR X)
                                                    (HOST (OR HOST (SETQ HOST (OR (CADR X)
                                                                                  BLIP))))
                                                    (DEVICE (OR DEVICE (SETQ DEVICE
                                                                        (OR (CADR X)
                                                                            BLIP))))
                                                    (DIRECTORY [OR DIRECTORY
                                                                   (COND
                                                                      (RELATIVEDIRECTORY (SETQ 
                                                                                          DIRECTORY 
                                                                                          BLIP))
                                                                      (T (SETQ DIRECTORY
                                                                          (OR (CADR X)
                                                                              BLIP])
                                                    (SUBDIRECTORY (OR SUBDIRECTORY
                                                                      (SETQ SUBDIRECTORY
                                                                       (OR (CADR X)
                                                                           BLIP))))
                                                    (RELATIVEDIRECTORY 
                                                         [OR RELATIVEDIRECTORY
                                                             (COND
                                                                (DIRECTORY (SETQ RELATIVEDIRECTORY 
                                                                            BLIP))
                                                                (T (SETQ RELATIVEDIRECTORY
                                                                    (OR (CADR X)
                                                                        BLIP])
                                                    (NAME (OR NAME (SETQ NAME (OR (CADR X)
                                                                                  BLIP))))
                                                    (EXTENSION (OR EXTENSION (SETQ EXTENSION
                                                                              (OR (CADR X)
                                                                                  BLIP))))
                                                    (VERSION (OR VERSION (SETQ VERSION
                                                                          (OR (CADR X)
                                                                              BLIP))))
                                                    (SHOULDNT]
                                    (FUNCTION CDDR)))
                         (HOST [OR HOST (SETQ HOST (COND
                                                      (VAL (SELCHARQ (CHCON1 VAL)
                                                                (({ %[ %() 
                                                                     (SUBSTRING VAL 2
                                                                            (SELCHARQ (NTHCHARCODE
                                                                                       VAL -1)
                                                                                 ((} %] %)) 
                                                                                      -2)
                                                                                 -1)))
                                                                VAL))
                                                      (T BLIP])
                         ((PATHNAME DIRECTORY) 
                              [COND
                                 (VAL
                                  (for X on (SETQ VAL (UNPACKFILENAME.STRING VAL NIL
                                                                     'RETURN))
                                     by (CDDR X)
                                     do (SELECTQ (CAR X)
                                                (HOST [COND
                                                         ((NOT HOST)
                                                          (SETQ HOST (OR (CADR X)
                                                                         BLIP])
                                                (DEVICE [COND
                                                           ((NOT DEVICE)
                                                            (SETQ DEVICE (OR (CADR X)
                                                                             BLIP])
                                                (SUBDIRECTORY [OR DIRECTORY
                                                                  (COND
                                                                     (RELATIVEDIRECTORY (SETQ 
                                                                                         DIRECTORY 
                                                                                         BLIP))
                                                                     (T (SETQ DIRECTORY
                                                                         (OR (CADR X)
                                                                             BLIP])
                                                (RELATIVEDIRECTORY 

                                 (* ;; "This used to set RELATIVEDIRECTORY to BLIP if DIRECTORY was already specified.  It really should act as a subdirectory in that case?  JDS")

                                                     (OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY
                                                                            (OR (CADR X)
                                                                                BLIP))))
                                                (DIRECTORY [OR DIRECTORY
                                                               (COND
                                                                  (RELATIVEDIRECTORY (SETQ DIRECTORY
                                                                                      BLIP))
                                                                  (T (SETQ DIRECTORY
                                                                      (OR (CADR X)
                                                                          BLIP])
                                                (ERROR "Illegal field in DIRECTORY slot" VAL)))
                                  (for X on VAL by (CDDR X)
                                     do (SELECTQ (CAR X)
                                                (HOST (OR DEVICE (SETQ DEVICE BLIP))
                                                      (OR DIRECTORY (SETQ DIRECTORY BLIP)))
                                                (DEVICE (OR DIRECTORY (SETQ DIRECTORY BLIP)))
                                                NIL)))
                                 (T (OR DIRECTORY (SETQ DIRECTORY BLIP])
                         (SUBDIRECTORY (OR SUBDIRECTORY (SETQ SUBDIRECTORY (OR VAL BLIP))))
                         (RELATIVEDIRECTORY 

                                 (* ;; "This used to set RELATIVEDIRECTORY to BLIP if DIRECTORY was already specified.  It really should act as a subdirectory in that case?  JDS")

                              (OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY (OR VAL BLIP))))
                         (DEVICE (OR DEVICE (SETQ DEVICE (OR VAL BLIP))))
                         (NAME (OR NAME (SETQ NAME (OR VAL BLIP))))
                         (EXTENSION (OR EXTENSION (SETQ EXTENSION (OR VAL BLIP))))
                         (VERSION (OR VERSION (SETQ VERSION (OR VAL BLIP))))
                         (TEMPORARY (OR TEMPORARY (SETQ TEMPORARY (OR VAL BLIP))))
                         (\ILLEGAL.ARG VAR))
                     (SETQ I (ADD1 I))
                     (GO LP)))
                 (COND
                    ((EQ HOST BLIP)
                     (SETQ HOST NIL)))
                 (COND
                    ((EQ DEVICE BLIP)
                     (SETQ DEVICE NIL)))
                 (COND
                    ((EQ DIRECTORY BLIP)
                     (SETQ DIRECTORY NIL)))
                 [COND
                    ((EQ SUBDIRECTORY BLIP)
                     (SETQ SUBDIRECTORY NIL))
                    ((AND NIL SUBDIRECTORY)
                     (COND
                        ((AND (NULL DIRECTORY)
                              (OR HOST DEVICE))
                         (SETQ DIRECTORY SUBDIRECTORY)
                         (SETQ SUBDIRECTORY NIL]
                 (COND
                    ((EQ RELATIVEDIRECTORY BLIP)
                     (SETQ RELATIVEDIRECTORY NIL)))
                 (RETURN (NCONC (AND HOST (LIST "{" HOST "}"))
                                [AND DEVICE (COND
                                               ((AND (SETQ TEMP (LASTCHPOS (CHARCODE %:)
                                                                       DEVICE 1))
                                                     (EQ TEMP (NCHARS DEVICE)))
                                                (LIST DEVICE))
                                               (T (LIST DEVICE ":"]
                                [COND
                                   (DIRECTORY (COND
                                                 [[OR (STREQUAL DIRECTORY "<")
                                                      (AND (SETQ TEMP (LASTCHPOS
                                                                       (CHARCODE (> /))
                                                                       DIRECTORY 1))
                                                           (EQ TEMP (NCHARS DIRECTORY]
                                                  (COND
                                                     ((EQMEMB (NTHCHARCODE DIRECTORY 1)
                                                             (CHARCODE (< /)))
                                                      (LIST DIRECTORY))
                                                     (T (LIST (CL:FIRST \FILENAME.SYNTAX)
                                                              DIRECTORY]
                                                 (T (LIST (CL:FIRST \FILENAME.SYNTAX)
                                                          DIRECTORY
                                                          (CL:SECOND \FILENAME.SYNTAX]
                                [COND
                                   (RELATIVEDIRECTORY (COND
                                                         ((AND (SETQ TEMP (LASTCHPOS
                                                                           (CHARCODE (> /))
                                                                           RELATIVEDIRECTORY 1))
                                                               (EQ TEMP (NCHARS RELATIVEDIRECTORY)))
                                                          (LIST RELATIVEDIRECTORY))
                                                         (T (LIST RELATIVEDIRECTORY (CL:SECOND 
                                                                                     \FILENAME.SYNTAX
                                                                                           ]
                                [COND
                                   (SUBDIRECTORY (LIST SUBDIRECTORY (CL:SECOND \FILENAME.SYNTAX]
                                (AND NAME (NEQ NAME BLIP)
                                     (LIST NAME))
                                (AND (OR (AND EXTENSION (NEQ EXTENSION BLIP))
                                         (AND VERSION (NEQ VERSION BLIP)))
                                     (LIST (COND
                                              ((AND EXTENSION (EQ (CHCON1 EXTENSION)
                                                                  (CHARCODE %.)))
                                               BLIP)
                                              (T '%.))
                                           (OR EXTENSION BLIP)))
                                (AND VERSION (NEQ VERSION BLIP)
                                     (LIST (CL:THIRD \FILENAME.SYNTAX)
                                           (COND
                                              ((FIXP VERSION)
                                               VERSION)
                                              (T (SELCHARQ (CHCON1 VERSION)
                                                      ((%. ! ;) 
                                                           (SUBSTRING VERSION 2 -1))
                                                      VERSION])

(PUTPROPS UNPACKFILE1 MACRO [OPENLAMBDA (NAM ST END)
                                                             (* lmm "22-APR-81 22:21")
                                      (COND
                                         [(NOT ONEFIELDFLG)
                                          (SETQ VAL (CONS (COND
                                                             (PACKFLG (SUBATOM FILE ST END))
                                                             (T (OR (SUBSTRING FILE ST END)
                                                                    "")))
                                                          (CONS NAM VAL]
                                         ((EQMEMB NAM ONEFIELDFLG)
                                          (RETURN (COND
                                                     (PACKFLG (SUBATOM FILE ST END))
                                                     (T (OR (SUBSTRING FILE ST END)
                                                            ""])
)
)

(RPAQQ \FILENAME.SYNTAX ("<" ">" ";"))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \FILENAME.SYNTAX)
)



(* ; "saving and restoring system state")

(DEFINEQ

(LOGOUT
  [LAMBDA (FAST)                                       (* ; "Edited 15-Mar-2021 11:53 by larry")
    (\USEREVENT 'BEFORELOGOUT)
    (OR (EQ FAST T)
        (\FLUSHVMOK? 'LOGOUT))                               (* ; 
                                            "Check that we have a vmem file before allowing LOGOUT")
    (\PROCESS.BEFORE.LOGOUT)
    (\DEVICEEVENT 'BEFORELOGOUT)
    (\SETTOTALTIME)                                          (* ; 
                                         "update the total time that this sysout has been running.")
    (\LOGOUT0 FAST)

    (* ;; "Must re-establish the state of devices and of previously open files that might have been modified at the EXEC.")

    (\RESETKEYBOARD)
    (\DEVICEEVENT 'AFTERLOGOUT)
    (\OPENLINEBUF)
    (\PROCESS.AFTER.EXIT 'AFTERLOGOUT)
    (\USEREVENT 'AFTERLOGOUT)
    (INTERPRET.REM.CM)
    NIL])

(MAKESYS
  [LAMBDA (FILE NAME)
    (DECLARE (GLOBALVARS \MISCSTATS)
           (SPECVARS FILE NAME))                       (* ; "Edited 15-Mar-2021 12:40 by larry")
                                                             (* ; "Edited 28-Jul-88 18:16 by drc:")
    (\USEREVENT 'BEFOREMAKESYS)
    (HERALD (CONCAT (OR NAME (CL:STRING-CAPITALIZE MAKESYSNAME))
                       " "
                       (SUBSTRING (SETQ MAKESYSDATE (DATE))
                              1 11)
                       " ..."))
    (\DEVICEEVENT 'BEFOREMAKESYS)

    (* ;; "RMK:  make sysout on a temp file, then rename it in order to get version numbers")

    (LET [(NEWFILE (\COPYSYS (OUTFILEP FILE]
         (COND
            ((NLISTP NEWFILE)                                (* ; 
                               "Coming back from doing the MAKESYS, so just set up to keep going.,")
             (\DEVICEEVENT 'AFTERDOMAKESYS)
             (\USEREVENT 'AFTERDOMAKESYS)
             FILE)
            (T                                               (* ; 
                                       "Coming back in the MAKESYS'd sysout, so restart the world.")
               (\DEVICEEVENT 'AFTERMAKESYS)
               (\PROCESS.AFTER.EXIT 'AFTERMAKESYS)
               (PRIN1 HERALDSTRING T)
               (\USEREVENT 'AFTERMAKESYS)
               (INTERPRET.REM.CM)                        (* ; 
                                                           "Run the commands in the file REM.CM")
               (RESET])

(SYSOUT
  [LAMBDA (FILE)                                       (* ; "Edited 15-Mar-2021 12:17 by larry")
                                                             (* hdj "29-Sep-86 12:14")
    (DECLARE (GLOBALVARS \MISCSTATS)
           (SPECVARS FILE))                                  (* ; 
                                           "FILE is special so that BEFORESYSOUTFORMS can alter it")
    (\USEREVENT 'BEFORESYSOUT)
    (\DEVICEEVENT 'BEFORESYSOUT)

    (* ;; 
  "RMK:  Fix it so that sysouts are versioned.  Temp file goes to same place as eventual sysout.")

    (LET ((TOTALTIMESAVE (fetch TOTALTIME of \MISCSTATS))
          NEWFILE)                                           (* ; 
                    "update the total time field so that the run time in the sysout will be right.")
         (\SETTOTALTIME)
         (SETQ NEWFILE (\COPYSYS (OUTFILEP FILE)))
         [COND
            ((NLISTP NEWFILE)

             (* ;; "Continuing in same sysout;  reset TOTALTIME in misc stats page to not include the time before the sysout.")

             (replace TOTALTIME of \MISCSTATS with TOTALTIMESAVE)
             (\DEVICEEVENT 'AFTERDOSYSOUT)
             (\USEREVENT 'AFTERDOSYSOUT))
            (T                                               (* ; "restarting")
               (\DEVICEEVENT 'AFTERSYSOUT)
               (\PROCESS.AFTER.EXIT 'AFTERSYSOUT)
               (INTERPRET.REM.CM)
               (\USEREVENT 'AFTERSYSOUT]
         FILE])

(SAVEVM
  [LAMBDA NIL                                          (* ; "Edited 15-Mar-2021 12:04 by larry")

    (* ;; "Save the virtual memory.  This is similar to logging out, then back in, but is much faster, since it doesn't lose any pages.  Conceptually, this is like doing a sysout to Lisp.virtualmem")

    (\USEREVENT 'BEFORESAVEVM)
    (\DEVICEEVENT 'BEFORESAVEVM)
    (COND
       ((\FLUSHVM)
        (\RESETKEYBOARD)                                     (* ; 
                                                           "Returns T when starting up fresh")
        (\DEVICEEVENT 'AFTERSAVEVM)
        (\PROCESS.AFTER.EXIT 'AFTERSAVEVM)
        (\USEREVENT 'AFTERSAVEVM)
        T)
       (T (\DEVICEEVENT 'AFTERDOSAVEVM)
          (\USEREVENT 'AFTERDOSAVEVM])

(HERALD
  [LAMBDA (STR)                                          (* wt%: " 2-MAY-79 15:38")
    (AND STR (SETQ HERALDSTRING STR))
    HERALDSTRING])

(INTERPRET.REM.CM
  [LAMBDA (RETFLG)                                     (* ; "Edited 15-Mar-2021 12:27 by larry")
    (DECLARE (GLOBALVARS STARTUPFORM))

(* ;;; "Looks at REM.CM and evaluates the form there if the first character of the file is open paren or doublequote.  If it's a string, it will be unread,, else the form will be evaluated at the next prompt.  For use in INIT.LISP, among others.  If RETFLG is true, the expression read is simply returned")

    (PROG ((FILE (UNIX-GETENV "LDEINIT"))
           COM)
          (OR FILE (RETURN))
          (SETQ FILE (OPENSTREAM FILE 'INPUT))
          (COND
             [[AND (IGREATERP (GETFILEINFO FILE 'LENGTH)
                          0)
                   (EQ (SKIPSEPRS FILE T)
                       '%")
                   (SETQ COM (CAR (NLSETQ (READ FILE T]
              (CLOSEF FILE)
              (COND
                 (RETFLG                                     (* ; "Save it to return"))
                 (T                                          (* ; "Unread a string")
                                                             (* ; 
                                   "RMK: Replace CR and LF by space to avoid EOL convention issues")
                    (for I from 1 to (NCHARS COM)
                       when (FMEMB (NTHCHARCODE COM I)
                                       (CHARCODE (CR LF EOL))) do (RPLCHARCODE COM I (CHARCODE
                                                                                          EOL)))
                    (BKSYSBUF COM]
             (T (CLOSEF FILE)))
          (RETURN (COND
                     (RETFLG COM)
                     (COM T])

(\USEREVENT
  [LAMBDA (EVENT)
    (DECLARE (GLOBALVARS AROUNDEXITFNS))             (* bvm%: "16-Dec-83 15:27")
    (for FN in (SELECTQ EVENT
                           ((BEFORELOGOUT BEFORESYSOUT BEFORESAVEVM BEFOREMAKESYS) 
                                AROUNDEXITFNS)
                           (REVERSE AROUNDEXITFNS)) do (APPLY* FN EVENT])
)

(ADDTOVAR AROUNDEXITFNS )

(RPAQ? HERALDSTRING "")

(RPAQ? \USERNAME )
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS HERALDSTRING USERNAME \USERNAME AROUNDEXITFNS)
)
(DEFINEQ

(USERNAME
  [LAMBDA (FLG STRPTR PRESERVECASE)                      (* lmm "28-MAR-82 14:10")
                                                             (* ; 
                                                    "On 10, USERNAME can take a user number as arg")
    (PROG (ADDR NAME)
          (SETQ NAME (COND
                        (FLG NIL)
                        ((NEQ 0 (SETQ ADDR (fetch (IFPAGE UserNameAddr) of \InterfacePage)))
                         (GetBcplString (\ADDBASE (EMADDRESS 0)
                                               ADDR)
                                (EQ STRPTR T)))
                        (T \USERNAME)))
          (OR PRESERVECASE (NULL NAME)
              (SETQ NAME (U-CASE NAME)))
          (RETURN (COND
                     ((NULL NAME)
                      NIL)
                     ((STRINGP STRPTR)
                      (SUBSTRING NAME 1 -1 STRPTR))
                     (T NAME])

(SETUSERNAME
  [LAMBDA (NAME)                                         (* lmm "28-MAR-82 14:11")
                                                             (* ; 
                                                           "Changed interpretation of UserName0")
    (COND
       (NAME (PROG ((ADDR (fetch (IFPAGE UserNameAddr) of \InterfacePage)))
                   (RETURN (COND
                              ((NEQ ADDR 0)
                               (SetBcplString (\ADDBASE (EMADDRESS 0)
                                                     ADDR)
                                      NAME)
                               (SETQ USERNAME (USERNAME NIL T)))
                              (T (SETQ \USERNAME (CONCAT NAME])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY 

(FILESLOAD (LOADCOMP)
       FILEIO)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME)
)
(PUTPROPS ADIR COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 
1991 1992 1920 2017 2020 2021))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (3067 9761 (DELFILE 3077 . 3238) (FULLNAME 3240 . 3607) (INFILE 3609 . 3757) (INFILEP 
3759 . 3894) (IOFILE 3896 . 4036) (OPENFILE 4038 . 4438) (OPENSTREAM 4440 . 8748) (OUTFILE 8750 . 8901
) (OUTFILEP 8903 . 9039) (RENAMEFILE 9041 . 9347) (SIMPLE.FINDFILE 9349 . 9759)) (10133 29724 (
UNPACKFILENAME 10143 . 10329) (UNPACKFILENAME.STRING 10331 . 26603) (LASTCHPOS 26605 . 27299) (
\UPF.NEXTPOS 27301 . 27946) (\UPF.TEMPFILEP 27948 . 28525) (FILENAMEFIELD 28527 . 29012) (PACKFILENAME
 29014 . 29357) (PACKFILENAME.STRING 29359 . 29722)) (52165 59307 (LOGOUT 52175 . 53092) (MAKESYS 
53094 . 54677) (SYSOUT 54679 . 56239) (SAVEVM 56241 . 57041) (HERALD 57043 . 57203) (INTERPRET.REM.CM 
57205 . 58930) (\USEREVENT 58932 . 59305)) (59489 61216 (USERNAME 59499 . 60455) (SETUSERNAME 60457 . 
61214)))))
STOP
\ No newline at end of file
+(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "21-Mar-2021 21:59:07" {DSK}<home>larry>ilisp>medley>sources>ADIR.;30 65795  

      changes to%:  (VARS ADIRCOMS)
                    (FNS \FLUSHVM \LOGOUT0)

      previous date%: "16-Mar-2021 19:55:51" {DSK}<home>larry>ilisp>medley>sources>ADIR.;26)


(* ; "
Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corporation.
")

(PRETTYCOMPRINT ADIRCOMS)

(RPAQQ ADIRCOMS
       [[COMS                                                (* ; "user-level i/o routines")
              (FNS DELFILE FULLNAME INFILE INFILEP IOFILE OPENFILE OPENSTREAM OUTFILE OUTFILEP 
                   RENAMEFILE SIMPLE.FINDFILE VMEMSIZE \COPYSYS \FLUSHVM \LOGOUT0)
              (CONSTANTS (MULTIPLE.STREAMS.PER.FILE.ALLOWED T))
              (P (MOVD? 'SIMPLE.FINDFILE 'FINDFILE NIL T))
              (DECLARE%: DONTEVAL@LOAD DOCOPY (P 

                                       (* ;; "for the benefit of the call to PATHNAMEP in OPENSTREAM.  PATHNAMEP (and pathnames) get defined much later in the loadup.")

                                                 (MOVD? 'NILL 'CL:PATHNAMEP]
        (COMS (FNS UNPACKFILENAME UNPACKFILENAME.STRING LASTCHPOS \UPF.NEXTPOS \UPF.TEMPFILEP 
                   FILENAMEFIELD PACKFILENAME PACKFILENAME.STRING)
              (DECLARE%: DONTCOPY (MACROS CANONICAL.DIRECTORY UNPACKFILE1.DIRECTORY 
                                         PACKFILENAME.ASSEMBLE UNPACKFILE1))
              (VARS \FILENAME.SYNTAX)
              (GLOBALVARS \FILENAME.SYNTAX))
        (COMS                                                (* ; 
                                                           "saving and restoring system state")
              (FNS LOGOUT MAKESYS SYSOUT SAVEVM HERALD INTERPRET.REM.CM \USEREVENT)
              (ADDVARS (AROUNDEXITFNS))
              (INITVARS (HERALDSTRING "")
                     (\USERNAME))
              (GLOBALVARS HERALDSTRING USERNAME \USERNAME AROUNDEXITFNS)
              (FNS USERNAME SETUSERNAME))
        (LOCALVARS . T)
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
                                                                FILEIO))
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML)
                                                                             (LAMA 
                                                                                  PACKFILENAME.STRING
                                                                                   PACKFILENAME])



(* ; "user-level i/o routines")

(DEFINEQ

(DELFILE
  [LAMBDA (FILE)                                         (* bvm%: "23-Oct-85 11:20")
    (AND FILE (NEQ FILE T)
         (\DELETEFILE FILE])

(FULLNAME
  [LAMBDA (X RECOG)                                      (* rmk%: "22-AUG-83 13:33")
    (COND
       ((type? STREAM X)
        (fetch (STREAM FULLNAME) of X))
       (T (SELECTQ RECOG
              (NIL (SETQQ RECOG OLD))
              ((OLD OLD/NEW NEW OLDEST))
              (\ILLEGAL.ARG RECOG))
          (\GETFILENAME X RECOG])

(INFILE
  [LAMBDA (FILE)                                         (* rmk%: " 3-OCT-79 14:23")
    (INPUT (OPENFILE FILE 'INPUT 'OLD])

(INFILEP
  [LAMBDA (FILE)                                         (* rmk%: " 9-OCT-79 22:39")
    (\GETFILENAME FILE 'OLD])

(IOFILE
  [LAMBDA (FILE)                                         (* rmk%: " 5-SEP-81 13:54")
    (OPENFILE FILE 'BOTH 'OLD])

(OPENFILE
  [LAMBDA (FILE ACCESS RECOG PARAMETERS OPTIONAL)        (* ; "Edited 23-May-91 19:12 by jds")
    (if MULTIPLE.STREAMS.PER.FILE.ALLOWED
        then (OPENSTREAM FILE ACCESS RECOG PARAMETERS OPTIONAL)
      else (fetch (STREAM FULLNAME) of (OPENSTREAM FILE ACCESS RECOG PARAMETERS 
                                                          OPTIONAL])

(OPENSTREAM
  [LAMBDA (FILE ACCESS RECOG PARAMETERS OBSOLETE)        (* hdj "28-Aug-86 14:50")
    (PROG (REC OLDSTREAM STREAM)
          (SELECTQ ACCESS
              ((INPUT OUTPUT BOTH APPEND))
              (\ILLEGAL.ARG ACCESS))
          (SETQ REC (SELECTQ RECOG
                        ((EXACT NEW OLD OLD/NEW OLDEST) 
                             RECOG)
                        (NIL (SELECTQ ACCESS
                                 (INPUT 'OLD)
                                 (OUTPUT 'NEW)
                                 'OLD/NEW))
                        (\ILLEGAL.ARG RECOG)))
          (if (OR (LISTP OBSOLETE)
                      (AND PARAMETERS (NLISTP PARAMETERS)))
              then 

                    (* ;; "used to have OPENFILE/OPENSTREAM with BYTESIZE and PARAMETERS.  Now it will take PARAMETERS, and generally ignore the BYTESIZE")

                    (SETQ PARAMETERS (APPEND (SELECTQ PARAMETERS
                                                 (7 '((TYPE TEXT)))
                                                 (8 '((TYPE BINARY)))
                                                 NIL)
                                            OBSOLETE)))
          (COND
             ((OR (EQ FILE T)
                  (NULL FILE))

              (* ;; "Handle T and NIL separately, cause they can return the terminal streams, for which the search isn't necessary and the \ADDOFD shouldn't be done.")

              (SETQ STREAM (\GETSTREAM FILE ACCESS))
              (\DO.PARAMS.AT.OPEN STREAM ACCESS PARAMETERS)
              (RETURN STREAM)))

     (* ;; "Explicitly test for PATHNAMEP, as PATHNAMEP will have a NILL def early in the loadup, and the tests in \CONVERT-PATHNAME won't break anything")

     (* ;; "Pavel changed a call to (PATHNAMEP FILE) into (TYPEP FILE `PATHNAME) because PATHNAMEP didn't have a NILL defn early in the loadup and TYPEP has an optimizer on it that compiles away the call to TYPEP which also has no defn early in the loadup.")

     (* ;; "Pavel also added the call to MKSTRING below as a temporary hack to get around the fact that the Interlisp string functions can't yet handle Common Lisp simple-strings.")

          (if (TYPEP FILE 'PATHNAME)
              then (SETQ FILE (\CONVERT-PATHNAME FILE)))

     (* ;; "We open the file before looking to see whether it is already open.  This guarantees that we acquire the opening rights at the time we lookup the name.  We then check to see if it is currently open in Lisp.  If it is, we return the previous stream, which has the file's current state.  ")

     (* ;; "There are still potential problems: First, an interrupt can happen while we are doing the search which causes the file to be deleted or re-opened beneath us, BEFORE it gets added to \OPENFILES.  Second, a network device might not allow multiple openings of the file, even by the same guy with the same mode.")

          (SETQ STREAM (\OPENFILE FILE ACCESS REC PARAMETERS))
          (COND
             [[AND (NOT MULTIPLE.STREAMS.PER.FILE.ALLOWED)
                   (SETQ OLDSTREAM (\SEARCHOPENFILES (fetch FULLNAME of STREAM]

              (* ;; "There is already a stream open on the file.  Check that there is no conflict.  Eventually all this registration belongs in the device, so that we can have multiple streams open per file")

              (COND
                 ((AND (EQ ACCESS 'INPUT)
                       (EQ (fetch ACCESS of OLDSTREAM)
                           'INPUT))                          (* ; 
    "Dispose of the newly-obtained stream, This might be a noop, but a network device (LEAF) cares")
                  (OR (EQ STREAM OLDSTREAM)
                      (\CLOSEFILE STREAM))
                  (\DO.PARAMS.AT.OPEN OLDSTREAM ACCESS PARAMETERS)
                                                             (* ; "Do parameters on the old stream")
                  (RETURN OLDSTREAM))
                 (T (LISPERROR "FILE WON'T OPEN" FILE]
             (T (AND (NOT MULTIPLE.STREAMS.PER.FILE.ALLOWED)
                     (\ADDOFD STREAM))                       (* ; 
                                                       "Parameters done on new stream by \OPENFILE")
                (RETURN STREAM])

(OUTFILE
  [LAMBDA (FILE)                                         (* rmk%: " 3-OCT-79 14:24")
    (OUTPUT (OPENFILE FILE 'OUTPUT 'NEW])

(OUTFILEP
  [LAMBDA (FILE)                                         (* rmk%: " 9-OCT-79 22:39")
    (\GETFILENAME FILE 'NEW])

(RENAMEFILE
  [LAMBDA (OLDFILE NEWFILE)                              (* hdj " 4-Sep-86 16:56")
    (SETQ OLDFILE (\CONVERT-PATHNAME OLDFILE))
    (SETQ NEWFILE (\CONVERT-PATHNAME NEWFILE))
    (AND OLDFILE NEWFILE (NEQ OLDFILE T)
         (NEQ NEWFILE T)
         (\RENAMEFILE OLDFILE NEWFILE])

(SIMPLE.FINDFILE
  [LAMBDA (FILE DUMMY DIRLST)                            (* bvm%: "23-Oct-85 11:22")
    (OR (for DIR in DIRLST when (SETQ $$VAL (INFILEP (PACKFILENAME.STRING
                                                                      'DIRECTORY DIR 'BODY FILE)))
           do (RETURN $$VAL))
        (AND (NOT (MEMB NIL DIRLST))
             (INFILEP FILE])

(VMEMSIZE
  [LAMBDA NIL                                            (* bvm%: " 1-NOV-82 16:44")
    (fetch (IFPAGE NActivePages) of \InterfacePage])

(\COPYSYS
  [LAMBDA (FILE SYSNAME DONTSAVE)                      (* ; "Edited 16-Mar-2021 19:46 by larry")
    (PROG (FULLNAME VAL HOST)
      RETRY
          (SETQ FILE (PACKFILENAME.STRING 'BODY FILE 'BODY "WORK.SYSOUT" 'BODY 
                            \CONNECTED.DIRECTORY))
          [SELECTQ [SETQ HOST (U-CASE (FILENAMEFIELD FILE 'HOST]
              (DSK [SETQ FULLNAME (PACKFILENAME.STRING 'HOST HOST 'EXTENSION "tmpsysout"
                                         'BODY
                                         (\UFS.RECOGNIZE.FILE FILE 'NON (\GETDEVICEFROMNAME HOST]
                   (SETQ VAL (\FLUSHVM FULLNAME))
                   (SETQ FULLNAME (RENAMEFILE FULLNAME FILE)))
              (UNIX [SETQ FULLNAME (CONCAT "{" HOST "}" (\UFS.RECOGNIZE.FILE FILE 'NON (
                                                                                   \GETDEVICEFROMNAME
                                                                                        HOST]
                                                             (* ; "\DOFLUSHVM ")
                    (SETQ VAL (\FLUSHVM FULLNAME)))
              (PROGN (SETQ VAL (\FLUSHVM))
                     (LET ((UNIXVAR (UNIX-GETENV "LDEDESTSYSOUT")))
                                                             (* ; 
                                  "\FLSUVM saves image to  Unix enviroment var  or lisp.virtualmem")
                          (SETQ FULLNAME (COPYFILE (COND
                                                      (UNIXVAR (CONCAT "{DSK}" UNIXVAR))
                                                      (T "{DSK}~/lisp.virtualmem"))
                                                FILE
                                                '((TYPE BINARY]
          (COND
             ((NULL VAL)

              (* ;; "First clause of OR is T when resuming this vmem;  second is starting the sysout.  Unless \COPYSYS1 itself does a \FLUSHVM, the second never returns T, yes?  NIL is normal return (continuing in same image), <fixp> is error return")
                                                             (* ; "Continuing in the current image")
              (\DAYTIME0 \LASTUSERACTION)
              (RETURN FULLNAME))
             ((AND (SMALLP VAL)
                   (IGREATERP 0 VAL))                        (* ; 
                                                           "Error occurred while making sysout.")
              (LISPERROR (IMINUS VAL)
                     FULLNAME)
              (GO RETRY))
             (T                                              (* ; "Starting sysout")
                (\CLEARSYSBUF T)                             (* ; 
                                                           "Get rid of any spurious typeahead")
                (\RESETKEYBOARD)                             (* ; "Enable keyhandler")
                (RETURN (LIST FULLNAME])

(\FLUSHVM
  [LAMBDA (MAIKO.SYSOUTFILE)                           (* ; "Edited 16-Mar-2021 10:59 by larry")
                                                            (* ; "Edited  6-Jan-89 19:23 by Hayata")

    (* ;; 
  "Writes out all dirty pages to vmem, making it consistent.  Returns NIL now, T  on restart")

    (UNINTERRUPTABLY
        (PROG NIL
              (SELECTQ (\MISCAPPLY* (FUNCTION \DOFLUSHVM)
                              MAIKO.SYSOUTFILE)
                  (NIL (RETURN NIL))
                  (1 (ERROR "Can not find sysout file"))
                  (2 (ERROR "FILE-SYSTEM-RESOURCES-EXCEEDED"))
                  (3 (ERROR "Can not open sysout file"))
                  (4 (ERROR "Can not seek sysout file"))
                  (5 (ERROR "Can not write sysout file"))
                  (6 (ERROR "Connection timed out"))
                  NIL)
              (SETQ \DOFAULTINIT T)
              (\CONTEXTSWITCH \FAULTFXP)
              (for VAR in \SYSTEMCACHEVARS do (SET VAR NIL))
              (RETURN T)))])

(\LOGOUT0
  [LAMBDA (FAST)                                       (* ; "Edited 21-Mar-2021 21:13 by larry")
    (OR (AND (NOT FAST)
             (\FLUSHVM))
        (SUBRCALL LISPFINISH FAST])
)
(DECLARE%: EVAL@COMPILE 

(RPAQQ MULTIPLE.STREAMS.PER.FILE.ALLOWED T)


(CONSTANTS (MULTIPLE.STREAMS.PER.FILE.ALLOWED T))
)

(MOVD? 'SIMPLE.FINDFILE 'FINDFILE NIL T)
(DECLARE%: DONTEVAL@LOAD DOCOPY 


(* ;; "for the benefit of the call to PATHNAMEP in OPENSTREAM.  PATHNAMEP (and pathnames) get defined much later in the loadup.")


(MOVD? 'NILL 'CL:PATHNAMEP)
)
(DEFINEQ

(UNPACKFILENAME
  [LAMBDA (FILE ONEFIELDFLG OSTYPE)                      (* ; "Edited  6-Jan-88 13:13 by bvm:")
    (UNPACKFILENAME.STRING FILE ONEFIELDFLG NIL OSTYPE T])

(UNPACKFILENAME.STRING
  [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 30-Mar-90 22:37 by nm")

(* ;;; "Given a string or atom representation of a file name, unpack it into its component parts")

    (PROG ((POS 1)
           (LEN (NCHARS FILE))
           TEM BEYONDNAME BEYONDEXT VAL CODE HOSTP SUBDIREND FIRSTDOT SECONDDOT USEDSEMI)
          (COND
             ((NULL FILE)
              (RETURN NIL))
             ((OR (LITATOM FILE)
                  (STRINGP FILE)
                  (NUMBERP FILE)))
             ((TYPEP FILE 'PATHNAME)
              (RETURN (UNPACKPATHNAME.STRING FILE ONEFIELDFLG DIRFLG PACKFLG)))
             [(STREAMP FILE)                                 (* ; 
                                               "For streams, use full name.  If anonymous, fake it")
              (SETQ FILE (OR (ffetch FULLFILENAME of FILE)
                             (RETURN (COND
                                        (ONEFIELDFLG (AND (EQ ONEFIELDFLG 'NAME)
                                                          FILE))
                                        (T (LIST 'NAME FILE]
             (T (\ILLEGAL.ARG FILE)))
          (COND
             ((SELCHARQ (NTHCHARCODE FILE 1)
                   ({                                        (* ; "normal use in Interlisp-D")
                      (SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE })
                                                 FILE 2)
                                          0))))
                   (%[                                       (* ; 
                                                  "some Xerox and Arpanet systems use '[' for host")
                       (SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE "]")
                                                  FILE 2)
                                           0))))
                   (%(                                       (* ; 
                                                "this is the 'proposed standard' for Xerox servers")
                       (SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE ")")
                                                  FILE 2)
                                           0))))
                   NIL)
              (UNPACKFILE1 'HOST 2 TEM)
              [COND
                 ((EQ TEM -1)                                (* ; 
    "Started with the host field delimiter, but there was no corresponding terminating delimiter .")
                                                             (* ; 
                                           "I'm not sure why the name is dealt with the host name.")
                  (RETURN (DREVERSE VAL]
              (SETQ POS (IPLUS TEM 2))
              [if (EQ OSTYPE T)
                  then                                   (* ; 
                                                           "Use actual host to determine os type")
                        (SETQ OSTYPE (GETHOSTINFO (CAR VAL)
                                            'OSTYPE]
              (SETQ HOSTP T)))
          (COND
             ((SETQ TEM (LASTCHPOS (CHARCODE %:)
                               FILE POS))                    (* ; 
                                 "all device returned have DEVICE.END on it so that NIL: will work")
              (UNPACKFILE1 'DEVICE POS (if CLFLG
                                           then (SUB1 TEM)
                                         else TEM))
              (SETQ POS (ADD1 TEM))
              (SETQ HOSTP T)))
          (COND
             ((EQ DIRFLG 'RETURN)                            (* ; "assert that this is a directory; more forgiving about missing trailing delimiter. There are two distinct cases for the missing initial delimiter.  If HOST is also specified, it is dealt with as the true %"relative pathname%" by device dependent manner, otherwise it is dealt with following the %"incomplete file names%" convention.  In the first case, returns RELATIVEDIRECTORY instead of DIRECTORY and in the second case, returns SUBDIRECTORY.")
              (LET ((TYPE 'DIRECTORY)
                    (START (SELCHARQ (NTHCHARCODE FILE POS)
                                (NIL                         (* ; "just host, return")
                                     (RETURN (DREVERSE VAL)))
                                ((/ <)                       (* ; 
                                                    "Started with the initial directory delimiter.")
                                     (ADD1 POS))
                                POS))
                    END)
                   (SETQ END (SELCHARQ (NTHCHARCODE FILE -1)
                                  ((/ >) 
                                       [COND
                                          ((EQ START POS)    (* ; 
                                                         "Didn't start with a directory delimiter,")
                                           (COND
                                              ((NOT HOSTP)   (* ; "%"Incomplete file names%" case defined in IRM.  This is a subdirectory of the current connected directory")
                                               (SETQ TYPE 'SUBDIRECTORY))
                                              (T             (* ; "True %"relative pathname%".  The way to deal with it is dependent on the device on which HOST is implemented.")
                                                 (SETQ TYPE 'RELATIVEDIRECTORY]
                                       (COND
                                          ((EQ LEN POS)      (* ; 
                                       "Only the initial directory is specified (i.e. %"{DSK}/%").")
                                           (SETQ START POS)
                                           -1)
                                          (T -2)))
                                  (PROGN [COND
                                            [(EQ START POS)  (* ; 
                                            "Both of the initial and trail delimiters are omitted.")
                                             (COND
                                                ((NOT HOSTP) (* ; "%"Incomplete file names%" case defined in IRM.  This is a subdirectory of the current connected directory")
                                                 (SETQ TYPE 'SUBDIRECTORY))
                                                (T           (* ; "True %"relative pathname%".  The way to deal with it is dependent on the device on which HOST is implemented.")
                                                   (SETQ TYPE 'RELATIVEDIRECTORY]
                                            (T (COND
                                                  ((EQ LEN POS)
                                                             (* ; 
                                       "Only the initial directory is specified (i.e. %"{DSK}<%").")
                                                   (SETQ START POS]
                                         -1)))
                   (UNPACKFILE1.DIRECTORY TYPE START END))
              (RETURN (DREVERSE VAL)))
             ((SELCHARQ (NTHCHARCODE FILE POS)
                   (/                                        (* ; 
                                                "unix and the 'xerox standard' use / for delimiter")
                                                             (* ; 
                       "In the case of the {DSK}/FOO>BAR, FOO should be dealt with as a directory.")
                      (SETQ TEM (LASTCHPOS (CHARCODE (/ >))
                                       FILE
                                       (ADD1 POS)))
                      T)
                   ((< >)                                    (* ; 
             "Interlisp-D and most other Xerox systems, and Tops-20/Tenex use <>.  Jericho uses >>")
                                                             (* ; 
                       "In the case of the {DSK}<FOO/BAR, FOO should be dealt with as a directory.")
                        (SETQ TEM (LASTCHPOS (CHARCODE (> /))
                                         FILE
                                         (ADD1 POS)))
                        T)
                   NIL)

              (* ;; "allow {DSK}/etc   to be a directory specification.")

              (if TEM
                  then (UNPACKFILE1.DIRECTORY 'DIRECTORY (ADD1 POS)
                                  (SUB1 TEM))
                        (SETQ POS (ADD1 TEM))
                else 

                      (* ;; "{DSK}/foo: the directory is /, the name is foo")

                      (UNPACKFILE1.DIRECTORY 'DIRECTORY POS POS)
                      (SETQ POS (ADD1 POS)))
              (SETQ HOSTP T))
             ((SETQ TEM (LASTCHPOS (CHARCODE (/ >))
                               FILE POS))                    (* ; " {eris}abc>  relative")

              (* ;; 
        " This is the true %"relative pathname%".  Returns RELATIVEDIRECTORY instead of DIRECTORY.")

              [COND
                 ((NOT HOSTP)                                (* ; "%"Incomplete file names%" case.")
                  (UNPACKFILE1.DIRECTORY (if (EQ DIRFLG 'FIELD)
                                             then 'DIRECTORY
                                           else 'SUBDIRECTORY)
                         POS
                         (SUB1 TEM)))
                 (T                                          (* ; "True %"relative pathname%".")
                    (UNPACKFILE1.DIRECTORY (if (EQ DIRFLG 'FIELD)
                                               then 'DIRECTORY
                                             else 'RELATIVEDIRECTORY)
                           POS
                           (SUB1 TEM]
              (SETQ POS (ADD1 TEM))
              (SETQ HOSTP T)))
          (OR (SETQ CODE (NTHCHARCODE FILE (SETQ TEM POS)))
              (RETURN (DREVERSE VAL)))
          (if (EQ OSTYPE T)
              then                                       (* ; 
                                        "There wasn't a host field in the name, so we have no clue")
                    (SETQ OSTYPE NIL))
      NAMELP
          

     (* ;; "At this point, CODE is the TEM'th char of file name.  POS is the first character of the field we are currently working on.")

          (SELCHARQ CODE
               (%.                                           (* ; 
                          "Note position for later--we only want to deal with the last set of dots")
                   (if BEYONDNAME
                       then                              (* ; 
                                                 "no longer of interest (probably a bad name, too)")
                     elseif FIRSTDOT
                       then                              (* ; "We're recording the second dot")
                             (if SECONDDOT
                                 then                    (* ; 
                                                           "Note only the two most recent dots")
                                       (SETQ FIRSTDOT SECONDDOT))
                             (SETQ SECONDDOT TEM)
                     else (SETQ FIRSTDOT TEM)))
               ((! ; NIL)                                    (* ; 
                             "SUBDIRECTORY, NAME and EXTENSION fields definitely terminated by now")
                    (if (SELCHARQ CODE
                                 (!                          (* ; 
               "! is only a delimiter on IFS, so ignore it if we know the ostype is something else")
                                    (AND OSTYPE (NEQ OSTYPE 'IFS)))
                                 (;                          (* ; "If we've already parsed the extension, then we have a semi in the middle of the version.  Skip it unless it's ;T or ;S")
                                    [AND BEYONDEXT (NOT (\UPF.TEMPFILEP FILE (ADD1 TEM])
                                 NIL)
                        then (GO NEXTCHAR))
                    (if FIRSTDOT
                        then                             (* ; 
                                                        "Have a name and/or extension to parse now")
                        (if
                         [AND SECONDDOT
                              (NOT (if OSTYPE
                                       then              (* ; 
                                      "Known OS type must be Tops20 for second dot to mean version")
                                             (EQ OSTYPE 'TOPS20)
                                     else                (* ; 
                                "Unknown OS type, so check that %"version%" is numeric or wildcard")
                                           (AND [for I from (ADD1 SECONDDOT)
                                                   to (SUB1 TEM) bind CH
                                                   always (OR (DIGITCHARP (SETQ CH
                                                                               (NTHCHARCODE FILE I)))
                                                                  (EQ CH (CHARCODE *]
                                                (SELCHARQ CODE
                                                     (NIL    (* ; "end of file name, ok")
                                                          T)
                                                     (;      (* ; 
                                              "This semi-colon better not be introducing a version")
                                                        (\UPF.TEMPFILEP FILE (ADD1 TEM)))
                                                     NIL]
                            then                         (* ; 
                                                           "Second dot is not intoducing a version")
                                  (SETQ FIRSTDOT SECONDDOT)
                                  (SETQ SECONDDOT NIL))
                        (UNPACKFILE1 'NAME POS (SUB1 FIRSTDOT))
                        (SETQ POS (ADD1 (if SECONDDOT
                                            then (UNPACKFILE1 'EXTENSION (ADD1 FIRSTDOT)
                                                            (SUB1 SECONDDOT))
                                                  (SETQ BEYONDEXT T)
                                                  SECONDDOT
                                          else FIRSTDOT)))
                        (SETQ BEYONDNAME T)
                        (SETQ FIRSTDOT NIL))
                    (UNPACKFILE1 (COND
                                    ((NOT BEYONDNAME)
                                     (SETQQ BEYONDNAME NAME))
                                    ((NOT BEYONDEXT)
                                     'EXTENSION)
                                    ((AND (EQ BEYONDEXT (CHARCODE ";"))
                                          (\UPF.TEMPFILEP FILE POS)))
                                    (T                       (* ; 
                                                           "Everything after the semi was version")
                                       'VERSION))
                           POS
                           (SUB1 TEM))
                    (if (NULL CODE)
                        then                             (* ; "End of string")
                              (RETURN (DREVERSE VAL)))
                    (SETQ BEYONDEXT CODE)                    (* ; 
                                                  "Note the character that terminated the name/ext")
                    (SETQ POS (ADD1 TEM)))
               (%'                                           (* ; "Quoter")
                   (add TEM 1))
               NIL)
      NEXTCHAR
          (SETQ CODE (NTHCHARCODE FILE (add TEM 1)))
          (GO NAMELP])

(LASTCHPOS
  [LAMBDA (CH STR START)                              (* ; "Edited 17-May-88 13:43 by MASINTER")
    (PROG (RESULT NC)
          (OR START (SETQ START 1))
          (while (SETQ NC (NTHCHARCODE STR START)) do (COND
                                                                 ((EQMEMB NC CH)
                                                                  (SETQ RESULT START))
                                                                 ((EQ NC (CHARCODE %'))
                                                                  (add START 1)))
                                                             (add START 1))
          (RETURN RESULT])

(\UPF.NEXTPOS
  [LAMBDA (CHAR STRING POS)                              (* lmm " 5-Oct-84 18:41")
    (bind NCH while (SETQ NCH (NTHCHARCODE STRING POS)) do (COND
                                                                          ((EQMEMB NCH CHAR)
                                                                           (RETURN POS))
                                                                          ((EQ NCH (CHARCODE %'))
                                                                           (add POS 1)))
                                                                      (add POS 1])

(\UPF.TEMPFILEP
  [LAMBDA (FILENAME START)                               (* ; "Edited  6-Jan-88 13:12 by bvm:")

    (* ;; "Checks whether START denotes a temporary mark for Twenex filename beginning at START.  Returns the appropriate field name if so.  Not sure we should parse this junk any more, but this at least localizes it.")

    (SELCHARQ (NTHCHARCODE FILENAME START)
         ((T S)                                              (* ; "Funny temp stuff")
              (AND (EQ START (NCHARS FILENAME))
                   'TEMPORARY))
         NIL])

(FILENAMEFIELD
  [LAMBDA (FILE FIELDNAME)                               (* ; "Edited  6-Mar-90 19:38 by nm")
    (UNPACKFILENAME.STRING FILE (SELECTQ FIELDNAME
                                        ((VERSION GENERATION) 
                                             'VERSION)
                                        ((DEVICE STRUCTURE) 
                                             'DEVICE)
                                        FIELDNAME)
           'FIELD NIL T])

(PACKFILENAME
  [LAMBDA N                                              (* bvm%: " 5-Jul-85 15:40")
    (COND
       ((AND (EQ N 1)
             (LISTP (ARG N 1)))                              (* ; "spread argument list")
        (APPLY (FUNCTION PACKFILENAME)
               (ARG N 1)))
       (T (PACK (PACKFILENAME.ASSEMBLE])

(PACKFILENAME.STRING
  [LAMBDA N                                              (* bvm%: " 5-Jul-85 15:41")
    (COND
       ((AND (EQ N 1)
             (LISTP (ARG N 1)))                              (* ; "spread argument list")
        (APPLY (FUNCTION PACKFILENAME.STRING)
               (ARG N 1)))
       (T (CONCATLIST (PACKFILENAME.ASSEMBLE])
)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(PUTPROPS CANONICAL.DIRECTORY MACRO
          [OPENLAMBDA (SRCSTRING)
            (AND
             SRCSTRING
             (LET
              ((LEN (NCHARS SRCSTRING)))
              (COND
                 ((EQ LEN 1)
                  (if (STREQUAL SRCSTRING "/")
                      then "<"
                    else SRCSTRING))
                 (T
                  (LET*
                   ((FATP (ffetch (STRINGP FATSTRINGP) of SRCSTRING))
                    (DSTSTRING (ALLOCSTRING LEN NIL NIL (AND FATP T)))
                    (DSTBASE (ffetch (STRINGP BASE) of DSTSTRING))
                    (DSTPOS 0)
                    (NEXTPOS -1))
                   (if (NOT FATP)
                       then
                       [for SRCPOS from 1 to LEN bind CODE
                          first (while (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
                                                      (CHARCODE (< / >)))
                                       do (add SRCPOS 1))
                                (if (> SRCPOS LEN)
                                    then (RETURN "<"))
                          do (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
                                      ((> /) 
                                           (if (> DSTPOS NEXTPOS)
                                               then (\PUTBASETHIN DSTBASE DSTPOS (CHARCODE >))
                                                     (SETQ NEXTPOS (add DSTPOS 1))))
                                      (%' (\PUTBASETHIN DSTBASE DSTPOS CODE)
                                          (add DSTPOS 1)
                                          (if (NEQ SRCPOS LEN)
                                              then (\PUTBASETHIN DSTBASE DSTPOS
                                                              (NTHCHARCODE SRCSTRING (add SRCPOS
                                                                                            1)))
                                                    (add DSTPOS 1)))
                                      (PROGN (\PUTBASETHIN DSTBASE DSTPOS CODE)
                                             (add DSTPOS 1)))
                          finally (RETURN (if (EQ DSTPOS LEN)
                                                  then (if (EQMEMB (NTHCHARCODE DSTSTRING -1)
                                                                          (CHARCODE (> /)))
                                                               then (SUBSTRING DSTSTRING 1 -2)
                                                             else DSTSTRING)
                                                elseif (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
                                                                  (CHARCODE (> /)))
                                                  then (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
                                                else (SUBSTRING DSTSTRING 1 DSTPOS]
                     else
                     (for SRCPOS from 1 to LEN bind CODE
                        first (while (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
                                                    (CHARCODE (< / >))) do (add SRCPOS 1))
                        do (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
                                    ((> /) 
                                         (if (> DSTPOS NEXTPOS)
                                             then (\PUTBASEFAT DSTBASE DSTPOS (CHARCODE >))
                                                   (SETQ NEXTPOS (add DSTPOS 1))))
                                    (%' (\PUTBASEFAT DSTBASE DSTPOS CODE)
                                        (add DSTPOS 1)
                                        (if (NEQ SRCPOS LEN)
                                            then (\PUTBASEFAT DSTBASE DSTPOS
                                                            (NTHCHARCODE SRCSTRING (add SRCPOS 1)
                                                                   ))
                                                  (add DSTPOS 1)))
                                    (PROGN (\PUTBASEFAT DSTBASE DSTPOS CODE)
                                           (add DSTPOS 1)))
                        finally (RETURN (if (EQ DSTPOS LEN)
                                                then (if (EQMEMB (NTHCHARCODE DSTSTRING -1)
                                                                        (CHARCODE (> /)))
                                                             then (SUBSTRING DSTSTRING 1 -2)
                                                           else DSTSTRING)
                                              elseif (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
                                                                (CHARCODE (> /)))
                                                then (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
                                              else (SUBSTRING DSTSTRING 1 DSTPOS])

(PUTPROPS UNPACKFILE1.DIRECTORY MACRO [OPENLAMBDA (NAM ST END)
                                                (LET* ((OLDDIR (SUBSTRING FILE ST END))
                                                       (NEWDIR (CANONICAL.DIRECTORY OLDDIR)))
                                                      (COND
                                                         [(NOT ONEFIELDFLG)
                                                          (SETQ VAL
                                                           (CONS (COND
                                                                    (PACKFLG (AND NEWDIR (MKATOM
                                                                                          NEWDIR)))
                                                                    (T (OR NEWDIR "")))
                                                                 (CONS NAM VAL]
                                                         ((EQMEMB NAM ONEFIELDFLG)
                                                          (RETURN (COND
                                                                     (PACKFLG (AND NEWDIR
                                                                                   (MKATOM NEWDIR)))
                                                                     (T (OR NEWDIR ""])

(PUTPROPS PACKFILENAME.ASSEMBLE MACRO
          [NIL
           (PROG ((BLIP "")
                  (I 1)
                  HOST DEVICE STRUCTURE DIRECTORY SUBDIRECTORY RELATIVEDIRECTORY NAME EXTENSION 
                  VERSION TEMPORARY PROTECTION ACCOUNT PACKLIST VAR VAL TEMP)
                 (DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY SUBDIRECTORY NAME EXTENSION 
                                     VERSION TEMPORARY PROTECTION ACCOUNT))
             LP  (COND
                    ((<= I N)

                     (* ;; "Grab the next field-name / value pair and fold it into the filename:")

                     (COND
                        ((LISTP (SETQ VAR (ARG N I)))
                         (SETQ VAL (CDR VAR))
                         (SETQ VAR (CAR VAR)))
                        ((<= (SETQ I (ADD1 I))
                             N)
                         (SETQ VAL (ARG N I)))
                        (T (SETQ VAL)))
                     (OR (STRINGP VAL)
                         (ATOM VAL)
                         (EQ VAR 'BODY)
                         (\ILLEGAL.ARG VAL))
                     (SELECTQ VAR
                         (BODY (MAP (UNPACKFILENAME.STRING (COND
                                                                  ((LISTP VAL)
                                                                   (PACKFILENAME.STRING VAL))
                                                                  (T VAL))
                                           NIL
                                           'OK)
                                    [FUNCTION (LAMBDA (X)
                                                (SELECTQ (CAR X)
                                                    (HOST (OR HOST (SETQ HOST (OR (CADR X)
                                                                                  BLIP))))
                                                    (DEVICE (OR DEVICE (SETQ DEVICE
                                                                        (OR (CADR X)
                                                                            BLIP))))
                                                    (DIRECTORY [OR DIRECTORY
                                                                   (COND
                                                                      (RELATIVEDIRECTORY (SETQ 
                                                                                          DIRECTORY 
                                                                                          BLIP))
                                                                      (T (SETQ DIRECTORY
                                                                          (OR (CADR X)
                                                                              BLIP])
                                                    (SUBDIRECTORY (OR SUBDIRECTORY
                                                                      (SETQ SUBDIRECTORY
                                                                       (OR (CADR X)
                                                                           BLIP))))
                                                    (RELATIVEDIRECTORY 
                                                         [OR RELATIVEDIRECTORY
                                                             (COND
                                                                (DIRECTORY (SETQ RELATIVEDIRECTORY 
                                                                            BLIP))
                                                                (T (SETQ RELATIVEDIRECTORY
                                                                    (OR (CADR X)
                                                                        BLIP])
                                                    (NAME (OR NAME (SETQ NAME (OR (CADR X)
                                                                                  BLIP))))
                                                    (EXTENSION (OR EXTENSION (SETQ EXTENSION
                                                                              (OR (CADR X)
                                                                                  BLIP))))
                                                    (VERSION (OR VERSION (SETQ VERSION
                                                                          (OR (CADR X)
                                                                              BLIP))))
                                                    (SHOULDNT]
                                    (FUNCTION CDDR)))
                         (HOST [OR HOST (SETQ HOST (COND
                                                      (VAL (SELCHARQ (CHCON1 VAL)
                                                                (({ %[ %() 
                                                                     (SUBSTRING VAL 2
                                                                            (SELCHARQ (NTHCHARCODE
                                                                                       VAL -1)
                                                                                 ((} %] %)) 
                                                                                      -2)
                                                                                 -1)))
                                                                VAL))
                                                      (T BLIP])
                         ((PATHNAME DIRECTORY) 
                              [COND
                                 (VAL
                                  (for X on (SETQ VAL (UNPACKFILENAME.STRING VAL NIL
                                                                     'RETURN))
                                     by (CDDR X)
                                     do (SELECTQ (CAR X)
                                                (HOST [COND
                                                         ((NOT HOST)
                                                          (SETQ HOST (OR (CADR X)
                                                                         BLIP])
                                                (DEVICE [COND
                                                           ((NOT DEVICE)
                                                            (SETQ DEVICE (OR (CADR X)
                                                                             BLIP])
                                                (SUBDIRECTORY [OR DIRECTORY
                                                                  (COND
                                                                     (RELATIVEDIRECTORY (SETQ 
                                                                                         DIRECTORY 
                                                                                         BLIP))
                                                                     (T (SETQ DIRECTORY
                                                                         (OR (CADR X)
                                                                             BLIP])
                                                (RELATIVEDIRECTORY 

                                 (* ;; "This used to set RELATIVEDIRECTORY to BLIP if DIRECTORY was already specified.  It really should act as a subdirectory in that case?  JDS")

                                                     (OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY
                                                                            (OR (CADR X)
                                                                                BLIP))))
                                                (DIRECTORY [OR DIRECTORY
                                                               (COND
                                                                  (RELATIVEDIRECTORY (SETQ DIRECTORY
                                                                                      BLIP))
                                                                  (T (SETQ DIRECTORY
                                                                      (OR (CADR X)
                                                                          BLIP])
                                                (ERROR "Illegal field in DIRECTORY slot" VAL)))
                                  (for X on VAL by (CDDR X)
                                     do (SELECTQ (CAR X)
                                                (HOST (OR DEVICE (SETQ DEVICE BLIP))
                                                      (OR DIRECTORY (SETQ DIRECTORY BLIP)))
                                                (DEVICE (OR DIRECTORY (SETQ DIRECTORY BLIP)))
                                                NIL)))
                                 (T (OR DIRECTORY (SETQ DIRECTORY BLIP])
                         (SUBDIRECTORY (OR SUBDIRECTORY (SETQ SUBDIRECTORY (OR VAL BLIP))))
                         (RELATIVEDIRECTORY 

                                 (* ;; "This used to set RELATIVEDIRECTORY to BLIP if DIRECTORY was already specified.  It really should act as a subdirectory in that case?  JDS")

                              (OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY (OR VAL BLIP))))
                         (DEVICE (OR DEVICE (SETQ DEVICE (OR VAL BLIP))))
                         (NAME (OR NAME (SETQ NAME (OR VAL BLIP))))
                         (EXTENSION (OR EXTENSION (SETQ EXTENSION (OR VAL BLIP))))
                         (VERSION (OR VERSION (SETQ VERSION (OR VAL BLIP))))
                         (TEMPORARY (OR TEMPORARY (SETQ TEMPORARY (OR VAL BLIP))))
                         (\ILLEGAL.ARG VAR))
                     (SETQ I (ADD1 I))
                     (GO LP)))
                 (COND
                    ((EQ HOST BLIP)
                     (SETQ HOST NIL)))
                 (COND
                    ((EQ DEVICE BLIP)
                     (SETQ DEVICE NIL)))
                 (COND
                    ((EQ DIRECTORY BLIP)
                     (SETQ DIRECTORY NIL)))
                 [COND
                    ((EQ SUBDIRECTORY BLIP)
                     (SETQ SUBDIRECTORY NIL))
                    ((AND NIL SUBDIRECTORY)
                     (COND
                        ((AND (NULL DIRECTORY)
                              (OR HOST DEVICE))
                         (SETQ DIRECTORY SUBDIRECTORY)
                         (SETQ SUBDIRECTORY NIL]
                 (COND
                    ((EQ RELATIVEDIRECTORY BLIP)
                     (SETQ RELATIVEDIRECTORY NIL)))
                 (RETURN (NCONC (AND HOST (LIST "{" HOST "}"))
                                [AND DEVICE (COND
                                               ((AND (SETQ TEMP (LASTCHPOS (CHARCODE %:)
                                                                       DEVICE 1))
                                                     (EQ TEMP (NCHARS DEVICE)))
                                                (LIST DEVICE))
                                               (T (LIST DEVICE ":"]
                                [COND
                                   (DIRECTORY (COND
                                                 [[OR (STREQUAL DIRECTORY "<")
                                                      (AND (SETQ TEMP (LASTCHPOS
                                                                       (CHARCODE (> /))
                                                                       DIRECTORY 1))
                                                           (EQ TEMP (NCHARS DIRECTORY]
                                                  (COND
                                                     ((EQMEMB (NTHCHARCODE DIRECTORY 1)
                                                             (CHARCODE (< /)))
                                                      (LIST DIRECTORY))
                                                     (T (LIST (CL:FIRST \FILENAME.SYNTAX)
                                                              DIRECTORY]
                                                 (T (LIST (CL:FIRST \FILENAME.SYNTAX)
                                                          DIRECTORY
                                                          (CL:SECOND \FILENAME.SYNTAX]
                                [COND
                                   (RELATIVEDIRECTORY (COND
                                                         ((AND (SETQ TEMP (LASTCHPOS
                                                                           (CHARCODE (> /))
                                                                           RELATIVEDIRECTORY 1))
                                                               (EQ TEMP (NCHARS RELATIVEDIRECTORY)))
                                                          (LIST RELATIVEDIRECTORY))
                                                         (T (LIST RELATIVEDIRECTORY (CL:SECOND 
                                                                                     \FILENAME.SYNTAX
                                                                                           ]
                                [COND
                                   (SUBDIRECTORY (LIST SUBDIRECTORY (CL:SECOND \FILENAME.SYNTAX]
                                (AND NAME (NEQ NAME BLIP)
                                     (LIST NAME))
                                (AND (OR (AND EXTENSION (NEQ EXTENSION BLIP))
                                         (AND VERSION (NEQ VERSION BLIP)))
                                     (LIST (COND
                                              ((AND EXTENSION (EQ (CHCON1 EXTENSION)
                                                                  (CHARCODE %.)))
                                               BLIP)
                                              (T '%.))
                                           (OR EXTENSION BLIP)))
                                (AND VERSION (NEQ VERSION BLIP)
                                     (LIST (CL:THIRD \FILENAME.SYNTAX)
                                           (COND
                                              ((FIXP VERSION)
                                               VERSION)
                                              (T (SELCHARQ (CHCON1 VERSION)
                                                      ((%. ! ;) 
                                                           (SUBSTRING VERSION 2 -1))
                                                      VERSION])

(PUTPROPS UNPACKFILE1 MACRO [OPENLAMBDA (NAM ST END)
                                                             (* lmm "22-APR-81 22:21")
                                      (COND
                                         [(NOT ONEFIELDFLG)
                                          (SETQ VAL (CONS (COND
                                                             (PACKFLG (SUBATOM FILE ST END))
                                                             (T (OR (SUBSTRING FILE ST END)
                                                                    "")))
                                                          (CONS NAM VAL]
                                         ((EQMEMB NAM ONEFIELDFLG)
                                          (RETURN (COND
                                                     (PACKFLG (SUBATOM FILE ST END))
                                                     (T (OR (SUBSTRING FILE ST END)
                                                            ""])
)
)

(RPAQQ \FILENAME.SYNTAX ("<" ">" ";"))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \FILENAME.SYNTAX)
)



(* ; "saving and restoring system state")

(DEFINEQ

(LOGOUT
  [LAMBDA (FAST)                                       (* ; "Edited 15-Mar-2021 11:53 by larry")
    (\USEREVENT 'BEFORELOGOUT)
    (OR (EQ FAST T)
        (\FLUSHVMOK? 'LOGOUT))                               (* ; 
                                            "Check that we have a vmem file before allowing LOGOUT")
    (\PROCESS.BEFORE.LOGOUT)
    (\DEVICEEVENT 'BEFORELOGOUT)
    (\SETTOTALTIME)                                          (* ; 
                                         "update the total time that this sysout has been running.")
    (\LOGOUT0 FAST)

    (* ;; "Must re-establish the state of devices and of previously open files that might have been modified at the EXEC.")

    (\RESETKEYBOARD)
    (\DEVICEEVENT 'AFTERLOGOUT)
    (\OPENLINEBUF)
    (\PROCESS.AFTER.EXIT 'AFTERLOGOUT)
    (\USEREVENT 'AFTERLOGOUT)
    (INTERPRET.REM.CM)
    NIL])

(MAKESYS
  [LAMBDA (FILE NAME)
    (DECLARE (GLOBALVARS \MISCSTATS)
           (SPECVARS FILE NAME))                       (* ; "Edited 16-Mar-2021 19:36 by larry")
                                                             (* ; "Edited 28-Jul-88 18:16 by drc:")
    (\USEREVENT 'BEFOREMAKESYS)
    (HERALD (CONCAT (OR NAME (CL:STRING-CAPITALIZE MAKESYSNAME))
                       " "
                       (SUBSTRING (SETQ MAKESYSDATE (DATE))
                              1 11)
                       " ..."))
    (\DEVICEEVENT 'BEFOREMAKESYS)

    (* ;; "RMK:  make sysout on a temp file, then rename it in order to get version numbers LMM unneded -- OUTFILEP assivvns a new version number")

    (LET ((NEWFILE (\COPYSYS FILE)))
         (COND
            ((NLISTP NEWFILE)                                (* ; 
                               "Coming back from doing the MAKESYS, so just set up to keep going.,")
             (\DEVICEEVENT 'AFTERDOMAKESYS)
             (\USEREVENT 'AFTERDOMAKESYS)
             FILE)
            (T                                               (* ; 
                                       "Coming back in the MAKESYS'd sysout, so restart the world.")
               (\DEVICEEVENT 'AFTERMAKESYS)
               (\PROCESS.AFTER.EXIT 'AFTERMAKESYS)
               (PRIN1 HERALDSTRING T)
               (\USEREVENT 'AFTERMAKESYS)
               (INTERPRET.REM.CM)                        (* ; 
                                                           "Run the commands in the file REM.CM")
               (RESET])

(SYSOUT
  [LAMBDA (FILE)                                       (* ; "Edited 16-Mar-2021 19:34 by larry")
                                                             (* hdj "29-Sep-86 12:14")
    (DECLARE (GLOBALVARS \MISCSTATS)
           (SPECVARS FILE))                                  (* ; 
                                           "FILE is special so that BEFORESYSOUTFORMS can alter it")
    (\USEREVENT 'BEFORESYSOUT)
    (\DEVICEEVENT 'BEFORESYSOUT)

    (* ;; 
  "RMK:  Fix it so that sysouts are versioned.  Temp file goes to same place as eventual sysout.")

    (LET ((TOTALTIMESAVE (fetch TOTALTIME of \MISCSTATS))
          NEWFILE)                                           (* ; 
                    "update the total time field so that the run time in the sysout will be right.")
         (\SETTOTALTIME)
         (SETQ NEWFILE (\COPYSYS FILE))
         [COND
            ((NLISTP NEWFILE)

             (* ;; "Continuing in same sysout;  reset TOTALTIME in misc stats page to not include the time before the sysout.")

             (replace TOTALTIME of \MISCSTATS with TOTALTIMESAVE)
             (\DEVICEEVENT 'AFTERDOSYSOUT)
             (\USEREVENT 'AFTERDOSYSOUT))
            (T                                               (* ; "restarting")
               (\DEVICEEVENT 'AFTERSYSOUT)
               (\PROCESS.AFTER.EXIT 'AFTERSYSOUT)
               (INTERPRET.REM.CM)
               (\USEREVENT 'AFTERSYSOUT]
         NEWFILE])

(SAVEVM
  [LAMBDA NIL                                          (* ; "Edited 15-Mar-2021 12:04 by larry")

    (* ;; "Save the virtual memory.  This is similar to logging out, then back in, but is much faster, since it doesn't lose any pages.  Conceptually, this is like doing a sysout to Lisp.virtualmem")

    (\USEREVENT 'BEFORESAVEVM)
    (\DEVICEEVENT 'BEFORESAVEVM)
    (COND
       ((\FLUSHVM)
        (\RESETKEYBOARD)                                     (* ; 
                                                           "Returns T when starting up fresh")
        (\DEVICEEVENT 'AFTERSAVEVM)
        (\PROCESS.AFTER.EXIT 'AFTERSAVEVM)
        (\USEREVENT 'AFTERSAVEVM)
        T)
       (T (\DEVICEEVENT 'AFTERDOSAVEVM)
          (\USEREVENT 'AFTERDOSAVEVM])

(HERALD
  [LAMBDA (STR)                                          (* wt%: " 2-MAY-79 15:38")
    (AND STR (SETQ HERALDSTRING STR))
    HERALDSTRING])

(INTERPRET.REM.CM
  [LAMBDA (RETFLG)                                     (* ; "Edited 15-Mar-2021 12:27 by larry")
    (DECLARE (GLOBALVARS STARTUPFORM))

(* ;;; "Looks at REM.CM and evaluates the form there if the first character of the file is open paren or doublequote.  If it's a string, it will be unread,, else the form will be evaluated at the next prompt.  For use in INIT.LISP, among others.  If RETFLG is true, the expression read is simply returned")

    (PROG ((FILE (UNIX-GETENV "LDEINIT"))
           COM)
          (OR FILE (RETURN))
          (SETQ FILE (OPENSTREAM FILE 'INPUT))
          (COND
             [[AND (IGREATERP (GETFILEINFO FILE 'LENGTH)
                          0)
                   (EQ (SKIPSEPRS FILE T)
                       '%")
                   (SETQ COM (CAR (NLSETQ (READ FILE T]
              (CLOSEF FILE)
              (COND
                 (RETFLG                                     (* ; "Save it to return"))
                 (T                                          (* ; "Unread a string")
                                                             (* ; 
                                   "RMK: Replace CR and LF by space to avoid EOL convention issues")
                    (for I from 1 to (NCHARS COM)
                       when (FMEMB (NTHCHARCODE COM I)
                                       (CHARCODE (CR LF EOL))) do (RPLCHARCODE COM I (CHARCODE
                                                                                          EOL)))
                    (BKSYSBUF COM]
             (T (CLOSEF FILE)))
          (RETURN (COND
                     (RETFLG COM)
                     (COM T])

(\USEREVENT
  [LAMBDA (EVENT)
    (DECLARE (GLOBALVARS AROUNDEXITFNS))             (* bvm%: "16-Dec-83 15:27")
    (for FN in (SELECTQ EVENT
                           ((BEFORELOGOUT BEFORESYSOUT BEFORESAVEVM BEFOREMAKESYS) 
                                AROUNDEXITFNS)
                           (REVERSE AROUNDEXITFNS)) do (APPLY* FN EVENT])
)

(ADDTOVAR AROUNDEXITFNS )

(RPAQ? HERALDSTRING "")

(RPAQ? \USERNAME )
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS HERALDSTRING USERNAME \USERNAME AROUNDEXITFNS)
)
(DEFINEQ

(USERNAME
  [LAMBDA (FLG STRPTR PRESERVECASE)                      (* lmm "28-MAR-82 14:10")
                                                             (* ; 
                                                    "On 10, USERNAME can take a user number as arg")
    (PROG (ADDR NAME)
          (SETQ NAME (COND
                        (FLG NIL)
                        ((NEQ 0 (SETQ ADDR (fetch (IFPAGE UserNameAddr) of \InterfacePage)))
                         (GetBcplString (\ADDBASE (EMADDRESS 0)
                                               ADDR)
                                (EQ STRPTR T)))
                        (T \USERNAME)))
          (OR PRESERVECASE (NULL NAME)
              (SETQ NAME (U-CASE NAME)))
          (RETURN (COND
                     ((NULL NAME)
                      NIL)
                     ((STRINGP STRPTR)
                      (SUBSTRING NAME 1 -1 STRPTR))
                     (T NAME])

(SETUSERNAME
  [LAMBDA (NAME)                                         (* lmm "28-MAR-82 14:11")
                                                             (* ; 
                                                           "Changed interpretation of UserName0")
    (COND
       (NAME (PROG ((ADDR (fetch (IFPAGE UserNameAddr) of \InterfacePage)))
                   (RETURN (COND
                              ((NEQ ADDR 0)
                               (SetBcplString (\ADDBASE (EMADDRESS 0)
                                                     ADDR)
                                      NAME)
                               (SETQ USERNAME (USERNAME NIL T)))
                              (T (SETQ \USERNAME (CONCAT NAME])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY 

(FILESLOAD (LOADCOMP)
       FILEIO)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME)
)
(PUTPROPS ADIR COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 
1991 1992 1920 2017 2020 2021))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (2745 13838 (DELFILE 2755 . 2916) (FULLNAME 2918 . 3285) (INFILE 3287 . 3435) (INFILEP 
3437 . 3572) (IOFILE 3574 . 3714) (OPENFILE 3716 . 4116) (OPENSTREAM 4118 . 8426) (OUTFILE 8428 . 8579
) (OUTFILEP 8581 . 8717) (RENAMEFILE 8719 . 9025) (SIMPLE.FINDFILE 9027 . 9437) (VMEMSIZE 9439 . 9606)
 (\COPYSYS 9608 . 12557) (\FLUSHVM 12559 . 13631) (\LOGOUT0 13633 . 13836)) (14210 33801 (
UNPACKFILENAME 14220 . 14406) (UNPACKFILENAME.STRING 14408 . 30680) (LASTCHPOS 30682 . 31376) (
\UPF.NEXTPOS 31378 . 32023) (\UPF.TEMPFILEP 32025 . 32602) (FILENAMEFIELD 32604 . 33089) (PACKFILENAME
 33091 . 33434) (PACKFILENAME.STRING 33436 . 33799)) (56242 63422 (LOGOUT 56252 . 57169) (MAKESYS 
57171 . 58800) (SYSOUT 58802 . 60354) (SAVEVM 60356 . 61156) (HERALD 61158 . 61318) (INTERPRET.REM.CM 
61320 . 63045) (\USEREVENT 63047 . 63420)) (63604 65331 (USERNAME 63614 . 64570) (SETUSERNAME 64572 . 
65329)))))
STOP
\ No newline at end of file
diff --git a/sources/ADIR.LCOM b/sources/ADIR.LCOM
index db8cfdcf..48f6ab38 100644
Binary files a/sources/ADIR.LCOM and b/sources/ADIR.LCOM differ
diff --git a/sources/LLFAULT b/sources/LLFAULT
index c5cb6d3d..0f7d8699 100644
--- a/sources/LLFAULT
+++ b/sources/LLFAULT
@@ -1 +1 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-Feb-2021 22:44:43" {DSK}<home>larry>ilisp>medley>sources>LLFAULT.;5 507542Q

      changes to%:  (FNS \FLUSHVM \DOFLUSHVM \FAULTINIT \D01.FAULTINIT \D01.ASSIGNBUFFERS 
                         \MAIKO.FAULTINIT \MAIKO.NEWFAULTINIT \MAIKO.ASSIGNBUFFERS \M-VMEMSAVE 
                         \MAIKO.NEWPAGE \MAIKO.DO.MOVDS \DOVE.FAULTINIT \DL.FAULTINIT 
                         \DL.NEWFAULTINIT \DL.UNMAPPAGES \DL.MARK.PAGES.UNAVAILABLE \DL.ASSIGNBUFFERS
                         \CHAIN.UP.RPT \FAULTHANDLER \PAGEFAULT \INVALIDADDR \INVALIDVP \FLUSHPAGE 
                         \LOADVMEMPAGE \MOVEREALPAGE \LOOKUPPAGEMAP \VALIDADDRESSP \LOCKEDPAGEP 
                         \SELECTREALPAGE \SPECIALRP \TRANSFERPAGE \UPDATECHAIN \NEWPAGE \DONEWPAGE 
                         \ASSURE.FPTOVP.PAGE \MAKESPACEFORLOCKEDPAGE \MOVEVMEMFILEPAGE 
                         \NEWEPHEMERALPAGE \DONEWEPHEMERALPAGE \LOCKPAGES \DOLOCKPAGES \TEMPLOCKPAGES
                         \DOTEMPLOCKPAGES \TEMPUNLOCKPAGES \UNLOCKPAGES \LOGOUT0 \FLUSHVMOK?)
                    (VARS LLFAULTCOMS)

      previous date%: "10-Feb-2021 22:40:24" {DSK}<home>larry>ilisp>medley>sources>LLFAULT.;4)


(* ; "
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 2021 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT LLFAULTCOMS)

(RPAQQ LLFAULTCOMS
       [(VARS (FAULTTEST T))
        (COMS                                                (* ; 
                                                 "Bootstrap code, run once when an image is booted")
              (FNS \FAULTINIT \D01.FAULTINIT \D01.ASSIGNBUFFERS \MAIKO.FAULTINIT \MAIKO.NEWFAULTINIT
                   \MAIKO.ASSIGNBUFFERS \M-VMEMSAVE \MAIKO.NEWPAGE)
              
              (* ;; "For setting up (and maybe eventually removing?) MAIKO-specific versions of the generic low-levle functions:")

              (FNS \MAIKO.DO.MOVDS)
              (ADDVARS (\MAIKO.MOVDS (TRUE \LOCKEDPAGEP)
                              (\MAIKO.NEWPAGE \NEWPAGE)
                              (\MAIKO.NEWPAGE \DONEWPAGE)
                              (NILL \LOCKPAGES)
                              (NILL \DOLOCKPAGES)
                              (NILL \DOTEMPLOCKPAGES)
                              (NILL \TEMPUNLOCKPAGES)
                              (NILL \UNLOCKPAGES)
                              (NILL \WRITEDIRTYPAGE)
                              (NILL \DIRTYBACKGROUND)
                              (ZERO \COUNTREALPAGES)
                              (NILL \SHOWPAGETABLE)
                              (NILL CHECKPAGEMAP)
                              (EVQ \PAGEFAULT)
                              (EVQ \LOADVMEMPAGE)
                              (NILL \LOADVMEMPAGE)
                              (TRUE \MOVEVMEMFILEPAGE)
                              (TRUE \VALIDADDRESSP)))
              (FNS \DOVE.FAULTINIT \DL.FAULTINIT \DL.NEWFAULTINIT \DL.UNMAPPAGES 
                   \DL.MARK.PAGES.UNAVAILABLE \DL.ASSIGNBUFFERS \CHAIN.UP.RPT))
        (COMS                                                (* ; "Pagefault handler")
              (FNS \FAULTHANDLER \PAGEFAULT \INVALIDADDR \INVALIDVP \FLUSHPAGE \LOADVMEMPAGE 
                   \MOVEREALPAGE \LOOKUPPAGEMAP \VALIDADDRESSP \LOCKEDPAGEP \SELECTREALPAGE 
                   \SPECIALRP \TRANSFERPAGE \UPDATECHAIN))
        (COMS                                                (* ; 
                                                           "Allocating and locking new pages")
              (FNS \NEWPAGE \DONEWPAGE \ASSURE.FPTOVP.PAGE \MAKESPACEFORLOCKEDPAGE \MOVEVMEMFILEPAGE
                   \NEWEPHEMERALPAGE \DONEWEPHEMERALPAGE \LOCKPAGES \DOLOCKPAGES \TEMPLOCKPAGES 
                   \DOTEMPLOCKPAGES \TEMPUNLOCKPAGES \UNLOCKPAGES))
        (COMS                                                (* ; "Writing out the vmem")
              (FNS \FLUSHVM \LOGOUT0 \DOFLUSHVM \RELEASEWORKINGSET \WRITEDIRTYPAGE \WRITEDIRTYPAGE1 
                   \COUNTREALPAGES))
        (COMS                                                (* ; "VMEM.PURE.STATE hack")
              (FNS \DOCOMPRESSVMEM VMEM.PURE.STATE))
        (COMS 
              (* ;; "Handling the backing store getting too full--keep running, but if we overflow, we can never \FLUSHVM because there is no place to write some pages")

              (FNS 32MBADDRESSABLE \SET.VMEM.FULL.STATE \SET.LASTVMEMFILEPAGE \DOVMEMFULLINTERRUPT 
                   \FLUSHVMOK?))
        (INITVARS (\UPDATECHAINFREQ 100)
               (\PAGEFAULTCOUNTER 0)
               (\DIRTYPAGECOUNTER 0)
               (\DIRTYPAGEHINT 0)
               (\LASTACCESSEDVMEMPAGE 0)
               (\MAXSHORTSEEK 1000)
               (\MINSHORTSEEK 20)
               (\MAXCLEANPROBES 20)
               (\VMEM.INHIBIT.WRITE)
               (\VMEM.PURE.LIMIT)
               (\VMEM.FULL.STATE)
               (\GUARDVMEMFULL 500)
               (VMEM.COMPRESS.FLG)
               (\DOFAULTINIT 0)
               (\VMEMACCESSFN)
               (\SYSTEMCACHEVARS)
               (\MAXSWAPBUFFERS 1)
               (\EXTENDINGVMEMFILE)
               (\MaxScreenPage 0)
               (\NEWVMEMPAGEADDED))
        (INITVARS (\LASTDIRTYCNT)
               (\LASTDIRTYFOUND)
               (\LASTDIRTYSCANPTR)
               (\DIRTYSEEKMAX 50))
        (COMS                                                (* ; 
                                                         "Errors signaled in the maintenance panel")
              (FNS \MP.ERROR))
        (COMS                                                (* ; 
                          "Debugging code.  Some of this also runs renamed for extra TeleRaid help")
              (FNS \ACTONVMEMFILE \SHOWPAGETABLE CHECKPAGEMAP CHECKFPTOVP CHECKFPTOVP1 \PRINTFPTOVP 
                   \PRINTVP))
        (E (RESETSAVE (RADIX 8)))
        (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS \ACTONVMEMFILE .VMEM.CONSISTENTP. .LOCKABLERP.)
               (COMS                                         (* ; "Virtual page flags")
                     (CONSTANTS \VMAP.DIRTY \VMAP.CLEAN \VMAP.REF \VMAP.VACANT \VMAP.FLAGS 
                            \VMAP.NOTFLAGS)
                     (RECORDS VMEMFLAGS)
                     (MACROS LOGNOT16))
               (COMS                                         (* ; "RPT constants")
                     (CONSTANTS \RPT.EMPTY \RPT.UNAVAILABLE \PAGETABLESTOPFLG \RPTENTRYLENGTH)
                     (RECORDS RPT RPT1)
                     (MACROS RPFROMRPT RPTFROMRP NPAGESMACRO))
               (COMS                                         (* ; "Virtual to file pagemap")
                     (EXPORT (CONSTANTS \MAXFILEPAGE))
                     (CONSTANTS \EMPTYPMTENTRY)
                     (RECORDS VP)
                     (MACROS .PAGEMAPBASE.))
               (COMS                                         (* ; "FP to VP stuff")
                     (RECORDS FPTOVP)
                     (CONSTANTS \NO.VMEM.PAGE)
                     (MACROS DLRPFROMFP DLFPFROMRP))
               (PROP DOPVAL \TOUCHPAGE TIMES3)
               (COMS                                         (* ; "Locked page table")
                     (MACROS .LOCKEDVPBASE. .LOCKEDVPMASK.))
               (CONSTANTS \MAXDIRTYSCANCOUNT \MINVMEMSPAREPAGES \DLBUFFERPAGES)
               (CONSTANTS 2MBPAGES)
               (GLOBALVARS \UPDATECHAINFREQ \REALPAGETABLE \RPTLAST \RPOFFSET \RPTSIZE 
                      \LOCKEDPAGETABLE \EMBUFBASE \EMBUFVP \EMBUFRP \PAGEFAULTCOUNTER \LASTDIRTYCNT 
                      \LASTDIRTYFOUND \LASTDIRTYSCANPTR \MACHINETYPE \LASTACCESSEDVMEMPAGE 
                      \MAXSHORTSEEK \MAXCLEANPROBES \MINSHORTSEEK \DIRTYSEEKMAX \DIRTYPAGECOUNTER 
                      \DIRTYPAGEHINT \VMEM.INHIBIT.WRITE \VMEM.PURE.LIMIT \VMEM.FULL.STATE 
                      \GUARDVMEMFULL VMEM.COMPRESS.FLG \KBDSTACKBASE \MISCSTACKBASE \DOFAULTINIT 
                      \FPTOVP \VMEMACCESSFN \SYSTEMCACHEVARS \LASTVMEMFILEPAGE \EXTENDINGVMEMFILE 
                      \MaxScreenPage \NEWVMEMPAGEADDED)
               (GLOBALVARS \#SWAPBUFFERS \#EMUBUFFERS \#DISKBUFFERS \MAXSWAPBUFFERS \EMUSWAPBUFFERS 
                      \EMUBUFFERS \TELERAIDBUFFER \EMUDISKBUFFERS \EMUDISKBUFEND)
               (MACROS RWMufMan)
               (CONSTANTS (DOLOCKCHECKS NIL)))
        [COMS 

(* ;;; "MAKEINIT stuff")

              (FNS ADDPME CHECKIFPAGE DUMPINITPAGES MAKEROOMFORPME MAPPAGES READPAGEMAP 
                   READPAGEMAPBLOCK SETUPPAGEMAP)
              (DECLARE%: DONTCOPY (MACROS CHECKIF)
                     (ADDVARS (INEWCOMS (FNS DUMPINITPAGES)
                                     (VARS INITCONSTANTS)
                                     (FNS SETUPPAGEMAP ADDPME MAKEROOMFORPME MAPPAGES))
                            (RDCOMS (FNS READPAGEMAP READPAGEMAPBLOCK CHECKIFPAGE \LOCKEDPAGEP 
                                         \LOOKUPPAGEMAP CHECKPAGEMAP CHECKFPTOVP CHECKFPTOVP1 
                                         \SHOWPAGETABLE \PRINTFPTOVP))
                            (EXPANDMACROFNS CHECKIF .LOCKEDVPBASE. .LOCKEDVPMASK. .PAGEMAPBASE.)
                            (MKI.SUBFNS (\NEWPAGE . MKI.NEWPAGE)
                                   (\LOCKPAGES . MKI.LOCKPAGES))
                            (RD.SUBFNS (\NEWPAGE . VNEWPAGE)
                                   (\LOCKPAGES . VLOCKPAGES))
                            (RDPTRS (\REALPAGETABLE))
                            (RDVALS (\RPTSIZE)))
                     EVAL@COMPILE
                     (ADDVARS (DONTCOMPILEFNS DUMPINITPAGES SETUPPAGEMAP ADDPME MAKEROOMFORPME 
                                     MAPPAGES READPAGEMAP READPAGEMAPBLOCK CHECKIFPAGE]
        (FNS \LOCKFN \LOCKCODE \LOCKVAR \LOCKCELL \LOCKWORDS)
        [DECLARE%: DONTCOPY
               (ADDVARS (INEWCOMS (FNS \LOCKFN \LOCKVAR \LOCKCELL \LOCKWORDS \LOCKCODE)
                               (ALLOCAL (ADDVARS (LOCKEDFNS \FAULTHANDLER \FAULTINIT \DOVE.FAULTINIT
                                                        \D01.FAULTINIT \DL.FAULTINIT \CHAIN.UP.RPT 
                                                        \MAKESPACEFORLOCKEDPAGE \PAGEFAULT \WRITEMAP
                                                        \LOOKUPPAGEMAP \LOCKEDPAGEP \LOADVMEMPAGE 
                                                        \MOVEREALPAGE \INVALIDADDR \INVALIDVP 
                                                        \SELECTREALPAGE \TRANSFERPAGE \SPECIALRP 
                                                        \UPDATECHAIN \MARKPAGEVACANT \FLUSHPAGE 
                                                        \CLEARWORDS \FLUSHVM \DONEWPAGE 
                                                        \ASSURE.FPTOVP.PAGE \DONEWEPHEMERALPAGE 
                                                        \WRITEDIRTYPAGE1 \COPYSYS0 \COPYSYS0SUBR 
                                                        \RELEASEWORKINGSET \DOFLUSHVM \DOLOCKPAGES 
                                                        \DOTEMPLOCKPAGES \TEMPUNLOCKPAGES \MP.ERROR 
                                                        RAID \DL.NEWFAULTINIT 
                                                        \DL.MARK.PAGES.UNAVAILABLE \DL.UNMAPPAGES 
                                                        \DL.ASSIGNBUFFERS \D01.ASSIGNBUFFERS 
                                                        \DOCOMPRESSVMEM \MOVEVMEMFILEPAGE 
                                                        \SET.VMEM.FULL.STATE \HINUM \LONUM \ATOMCELL
                                                        SETTOPVAL)
                                               (LOCKEDVARS \REALPAGETABLE \RPTLAST \PAGEFAULTCOUNTER
                                                      \UPDATECHAINFREQ \RPOFFSET \RPTSIZE 
                                                      \LOCKEDPAGETABLE \EMBUFBASE \EMBUFVP \EMBUFRP 
                                                      \LASTACCESSEDVMEMPAGE \MAXSHORTSEEK 
                                                      \MAXCLEANPROBES \MINSHORTSEEK \DIRTYPAGECOUNTER
                                                      \DIRTYPAGEHINT \VMEM.INHIBIT.WRITE 
                                                      \VMEM.PURE.LIMIT \VMEM.FULL.STATE 
                                                      \GUARDVMEMFULL VMEM.COMPRESS.FLG \KBDSTACKBASE
                                                      \MISCSTACKBASE \DOFAULTINIT \FPTOVP 
                                                      \MACHINETYPE \VMEMACCESSFN \TELERAIDBUFFER 
                                                      \EMUDISKBUFFERS \EMUDISKBUFEND \MAXSWAPBUFFERS
                                                      \EMUBUFFERS \#EMUBUFFERS \#SWAPBUFFERS 
                                                      \#DISKBUFFERS \RCLKSECOND \RCLKMILLISECOND 
                                                      \VALSPACE \EMUSWAPBUFFERS \EM.CURSORBITMAP 
                                                      \PAGEMAP \PageMapTBL \IOCBPAGE \IOPAGE 
                                                      \MISCSTATS \DEFSPACE \InterfacePage 
                                                      \LASTVMEMFILEPAGE \DoveIORegion \MaxScreenPage
                                                      \NEWVMEMPAGEADDED]
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML)
                                                                             (LAMA VMEM.PURE.STATE])

(RPAQQ FAULTTEST T)



(* ; "Bootstrap code, run once when an image is booted")

(DEFINEQ

(\FAULTINIT
  [LAMBDA NIL                                                (* ; "Edited 30-Mar-88 17:30 by Snow")

(* ;;; "retrieves some constants from Interface page for the swapper and performs other initialization that must happen immediately.  Called when starting up, and also when \FAULTHANDLER context starts, in case init hasn't happened yet, as e.g.  from MAKEINIT")

    (SETQ \MACHINETYPE (fetch MachineType of \InterfacePage))
    [PROG NIL
          (COND
             ((EQ \MACHINETYPE \MAIKO)
              (\MAIKO.FAULTINIT)
              (RETURN NIL)))
          (OR (NEQ (fetch FPTOVPStart of \InterfacePage)
                   0)
              (\MP.ERROR \MP.OBSOLETEVMEM "No FPTOVP"))
          (COND
             ((AND (NEQ 0 (fetch (IFPAGE FullSpaceUsed) of \InterfacePage))
                   (SELECTC \MACHINETYPE
                       (\DORADO NIL)
                       (\DANDELION (EQ 0 (fetch (IFPAGE DL24BitAddressable) of \InterfacePage
                                                )))
                       (\DAYBREAK NIL)
                       T))
              (\MP.ERROR \MP.32MBINUSE "Sysout contains virtual pages not addressable by machine"
                     )))
          (SETQ \LASTDIRTYSCANPTR)
          (SELECTC \MACHINETYPE
              (\DANDELION (\DL.FAULTINIT))
              (\DAYBREAK (\DOVE.FAULTINIT))
              (\D01.FAULTINIT))                          (* ; 
                                            "Have to set \EM.CURSORBITMAP before faults can happen")

     (* ;; "But you can't call \SETIOPOINTERS on a Daybreak until after the Dove IO Region is mapped, which happens in \DL.NEWFAULTINIT")

          (\SETIOPOINTERS)
          (COND
             ((IGREATERP (fetch (IFPAGE NActivePages) of \InterfacePage)
                     (IDIFFERENCE \LASTVMEMFILEPAGE \GUARDVMEMFULL))
                                                             (* ; "Vmem getting full!")
              (\SET.VMEM.FULL.STATE]
    (COND
       ((EQ (PROG1 \DOFAULTINIT (SETQ \DOFAULTINIT NIL))
            T)                                               (* ; 
                                              "true after \FLUSHVM.  Need to rebuild some contexts")
        (replace (IFPAGE KbdFXP) of \InterfacePage with (\MAKEFRAME
                                                                     (COND
                                                                        ((fetch (LITATOM CCODEP)
                                                                            of '\KEYHANDLER)
                                                                         (FUNCTION \KEYHANDLER))
                                                                        (T '\DUMMYKEYHANDLER))
                                                                     \KBDSTACKBASE
                                                                     (IPLUS \KBDSTACKBASE 
                                                                            \StackAreaSize)
                                                                     0 0))
        (replace (IFPAGE MiscFXP) of \InterfacePage with (\MAKEFRAME
                                                                      (FUNCTION \DOMISCAPPLY)
                                                                      \MISCSTACKBASE
                                                                      (IPLUS \MISCSTACKBASE 
                                                                             \StackAreaSize)
                                                                      0 0))
        T])

(\D01.FAULTINIT
  [LAMBDA NIL                                                (* bvm%: "20-Oct-86 18:19")
    (SETQ \VMEMACCESSFN (FUNCTION \M44ACTONVMEMFILE))
    (SETQ \REALPAGETABLE (fetch (IFPAGE REALPAGETABLEPTR) of \InterfacePage))

    (* ;; "Note: these SETQ's do not reference count, since the values are all smallp's and emulator addresses (in atom space)")

    (SETQ \RPOFFSET (SIGNED (fetch (IFPAGE RPOFFSET) of \InterfacePage)
                           BITSPERWORD))
    (SETQ \RPTSIZE (fetch (IFPAGE RPTSIZE) of \InterfacePage))
                                                             (* ; 
                                                "Initialize the software clocks from alto emulator")
    (\BLT (LOCF (fetch SECONDSCLOCK of \MISCSTATS))
          (EMADDRESS \RTCSECONDS)
          (UNFOLD 3 WORDSPERCELL))
    [SETQ \RCLKMILLISECOND (CONSTANT (OR (SMALLP \ALTO.RCLKMILLISECOND)
                                         (ERROR \ALTO.RCLKMILLISECOND 
                                                "\ALTO.RCLKMILLISECOND isn't a SMALLP???"]

(* ;;; "\ALTO.RCLKMILLISECOND must be a SMALLP here so as not to cause any refcnt or pagefault activity.  \RCLKSECOND is large and has to live on \MISCSTATS, since there is no convenient way to lock a random cell.")

    (SETQ.NOREF \RCLKSECOND (LOCF (fetch RCLKSECOND of \MISCSTATS)))

(* ;;; "Note the SETQ.NOREF for \RCLKSECOND in order to guarantee no refcnt'ing (which might pagefault) Note that these LOADBYTE expressions are compiled as constants")

    (replace (FIXP HINUM) of \RCLKSECOND with (LOADBYTE \ALTO.RCLKSECOND 16 16))
    (replace (FIXP LONUM) of \RCLKSECOND with (LOADBYTE \ALTO.RCLKSECOND 0 16))
    [COND
       ((AND (EQ \MACHINETYPE \DORADO)
             (ILEQ 5124 (fetch RVersion of \InterfacePage)))
        (replace NSHost0 of \InterfacePage with 0)
        (replace NSHost1 of \InterfacePage with 21898)
        (replace NSHost2 of \InterfacePage
           with (IPLUS (MASK.1'S 15 1)
                           (for I (N _ 0) from 1168 to 1175
                              do                         (* ; 
                           "Mufflers `2220Q' thru `2227Q' hold the bits of the basic serial number")
                                    [SETQ N (IPLUS (LLSH N 1)
                                                   (COND
                                                      ((BITTEST (RWMufMan I)
                                                              (MASK.1'S 15 1))
                                                       0)
                                                      (T 1] finally (RETURN N]
    (\CHAIN.UP.RPT)
    (\D01.ASSIGNBUFFERS])

(\D01.ASSIGNBUFFERS
  [LAMBDA NIL                                                (* bvm%: "20-Oct-86 18:21")
    (PROGN                                                   (* ; "Assign swap buffer")
           (SETQ \EMBUFVP (fetch (IFPAGE EMBUFVP) of \InterfacePage))
           (SETQ \EMBUFBASE (EMPOINTER (UNFOLD \EMBUFVP WORDSPERPAGE)))
           (SETQ \EMBUFRP (\READRP \EMBUFVP)))
    (PROG ((EMBUF (fetch (IFPAGE EMUBUFFERS) of \InterfacePage))
           (EMLEN (fetch (IFPAGE EMUBUFLENGTH) of \InterfacePage))
           EXTRALEN NPAGES)
          [add EMLEN (IDIFFERENCE EMBUF (SETQ EMBUF (CEIL EMBUF WORDSPERPAGE]
                                                             (* ; 
                                             "Round up to a page boundary and throw out the excess")
          (SETQ EXTRALEN (IMOD EMLEN WORDSPERPAGE))
          (add EXTRALEN (COND
                               ((ILESSP EXTRALEN 100)
                                (TIMES 2 WORDSPERPAGE))
                               (T WORDSPERPAGE)))
          (SETQ NPAGES (FOLDLO (SETQ EMLEN (IDIFFERENCE EMLEN EXTRALEN))
                              WORDSPERPAGE))
          (OR (IGEQ NPAGES 4)
              (RAID "No swap buffer space"))
          (SETQ \TELERAIDBUFFER (EMPOINTER EMBUF))
          (SETQ \EMUBUFFERS (\ADDBASE \TELERAIDBUFFER WORDSPERPAGE))
          (SETQ \#EMUBUFFERS (SETQ NPAGES (SUB1 NPAGES)))
          (SETQ \#SWAPBUFFERS (IMIN \MAXSWAPBUFFERS (IQUOTIENT NPAGES 2)))
          (SETQ \#DISKBUFFERS (IDIFFERENCE \#EMUBUFFERS \#SWAPBUFFERS))
          (SETQ \EMUDISKBUFFERS \EMUBUFFERS)
          (SETQ \EMUDISKBUFEND (\ADDBASE \EMUDISKBUFFERS (UNFOLD \#DISKBUFFERS WORDSPERPAGE)))
          (SETQ \EMUSWAPBUFFERS \EMUDISKBUFEND)
          (\INITBFS (\ADDBASE \EMUBUFFERS (UNFOLD NPAGES WORDSPERPAGE))
                 EXTRALEN T])

(\MAIKO.FAULTINIT
  [LAMBDA NIL                                                (* ; "Edited  2-Jan-93 12:25 by jds")
    (SETQ \VMEMACCESSFN (FUNCTION NILL))                     (* ; "This variable must be the name of function that may be ACTONVMEMFILE that may write back  from VP to FP. But , in Katana type, this function may be required (by tt)")
    (SETQ \IOCBPAGE (create POINTER
                           PAGE# _ \VP.IOCBS))

    (* ;; "MOVD all the Maiko-specific low-level functions onto their generic counterparts:")

    (\MAIKO.DO.MOVDS)
    (\MAIKO.NEWFAULTINIT)
    (SETQ \RCLKMILLISECOND 1000)
    (SETQ \RCLKSECOND 1000000)
    (\RCLK (LOCF (fetch BASECLOCK of \MISCSTATS)))   (* ; "Reset base clock ")
    (\PUTBASEPTR (LOCF (fetch SECONDSCLOCK of \MISCSTATS))
           0 NIL)                                            (* ; "Clear the seconds timer (by tt)")
    (\PUTBASEPTR (LOCF (fetch MILLISECONDSCLOCK of \MISCSTATS))
           0 NIL)                                            (* ; "Clear the milliseconds timer")
                                                             (* SETQ \LASTVMEMFILEPAGE
                                                           (fetch (IFPAGE DLLastVmemPage) of 
                                                           \InterfacePage))
    (\SETIOPOINTERS])

(\MAIKO.NEWFAULTINIT
  [LAMBDA NIL                                                (* ; 
                                                         "Edited 26-Feb-88 14:07 by Osamu Nakamura")

    (* ;; "We have just started up on a Katana.  Boot code (SYSOUT Loader) may map FP to VP(VP is same map to RP). Therefore, in this function, only done the initialization of the gloval variables (particularly, the variables about Buffers). And, there is not /REALPAGETABLE in Katana.")

    (PROG ((NBUFFERS (IDIFFERENCE \DLBUFFERPAGES 2)))        (* ; "Allocate buffers")
          (\MAIKO.ASSIGNBUFFERS (create POINTER
                                           PAGE# _ \VP.BUFFERS)
                 NBUFFERS])

(\MAIKO.ASSIGNBUFFERS
  [LAMBDA (BASE NPAGES)                                      (* ; 
                                                           "Edited 14-May-88 18:31 by JMTurn")
    (PROGN                                                   (* ; 
                    "Allocate a page to hold name and password, and perhaps other ephemeral things")
           (replace (IFPAGE UserNameAddr) of \InterfacePage with (\LOLOC (\ADDBASE BASE 1
                                                                                            )))
           (replace (IFPAGE UserPswdAddr) of \InterfacePage with (\LOLOC (\ADDBASE BASE 
                                                                                            33)))
           (SETQ BASE (\ADDBASE BASE WORDSPERPAGE))
           (add NPAGES -1))
    (PROGN                                                   (* ; "Assign swap buffer")
           (SETQ \EMBUFBASE BASE)
           (SETQ \EMBUFVP (fetch (POINTER PAGE#) of BASE))
           (SETQ \EMBUFRP \EMBUFVP)
           (SETQ BASE (\ADDBASE BASE WORDSPERPAGE))
           (add NPAGES -1))
    (PROGN                                                   (* ; "Assign ether buffers")
           (replace (IFPAGE MDSZoneLength) of \InterfacePage with (UNFOLD 2 WORDSPERPAGE)
                  )
           (replace (IFPAGE MDSZone) of \InterfacePage with (\LOLOC BASE))
           (SETQ BASE (\ADDBASE BASE (UNFOLD 2 WORDSPERPAGE)))
           (SETQ \TELERAIDBUFFER BASE)
           (SETQ BASE (\ADDBASE BASE WORDSPERPAGE))
           (add NPAGES -3))
    (PROGN                                                   (* ; "Divvy up buffer space")
           (SETQ \#SWAPBUFFERS (SETQ \#EMUBUFFERS NPAGES))
           (SETQ \#DISKBUFFERS 0)
           (SETQ \EMUSWAPBUFFERS (SETQ \EMUBUFFERS BASE])

(\M-VMEMSAVE
  [LAMBDA NIL                                                (* ; 
                                                           "Edited 20-Apr-88 10:28 by MASINTER")
    (PROG ((SCRATCHBUF \EMUSWAPBUFFERS))
          (replace (IFPAGE MISCSTACKRESULT) of \InterfacePage with T)
          [COND
             (\VMEM.PURE.LIMIT                               (* ; 
                                            "Maintaining file consistency: move high water mark up")
                    (COND
                       (VMEM.COMPRESS.FLG (\DOCOMPRESSVMEM)))
                    (SETQ \VMEM.PURE.LIMIT (fetch (IFPAGE NActivePages) of \InterfacePage]
          (COND
             ((.VMEM.CONSISTENTP.)
              (replace (IFPAGE Key) of \InterfacePage with (LOGNOT16 \IFPValidKey))
                                                             (* ; 
                                                 "Invalidate vmem and write out the Interface page")

              (* ;; "following form doesn't eval for KATANA (\TRANSFERPAGE IFPVP \FirstVmemBlock (RPTFROMRP (\READRP IFPVP)) T NIL)")

              ))
          (replace (IFPAGE Key) of \InterfacePage with \IFPValidKey)
          (\BLT SCRATCHBUF \InterfacePage WORDSPERPAGE)      (* ; 
                              "Make its current fx point at user context, i.e.  the \FLUSHVM frame")
          (replace (IFPAGE CurrentFXP) of SCRATCHBUF with (fetch (IFPAGE MiscFXP)
                                                                         of \InterfacePage))
          (SUBRCALL VMEMSAVE)
          (RETURN NIL])

(\MAIKO.NEWPAGE
  [LAMBDA (BASE NOERROR LOCK?)                               (* ; 
                                                           "Edited 20-Apr-88 10:28 by MASINTER")
    (SUBRCALL NEWPAGE BASE])
)



(* ;; 
"For setting up (and maybe eventually removing?) MAIKO-specific versions of the generic low-levle functions:"
)

(DEFINEQ

(\MAIKO.DO.MOVDS
  [LAMBDA NIL                                                (* ; 
                                                      "Edited  2-Nov-92 03:57 by sybalsky:mv:envos")

    (* ;; "MOVD all the Maiko-specific low-level functions onto their generic counterparts.  This function is called from \MAIKO.FAULTINIT when the system is started up, and called explicitly during the LOADUP process to get everything in a state to run the ethernet.")

    (* ;; "THIS IS WHERE CHANGES SHOULD HAPPEN TO MAKE SUN LOADUPS RUN ON D-MACHINES (BY ADDING A \MAIKO.UNDO.MOVDS CALL AT VMEM SAVING TIME, AND ADDING A SYBMOL TO SAVE THE GENERIC DEFINITION ON TO THE MOVDS LIST.")

    (FOR PAIR IN \MAIKO.MOVDS DO 

                                 (* ;; "This is like MOVD, but absolutely no consing is done, frame names are not changed, etc.  So that no CONSING happens before all the MOVDs are finished -- prevents new-page allocation.")

                                            (LET [(FROMCELL (fetch (LITATOM DEFINITIONCELL)
                                                               of (CAR PAIR)))
                                                  (TOCELL (fetch (LITATOM DEFINITIONCELL)
                                                             of (CADR PAIR]
                                                 (UNINTERRUPTABLY
                                                     (replace (DEFINITIONCELL DEFPOINTER)
                                                        of TOCELL with (fetch
                                                                                (DEFINITIONCELL
                                                                                 DEFPOINTER)
                                                                                  of FROMCELL))
                                                     (replace (DEFINITIONCELL DEFCELLFLAGS)
                                                        of TOCELL with (fetch
                                                                                (DEFINITIONCELL
                                                                                 DEFCELLFLAGS)
                                                                                  of FROMCELL))
                                                     (replace (DEFINITIONCELL AUXDEFCELLFLAGS)
                                                        of TOCELL with (fetch
                                                                                (DEFINITIONCELL
                                                                                 AUXDEFCELLFLAGS)
                                                                                  of FROMCELL)))])
)

(ADDTOVAR \MAIKO.MOVDS
          (TRUE \LOCKEDPAGEP)
          (\MAIKO.NEWPAGE \NEWPAGE)
          (\MAIKO.NEWPAGE \DONEWPAGE)
          (NILL \LOCKPAGES)
          (NILL \DOLOCKPAGES)
          (NILL \DOTEMPLOCKPAGES)
          (NILL \TEMPUNLOCKPAGES)
          (NILL \UNLOCKPAGES)
          (NILL \WRITEDIRTYPAGE)
          (NILL \DIRTYBACKGROUND)
          (ZERO \COUNTREALPAGES)
          (NILL \SHOWPAGETABLE)
          (NILL CHECKPAGEMAP)
          (EVQ \PAGEFAULT)
          (EVQ \LOADVMEMPAGE)
          (NILL \LOADVMEMPAGE)
          (TRUE \MOVEVMEMFILEPAGE)
          (TRUE \VALIDADDRESSP))
(DEFINEQ

(\DOVE.FAULTINIT
  [LAMBDA NIL                                                (* ; "Edited 18-Sep-87 16:01 by bvm:")
    (DECLARE (GLOBALVARS \RCLKMILLISECOND \RCLKSECOND))
    (SETQ \VMEMACCESSFN (FUNCTION \DOVE.ACTONVMEMFILE))
    (SETQ \IOCBPAGE (create POINTER
                           PAGE# _ \VP.IOCBS))
    (COND
       ((NOT (.VMEM.CONSISTENTP.))
        (\MP.ERROR \MP.INVALIDVMEM)))
    (SETMAINTPANEL 1188)
    (\DL.NEWFAULTINIT)
    (SETMAINTPANEL 1189)
    (SETQ \RCLKMILLISECOND \DOVE.RCLKMILLISECOND)
    (SETQ.NOREF \RCLKSECOND (LOCF (fetch RCLKSECOND of \MISCSTATS)))
                                                             (* ; 
                                                    "Unfortunately, \DOVE.RCLKSECOND is not smallp")
    (replace (FIXP HINUM) of \RCLKSECOND with (CONSTANT (\HINUM \DOVE.RCLKSECOND)))
    (replace (FIXP LONUM) of \RCLKSECOND with (CONSTANT (\LONUM \DOVE.RCLKSECOND)))
    (\RCLK (LOCF (fetch BASECLOCK of \MISCSTATS)))   (* ; "Reset base clock")
    (\DoveMisc.ReadGMT (LOCF (fetch SECONDSCLOCK of \MISCSTATS)))
    (SETMAINTPANEL 1190)
    (\PUTBASEPTR (LOCF (fetch MILLISECONDSCLOCK of \MISCSTATS))
           0 NIL)                                            (* ; "Clear the milliseconds timer")
    (\DoveMisc.ReadHostID (LOCF (fetch NSHost0 of \InterfacePage)))
    (SETMAINTPANEL 1191)
    [SETQ \LASTVMEMFILEPAGE (COND
                               (NIL                          (* ; "For now, don't assume vmem is any bigger than the part in use now.  Local file system init will set it to the truth.")
                                    (SETQ \VMEM.FULL.STATE 0)(* ; "Flag to keep pages from being written off the end.  Setting it now prevents bogus vmem full interrupt at startup time.")
                                    (fetch (IFPAGE NActivePages) of \InterfacePage))
                               (T                            (* ; 
                                                           "Microcode is supposed to fill this in")
                                  (fetch (IFPAGE DLLastVmemPage) of \InterfacePage]
    (\DoveDisk.Init)
    (SETMAINTPANEL 1192)
    (\DoveDisplay.TurnOn])

(\DL.FAULTINIT
  [LAMBDA NIL                                                (* bvm%: "20-Oct-86 18:22")
    (SETQ \VMEMACCESSFN (FUNCTION \DL.ACTONVMEMFILE))
    (SETQ \IOCBPAGE (create POINTER
                           PAGE# _ \VP.IOCBS))
    (COND
       ((NOT (.VMEM.CONSISTENTP.))
        (\MP.ERROR \MP.INVALIDVMEM)))
    (\DL.NEWFAULTINIT)
    (SETQ \RCLKMILLISECOND \DLION.RCLKMILLISECOND)           (* ; 
                                                           "These are fortunately both small")
    (SETQ \RCLKSECOND \DLION.RCLKSECOND)
    (\RCLK (LOCF (fetch BASECLOCK of \MISCSTATS)))   (* ; "Reset base clock")
    [COND
       ((EQ (fetch DLTODVALID of \IOPAGE)
            0)                                               (* ; 
                                                       "Time not valid, so store zero in the clock")
        (\PUTBASEPTR (LOCF (fetch SECONDSCLOCK of \MISCSTATS))
               0 NIL))
       (T (bind TMP (BASE _ (LOCF (fetch SECONDSCLOCK of \MISCSTATS)))
             do                                          (* ; 
                        "Loop until clock reads the same as we wrote, in case it was being updated")
                   (\PUTBASE BASE 1 (SETQ TMP (fetch DLTODLO of \IOPAGE)))
                   (\PUTBASE BASE 0 (fetch DLTODHI of \IOPAGE))
             repeatuntil (EQ (fetch DLTODLO of \IOPAGE)
                                 TMP]
    (\PUTBASEPTR (LOCF (fetch MILLISECONDSCLOCK of \MISCSTATS))
           0 NIL)                                            (* ; "Clear the milliseconds timer")
    (repeatwhile (IGEQ (fetch DLPROCESSORCMD of \IOPAGE)
                           \DL.PROCESSORBUSY))               (* ; "Wait for IOP readiness")
    (replace DLPROCESSORCMD of \IOPAGE with \DL.READPID)
                                                             (* ; 
                                                        "Ask it to give the processor ID (3 words)")
    (repeatwhile (IGEQ (fetch DLPROCESSORCMD of \IOPAGE)
                           \DL.PROCESSORBUSY))
    (replace NSHost0 of \InterfacePage with (fetch DLPROCESSOR0 of \IOPAGE))
    (replace NSHost1 of \InterfacePage with (fetch DLPROCESSOR1 of \IOPAGE))
    (replace NSHost2 of \InterfacePage with (fetch DLPROCESSOR2 of \IOPAGE))
    (SETQ \LASTVMEMFILEPAGE (fetch (IFPAGE DLLastVmemPage) of \InterfacePage))
    (\DL.DISKINIT T])

(\DL.NEWFAULTINIT
  [LAMBDA NIL                                                (* ; "Edited 21-Oct-87 15:40 by bvm:")

    (* ;; "We have just started up on a DLion or Daybreak.  Boot code has loaded the first n pages of the sysout into pages 2 thru n-3, except for the area covered by the map and IO page, and has built the map accordingly.  Our principal task is to build \REALPAGETABLE")

    (PROG ((NREALPAGES (fetch (IFPAGE NRealPages) of \InterfacePage))
           (FIRSTBUFFERRP \RP.STARTBUFFERS)
           (SCRATCHVP \VP.INITSCRATCH)
           (SCRATCHBASE (create POINTER
                               PAGE# _ \VP.INITSCRATCH))
           FIRSTUSEFULRP IFPAGERP IOCBRP RPTBASE VP RPTPAGES FIRSTRP NDISPLAYPAGES)
          [do (COND
                     ((for I from 0 to (SUB1 \DLBUFFERPAGES)
                         as (FPBASE _ (\ADDBASE \FPTOVP (DLFPFROMRP FIRSTBUFFERRP)))
                         by (\ADDBASE FPBASE 1)
                         do (COND
                                   ([OR (NOT (fetch FPOCCUPIED of FPBASE))
                                        (\LOCKEDPAGEP (SETQ VP (fetch FPVIRTUALPAGE
                                                                      of FPBASE]

                                    (* ;; "Can't use as buffer.  This is just a check for consistency;  you should pick \RP.STARTBUFFERS so that this isn't a problem")

                                    (RETURN T)))             (* ; 
                                                     "Unmap this page so we can use it for buffers")
                               (\WRITEMAP VP 0 \VMAP.VACANT))(* ; "Bad starting place, try again")
                      (add FIRSTBUFFERRP 1))
                     (T (RETURN]
          (SETQ FIRSTUSEFULRP (+ FIRSTBUFFERRP \DLBUFFERPAGES))
          (PROGN                                             (* ; 
                                                      "Copy vital info that booting left in page 1")
                 [COND
                    ((EQ \MACHINETYPE \DAYBREAK)

                     (* ;; "Use first buffer page for IOCB page.  Used to have to place this in a real page whose page-in-segment number was the same as that of \VP.IOCBS, but that constraint is now lifted for Daybreak.")

                     (SETQ IOCBRP FIRSTBUFFERRP)
                     (add FIRSTBUFFERRP 1))
                    (T (SETQ IOCBRP (+ (LOGAND (SUB1 (IMIN NREALPAGES 3072))
                                              65280)
                                       \VP.IOCBS))

                       (* ;; "Put IOCB page near the end of memory, but in the first 1.5 mb so that Burdock can see it.  Temporary until Steve fixes swap code to not care what RP contains IOCB's")

                       [SETQ VP (fetch FPVIRTUALPAGE of (\ADDBASE \FPTOVP (DLFPFROMRP IOCBRP]
                       (COND
                          ((\LOCKEDPAGEP VP)
                           (\MP.ERROR \MP.IOCBPAGE))
                          (T                                 (* ; 
                                                           "Unmap whoever lived in our target page")
                             (\WRITEMAP VP 0 \VMAP.VACANT]
                 (\WRITEMAP \VP.IOCBS IOCBRP \VMAP.CLEAN)
                 (\WRITEMAP SCRATCHVP 1 \VMAP.CLEAN)
                 (\BLT \IOCBPAGE SCRATCHBASE WORDSPERPAGE))
          (PROGN                                             (* ; 
                                                           "Copy InterfacePage out of segment zero")
                 (\WRITEMAP SCRATCHVP FIRSTBUFFERRP \VMAP.CLEAN)
                 (\BLT SCRATCHBASE \InterfacePage WORDSPERPAGE)
                 (\WRITEMAP \VP.IFPAGE (SETQ IFPAGERP FIRSTBUFFERRP)
                        \VMAP.CLEAN)
                 (add FIRSTBUFFERRP 1))
          [PROGN                                             (* ; 
                                                "Unmap everything that fell somewhere we can't use")
                 (\DL.UNMAPPAGES (ADD1 \FP.IFPAGE)
                        (DLFPFROMRP \RP.IOPAGE))             (* ; 
                                                           "real segment zero, map or IOPAGE")
                 (COND
                    ((EQ \MACHINETYPE \DANDELION)
                     (for NEXTBANK0 from 2MBPAGES by 2MBPAGES
                        until (> NEXTBANK0 NREALPAGES) do 

                                           (* ;; "All the `shadows of the display bank' in higher memory have restricted use;  take them out of commission for now")

                                                                 (\DL.UNMAPPAGES NEXTBANK0
                                                                        (+ NEXTBANK0 PAGESPERSEGMENT
                                                                           -1]
          (PROGN                                             (* ; "Copy Display into segment zero")
                 [SETQ NDISPLAYPAGES (COND
                                        ((EQ \MACHINETYPE \DANDELION)

                                 (* ;; "Only lock the standard screen's worth of pages on DLion, even if there are more because the sysout came from wide Daybreak.  Only this many need to be in the display bank, besides which there is a cursor bank after the display;  the rest can be vanilla locked pages.")

                                         \NP.DISPLAY)
                                        (T (IMAX \NP.DISPLAY (ADD1 \MaxScreenPage]
                                                             (* ; 
                                                     "Number of display pages in use in this image")
                 (for I from 0 to (SUB1 NDISPLAYPAGES)
                    do (\WRITEMAP (+ SCRATCHVP I)
                                  (+ \RP.DISPLAY I)
                                  \VMAP.CLEAN))              (* ; 
                                                          "Point scratch area at real segment zero")
                 (\BLT SCRATCHBASE (create POINTER
                                          PAGE# _ \VP.DISPLAY)
                       (UNFOLD NDISPLAYPAGES WORDSPERPAGE))  (* ; 
                                                           "Copy display from wherever boot put it")
                 (for I from 0 to (SUB1 NDISPLAYPAGES)
                    do (\WRITEMAP (+ SCRATCHVP I)
                                  0 \VMAP.VACANT)
                          (\WRITEMAP (+ \VP.DISPLAY I)
                                 (+ \RP.DISPLAY I)
                                 \VMAP.CLEAN))               (* ; 
                                        "Display is now where hardware wants it, so enable display")
                 (replace (IOPAGE DLDISPCONTROL) of \IOPAGE with 0))
          (COND
             ((EQ \MACHINETYPE \DAYBREAK)                    (* ; 
   "If on a daybreak, map the I/O region.  Have to do this before calling \DoveDisplay.ScreenWidth")
              (for I from 0 to (SUB1 \DOVEIORGNSIZE) do (\WRITEMAP (+ \VP.DOVEIORGN I
                                                                                      )
                                                                               (+ \RP.DOVEIORGN I)
                                                                               \VMAP.CLEAN))
              (\DoveIO.InitializeIORegionPtrs)))
          [PROG ((RPSIZE (- NREALPAGES (SETQ \RPOFFSET -1)))
                 (FIRSTVP \VP.RPT))
                (SETQ FIRSTRP (COND
                                 ((OR (> NDISPLAYPAGES \NP.DISPLAY)
                                      (AND (EQ \MACHINETYPE \DAYBREAK)
                                           (EQ (\DoveDisplay.ScreenWidth)
                                               \WIDEDOVEDISPLAYWIDTH)))

                                  (* ;; "Sysout was made on a large screen daybreak, or is now being run on one.  Need to make sure there is space for all that display")

                                  \RP.AFTERDOVEDISPLAY)
                                 (T \RP.AFTERDISPLAY)))      (* ; 
                                      "Construct real page table in segment zero after the display")
                [COND
                   ((> RPSIZE (CONSTANT (EXPT 2 15)))        (* ; 
        "We only have 15 bits for real page table numbers, so have to sacrifice the rest of memory")
                    (SETQ RPSIZE (CONSTANT (EXPT 2 15]
                [SETQ RPTPAGES (PROGN 

                                 (* ;; "This is a way of computing (FOLDHI RPSIZE*3 WORDSPERPAGE) that won't overflow when memory exceeds 10.6MB -- the first term computes RPSIZE*3/256, the second performs the FOLDHI directly on the now much smaller remainder.")

                                      (+ (TIMES3 (FOLDLO RPSIZE WORDSPERPAGE))
                                         (FOLDHI (TIMES3 (IMOD RPSIZE WORDSPERPAGE))
                                                WORDSPERPAGE]
                (COND
                   ((> (+ RPTPAGES FIRSTRP)
                       PAGESPERSEGMENT)

                    (* ;; "No space in bank zero, so put RPT in first segment after 2 megabytes, where the first `shadow' display bank lives.  No shadow bank on Daybreak, but this is as good a place as any")

                    (SETQ FIRSTRP (IMIN 2MBPAGES (- NREALPAGES RPTPAGES)))
                                                             (* ; 
                            "IMIN because we could be on a wide-display Daybreak with small memory")
                    [COND
                       ((> (+ FIRSTVP RPTPAGES)
                           \VP.BUFFERS)                      (* ; 
                                                   "Move virtual assignment backwards if necessary")
                        (SETQ FIRSTVP (COND
                                         ((< RPTPAGES \VP.BUFFERS)
                                          (- \VP.BUFFERS RPTPAGES))
                                         ((<= RPTPAGES PAGESPERSEGMENT)
                                                             (* ; 
                      "Can't fit real page table in display bank at all, so overlap smallneg space")
                                          (UNFOLD \SmallNegHi PAGESPERSEGMENT))
                                         (T                  (* ; 
                                    "Ack, more than 10.6 MB, have to slop over into smallpos space")
                                            (- (+ (UNFOLD \SmallNegHi PAGESPERSEGMENT)
                                                  PAGESPERSEGMENT)
                                               RPTPAGES]
                    (\DL.UNMAPPAGES (DLFPFROMRP FIRSTRP)
                           (DLFPFROMRP (+ FIRSTRP RPTPAGES -1)))
                                                             (* ; 
"Unmap the pages in which RPT lives.  This was already done on DLion, but can't hurt to do it again")
                    ))
                (for I from 0 to (SUB1 RPTPAGES) do 
                                                             (* ; 
                                                           "Assign pages to real page table now")
                                                                   (\WRITEMAP (+ FIRSTVP I)
                                                                          (+ FIRSTRP I)
                                                                          \VMAP.CLEAN))
                (SETQ \REALPAGETABLE (create POINTER
                                            PAGE# _ FIRSTVP))
                (\CLEARWORDS \REALPAGETABLE RPSIZE)
                (\CLEARWORDS (\ADDBASE \REALPAGETABLE RPSIZE)
                       RPSIZE)
                (\CLEARWORDS (\ADDBASE (\ADDBASE \REALPAGETABLE RPSIZE)
                                    RPSIZE)
                       RPSIZE)                               (* ; 
                                  "Clear table in three steps, since 3*RPSIZE overflows after 10MB")
                (SETQ \RPTSIZE RPSIZE)
                (COND
                   [(EQ \MACHINETYPE \DANDELION)
                    (for NEXTBANK0 from 2MBPAGES by 2MBPAGES
                       until (> NEXTBANK0 NREALPAGES) do 
                                                             (* ; 
                                                   "Mark the shadow display bank pages unavailable")
                                                                (\DL.MARK.PAGES.UNAVAILABLE
                                                                 NEXTBANK0
                                                                 (+ NEXTBANK0 PAGESPERSEGMENT -1]
                   (T 
                      (* ;; "RPT itself occupies unavailable pages;  on DLion these were marked unavailable either in segment zero after display or as part of shadow bank")

                      (\DL.MARK.PAGES.UNAVAILABLE FIRSTRP (+ FIRSTRP RPTPAGES -1))
                                                             (* ; 
                                                           "Also, Dove IO region is unavailable")
                      (\DL.MARK.PAGES.UNAVAILABLE \RP.DOVEIORGN (SUB1 (+ \RP.DOVEIORGN 
                                                                             \DOVEIORGNSIZE]
          (PROGN 
                 (* ;; "Fill in special cases in RPT -- the display, which is not where FPTOVP says it is, and all the pages that are unavailable for one reason or another.  Note: any page marked unavailable here MUST be unmapped by now, either because booting never put it where FPTOVP says it would be, there's no page there to begin with, or there's an explicit call to \WRITEMAP or \DL.UNMAPPAGES to unmap it above")

                 (SETQ RPTBASE \REALPAGETABLE)
                 [for I from 0 to (SUB1 NDISPLAYPAGES)
                    do (SETQ RPTBASE (\ADDBASE RPTBASE \RPTENTRYLENGTH)) 
                                                             (* ; "Fill in Display pages")
                          (replace (RPT VP) of RPTBASE with (+ \VP.DISPLAY I))
                          (replace (RPT FILEPAGE) of RPTBASE with (DLFPFROMRP
                                                                               (+ \RP.TEMPDISPLAY I]
                 (\DL.MARK.PAGES.UNAVAILABLE NDISPLAYPAGES \RP.IOPAGE)
                                                             (* ; 
                                        "Mark rest of segment zero plus Map and IOPAGE unavailable")
                 )
          [PROGN                                             (* ; 
                                                       "fill in main part of RPT by reading FPTOVP")
                 (for I from (ADD1 \RP.IOPAGE) to (SUB1 NREALPAGES)
                    as [FPBASE _ (\ADDBASE \FPTOVP (DLFPFROMRP (ADD1 \RP.IOPAGE]
                    by (\ADDBASE FPBASE 1) as [RPTBASE _ (fetch RPTRBASE
                                                                    of (RPTFROMRP (ADD1 
                                                                                           \RP.IOPAGE
                                                                                            ]
                    by (\ADDBASE RPTBASE \RPTENTRYLENGTH)
                    bind (LASTREALPAGE _ (DLRPFROMFP (fetch (IFPAGE NActivePages)
                                                            of \InterfacePage)))
                    do 

                          (* ;; "Fill in rest of RPT from \FPTOVP.  Could optimize this a little by special casing the area occupied by the display, but this is simpler")

                          (COND
                             ((fetch (RPT UNAVAILABLE) of RPTBASE))
                             ((AND (<= I LASTREALPAGE)
                                   (fetch FPOCCUPIED of FPBASE)
                                   [NOT (fetch (VMEMFLAGS VACANT)
                                           of (\READFLAGS (SETQ VP (fetch FPVIRTUALPAGE
                                                                          of FPBASE]
                                   (EQ I (\READRP VP)))

                              (* ;; "There is a VP assigned to this filepage, and it is still there.  False for display that got moved and any real pages that didn't get filled.  LASTREALPAGE is in case the real memory is larger than the sysout -- FPTOVP does not exist all the way")

                              (replace (RPT VP) of RPTBASE with VP)
                              (replace (RPT FILEPAGE) of RPTBASE with (DLFPFROMRP I)))
                             (T (replace (RPT EMPTY) of RPTBASE with T]
          (PROGN                                             (* ; 
                                                           "Touch up RPT with the exceptions")
                 (SETQ RPTBASE (fetch RPTRBASE of (RPTFROMRP IFPAGERP)))
                                                             (* ; "Interface Page")
                 (replace (RPT VP) of RPTBASE with \VP.IFPAGE)
                 (replace (RPT FILEPAGE) of RPTBASE with \FP.IFPAGE)
                 (replace (RPT UNAVAILABLE) of (fetch RPTRBASE of (RPTFROMRP IOCBRP))
                    with T)                              (* ; "\IOCBPAGE")
                 (\DL.MARK.PAGES.UNAVAILABLE FIRSTBUFFERRP (SUB1 FIRSTUSEFULRP))
                                                             (* ; 
                                                           "buffer pages unavailable to swapper")
                 )
          (\CHAIN.UP.RPT)
          (PROG ((NBUFFERS (- FIRSTUSEFULRP FIRSTBUFFERRP))) (* ; "Allocate buffers")
                (for I from 0 to (SUB1 NBUFFERS) do (\WRITEMAP (+ \VP.BUFFERS I)
                                                                           (+ FIRSTBUFFERRP I)
                                                                           \VMAP.CLEAN))
                (\DL.ASSIGNBUFFERS (create POINTER
                                              PAGE# _ \VP.BUFFERS)
                       NBUFFERS])

(\DL.UNMAPPAGES
  [LAMBDA (FIRSTFP LASTFP)                                   (* bvm%: "14-Jan-84 14:20")

(* ;;; 
"At initialization time, unmap anything that originally lived in filepages FIRSTFP thru LASTFP")

    (for FP from FIRSTFP to LASTFP as (FPBASE _ (\ADDBASE \FPTOVP FIRSTFP))
       by (\ADDBASE FPBASE 1) when (fetch FPOCCUPIED of FPBASE)
       do (\WRITEMAP (fetch FPVIRTUALPAGE of FPBASE)
                     0 \VMAP.VACANT])

(\DL.MARK.PAGES.UNAVAILABLE
  [LAMBDA (FIRSTRP LASTRP)                                   (* bvm%: "14-Jan-84 14:32")
    (for I from FIRSTRP to LASTRP as (RPTBASE _ (fetch RPTRBASE
                                                                   of (RPTFROMRP FIRSTRP)))
       by (\ADDBASE RPTBASE \RPTENTRYLENGTH) do (replace (RPT UNAVAILABLE) of RPTBASE
                                                           with T])

(\DL.ASSIGNBUFFERS
  [LAMBDA (BASE NPAGES)                                      (* bvm%: "29-Jan-85 19:05")
    (PROGN                                                   (* ; 
                    "Allocate a page to hold name and password, and perhaps other ephemeral things")
           (\CLEARWORDS BASE WORDSPERPAGE)
           (replace (IFPAGE UserNameAddr) of \InterfacePage with (\LOLOC (\ADDBASE BASE 1
                                                                                            )))
           (replace (IFPAGE UserPswdAddr) of \InterfacePage with (\LOLOC (\ADDBASE BASE 
                                                                                            33)))
           (SETQ BASE (\ADDBASE BASE WORDSPERPAGE))
           (add NPAGES -1))
    (PROGN                                                   (* ; "Assign swap buffer")
           (SETQ \EMBUFBASE BASE)
           (SETQ \EMBUFVP (fetch (POINTER PAGE#) of BASE))
           (SETQ \EMBUFRP (\READRP \EMBUFVP))
           (SETQ BASE (\ADDBASE BASE WORDSPERPAGE))
           (add NPAGES -1))
    (PROGN                                                   (* ; "Assign ether buffers")
           (replace (IFPAGE MDSZoneLength) of \InterfacePage with (UNFOLD 2 WORDSPERPAGE)
                  )
           (replace (IFPAGE MDSZone) of \InterfacePage with (\LOLOC BASE))
           (SETQ BASE (\ADDBASE BASE (UNFOLD 2 WORDSPERPAGE)))
           (SETQ \TELERAIDBUFFER BASE)
           (SETQ BASE (\ADDBASE BASE WORDSPERPAGE))
           (add NPAGES -3))
    (PROGN                                                   (* ; "Divvy up buffer space")
           (SETQ \#SWAPBUFFERS (SETQ \#EMUBUFFERS NPAGES))
           (SETQ \#DISKBUFFERS 0)
           (SETQ \EMUSWAPBUFFERS (SETQ \EMUBUFFERS BASE])

(\CHAIN.UP.RPT
  [LAMBDA NIL                                                (* bvm%: "18-Dec-84 16:07")

(* ;;; "Maps over the Real Page Table as constructed so far and fleshes it out.  Assumes that the table is built, has all its VP and FILEPAGE entries set, and that the empty and unavailable entries are so marked.  Finishes the job by chaining together the available pages and setting the LOCKED bits")

    (PROG ((RPTBASE \REALPAGETABLE)
           (LASTEMPTY \REALPAGETABLE)
           (LASTUSED (\ADDBASE \REALPAGETABLE 1))
           FIRSTUSED)
          (SETQ FIRSTUSED LASTUSED)

     (* ;; "The `entry' \REALPAGETABLE is a dummy that points to the least recently used entry.  We use the second word of that dummy as a temporary chain head for the used pages, so that we can put all the empty pages at the front of the queue.")

          [for I from 1 to (SUB1 \RPTSIZE)
             do (SETQ RPTBASE (\ADDBASE RPTBASE \RPTENTRYLENGTH))
                   (COND
                      ((fetch (RPT UNAVAILABLE) of RPTBASE))
                      ((fetch (RPT EMPTY) of RPTBASE)
                       (replace (RPT NEXTRP) of LASTEMPTY with I)
                       (replace (RPT LOCKED) of RPTBASE with NIL)
                       (SETQ LASTEMPTY RPTBASE))
                      (T (replace (RPT NEXTRP) of LASTUSED with I)
                         (replace (RPT LOCKED) of RPTBASE with (\LOCKEDPAGEP
                                                                            (fetch (RPT VP)
                                                                               of RPTBASE)))
                         (SETQ LASTUSED RPTBASE]             (* ; 
                                    "Finally, link the end of empty chain to front of in use chain")
          (replace (RPT NEXTRP) of LASTEMPTY with (fetch (RPT NEXTRP) of 
                                                                                            FIRSTUSED
                                                                     ))
          (replace (RPT NEXTRP) of (SETQ \RPTLAST LASTUSED) with \PAGETABLESTOPFLG)
          (replace (RPT UNAVAILABLE) of \REALPAGETABLE with T)
                                                             (* ; "Dummy first entry")
      ])
)



(* ; "Pagefault handler")

(DEFINEQ

(\FAULTHANDLER
  [LAMBDA NIL                                                (* ; "Edited 27-Sep-88 00:47 by jds")
    (PROG NIL
      LP  [OR (AND \DOFAULTINIT (\FAULTINIT))
              (\PAGEFAULT (\VAG2 (LOGAND 255 (fetch (IFPAGE FAULTHI) of \InterfacePage))
                                     (fetch (IFPAGE FAULTLO) of \InterfacePage]
          (\CONTEXTSWITCH \FAULTFXP)
          (GO LP])

(\PAGEFAULT
  [LAMBDA (PTR)                                              (* bvm%: "13-Aug-85 16:38")
    (\CLOCK0 (LOCF (fetch SWAPTEMP0 of \MISCSTATS))) (* ; "Note time of start")
    (PROG ((VP (fetch (POINTER PAGE#) of PTR))
           FLAGS FILEPAGE)
          (COND
             ((fetch (VP INVALID) of VP)             (* ; 
      "Map out of bounds on Dolphin always produces -1 as the vp.  Don't know about other machines")
              (\MP.ERROR \MP.MOB "Page Fault: Map out of bounds" (AND (NEQ VP 65535)
                                                                          PTR)
                     T))
             ([NOT (fetch (VMEMFLAGS VACANT) of (SETQ FLAGS (\READFLAGS VP]
              (\MP.ERROR \MP.RESIDENT "Fault on resident page" PTR T))
             ((EQ (SETQ FILEPAGE (\LOOKUPPAGEMAP VP))
                  0)
              (\INVALIDADDR PTR))
             (T (COND
                   ((EQ (\HILOC PTR)
                        \STACKHI)                            (* ; 
                                                           "should never happen.  For debugging")
                    (\MP.ERROR \MP.STACKFAULT "Fault on stack" PTR T)))
                (\LOADVMEMPAGE VP FILEPAGE)))
          (COND
             (\NEWVMEMPAGEADDED                              (* ; 
                                                           "Only happens if VMEM.PURE.STATE on")
                    (\ASSURE.FPTOVP.PAGE)))
          [\BOXIPLUS (LOCF (fetch SWAPWAITTIME of \MISCSTATS))
                 (\BOXIDIFFERENCE (\CLOCK0 (LOCF (fetch SWAPTEMP1 of \MISCSTATS)))
                        (LOCF (fetch SWAPTEMP0 of \MISCSTATS]
                                                             (* ; "Count the time used.")
          (RETURN PTR])

(\INVALIDADDR
  [LAMBDA (ADDR)                                             (* bvm%: " 6-AUG-83 22:25")
    (\MP.ERROR \MP.INVALIDADDR "Invalid address" ADDR T])

(\INVALIDVP
  [LAMBDA (VP)                                               (* bvm%: " 6-AUG-83 22:25")
    (\MP.ERROR \MP.INVALIDVP "Invalid VP" VP])

(\FLUSHPAGE
  [LAMBDA (RPTINDEX FROMFLUSHVM)                             (* bvm%: "13-Aug-85 16:35")

(* ;;; "Write out real page RPTINDEX if it is dirty.")

    (PROG ((RPTR (fetch RPTRBASE of RPTINDEX))
           VP FP NEWFP)
          (COND
             ([AND (fetch (RPT OCCUPIED) of RPTR)
                   (fetch (VMEMFLAGS DIRTY) of (\READFLAGS (SETQ VP (fetch (RPT VP)
                                                                               of RPTR]
                                                             (* ; "Yes, page is dirty")
              (SETQ FP (fetch (RPT FILEPAGE) of RPTR))
              [COND
                 [(AND \VMEM.PURE.LIMIT (NOT FROMFLUSHVM))   (* ; 
                                "Don't sully vmem;  write page out beyond the original end of vmem")
                  (COND
                     ((ILEQ FP \VMEM.PURE.LIMIT)
                      (COND
                         ((fetch (RPT LOCKED) of RPTR)
                          (\MP.ERROR \MP.WRITING.LOCKED.PAGE)))
                      (SETQ NEWFP (add (fetch NActivePages of \InterfacePage)
                                         1))
                      (COND
                         ((IGREATERP NEWFP (IDIFFERENCE \LASTVMEMFILEPAGE \GUARDVMEMFULL))
                          (\SET.VMEM.FULL.STATE)))
                      (SETQ \NEWVMEMPAGEADDED T)
                      (\PUTBASE (.PAGEMAPBASE. VP)
                             0 NEWFP)
                      (\PUTBASE \FPTOVP NEWFP VP)
                      (\PUTBASE \FPTOVP FP \NO.VMEM.PAGE)
                      (replace (RPT FILEPAGE) of RPTR with (SETQ FP NEWFP]
                 ((.VMEM.CONSISTENTP.)
                  (replace (IFPAGE Key) of \InterfacePage with (LOGNOT16 \IFPValidKey))
                                                             (* ; 
                                                 "Invalidate vmem and write out the Interface page")
                  (SETQ \DIRTYPAGEHINT 0)                    (* ; 
                                                "So that the dirty page background writer wakes up")
                  (PROG ((IFVP (fetch (POINTER PAGE#) of \InterfacePage)))
                        (\TRANSFERPAGE IFVP \FirstVmemBlock (RPTFROMRP (\READRP IFVP))
                               T NIL]                        (* ; "Write it out")
              (COND
                 ((IGREATERP \DIRTYPAGEHINT 0)
                  (add \DIRTYPAGEHINT -1)))
              (\TRANSFERPAGE VP FP RPTINDEX T NIL])

(\LOADVMEMPAGE
  [LAMBDA (VPAGE FILEPAGE NEWPAGEFLG LOCK? DONTMOVETOPFLG)   (* bvm%: "10-Aug-85 18:08")

    (* ;; "Fault in virtual page VPAGE known to live in FILEPAGE on the vmem.  NEWPAGEFLG is true if the page is new, so should just be cleared, not loaded from vmem file.  If LOCK?  is true, locks down the page as well.  In this case, if on Dandelion, we also check for page wanting to live in a particular real page.  If DONTMOVETOPFLG is true, the real page we put this page in is not promoted to the front of the LRU queue of pages")

    (COND
       ((IGREATERP \PAGEFAULTCOUNTER \UPDATECHAINFREQ)
        (\UPDATECHAIN)))
    (add \PAGEFAULTCOUNTER 1)
    (PROG ((RPTINDEX (\SELECTREALPAGE FILEPAGE LOCK? DONTMOVETOPFLG))
           RPTBASE SPECIALRP)
          (SETQ RPTBASE (fetch RPTRBASE of RPTINDEX))
          [COND
             ((AND LOCK? (OR (EQ \MACHINETYPE \DANDELION)
                             (EQ \MACHINETYPE \DAYBREAK))
                   (SETQ SPECIALRP (\SPECIALRP VPAGE)))  (* ; 
"Must actually put FILEPAGE into special RP, and thus move old contents of SPECIALRP into RPTINDEX")
              (LET* ((SRINDEX (RPTFROMRP SPECIALRP))
                     (SRPTR (fetch RPTRBASE of SRINDEX)))
                    (\MOVEREALPAGE SRINDEX SRPTR RPTINDEX RPTBASE)
                    (SETQ RPTINDEX SRINDEX)
                    (SETQ RPTBASE SRPTR]                     (* ; 
                                                       "Fill in new RPTINDEX with appropriate data")
          (replace (RPT VP) of RPTBASE with VPAGE)
          (replace (RPT FILEPAGE) of RPTBASE with FILEPAGE)
          (replace (RPT LOCKED) of RPTBASE with LOCK?)
          (COND
             ([AND DOLOCKCHECKS (NOT LOCK?)
                   (EQ (LRSH VPAGE 8)
                       (CONSTANT (\HILOC \PAGEMAP]
              (\MP.ERROR \MP.MAPNOTLOCKED "Page of page map being loaded but not locked" VPAGE)))
          (\TRANSFERPAGE VPAGE FILEPAGE RPTINDEX NIL NEWPAGEFLG])

(\MOVEREALPAGE
  [LAMBDA (SOURCEINDEX SOURCERPT DESTINDEX DESTRPT)          (* bvm%: "14-Aug-85 13:53")

(* ;;; "Moves the page, if any, currently living in real page table SOURCEINDEX & SOURCERPT into the page indicated by DESTINDEX & DESTRPT.  The destination is assumed to have been vacated")

    (CHECK (NOT (fetch (RPT LOCKED) of SOURCERPT)))
    (replace (RPT LOCKED) of DESTRPT with NIL)
    [COND
       ((fetch (RPT OCCUPIED) of SOURCERPT)          (* ; 
                                                           "Page was not vacant to start with")
        (LET* ((SOURCEVP (fetch (RPT VP) of SOURCERPT))
               (SOURCEFLAGS (\READFLAGS SOURCEVP)))
              (replace (RPT VP) of DESTRPT with SOURCEVP)
              (replace (RPT FILEPAGE) of DESTRPT with (fetch (RPT FILEPAGE)
                                                                     of SOURCERPT))
              (\WRITEMAP \EMBUFVP (RPFROMRPT DESTINDEX)
                     0)                                      (* ; "Map buffer to target page")
              (\BLT \EMBUFBASE (create POINTER
                                      PAGE# _ SOURCEVP)
                    WORDSPERPAGE)                            (* ; "move data to buffer page")
              (\WRITEMAP \EMBUFVP \EMBUFRP 0)                (* ; 
                                                           "Restore buffer to its proper page")
              (\WRITEMAP SOURCEVP (RPFROMRPT DESTINDEX)
                     SOURCEFLAGS)                            (* ; "Set flags and new RP for page")
              ]
    DESTINDEX])

(\LOOKUPPAGEMAP
  [LAMBDA (VP)                                               (* bvm%: "20-Oct-86 18:26")

    (* ;; "Returns the pagemap entry for VP, which is expected to be in bounds.  High bit of result is the lock bit.  Zero denotes absence")

    (LET [(PRIMENTRY (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP]
         (COND
            ((EQ PRIMENTRY \EMPTYPMTENTRY)
             0)
            (T (\GETBASE \PAGEMAP (IPLUS PRIMENTRY (fetch (VP SECONDARYKEY) of VP])

(\VALIDADDRESSP
  [LAMBDA (BASE)                                             (* bvm%: "16-Jun-86 11:30")
    (NEQ 0 (\LOOKUPPAGEMAP (fetch (POINTER PAGE#) of BASE])

(\LOCKEDPAGEP
  [LAMBDA (VP TEMP)                                          (* bvm%: "18-Feb-85 18:08")

(* ;;; "True if VP is locked.  If TEMP is NIL consults only the locked page table;  otherwise, also checks for `temporary' locked page")

    (OR (NEQ 0 (LOGAND (.LOCKEDVPMASK. VP)
                      (\GETBASE (.LOCKEDVPBASE. VP)
                             0)))
        (UNLESSRDSYS (AND TEMP (NOT (fetch (VMEMFLAGS VACANT) of (\READFLAGS VP)))
                          (fetch (RPT LOCKED) of (fetch RPTRBASE
                                                            of (RPTFROMRP (\READRP VP])

(\SELECTREALPAGE
  [LAMBDA (NEWFP LOCK? DONTMOVETOPFLG)                       (* bvm%: "10-Aug-85 18:08")

    (* ;; "Selects a real page, flushing it if necessary, and returns the RPT index of the page.  NEWFP, if supplied, is the filepage that will be read into here.  This might influence page choice by minimizing seek time.  LOCK?  means caller intends to lock the page, which constrains which real pages it can fall into.  The selected page is moved to the back of the LRU queue, so that it won't be selected again soon, unless DONTMOVETOPFLG is true.  If DONTMOVETOPFLG is REMOVE then the page is spliced out of the chain forever.")

    (PROG ((TRIES 0)
           (CNTR \MAXCLEANPROBES)
           (DISTANCE \MINSHORTSEEK)
           PREVRPT PREVINDEX RPTINDEX RPTBASE FP FLAGS)
      RETRY
          (SETQ PREVRPT \REALPAGETABLE)
          (until (EQ (SETQ RPTINDEX (fetch (RPT NEXTRP) of PREVRPT))
                         \PAGETABLESTOPFLG)
             do (SETQ RPTBASE (fetch RPTRBASE of RPTINDEX))
                   [COND
                      ((fetch (RPT EMPTY) of RPTBASE)
                       (RETURN PREVRPT))
                      ((NOT (fetch (RPT OCCUPIED) of RPTBASE))
                       (\MP.ERROR \MP.CHAIN.UNAVAIL "UNAVAILABLE page on Chain"))
                      ([AND (NOT (fetch (RPT LOCKED) of RPTBASE))
                            [NOT (fetch (VMEMFLAGS REFERENCED)
                                    of (SETQ FLAGS (\READFLAGS (fetch (RPT VP) of RPTBASE
                                                                          ]
                            (OR (NOT LOCK?)
                                (.LOCKABLERP. (RPFROMRPT RPTINDEX]

                       (* ;; "Page is unlocked and unreferenced, so is good candidate for flushing.  LOCK?  check is to avoid locking a page into a real page that might be desired by code that cares about real pages")

                       (COND
                          ([OR (NOT (fetch (VMEMFLAGS DIRTY) of FLAGS))
                               (PROGN (SETQ FP (fetch (RPT FILEPAGE) of RPTBASE))
                                      (COND
                                         ((SELECTQ \VMEM.INHIBIT.WRITE
                                              (NIL [SELECTQ \VMEM.FULL.STATE
                                                       (NIL  (* ; "Normal, can write anything")
                                                            T)
                                                       (T    (* ; 
                                                     "Vmem is full and clean, don't write anything")
                                                          NIL)
                                                       (PROGN 
                                                             (* ; 
              "Vmem is full, but sullied, so might as well write anything for which there is space")
                                                              (AND (ILEQ FP \LASTVMEMFILEPAGE)
                                                                   (OR (NULL \VMEM.PURE.LIMIT)
                                                                       (IGREATERP FP \VMEM.PURE.LIMIT
                                                                              ])
                                              (NEW           (* ; 
      "Only allowed to write old pages, since new pages might just have to get moved a second time")
                                                   (ILEQ FP \VMEM.PURE.LIMIT))
                                              (PROGN         (* ; 
                                                           "We are forbidden from writing any page")
                                                     NIL))
                                          (COND
                                             ((OR (ILEQ CNTR 0)
                                                  (NULL NEWFP)
                                                  (ILESSP (IABS (IDIFFERENCE FP NEWFP))
                                                         DISTANCE))
                                                             (* ; 
                               "Page is near replacement, or we have given up trying for closeness")
                                              T)
                                             (T              (* ; 
                                                       "Page is too far away from replacement page")
                                                (SETQ CNTR (SUB1 CNTR))
                                                [COND
                                                   ((ILESSP DISTANCE \MAXSHORTSEEK)
                                                             (* ; "Get more liberal")
                                                    (SETQ DISTANCE (LLSH DISTANCE 1]
                                                NIL]
                           [COND
                              (DOLOCKCHECKS (COND
                                               ((fetch (RPT LOCKED) of RPTBASE)
                                                (\MP.ERROR \MP.FLUSHLOCKED 
                                                       "Attempt to displace locked page" RPTBASE))
                                               ((EQ (fetch (RPT VPSEG) of RPTBASE)
                                                    (CONSTANT (\HILOC \PAGEMAP)))
                                                (\MP.ERROR \MP.MAPNOTLOCKED 
                                                       "A page of the page map is not locked" RPTBASE
                                                       ]
                           (\FLUSHPAGE RPTINDEX)
                           (\WRITEMAP (fetch (RPT VP) of RPTBASE)
                                  0 \VMAP.VACANT)
                           (replace (RPT EMPTY) of RPTBASE with T)
                           (RETURN PREVRPT]
                   (SETQ PREVRPT RPTBASE)
                   (SETQ PREVINDEX RPTINDEX) finally 

                                 (* ;; "Couldn't find an unreffed page because all pages were touched since last \UPDATECHAIN.  Do another, which clears ref bits, and try again")

                                                   (COND
                                                      ((EQ TRIES 0)
                                                       (SETQ TRIES 1)
                                                       (\UPDATECHAIN))
                                                      [(AND (EQ TRIES 1)
                                                            \VMEM.INHIBIT.WRITE)
                                                       (SETQ \VMEM.INHIBIT.WRITE)
                                                       (COND
                                                          ((AND (NEQ \MACHINETYPE \DANDELION)
                                                                (NEQ \MACHINETYPE \DAYBREAK))

                                 (* ;; "Don't call RAID on a DLion, since the interface is so bad.  Dorado user might want to know that we're smashing \VMEM.INHIBIT.WRITE")

                                                           (RAID 
                                      "No clean vmem pages to reuse, must write one.  ^N to continue"
                                                                 ]
                                                      (T (\MP.ERROR \MP.SELECTLOOP 
                                                                "Loop in \SELECTREALPAGE")))
                                                   (GO RETRY))
          (SELECTQ DONTMOVETOPFLG
              (NIL                                           (* ; 
                           "Move this page to head of chain, so that it won't be picked again soon")
                   (replace (RPT NEXTRP) of PREVRPT with (fetch (RPT NEXTRP)
                                                                        of RPTBASE))
                                                             (* ; "Splice RPTINDEX out of chain")
                   (replace (RPT NEXTRP) of \RPTLAST with RPTINDEX)
                                                             (* ; "Put new page at end of chain")
                   (replace (RPT NEXTRP) of (SETQ \RPTLAST RPTBASE) with 
                                                                                  \PAGETABLESTOPFLG))
              (REMOVE                                        (* ; 
                                                         "Splice this page out of chain altogether")
                      (replace (RPT NEXTRP) of PREVRPT with (fetch (RPT NEXTRP)
                                                                           of RPTBASE))
                      (replace (RPT NEXTRP) of RPTBASE with \PAGETABLESTOPFLG))
              NIL)
          (RETURN RPTINDEX])

(\SPECIALRP
  [LAMBDA (VP)                                               (* edited%: " 9-Aug-85 17:14")

    (* ;; "for \DANDELION, some virtual pages must be mapped into special real pages.  This function returns the corresponding real page")

    (SELECTC (FOLDLO VP PAGESPERSEGMENT)
        ((FOLDLO \VP.STACK PAGESPERSEGMENT) 
             (IPLUS VP (IDIFFERENCE \RP.STACK \VP.STACK)))
        ((FOLDLO \VP.DISPLAY PAGESPERSEGMENT) 
             (IPLUS VP (IDIFFERENCE \RP.DISPLAY \VP.DISPLAY)))
        NIL])

(\TRANSFERPAGE
  [LAMBDA (VP FILEPAGE RPTINDEX WRITE? NEWPAGE?)             (* MPL "27-Jul-85 21:28")

    (* ;; "Transfers virtual page VP between page FILEPAGE of the vmem and real page RPTINDEX.  WRITE?  indicates direction of transfer.  If NEWPAGE?, then page does not exist on file, and is simply cleared")

    (PROG (NEWFLAGS)
          (COND
             (WRITE? (FLIPCURSORBAR 15))
             (T (FLIPCURSORBAR 0)))
          (SETQ NEWFLAGS (COND
                            (NEWPAGE? \VMAP.DIRTY)
                            (WRITE? (LOGAND (\READFLAGS VP)
                                           (LOGNOT16 \VMAP.DIRTY)))
                            (T 0)))
          (COND
             ((AND WRITE? (fetch (RPT LOCKED) of (fetch RPTRBASE of RPTINDEX)))

              (* ;; "Writing a locked page: can't diddle map, because others might die, so do this in the straightforward way")

              (\BLT \EMBUFBASE (create POINTER
                                      PAGE# _ VP)
                    WORDSPERPAGE)                            (* ; 
                                                 "Copy page into buffer, then write the buffer out")
              (\ACTONVMEMFILE FILEPAGE \EMBUFBASE 1 T)
              (SETQ \LASTACCESSEDVMEMPAGE FILEPAGE))
             ((NOT NEWPAGE?)                                 (* ; 
        "Map the buffer page into the target real page, read/write the page, then set the map back")
              (\WRITEMAP VP 0 \VMAP.VACANT)                  (* ; 
                      "Unmap VP so that we don't have two virtual pages pointing at same real page")
              (\WRITEMAP \EMBUFVP (RPFROMRPT RPTINDEX)
                     0)                                      (* ; "Map buffer to target page")
              (\ACTONVMEMFILE FILEPAGE \EMBUFBASE 1 WRITE?)
                                                             (* ; "Do the i/o")
              (\WRITEMAP \EMBUFVP \EMBUFRP 0)                (* ; 
                                                           "Restore buffer to its proper page")
              (SETQ \LASTACCESSEDVMEMPAGE FILEPAGE)))
          (\WRITEMAP VP (RPFROMRPT RPTINDEX)
                 NEWFLAGS)                                   (* ; "Set flags for page")
          (COND
             (NEWPAGE?                                       (* ; 
             "Not on file yet, so clear it.  Couldn't do this sooner because the flags weren't set")
                    (\CLEARWORDS (create POINTER
                                        PAGE# _ VP)
                           WORDSPERPAGE)))
          (COND
             (WRITE? (FLIPCURSORBAR 15)
                    (\BOXIPLUS (LOCF (fetch SWAPWRITES of \MISCSTATS))
                           1))
             (T (FLIPCURSORBAR 0)
                (\BOXIPLUS (LOCF (fetch PAGEFAULTS of \MISCSTATS))
                       1])

(\UPDATECHAIN
  [LAMBDA NIL                                                (* bvm%: "30-Jul-85 15:20")
                                                             (* ; 
                                                           "Sorts the page chain by reference bit")
    (CHECK (NOT \INTERRUPTABLE))
    (PROG ((RPTINDEX (fetch (RPT NEXTRP) of \REALPAGETABLE))
           (CHAIN0 \REALPAGETABLE)
           (CHAIN1 (\ADDBASE \REALPAGETABLE 2))
           RPTR VP FLAGS HEAD1)
          (SETQ HEAD1 CHAIN1)

     (* ;; "HEAD1 = CHAIN1 is just a holding cell for the second Chain we temporarily create inside here.  Use the unused third word of the dummy header entry of \REALPAGETABLE")

          (replace (RPT NEXTRP) of CHAIN0 with \PAGETABLESTOPFLG)
          (replace (RPT NEXTRP) of CHAIN1 with \PAGETABLESTOPFLG)
          (do (SETQ RPTR (fetch RPTRBASE of RPTINDEX))
                 (SETQ VP (fetch (RPT VP) of RPTR))
                 [SETQ FLAGS (COND
                                ((fetch (RPT EMPTY) of RPTR)
                                 0)
                                (T (\READFLAGS VP]
                 (COND
                    ((OR (fetch (RPT LOCKED) of RPTR)
                         (PROGN (COND
                                   ([AND DOLOCKCHECKS (EQ (fetch (RPT VPSEG) of RPTR)
                                                          (CONSTANT (\HILOC \PAGEMAP]
                                    (\MP.ERROR \MP.MAPNOTLOCKED 
                                           "A page of the page map is not locked" RPTR)))
                                (fetch (VMEMFLAGS REFERENCED) of FLAGS)))
                                                             (* ; 
                                                         "Page referenced or locked, put on CHAIN1")
                     (\WRITEMAP VP (RPFROMRPT RPTINDEX)
                            (LOGAND FLAGS (LOGNOT16 \VMAP.REF)))
                                                             (* ; "Turn off ref bit")
                     (replace (RPT NEXTRP) of CHAIN1 with RPTINDEX)
                     (SETQ CHAIN1 RPTR))
                    (T                                       (* ; 
                                                  "Page was not referenced recently, put on CHAIN0")
                       (replace (RPT NEXTRP) of CHAIN0 with RPTINDEX)
                       (SETQ CHAIN0 RPTR)))
                 (SETQ RPTINDEX (fetch (RPT NEXTRP) of RPTR)) 
                                                             (* ; "Look at next page in old chain")
             repeatuntil (EQ RPTINDEX \PAGETABLESTOPFLG))
          (replace (RPT NEXTRP) of CHAIN1 with \PAGETABLESTOPFLG)
                                                             (* ; "End of the line")
          (replace (RPT NEXTRP) of CHAIN0 with (fetch (RPT NEXTRP) of HEAD1))
                                                             (* ; 
                                                        "Link end of CHAIN0 to beginning of CHAIN1")
          (SETQ \RPTLAST (COND
                            ((EQ HEAD1 CHAIN1)               (* ; "Nothing on CHAIN1 ??!!")
                             CHAIN0)
                            (T CHAIN1)))                     (* ; 
                                                           "Pointer to end of complete chain")
          (SETQ \DIRTYPAGECOUNTER (SETQ \PAGEFAULTCOUNTER 0])
)



(* ; "Allocating and locking new pages")

(DEFINEQ

(\NEWPAGE
  [LAMBDA (BASE NOERROR LOCK?)                               (* ; 
                                                      "Edited 24-Oct-92 12:45 by sybalsky:mv:envos")

(* ;;; "Creates and returns a new page located at virtual addr BASE")

    (* ;; "If LOCK?, lock the page into real memory (A NOP on nonXerox machines!)")

    (UNINTERRUPTABLY
        (COND
           [(NOT (\MISCAPPLY* (FUNCTION \DONEWPAGE)
                        BASE LOCK?))                         (* ; "Failed, page exists")
            (COND
               ((NOT NOERROR)
                (\MP.ERROR \MP.NEWPAGE "Attempt to allocate already existing page" BASE T)))
            (COND
               (LOCK? (\LOCKPAGES BASE 1]
           ((IGREATERP (fetch (IFPAGE NActivePages) of \InterfacePage)
                   (IDIFFERENCE \LASTVMEMFILEPAGE \GUARDVMEMFULL))
                                                             (* ; "Vmem getting full!")
            (\SET.VMEM.FULL.STATE)))
        BASE)])

(\DONEWPAGE
  [LAMBDA (BASE LOCK? INTERNALFLG)                           (* bvm%: "13-Aug-85 16:32")

(* ;;; "Allocates new page at BASE, locking it if LOCK?  is true.  Returns vmemfile page# on success, NIL if page already exists.  Must be run in safe context! because it can cause vmem activity")

    (AND \DOFAULTINIT (\FAULTINIT))                      (* ; 
              "Only an issue when INIT.SYSOUT starts.  Perhaps there is a better place to put this")
    (PROG ((VP (fetch (POINTER PAGE#) of BASE))
           MAPBASE LOCKBASE FILEPAGE NEXTPM ERRCODE)
          (RETURN (COND
                     ((fetch (VP INVALID) of VP)
                      (\INVALIDVP VP)
                      NIL)
                     (T (SETQ MAPBASE (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)))
                        (COND
                           ((EQ MAPBASE \EMPTYPMTENTRY)      (* ; 
                                                          "Need to create a new second-level block")
                            (SETQ NEXTPM (fetch (IFPAGE NxtPMAddr) of \InterfacePage))
                            [COND
                               ((EVENP NEXTPM WORDSPERPAGE)

                                (* ;; "Need a new secondary pagemap page.  This recursion is ok, because we know that SETUPPAGEMAP assures that the pagemap pages for all the pages in secondary map space were created at MAKEINIT time")

                                (OR (\DONEWPAGE (\ADDBASE \PAGEMAP NEXTPM)
                                           T T)
                                    (RETURN (\MP.ERROR \MP.NEWMAPPAGE 
                                                   "\DONEWPAGE failed to allocate new map page"]
                            (\PUTBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)
                                   NEXTPM)
                            (replace (IFPAGE NxtPMAddr) of \InterfacePage
                               with (IPLUS NEXTPM \PMblockSize))
                            (SETQ MAPBASE NEXTPM)))
                        [SETQ MAPBASE (\ADDBASE \PAGEMAP (IPLUS MAPBASE (fetch (VP SECONDARYKEY)
                                                                           of VP]
                        (COND
                           ((NEQ (\GETBASE MAPBASE 0)
                                 0)                          (* ; "Page exists")
                            (RETURN NIL)))
                        (SETQ FILEPAGE (add (fetch (IFPAGE NActivePages) of 
                                                                                       \InterfacePage
                                                       )
                                              1))
                        (replace (IFPAGE NDirtyPages) of \InterfacePage with FILEPAGE)
                                                             (* ; "Currently a redundant field")
                        [COND
                           (LOCK? (SETQ FILEPAGE (\MAKESPACEFORLOCKEDPAGE VP FILEPAGE))
                                  (\PUTBASE (SETQ LOCKBASE (.LOCKEDVPBASE. VP))
                                         0
                                         (LOGOR (.LOCKEDVPMASK. VP)
                                                (\GETBASE LOCKBASE 0]
                        (\PUTBASE \FPTOVP FILEPAGE VP)
                        (\PUTBASE MAPBASE 0 FILEPAGE)
                        (\LOADVMEMPAGE VP FILEPAGE T LOCK?)
                        (COND
                           (INTERNALFLG (SETQ \NEWVMEMPAGEADDED T))
                           (T                                (* ; 
                                                          "Make sure \FPTOVP extended if necessary")
                              (\ASSURE.FPTOVP.PAGE)))
                        FILEPAGE])

(\ASSURE.FPTOVP.PAGE
  [LAMBDA NIL                                                (* bvm%: "13-Aug-85 16:29")

    (* ;; "Called at the end of some swapping operation that added one or more pages to the vmem file, setting \NEWVMEMPAGEADDED true.  If we're going to need a new page of \FPTOVP soon, do it now while there's still maneuvering room.  The allowance below is for the worst case, which can happen when VMEM.PURE.STATE is on and \NEWPAGE was called needing a new pagemap page as well, in which case we could have as many as the following new vmem pages before we're home safe --- 1: \NEWPAGE added a page --- 2: a page was displaced by the new page and written to the end of the vmem --- 3: a new pagemap page was needed --- 4: it displaced a page to end of vmem --- 5: the new \FPTOVP page below --- 6: a page displaced by same.  --- --- Alternatively, it could have been the new \FPTOVP page that needed a new pagemap block.  Will never have both needing a new pagemap block, since there are several pagemap blocks per page")

    (LET ((FILEPAGE (fetch (IFPAGE NActivePages) of \InterfacePage)))
         (COND
            ((IGREATERP (IMOD FILEPAGE WORDSPERPAGE)
                    (IDIFFERENCE WORDSPERPAGE 7))            (* ; 
                                           "This is a no-op if the page has already been allocated")
             (\DONEWPAGE (\ADDBASE \FPTOVP (CEIL FILEPAGE WORDSPERPAGE))
                    T T)))
         (SETQ \NEWVMEMPAGEADDED NIL])

(\MAKESPACEFORLOCKEDPAGE
  [LAMBDA (VP FILEPAGE)                                      (* bvm%: "29-Jun-86 17:44")

    (* ;; "VP is a page to be locked, FILEPAGE its home.  Returns a possibly new file page where VP will now live, after having kicked the former resident of the new file page into VP's old FILEPAGE")

    (PROG (DESIREDFP OLDVP FPBASE)
          [SETQ DESIREDFP (SELECTC (FOLDLO VP PAGESPERSEGMENT)
                              ((FOLDLO \VP.STACK PAGESPERSEGMENT) 
                                   (IPLUS VP (IDIFFERENCE (DLFPFROMRP \RP.STACK)
                                                    \VP.STACK)))
                              ((FOLDLO \VP.DISPLAY PAGESPERSEGMENT) 
                                                             (* ; 
                        "Display lives in a fixed place in file, but does not land there initially")
                                   (IPLUS VP (IDIFFERENCE (DLFPFROMRP \RP.TEMPDISPLAY)
                                                    \VP.DISPLAY)))
                              ((FOLDLO \VP.FPTOVP PAGESPERSEGMENT) 
                                                             (* ; 
                         "A new page of FPTOVP has to be continguous on file with other such pages")
                                   (IPLUS VP (IDIFFERENCE (DLFPFROMRP \RP.FPTOVP)
                                                    \VP.FPTOVP)))
                              (COND
                                 ((AND (ILEQ FILEPAGE (fetch LastLockedFilePage of 
                                                                                       \InterfacePage
                                                             ))
                                       (IGREATERP FILEPAGE (DLFPFROMRP \RP.MISCLOCKED)))
                                                             (* ; 
                     "Page is in a good place already.  It probably was once locked, then unlocked")
                                  (RETURN FILEPAGE))
                                 (T                          (* ; 
                                                          "Put it after all the other locked pages")
                                    (add (fetch LastLockedFilePage of \InterfacePage)
                                           1]
          (COND
             ((AND (fetch FPOCCUPIED of (SETQ FPBASE (\ADDBASE \FPTOVP DESIREDFP)))
                   (NEQ (SETQ OLDVP (fetch FPVIRTUALPAGE of FPBASE))
                        VP))                                 (* ; 
                                                          "Someone else lives here, so move it out")
              (\MOVEVMEMFILEPAGE OLDVP DESIREDFP FILEPAGE)))
          (RETURN DESIREDFP])

(\MOVEVMEMFILEPAGE
  [LAMBDA (VP OLDFP NEWFP)                                   (* bvm%: "18-Nov-84 14:14")
    (PROG ((FLAGS (\READFLAGS VP))
           RP)
          (COND
             ((fetch (VMEMFLAGS VACANT) of FLAGS)    (* ; 
                                                           "Page not resident, so pull it in")
              (\LOADVMEMPAGE VP OLDFP)
              (SETQ FLAGS \VMAP.CLEAN))
             ((\LOCKEDPAGEP VP)
              (\MP.ERROR \MP.BADLOCKED "Locked page is in the way" VP)))
          (\WRITEMAP VP (SETQ RP (\READRP VP))
                 (LOGOR FLAGS \VMAP.DIRTY))                  (* ; 
                           "Mark page dirty, so that it will eventually be written to its new home")
          (replace (RPT FILEPAGE) of (fetch RPTRBASE of (RPTFROMRP RP)) with
                                                                                        NEWFP)
                                                             (* ; "Tell RPT where VP now lives")
          (\PUTBASE (.PAGEMAPBASE. VP)
                 0 NEWFP)                                    (* ; "Tell \PAGEMAP about it")
          (\PUTBASE \FPTOVP NEWFP VP)                        (* ; "...  and \FPTOVP")
      ])

(\NEWEPHEMERALPAGE
  [LAMBDA (BASE NOERROR)                                     (* bvm%: "26-NOV-82 15:40")

(* ;;; "Creates and returns a new page located at virtual addr BASE, mapping it permanently into some real page but leaving it out of the vmem file")

    (\MISCAPPLY* (FUNCTION \DONEWEPHEMERALPAGE)
           BASE NOERROR])

(\DONEWEPHEMERALPAGE
  [LAMBDA (BASE NOERROR)                                     (* bvm%: "30-Oct-86 16:47")

(* ;;; "Creates and returns a new page located at virtual addr BASE, mapping it permanently into some real page but leaving it out of the vmem file")

    (LET ((VP (fetch (POINTER PAGE#) of BASE))
          MAPBASE PREVRP RPTINDEX RPTR)
         (COND
            ((fetch (VP INVALID) of VP)
             (\INVALIDVP VP)
             NIL)
            ([OR (AND (NEQ (SETQ MAPBASE (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY)
                                                                  of VP)))
                           \EMPTYPMTENTRY)
                      (NEQ (\GETBASE \PAGEMAP (IPLUS MAPBASE (fetch (VP SECONDARYKEY)
                                                                of VP)))
                           0))
                 (NOT (fetch (VMEMFLAGS VACANT) of (\READFLAGS VP]
                                                             (* ; 
                                                          "Page is in the vmem already, so no hope")
             (COND
                ((NOT NOERROR)
                 (\MP.ERROR \MP.NEWPAGE "Page already exists " BASE T)))
             BASE)
            (T (COND
                  ((IGREATERP \PAGEFAULTCOUNTER \UPDATECHAINFREQ)
                   (\UPDATECHAIN)))
               (add \PAGEFAULTCOUNTER 1)
               (SETQ RPTINDEX (\SELECTREALPAGE NIL T 'REMOVE))
                                                             (* ; "Find a page to put this in")
               (SETQ RPTR (fetch RPTRBASE of RPTINDEX))
                                                             (* ; 
                                                       "Fill in new RPTINDEX with appropriate data")
               (replace (RPT VP) of RPTR with \RPT.UNAVAILABLE)
               (replace (RPT FILEPAGE) of RPTR with VP)
                                                             (* ; "For debugging only")
               (FLIPCURSORBAR 0)
               (\WRITEMAP VP (RPFROMRPT RPTINDEX)
                      \VMAP.DIRTY)                           (* ; "Set flags for page")
               (\CLEARWORDS (create POINTER
                                   PAGE# _ VP)
                      WORDSPERPAGE)                          (* ; "Clear new page")
               (FLIPCURSORBAR 0)
               (\BOXIPLUS (LOCF (fetch PAGEFAULTS of \MISCSTATS))
                      1)
               (COND
                  (\NEWVMEMPAGEADDED (\ASSURE.FPTOVP.PAGE)))
               BASE])

(\LOCKPAGES
  [LAMBDA (BASE NPAGES)                                      (* bvm%: "26-NOV-82 15:17")

    (* ;; "Needs to be done in safe stack context because might cause vmem transfer")

    (\MISCAPPLY* (FUNCTION \DOLOCKPAGES)
           BASE NPAGES)
    BASE])

(\DOLOCKPAGES
  [LAMBDA (BASE NPAGES)                                      (* ; "Edited 21-Oct-87 15:49 by bvm:")
    (for I from 0 to (SUB1 NPAGES) bind (VP _ (fetch (POINTER PAGE#) of
                                                                                         BASE))
                                                     FILEPAGE MAPBASE RPTBASE RPINDEX RP MASK 
                                                     LOCKBASE
       do [COND
                 ((fetch (VP INVALID) of VP)
                  (\INVALIDVP VP))
                 [(EQ (SETQ MAPBASE (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)))
                      \EMPTYPMTENTRY)
                  (\INVALIDADDR (ADDBASE BASE (UNFOLD I WORDSPERPAGE]
                 (T [SETQ MAPBASE (\ADDBASE \PAGEMAP (IPLUS MAPBASE (fetch (VP SECONDARYKEY)
                                                                       of VP]
                    (SETQ FILEPAGE (\GETBASE MAPBASE 0))
                    (COND
                       ((EQ 0 (LOGAND (SETQ MASK (.LOCKEDVPMASK. VP))
                                     (\GETBASE (SETQ LOCKBASE (.LOCKEDVPBASE. VP))
                                            0)))             (* ; "Not locked yet")
                        (COND
                           ((fetch VACANT of (\READFLAGS VP))
                                                             (* ; 
                                       "Bring locked page into core so we can move it if necessary")
                            (\LOADVMEMPAGE VP FILEPAGE NIL T)))
                        [SETQ RPINDEX (RPTFROMRP (SETQ RP (\READRP VP]
                        (SETQ RPTBASE (fetch RPTRBASE of RPINDEX))
                        [COND
                           ((AND (NOT (.LOCKABLERP. RP))
                                 (NOT (\SPECIALRP VP)))

                            (* ;; "Page already swapped in, but lives in a real page that might need to get bumped (e.g., for stack), so move it now.  If \SPECIALRP is true then we know that the page got swapped into the right place, so no need to move it.")

                            (LET* ((NEWINDEX (\SELECTREALPAGE NIL T))
                                   (NEWRPT (fetch RPTRBASE of NEWINDEX)))
                                  (\MOVEREALPAGE RPINDEX RPTBASE NEWINDEX NEWRPT)
                                  (replace (RPT EMPTY) of RPTBASE with T)
                                                             (* ; "Mark vacated RPT entry empty")
                                  (SETQ RPTBASE NEWRPT)
                                  (SETQ RP (RPFROMRPT NEWINDEX]
                        (COND
                           ((NEQ FILEPAGE (SETQ FILEPAGE (\MAKESPACEFORLOCKEDPAGE VP FILEPAGE)))

                            (* ;; "Moving to a new page, so have to mark this locked page dirty so that it will eventually get written to its new home")

                            (\WRITEMAP VP RP (LOGOR \VMAP.DIRTY \VMAP.REF))
                            (replace (RPT FILEPAGE) of RPTBASE with FILEPAGE)
                            (\PUTBASE \FPTOVP FILEPAGE VP)
                            (\PUTBASE MAPBASE 0 FILEPAGE)))
                        (\PUTBASE LOCKBASE 0 (LOGOR MASK (\GETBASE LOCKBASE 0)))
                                                             (* ; "Set lock bit in page map")
                        (replace (RPT LOCKED) of RPTBASE with T]
             (add VP 1) finally (COND
                                           (\NEWVMEMPAGEADDED 
                                                             (* ; 
        "If we had to load or rearrange pages, vmem could have gotten bigger if VMEM.PURE.STATE on")
                                                  (\ASSURE.FPTOVP.PAGE])

(\TEMPLOCKPAGES
  [LAMBDA (BASE NPAGES)                                      (* bvm%: "10-Aug-85 18:17")

(* ;;; "`Temporarily' locks BASE for NPAGES, i.e. ensures that the swapper will not move the pages.  Information vanishes at logout etc.")

    (\MISCAPPLY* (FUNCTION \DOTEMPLOCKPAGES)
           BASE NPAGES])

(\DOTEMPLOCKPAGES
  [LAMBDA (BASE NPAGES)                                      (* ; "Edited 21-Oct-87 15:49 by bvm:")

    (* ;; "`Temporarily' locks BASE for NPAGES, i.e. ensures that the swapper will not move the pages.  Information vanishes at logout etc.  This function must be locked because it manipulates the page table table.  Runs in MISC context")

    (to NPAGES as VP from (fetch (POINTER PAGE#) of BASE) bind RPTBASE 
                                                                                    RPINDEX RP
       do (\TOUCHPAGE BASE)                              (* ; "Touch page in case not resident")
             [SETQ RPINDEX (RPTFROMRP (SETQ RP (\READRP VP]
             (SETQ RPTBASE (fetch RPTRBASE of RPINDEX))
             [COND
                ((NOT (.LOCKABLERP. RP))

                 (* ;; "Page already swapped in, but lives in a real page that might need to get bumped (e.g., for stack), so move it now")

                 (LET* ((NEWINDEX (\SELECTREALPAGE NIL T))
                        (NEWRPT (fetch RPTRBASE of NEWINDEX)))
                       (\MOVEREALPAGE RPINDEX RPTBASE NEWINDEX NEWRPT)
                       (replace (RPT EMPTY) of RPTBASE with T)
                                                             (* ; "Mark vacated RPT entry empty")
                       (SETQ RPTBASE NEWRPT]
             (replace (RPT LOCKED) of RPTBASE with T)
             (SETQ BASE (\ADDBASE BASE WORDSPERPAGE])

(\TEMPUNLOCKPAGES
  [LAMBDA (BASE NPAGES)                                      (* bvm%: "30-Jul-85 16:58")

    (* ;; "Unlocks pages that were locked by \TEMPLOCKPAGES.  This function must be locked because it manipulates the page table")

    (while (IGREATERP NPAGES 0) bind (VP _ (fetch (POINTER PAGE#) of BASE))
                                          RPTR
       do (UNINTERRUPTABLY
                  (\TOUCHPAGE BASE)                          (* ; 
         "Touch page in case not resident.  Should only happen if page wasn't locked to begin with")
                  (COND
                     ((AND (NEQ (SETQ RPTR (\READRP VP))
                                0)
                           (EQ [fetch (RPT VP) of (SETQ RPTR (fetch RPTRBASE
                                                                        of (RPTFROMRP RPTR]
                               VP))
                      (COND
                         ([AND DOLOCKCHECKS (EQ (LRSH VP 8)
                                                (CONSTANT (\HILOC \PAGEMAP]
                          (\MP.ERROR \MP.UNLOCKINGMAP "Attempt to unlock map page" VP)))
                      (replace (RPT LOCKED) of RPTR with NIL))
                     (T (HELP "Page table changed out from under me!" VP))))
             (add VP 1)
             (add NPAGES -1)
             (SETQ BASE (\ADDBASE BASE WORDSPERPAGE])

(\UNLOCKPAGES
  [LAMBDA (BASE NPAGES)                                      (* bvm%: "30-Jul-85 16:58")

(* ;;; "Unlocks NPAGES virtual pages from BASE onward")

    (UNINTERRUPTABLY
        (for I from 0 to (SUB1 NPAGES) bind (VP _ (fetch (POINTER PAGE#)
                                                                     of BASE))
                                                         MASK LOCKBASE
           do (COND
                     ((fetch (VP INVALID) of VP)
                      (\INVALIDVP VP))
                     ((NEQ 0 (LOGAND (SETQ MASK (.LOCKEDVPMASK. VP))
                                    (\GETBASE (SETQ LOCKBASE (.LOCKEDVPBASE. VP))
                                           0)))              (* ; 
                                                    "Yes, page was locked, so turn the bit off now")
                      (COND
                         ([AND DOLOCKCHECKS (EQ (LRSH VP 8)
                                                (CONSTANT (\HILOC \PAGEMAP]
                          (\MP.ERROR \MP.UNLOCKINGMAP "Attempt to unlock map page" VP)))
                      (\PUTBASE LOCKBASE 0 (LOGXOR MASK (\GETBASE LOCKBASE 0)))
                                                             (* ; 
                                                      "Update pagemap, then update real page table")
                      (replace (RPT LOCKED) of (fetch RPTRBASE of (RPTFROMRP
                                                                                   (\READRP VP)))
                         with NIL)))
                 (add VP 1)))])
)



(* ; "Writing out the vmem")

(DEFINEQ

(\FLUSHVM
  [LAMBDA (MAIKO.SYSOUTFILE)                             (* ; "Edited 10-Feb-2021 22:43 by lmm")
                                                             (* ; 
                                                           "Edited  6-Jan-89 19:23 by Hayata")

    (* ;; 
  "Writes out all dirty pages to vmem, making it consistent.  Returns NIL now, T  on restart")

    (UNINTERRUPTABLY
        (PROG NIL
              (SELECTQ (\MISCAPPLY* (FUNCTION \DOFLUSHVM)
                              MAIKO.SYSOUTFILE)
                  (NIL (SETQ \DIRTYPAGEHINT 32767)
                       (RETURN NIL))
                  (1 (ERROR "Can not find sysout file"))
                  (2 (ERROR "FILE-SYSTEM-RESOURCES-EXCEEDED"))
                  (3 (ERROR "Can not open sysout file"))
                  (4 (ERROR "Can not seek sysout file"))
                  (5 (ERROR "Can not write sysout file"))
                  (6 (ERROR "Connection timed out"))
                  NIL)
              (SETQ \DOFAULTINIT T)
              (\CONTEXTSWITCH \FAULTFXP)
              (for VAR in \SYSTEMCACHEVARS do (SET VAR NIL))
              (RETURN T)))])

(\LOGOUT0
  [LAMBDA (FAST)                                             (* ; 
                                                           "Edited 18-Jul-88 04:14 by masinter")
    [COND
       ((OR (EQ (fetch MachineType of \InterfacePage)
                \DORADO)
            (EQ (fetch MachineType of \InterfacePage)
                \DOLPHIN))

        (* ;; "If we're running on a Dolphin or Dorado, we update the alto's clock.  Note that Dandelions and Daybreaks don't have alto clocks, so this wouldn't work on them")

        (\BLT (EMADDRESS \RTCSECONDS)
              (LOCF (fetch SECONDSCLOCK of \MISCSTATS))
              (UNFOLD 3 WORDSPERCELL]
    (UNINTERRUPTABLY
        (OR (AND [OR (NOT FAST)
                     (AND (EQ FAST '?)
                          (NOT (.VMEM.CONSISTENTP.]
                 (\FLUSHVM))
            (SELECTC \MACHINETYPE
                (\DAYBREAK (\DoveMisc.BootButton))
                (SUBRCALL LISPFINISH FAST))))])

(\DOFLUSHVM
  [LAMBDA (MAIKO.SYSOUTFILE)                             (* ; "Edited 10-Feb-2021 22:38 by lmm")
                                                             (* ; 
                                                           "Edited  6-Jan-89 19:23 by Hayata")

(* ;;; "Write everything out in a resumable way.  Value is NIL if returned from directly, T if from saved state.  Always invoked via \MISCAPPLY*")

    (CHECK (NOT \INTERRUPTABLE))                             (* ; 
                               "NOTE: need stats gathering off in here.  Also avoid touching pages")
    (PROG ((IFPVP (fetch (POINTER PAGE#) of \InterfacePage))
           (SCRATCHBUF \EMUSWAPBUFFERS)
           IFPRPT)
          (replace (IFPAGE MISCSTACKRESULT) of \InterfacePage with T)
                                                             (* ; 
"This will make it look like we have returned from BCPL if caller gets control from the saved state")

     (* ;; "update interface pge before writing out sysout")

          (replace (IFPAGE CurrentFXP) of \InterfacePage with (fetch (IFPAGE MiscFXP)
                                                                             of \InterfacePage))
          (RETURN (SUBRCALL VMEMSAVE MAIKO.SYSOUTFILE])

(\RELEASEWORKINGSET
  [LAMBDA NIL                                            (* bvm%: "29-Nov-84 10:56")
    (COND
       ((\FLUSHVM)                                       (* ; "Returning from Lisp startup")
        T)
       (T                                                    (* ; "Unmap any unlocked page")
          (for RPTINDEX from 1 to (SUB1 \RPTSIZE) bind RPTR
             when (AND (fetch (RPT OCCUPIED) of (SETQ RPTR (fetch RPTRBASE
                                                                          of RPTINDEX)))
                           (NOT (fetch (RPT LOCKED) of RPTR)))
             do (\WRITEMAP (fetch (RPT VP) of RPTR)
                           (RPFROMRPT RPTINDEX)
                           \VMAP.VACANT)
                   (replace (RPT EMPTY) of RPTR with T])

(\WRITEDIRTYPAGE
  [LAMBDA (MINDIRTY)                                     (* bvm%: "13-Aug-85 17:51")
    (COND
       ((OR (NOT (.VMEM.CONSISTENTP.))
            (AND \VMEM.PURE.LIMIT (NEQ \VMEM.PURE.LIMIT -1)
                 (NOT \VMEM.FULL.STATE)))
        (PROG ((RPTR (OR \LASTDIRTYSCANPTR \REALPAGETABLE))
               (NUMDIRTY (OR \LASTDIRTYCNT 0))
               (CNT \MAXDIRTYSCANCOUNT)
               RP FP FLAGS)
              [COND
                 ((AND (NULL \LASTDIRTYSCANPTR)
                       (IGREATERP (IPLUS (add \DIRTYPAGECOUNTER 1)
                                         \PAGEFAULTCOUNTER)
                              \UPDATECHAINFREQ))             (* ; 
                                                  "Take this time to update the page chain instead")
                  (RETURN (UNINTERRUPTABLY
                              (\MISCAPPLY* (FUNCTION \UPDATECHAIN)))]
              (OR MINDIRTY (SETQ MINDIRTY 1))
          LP  [COND
                 [(EQ (SETQ RP (fetch (RPT NEXTRP) of RPTR))
                      \PAGETABLESTOPFLG)                     (* ; 
                                  "Hit end of chain.  Write out what we found if enough were dirty")
                  (COND
                     ((AND (IGEQ NUMDIRTY MINDIRTY)
                           (NEQ NUMDIRTY 0)
                           (SETQ RP \LASTDIRTYFOUND))
                      (GO GOTPAGE))
                     (T (SETQ \LASTDIRTYSCANPTR (SETQ \LASTDIRTYCNT (SETQ \LASTDIRTYFOUND NIL)))
                        [COND
                           ((AND (NEQ NUMDIRTY 0)
                                 (ILESSP \DIRTYSEEKMAX (LRSH MAX.SMALL.INTEGER 1)))
                                                             (* ; 
                                     "Failed because page not close enough, so widen the tolerance")
                            (SETQ \DIRTYSEEKMAX (LLSH \DIRTYSEEKMAX 1]
                        (RETURN]
                 ((fetch (RPT EMPTY) of (SETQ RPTR (fetch RPTRBASE of RP)))
                                                             (* ; 
                                              "Page is empty.  Should never happen if key is valid")
                  (RETURN))
                 ((NOT (fetch (RPT LOCKED) of RPTR)) (* ; 
            "Don't bother writing out locked pages, since they don't help us in our swapping quest")
                  (SETQ FLAGS (\READFLAGS (fetch (RPT VP) of RPTR)))
                  (COND
                     ((NOT (fetch (VMEMFLAGS DIRTY) of FLAGS))
                                                             (* ; "Page not dirty;  skip")
                      )
                     [(PROGN (SETQ FP (fetch (RPT FILEPAGE) of RPTR))
                             (IGREATERP (IABS (IDIFFERENCE (COND
                                                              ((AND \VMEM.PURE.LIMIT (ILESSP FP 
                                                                                     \VMEM.PURE.LIMIT
                                                                                            ))
                                                             (* ; 
                                                 "We'd have to write page to a new place, not here")
                                                               (fetch (IFPAGE NActivePages)
                                                                  of \InterfacePage))
                                                              (T FP))
                                                     \LASTACCESSEDVMEMPAGE))
                                    \DIRTYSEEKMAX))          (* ; 
                                                           "Page too far away, don't write it")
                      (COND
                         ((fetch (VMEMFLAGS REFERENCED) of FLAGS)
                                                             (* ; "but still count it")
                          (add NUMDIRTY 1]
                     ((IGREATERP FP \LASTVMEMFILEPAGE)       (* ; "Can't write it")
                      )
                     ((fetch (VMEMFLAGS REFERENCED) of FLAGS)
                                                             (* ; 
                           "Page dirty but referenced.  Note it, but keep looking for a better one")
                      (COND
                         ((EQ NUMDIRTY 0)
                          (SETQ \LASTDIRTYFOUND RP)))
                      (add NUMDIRTY 1))
                     (T                                      (* ; "Dirty, not referenced: do it")
                        (GO GOTPAGE]
              (COND
                 ((EQ (add CNT -1)
                      0)                                     (* ; 
                                                    "Scanned for long enough;  don't lock user out")
                  (SETQ \LASTDIRTYSCANPTR RPTR)
                  (SETQ \LASTDIRTYCNT NUMDIRTY)
                  (RETURN)))
              (GO LP)
          GOTPAGE
              (UNINTERRUPTABLY
                  (SETQ \LASTDIRTYSCANPTR (SETQ RPTR (fetch RPTRBASE of RP)))
                                                             (* ; "Keep traveling pointer")
                  (SETQ \LASTDIRTYCNT (SETQ \LASTDIRTYFOUND NIL))
                  (COND
                     ((ILEQ (IABS (IDIFFERENCE (fetch (RPT FILEPAGE) of RPTR)
                                         \LASTACCESSEDVMEMPAGE))
                            \DIRTYSEEKMAX)                   (* ; 
                        "Could fail if swapping since the selection has moved the disk arm too far")
                      (\MISCAPPLY* (FUNCTION \WRITEDIRTYPAGE1)
                             RP RPTR)))
                  (SETQ \DIRTYSEEKMAX \MAXSHORTSEEK))
              (RETURN T])

(\WRITEDIRTYPAGE1
  [LAMBDA (RP RPTR)                                      (* bvm%: "13-Aug-85 16:41")
                                                             (* ; 
                           "Write out buffer RP.  This fn is locked and called in the misc context")
    (COND
       ([AND (NOT (fetch (RPT LOCKED) of RPTR))
             (fetch (VMEMFLAGS DIRTY) of (\READFLAGS (fetch (RPT VP) of RPTR]
                                                             (* ; 
               "Verify that the page is still a candidate, so previous loop could be interruptable")
        (\FLUSHPAGE RP)
        (COND
           (\NEWVMEMPAGEADDED (\ASSURE.FPTOVP.PAGE])

(\COUNTREALPAGES
  [LAMBDA (TYPE)                                         (* bvm%: "18-Dec-84 15:31")
    (SELECTQ TYPE
        ((DIRTY REF) 
             [PROG [(FLAGBITS (COND
                                 ((EQ TYPE 'DIRTY)
                                  \VMAP.DIRTY)
                                 (T \VMAP.REF]
                   (RETURN (NPAGESMACRO (NEQ (LOGAND (\READFLAGS VP)
                                                    FLAGBITS)
                                             0])
        (LOCKED (NPAGESMACRO (fetch (RPT LOCKED) of RPTR)))
        (OCCUPIED (NPAGESMACRO T))
        (\ILLEGAL.ARG TYPE])
)



(* ; "VMEM.PURE.STATE hack")

(DEFINEQ

(\DOCOMPRESSVMEM
  [LAMBDA NIL                                            (* bvm%: " 7-Apr-84 17:53")

(* ;;; "Called underneath \DOFLUSHVM to write the pages above the high water mark back to the places vacated below that mark")

    (PROG ((EMPTYFP (DLFPFROMRP \RP.GCTABLE))
           (LASTFP (fetch NActivePages of \InterfacePage))
           (OLDVIW \VMEM.INHIBIT.WRITE)
           VP)
          [COND
             ((NULL OLDVIW)

              (* ;; "Encourage \SELECTREALPAGE to select only `old' file pages for displacement, so that we don't needlessly write the same page twice")

              (SETQ \VMEM.INHIBIT.WRITE 'NEW]
      LP  (COND
             ((IGEQ EMPTYFP LASTFP)
              (SETQ \VMEM.INHIBIT.WRITE OLDVIW)
              (RETURN)))
          [COND
             ((EQ (\GETBASE \FPTOVP EMPTYFP)
                  \NO.VMEM.PAGE)
              (while (EQ (SETQ VP (\GETBASE \FPTOVP LASTFP))
                             \NO.VMEM.PAGE) do (SETQ LASTFP (SUB1 LASTFP)))
              (\MOVEVMEMFILEPAGE VP LASTFP EMPTYFP)
              (replace NActivePages of \InterfacePage with (SETQ LASTFP (SUB1 LASTFP]
          (add EMPTYFP 1)
          (GO LP])

(VMEM.PURE.STATE
  [LAMBDA FLG                                            (* bvm%: " 7-Apr-84 16:59")
    (PROG1 (NOT (NULL \VMEM.PURE.LIMIT))
        [COND
           ((IGREATERP FLG 0)

            (* ;; "Set \VMEM.PURE.LIMIT appropriately.  If turning on, and it wasn't on before, set it to -1 so that it takes effect only at the next FLUSHVM")

            (SETQ \VMEM.PURE.LIMIT (AND (ARG FLG 1)
                                        (OR \VMEM.PURE.LIMIT (SETQ \VMEM.PURE.LIMIT -1])])
)



(* ;; 
"Handling the backing store getting too full--keep running, but if we overflow, we can never \FLUSHVM because there is no place to write some pages"
)

(DEFINEQ

(32MBADDRESSABLE
  [LAMBDA NIL                                         (* ; "Edited  2-May-88 22:03 by MASINTER")
    (SELECTC \MACHINETYPE
        (\DORADO T)
        (\DOLPHIN NIL)
        (\DAYBREAK T)
        (NEQ 0 (fetch (IFPAGE DL24BitAddressable) of \InterfacePage])

(\SET.VMEM.FULL.STATE
  [LAMBDA NIL                                            (* bvm%: "13-Feb-85 20:12")
                                                             (* ; 
                 "We are running out of vmem, try to extend file.  Do this at next convenient time")
    (COND
       ((NOT \VMEM.FULL.STATE)                               (* ; "Get an interrupt to handle this")
        (replace VMEMFULL of \INTERRUPTSTATE with T)
        (SETQ \PENDINGINTERRUPT T)))
    (SETQ \VMEM.FULL.STATE (COND
                              ((ILESSP (fetch (IFPAGE NActivePages) of \InterfacePage)
                                      \LASTVMEMFILEPAGE)     (* ; 
                                               "Not completely full, allow normal things to happen")
                               0)
                              ((.VMEM.CONSISTENTP.)
                               T)
                              (T 'DIRTY])

(\SET.LASTVMEMFILEPAGE
  [LAMBDA (N)                                            (* ; "Edited  6-Apr-87 14:09 by bvm:")

    (* ;; "Called by disk routines when they discover how long the physical vmem is.  Currently only used by Dove.")

    (COND
       ((IGREATERP (fetch (IFPAGE NActivePages) of \InterfacePage)
               (IDIFFERENCE (SETQ \LASTVMEMFILEPAGE N)
                      \GUARDVMEMFULL))                       (* ; "Vmem getting full!")
        (\SET.VMEM.FULL.STATE))
       (T                                                    (* ; 
                                          "Vmem ok now (was earlier set to full for safety's sake)")
          (SETQ \VMEM.FULL.STATE NIL)))
    N])

(\DOVMEMFULLINTERRUPT
  [LAMBDA NIL                                            (* ; "Edited 21-Oct-87 13:54 by bvm:")

(* ;;; "Called while interruptable when vmem is full or nearly so.  Tries to extend vmem file, or gives error if it can't")

    (COND
       (\EXTENDINGVMEMFILE 

              (* ;; "Another interrupt happened while we are extending file.  Don't try to do this one twice, but repost the interrupt in the hopes that it will happen after vmem extension is finished")

              (SETQ \PENDINGINTERRUPT T))
       (T (RESETVARS ((\EXTENDINGVMEMFILE T))

           (* ;; "Used to have code here that tried to extend the vmem file, but even on those that support extension it's flaky, and rarely what you want--people allocate the vmem file to the desired size in the first place, don't want it extended further.")

                     (PROG ((HELPFLAG 'BREAK!))
                           (replace VMEMFULL of \INTERRUPTSTATE with NIL)
                                                             (* ; 
             "Very slight chance of losing the break if ^E right here.  Don't know how to fix this")
                           (CL:CERROR "Resume the interrupted computation"
                                  (CONCAT "Your virtual memory backing file is "
                                         (COND
                                            ((>= (fetch (IFPAGE NActivePages) of 
                                                                                       \InterfacePage
                                                        )
                                                 \LASTVMEMFILEPAGE)
                                             "complete")
                                            (T "near"))
                                         "ly full.
Save your work & reload a.s.a.p."])

(\FLUSHVMOK?
  [LAMBDA (TYPE NOERROR)                                     (* ; 
                                                           "Edited 10-Feb-2021 21:49 by larry")
                                                             (* bvm%: " 7-Sep-85 10:48")

(* ;;; "Called before any attempt to do a \FLUSHVM to make sure it's ok")

    T])
)

(RPAQ? \UPDATECHAINFREQ 100)

(RPAQ? \PAGEFAULTCOUNTER 0)

(RPAQ? \DIRTYPAGECOUNTER 0)

(RPAQ? \DIRTYPAGEHINT 0)

(RPAQ? \LASTACCESSEDVMEMPAGE 0)

(RPAQ? \MAXSHORTSEEK 1000)

(RPAQ? \MINSHORTSEEK 20)

(RPAQ? \MAXCLEANPROBES 20)

(RPAQ? \VMEM.INHIBIT.WRITE )

(RPAQ? \VMEM.PURE.LIMIT )

(RPAQ? \VMEM.FULL.STATE )

(RPAQ? \GUARDVMEMFULL 500)

(RPAQ? VMEM.COMPRESS.FLG )

(RPAQ? \DOFAULTINIT 0)

(RPAQ? \VMEMACCESSFN )

(RPAQ? \SYSTEMCACHEVARS )

(RPAQ? \MAXSWAPBUFFERS 1)

(RPAQ? \EXTENDINGVMEMFILE )

(RPAQ? \MaxScreenPage 0)

(RPAQ? \NEWVMEMPAGEADDED )

(RPAQ? \LASTDIRTYCNT )

(RPAQ? \LASTDIRTYFOUND )

(RPAQ? \LASTDIRTYSCANPTR )

(RPAQ? \DIRTYSEEKMAX 50)



(* ; "Errors signaled in the maintenance panel")

(DEFINEQ

(\MP.ERROR
  [LAMBDA (CODE STRING ARG1 ARG2)                        (* mpl "20-Jun-85 11:09")
    (COND
       ((OR (EQ \MACHINETYPE \DANDELION)
            (EQ \MACHINETYPE \DAYBREAK))
        ((OPCODES RAID)
         CODE))
       (T (RAID STRING ARG1 ARG2])
)



(* ; "Debugging code.  Some of this also runs renamed for extra TeleRaid help")

(DEFINEQ

(\ACTONVMEMFILE
  [LAMBDA (FILEPAGE BUFFER NPAGES WRITEFLAG)             (* MPL "22-Jun-85 20:18")
    (COND
       ((EQ \MACHINETYPE \DANDELION)
        (\DL.ACTONVMEMFILE FILEPAGE BUFFER NPAGES WRITEFLAG))
       ((EQ \MACHINETYPE \DAYBREAK)
        (\DOVE.ACTONVMEMFILE FILEPAGE BUFFER NPAGES WRITEFLAG))
       (T (\M44ACTONVMEMFILE FILEPAGE BUFFER NPAGES WRITEFLAG])

(\SHOWPAGETABLE
  [LAMBDA (MODE FILE)                                    (* bvm%: "12-Jul-86 16:55")
    (PROG ((*PRINT-BASE* 8)
           (OUTSTREAM (GETSTREAM FILE 'OUTPUT))
           (RPTR \REALPAGETABLE)
           (RP 0)
           FLAGS VP STATE FIRSTONE LASTONE)
          (printout OUTSTREAM "     RP      VP           FilePage  Status" T)
          (until (SELECTQ MODE
                         (CHAIN (EQ (SETQ RP (fetch (RPT NEXTRP) of RPTR))
                                    \PAGETABLESTOPFLG))
                         (NIL (add RP 1)
                              (IGEQ RP \RPTSIZE))
                         (\ILLEGAL.ARG MODE))
             do (SETQ RPTR (fetch RPTRBASE of RP))
                   (SETQ VP (fetch (RPT VP) of RPTR))
                   (COND
                      ((AND (NULL MODE)
                            (EQ VP STATE))
                       (SETQ LASTONE RP))
                      (T (COND
                            (LASTONE (printout OUTSTREAM "ditto thru " LASTONE T)
                                   (SETQ LASTONE NIL)))
                         (SETQ FIRSTONE RP)
                         (SETQ STATE VP)
                         (printout OUTSTREAM |.I7.8| (RPFROMRPT RP))
                         [COND
                            ((fetch (RPT EMPTY) of RPTR)
                             (PRIN1 " Empty" OUTSTREAM))
                            ((NOT (fetch (RPT OCCUPIED) of RPTR))
                             (PRIN1 " Unavailable" OUTSTREAM))
                            (T (printout OUTSTREAM |.I8.8| VP %,)
                               (\PRINTVP VP OUTSTREAM)
                               (printout OUTSTREAM 28 |.I6.8| (fetch (RPT FILEPAGE) of RPTR)
                                      %,,)
                               (COND
                                  ((fetch (RPT LOCKED) of RPTR)
                                   (COND
                                      ((NOT (\LOCKEDPAGEP VP))
                                                             (* ; "not permanently locked")
                                       (PRIN1 "Temp" OUTSTREAM)))
                                   (PRIN1 "Locked " OUTSTREAM)))
                               (UNLESSRDSYS (PROGN (COND
                                                      ((fetch (VMEMFLAGS REFERENCED)
                                                          of (SETQ FLAGS (\READFLAGS VP)))
                                                       (PRIN1 "Ref " OUTSTREAM)))
                                                   (COND
                                                      ((fetch (VMEMFLAGS DIRTY) of FLAGS)
                                                       (PRIN1 "Dirty" OUTSTREAM]
                         (TERPRI OUTSTREAM])

(CHECKPAGEMAP
  [LAMBDA NIL                                            (* bvm%: "12-Jul-86 16:56")
    (LET ((*PRINT-BASE* 8)
          (NUMOCCUPIED 0)
          (NUMLOCKED 0)
          (CHAINOCCUPIED 0)
          (CHAINLOCKED 0)
          RPTR FPBASE FP VP RP)
         (CHECKFPTOVP)
         [for RPTINDEX from 1 to (SUB1 \RPTSIZE)
            when (fetch (RPT OCCUPIED) of (SETQ RPTR (fetch RPTRBASE of RPTINDEX)
                                                       ))
            do (add NUMOCCUPIED 1)
                  (SETQ VP (fetch (RPT VP) of RPTR))
                  (SETQ FP (fetch (RPT FILEPAGE) of RPTR))
                  (COND
                     ((CHECKFPTOVP1 FP VP RPTINDEX))
                     ([NEQ VP (fetch FPVIRTUALPAGE of (SETQ FPBASE (\ADDBASE \FPTOVP FP]
                      (printout T "RPT for RP " (RPFROMRPT RPTINDEX)
                             " says VP ")
                      (\PRINTVP VP T)
                      (printout T " lives in FP " FP "; but FP Map says that FP contains ")
                      (\PRINTVP (fetch FPVIRTUALPAGE of FPBASE)
                             T)
                      (printout T T))
                     ((\LOCKEDPAGEP VP)
                      (add NUMLOCKED 1)
                      (COND
                         ((NOT (fetch (RPT LOCKED) of RPTR))
                          (printout T "VP " VP ", living in RP " (RPFROMRPT RPTINDEX)
                                 " should be locked but isn't." T))
                         ((IGREATERP FP (DLRPFROMFP (fetch (IFPAGE LastLockedFilePage)
                                                       of \InterfacePage)))
                          (printout T "VP " VP " is locked, but living in FP " FP 
                                 ", which is not in the locked page area" T]
         (PROGN (SETQ RPTR \REALPAGETABLE)                   (* ; "Check pagetable chain")
                [while (NEQ (SETQ RP (fetch (RPT NEXTRP) of RPTR))
                                \PAGETABLESTOPFLG) when (fetch (RPT OCCUPIED)
                                                               of (SETQ RPTR
                                                                       (fetch RPTRBASE
                                                                          of RP)))
                   do (add CHAINOCCUPIED 1)
                         (COND
                            ((fetch (RPT LOCKED) of RPTR)
                             (add CHAINLOCKED 1]
                (COND
                   ((ILESSP CHAINOCCUPIED NUMOCCUPIED)
                    (printout T NUMOCCUPIED " occupied pages, but only " CHAINOCCUPIED 
                           " are on page chain.  " NUMLOCKED " pages are permanently locked; " 
                           CHAINLOCKED " pages on chain are locked somehow." T])

(CHECKFPTOVP
  [LAMBDA NIL                                            (* bvm%: "10-Dec-84 12:39")
    (for FP from 1 to (fetch NActivePages of \InterfacePage)
       as (FPBASE _ (\ADDBASE \FPTOVP 1)) by (\ADDBASE FPBASE 1)
       when (fetch FPOCCUPIED of FPBASE) do (CHECKFPTOVP1 FP
                                                                   (fetch FPVIRTUALPAGE
                                                                      of FPBASE])

(CHECKFPTOVP1
  [LAMBDA (FP VP RPTINDEX)                               (* bvm%: "10-Dec-84 12:36")
    (PROG ((FP2 (\LOOKUPPAGEMAP VP)))
          (RETURN (COND
                     ((NEQ FP2 FP)
                      (COND
                         ((UNLESSRDSYS RPTINDEX)
                          (printout T "RPT for RP " (RPFROMRPT RPTINDEX)))
                         (T (printout T "FP map")))
                      (printout T " says FP " FP " contains VP ")
                      (\PRINTVP VP T)
                      (printout T "; but PageMap says that page is in FP " FP2 T)
                      T])

(\PRINTFPTOVP
  [LAMBDA (FIRSTPAGE NWORDS TYPEFLG STREAM VPRAWFLG)     (* bvm%: "24-Sep-86 11:44")
    (SETQ STREAM (GETSTREAM STREAM 'OUTPUT))
    (OR FIRSTPAGE (SETQ FIRSTPAGE 1))
    (OR NWORDS (SETQ NWORDS (fetch (IFPAGE NActivePages) of \InterfacePage)))
    (LET ((BASE (\ADDBASE \FPTOVP (SUB1 FIRSTPAGE)))
          (*PRINT-BASE* 8)
          (LASTVP -2)
          (NEXTFP (SUB1 FIRSTPAGE))
          FIRSTFP FIRSTVP NEXTVP LOCKEDP TYPE NEXTLOCKED NEXTTYPE)
         (while (IGEQ NWORDS 0)
            do (add NEXTFP 1)
                  [COND
                     ((EQ NWORDS 0)
                      (SETQ NEXTVP -1))
                     ((NEQ (SETQ NEXTVP (\GETBASE (SETQ BASE (\ADDBASE BASE 1))
                                               0))
                           \NO.VMEM.PAGE)
                      (SETQ NEXTLOCKED (\LOCKEDPAGEP NEXTVP))
                      (if TYPEFLG
                          then (SETQ NEXTTYPE (TYPENAME (create POINTER
                                                                   PAGE# _ NEXTVP)))
                                (if (NULL NEXTTYPE)
                                    then (SETQ NEXTTYPE (SELECTC (LRSH NEXTVP 8)
                                                                ((LIST \PNAME.HI (CL:1+ \PNAME.HI)) 
                                                                     "Pnames")
                                                                ((LIST \DEF.HI (CL:1+ \DEF.HI)) 
                                                                     "Definitions")
                                                                ((LIST \VAL.HI (CL:1+ \VAL.HI)) 
                                                                     "Value cells")
                                                                ((LIST \PLIST.HI (CL:1+ \PLIST.HI)) 
                                                                     "Property lists")
                                                                ((\HILOC \FPTOVP) 
                                                                     "\FPTOVP")
                                                                (\STACKHI "Stack")
                                                                ((\HILOC \HTMAIN) 
                                                                     "GC Main table")
                                                                ((\HILOC \HTOVERFLOW) 
                                                                     "GC Overflow table")
                                                                NIL]
                  [COND
                     ([COND
                         ((EQ NEXTVP \NO.VMEM.PAGE)
                          (NEQ LASTVP \NO.VMEM.PAGE))
                         (T (OR (NEQ NEXTVP (ADD1 LASTVP))
                                (NEQ NEXTLOCKED LOCKEDP)
                                (NEQ TYPE NEXTTYPE]
                      [COND
                         ((IGEQ LASTVP 0)
                          (COND
                             (FIRSTFP (printout STREAM FIRSTFP "-")))
                          (printout STREAM (SUB1 NEXTFP)
                                 12)
                          (COND
                             ((EQ LASTVP \NO.VMEM.PAGE)
                              (printout STREAM "empty"))
                             (T (COND
                                   (FIRSTFP (if VPRAWFLG
                                                then (PRIN1 FIRSTVP STREAM)
                                              else (\PRINTVP FIRSTVP STREAM))
                                          (PRIN1 "-" STREAM)))
                                (if VPRAWFLG
                                    then (PRIN1 LASTVP STREAM)
                                  else (\PRINTVP LASTVP STREAM))
                                (COND
                                   (LOCKEDP (PRIN1 '* STREAM)))
                                (if TYPE
                                    then (printout STREAM 32 TYPE]
                      (SETQ FIRSTFP)
                      (TERPRI STREAM)
                      (SETQ FIRSTVP NEXTVP))
                     (T                                      (* ; "in a run")
                        (OR FIRSTFP (SETQ FIRSTFP (SUB1 NEXTFP]
                  (SETQ LASTVP NEXTVP)
                  (SETQ LOCKEDP NEXTLOCKED)
                  (SETQ TYPE NEXTTYPE)
                  (add NWORDS -1])

(\PRINTVP
  [LAMBDA (VP STREAM)                                    (* bvm%: "28-MAR-83 12:40")
    (printout STREAM "{" (LRSH VP 8)
           ","
           (LOGAND VP 255)
           "}"])
)
(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(PUTPROPS \ACTONVMEMFILE MACRO ((X . Y)
                                        (SPREADAPPLY* \VMEMACCESSFN X . Y)))

(PUTPROPS .VMEM.CONSISTENTP. MACRO (NIL (EQ (fetch (IFPAGE Key) of \InterfacePage)
                                                    \IFPValidKey)))

(PUTPROPS .LOCKABLERP. MACRO [(RP)
                                      (OR (NEQ (FOLDLO RP PAGESPERSEGMENT)
                                               (FOLDLO \RP.STACK PAGESPERSEGMENT))
                                          (NOT (OR (EQ \MACHINETYPE \DANDELION)
                                                   (EQ \MACHINETYPE \DAYBREAK])
)




(* ; "Virtual page flags")

(DECLARE%: EVAL@COMPILE 

(RPAQQ \VMAP.DIRTY 10000Q)

(RPAQQ \VMAP.CLEAN 0)

(RPAQQ \VMAP.REF 100000Q)

(RPAQQ \VMAP.VACANT 30000Q)

(RPAQQ \VMAP.FLAGS 170000Q)

(RPAQQ \VMAP.NOTFLAGS 7777Q)


(CONSTANTS \VMAP.DIRTY \VMAP.CLEAN \VMAP.REF \VMAP.VACANT \VMAP.FLAGS \VMAP.NOTFLAGS)
)
(DECLARE%: EVAL@COMPILE

(ACCESSFNS VMEMFLAGS ((VACANT (EQ (LOGAND DATUM \VMAP.VACANT)
                                      \VMAP.VACANT))
                          (DIRTY (NEQ (LOGAND DATUM \VMAP.DIRTY)
                                      0))
                          (REFERENCED (NEQ (LOGAND DATUM \VMAP.REF)
                                           0))))
)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS LOGNOT16 MACRO ((X)
                                  (LOGXOR X 177777Q)))
)




(* ; "RPT constants")

(DECLARE%: EVAL@COMPILE 

(RPAQQ \RPT.EMPTY 177776Q)

(RPAQQ \RPT.UNAVAILABLE 177777Q)

(RPAQQ \PAGETABLESTOPFLG 0)

(RPAQQ \RPTENTRYLENGTH 3)


(CONSTANTS \RPT.EMPTY \RPT.UNAVAILABLE \PAGETABLESTOPFLG \RPTENTRYLENGTH)
)
(DECLARE%: EVAL@COMPILE

(BLOCKRECORD RPT ((LOCKED FLAG)
                      (NEXTRP BITS 17Q)
                      (VP WORD)
                      (FILEPAGE WORD))
                     (BLOCKRECORD RPT ((NIL BITS 20Q)
                                       (VPSEG BYTE)
                                       (VPPAGEINSEG BYTE)))
                     [ACCESSFNS RPT ([EMPTY (EQ (fetch (RPT VP) of DATUM)
                                                \RPT.EMPTY)
                                            (COND
                                               (NEWVALUE (replace (RPT VP) of DATUM
                                                            with \RPT.EMPTY))
                                               (T (ERROR "Invalid replace of RPT.EMPTY" DATUM]
                                     [UNAVAILABLE (EQ (fetch (RPT VP) of DATUM)
                                                      \RPT.UNAVAILABLE)
                                            (COND
                                               (NEWVALUE (replace (RPT VP) of DATUM
                                                            with \RPT.UNAVAILABLE))
                                               (T (ERROR "Invalid replace of RPT.UNAVAILABLE" DATUM]
                                     (OCCUPIED (ILESSP (fetch (RPT VP) of DATUM)
                                                      \RPT.EMPTY])

(ACCESSFNS RPT1 (RPTRBASE (\ADDBASE (\ADDBASE \REALPAGETABLE (LLSH DATUM 1))
                                     DATUM)))
)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS RPFROMRPT MACRO ((RPTINDEX)
                                   (IPLUS RPTINDEX \RPOFFSET)))

(PUTPROPS RPTFROMRP MACRO ((RP)
                                   (IDIFFERENCE RP \RPOFFSET)))

(PUTPROPS NPAGESMACRO MACRO ((FORM)
                                     (PROG ((RESULT 0)
                                            (CNTR \RPTSIZE)
                                            (RPTR \REALPAGETABLE)
                                            VP)
                                       LP  (COND
                                              ((NEQ (SETQ CNTR (SUB1 CNTR))
                                                    0)
                                               (SETQ RPTR (\ADDBASE RPTR \RPTENTRYLENGTH))
                                               (COND
                                                  ((AND (fetch (RPT OCCUPIED) of RPTR)
                                                        (PROGN (SETQ VP (fetch (RPT VP)
                                                                           of RPTR))
                                                               FORM))
                                                   (add RESULT 1)))
                                               (GO LP)))
                                           (RETURN RESULT))))
)




(* ; "Virtual to file pagemap")

(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 

(RPAQQ \MAXFILEPAGE 177776Q)


(CONSTANTS \MAXFILEPAGE)
)

(* "END EXPORTED DEFINITIONS")

(DECLARE%: EVAL@COMPILE 

(RPAQQ \EMPTYPMTENTRY 177777Q)


(CONSTANTS \EMPTYPMTENTRY)
)
(DECLARE%: EVAL@COMPILE

(ACCESSFNS VP ((PRIMARYKEY (LRSH DATUM 5))
                   (SECONDARYKEY (LOGAND DATUM 37Q))
                   (INVALID (PROGN NIL))))
)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS .PAGEMAPBASE. MACRO [OPENLAMBDA (VPAGE)
                                        (\ADDBASE \PAGEMAP (IPLUS (\GETBASE \PageMapTBL
                                                                         (fetch (VP PRIMARYKEY)
                                                                            of VPAGE))
                                                                  (fetch (VP SECONDARYKEY)
                                                                     of VPAGE])
)




(* ; "FP to VP stuff")

(DECLARE%: EVAL@COMPILE

(BLOCKRECORD FPTOVP ((FPVIRTUALPAGE FIXP))
                        [ACCESSFNS FPTOVP ((FPOCCUPIED (NEQ (\GETBASE DATUM 0)
                                                            \NO.VMEM.PAGE])
)
(DECLARE%: EVAL@COMPILE 

(RPAQQ \NO.VMEM.PAGE 177777Q)


(CONSTANTS \NO.VMEM.PAGE)
)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS DLRPFROMFP MACRO ((FP)
                                    (ADD1 FP)))

(PUTPROPS DLFPFROMRP MACRO ((RP)
                                    (SUB1 RP)))
)


(PUTPROPS \TOUCHPAGE DOPVAL (1 GETBASE.N 0))

(PUTPROPS TIMES3 DOPVAL (1 COPY LLSH1 IPLUS2))




(* ; "Locked page table")

(DECLARE%: EVAL@COMPILE 

(PUTPROPS .LOCKEDVPBASE. MACRO ((VP)
                                        (\ADDBASE \LOCKEDPAGETABLE (FOLDLO VP BITSPERWORD))))

(PUTPROPS .LOCKEDVPMASK. MACRO ((VP)
                                        (LLSH 1 (IMOD VP BITSPERWORD))))
)

(DECLARE%: EVAL@COMPILE 

(RPAQQ \MAXDIRTYSCANCOUNT 144Q)

(RPAQQ \MINVMEMSPAREPAGES 144Q)

(RPAQQ \DLBUFFERPAGES 20Q)


(CONSTANTS \MAXDIRTYSCANCOUNT \MINVMEMSPAREPAGES \DLBUFFERPAGES)
)

(DECLARE%: EVAL@COMPILE 

(RPAQQ 2MBPAGES 10000Q)


(CONSTANTS 2MBPAGES)
)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \UPDATECHAINFREQ \REALPAGETABLE \RPTLAST \RPOFFSET \RPTSIZE \LOCKEDPAGETABLE \EMBUFBASE 
       \EMBUFVP \EMBUFRP \PAGEFAULTCOUNTER \LASTDIRTYCNT \LASTDIRTYFOUND \LASTDIRTYSCANPTR 
       \MACHINETYPE \LASTACCESSEDVMEMPAGE \MAXSHORTSEEK \MAXCLEANPROBES \MINSHORTSEEK \DIRTYSEEKMAX 
       \DIRTYPAGECOUNTER \DIRTYPAGEHINT \VMEM.INHIBIT.WRITE \VMEM.PURE.LIMIT \VMEM.FULL.STATE 
       \GUARDVMEMFULL VMEM.COMPRESS.FLG \KBDSTACKBASE \MISCSTACKBASE \DOFAULTINIT \FPTOVP 
       \VMEMACCESSFN \SYSTEMCACHEVARS \LASTVMEMFILEPAGE \EXTENDINGVMEMFILE \MaxScreenPage 
       \NEWVMEMPAGEADDED)
)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \#SWAPBUFFERS \#EMUBUFFERS \#DISKBUFFERS \MAXSWAPBUFFERS \EMUSWAPBUFFERS \EMUBUFFERS 
       \TELERAIDBUFFER \EMUDISKBUFFERS \EMUDISKBUFEND)
)

(DECLARE%: EVAL@COMPILE 

(PUTPROPS RWMufMan DMACRO ((X)
                                   ((OPCODES 170Q 11Q)
                                    X)))
)

(DECLARE%: EVAL@COMPILE 

(RPAQQ DOLOCKCHECKS NIL)


(CONSTANTS (DOLOCKCHECKS NIL))
)
)



(* ;;; "MAKEINIT stuff")

(DEFINEQ

(ADDPME
  [LAMBDA (VP NEWPAGEOK)                                 (* bvm%: " 6-Dec-84 14:07")

    (* ;; "add an entry for VP to the PAGEMAP.  Called only under MAKEINIT")

    (PROG (PX PMP LOCKBASE)
          [COND
             ((IEQ (SETQ PMP (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)))
                   \EmptyPMTEntry)                           (* ; 
                                      "empty entries in the PageMapTBL have 177777q as their value")
              (COND
                 ((EVENP NEXTPM WORDSPERPAGE)                (* ; "must add a new page map page")
                  (SETQ PX (\ADDBASE \PAGEMAP NEXTPM))
                  (OR NEWPAGEOK (IGREATERP (PAGELOC PX)
                                       VP)
                      (HELP "page map needs new page after page map written out"))
                  (\NEWPAGE PX NIL T)))
              (\PUTBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)
                     (SETQ PMP NEXTPM))
              (SETQ NEXTPM (IPLUS NEXTPM \PMblockSize]
          (SETQ PX (IPLUS PMP (fetch (VP SECONDARYKEY) of VP)))
          (COND
             ((NEQ (\GETBASE \PAGEMAP PX)
                   0)
              (HELP "page already in pagemap" VP))
             (T (\PUTBASE \PAGEMAP PX NEXTVMEM)
                [COND
                   ((LOCKEDPAGEP VP)                         (* ; 
                                                           "Set lock bit in locked page table")
                    (\PUTBASE (SETQ LOCKBASE (.LOCKEDVPBASE. VP))
                           0
                           (LOGOR (.LOCKEDVPMASK. VP)
                                  (\GETBASE LOCKBASE 0]
                (SETQ NEXTVMEM (ADD1 NEXTVMEM])

(CHECKIFPAGE
  [LAMBDA NIL                                            (* mjs "19-Jul-84 13:24")
    (CHECKIF Key EQUAL \IFPValidKey "Interface page key"])

(DUMPINITPAGES
  [LAMBDA (CODEFIRSTPAGE CODENEXTPAGE VERSIONS)          (* bvm%: "14-Jan-85 12:51")
                                                             (* ; "called only under MAKEINIT")
    (ADDPME (PAGELOC \InterfacePage)
           T)                                                (* ; 
                                                        "THE INTERFACE PAGE MUST BE THE FIRST PAGE")
    (for I from CODEFIRSTPAGE to (SUB1 CODENEXTPAGE) do 
                                                             (* ; 
                    "add the pagemap entries for the pages which were written directly to the file")
                                                                       (ADDPME I T))
    (MAPPAGES 0 (ADD1 \MAXVMPAGE)
           (FUNCTION MAKEROOMFORPME))
    (MAPPAGES 0 (ADD1 \MAXVMPAGE)
           (FUNCTION ADDPME))
    (PROGN                                                   (* ; 
                     "set interface page locations --- stack pointers already set up IN SETUPSTACK")
           (replace (IFPAGE NxtPMAddr) of \InterfacePage with NEXTPM)
           (replace (IFPAGE NActivePages) of \InterfacePage with (SUB1 NEXTVMEM))
           (replace (IFPAGE NDirtyPages) of \InterfacePage with (SUB1 NEXTVMEM))
           (replace (IFPAGE filePnPMP0) of \InterfacePage with (\GETBASE \PAGEMAP 0))
           (replace (IFPAGE filePnPMT0) of \InterfacePage with (\GETBASE
                                                                            (.PAGEMAPBASE.
                                                                             (PAGELOC \PageMapTBL))
                                                                            0))
           [COND
              (VERSIONS (replace (IFPAGE LVersion) of \InterfacePage with (CAR VERSIONS))
                     (replace (IFPAGE MinBVersion) of \InterfacePage with (CADDR VERSIONS
                                                                                             ))
                     (replace (IFPAGE MinRVersion) of \InterfacePage with (CADR VERSIONS]
           (replace (IFPAGE Key) of \InterfacePage with \IFPValidKey))
    (MAPPAGES 0 (ADD1 \MAXVMPAGE)
           (FUNCTION DUMPVP))
    (ALLOCAL (PROG ((FILE (OUTPUT)))
                   [COND
                      ((NOT (RANDACCESSP FILE))              (* ; 
                                "SYSOUT file is sequential;  have to get it random access for this")
                       (OUTPUT (SETQ FILE (OPENFILE (CLOSEF FILE)
                                                 'BOTH]
                   (SETFILEPTR FILE MKI.Page0Byte)))
    (DUMPVP (PAGELOC \InterfacePage])

(MAKEROOMFORPME
  [LAMBDA (VP)                                           (* bvm%: "29-MAR-83 17:11")

    (* ;; 
 "make sure that the pagemap-page for page VP exists;  we later will want to add it to the pagemap")

    (COND
       ((IEQ (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP))
             \EmptyPMTEntry)                                 (* ; 
                                      "empty entries in the PageMapTBL have 177777q as their value")
        (COND
           ((EVENP NEXTPM WORDSPERPAGE)                      (* ; "must add a new page map page")
            (\NEWPAGE (\ADDBASE \PAGEMAP NEXTPM)
                   NIL T)))
        (\PUTBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)
               NEXTPM)
        (SETQ NEXTPM (IPLUS NEXTPM \PMblockSize])

(MAPPAGES
  [LAMBDA (BOT TOP FN)                        (* ; 
                                                "Edited  5-Nov-92 15:41 by sybalsky:mv:envos")

    (* ;; "Map thru all pages from BOT to TOP that exist, skipping the interface page, if it falls into that range.  Call FN on the page number.")

    (PROG ((VP BOT)
           (IVP (PAGELOC \InterfacePage)))
      LP  (COND
             ((AND (SETQ VP (MKI.NEXTPAGE VP))
                   (IGREATERP TOP VP))
              (COND
                 ((NOT (IEQ VP IVP))
                  (APPLY* FN VP)))
              (SETQ VP (ADD1 VP))
              (GO LP])

(READPAGEMAP
  [LAMBDA NIL                                            (* bvm%: "10-Dec-84 21:54")
                                                             (* ; 
                          "called only under READSYS -- reads in pagemap so that SETVMPTR can work")
    (PROG (D)
          (LOCAL (MAPVMPAGE (fetch (POINTER PAGE#) of \InterfacePage)
                        1))                                  (* ; "Install interface page by magic")
                                                             (* PROGN (SETQ FPSTART
                                                           (fetch (IFPAGE LastDominoFilePage) 
                                                           of \InterfacePage))
                                                           (SETQ NPAGES (fetch
                                                           (IFPAGE NActivePages) of 
                                                           \InterfacePage)) (* ;
                                                           "Note: have to do these fetches before the SETFILEPTR since they indirectly do SETFILEPTR themselves")
                                                           (SETFILEPTR VMEMFILE
                                                           (IPLUS (UNFOLD (SUB1
                                                           (fetch (IFPAGE FPTOVPStart) of 
                                                           \InterfacePage)) BYTESPERPAGE)
                                                           (UNFOLD FPSTART BYTESPERWORD)))
                                                           (for I from FPSTART to NPAGES bind 
                                                           VP when (NEQ (SETQ VP
                                                           (VBIN2)) \NO.VMEM.PAGE) do
                                                           (* ; "Read in all of FPTOVP")
                                                           (MAPVMPAGE VP (SUB1 I))))
          [LOCAL (MAPVMPAGE (PAGELOC \PAGEMAP)
                        (SUB1 (fetch (IFPAGE filePnPMP0) of \InterfacePage]
                                                             (* ; "map in first page of secondary page map, which is where all the secondary map pages themselves live")
          (LOCAL (SETVMPTR \PAGEMAP))
          (for I from 0 to (SUB1 (FOLDHI PAGESPERSEGMENT \PMblockSize)) as VP
             from (PAGELOC \PAGEMAP) by \PMblockSize do 
                                                             (* ; 
"Have to read all the addresses of secondary map pages themselves before we can read their contents")
                                                                   (READPAGEMAPBLOCK VP))
          (for J from 0 to (SUB1 \NumPMTpages) as FP
             from (SUB1 (fetch (IFPAGE filePnPMT0) of \InterfacePage))
             do                                          (* ; 
                                                          "read in all the primary map table pages")
                   (LOCAL (MAPVMPAGE (IPLUS (PAGELOC \PageMapTBL)
                                            J)
                                 FP)))
          (for I from 0 to (SUB1 (UNFOLD \NumPMTpages WORDSPERPAGE))
             do (COND
                       ((IEQ (SETQ D (GETBASE \PageMapTBL I))
                             \EmptyPMTEntry))
                       (T (LOCAL (SETVMPTR (ADDBASE \PAGEMAP D)))
                          (READPAGEMAPBLOCK (UNFOLD I \PMblockSize])

(READPAGEMAPBLOCK
  [LAMBDA (VP)                                           (* lmm " 4-MAY-82 21:12")
    (PROG ((B VP)
           P)
          (FRPTQ \PMblockSize [COND
                                 ((NEQ (SETQ P (VBIN2))
                                       0)
                                  (LOCAL (MAPVMPAGE B (SUB1 P]
                 (SETQ B (ADD1 B])

(SETUPPAGEMAP
  [LAMBDA NIL                                 (* ; 
                                                "Edited  5-Nov-92 16:03 by sybalsky:mv:envos")
                                                             (* ; 
                                             "called only from MAKEINIT to initialize the page map")
    (PROG NIL                                                (* ; "set up page map")
          (\NEWPAGE \PAGEMAP NIL T)                      (* ; 
                                                           "Create 1 page worth of real page table")
          (CREATEPAGES \PageMapTBL \NumPMTpages NIL T)       (* ; "And the segment table.")

     (* ;; "init PageMapTBL pages to 177777q:")

          (for I from 0 to (SUB1 (UNFOLD \NumPMTpages WORDSPERPAGE))
             do (\PUTBASE \PageMapTBL I \EmptyPMTEntry))
          (SETQ NEXTPM 0)
          (for I from 0 to (SUB1 (fetch (VP PRIMARYKEY) of \NumPageMapPages))
             bind (PAGEMAPKEY _ (fetch (VP PRIMARYKEY) of (PAGELOC \PAGEMAP)))
             do 

                   (* ;; "Assign pagemap pages to cover all pagemap pages, so that \DONEWPAGE can guarantee that when it needs to allocate a new pagemap page, that the pagemap page for the new page already exists")

                   (\PUTBASE \PageMapTBL (IPLUS PAGEMAPKEY I)
                          NEXTPM)
                   (SETQ NEXTPM (IPLUS NEXTPM \PMblockSize)))
          (SETQ NEXTVMEM \FirstVmemBlock)                    (* ; 
                                      "add entry for InterfacePage which must be on FirstVMemBlock")
          (CREATEPAGES \LOCKEDPAGETABLE \NumLPTPages NIL T])
)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(PUTPROPS CHECKIF MACRO [(FLD COMPARISON VALUE STR)
                                 (COND
                                    ((NOT (COMPARISON VALUE (fetch (IFPAGE FLD) of 
                                                                                       \InterfacePage
                                                                   )))
                                     (printout T "Warning: " STR "= " (PROGN VALUE)
                                            ", but \InterfacePage says "
                                            (fetch (IFPAGE FLD) of \InterfacePage)
                                            T])
)


(ADDTOVAR INEWCOMS (FNS DUMPINITPAGES)
                       (VARS INITCONSTANTS)
                       (FNS SETUPPAGEMAP ADDPME MAKEROOMFORPME MAPPAGES))

(ADDTOVAR RDCOMS (FNS READPAGEMAP READPAGEMAPBLOCK CHECKIFPAGE \LOCKEDPAGEP \LOOKUPPAGEMAP 
                          CHECKPAGEMAP CHECKFPTOVP CHECKFPTOVP1 \SHOWPAGETABLE \PRINTFPTOVP))

(ADDTOVAR EXPANDMACROFNS CHECKIF .LOCKEDVPBASE. .LOCKEDVPMASK. .PAGEMAPBASE.)

(ADDTOVAR MKI.SUBFNS (\NEWPAGE . MKI.NEWPAGE)
                         (\LOCKPAGES . MKI.LOCKPAGES))

(ADDTOVAR RD.SUBFNS (\NEWPAGE . VNEWPAGE)
                        (\LOCKPAGES . VLOCKPAGES))

(ADDTOVAR RDPTRS (\REALPAGETABLE))

(ADDTOVAR RDVALS (\RPTSIZE))
EVAL@COMPILE 

(ADDTOVAR DONTCOMPILEFNS DUMPINITPAGES SETUPPAGEMAP ADDPME MAKEROOMFORPME MAPPAGES READPAGEMAP 
                                   READPAGEMAPBLOCK CHECKIFPAGE)
)
(DEFINEQ

(\LOCKFN
  [LAMBDA (FN)                                           (* bvm%: "22-NOV-82 17:39")
    [\LOCKCELL (SETQ FN (fetch (LITATOM DEFINITIONCELL) of (EVQ FN]
    (COND
       ((fetch (DEFINITIONCELL CCODEP) of FN)
        (\LOCKCODE (fetch (DEFINITIONCELL DEFPOINTER) of FN])

(\LOCKCODE
  [LAMBDA (CODEBLOCK)                                    (* rmk%: "15-Aug-84 13:35")
    (\LOCKWORDS CODEBLOCK (UNFOLD (\#BLOCKDATACELLS CODEBLOCK)
                                     WORDSPERCELL])

(\LOCKVAR
  [LAMBDA (VAR)                                          (* lmm " 5-APR-82 00:43")
    (\LOCKCELL (fetch (LITATOM VCELL) of (EVQ VAR])

(\LOCKCELL
  [LAMBDA (X NPGS)                                       (* bvm%: "22-NOV-82 17:54")
    (\LOCKPAGES (PAGEBASE X)
           (OR NPGS 1])

(\LOCKWORDS
  [LAMBDA (BASE NWORDS)                                  (* bvm%: "22-NOV-82 17:35")
    (\LOCKPAGES (PAGEBASE BASE)
           (COND
              (NWORDS (FOLDHI (IPLUS (fetch (POINTER WORDINPAGE) of BASE)
                                     NWORDS)
                             WORDSPERPAGE))
              (T 1])
)
(DECLARE%: DONTCOPY 

(ADDTOVAR INEWCOMS
          (FNS \LOCKFN \LOCKVAR \LOCKCELL \LOCKWORDS \LOCKCODE)
          (ALLOCAL (ADDVARS (LOCKEDFNS \FAULTHANDLER \FAULTINIT \DOVE.FAULTINIT \D01.FAULTINIT 
                                   \DL.FAULTINIT \CHAIN.UP.RPT \MAKESPACEFORLOCKEDPAGE \PAGEFAULT 
                                   \WRITEMAP \LOOKUPPAGEMAP \LOCKEDPAGEP \LOADVMEMPAGE \MOVEREALPAGE
                                   \INVALIDADDR \INVALIDVP \SELECTREALPAGE \TRANSFERPAGE \SPECIALRP 
                                   \UPDATECHAIN \MARKPAGEVACANT \FLUSHPAGE \CLEARWORDS \FLUSHVM 
                                   \DONEWPAGE \ASSURE.FPTOVP.PAGE \DONEWEPHEMERALPAGE 
                                   \WRITEDIRTYPAGE1 \COPYSYS0 \COPYSYS0SUBR \RELEASEWORKINGSET 
                                   \DOFLUSHVM \DOLOCKPAGES \DOTEMPLOCKPAGES \TEMPUNLOCKPAGES 
                                   \MP.ERROR RAID \DL.NEWFAULTINIT \DL.MARK.PAGES.UNAVAILABLE 
                                   \DL.UNMAPPAGES \DL.ASSIGNBUFFERS \D01.ASSIGNBUFFERS 
                                   \DOCOMPRESSVMEM \MOVEVMEMFILEPAGE \SET.VMEM.FULL.STATE \HINUM 
                                   \LONUM \ATOMCELL SETTOPVAL)
                          (LOCKEDVARS \REALPAGETABLE \RPTLAST \PAGEFAULTCOUNTER \UPDATECHAINFREQ 
                                 \RPOFFSET \RPTSIZE \LOCKEDPAGETABLE \EMBUFBASE \EMBUFVP \EMBUFRP 
                                 \LASTACCESSEDVMEMPAGE \MAXSHORTSEEK \MAXCLEANPROBES \MINSHORTSEEK 
                                 \DIRTYPAGECOUNTER \DIRTYPAGEHINT \VMEM.INHIBIT.WRITE 
                                 \VMEM.PURE.LIMIT \VMEM.FULL.STATE \GUARDVMEMFULL VMEM.COMPRESS.FLG 
                                 \KBDSTACKBASE \MISCSTACKBASE \DOFAULTINIT \FPTOVP \MACHINETYPE 
                                 \VMEMACCESSFN \TELERAIDBUFFER \EMUDISKBUFFERS \EMUDISKBUFEND 
                                 \MAXSWAPBUFFERS \EMUBUFFERS \#EMUBUFFERS \#SWAPBUFFERS \#DISKBUFFERS
                                 \RCLKSECOND \RCLKMILLISECOND \VALSPACE \EMUSWAPBUFFERS 
                                 \EM.CURSORBITMAP \PAGEMAP \PageMapTBL \IOCBPAGE \IOPAGE \MISCSTATS 
                                 \DEFSPACE \InterfacePage \LASTVMEMFILEPAGE \DoveIORegion 
                                 \MaxScreenPage \NEWVMEMPAGEADDED))))
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA VMEM.PURE.STATE)
)
(PUTPROPS LLFAULT COPYRIGHT ("Venue & Xerox Corporation" 3676Q 3677Q 3700Q 3701Q 3702Q 3703Q 3704Q 
3705Q 3706Q 3707Q 3710Q 3711Q 3745Q))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (33017Q 67143Q (\FAULTINIT 33031Q . 42260Q) (\D01.FAULTINIT 42262Q . 47707Q) (
\D01.ASSIGNBUFFERS 47711Q . 53456Q) (\MAIKO.FAULTINIT 53460Q . 56245Q) (\MAIKO.NEWFAULTINIT 56247Q . 
57603Q) (\MAIKO.ASSIGNBUFFERS 57605Q . 63361Q) (\M-VMEMSAVE 63363Q . 66603Q) (\MAIKO.NEWPAGE 66605Q . 
67141Q)) (67343Q 74771Q (\MAIKO.DO.MOVDS 67355Q . 74767Q)) (76130Q 166610Q (\DOVE.FAULTINIT 76142Q . 
102535Q) (\DL.FAULTINIT 102537Q . 107630Q) (\DL.NEWFAULTINIT 107632Q . 154344Q) (\DL.UNMAPPAGES 
154346Q . 155334Q) (\DL.MARK.PAGES.UNAVAILABLE 155336Q . 156274Q) (\DL.ASSIGNBUFFERS 156276Q . 162017Q
) (\CHAIN.UP.RPT 162021Q . 166606Q)) (166653Q 253066Q (\FAULTHANDLER 166665Q . 167543Q) (\PAGEFAULT 
167545Q . 173304Q) (\INVALIDADDR 173306Q . 173562Q) (\INVALIDVP 173564Q . 174023Q) (\FLUSHPAGE 174025Q
 . 201166Q) (\LOADVMEMPAGE 201170Q . 205242Q) (\MOVEREALPAGE 205244Q . 210504Q) (\LOOKUPPAGEMAP 
210506Q . 211500Q) (\VALIDADDRESSP 211502Q . 211772Q) (\LOCKEDPAGEP 211774Q . 213176Q) (
\SELECTREALPAGE 213200Q . 235135Q) (\SPECIALRP 235137Q . 236154Q) (\TRANSFERPAGE 236156Q . 244017Q) (
\UPDATECHAIN 244021Q . 253064Q)) (253150Q 327741Q (\NEWPAGE 253162Q . 255200Q) (\DONEWPAGE 255202Q . 
264741Q) (\ASSURE.FPTOVP.PAGE 264743Q . 267715Q) (\MAKESPACEFORLOCKEDPAGE 267717Q . 275321Q) (
\MOVEVMEMFILEPAGE 275323Q . 277744Q) (\NEWEPHEMERALPAGE 277746Q . 300477Q) (\DONEWEPHEMERALPAGE 
300501Q . 305717Q) (\LOCKPAGES 305721Q . 306345Q) (\DOLOCKPAGES 306347Q . 316113Q) (\TEMPLOCKPAGES 
316115Q . 316624Q) (\DOTEMPLOCKPAGES 316626Q . 321641Q) (\TEMPUNLOCKPAGES 321643Q . 324525Q) (
\UNLOCKPAGES 324527Q . 327737Q)) (330007Q 357025Q (\FLUSHVM 330021Q . 332261Q) (\LOGOUT0 332263Q . 
334236Q) (\DOFLUSHVM 334240Q . 336724Q) (\RELEASEWORKINGSET 336726Q . 340516Q) (\WRITEDIRTYPAGE 
340520Q . 354264Q) (\WRITEDIRTYPAGE1 354266Q . 355613Q) (\COUNTREALPAGES 355615Q . 357023Q)) (357073Q 
362422Q (\DOCOMPRESSVMEM 357105Q . 361423Q) (VMEM.PURE.STATE 361425Q . 362420Q)) (362671Q 373200Q (
32MBADDRESSABLE 362703Q . 363351Q) (\SET.VMEM.FULL.STATE 363353Q . 365274Q) (\SET.LASTVMEMFILEPAGE 
365276Q . 366647Q) (\DOVMEMFULLINTERRUPT 366651Q . 372414Q) (\FLUSHVMOK? 372416Q . 373176Q)) (374654Q 
375310Q (\MP.ERROR 374666Q . 375306Q)) (375441Q 425251Q (\ACTONVMEMFILE 375453Q . 376252Q) (
\SHOWPAGETABLE 376254Q . 403755Q) (CHECKPAGEMAP 403757Q . 411641Q) (CHECKFPTOVP 411643Q . 412655Q) (
CHECKFPTOVP1 412657Q . 414046Q) (\PRINTFPTOVP 414050Q . 424733Q) (\PRINTVP 424735Q . 425247Q)) (
445216Q 474714Q (ADDPME 445230Q . 450577Q) (CHECKIFPAGE 450601Q . 451053Q) (DUMPINITPAGES 451055Q . 
456473Q) (MAKEROOMFORPME 456475Q . 460175Q) (MAPPAGES 460177Q . 461376Q) (READPAGEMAP 461400Q . 
470555Q) (READPAGEMAPBLOCK 470557Q . 471347Q) (SETUPPAGEMAP 471351Q . 474712Q)) (500023Q 502371Q (
\LOCKFN 500035Q . 500540Q) (\LOCKCODE 500542Q . 501104Q) (\LOCKVAR 501106Q . 501356Q) (\LOCKCELL 
501360Q . 501624Q) (\LOCKWORDS 501626Q . 502367Q)))))
STOP
\ No newline at end of file
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "21-Mar-2021 21:33:01" {DSK}<home>larry>ilisp>medley>sources>LLFAULT.;10 501717Q

      changes to%:  (VARS LLFAULTCOMS)

      previous date%: "16-Mar-2021 20:27:50" {DSK}<home>larry>ilisp>medley>sources>LLFAULT.;8)


(* ; "
Copyright (c) 1982-1993, 2021 by Venue & Xerox Corporation.
")

(PRETTYCOMPRINT LLFAULTCOMS)

(RPAQQ LLFAULTCOMS
       [(VARS (FAULTTEST T))
        (COMS                                                (* ; 
                                                 "Bootstrap code, run once when an image is booted")
              (FNS \FAULTINIT \D01.FAULTINIT \D01.ASSIGNBUFFERS \MAIKO.FAULTINIT \MAIKO.NEWFAULTINIT
                   \MAIKO.ASSIGNBUFFERS \M-VMEMSAVE \MAIKO.NEWPAGE)
              
              (* ;; "For setting up (and maybe eventually removing?) MAIKO-specific versions of the generic low-levle functions:")

              (FNS \MAIKO.DO.MOVDS)
              (ADDVARS (\MAIKO.MOVDS (TRUE \LOCKEDPAGEP)
                              (\MAIKO.NEWPAGE \NEWPAGE)
                              (\MAIKO.NEWPAGE \DONEWPAGE)
                              (NILL \LOCKPAGES)
                              (NILL \DOLOCKPAGES)
                              (NILL \DOTEMPLOCKPAGES)
                              (NILL \TEMPUNLOCKPAGES)
                              (NILL \UNLOCKPAGES)
                              (NILL \WRITEDIRTYPAGE)
                              (NILL \DIRTYBACKGROUND)
                              (ZERO \COUNTREALPAGES)
                              (NILL \SHOWPAGETABLE)
                              (NILL CHECKPAGEMAP)
                              (EVQ \PAGEFAULT)
                              (EVQ \LOADVMEMPAGE)
                              (NILL \LOADVMEMPAGE)
                              (TRUE \MOVEVMEMFILEPAGE)
                              (TRUE \VALIDADDRESSP)))
              (FNS \DOVE.FAULTINIT \DL.FAULTINIT \DL.NEWFAULTINIT \DL.UNMAPPAGES 
                   \DL.MARK.PAGES.UNAVAILABLE \DL.ASSIGNBUFFERS \CHAIN.UP.RPT))
        (COMS                                                (* ; "Pagefault handler")
              (FNS \FAULTHANDLER \PAGEFAULT \INVALIDADDR \INVALIDVP \FLUSHPAGE \LOADVMEMPAGE 
                   \MOVEREALPAGE \LOOKUPPAGEMAP \VALIDADDRESSP \LOCKEDPAGEP \SELECTREALPAGE 
                   \SPECIALRP \TRANSFERPAGE \UPDATECHAIN))
        (COMS                                                (* ; 
                                                           "Allocating and locking new pages")
              (FNS \NEWPAGE \DONEWPAGE \ASSURE.FPTOVP.PAGE \MAKESPACEFORLOCKEDPAGE \MOVEVMEMFILEPAGE
                   \NEWEPHEMERALPAGE \DONEWEPHEMERALPAGE \LOCKPAGES \DOLOCKPAGES \TEMPLOCKPAGES 
                   \DOTEMPLOCKPAGES \TEMPUNLOCKPAGES \UNLOCKPAGES))
        (COMS                                                (* ; "Writing out the vmem")
              (FNS \DOFLUSHVM \RELEASEWORKINGSET \WRITEDIRTYPAGE \WRITEDIRTYPAGE1 \COUNTREALPAGES))
        (COMS                                                (* ; "VMEM.PURE.STATE hack")
              (FNS \DOCOMPRESSVMEM VMEM.PURE.STATE))
        (COMS 
              (* ;; "Handling the backing store getting too full--keep running, but if we overflow, we can never \FLUSHVM because there is no place to write some pages")

              (FNS 32MBADDRESSABLE \SET.VMEM.FULL.STATE \SET.LASTVMEMFILEPAGE \DOVMEMFULLINTERRUPT 
                   \FLUSHVMOK?))
        (INITVARS (\UPDATECHAINFREQ 100)
               (\PAGEFAULTCOUNTER 0)
               (\DIRTYPAGECOUNTER 0)
               (\DIRTYPAGEHINT 0)
               (\LASTACCESSEDVMEMPAGE 0)
               (\MAXSHORTSEEK 1000)
               (\MINSHORTSEEK 20)
               (\MAXCLEANPROBES 20)
               (\VMEM.INHIBIT.WRITE)
               (\VMEM.PURE.LIMIT)
               (\VMEM.FULL.STATE)
               (\GUARDVMEMFULL 500)
               (VMEM.COMPRESS.FLG)
               (\DOFAULTINIT 0)
               (\VMEMACCESSFN)
               (\SYSTEMCACHEVARS)
               (\MAXSWAPBUFFERS 1)
               (\EXTENDINGVMEMFILE)
               (\MaxScreenPage 0)
               (\NEWVMEMPAGEADDED))
        (INITVARS (\LASTDIRTYCNT)
               (\LASTDIRTYFOUND)
               (\LASTDIRTYSCANPTR)
               (\DIRTYSEEKMAX 50))
        (COMS                                                (* ; 
                                                         "Errors signaled in the maintenance panel")
              (FNS \MP.ERROR))
        (COMS                                                (* ; 
                          "Debugging code.  Some of this also runs renamed for extra TeleRaid help")
              (FNS \ACTONVMEMFILE \SHOWPAGETABLE CHECKPAGEMAP CHECKFPTOVP CHECKFPTOVP1 \PRINTFPTOVP 
                   \PRINTVP))
        (E (RESETSAVE (RADIX 8)))
        (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS \ACTONVMEMFILE .VMEM.CONSISTENTP. .LOCKABLERP.)
               (COMS                                         (* ; "Virtual page flags")
                     (CONSTANTS \VMAP.DIRTY \VMAP.CLEAN \VMAP.REF \VMAP.VACANT \VMAP.FLAGS 
                            \VMAP.NOTFLAGS)
                     (RECORDS VMEMFLAGS)
                     (MACROS LOGNOT16))
               (COMS                                         (* ; "RPT constants")
                     (CONSTANTS \RPT.EMPTY \RPT.UNAVAILABLE \PAGETABLESTOPFLG \RPTENTRYLENGTH)
                     (RECORDS RPT RPT1)
                     (MACROS RPFROMRPT RPTFROMRP NPAGESMACRO))
               (COMS                                         (* ; "Virtual to file pagemap")
                     (EXPORT (CONSTANTS \MAXFILEPAGE))
                     (CONSTANTS \EMPTYPMTENTRY)
                     (RECORDS VP)
                     (MACROS .PAGEMAPBASE.))
               (COMS                                         (* ; "FP to VP stuff")
                     (RECORDS FPTOVP)
                     (CONSTANTS \NO.VMEM.PAGE)
                     (MACROS DLRPFROMFP DLFPFROMRP))
               (PROP DOPVAL \TOUCHPAGE TIMES3)
               (COMS                                         (* ; "Locked page table")
                     (MACROS .LOCKEDVPBASE. .LOCKEDVPMASK.))
               (CONSTANTS \MAXDIRTYSCANCOUNT \MINVMEMSPAREPAGES \DLBUFFERPAGES)
               (CONSTANTS 2MBPAGES)
               (GLOBALVARS \UPDATECHAINFREQ \REALPAGETABLE \RPTLAST \RPOFFSET \RPTSIZE 
                      \LOCKEDPAGETABLE \EMBUFBASE \EMBUFVP \EMBUFRP \PAGEFAULTCOUNTER \LASTDIRTYCNT 
                      \LASTDIRTYFOUND \LASTDIRTYSCANPTR \MACHINETYPE \LASTACCESSEDVMEMPAGE 
                      \MAXSHORTSEEK \MAXCLEANPROBES \MINSHORTSEEK \DIRTYSEEKMAX \DIRTYPAGECOUNTER 
                      \DIRTYPAGEHINT \VMEM.INHIBIT.WRITE \VMEM.PURE.LIMIT \VMEM.FULL.STATE 
                      \GUARDVMEMFULL VMEM.COMPRESS.FLG \KBDSTACKBASE \MISCSTACKBASE \DOFAULTINIT 
                      \FPTOVP \VMEMACCESSFN \SYSTEMCACHEVARS \LASTVMEMFILEPAGE \EXTENDINGVMEMFILE 
                      \MaxScreenPage \NEWVMEMPAGEADDED)
               (GLOBALVARS \#SWAPBUFFERS \#EMUBUFFERS \#DISKBUFFERS \MAXSWAPBUFFERS \EMUSWAPBUFFERS 
                      \EMUBUFFERS \TELERAIDBUFFER \EMUDISKBUFFERS \EMUDISKBUFEND)
               (MACROS RWMufMan)
               (CONSTANTS (DOLOCKCHECKS NIL)))
        [COMS 

(* ;;; "MAKEINIT stuff")

              (FNS ADDPME CHECKIFPAGE DUMPINITPAGES MAKEROOMFORPME MAPPAGES READPAGEMAP 
                   READPAGEMAPBLOCK SETUPPAGEMAP)
              (DECLARE%: DONTCOPY (MACROS CHECKIF)
                     (ADDVARS (INEWCOMS (FNS DUMPINITPAGES)
                                     (VARS INITCONSTANTS)
                                     (FNS SETUPPAGEMAP ADDPME MAKEROOMFORPME MAPPAGES))
                            (RDCOMS (FNS READPAGEMAP READPAGEMAPBLOCK CHECKIFPAGE \LOCKEDPAGEP 
                                         \LOOKUPPAGEMAP CHECKPAGEMAP CHECKFPTOVP CHECKFPTOVP1 
                                         \SHOWPAGETABLE \PRINTFPTOVP))
                            (EXPANDMACROFNS CHECKIF .LOCKEDVPBASE. .LOCKEDVPMASK. .PAGEMAPBASE.)
                            (MKI.SUBFNS (\NEWPAGE . MKI.NEWPAGE)
                                   (\LOCKPAGES . MKI.LOCKPAGES))
                            (RD.SUBFNS (\NEWPAGE . VNEWPAGE)
                                   (\LOCKPAGES . VLOCKPAGES))
                            (RDPTRS (\REALPAGETABLE))
                            (RDVALS (\RPTSIZE)))
                     EVAL@COMPILE
                     (ADDVARS (DONTCOMPILEFNS DUMPINITPAGES SETUPPAGEMAP ADDPME MAKEROOMFORPME 
                                     MAPPAGES READPAGEMAP READPAGEMAPBLOCK CHECKIFPAGE]
        (FNS \LOCKFN \LOCKCODE \LOCKVAR \LOCKCELL \LOCKWORDS)
        [DECLARE%: DONTCOPY
               (ADDVARS (INEWCOMS (FNS \LOCKFN \LOCKVAR \LOCKCELL \LOCKWORDS \LOCKCODE)
                               (ALLOCAL (ADDVARS (LOCKEDFNS \FAULTHANDLER \FAULTINIT \DOVE.FAULTINIT
                                                        \D01.FAULTINIT \DL.FAULTINIT \CHAIN.UP.RPT 
                                                        \MAKESPACEFORLOCKEDPAGE \PAGEFAULT \WRITEMAP
                                                        \LOOKUPPAGEMAP \LOCKEDPAGEP \LOADVMEMPAGE 
                                                        \MOVEREALPAGE \INVALIDADDR \INVALIDVP 
                                                        \SELECTREALPAGE \TRANSFERPAGE \SPECIALRP 
                                                        \UPDATECHAIN \MARKPAGEVACANT \FLUSHPAGE 
                                                        \CLEARWORDS \FLUSHVM \DONEWPAGE 
                                                        \ASSURE.FPTOVP.PAGE \DONEWEPHEMERALPAGE 
                                                        \WRITEDIRTYPAGE1 \COPYSYS0 \COPYSYS0SUBR 
                                                        \RELEASEWORKINGSET \DOFLUSHVM \DOLOCKPAGES 
                                                        \DOTEMPLOCKPAGES \TEMPUNLOCKPAGES \MP.ERROR 
                                                        RAID \DL.NEWFAULTINIT 
                                                        \DL.MARK.PAGES.UNAVAILABLE \DL.UNMAPPAGES 
                                                        \DL.ASSIGNBUFFERS \D01.ASSIGNBUFFERS 
                                                        \DOCOMPRESSVMEM \MOVEVMEMFILEPAGE 
                                                        \SET.VMEM.FULL.STATE \HINUM \LONUM \ATOMCELL
                                                        SETTOPVAL)
                                               (LOCKEDVARS \REALPAGETABLE \RPTLAST \PAGEFAULTCOUNTER
                                                      \UPDATECHAINFREQ \RPOFFSET \RPTSIZE 
                                                      \LOCKEDPAGETABLE \EMBUFBASE \EMBUFVP \EMBUFRP 
                                                      \LASTACCESSEDVMEMPAGE \MAXSHORTSEEK 
                                                      \MAXCLEANPROBES \MINSHORTSEEK \DIRTYPAGECOUNTER
                                                      \DIRTYPAGEHINT \VMEM.INHIBIT.WRITE 
                                                      \VMEM.PURE.LIMIT \VMEM.FULL.STATE 
                                                      \GUARDVMEMFULL VMEM.COMPRESS.FLG \KBDSTACKBASE
                                                      \MISCSTACKBASE \DOFAULTINIT \FPTOVP 
                                                      \MACHINETYPE \VMEMACCESSFN \TELERAIDBUFFER 
                                                      \EMUDISKBUFFERS \EMUDISKBUFEND \MAXSWAPBUFFERS
                                                      \EMUBUFFERS \#EMUBUFFERS \#SWAPBUFFERS 
                                                      \#DISKBUFFERS \RCLKSECOND \RCLKMILLISECOND 
                                                      \VALSPACE \EMUSWAPBUFFERS \EM.CURSORBITMAP 
                                                      \PAGEMAP \PageMapTBL \IOCBPAGE \IOPAGE 
                                                      \MISCSTATS \DEFSPACE \InterfacePage 
                                                      \LASTVMEMFILEPAGE \DoveIORegion \MaxScreenPage
                                                      \NEWVMEMPAGEADDED]
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
               (ADDVARS (NLAMA)
                      (NLAML)
                      (LAMA CHECKPAGEMAP \SHOWPAGETABLE VMEM.PURE.STATE \COUNTREALPAGES 
                            \WRITEDIRTYPAGE \UNLOCKPAGES \TEMPUNLOCKPAGES \DOTEMPLOCKPAGES 
                            \DOLOCKPAGES \LOCKPAGES \LOADVMEMPAGE])

(RPAQQ FAULTTEST T)



(* ; "Bootstrap code, run once when an image is booted")

(DEFINEQ

(\FAULTINIT
  [LAMBDA NIL                                                (* ; "Edited 30-Mar-88 17:30 by Snow")

(* ;;; "retrieves some constants from Interface page for the swapper and performs other initialization that must happen immediately.  Called when starting up, and also when \FAULTHANDLER context starts, in case init hasn't happened yet, as e.g.  from MAKEINIT")

    (SETQ \MACHINETYPE (fetch MachineType of \InterfacePage))
    [PROG NIL
          (COND
             ((EQ \MACHINETYPE \MAIKO)
              (\MAIKO.FAULTINIT)
              (RETURN NIL)))
          (OR (NEQ (fetch FPTOVPStart of \InterfacePage)
                   0)
              (\MP.ERROR \MP.OBSOLETEVMEM "No FPTOVP"))
          (COND
             ((AND (NEQ 0 (fetch (IFPAGE FullSpaceUsed) of \InterfacePage))
                   (SELECTC \MACHINETYPE
                       (\DORADO NIL)
                       (\DANDELION (EQ 0 (fetch (IFPAGE DL24BitAddressable) of \InterfacePage
                                                )))
                       (\DAYBREAK NIL)
                       T))
              (\MP.ERROR \MP.32MBINUSE "Sysout contains virtual pages not addressable by machine"
                     )))
          (SETQ \LASTDIRTYSCANPTR)
          (SELECTC \MACHINETYPE
              (\DANDELION (\DL.FAULTINIT))
              (\DAYBREAK (\DOVE.FAULTINIT))
              (\D01.FAULTINIT))                          (* ; 
                                            "Have to set \EM.CURSORBITMAP before faults can happen")

     (* ;; "But you can't call \SETIOPOINTERS on a Daybreak until after the Dove IO Region is mapped, which happens in \DL.NEWFAULTINIT")

          (\SETIOPOINTERS)
          (COND
             ((IGREATERP (fetch (IFPAGE NActivePages) of \InterfacePage)
                     (IDIFFERENCE \LASTVMEMFILEPAGE \GUARDVMEMFULL))
                                                             (* ; "Vmem getting full!")
              (\SET.VMEM.FULL.STATE]
    (COND
       ((EQ (PROG1 \DOFAULTINIT (SETQ \DOFAULTINIT NIL))
            T)                                               (* ; 
                                              "true after \FLUSHVM.  Need to rebuild some contexts")
        (replace (IFPAGE KbdFXP) of \InterfacePage with (\MAKEFRAME
                                                                     (COND
                                                                        ((fetch (LITATOM CCODEP)
                                                                            of '\KEYHANDLER)
                                                                         (FUNCTION \KEYHANDLER))
                                                                        (T '\DUMMYKEYHANDLER))
                                                                     \KBDSTACKBASE
                                                                     (IPLUS \KBDSTACKBASE 
                                                                            \StackAreaSize)
                                                                     0 0))
        (replace (IFPAGE MiscFXP) of \InterfacePage with (\MAKEFRAME
                                                                      (FUNCTION \DOMISCAPPLY)
                                                                      \MISCSTACKBASE
                                                                      (IPLUS \MISCSTACKBASE 
                                                                             \StackAreaSize)
                                                                      0 0))
        T])

(\D01.FAULTINIT
  [LAMBDA NIL                                                (* bvm%: "20-Oct-86 18:19")
    (SETQ \VMEMACCESSFN (FUNCTION \M44ACTONVMEMFILE))
    (SETQ \REALPAGETABLE (fetch (IFPAGE REALPAGETABLEPTR) of \InterfacePage))

    (* ;; "Note: these SETQ's do not reference count, since the values are all smallp's and emulator addresses (in atom space)")

    (SETQ \RPOFFSET (SIGNED (fetch (IFPAGE RPOFFSET) of \InterfacePage)
                           BITSPERWORD))
    (SETQ \RPTSIZE (fetch (IFPAGE RPTSIZE) of \InterfacePage))
                                                             (* ; 
                                                "Initialize the software clocks from alto emulator")
    (\BLT (LOCF (fetch SECONDSCLOCK of \MISCSTATS))
          (EMADDRESS \RTCSECONDS)
          (UNFOLD 3 WORDSPERCELL))
    [SETQ \RCLKMILLISECOND (CONSTANT (OR (SMALLP \ALTO.RCLKMILLISECOND)
                                         (ERROR \ALTO.RCLKMILLISECOND 
                                                "\ALTO.RCLKMILLISECOND isn't a SMALLP???"]

(* ;;; "\ALTO.RCLKMILLISECOND must be a SMALLP here so as not to cause any refcnt or pagefault activity.  \RCLKSECOND is large and has to live on \MISCSTATS, since there is no convenient way to lock a random cell.")

    (SETQ.NOREF \RCLKSECOND (LOCF (fetch RCLKSECOND of \MISCSTATS)))

(* ;;; "Note the SETQ.NOREF for \RCLKSECOND in order to guarantee no refcnt'ing (which might pagefault) Note that these LOADBYTE expressions are compiled as constants")

    (replace (FIXP HINUM) of \RCLKSECOND with (LOADBYTE \ALTO.RCLKSECOND 16 16))
    (replace (FIXP LONUM) of \RCLKSECOND with (LOADBYTE \ALTO.RCLKSECOND 0 16))
    [COND
       ((AND (EQ \MACHINETYPE \DORADO)
             (ILEQ 5124 (fetch RVersion of \InterfacePage)))
        (replace NSHost0 of \InterfacePage with 0)
        (replace NSHost1 of \InterfacePage with 21898)
        (replace NSHost2 of \InterfacePage
           with (IPLUS (MASK.1'S 15 1)
                           (for I (N _ 0) from 1168 to 1175
                              do                         (* ; 
                           "Mufflers `2220Q' thru `2227Q' hold the bits of the basic serial number")
                                    [SETQ N (IPLUS (LLSH N 1)
                                                   (COND
                                                      ((BITTEST (RWMufMan I)
                                                              (MASK.1'S 15 1))
                                                       0)
                                                      (T 1] finally (RETURN N]
    (\CHAIN.UP.RPT)
    (\D01.ASSIGNBUFFERS])

(\D01.ASSIGNBUFFERS
  [LAMBDA NIL                                                (* bvm%: "20-Oct-86 18:21")
    (PROGN                                                   (* ; "Assign swap buffer")
           (SETQ \EMBUFVP (fetch (IFPAGE EMBUFVP) of \InterfacePage))
           (SETQ \EMBUFBASE (EMPOINTER (UNFOLD \EMBUFVP WORDSPERPAGE)))
           (SETQ \EMBUFRP (\READRP \EMBUFVP)))
    (PROG ((EMBUF (fetch (IFPAGE EMUBUFFERS) of \InterfacePage))
           (EMLEN (fetch (IFPAGE EMUBUFLENGTH) of \InterfacePage))
           EXTRALEN NPAGES)
          [add EMLEN (IDIFFERENCE EMBUF (SETQ EMBUF (CEIL EMBUF WORDSPERPAGE]
                                                             (* ; 
                                             "Round up to a page boundary and throw out the excess")
          (SETQ EXTRALEN (IMOD EMLEN WORDSPERPAGE))
          (add EXTRALEN (COND
                               ((ILESSP EXTRALEN 100)
                                (TIMES 2 WORDSPERPAGE))
                               (T WORDSPERPAGE)))
          (SETQ NPAGES (FOLDLO (SETQ EMLEN (IDIFFERENCE EMLEN EXTRALEN))
                              WORDSPERPAGE))
          (OR (IGEQ NPAGES 4)
              (RAID "No swap buffer space"))
          (SETQ \TELERAIDBUFFER (EMPOINTER EMBUF))
          (SETQ \EMUBUFFERS (\ADDBASE \TELERAIDBUFFER WORDSPERPAGE))
          (SETQ \#EMUBUFFERS (SETQ NPAGES (SUB1 NPAGES)))
          (SETQ \#SWAPBUFFERS (IMIN \MAXSWAPBUFFERS (IQUOTIENT NPAGES 2)))
          (SETQ \#DISKBUFFERS (IDIFFERENCE \#EMUBUFFERS \#SWAPBUFFERS))
          (SETQ \EMUDISKBUFFERS \EMUBUFFERS)
          (SETQ \EMUDISKBUFEND (\ADDBASE \EMUDISKBUFFERS (UNFOLD \#DISKBUFFERS WORDSPERPAGE)))
          (SETQ \EMUSWAPBUFFERS \EMUDISKBUFEND)
          (\INITBFS (\ADDBASE \EMUBUFFERS (UNFOLD NPAGES WORDSPERPAGE))
                 EXTRALEN T])

(\MAIKO.FAULTINIT
  [LAMBDA NIL                                                (* ; "Edited  2-Jan-93 12:25 by jds")
    (SETQ \VMEMACCESSFN (FUNCTION NILL))                     (* ; "This variable must be the name of function that may be ACTONVMEMFILE that may write back  from VP to FP. But , in Katana type, this function may be required (by tt)")
    (SETQ \IOCBPAGE (create POINTER
                           PAGE# _ \VP.IOCBS))

    (* ;; "MOVD all the Maiko-specific low-level functions onto their generic counterparts:")

    (\MAIKO.DO.MOVDS)
    (\MAIKO.NEWFAULTINIT)
    (SETQ \RCLKMILLISECOND 1000)
    (SETQ \RCLKSECOND 1000000)
    (\RCLK (LOCF (fetch BASECLOCK of \MISCSTATS)))   (* ; "Reset base clock ")
    (\PUTBASEPTR (LOCF (fetch SECONDSCLOCK of \MISCSTATS))
           0 NIL)                                            (* ; "Clear the seconds timer (by tt)")
    (\PUTBASEPTR (LOCF (fetch MILLISECONDSCLOCK of \MISCSTATS))
           0 NIL)                                            (* ; "Clear the milliseconds timer")
                                                             (* SETQ \LASTVMEMFILEPAGE
                                                           (fetch (IFPAGE DLLastVmemPage) of 
                                                           \InterfacePage))
    (\SETIOPOINTERS])

(\MAIKO.NEWFAULTINIT
  [LAMBDA NIL                                                (* ; 
                                                         "Edited 26-Feb-88 14:07 by Osamu Nakamura")

    (* ;; "We have just started up on a Katana.  Boot code (SYSOUT Loader) may map FP to VP(VP is same map to RP). Therefore, in this function, only done the initialization of the gloval variables (particularly, the variables about Buffers). And, there is not /REALPAGETABLE in Katana.")

    (PROG ((NBUFFERS (IDIFFERENCE \DLBUFFERPAGES 2)))        (* ; "Allocate buffers")
          (\MAIKO.ASSIGNBUFFERS (create POINTER
                                           PAGE# _ \VP.BUFFERS)
                 NBUFFERS])

(\MAIKO.ASSIGNBUFFERS
  [LAMBDA (BASE NPAGES)                                      (* ; 
                                                           "Edited 14-May-88 18:31 by JMTurn")
    (PROGN                                                   (* ; 
                    "Allocate a page to hold name and password, and perhaps other ephemeral things")
           (replace (IFPAGE UserNameAddr) of \InterfacePage with (\LOLOC (\ADDBASE BASE 1
                                                                                            )))
           (replace (IFPAGE UserPswdAddr) of \InterfacePage with (\LOLOC (\ADDBASE BASE 
                                                                                            33)))
           (SETQ BASE (\ADDBASE BASE WORDSPERPAGE))
           (add NPAGES -1))
    (PROGN                                                   (* ; "Assign swap buffer")
           (SETQ \EMBUFBASE BASE)
           (SETQ \EMBUFVP (fetch (POINTER PAGE#) of BASE))
           (SETQ \EMBUFRP \EMBUFVP)
           (SETQ BASE (\ADDBASE BASE WORDSPERPAGE))
           (add NPAGES -1))
    (PROGN                                                   (* ; "Assign ether buffers")
           (replace (IFPAGE MDSZoneLength) of \InterfacePage with (UNFOLD 2 WORDSPERPAGE)
                  )
           (replace (IFPAGE MDSZone) of \InterfacePage with (\LOLOC BASE))
           (SETQ BASE (\ADDBASE BASE (UNFOLD 2 WORDSPERPAGE)))
           (SETQ \TELERAIDBUFFER BASE)
           (SETQ BASE (\ADDBASE BASE WORDSPERPAGE))
           (add NPAGES -3))
    (PROGN                                                   (* ; "Divvy up buffer space")
           (SETQ \#SWAPBUFFERS (SETQ \#EMUBUFFERS NPAGES))
           (SETQ \#DISKBUFFERS 0)
           (SETQ \EMUSWAPBUFFERS (SETQ \EMUBUFFERS BASE])

(\M-VMEMSAVE
  [LAMBDA NIL                                                (* ; 
                                                           "Edited 20-Apr-88 10:28 by MASINTER")
    (PROG ((SCRATCHBUF \EMUSWAPBUFFERS))
          (replace (IFPAGE MISCSTACKRESULT) of \InterfacePage with T)
          [COND
             (\VMEM.PURE.LIMIT                               (* ; 
                                            "Maintaining file consistency: move high water mark up")
                    (COND
                       (VMEM.COMPRESS.FLG (\DOCOMPRESSVMEM)))
                    (SETQ \VMEM.PURE.LIMIT (fetch (IFPAGE NActivePages) of \InterfacePage]
          (COND
             ((.VMEM.CONSISTENTP.)
              (replace (IFPAGE Key) of \InterfacePage with (LOGNOT16 \IFPValidKey))
                                                             (* ; 
                                                 "Invalidate vmem and write out the Interface page")

              (* ;; "following form doesn't eval for KATANA (\TRANSFERPAGE IFPVP \FirstVmemBlock (RPTFROMRP (\READRP IFPVP)) T NIL)")

              ))
          (replace (IFPAGE Key) of \InterfacePage with \IFPValidKey)
          (\BLT SCRATCHBUF \InterfacePage WORDSPERPAGE)      (* ; 
                              "Make its current fx point at user context, i.e.  the \FLUSHVM frame")
          (replace (IFPAGE CurrentFXP) of SCRATCHBUF with (fetch (IFPAGE MiscFXP)
                                                                         of \InterfacePage))
          (SUBRCALL VMEMSAVE)
          (RETURN NIL])

(\MAIKO.NEWPAGE
  [LAMBDA (BASE NOERROR LOCK?)                               (* ; 
                                                           "Edited 20-Apr-88 10:28 by MASINTER")
    (SUBRCALL NEWPAGE BASE])
)



(* ;; 
"For setting up (and maybe eventually removing?) MAIKO-specific versions of the generic low-levle functions:"
)

(DEFINEQ

(\MAIKO.DO.MOVDS
  [LAMBDA NIL                                                (* ; 
                                                      "Edited  2-Nov-92 03:57 by sybalsky:mv:envos")

    (* ;; "MOVD all the Maiko-specific low-level functions onto their generic counterparts.  This function is called from \MAIKO.FAULTINIT when the system is started up, and called explicitly during the LOADUP process to get everything in a state to run the ethernet.")

    (* ;; "THIS IS WHERE CHANGES SHOULD HAPPEN TO MAKE SUN LOADUPS RUN ON D-MACHINES (BY ADDING A \MAIKO.UNDO.MOVDS CALL AT VMEM SAVING TIME, AND ADDING A SYBMOL TO SAVE THE GENERIC DEFINITION ON TO THE MOVDS LIST.")

    (FOR PAIR IN \MAIKO.MOVDS DO 

                                 (* ;; "This is like MOVD, but absolutely no consing is done, frame names are not changed, etc.  So that no CONSING happens before all the MOVDs are finished -- prevents new-page allocation.")

                                            (LET [(FROMCELL (fetch (LITATOM DEFINITIONCELL)
                                                               of (CAR PAIR)))
                                                  (TOCELL (fetch (LITATOM DEFINITIONCELL)
                                                             of (CADR PAIR]
                                                 (UNINTERRUPTABLY
                                                     (replace (DEFINITIONCELL DEFPOINTER)
                                                        of TOCELL with (fetch
                                                                                (DEFINITIONCELL
                                                                                 DEFPOINTER)
                                                                                  of FROMCELL))
                                                     (replace (DEFINITIONCELL DEFCELLFLAGS)
                                                        of TOCELL with (fetch
                                                                                (DEFINITIONCELL
                                                                                 DEFCELLFLAGS)
                                                                                  of FROMCELL))
                                                     (replace (DEFINITIONCELL AUXDEFCELLFLAGS)
                                                        of TOCELL with (fetch
                                                                                (DEFINITIONCELL
                                                                                 AUXDEFCELLFLAGS)
                                                                                  of FROMCELL)))])
)

(ADDTOVAR \MAIKO.MOVDS
          (TRUE \LOCKEDPAGEP)
          (\MAIKO.NEWPAGE \NEWPAGE)
          (\MAIKO.NEWPAGE \DONEWPAGE)
          (NILL \LOCKPAGES)
          (NILL \DOLOCKPAGES)
          (NILL \DOTEMPLOCKPAGES)
          (NILL \TEMPUNLOCKPAGES)
          (NILL \UNLOCKPAGES)
          (NILL \WRITEDIRTYPAGE)
          (NILL \DIRTYBACKGROUND)
          (ZERO \COUNTREALPAGES)
          (NILL \SHOWPAGETABLE)
          (NILL CHECKPAGEMAP)
          (EVQ \PAGEFAULT)
          (EVQ \LOADVMEMPAGE)
          (NILL \LOADVMEMPAGE)
          (TRUE \MOVEVMEMFILEPAGE)
          (TRUE \VALIDADDRESSP))
(DEFINEQ

(\DOVE.FAULTINIT
  [LAMBDA NIL                                                (* ; "Edited 18-Sep-87 16:01 by bvm:")
    (DECLARE (GLOBALVARS \RCLKMILLISECOND \RCLKSECOND))
    (SETQ \VMEMACCESSFN (FUNCTION \DOVE.ACTONVMEMFILE))
    (SETQ \IOCBPAGE (create POINTER
                           PAGE# _ \VP.IOCBS))
    (COND
       ((NOT (.VMEM.CONSISTENTP.))
        (\MP.ERROR \MP.INVALIDVMEM)))
    (SETMAINTPANEL 1188)
    (\DL.NEWFAULTINIT)
    (SETMAINTPANEL 1189)
    (SETQ \RCLKMILLISECOND \DOVE.RCLKMILLISECOND)
    (SETQ.NOREF \RCLKSECOND (LOCF (fetch RCLKSECOND of \MISCSTATS)))
                                                             (* ; 
                                                    "Unfortunately, \DOVE.RCLKSECOND is not smallp")
    (replace (FIXP HINUM) of \RCLKSECOND with (CONSTANT (\HINUM \DOVE.RCLKSECOND)))
    (replace (FIXP LONUM) of \RCLKSECOND with (CONSTANT (\LONUM \DOVE.RCLKSECOND)))
    (\RCLK (LOCF (fetch BASECLOCK of \MISCSTATS)))   (* ; "Reset base clock")
    (\DoveMisc.ReadGMT (LOCF (fetch SECONDSCLOCK of \MISCSTATS)))
    (SETMAINTPANEL 1190)
    (\PUTBASEPTR (LOCF (fetch MILLISECONDSCLOCK of \MISCSTATS))
           0 NIL)                                            (* ; "Clear the milliseconds timer")
    (\DoveMisc.ReadHostID (LOCF (fetch NSHost0 of \InterfacePage)))
    (SETMAINTPANEL 1191)
    [SETQ \LASTVMEMFILEPAGE (COND
                               (NIL                          (* ; "For now, don't assume vmem is any bigger than the part in use now.  Local file system init will set it to the truth.")
                                    (SETQ \VMEM.FULL.STATE 0)(* ; "Flag to keep pages from being written off the end.  Setting it now prevents bogus vmem full interrupt at startup time.")
                                    (fetch (IFPAGE NActivePages) of \InterfacePage))
                               (T                            (* ; 
                                                           "Microcode is supposed to fill this in")
                                  (fetch (IFPAGE DLLastVmemPage) of \InterfacePage]
    (\DoveDisk.Init)
    (SETMAINTPANEL 1192)
    (\DoveDisplay.TurnOn])

(\DL.FAULTINIT
  [LAMBDA NIL                                                (* bvm%: "20-Oct-86 18:22")
    (SETQ \VMEMACCESSFN (FUNCTION \DL.ACTONVMEMFILE))
    (SETQ \IOCBPAGE (create POINTER
                           PAGE# _ \VP.IOCBS))
    (COND
       ((NOT (.VMEM.CONSISTENTP.))
        (\MP.ERROR \MP.INVALIDVMEM)))
    (\DL.NEWFAULTINIT)
    (SETQ \RCLKMILLISECOND \DLION.RCLKMILLISECOND)           (* ; 
                                                           "These are fortunately both small")
    (SETQ \RCLKSECOND \DLION.RCLKSECOND)
    (\RCLK (LOCF (fetch BASECLOCK of \MISCSTATS)))   (* ; "Reset base clock")
    [COND
       ((EQ (fetch DLTODVALID of \IOPAGE)
            0)                                               (* ; 
                                                       "Time not valid, so store zero in the clock")
        (\PUTBASEPTR (LOCF (fetch SECONDSCLOCK of \MISCSTATS))
               0 NIL))
       (T (bind TMP (BASE _ (LOCF (fetch SECONDSCLOCK of \MISCSTATS)))
             do                                          (* ; 
                        "Loop until clock reads the same as we wrote, in case it was being updated")
                   (\PUTBASE BASE 1 (SETQ TMP (fetch DLTODLO of \IOPAGE)))
                   (\PUTBASE BASE 0 (fetch DLTODHI of \IOPAGE))
             repeatuntil (EQ (fetch DLTODLO of \IOPAGE)
                                 TMP]
    (\PUTBASEPTR (LOCF (fetch MILLISECONDSCLOCK of \MISCSTATS))
           0 NIL)                                            (* ; "Clear the milliseconds timer")
    (repeatwhile (IGEQ (fetch DLPROCESSORCMD of \IOPAGE)
                           \DL.PROCESSORBUSY))               (* ; "Wait for IOP readiness")
    (replace DLPROCESSORCMD of \IOPAGE with \DL.READPID)
                                                             (* ; 
                                                        "Ask it to give the processor ID (3 words)")
    (repeatwhile (IGEQ (fetch DLPROCESSORCMD of \IOPAGE)
                           \DL.PROCESSORBUSY))
    (replace NSHost0 of \InterfacePage with (fetch DLPROCESSOR0 of \IOPAGE))
    (replace NSHost1 of \InterfacePage with (fetch DLPROCESSOR1 of \IOPAGE))
    (replace NSHost2 of \InterfacePage with (fetch DLPROCESSOR2 of \IOPAGE))
    (SETQ \LASTVMEMFILEPAGE (fetch (IFPAGE DLLastVmemPage) of \InterfacePage))
    (\DL.DISKINIT T])

(\DL.NEWFAULTINIT
  [LAMBDA NIL                                                (* ; "Edited 21-Oct-87 15:40 by bvm:")

    (* ;; "We have just started up on a DLion or Daybreak.  Boot code has loaded the first n pages of the sysout into pages 2 thru n-3, except for the area covered by the map and IO page, and has built the map accordingly.  Our principal task is to build \REALPAGETABLE")

    (PROG ((NREALPAGES (fetch (IFPAGE NRealPages) of \InterfacePage))
           (FIRSTBUFFERRP \RP.STARTBUFFERS)
           (SCRATCHVP \VP.INITSCRATCH)
           (SCRATCHBASE (create POINTER
                               PAGE# _ \VP.INITSCRATCH))
           FIRSTUSEFULRP IFPAGERP IOCBRP RPTBASE VP RPTPAGES FIRSTRP NDISPLAYPAGES)
          [do (COND
                     ((for I from 0 to (SUB1 \DLBUFFERPAGES)
                         as (FPBASE _ (\ADDBASE \FPTOVP (DLFPFROMRP FIRSTBUFFERRP)))
                         by (\ADDBASE FPBASE 1)
                         do (COND
                                   ([OR (NOT (fetch FPOCCUPIED of FPBASE))
                                        (\LOCKEDPAGEP (SETQ VP (fetch FPVIRTUALPAGE
                                                                      of FPBASE]

                                    (* ;; "Can't use as buffer.  This is just a check for consistency;  you should pick \RP.STARTBUFFERS so that this isn't a problem")

                                    (RETURN T)))             (* ; 
                                                     "Unmap this page so we can use it for buffers")
                               (\WRITEMAP VP 0 \VMAP.VACANT))(* ; "Bad starting place, try again")
                      (add FIRSTBUFFERRP 1))
                     (T (RETURN]
          (SETQ FIRSTUSEFULRP (+ FIRSTBUFFERRP \DLBUFFERPAGES))
          (PROGN                                             (* ; 
                                                      "Copy vital info that booting left in page 1")
                 [COND
                    ((EQ \MACHINETYPE \DAYBREAK)

                     (* ;; "Use first buffer page for IOCB page.  Used to have to place this in a real page whose page-in-segment number was the same as that of \VP.IOCBS, but that constraint is now lifted for Daybreak.")

                     (SETQ IOCBRP FIRSTBUFFERRP)
                     (add FIRSTBUFFERRP 1))
                    (T (SETQ IOCBRP (+ (LOGAND (SUB1 (IMIN NREALPAGES 3072))
                                              65280)
                                       \VP.IOCBS))

                       (* ;; "Put IOCB page near the end of memory, but in the first 1.5 mb so that Burdock can see it.  Temporary until Steve fixes swap code to not care what RP contains IOCB's")

                       [SETQ VP (fetch FPVIRTUALPAGE of (\ADDBASE \FPTOVP (DLFPFROMRP IOCBRP]
                       (COND
                          ((\LOCKEDPAGEP VP)
                           (\MP.ERROR \MP.IOCBPAGE))
                          (T                                 (* ; 
                                                           "Unmap whoever lived in our target page")
                             (\WRITEMAP VP 0 \VMAP.VACANT]
                 (\WRITEMAP \VP.IOCBS IOCBRP \VMAP.CLEAN)
                 (\WRITEMAP SCRATCHVP 1 \VMAP.CLEAN)
                 (\BLT \IOCBPAGE SCRATCHBASE WORDSPERPAGE))
          (PROGN                                             (* ; 
                                                           "Copy InterfacePage out of segment zero")
                 (\WRITEMAP SCRATCHVP FIRSTBUFFERRP \VMAP.CLEAN)
                 (\BLT SCRATCHBASE \InterfacePage WORDSPERPAGE)
                 (\WRITEMAP \VP.IFPAGE (SETQ IFPAGERP FIRSTBUFFERRP)
                        \VMAP.CLEAN)
                 (add FIRSTBUFFERRP 1))
          [PROGN                                             (* ; 
                                                "Unmap everything that fell somewhere we can't use")
                 (\DL.UNMAPPAGES (ADD1 \FP.IFPAGE)
                        (DLFPFROMRP \RP.IOPAGE))             (* ; 
                                                           "real segment zero, map or IOPAGE")
                 (COND
                    ((EQ \MACHINETYPE \DANDELION)
                     (for NEXTBANK0 from 2MBPAGES by 2MBPAGES
                        until (> NEXTBANK0 NREALPAGES) do 

                                           (* ;; "All the `shadows of the display bank' in higher memory have restricted use;  take them out of commission for now")

                                                                 (\DL.UNMAPPAGES NEXTBANK0
                                                                        (+ NEXTBANK0 PAGESPERSEGMENT
                                                                           -1]
          (PROGN                                             (* ; "Copy Display into segment zero")
                 [SETQ NDISPLAYPAGES (COND
                                        ((EQ \MACHINETYPE \DANDELION)

                                 (* ;; "Only lock the standard screen's worth of pages on DLion, even if there are more because the sysout came from wide Daybreak.  Only this many need to be in the display bank, besides which there is a cursor bank after the display;  the rest can be vanilla locked pages.")

                                         \NP.DISPLAY)
                                        (T (IMAX \NP.DISPLAY (ADD1 \MaxScreenPage]
                                                             (* ; 
                                                     "Number of display pages in use in this image")
                 (for I from 0 to (SUB1 NDISPLAYPAGES)
                    do (\WRITEMAP (+ SCRATCHVP I)
                                  (+ \RP.DISPLAY I)
                                  \VMAP.CLEAN))              (* ; 
                                                          "Point scratch area at real segment zero")
                 (\BLT SCRATCHBASE (create POINTER
                                          PAGE# _ \VP.DISPLAY)
                       (UNFOLD NDISPLAYPAGES WORDSPERPAGE))  (* ; 
                                                           "Copy display from wherever boot put it")
                 (for I from 0 to (SUB1 NDISPLAYPAGES)
                    do (\WRITEMAP (+ SCRATCHVP I)
                                  0 \VMAP.VACANT)
                          (\WRITEMAP (+ \VP.DISPLAY I)
                                 (+ \RP.DISPLAY I)
                                 \VMAP.CLEAN))               (* ; 
                                        "Display is now where hardware wants it, so enable display")
                 (replace (IOPAGE DLDISPCONTROL) of \IOPAGE with 0))
          (COND
             ((EQ \MACHINETYPE \DAYBREAK)                    (* ; 
   "If on a daybreak, map the I/O region.  Have to do this before calling \DoveDisplay.ScreenWidth")
              (for I from 0 to (SUB1 \DOVEIORGNSIZE) do (\WRITEMAP (+ \VP.DOVEIORGN I
                                                                                      )
                                                                               (+ \RP.DOVEIORGN I)
                                                                               \VMAP.CLEAN))
              (\DoveIO.InitializeIORegionPtrs)))
          [PROG ((RPSIZE (- NREALPAGES (SETQ \RPOFFSET -1)))
                 (FIRSTVP \VP.RPT))
                (SETQ FIRSTRP (COND
                                 ((OR (> NDISPLAYPAGES \NP.DISPLAY)
                                      (AND (EQ \MACHINETYPE \DAYBREAK)
                                           (EQ (\DoveDisplay.ScreenWidth)
                                               \WIDEDOVEDISPLAYWIDTH)))

                                  (* ;; "Sysout was made on a large screen daybreak, or is now being run on one.  Need to make sure there is space for all that display")

                                  \RP.AFTERDOVEDISPLAY)
                                 (T \RP.AFTERDISPLAY)))      (* ; 
                                      "Construct real page table in segment zero after the display")
                [COND
                   ((> RPSIZE (CONSTANT (EXPT 2 15)))        (* ; 
        "We only have 15 bits for real page table numbers, so have to sacrifice the rest of memory")
                    (SETQ RPSIZE (CONSTANT (EXPT 2 15]
                [SETQ RPTPAGES (PROGN 

                                 (* ;; "This is a way of computing (FOLDHI RPSIZE*3 WORDSPERPAGE) that won't overflow when memory exceeds 10.6MB -- the first term computes RPSIZE*3/256, the second performs the FOLDHI directly on the now much smaller remainder.")

                                      (+ (TIMES3 (FOLDLO RPSIZE WORDSPERPAGE))
                                         (FOLDHI (TIMES3 (IMOD RPSIZE WORDSPERPAGE))
                                                WORDSPERPAGE]
                (COND
                   ((> (+ RPTPAGES FIRSTRP)
                       PAGESPERSEGMENT)

                    (* ;; "No space in bank zero, so put RPT in first segment after 2 megabytes, where the first `shadow' display bank lives.  No shadow bank on Daybreak, but this is as good a place as any")

                    (SETQ FIRSTRP (IMIN 2MBPAGES (- NREALPAGES RPTPAGES)))
                                                             (* ; 
                            "IMIN because we could be on a wide-display Daybreak with small memory")
                    [COND
                       ((> (+ FIRSTVP RPTPAGES)
                           \VP.BUFFERS)                      (* ; 
                                                   "Move virtual assignment backwards if necessary")
                        (SETQ FIRSTVP (COND
                                         ((< RPTPAGES \VP.BUFFERS)
                                          (- \VP.BUFFERS RPTPAGES))
                                         ((<= RPTPAGES PAGESPERSEGMENT)
                                                             (* ; 
                      "Can't fit real page table in display bank at all, so overlap smallneg space")
                                          (UNFOLD \SmallNegHi PAGESPERSEGMENT))
                                         (T                  (* ; 
                                    "Ack, more than 10.6 MB, have to slop over into smallpos space")
                                            (- (+ (UNFOLD \SmallNegHi PAGESPERSEGMENT)
                                                  PAGESPERSEGMENT)
                                               RPTPAGES]
                    (\DL.UNMAPPAGES (DLFPFROMRP FIRSTRP)
                           (DLFPFROMRP (+ FIRSTRP RPTPAGES -1)))
                                                             (* ; 
"Unmap the pages in which RPT lives.  This was already done on DLion, but can't hurt to do it again")
                    ))
                (for I from 0 to (SUB1 RPTPAGES) do 
                                                             (* ; 
                                                           "Assign pages to real page table now")
                                                                   (\WRITEMAP (+ FIRSTVP I)
                                                                          (+ FIRSTRP I)
                                                                          \VMAP.CLEAN))
                (SETQ \REALPAGETABLE (create POINTER
                                            PAGE# _ FIRSTVP))
                (\CLEARWORDS \REALPAGETABLE RPSIZE)
                (\CLEARWORDS (\ADDBASE \REALPAGETABLE RPSIZE)
                       RPSIZE)
                (\CLEARWORDS (\ADDBASE (\ADDBASE \REALPAGETABLE RPSIZE)
                                    RPSIZE)
                       RPSIZE)                               (* ; 
                                  "Clear table in three steps, since 3*RPSIZE overflows after 10MB")
                (SETQ \RPTSIZE RPSIZE)
                (COND
                   [(EQ \MACHINETYPE \DANDELION)
                    (for NEXTBANK0 from 2MBPAGES by 2MBPAGES
                       until (> NEXTBANK0 NREALPAGES) do 
                                                             (* ; 
                                                   "Mark the shadow display bank pages unavailable")
                                                                (\DL.MARK.PAGES.UNAVAILABLE
                                                                 NEXTBANK0
                                                                 (+ NEXTBANK0 PAGESPERSEGMENT -1]
                   (T 
                      (* ;; "RPT itself occupies unavailable pages;  on DLion these were marked unavailable either in segment zero after display or as part of shadow bank")

                      (\DL.MARK.PAGES.UNAVAILABLE FIRSTRP (+ FIRSTRP RPTPAGES -1))
                                                             (* ; 
                                                           "Also, Dove IO region is unavailable")
                      (\DL.MARK.PAGES.UNAVAILABLE \RP.DOVEIORGN (SUB1 (+ \RP.DOVEIORGN 
                                                                             \DOVEIORGNSIZE]
          (PROGN 
                 (* ;; "Fill in special cases in RPT -- the display, which is not where FPTOVP says it is, and all the pages that are unavailable for one reason or another.  Note: any page marked unavailable here MUST be unmapped by now, either because booting never put it where FPTOVP says it would be, there's no page there to begin with, or there's an explicit call to \WRITEMAP or \DL.UNMAPPAGES to unmap it above")

                 (SETQ RPTBASE \REALPAGETABLE)
                 [for I from 0 to (SUB1 NDISPLAYPAGES)
                    do (SETQ RPTBASE (\ADDBASE RPTBASE \RPTENTRYLENGTH)) 
                                                             (* ; "Fill in Display pages")
                          (replace (RPT VP) of RPTBASE with (+ \VP.DISPLAY I))
                          (replace (RPT FILEPAGE) of RPTBASE with (DLFPFROMRP
                                                                               (+ \RP.TEMPDISPLAY I]
                 (\DL.MARK.PAGES.UNAVAILABLE NDISPLAYPAGES \RP.IOPAGE)
                                                             (* ; 
                                        "Mark rest of segment zero plus Map and IOPAGE unavailable")
                 )
          [PROGN                                             (* ; 
                                                       "fill in main part of RPT by reading FPTOVP")
                 (for I from (ADD1 \RP.IOPAGE) to (SUB1 NREALPAGES)
                    as [FPBASE _ (\ADDBASE \FPTOVP (DLFPFROMRP (ADD1 \RP.IOPAGE]
                    by (\ADDBASE FPBASE 1) as [RPTBASE _ (fetch RPTRBASE
                                                                    of (RPTFROMRP (ADD1 
                                                                                           \RP.IOPAGE
                                                                                            ]
                    by (\ADDBASE RPTBASE \RPTENTRYLENGTH)
                    bind (LASTREALPAGE _ (DLRPFROMFP (fetch (IFPAGE NActivePages)
                                                            of \InterfacePage)))
                    do 

                          (* ;; "Fill in rest of RPT from \FPTOVP.  Could optimize this a little by special casing the area occupied by the display, but this is simpler")

                          (COND
                             ((fetch (RPT UNAVAILABLE) of RPTBASE))
                             ((AND (<= I LASTREALPAGE)
                                   (fetch FPOCCUPIED of FPBASE)
                                   [NOT (fetch (VMEMFLAGS VACANT)
                                           of (\READFLAGS (SETQ VP (fetch FPVIRTUALPAGE
                                                                          of FPBASE]
                                   (EQ I (\READRP VP)))

                              (* ;; "There is a VP assigned to this filepage, and it is still there.  False for display that got moved and any real pages that didn't get filled.  LASTREALPAGE is in case the real memory is larger than the sysout -- FPTOVP does not exist all the way")

                              (replace (RPT VP) of RPTBASE with VP)
                              (replace (RPT FILEPAGE) of RPTBASE with (DLFPFROMRP I)))
                             (T (replace (RPT EMPTY) of RPTBASE with T]
          (PROGN                                             (* ; 
                                                           "Touch up RPT with the exceptions")
                 (SETQ RPTBASE (fetch RPTRBASE of (RPTFROMRP IFPAGERP)))
                                                             (* ; "Interface Page")
                 (replace (RPT VP) of RPTBASE with \VP.IFPAGE)
                 (replace (RPT FILEPAGE) of RPTBASE with \FP.IFPAGE)
                 (replace (RPT UNAVAILABLE) of (fetch RPTRBASE of (RPTFROMRP IOCBRP))
                    with T)                              (* ; "\IOCBPAGE")
                 (\DL.MARK.PAGES.UNAVAILABLE FIRSTBUFFERRP (SUB1 FIRSTUSEFULRP))
                                                             (* ; 
                                                           "buffer pages unavailable to swapper")
                 )
          (\CHAIN.UP.RPT)
          (PROG ((NBUFFERS (- FIRSTUSEFULRP FIRSTBUFFERRP))) (* ; "Allocate buffers")
                (for I from 0 to (SUB1 NBUFFERS) do (\WRITEMAP (+ \VP.BUFFERS I)
                                                                           (+ FIRSTBUFFERRP I)
                                                                           \VMAP.CLEAN))
                (\DL.ASSIGNBUFFERS (create POINTER
                                              PAGE# _ \VP.BUFFERS)
                       NBUFFERS])

(\DL.UNMAPPAGES
  [LAMBDA (FIRSTFP LASTFP)                                   (* bvm%: "14-Jan-84 14:20")

(* ;;; 
"At initialization time, unmap anything that originally lived in filepages FIRSTFP thru LASTFP")

    (for FP from FIRSTFP to LASTFP as (FPBASE _ (\ADDBASE \FPTOVP FIRSTFP))
       by (\ADDBASE FPBASE 1) when (fetch FPOCCUPIED of FPBASE)
       do (\WRITEMAP (fetch FPVIRTUALPAGE of FPBASE)
                     0 \VMAP.VACANT])

(\DL.MARK.PAGES.UNAVAILABLE
  [LAMBDA (FIRSTRP LASTRP)                                   (* bvm%: "14-Jan-84 14:32")
    (for I from FIRSTRP to LASTRP as (RPTBASE _ (fetch RPTRBASE
                                                                   of (RPTFROMRP FIRSTRP)))
       by (\ADDBASE RPTBASE \RPTENTRYLENGTH) do (replace (RPT UNAVAILABLE) of RPTBASE
                                                           with T])

(\DL.ASSIGNBUFFERS
  [LAMBDA (BASE NPAGES)                                      (* bvm%: "29-Jan-85 19:05")
    (PROGN                                                   (* ; 
                    "Allocate a page to hold name and password, and perhaps other ephemeral things")
           (\CLEARWORDS BASE WORDSPERPAGE)
           (replace (IFPAGE UserNameAddr) of \InterfacePage with (\LOLOC (\ADDBASE BASE 1
                                                                                            )))
           (replace (IFPAGE UserPswdAddr) of \InterfacePage with (\LOLOC (\ADDBASE BASE 
                                                                                            33)))
           (SETQ BASE (\ADDBASE BASE WORDSPERPAGE))
           (add NPAGES -1))
    (PROGN                                                   (* ; "Assign swap buffer")
           (SETQ \EMBUFBASE BASE)
           (SETQ \EMBUFVP (fetch (POINTER PAGE#) of BASE))
           (SETQ \EMBUFRP (\READRP \EMBUFVP))
           (SETQ BASE (\ADDBASE BASE WORDSPERPAGE))
           (add NPAGES -1))
    (PROGN                                                   (* ; "Assign ether buffers")
           (replace (IFPAGE MDSZoneLength) of \InterfacePage with (UNFOLD 2 WORDSPERPAGE)
                  )
           (replace (IFPAGE MDSZone) of \InterfacePage with (\LOLOC BASE))
           (SETQ BASE (\ADDBASE BASE (UNFOLD 2 WORDSPERPAGE)))
           (SETQ \TELERAIDBUFFER BASE)
           (SETQ BASE (\ADDBASE BASE WORDSPERPAGE))
           (add NPAGES -3))
    (PROGN                                                   (* ; "Divvy up buffer space")
           (SETQ \#SWAPBUFFERS (SETQ \#EMUBUFFERS NPAGES))
           (SETQ \#DISKBUFFERS 0)
           (SETQ \EMUSWAPBUFFERS (SETQ \EMUBUFFERS BASE])

(\CHAIN.UP.RPT
  [LAMBDA NIL                                                (* bvm%: "18-Dec-84 16:07")

(* ;;; "Maps over the Real Page Table as constructed so far and fleshes it out.  Assumes that the table is built, has all its VP and FILEPAGE entries set, and that the empty and unavailable entries are so marked.  Finishes the job by chaining together the available pages and setting the LOCKED bits")

    (PROG ((RPTBASE \REALPAGETABLE)
           (LASTEMPTY \REALPAGETABLE)
           (LASTUSED (\ADDBASE \REALPAGETABLE 1))
           FIRSTUSED)
          (SETQ FIRSTUSED LASTUSED)

     (* ;; "The `entry' \REALPAGETABLE is a dummy that points to the least recently used entry.  We use the second word of that dummy as a temporary chain head for the used pages, so that we can put all the empty pages at the front of the queue.")

          [for I from 1 to (SUB1 \RPTSIZE)
             do (SETQ RPTBASE (\ADDBASE RPTBASE \RPTENTRYLENGTH))
                   (COND
                      ((fetch (RPT UNAVAILABLE) of RPTBASE))
                      ((fetch (RPT EMPTY) of RPTBASE)
                       (replace (RPT NEXTRP) of LASTEMPTY with I)
                       (replace (RPT LOCKED) of RPTBASE with NIL)
                       (SETQ LASTEMPTY RPTBASE))
                      (T (replace (RPT NEXTRP) of LASTUSED with I)
                         (replace (RPT LOCKED) of RPTBASE with (\LOCKEDPAGEP
                                                                            (fetch (RPT VP)
                                                                               of RPTBASE)))
                         (SETQ LASTUSED RPTBASE]             (* ; 
                                    "Finally, link the end of empty chain to front of in use chain")
          (replace (RPT NEXTRP) of LASTEMPTY with (fetch (RPT NEXTRP) of 
                                                                                            FIRSTUSED
                                                                     ))
          (replace (RPT NEXTRP) of (SETQ \RPTLAST LASTUSED) with \PAGETABLESTOPFLG)
          (replace (RPT UNAVAILABLE) of \REALPAGETABLE with T)
                                                             (* ; "Dummy first entry")
      ])
)



(* ; "Pagefault handler")

(DEFINEQ

(\FAULTHANDLER
  [LAMBDA NIL                                                (* ; "Edited 27-Sep-88 00:47 by jds")
    (PROG NIL
      LP  [OR (AND \DOFAULTINIT (\FAULTINIT))
              (\PAGEFAULT (\VAG2 (LOGAND 255 (fetch (IFPAGE FAULTHI) of \InterfacePage))
                                     (fetch (IFPAGE FAULTLO) of \InterfacePage]
          (\CONTEXTSWITCH \FAULTFXP)
          (GO LP])

(\PAGEFAULT
  [LAMBDA (PTR)                                              (* bvm%: "13-Aug-85 16:38")
    (\CLOCK0 (LOCF (fetch SWAPTEMP0 of \MISCSTATS))) (* ; "Note time of start")
    (PROG ((VP (fetch (POINTER PAGE#) of PTR))
           FLAGS FILEPAGE)
          (COND
             ((fetch (VP INVALID) of VP)             (* ; 
      "Map out of bounds on Dolphin always produces -1 as the vp.  Don't know about other machines")
              (\MP.ERROR \MP.MOB "Page Fault: Map out of bounds" (AND (NEQ VP 65535)
                                                                          PTR)
                     T))
             ([NOT (fetch (VMEMFLAGS VACANT) of (SETQ FLAGS (\READFLAGS VP]
              (\MP.ERROR \MP.RESIDENT "Fault on resident page" PTR T))
             ((EQ (SETQ FILEPAGE (\LOOKUPPAGEMAP VP))
                  0)
              (\INVALIDADDR PTR))
             (T (COND
                   ((EQ (\HILOC PTR)
                        \STACKHI)                            (* ; 
                                                           "should never happen.  For debugging")
                    (\MP.ERROR \MP.STACKFAULT "Fault on stack" PTR T)))
                (\LOADVMEMPAGE VP FILEPAGE)))
          (COND
             (\NEWVMEMPAGEADDED                              (* ; 
                                                           "Only happens if VMEM.PURE.STATE on")
                    (\ASSURE.FPTOVP.PAGE)))
          [\BOXIPLUS (LOCF (fetch SWAPWAITTIME of \MISCSTATS))
                 (\BOXIDIFFERENCE (\CLOCK0 (LOCF (fetch SWAPTEMP1 of \MISCSTATS)))
                        (LOCF (fetch SWAPTEMP0 of \MISCSTATS]
                                                             (* ; "Count the time used.")
          (RETURN PTR])

(\INVALIDADDR
  [LAMBDA (ADDR)                                             (* bvm%: " 6-AUG-83 22:25")
    (\MP.ERROR \MP.INVALIDADDR "Invalid address" ADDR T])

(\INVALIDVP
  [LAMBDA (VP)                                               (* bvm%: " 6-AUG-83 22:25")
    (\MP.ERROR \MP.INVALIDVP "Invalid VP" VP])

(\FLUSHPAGE
  [LAMBDA (RPTINDEX FROMFLUSHVM)                             (* bvm%: "13-Aug-85 16:35")

(* ;;; "Write out real page RPTINDEX if it is dirty.")

    (PROG ((RPTR (fetch RPTRBASE of RPTINDEX))
           VP FP NEWFP)
          (COND
             ([AND (fetch (RPT OCCUPIED) of RPTR)
                   (fetch (VMEMFLAGS DIRTY) of (\READFLAGS (SETQ VP (fetch (RPT VP)
                                                                               of RPTR]
                                                             (* ; "Yes, page is dirty")
              (SETQ FP (fetch (RPT FILEPAGE) of RPTR))
              [COND
                 [(AND \VMEM.PURE.LIMIT (NOT FROMFLUSHVM))   (* ; 
                                "Don't sully vmem;  write page out beyond the original end of vmem")
                  (COND
                     ((ILEQ FP \VMEM.PURE.LIMIT)
                      (COND
                         ((fetch (RPT LOCKED) of RPTR)
                          (\MP.ERROR \MP.WRITING.LOCKED.PAGE)))
                      (SETQ NEWFP (add (fetch NActivePages of \InterfacePage)
                                         1))
                      (COND
                         ((IGREATERP NEWFP (IDIFFERENCE \LASTVMEMFILEPAGE \GUARDVMEMFULL))
                          (\SET.VMEM.FULL.STATE)))
                      (SETQ \NEWVMEMPAGEADDED T)
                      (\PUTBASE (.PAGEMAPBASE. VP)
                             0 NEWFP)
                      (\PUTBASE \FPTOVP NEWFP VP)
                      (\PUTBASE \FPTOVP FP \NO.VMEM.PAGE)
                      (replace (RPT FILEPAGE) of RPTR with (SETQ FP NEWFP]
                 ((.VMEM.CONSISTENTP.)
                  (replace (IFPAGE Key) of \InterfacePage with (LOGNOT16 \IFPValidKey))
                                                             (* ; 
                                                 "Invalidate vmem and write out the Interface page")
                  (SETQ \DIRTYPAGEHINT 0)                    (* ; 
                                                "So that the dirty page background writer wakes up")
                  (PROG ((IFVP (fetch (POINTER PAGE#) of \InterfacePage)))
                        (\TRANSFERPAGE IFVP \FirstVmemBlock (RPTFROMRP (\READRP IFVP))
                               T NIL]                        (* ; "Write it out")
              (COND
                 ((IGREATERP \DIRTYPAGEHINT 0)
                  (add \DIRTYPAGEHINT -1)))
              (\TRANSFERPAGE VP FP RPTINDEX T NIL])

(\LOADVMEMPAGE
  [LAMBDA (VPAGE FILEPAGE NEWPAGEFLG LOCK? DONTMOVETOPFLG)   (* bvm%: "10-Aug-85 18:08")

    (* ;; "Fault in virtual page VPAGE known to live in FILEPAGE on the vmem.  NEWPAGEFLG is true if the page is new, so should just be cleared, not loaded from vmem file.  If LOCK?  is true, locks down the page as well.  In this case, if on Dandelion, we also check for page wanting to live in a particular real page.  If DONTMOVETOPFLG is true, the real page we put this page in is not promoted to the front of the LRU queue of pages")

    (COND
       ((IGREATERP \PAGEFAULTCOUNTER \UPDATECHAINFREQ)
        (\UPDATECHAIN)))
    (add \PAGEFAULTCOUNTER 1)
    (PROG ((RPTINDEX (\SELECTREALPAGE FILEPAGE LOCK? DONTMOVETOPFLG))
           RPTBASE SPECIALRP)
          (SETQ RPTBASE (fetch RPTRBASE of RPTINDEX))
          [COND
             ((AND LOCK? (OR (EQ \MACHINETYPE \DANDELION)
                             (EQ \MACHINETYPE \DAYBREAK))
                   (SETQ SPECIALRP (\SPECIALRP VPAGE)))  (* ; 
"Must actually put FILEPAGE into special RP, and thus move old contents of SPECIALRP into RPTINDEX")
              (LET* ((SRINDEX (RPTFROMRP SPECIALRP))
                     (SRPTR (fetch RPTRBASE of SRINDEX)))
                    (\MOVEREALPAGE SRINDEX SRPTR RPTINDEX RPTBASE)
                    (SETQ RPTINDEX SRINDEX)
                    (SETQ RPTBASE SRPTR]                     (* ; 
                                                       "Fill in new RPTINDEX with appropriate data")
          (replace (RPT VP) of RPTBASE with VPAGE)
          (replace (RPT FILEPAGE) of RPTBASE with FILEPAGE)
          (replace (RPT LOCKED) of RPTBASE with LOCK?)
          (COND
             ([AND DOLOCKCHECKS (NOT LOCK?)
                   (EQ (LRSH VPAGE 8)
                       (CONSTANT (\HILOC \PAGEMAP]
              (\MP.ERROR \MP.MAPNOTLOCKED "Page of page map being loaded but not locked" VPAGE)))
          (\TRANSFERPAGE VPAGE FILEPAGE RPTINDEX NIL NEWPAGEFLG])

(\MOVEREALPAGE
  [LAMBDA (SOURCEINDEX SOURCERPT DESTINDEX DESTRPT)          (* bvm%: "14-Aug-85 13:53")

(* ;;; "Moves the page, if any, currently living in real page table SOURCEINDEX & SOURCERPT into the page indicated by DESTINDEX & DESTRPT.  The destination is assumed to have been vacated")

    (CHECK (NOT (fetch (RPT LOCKED) of SOURCERPT)))
    (replace (RPT LOCKED) of DESTRPT with NIL)
    [COND
       ((fetch (RPT OCCUPIED) of SOURCERPT)          (* ; 
                                                           "Page was not vacant to start with")
        (LET* ((SOURCEVP (fetch (RPT VP) of SOURCERPT))
               (SOURCEFLAGS (\READFLAGS SOURCEVP)))
              (replace (RPT VP) of DESTRPT with SOURCEVP)
              (replace (RPT FILEPAGE) of DESTRPT with (fetch (RPT FILEPAGE)
                                                                     of SOURCERPT))
              (\WRITEMAP \EMBUFVP (RPFROMRPT DESTINDEX)
                     0)                                      (* ; "Map buffer to target page")
              (\BLT \EMBUFBASE (create POINTER
                                      PAGE# _ SOURCEVP)
                    WORDSPERPAGE)                            (* ; "move data to buffer page")
              (\WRITEMAP \EMBUFVP \EMBUFRP 0)                (* ; 
                                                           "Restore buffer to its proper page")
              (\WRITEMAP SOURCEVP (RPFROMRPT DESTINDEX)
                     SOURCEFLAGS)                            (* ; "Set flags and new RP for page")
              ]
    DESTINDEX])

(\LOOKUPPAGEMAP
  [LAMBDA (VP)                                               (* bvm%: "20-Oct-86 18:26")

    (* ;; "Returns the pagemap entry for VP, which is expected to be in bounds.  High bit of result is the lock bit.  Zero denotes absence")

    (LET [(PRIMENTRY (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP]
         (COND
            ((EQ PRIMENTRY \EMPTYPMTENTRY)
             0)
            (T (\GETBASE \PAGEMAP (IPLUS PRIMENTRY (fetch (VP SECONDARYKEY) of VP])

(\VALIDADDRESSP
  [LAMBDA (BASE)                                             (* bvm%: "16-Jun-86 11:30")
    (NEQ 0 (\LOOKUPPAGEMAP (fetch (POINTER PAGE#) of BASE])

(\LOCKEDPAGEP
  [LAMBDA (VP TEMP)                                          (* bvm%: "18-Feb-85 18:08")

(* ;;; "True if VP is locked.  If TEMP is NIL consults only the locked page table;  otherwise, also checks for `temporary' locked page")

    (OR (NEQ 0 (LOGAND (.LOCKEDVPMASK. VP)
                      (\GETBASE (.LOCKEDVPBASE. VP)
                             0)))
        (UNLESSRDSYS (AND TEMP (NOT (fetch (VMEMFLAGS VACANT) of (\READFLAGS VP)))
                          (fetch (RPT LOCKED) of (fetch RPTRBASE
                                                            of (RPTFROMRP (\READRP VP])

(\SELECTREALPAGE
  [LAMBDA (NEWFP LOCK? DONTMOVETOPFLG)                       (* bvm%: "10-Aug-85 18:08")

    (* ;; "Selects a real page, flushing it if necessary, and returns the RPT index of the page.  NEWFP, if supplied, is the filepage that will be read into here.  This might influence page choice by minimizing seek time.  LOCK?  means caller intends to lock the page, which constrains which real pages it can fall into.  The selected page is moved to the back of the LRU queue, so that it won't be selected again soon, unless DONTMOVETOPFLG is true.  If DONTMOVETOPFLG is REMOVE then the page is spliced out of the chain forever.")

    (PROG ((TRIES 0)
           (CNTR \MAXCLEANPROBES)
           (DISTANCE \MINSHORTSEEK)
           PREVRPT PREVINDEX RPTINDEX RPTBASE FP FLAGS)
      RETRY
          (SETQ PREVRPT \REALPAGETABLE)
          (until (EQ (SETQ RPTINDEX (fetch (RPT NEXTRP) of PREVRPT))
                         \PAGETABLESTOPFLG)
             do (SETQ RPTBASE (fetch RPTRBASE of RPTINDEX))
                   [COND
                      ((fetch (RPT EMPTY) of RPTBASE)
                       (RETURN PREVRPT))
                      ((NOT (fetch (RPT OCCUPIED) of RPTBASE))
                       (\MP.ERROR \MP.CHAIN.UNAVAIL "UNAVAILABLE page on Chain"))
                      ([AND (NOT (fetch (RPT LOCKED) of RPTBASE))
                            [NOT (fetch (VMEMFLAGS REFERENCED)
                                    of (SETQ FLAGS (\READFLAGS (fetch (RPT VP) of RPTBASE
                                                                          ]
                            (OR (NOT LOCK?)
                                (.LOCKABLERP. (RPFROMRPT RPTINDEX]

                       (* ;; "Page is unlocked and unreferenced, so is good candidate for flushing.  LOCK?  check is to avoid locking a page into a real page that might be desired by code that cares about real pages")

                       (COND
                          ([OR (NOT (fetch (VMEMFLAGS DIRTY) of FLAGS))
                               (PROGN (SETQ FP (fetch (RPT FILEPAGE) of RPTBASE))
                                      (COND
                                         ((SELECTQ \VMEM.INHIBIT.WRITE
                                              (NIL [SELECTQ \VMEM.FULL.STATE
                                                       (NIL  (* ; "Normal, can write anything")
                                                            T)
                                                       (T    (* ; 
                                                     "Vmem is full and clean, don't write anything")
                                                          NIL)
                                                       (PROGN 
                                                             (* ; 
              "Vmem is full, but sullied, so might as well write anything for which there is space")
                                                              (AND (ILEQ FP \LASTVMEMFILEPAGE)
                                                                   (OR (NULL \VMEM.PURE.LIMIT)
                                                                       (IGREATERP FP \VMEM.PURE.LIMIT
                                                                              ])
                                              (NEW           (* ; 
      "Only allowed to write old pages, since new pages might just have to get moved a second time")
                                                   (ILEQ FP \VMEM.PURE.LIMIT))
                                              (PROGN         (* ; 
                                                           "We are forbidden from writing any page")
                                                     NIL))
                                          (COND
                                             ((OR (ILEQ CNTR 0)
                                                  (NULL NEWFP)
                                                  (ILESSP (IABS (IDIFFERENCE FP NEWFP))
                                                         DISTANCE))
                                                             (* ; 
                               "Page is near replacement, or we have given up trying for closeness")
                                              T)
                                             (T              (* ; 
                                                       "Page is too far away from replacement page")
                                                (SETQ CNTR (SUB1 CNTR))
                                                [COND
                                                   ((ILESSP DISTANCE \MAXSHORTSEEK)
                                                             (* ; "Get more liberal")
                                                    (SETQ DISTANCE (LLSH DISTANCE 1]
                                                NIL]
                           [COND
                              (DOLOCKCHECKS (COND
                                               ((fetch (RPT LOCKED) of RPTBASE)
                                                (\MP.ERROR \MP.FLUSHLOCKED 
                                                       "Attempt to displace locked page" RPTBASE))
                                               ((EQ (fetch (RPT VPSEG) of RPTBASE)
                                                    (CONSTANT (\HILOC \PAGEMAP)))
                                                (\MP.ERROR \MP.MAPNOTLOCKED 
                                                       "A page of the page map is not locked" RPTBASE
                                                       ]
                           (\FLUSHPAGE RPTINDEX)
                           (\WRITEMAP (fetch (RPT VP) of RPTBASE)
                                  0 \VMAP.VACANT)
                           (replace (RPT EMPTY) of RPTBASE with T)
                           (RETURN PREVRPT]
                   (SETQ PREVRPT RPTBASE)
                   (SETQ PREVINDEX RPTINDEX) finally 

                                 (* ;; "Couldn't find an unreffed page because all pages were touched since last \UPDATECHAIN.  Do another, which clears ref bits, and try again")

                                                   (COND
                                                      ((EQ TRIES 0)
                                                       (SETQ TRIES 1)
                                                       (\UPDATECHAIN))
                                                      [(AND (EQ TRIES 1)
                                                            \VMEM.INHIBIT.WRITE)
                                                       (SETQ \VMEM.INHIBIT.WRITE)
                                                       (COND
                                                          ((AND (NEQ \MACHINETYPE \DANDELION)
                                                                (NEQ \MACHINETYPE \DAYBREAK))

                                 (* ;; "Don't call RAID on a DLion, since the interface is so bad.  Dorado user might want to know that we're smashing \VMEM.INHIBIT.WRITE")

                                                           (RAID 
                                      "No clean vmem pages to reuse, must write one.  ^N to continue"
                                                                 ]
                                                      (T (\MP.ERROR \MP.SELECTLOOP 
                                                                "Loop in \SELECTREALPAGE")))
                                                   (GO RETRY))
          (SELECTQ DONTMOVETOPFLG
              (NIL                                           (* ; 
                           "Move this page to head of chain, so that it won't be picked again soon")
                   (replace (RPT NEXTRP) of PREVRPT with (fetch (RPT NEXTRP)
                                                                        of RPTBASE))
                                                             (* ; "Splice RPTINDEX out of chain")
                   (replace (RPT NEXTRP) of \RPTLAST with RPTINDEX)
                                                             (* ; "Put new page at end of chain")
                   (replace (RPT NEXTRP) of (SETQ \RPTLAST RPTBASE) with 
                                                                                  \PAGETABLESTOPFLG))
              (REMOVE                                        (* ; 
                                                         "Splice this page out of chain altogether")
                      (replace (RPT NEXTRP) of PREVRPT with (fetch (RPT NEXTRP)
                                                                           of RPTBASE))
                      (replace (RPT NEXTRP) of RPTBASE with \PAGETABLESTOPFLG))
              NIL)
          (RETURN RPTINDEX])

(\SPECIALRP
  [LAMBDA (VP)                                               (* edited%: " 9-Aug-85 17:14")

    (* ;; "for \DANDELION, some virtual pages must be mapped into special real pages.  This function returns the corresponding real page")

    (SELECTC (FOLDLO VP PAGESPERSEGMENT)
        ((FOLDLO \VP.STACK PAGESPERSEGMENT) 
             (IPLUS VP (IDIFFERENCE \RP.STACK \VP.STACK)))
        ((FOLDLO \VP.DISPLAY PAGESPERSEGMENT) 
             (IPLUS VP (IDIFFERENCE \RP.DISPLAY \VP.DISPLAY)))
        NIL])

(\TRANSFERPAGE
  [LAMBDA (VP FILEPAGE RPTINDEX WRITE? NEWPAGE?)             (* MPL "27-Jul-85 21:28")

    (* ;; "Transfers virtual page VP between page FILEPAGE of the vmem and real page RPTINDEX.  WRITE?  indicates direction of transfer.  If NEWPAGE?, then page does not exist on file, and is simply cleared")

    (PROG (NEWFLAGS)
          (COND
             (WRITE? (FLIPCURSORBAR 15))
             (T (FLIPCURSORBAR 0)))
          (SETQ NEWFLAGS (COND
                            (NEWPAGE? \VMAP.DIRTY)
                            (WRITE? (LOGAND (\READFLAGS VP)
                                           (LOGNOT16 \VMAP.DIRTY)))
                            (T 0)))
          (COND
             ((AND WRITE? (fetch (RPT LOCKED) of (fetch RPTRBASE of RPTINDEX)))

              (* ;; "Writing a locked page: can't diddle map, because others might die, so do this in the straightforward way")

              (\BLT \EMBUFBASE (create POINTER
                                      PAGE# _ VP)
                    WORDSPERPAGE)                            (* ; 
                                                 "Copy page into buffer, then write the buffer out")
              (\ACTONVMEMFILE FILEPAGE \EMBUFBASE 1 T)
              (SETQ \LASTACCESSEDVMEMPAGE FILEPAGE))
             ((NOT NEWPAGE?)                                 (* ; 
        "Map the buffer page into the target real page, read/write the page, then set the map back")
              (\WRITEMAP VP 0 \VMAP.VACANT)                  (* ; 
                      "Unmap VP so that we don't have two virtual pages pointing at same real page")
              (\WRITEMAP \EMBUFVP (RPFROMRPT RPTINDEX)
                     0)                                      (* ; "Map buffer to target page")
              (\ACTONVMEMFILE FILEPAGE \EMBUFBASE 1 WRITE?)
                                                             (* ; "Do the i/o")
              (\WRITEMAP \EMBUFVP \EMBUFRP 0)                (* ; 
                                                           "Restore buffer to its proper page")
              (SETQ \LASTACCESSEDVMEMPAGE FILEPAGE)))
          (\WRITEMAP VP (RPFROMRPT RPTINDEX)
                 NEWFLAGS)                                   (* ; "Set flags for page")
          (COND
             (NEWPAGE?                                       (* ; 
             "Not on file yet, so clear it.  Couldn't do this sooner because the flags weren't set")
                    (\CLEARWORDS (create POINTER
                                        PAGE# _ VP)
                           WORDSPERPAGE)))
          (COND
             (WRITE? (FLIPCURSORBAR 15)
                    (\BOXIPLUS (LOCF (fetch SWAPWRITES of \MISCSTATS))
                           1))
             (T (FLIPCURSORBAR 0)
                (\BOXIPLUS (LOCF (fetch PAGEFAULTS of \MISCSTATS))
                       1])

(\UPDATECHAIN
  [LAMBDA NIL                                                (* bvm%: "30-Jul-85 15:20")
                                                             (* ; 
                                                           "Sorts the page chain by reference bit")
    (CHECK (NOT \INTERRUPTABLE))
    (PROG ((RPTINDEX (fetch (RPT NEXTRP) of \REALPAGETABLE))
           (CHAIN0 \REALPAGETABLE)
           (CHAIN1 (\ADDBASE \REALPAGETABLE 2))
           RPTR VP FLAGS HEAD1)
          (SETQ HEAD1 CHAIN1)

     (* ;; "HEAD1 = CHAIN1 is just a holding cell for the second Chain we temporarily create inside here.  Use the unused third word of the dummy header entry of \REALPAGETABLE")

          (replace (RPT NEXTRP) of CHAIN0 with \PAGETABLESTOPFLG)
          (replace (RPT NEXTRP) of CHAIN1 with \PAGETABLESTOPFLG)
          (do (SETQ RPTR (fetch RPTRBASE of RPTINDEX))
                 (SETQ VP (fetch (RPT VP) of RPTR))
                 [SETQ FLAGS (COND
                                ((fetch (RPT EMPTY) of RPTR)
                                 0)
                                (T (\READFLAGS VP]
                 (COND
                    ((OR (fetch (RPT LOCKED) of RPTR)
                         (PROGN (COND
                                   ([AND DOLOCKCHECKS (EQ (fetch (RPT VPSEG) of RPTR)
                                                          (CONSTANT (\HILOC \PAGEMAP]
                                    (\MP.ERROR \MP.MAPNOTLOCKED 
                                           "A page of the page map is not locked" RPTR)))
                                (fetch (VMEMFLAGS REFERENCED) of FLAGS)))
                                                             (* ; 
                                                         "Page referenced or locked, put on CHAIN1")
                     (\WRITEMAP VP (RPFROMRPT RPTINDEX)
                            (LOGAND FLAGS (LOGNOT16 \VMAP.REF)))
                                                             (* ; "Turn off ref bit")
                     (replace (RPT NEXTRP) of CHAIN1 with RPTINDEX)
                     (SETQ CHAIN1 RPTR))
                    (T                                       (* ; 
                                                  "Page was not referenced recently, put on CHAIN0")
                       (replace (RPT NEXTRP) of CHAIN0 with RPTINDEX)
                       (SETQ CHAIN0 RPTR)))
                 (SETQ RPTINDEX (fetch (RPT NEXTRP) of RPTR)) 
                                                             (* ; "Look at next page in old chain")
             repeatuntil (EQ RPTINDEX \PAGETABLESTOPFLG))
          (replace (RPT NEXTRP) of CHAIN1 with \PAGETABLESTOPFLG)
                                                             (* ; "End of the line")
          (replace (RPT NEXTRP) of CHAIN0 with (fetch (RPT NEXTRP) of HEAD1))
                                                             (* ; 
                                                        "Link end of CHAIN0 to beginning of CHAIN1")
          (SETQ \RPTLAST (COND
                            ((EQ HEAD1 CHAIN1)               (* ; "Nothing on CHAIN1 ??!!")
                             CHAIN0)
                            (T CHAIN1)))                     (* ; 
                                                           "Pointer to end of complete chain")
          (SETQ \DIRTYPAGECOUNTER (SETQ \PAGEFAULTCOUNTER 0])
)



(* ; "Allocating and locking new pages")

(DEFINEQ

(\NEWPAGE
  [LAMBDA (BASE NOERROR LOCK?)                               (* ; 
                                                      "Edited 24-Oct-92 12:45 by sybalsky:mv:envos")

(* ;;; "Creates and returns a new page located at virtual addr BASE")

    (* ;; "If LOCK?, lock the page into real memory (A NOP on nonXerox machines!)")

    (UNINTERRUPTABLY
        (COND
           [(NOT (\MISCAPPLY* (FUNCTION \DONEWPAGE)
                        BASE LOCK?))                         (* ; "Failed, page exists")
            (COND
               ((NOT NOERROR)
                (\MP.ERROR \MP.NEWPAGE "Attempt to allocate already existing page" BASE T)))
            (COND
               (LOCK? (\LOCKPAGES BASE 1]
           ((IGREATERP (fetch (IFPAGE NActivePages) of \InterfacePage)
                   (IDIFFERENCE \LASTVMEMFILEPAGE \GUARDVMEMFULL))
                                                             (* ; "Vmem getting full!")
            (\SET.VMEM.FULL.STATE)))
        BASE)])

(\DONEWPAGE
  [LAMBDA (BASE LOCK? INTERNALFLG)                           (* bvm%: "13-Aug-85 16:32")

(* ;;; "Allocates new page at BASE, locking it if LOCK?  is true.  Returns vmemfile page# on success, NIL if page already exists.  Must be run in safe context! because it can cause vmem activity")

    (AND \DOFAULTINIT (\FAULTINIT))                      (* ; 
              "Only an issue when INIT.SYSOUT starts.  Perhaps there is a better place to put this")
    (PROG ((VP (fetch (POINTER PAGE#) of BASE))
           MAPBASE LOCKBASE FILEPAGE NEXTPM ERRCODE)
          (RETURN (COND
                     ((fetch (VP INVALID) of VP)
                      (\INVALIDVP VP)
                      NIL)
                     (T (SETQ MAPBASE (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)))
                        (COND
                           ((EQ MAPBASE \EMPTYPMTENTRY)      (* ; 
                                                          "Need to create a new second-level block")
                            (SETQ NEXTPM (fetch (IFPAGE NxtPMAddr) of \InterfacePage))
                            [COND
                               ((EVENP NEXTPM WORDSPERPAGE)

                                (* ;; "Need a new secondary pagemap page.  This recursion is ok, because we know that SETUPPAGEMAP assures that the pagemap pages for all the pages in secondary map space were created at MAKEINIT time")

                                (OR (\DONEWPAGE (\ADDBASE \PAGEMAP NEXTPM)
                                           T T)
                                    (RETURN (\MP.ERROR \MP.NEWMAPPAGE 
                                                   "\DONEWPAGE failed to allocate new map page"]
                            (\PUTBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)
                                   NEXTPM)
                            (replace (IFPAGE NxtPMAddr) of \InterfacePage
                               with (IPLUS NEXTPM \PMblockSize))
                            (SETQ MAPBASE NEXTPM)))
                        [SETQ MAPBASE (\ADDBASE \PAGEMAP (IPLUS MAPBASE (fetch (VP SECONDARYKEY)
                                                                           of VP]
                        (COND
                           ((NEQ (\GETBASE MAPBASE 0)
                                 0)                          (* ; "Page exists")
                            (RETURN NIL)))
                        (SETQ FILEPAGE (add (fetch (IFPAGE NActivePages) of 
                                                                                       \InterfacePage
                                                       )
                                              1))
                        (replace (IFPAGE NDirtyPages) of \InterfacePage with FILEPAGE)
                                                             (* ; "Currently a redundant field")
                        [COND
                           (LOCK? (SETQ FILEPAGE (\MAKESPACEFORLOCKEDPAGE VP FILEPAGE))
                                  (\PUTBASE (SETQ LOCKBASE (.LOCKEDVPBASE. VP))
                                         0
                                         (LOGOR (.LOCKEDVPMASK. VP)
                                                (\GETBASE LOCKBASE 0]
                        (\PUTBASE \FPTOVP FILEPAGE VP)
                        (\PUTBASE MAPBASE 0 FILEPAGE)
                        (\LOADVMEMPAGE VP FILEPAGE T LOCK?)
                        (COND
                           (INTERNALFLG (SETQ \NEWVMEMPAGEADDED T))
                           (T                                (* ; 
                                                          "Make sure \FPTOVP extended if necessary")
                              (\ASSURE.FPTOVP.PAGE)))
                        FILEPAGE])

(\ASSURE.FPTOVP.PAGE
  [LAMBDA NIL                                                (* bvm%: "13-Aug-85 16:29")

    (* ;; "Called at the end of some swapping operation that added one or more pages to the vmem file, setting \NEWVMEMPAGEADDED true.  If we're going to need a new page of \FPTOVP soon, do it now while there's still maneuvering room.  The allowance below is for the worst case, which can happen when VMEM.PURE.STATE is on and \NEWPAGE was called needing a new pagemap page as well, in which case we could have as many as the following new vmem pages before we're home safe --- 1: \NEWPAGE added a page --- 2: a page was displaced by the new page and written to the end of the vmem --- 3: a new pagemap page was needed --- 4: it displaced a page to end of vmem --- 5: the new \FPTOVP page below --- 6: a page displaced by same.  --- --- Alternatively, it could have been the new \FPTOVP page that needed a new pagemap block.  Will never have both needing a new pagemap block, since there are several pagemap blocks per page")

    (LET ((FILEPAGE (fetch (IFPAGE NActivePages) of \InterfacePage)))
         (COND
            ((IGREATERP (IMOD FILEPAGE WORDSPERPAGE)
                    (IDIFFERENCE WORDSPERPAGE 7))            (* ; 
                                           "This is a no-op if the page has already been allocated")
             (\DONEWPAGE (\ADDBASE \FPTOVP (CEIL FILEPAGE WORDSPERPAGE))
                    T T)))
         (SETQ \NEWVMEMPAGEADDED NIL])

(\MAKESPACEFORLOCKEDPAGE
  [LAMBDA (VP FILEPAGE)                                      (* bvm%: "29-Jun-86 17:44")

    (* ;; "VP is a page to be locked, FILEPAGE its home.  Returns a possibly new file page where VP will now live, after having kicked the former resident of the new file page into VP's old FILEPAGE")

    (PROG (DESIREDFP OLDVP FPBASE)
          [SETQ DESIREDFP (SELECTC (FOLDLO VP PAGESPERSEGMENT)
                              ((FOLDLO \VP.STACK PAGESPERSEGMENT) 
                                   (IPLUS VP (IDIFFERENCE (DLFPFROMRP \RP.STACK)
                                                    \VP.STACK)))
                              ((FOLDLO \VP.DISPLAY PAGESPERSEGMENT) 
                                                             (* ; 
                        "Display lives in a fixed place in file, but does not land there initially")
                                   (IPLUS VP (IDIFFERENCE (DLFPFROMRP \RP.TEMPDISPLAY)
                                                    \VP.DISPLAY)))
                              ((FOLDLO \VP.FPTOVP PAGESPERSEGMENT) 
                                                             (* ; 
                         "A new page of FPTOVP has to be continguous on file with other such pages")
                                   (IPLUS VP (IDIFFERENCE (DLFPFROMRP \RP.FPTOVP)
                                                    \VP.FPTOVP)))
                              (COND
                                 ((AND (ILEQ FILEPAGE (fetch LastLockedFilePage of 
                                                                                       \InterfacePage
                                                             ))
                                       (IGREATERP FILEPAGE (DLFPFROMRP \RP.MISCLOCKED)))
                                                             (* ; 
                     "Page is in a good place already.  It probably was once locked, then unlocked")
                                  (RETURN FILEPAGE))
                                 (T                          (* ; 
                                                          "Put it after all the other locked pages")
                                    (add (fetch LastLockedFilePage of \InterfacePage)
                                           1]
          (COND
             ((AND (fetch FPOCCUPIED of (SETQ FPBASE (\ADDBASE \FPTOVP DESIREDFP)))
                   (NEQ (SETQ OLDVP (fetch FPVIRTUALPAGE of FPBASE))
                        VP))                                 (* ; 
                                                          "Someone else lives here, so move it out")
              (\MOVEVMEMFILEPAGE OLDVP DESIREDFP FILEPAGE)))
          (RETURN DESIREDFP])

(\MOVEVMEMFILEPAGE
  [LAMBDA (VP OLDFP NEWFP)                                   (* bvm%: "18-Nov-84 14:14")
    (PROG ((FLAGS (\READFLAGS VP))
           RP)
          (COND
             ((fetch (VMEMFLAGS VACANT) of FLAGS)    (* ; 
                                                           "Page not resident, so pull it in")
              (\LOADVMEMPAGE VP OLDFP)
              (SETQ FLAGS \VMAP.CLEAN))
             ((\LOCKEDPAGEP VP)
              (\MP.ERROR \MP.BADLOCKED "Locked page is in the way" VP)))
          (\WRITEMAP VP (SETQ RP (\READRP VP))
                 (LOGOR FLAGS \VMAP.DIRTY))                  (* ; 
                           "Mark page dirty, so that it will eventually be written to its new home")
          (replace (RPT FILEPAGE) of (fetch RPTRBASE of (RPTFROMRP RP)) with
                                                                                        NEWFP)
                                                             (* ; "Tell RPT where VP now lives")
          (\PUTBASE (.PAGEMAPBASE. VP)
                 0 NEWFP)                                    (* ; "Tell \PAGEMAP about it")
          (\PUTBASE \FPTOVP NEWFP VP)                        (* ; "...  and \FPTOVP")
      ])

(\NEWEPHEMERALPAGE
  [LAMBDA (BASE NOERROR)                                     (* bvm%: "26-NOV-82 15:40")

(* ;;; "Creates and returns a new page located at virtual addr BASE, mapping it permanently into some real page but leaving it out of the vmem file")

    (\MISCAPPLY* (FUNCTION \DONEWEPHEMERALPAGE)
           BASE NOERROR])

(\DONEWEPHEMERALPAGE
  [LAMBDA (BASE NOERROR)                                     (* bvm%: "30-Oct-86 16:47")

(* ;;; "Creates and returns a new page located at virtual addr BASE, mapping it permanently into some real page but leaving it out of the vmem file")

    (LET ((VP (fetch (POINTER PAGE#) of BASE))
          MAPBASE PREVRP RPTINDEX RPTR)
         (COND
            ((fetch (VP INVALID) of VP)
             (\INVALIDVP VP)
             NIL)
            ([OR (AND (NEQ (SETQ MAPBASE (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY)
                                                                  of VP)))
                           \EMPTYPMTENTRY)
                      (NEQ (\GETBASE \PAGEMAP (IPLUS MAPBASE (fetch (VP SECONDARYKEY)
                                                                of VP)))
                           0))
                 (NOT (fetch (VMEMFLAGS VACANT) of (\READFLAGS VP]
                                                             (* ; 
                                                          "Page is in the vmem already, so no hope")
             (COND
                ((NOT NOERROR)
                 (\MP.ERROR \MP.NEWPAGE "Page already exists " BASE T)))
             BASE)
            (T (COND
                  ((IGREATERP \PAGEFAULTCOUNTER \UPDATECHAINFREQ)
                   (\UPDATECHAIN)))
               (add \PAGEFAULTCOUNTER 1)
               (SETQ RPTINDEX (\SELECTREALPAGE NIL T 'REMOVE))
                                                             (* ; "Find a page to put this in")
               (SETQ RPTR (fetch RPTRBASE of RPTINDEX))
                                                             (* ; 
                                                       "Fill in new RPTINDEX with appropriate data")
               (replace (RPT VP) of RPTR with \RPT.UNAVAILABLE)
               (replace (RPT FILEPAGE) of RPTR with VP)
                                                             (* ; "For debugging only")
               (FLIPCURSORBAR 0)
               (\WRITEMAP VP (RPFROMRPT RPTINDEX)
                      \VMAP.DIRTY)                           (* ; "Set flags for page")
               (\CLEARWORDS (create POINTER
                                   PAGE# _ VP)
                      WORDSPERPAGE)                          (* ; "Clear new page")
               (FLIPCURSORBAR 0)
               (\BOXIPLUS (LOCF (fetch PAGEFAULTS of \MISCSTATS))
                      1)
               (COND
                  (\NEWVMEMPAGEADDED (\ASSURE.FPTOVP.PAGE)))
               BASE])

(\LOCKPAGES
  [LAMBDA (BASE NPAGES)                                      (* bvm%: "26-NOV-82 15:17")

    (* ;; "Needs to be done in safe stack context because might cause vmem transfer")

    (\MISCAPPLY* (FUNCTION \DOLOCKPAGES)
           BASE NPAGES)
    BASE])

(\DOLOCKPAGES
  [LAMBDA (BASE NPAGES)                                      (* ; "Edited 21-Oct-87 15:49 by bvm:")
    (for I from 0 to (SUB1 NPAGES) bind (VP _ (fetch (POINTER PAGE#) of
                                                                                         BASE))
                                                     FILEPAGE MAPBASE RPTBASE RPINDEX RP MASK 
                                                     LOCKBASE
       do [COND
                 ((fetch (VP INVALID) of VP)
                  (\INVALIDVP VP))
                 [(EQ (SETQ MAPBASE (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)))
                      \EMPTYPMTENTRY)
                  (\INVALIDADDR (ADDBASE BASE (UNFOLD I WORDSPERPAGE]
                 (T [SETQ MAPBASE (\ADDBASE \PAGEMAP (IPLUS MAPBASE (fetch (VP SECONDARYKEY)
                                                                       of VP]
                    (SETQ FILEPAGE (\GETBASE MAPBASE 0))
                    (COND
                       ((EQ 0 (LOGAND (SETQ MASK (.LOCKEDVPMASK. VP))
                                     (\GETBASE (SETQ LOCKBASE (.LOCKEDVPBASE. VP))
                                            0)))             (* ; "Not locked yet")
                        (COND
                           ((fetch VACANT of (\READFLAGS VP))
                                                             (* ; 
                                       "Bring locked page into core so we can move it if necessary")
                            (\LOADVMEMPAGE VP FILEPAGE NIL T)))
                        [SETQ RPINDEX (RPTFROMRP (SETQ RP (\READRP VP]
                        (SETQ RPTBASE (fetch RPTRBASE of RPINDEX))
                        [COND
                           ((AND (NOT (.LOCKABLERP. RP))
                                 (NOT (\SPECIALRP VP)))

                            (* ;; "Page already swapped in, but lives in a real page that might need to get bumped (e.g., for stack), so move it now.  If \SPECIALRP is true then we know that the page got swapped into the right place, so no need to move it.")

                            (LET* ((NEWINDEX (\SELECTREALPAGE NIL T))
                                   (NEWRPT (fetch RPTRBASE of NEWINDEX)))
                                  (\MOVEREALPAGE RPINDEX RPTBASE NEWINDEX NEWRPT)
                                  (replace (RPT EMPTY) of RPTBASE with T)
                                                             (* ; "Mark vacated RPT entry empty")
                                  (SETQ RPTBASE NEWRPT)
                                  (SETQ RP (RPFROMRPT NEWINDEX]
                        (COND
                           ((NEQ FILEPAGE (SETQ FILEPAGE (\MAKESPACEFORLOCKEDPAGE VP FILEPAGE)))

                            (* ;; "Moving to a new page, so have to mark this locked page dirty so that it will eventually get written to its new home")

                            (\WRITEMAP VP RP (LOGOR \VMAP.DIRTY \VMAP.REF))
                            (replace (RPT FILEPAGE) of RPTBASE with FILEPAGE)
                            (\PUTBASE \FPTOVP FILEPAGE VP)
                            (\PUTBASE MAPBASE 0 FILEPAGE)))
                        (\PUTBASE LOCKBASE 0 (LOGOR MASK (\GETBASE LOCKBASE 0)))
                                                             (* ; "Set lock bit in page map")
                        (replace (RPT LOCKED) of RPTBASE with T]
             (add VP 1) finally (COND
                                           (\NEWVMEMPAGEADDED 
                                                             (* ; 
        "If we had to load or rearrange pages, vmem could have gotten bigger if VMEM.PURE.STATE on")
                                                  (\ASSURE.FPTOVP.PAGE])

(\TEMPLOCKPAGES
  [LAMBDA (BASE NPAGES)                                      (* bvm%: "10-Aug-85 18:17")

(* ;;; "`Temporarily' locks BASE for NPAGES, i.e. ensures that the swapper will not move the pages.  Information vanishes at logout etc.")

    (\MISCAPPLY* (FUNCTION \DOTEMPLOCKPAGES)
           BASE NPAGES])

(\DOTEMPLOCKPAGES
  [LAMBDA (BASE NPAGES)                                      (* ; "Edited 21-Oct-87 15:49 by bvm:")

    (* ;; "`Temporarily' locks BASE for NPAGES, i.e. ensures that the swapper will not move the pages.  Information vanishes at logout etc.  This function must be locked because it manipulates the page table table.  Runs in MISC context")

    (to NPAGES as VP from (fetch (POINTER PAGE#) of BASE) bind RPTBASE 
                                                                                    RPINDEX RP
       do (\TOUCHPAGE BASE)                              (* ; "Touch page in case not resident")
             [SETQ RPINDEX (RPTFROMRP (SETQ RP (\READRP VP]
             (SETQ RPTBASE (fetch RPTRBASE of RPINDEX))
             [COND
                ((NOT (.LOCKABLERP. RP))

                 (* ;; "Page already swapped in, but lives in a real page that might need to get bumped (e.g., for stack), so move it now")

                 (LET* ((NEWINDEX (\SELECTREALPAGE NIL T))
                        (NEWRPT (fetch RPTRBASE of NEWINDEX)))
                       (\MOVEREALPAGE RPINDEX RPTBASE NEWINDEX NEWRPT)
                       (replace (RPT EMPTY) of RPTBASE with T)
                                                             (* ; "Mark vacated RPT entry empty")
                       (SETQ RPTBASE NEWRPT]
             (replace (RPT LOCKED) of RPTBASE with T)
             (SETQ BASE (\ADDBASE BASE WORDSPERPAGE])

(\TEMPUNLOCKPAGES
  [LAMBDA (BASE NPAGES)                                      (* bvm%: "30-Jul-85 16:58")

    (* ;; "Unlocks pages that were locked by \TEMPLOCKPAGES.  This function must be locked because it manipulates the page table")

    (while (IGREATERP NPAGES 0) bind (VP _ (fetch (POINTER PAGE#) of BASE))
                                          RPTR
       do (UNINTERRUPTABLY
                  (\TOUCHPAGE BASE)                          (* ; 
         "Touch page in case not resident.  Should only happen if page wasn't locked to begin with")
                  (COND
                     ((AND (NEQ (SETQ RPTR (\READRP VP))
                                0)
                           (EQ [fetch (RPT VP) of (SETQ RPTR (fetch RPTRBASE
                                                                        of (RPTFROMRP RPTR]
                               VP))
                      (COND
                         ([AND DOLOCKCHECKS (EQ (LRSH VP 8)
                                                (CONSTANT (\HILOC \PAGEMAP]
                          (\MP.ERROR \MP.UNLOCKINGMAP "Attempt to unlock map page" VP)))
                      (replace (RPT LOCKED) of RPTR with NIL))
                     (T (HELP "Page table changed out from under me!" VP))))
             (add VP 1)
             (add NPAGES -1)
             (SETQ BASE (\ADDBASE BASE WORDSPERPAGE])

(\UNLOCKPAGES
  [LAMBDA (BASE NPAGES)                                      (* bvm%: "30-Jul-85 16:58")

(* ;;; "Unlocks NPAGES virtual pages from BASE onward")

    (UNINTERRUPTABLY
        (for I from 0 to (SUB1 NPAGES) bind (VP _ (fetch (POINTER PAGE#)
                                                                     of BASE))
                                                         MASK LOCKBASE
           do (COND
                     ((fetch (VP INVALID) of VP)
                      (\INVALIDVP VP))
                     ((NEQ 0 (LOGAND (SETQ MASK (.LOCKEDVPMASK. VP))
                                    (\GETBASE (SETQ LOCKBASE (.LOCKEDVPBASE. VP))
                                           0)))              (* ; 
                                                    "Yes, page was locked, so turn the bit off now")
                      (COND
                         ([AND DOLOCKCHECKS (EQ (LRSH VP 8)
                                                (CONSTANT (\HILOC \PAGEMAP]
                          (\MP.ERROR \MP.UNLOCKINGMAP "Attempt to unlock map page" VP)))
                      (\PUTBASE LOCKBASE 0 (LOGXOR MASK (\GETBASE LOCKBASE 0)))
                                                             (* ; 
                                                      "Update pagemap, then update real page table")
                      (replace (RPT LOCKED) of (fetch RPTRBASE of (RPTFROMRP
                                                                                   (\READRP VP)))
                         with NIL)))
                 (add VP 1)))])
)



(* ; "Writing out the vmem")

(DEFINEQ

(\DOFLUSHVM
  [LAMBDA (MAIKO.SYSOUTFILE)                             (* ; "Edited 10-Feb-2021 22:38 by lmm")
                                                             (* ; 
                                                           "Edited  6-Jan-89 19:23 by Hayata")

(* ;;; "Write everything out in a resumable way.  Value is NIL if returned from directly, T if from saved state.  Always invoked via \MISCAPPLY*")

    (CHECK (NOT \INTERRUPTABLE))                             (* ; 
                               "NOTE: need stats gathering off in here.  Also avoid touching pages")
    (PROG ((IFPVP (fetch (POINTER PAGE#) of \InterfacePage))
           (SCRATCHBUF \EMUSWAPBUFFERS)
           IFPRPT)
          (replace (IFPAGE MISCSTACKRESULT) of \InterfacePage with T)
                                                             (* ; 
"This will make it look like we have returned from BCPL if caller gets control from the saved state")

     (* ;; "update interface pge before writing out sysout")

          (replace (IFPAGE CurrentFXP) of \InterfacePage with (fetch (IFPAGE MiscFXP)
                                                                             of \InterfacePage))
          (RETURN (SUBRCALL VMEMSAVE MAIKO.SYSOUTFILE])

(\RELEASEWORKINGSET
  [LAMBDA NIL                                            (* bvm%: "29-Nov-84 10:56")
    (COND
       ((\FLUSHVM)                                       (* ; "Returning from Lisp startup")
        T)
       (T                                                    (* ; "Unmap any unlocked page")
          (for RPTINDEX from 1 to (SUB1 \RPTSIZE) bind RPTR
             when (AND (fetch (RPT OCCUPIED) of (SETQ RPTR (fetch RPTRBASE
                                                                          of RPTINDEX)))
                           (NOT (fetch (RPT LOCKED) of RPTR)))
             do (\WRITEMAP (fetch (RPT VP) of RPTR)
                           (RPFROMRPT RPTINDEX)
                           \VMAP.VACANT)
                   (replace (RPT EMPTY) of RPTR with T])

(\WRITEDIRTYPAGE
  [LAMBDA (MINDIRTY)                                     (* bvm%: "13-Aug-85 17:51")
    (COND
       ((OR (NOT (.VMEM.CONSISTENTP.))
            (AND \VMEM.PURE.LIMIT (NEQ \VMEM.PURE.LIMIT -1)
                 (NOT \VMEM.FULL.STATE)))
        (PROG ((RPTR (OR \LASTDIRTYSCANPTR \REALPAGETABLE))
               (NUMDIRTY (OR \LASTDIRTYCNT 0))
               (CNT \MAXDIRTYSCANCOUNT)
               RP FP FLAGS)
              [COND
                 ((AND (NULL \LASTDIRTYSCANPTR)
                       (IGREATERP (IPLUS (add \DIRTYPAGECOUNTER 1)
                                         \PAGEFAULTCOUNTER)
                              \UPDATECHAINFREQ))             (* ; 
                                                  "Take this time to update the page chain instead")
                  (RETURN (UNINTERRUPTABLY
                              (\MISCAPPLY* (FUNCTION \UPDATECHAIN)))]
              (OR MINDIRTY (SETQ MINDIRTY 1))
          LP  [COND
                 [(EQ (SETQ RP (fetch (RPT NEXTRP) of RPTR))
                      \PAGETABLESTOPFLG)                     (* ; 
                                  "Hit end of chain.  Write out what we found if enough were dirty")
                  (COND
                     ((AND (IGEQ NUMDIRTY MINDIRTY)
                           (NEQ NUMDIRTY 0)
                           (SETQ RP \LASTDIRTYFOUND))
                      (GO GOTPAGE))
                     (T (SETQ \LASTDIRTYSCANPTR (SETQ \LASTDIRTYCNT (SETQ \LASTDIRTYFOUND NIL)))
                        [COND
                           ((AND (NEQ NUMDIRTY 0)
                                 (ILESSP \DIRTYSEEKMAX (LRSH MAX.SMALL.INTEGER 1)))
                                                             (* ; 
                                     "Failed because page not close enough, so widen the tolerance")
                            (SETQ \DIRTYSEEKMAX (LLSH \DIRTYSEEKMAX 1]
                        (RETURN]
                 ((fetch (RPT EMPTY) of (SETQ RPTR (fetch RPTRBASE of RP)))
                                                             (* ; 
                                              "Page is empty.  Should never happen if key is valid")
                  (RETURN))
                 ((NOT (fetch (RPT LOCKED) of RPTR)) (* ; 
            "Don't bother writing out locked pages, since they don't help us in our swapping quest")
                  (SETQ FLAGS (\READFLAGS (fetch (RPT VP) of RPTR)))
                  (COND
                     ((NOT (fetch (VMEMFLAGS DIRTY) of FLAGS))
                                                             (* ; "Page not dirty;  skip")
                      )
                     [(PROGN (SETQ FP (fetch (RPT FILEPAGE) of RPTR))
                             (IGREATERP (IABS (IDIFFERENCE (COND
                                                              ((AND \VMEM.PURE.LIMIT (ILESSP FP 
                                                                                     \VMEM.PURE.LIMIT
                                                                                            ))
                                                             (* ; 
                                                 "We'd have to write page to a new place, not here")
                                                               (fetch (IFPAGE NActivePages)
                                                                  of \InterfacePage))
                                                              (T FP))
                                                     \LASTACCESSEDVMEMPAGE))
                                    \DIRTYSEEKMAX))          (* ; 
                                                           "Page too far away, don't write it")
                      (COND
                         ((fetch (VMEMFLAGS REFERENCED) of FLAGS)
                                                             (* ; "but still count it")
                          (add NUMDIRTY 1]
                     ((IGREATERP FP \LASTVMEMFILEPAGE)       (* ; "Can't write it")
                      )
                     ((fetch (VMEMFLAGS REFERENCED) of FLAGS)
                                                             (* ; 
                           "Page dirty but referenced.  Note it, but keep looking for a better one")
                      (COND
                         ((EQ NUMDIRTY 0)
                          (SETQ \LASTDIRTYFOUND RP)))
                      (add NUMDIRTY 1))
                     (T                                      (* ; "Dirty, not referenced: do it")
                        (GO GOTPAGE]
              (COND
                 ((EQ (add CNT -1)
                      0)                                     (* ; 
                                                    "Scanned for long enough;  don't lock user out")
                  (SETQ \LASTDIRTYSCANPTR RPTR)
                  (SETQ \LASTDIRTYCNT NUMDIRTY)
                  (RETURN)))
              (GO LP)
          GOTPAGE
              (UNINTERRUPTABLY
                  (SETQ \LASTDIRTYSCANPTR (SETQ RPTR (fetch RPTRBASE of RP)))
                                                             (* ; "Keep traveling pointer")
                  (SETQ \LASTDIRTYCNT (SETQ \LASTDIRTYFOUND NIL))
                  (COND
                     ((ILEQ (IABS (IDIFFERENCE (fetch (RPT FILEPAGE) of RPTR)
                                         \LASTACCESSEDVMEMPAGE))
                            \DIRTYSEEKMAX)                   (* ; 
                        "Could fail if swapping since the selection has moved the disk arm too far")
                      (\MISCAPPLY* (FUNCTION \WRITEDIRTYPAGE1)
                             RP RPTR)))
                  (SETQ \DIRTYSEEKMAX \MAXSHORTSEEK))
              (RETURN T])

(\WRITEDIRTYPAGE1
  [LAMBDA (RP RPTR)                                      (* bvm%: "13-Aug-85 16:41")
                                                             (* ; 
                           "Write out buffer RP.  This fn is locked and called in the misc context")
    (COND
       ([AND (NOT (fetch (RPT LOCKED) of RPTR))
             (fetch (VMEMFLAGS DIRTY) of (\READFLAGS (fetch (RPT VP) of RPTR]
                                                             (* ; 
               "Verify that the page is still a candidate, so previous loop could be interruptable")
        (\FLUSHPAGE RP)
        (COND
           (\NEWVMEMPAGEADDED (\ASSURE.FPTOVP.PAGE])

(\COUNTREALPAGES
  [LAMBDA (TYPE)                                         (* bvm%: "18-Dec-84 15:31")
    (SELECTQ TYPE
        ((DIRTY REF) 
             [PROG [(FLAGBITS (COND
                                 ((EQ TYPE 'DIRTY)
                                  \VMAP.DIRTY)
                                 (T \VMAP.REF]
                   (RETURN (NPAGESMACRO (NEQ (LOGAND (\READFLAGS VP)
                                                    FLAGBITS)
                                             0])
        (LOCKED (NPAGESMACRO (fetch (RPT LOCKED) of RPTR)))
        (OCCUPIED (NPAGESMACRO T))
        (\ILLEGAL.ARG TYPE])
)



(* ; "VMEM.PURE.STATE hack")

(DEFINEQ

(\DOCOMPRESSVMEM
  [LAMBDA NIL                                            (* bvm%: " 7-Apr-84 17:53")

(* ;;; "Called underneath \DOFLUSHVM to write the pages above the high water mark back to the places vacated below that mark")

    (PROG ((EMPTYFP (DLFPFROMRP \RP.GCTABLE))
           (LASTFP (fetch NActivePages of \InterfacePage))
           (OLDVIW \VMEM.INHIBIT.WRITE)
           VP)
          [COND
             ((NULL OLDVIW)

              (* ;; "Encourage \SELECTREALPAGE to select only `old' file pages for displacement, so that we don't needlessly write the same page twice")

              (SETQ \VMEM.INHIBIT.WRITE 'NEW]
      LP  (COND
             ((IGEQ EMPTYFP LASTFP)
              (SETQ \VMEM.INHIBIT.WRITE OLDVIW)
              (RETURN)))
          [COND
             ((EQ (\GETBASE \FPTOVP EMPTYFP)
                  \NO.VMEM.PAGE)
              (while (EQ (SETQ VP (\GETBASE \FPTOVP LASTFP))
                             \NO.VMEM.PAGE) do (SETQ LASTFP (SUB1 LASTFP)))
              (\MOVEVMEMFILEPAGE VP LASTFP EMPTYFP)
              (replace NActivePages of \InterfacePage with (SETQ LASTFP (SUB1 LASTFP]
          (add EMPTYFP 1)
          (GO LP])

(VMEM.PURE.STATE
  [LAMBDA FLG                                            (* bvm%: " 7-Apr-84 16:59")
    (PROG1 (NOT (NULL \VMEM.PURE.LIMIT))
        [COND
           ((IGREATERP FLG 0)

            (* ;; "Set \VMEM.PURE.LIMIT appropriately.  If turning on, and it wasn't on before, set it to -1 so that it takes effect only at the next FLUSHVM")

            (SETQ \VMEM.PURE.LIMIT (AND (ARG FLG 1)
                                        (OR \VMEM.PURE.LIMIT (SETQ \VMEM.PURE.LIMIT -1])])
)



(* ;; 
"Handling the backing store getting too full--keep running, but if we overflow, we can never \FLUSHVM because there is no place to write some pages"
)

(DEFINEQ

(32MBADDRESSABLE
  [LAMBDA NIL                                         (* ; "Edited  2-May-88 22:03 by MASINTER")
    (SELECTC \MACHINETYPE
        (\DORADO T)
        (\DOLPHIN NIL)
        (\DAYBREAK T)
        (NEQ 0 (fetch (IFPAGE DL24BitAddressable) of \InterfacePage])

(\SET.VMEM.FULL.STATE
  [LAMBDA NIL                                            (* bvm%: "13-Feb-85 20:12")
                                                             (* ; 
                 "We are running out of vmem, try to extend file.  Do this at next convenient time")
    (COND
       ((NOT \VMEM.FULL.STATE)                               (* ; "Get an interrupt to handle this")
        (replace VMEMFULL of \INTERRUPTSTATE with T)
        (SETQ \PENDINGINTERRUPT T)))
    (SETQ \VMEM.FULL.STATE (COND
                              ((ILESSP (fetch (IFPAGE NActivePages) of \InterfacePage)
                                      \LASTVMEMFILEPAGE)     (* ; 
                                               "Not completely full, allow normal things to happen")
                               0)
                              ((.VMEM.CONSISTENTP.)
                               T)
                              (T 'DIRTY])

(\SET.LASTVMEMFILEPAGE
  [LAMBDA (N)                                            (* ; "Edited  6-Apr-87 14:09 by bvm:")

    (* ;; "Called by disk routines when they discover how long the physical vmem is.  Currently only used by Dove.")

    (COND
       ((IGREATERP (fetch (IFPAGE NActivePages) of \InterfacePage)
               (IDIFFERENCE (SETQ \LASTVMEMFILEPAGE N)
                      \GUARDVMEMFULL))                       (* ; "Vmem getting full!")
        (\SET.VMEM.FULL.STATE))
       (T                                                    (* ; 
                                          "Vmem ok now (was earlier set to full for safety's sake)")
          (SETQ \VMEM.FULL.STATE NIL)))
    N])

(\DOVMEMFULLINTERRUPT
  [LAMBDA NIL                                            (* ; "Edited 21-Oct-87 13:54 by bvm:")

(* ;;; "Called while interruptable when vmem is full or nearly so.  Tries to extend vmem file, or gives error if it can't")

    (COND
       (\EXTENDINGVMEMFILE 

              (* ;; "Another interrupt happened while we are extending file.  Don't try to do this one twice, but repost the interrupt in the hopes that it will happen after vmem extension is finished")

              (SETQ \PENDINGINTERRUPT T))
       (T (RESETVARS ((\EXTENDINGVMEMFILE T))

           (* ;; "Used to have code here that tried to extend the vmem file, but even on those that support extension it's flaky, and rarely what you want--people allocate the vmem file to the desired size in the first place, don't want it extended further.")

                     (PROG ((HELPFLAG 'BREAK!))
                           (replace VMEMFULL of \INTERRUPTSTATE with NIL)
                                                             (* ; 
             "Very slight chance of losing the break if ^E right here.  Don't know how to fix this")
                           (CL:CERROR "Resume the interrupted computation"
                                  (CONCAT "Your virtual memory backing file is "
                                         (COND
                                            ((>= (fetch (IFPAGE NActivePages) of 
                                                                                       \InterfacePage
                                                        )
                                                 \LASTVMEMFILEPAGE)
                                             "complete")
                                            (T "near"))
                                         "ly full.
Save your work & reload a.s.a.p."])

(\FLUSHVMOK?
  [LAMBDA (TYPE NOERROR)                                     (* ; 
                                                           "Edited 10-Feb-2021 21:49 by larry")
                                                             (* bvm%: " 7-Sep-85 10:48")

(* ;;; "Called before any attempt to do a \FLUSHVM to make sure it's ok")

    T])
)

(RPAQ? \UPDATECHAINFREQ 100)

(RPAQ? \PAGEFAULTCOUNTER 0)

(RPAQ? \DIRTYPAGECOUNTER 0)

(RPAQ? \DIRTYPAGEHINT 0)

(RPAQ? \LASTACCESSEDVMEMPAGE 0)

(RPAQ? \MAXSHORTSEEK 1000)

(RPAQ? \MINSHORTSEEK 20)

(RPAQ? \MAXCLEANPROBES 20)

(RPAQ? \VMEM.INHIBIT.WRITE )

(RPAQ? \VMEM.PURE.LIMIT )

(RPAQ? \VMEM.FULL.STATE )

(RPAQ? \GUARDVMEMFULL 500)

(RPAQ? VMEM.COMPRESS.FLG )

(RPAQ? \DOFAULTINIT 0)

(RPAQ? \VMEMACCESSFN )

(RPAQ? \SYSTEMCACHEVARS )

(RPAQ? \MAXSWAPBUFFERS 1)

(RPAQ? \EXTENDINGVMEMFILE )

(RPAQ? \MaxScreenPage 0)

(RPAQ? \NEWVMEMPAGEADDED )

(RPAQ? \LASTDIRTYCNT )

(RPAQ? \LASTDIRTYFOUND )

(RPAQ? \LASTDIRTYSCANPTR )

(RPAQ? \DIRTYSEEKMAX 50)



(* ; "Errors signaled in the maintenance panel")

(DEFINEQ

(\MP.ERROR
  [LAMBDA (CODE STRING ARG1 ARG2)                        (* mpl "20-Jun-85 11:09")
    (COND
       ((OR (EQ \MACHINETYPE \DANDELION)
            (EQ \MACHINETYPE \DAYBREAK))
        ((OPCODES RAID)
         CODE))
       (T (RAID STRING ARG1 ARG2])
)



(* ; "Debugging code.  Some of this also runs renamed for extra TeleRaid help")

(DEFINEQ

(\ACTONVMEMFILE
  [LAMBDA (FILEPAGE BUFFER NPAGES WRITEFLAG)             (* MPL "22-Jun-85 20:18")
    (COND
       ((EQ \MACHINETYPE \DANDELION)
        (\DL.ACTONVMEMFILE FILEPAGE BUFFER NPAGES WRITEFLAG))
       ((EQ \MACHINETYPE \DAYBREAK)
        (\DOVE.ACTONVMEMFILE FILEPAGE BUFFER NPAGES WRITEFLAG))
       (T (\M44ACTONVMEMFILE FILEPAGE BUFFER NPAGES WRITEFLAG])

(\SHOWPAGETABLE
  [LAMBDA (MODE FILE)                                    (* bvm%: "12-Jul-86 16:55")
    (PROG ((*PRINT-BASE* 8)
           (OUTSTREAM (GETSTREAM FILE 'OUTPUT))
           (RPTR \REALPAGETABLE)
           (RP 0)
           FLAGS VP STATE FIRSTONE LASTONE)
          (printout OUTSTREAM "     RP      VP           FilePage  Status" T)
          (until (SELECTQ MODE
                         (CHAIN (EQ (SETQ RP (fetch (RPT NEXTRP) of RPTR))
                                    \PAGETABLESTOPFLG))
                         (NIL (add RP 1)
                              (IGEQ RP \RPTSIZE))
                         (\ILLEGAL.ARG MODE))
             do (SETQ RPTR (fetch RPTRBASE of RP))
                   (SETQ VP (fetch (RPT VP) of RPTR))
                   (COND
                      ((AND (NULL MODE)
                            (EQ VP STATE))
                       (SETQ LASTONE RP))
                      (T (COND
                            (LASTONE (printout OUTSTREAM "ditto thru " LASTONE T)
                                   (SETQ LASTONE NIL)))
                         (SETQ FIRSTONE RP)
                         (SETQ STATE VP)
                         (printout OUTSTREAM |.I7.8| (RPFROMRPT RP))
                         [COND
                            ((fetch (RPT EMPTY) of RPTR)
                             (PRIN1 " Empty" OUTSTREAM))
                            ((NOT (fetch (RPT OCCUPIED) of RPTR))
                             (PRIN1 " Unavailable" OUTSTREAM))
                            (T (printout OUTSTREAM |.I8.8| VP %,)
                               (\PRINTVP VP OUTSTREAM)
                               (printout OUTSTREAM 28 |.I6.8| (fetch (RPT FILEPAGE) of RPTR)
                                      %,,)
                               (COND
                                  ((fetch (RPT LOCKED) of RPTR)
                                   (COND
                                      ((NOT (\LOCKEDPAGEP VP))
                                                             (* ; "not permanently locked")
                                       (PRIN1 "Temp" OUTSTREAM)))
                                   (PRIN1 "Locked " OUTSTREAM)))
                               (UNLESSRDSYS (PROGN (COND
                                                      ((fetch (VMEMFLAGS REFERENCED)
                                                          of (SETQ FLAGS (\READFLAGS VP)))
                                                       (PRIN1 "Ref " OUTSTREAM)))
                                                   (COND
                                                      ((fetch (VMEMFLAGS DIRTY) of FLAGS)
                                                       (PRIN1 "Dirty" OUTSTREAM]
                         (TERPRI OUTSTREAM])

(CHECKPAGEMAP
  [LAMBDA NIL                                            (* bvm%: "12-Jul-86 16:56")
    (LET ((*PRINT-BASE* 8)
          (NUMOCCUPIED 0)
          (NUMLOCKED 0)
          (CHAINOCCUPIED 0)
          (CHAINLOCKED 0)
          RPTR FPBASE FP VP RP)
         (CHECKFPTOVP)
         [for RPTINDEX from 1 to (SUB1 \RPTSIZE)
            when (fetch (RPT OCCUPIED) of (SETQ RPTR (fetch RPTRBASE of RPTINDEX)
                                                       ))
            do (add NUMOCCUPIED 1)
                  (SETQ VP (fetch (RPT VP) of RPTR))
                  (SETQ FP (fetch (RPT FILEPAGE) of RPTR))
                  (COND
                     ((CHECKFPTOVP1 FP VP RPTINDEX))
                     ([NEQ VP (fetch FPVIRTUALPAGE of (SETQ FPBASE (\ADDBASE \FPTOVP FP]
                      (printout T "RPT for RP " (RPFROMRPT RPTINDEX)
                             " says VP ")
                      (\PRINTVP VP T)
                      (printout T " lives in FP " FP "; but FP Map says that FP contains ")
                      (\PRINTVP (fetch FPVIRTUALPAGE of FPBASE)
                             T)
                      (printout T T))
                     ((\LOCKEDPAGEP VP)
                      (add NUMLOCKED 1)
                      (COND
                         ((NOT (fetch (RPT LOCKED) of RPTR))
                          (printout T "VP " VP ", living in RP " (RPFROMRPT RPTINDEX)
                                 " should be locked but isn't." T))
                         ((IGREATERP FP (DLRPFROMFP (fetch (IFPAGE LastLockedFilePage)
                                                       of \InterfacePage)))
                          (printout T "VP " VP " is locked, but living in FP " FP 
                                 ", which is not in the locked page area" T]
         (PROGN (SETQ RPTR \REALPAGETABLE)                   (* ; "Check pagetable chain")
                [while (NEQ (SETQ RP (fetch (RPT NEXTRP) of RPTR))
                                \PAGETABLESTOPFLG) when (fetch (RPT OCCUPIED)
                                                               of (SETQ RPTR
                                                                       (fetch RPTRBASE
                                                                          of RP)))
                   do (add CHAINOCCUPIED 1)
                         (COND
                            ((fetch (RPT LOCKED) of RPTR)
                             (add CHAINLOCKED 1]
                (COND
                   ((ILESSP CHAINOCCUPIED NUMOCCUPIED)
                    (printout T NUMOCCUPIED " occupied pages, but only " CHAINOCCUPIED 
                           " are on page chain.  " NUMLOCKED " pages are permanently locked; " 
                           CHAINLOCKED " pages on chain are locked somehow." T])

(CHECKFPTOVP
  [LAMBDA NIL                                            (* bvm%: "10-Dec-84 12:39")
    (for FP from 1 to (fetch NActivePages of \InterfacePage)
       as (FPBASE _ (\ADDBASE \FPTOVP 1)) by (\ADDBASE FPBASE 1)
       when (fetch FPOCCUPIED of FPBASE) do (CHECKFPTOVP1 FP
                                                                   (fetch FPVIRTUALPAGE
                                                                      of FPBASE])

(CHECKFPTOVP1
  [LAMBDA (FP VP RPTINDEX)                               (* bvm%: "10-Dec-84 12:36")
    (PROG ((FP2 (\LOOKUPPAGEMAP VP)))
          (RETURN (COND
                     ((NEQ FP2 FP)
                      (COND
                         ((UNLESSRDSYS RPTINDEX)
                          (printout T "RPT for RP " (RPFROMRPT RPTINDEX)))
                         (T (printout T "FP map")))
                      (printout T " says FP " FP " contains VP ")
                      (\PRINTVP VP T)
                      (printout T "; but PageMap says that page is in FP " FP2 T)
                      T])

(\PRINTFPTOVP
  [LAMBDA (FIRSTPAGE NWORDS TYPEFLG STREAM VPRAWFLG)     (* bvm%: "24-Sep-86 11:44")
    (SETQ STREAM (GETSTREAM STREAM 'OUTPUT))
    (OR FIRSTPAGE (SETQ FIRSTPAGE 1))
    (OR NWORDS (SETQ NWORDS (fetch (IFPAGE NActivePages) of \InterfacePage)))
    (LET ((BASE (\ADDBASE \FPTOVP (SUB1 FIRSTPAGE)))
          (*PRINT-BASE* 8)
          (LASTVP -2)
          (NEXTFP (SUB1 FIRSTPAGE))
          FIRSTFP FIRSTVP NEXTVP LOCKEDP TYPE NEXTLOCKED NEXTTYPE)
         (while (IGEQ NWORDS 0)
            do (add NEXTFP 1)
                  [COND
                     ((EQ NWORDS 0)
                      (SETQ NEXTVP -1))
                     ((NEQ (SETQ NEXTVP (\GETBASE (SETQ BASE (\ADDBASE BASE 1))
                                               0))
                           \NO.VMEM.PAGE)
                      (SETQ NEXTLOCKED (\LOCKEDPAGEP NEXTVP))
                      (if TYPEFLG
                          then (SETQ NEXTTYPE (TYPENAME (create POINTER
                                                                   PAGE# _ NEXTVP)))
                                (if (NULL NEXTTYPE)
                                    then (SETQ NEXTTYPE (SELECTC (LRSH NEXTVP 8)
                                                                ((LIST \PNAME.HI (CL:1+ \PNAME.HI)) 
                                                                     "Pnames")
                                                                ((LIST \DEF.HI (CL:1+ \DEF.HI)) 
                                                                     "Definitions")
                                                                ((LIST \VAL.HI (CL:1+ \VAL.HI)) 
                                                                     "Value cells")
                                                                ((LIST \PLIST.HI (CL:1+ \PLIST.HI)) 
                                                                     "Property lists")
                                                                ((\HILOC \FPTOVP) 
                                                                     "\FPTOVP")
                                                                (\STACKHI "Stack")
                                                                ((\HILOC \HTMAIN) 
                                                                     "GC Main table")
                                                                ((\HILOC \HTOVERFLOW) 
                                                                     "GC Overflow table")
                                                                NIL]
                  [COND
                     ([COND
                         ((EQ NEXTVP \NO.VMEM.PAGE)
                          (NEQ LASTVP \NO.VMEM.PAGE))
                         (T (OR (NEQ NEXTVP (ADD1 LASTVP))
                                (NEQ NEXTLOCKED LOCKEDP)
                                (NEQ TYPE NEXTTYPE]
                      [COND
                         ((IGEQ LASTVP 0)
                          (COND
                             (FIRSTFP (printout STREAM FIRSTFP "-")))
                          (printout STREAM (SUB1 NEXTFP)
                                 12)
                          (COND
                             ((EQ LASTVP \NO.VMEM.PAGE)
                              (printout STREAM "empty"))
                             (T (COND
                                   (FIRSTFP (if VPRAWFLG
                                                then (PRIN1 FIRSTVP STREAM)
                                              else (\PRINTVP FIRSTVP STREAM))
                                          (PRIN1 "-" STREAM)))
                                (if VPRAWFLG
                                    then (PRIN1 LASTVP STREAM)
                                  else (\PRINTVP LASTVP STREAM))
                                (COND
                                   (LOCKEDP (PRIN1 '* STREAM)))
                                (if TYPE
                                    then (printout STREAM 32 TYPE]
                      (SETQ FIRSTFP)
                      (TERPRI STREAM)
                      (SETQ FIRSTVP NEXTVP))
                     (T                                      (* ; "in a run")
                        (OR FIRSTFP (SETQ FIRSTFP (SUB1 NEXTFP]
                  (SETQ LASTVP NEXTVP)
                  (SETQ LOCKEDP NEXTLOCKED)
                  (SETQ TYPE NEXTTYPE)
                  (add NWORDS -1])

(\PRINTVP
  [LAMBDA (VP STREAM)                                    (* bvm%: "28-MAR-83 12:40")
    (printout STREAM "{" (LRSH VP 8)
           ","
           (LOGAND VP 255)
           "}"])
)
(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(PUTPROPS \ACTONVMEMFILE MACRO ((X . Y)
                                        (SPREADAPPLY* \VMEMACCESSFN X . Y)))

(PUTPROPS .VMEM.CONSISTENTP. MACRO (NIL (EQ (fetch (IFPAGE Key) of \InterfacePage)
                                                    \IFPValidKey)))

(PUTPROPS .LOCKABLERP. MACRO [(RP)
                                      (OR (NEQ (FOLDLO RP PAGESPERSEGMENT)
                                               (FOLDLO \RP.STACK PAGESPERSEGMENT))
                                          (NOT (OR (EQ \MACHINETYPE \DANDELION)
                                                   (EQ \MACHINETYPE \DAYBREAK])
)




(* ; "Virtual page flags")

(DECLARE%: EVAL@COMPILE 

(RPAQQ \VMAP.DIRTY 10000Q)

(RPAQQ \VMAP.CLEAN 0)

(RPAQQ \VMAP.REF 100000Q)

(RPAQQ \VMAP.VACANT 30000Q)

(RPAQQ \VMAP.FLAGS 170000Q)

(RPAQQ \VMAP.NOTFLAGS 7777Q)


(CONSTANTS \VMAP.DIRTY \VMAP.CLEAN \VMAP.REF \VMAP.VACANT \VMAP.FLAGS \VMAP.NOTFLAGS)
)
(DECLARE%: EVAL@COMPILE

(ACCESSFNS VMEMFLAGS ((VACANT (EQ (LOGAND DATUM \VMAP.VACANT)
                                      \VMAP.VACANT))
                          (DIRTY (NEQ (LOGAND DATUM \VMAP.DIRTY)
                                      0))
                          (REFERENCED (NEQ (LOGAND DATUM \VMAP.REF)
                                           0))))
)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS LOGNOT16 MACRO ((X)
                                  (LOGXOR X 177777Q)))
)




(* ; "RPT constants")

(DECLARE%: EVAL@COMPILE 

(RPAQQ \RPT.EMPTY 177776Q)

(RPAQQ \RPT.UNAVAILABLE 177777Q)

(RPAQQ \PAGETABLESTOPFLG 0)

(RPAQQ \RPTENTRYLENGTH 3)


(CONSTANTS \RPT.EMPTY \RPT.UNAVAILABLE \PAGETABLESTOPFLG \RPTENTRYLENGTH)
)
(DECLARE%: EVAL@COMPILE

(BLOCKRECORD RPT ((LOCKED FLAG)
                      (NEXTRP BITS 17Q)
                      (VP WORD)
                      (FILEPAGE WORD))
                     (BLOCKRECORD RPT ((NIL BITS 20Q)
                                       (VPSEG BYTE)
                                       (VPPAGEINSEG BYTE)))
                     [ACCESSFNS RPT ([EMPTY (EQ (fetch (RPT VP) of DATUM)
                                                \RPT.EMPTY)
                                            (COND
                                               (NEWVALUE (replace (RPT VP) of DATUM
                                                            with \RPT.EMPTY))
                                               (T (ERROR "Invalid replace of RPT.EMPTY" DATUM]
                                     [UNAVAILABLE (EQ (fetch (RPT VP) of DATUM)
                                                      \RPT.UNAVAILABLE)
                                            (COND
                                               (NEWVALUE (replace (RPT VP) of DATUM
                                                            with \RPT.UNAVAILABLE))
                                               (T (ERROR "Invalid replace of RPT.UNAVAILABLE" DATUM]
                                     (OCCUPIED (ILESSP (fetch (RPT VP) of DATUM)
                                                      \RPT.EMPTY])

(ACCESSFNS RPT1 (RPTRBASE (\ADDBASE (\ADDBASE \REALPAGETABLE (LLSH DATUM 1))
                                     DATUM)))
)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS RPFROMRPT MACRO ((RPTINDEX)
                                   (IPLUS RPTINDEX \RPOFFSET)))

(PUTPROPS RPTFROMRP MACRO ((RP)
                                   (IDIFFERENCE RP \RPOFFSET)))

(PUTPROPS NPAGESMACRO MACRO ((FORM)
                                     (PROG ((RESULT 0)
                                            (CNTR \RPTSIZE)
                                            (RPTR \REALPAGETABLE)
                                            VP)
                                       LP  (COND
                                              ((NEQ (SETQ CNTR (SUB1 CNTR))
                                                    0)
                                               (SETQ RPTR (\ADDBASE RPTR \RPTENTRYLENGTH))
                                               (COND
                                                  ((AND (fetch (RPT OCCUPIED) of RPTR)
                                                        (PROGN (SETQ VP (fetch (RPT VP)
                                                                           of RPTR))
                                                               FORM))
                                                   (add RESULT 1)))
                                               (GO LP)))
                                           (RETURN RESULT))))
)




(* ; "Virtual to file pagemap")

(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 

(RPAQQ \MAXFILEPAGE 177776Q)


(CONSTANTS \MAXFILEPAGE)
)

(* "END EXPORTED DEFINITIONS")

(DECLARE%: EVAL@COMPILE 

(RPAQQ \EMPTYPMTENTRY 177777Q)


(CONSTANTS \EMPTYPMTENTRY)
)
(DECLARE%: EVAL@COMPILE

(ACCESSFNS VP ((PRIMARYKEY (LRSH DATUM 5))
                   (SECONDARYKEY (LOGAND DATUM 37Q))
                   (INVALID (PROGN NIL))))
)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS .PAGEMAPBASE. MACRO [OPENLAMBDA (VPAGE)
                                        (\ADDBASE \PAGEMAP (IPLUS (\GETBASE \PageMapTBL
                                                                         (fetch (VP PRIMARYKEY)
                                                                            of VPAGE))
                                                                  (fetch (VP SECONDARYKEY)
                                                                     of VPAGE])
)




(* ; "FP to VP stuff")

(DECLARE%: EVAL@COMPILE

(BLOCKRECORD FPTOVP ((FPVIRTUALPAGE FIXP))
                        [ACCESSFNS FPTOVP ((FPOCCUPIED (NEQ (\GETBASE DATUM 0)
                                                            \NO.VMEM.PAGE])
)
(DECLARE%: EVAL@COMPILE 

(RPAQQ \NO.VMEM.PAGE 177777Q)


(CONSTANTS \NO.VMEM.PAGE)
)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS DLRPFROMFP MACRO ((FP)
                                    (ADD1 FP)))

(PUTPROPS DLFPFROMRP MACRO ((RP)
                                    (SUB1 RP)))
)


(PUTPROPS \TOUCHPAGE DOPVAL (1 GETBASE.N 0))

(PUTPROPS TIMES3 DOPVAL (1 COPY LLSH1 IPLUS2))




(* ; "Locked page table")

(DECLARE%: EVAL@COMPILE 

(PUTPROPS .LOCKEDVPBASE. MACRO ((VP)
                                        (\ADDBASE \LOCKEDPAGETABLE (FOLDLO VP BITSPERWORD))))

(PUTPROPS .LOCKEDVPMASK. MACRO ((VP)
                                        (LLSH 1 (IMOD VP BITSPERWORD))))
)

(DECLARE%: EVAL@COMPILE 

(RPAQQ \MAXDIRTYSCANCOUNT 144Q)

(RPAQQ \MINVMEMSPAREPAGES 144Q)

(RPAQQ \DLBUFFERPAGES 20Q)


(CONSTANTS \MAXDIRTYSCANCOUNT \MINVMEMSPAREPAGES \DLBUFFERPAGES)
)

(DECLARE%: EVAL@COMPILE 

(RPAQQ 2MBPAGES 10000Q)


(CONSTANTS 2MBPAGES)
)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \UPDATECHAINFREQ \REALPAGETABLE \RPTLAST \RPOFFSET \RPTSIZE \LOCKEDPAGETABLE \EMBUFBASE 
       \EMBUFVP \EMBUFRP \PAGEFAULTCOUNTER \LASTDIRTYCNT \LASTDIRTYFOUND \LASTDIRTYSCANPTR 
       \MACHINETYPE \LASTACCESSEDVMEMPAGE \MAXSHORTSEEK \MAXCLEANPROBES \MINSHORTSEEK \DIRTYSEEKMAX 
       \DIRTYPAGECOUNTER \DIRTYPAGEHINT \VMEM.INHIBIT.WRITE \VMEM.PURE.LIMIT \VMEM.FULL.STATE 
       \GUARDVMEMFULL VMEM.COMPRESS.FLG \KBDSTACKBASE \MISCSTACKBASE \DOFAULTINIT \FPTOVP 
       \VMEMACCESSFN \SYSTEMCACHEVARS \LASTVMEMFILEPAGE \EXTENDINGVMEMFILE \MaxScreenPage 
       \NEWVMEMPAGEADDED)
)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \#SWAPBUFFERS \#EMUBUFFERS \#DISKBUFFERS \MAXSWAPBUFFERS \EMUSWAPBUFFERS \EMUBUFFERS 
       \TELERAIDBUFFER \EMUDISKBUFFERS \EMUDISKBUFEND)
)

(DECLARE%: EVAL@COMPILE 

(PUTPROPS RWMufMan DMACRO ((X)
                                   ((OPCODES 170Q 11Q)
                                    X)))
)

(DECLARE%: EVAL@COMPILE 

(RPAQQ DOLOCKCHECKS NIL)


(CONSTANTS (DOLOCKCHECKS NIL))
)
)



(* ;;; "MAKEINIT stuff")

(DEFINEQ

(ADDPME
  [LAMBDA (VP NEWPAGEOK)                                 (* bvm%: " 6-Dec-84 14:07")

    (* ;; "add an entry for VP to the PAGEMAP.  Called only under MAKEINIT")

    (PROG (PX PMP LOCKBASE)
          [COND
             ((IEQ (SETQ PMP (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)))
                   \EmptyPMTEntry)                           (* ; 
                                      "empty entries in the PageMapTBL have 177777q as their value")
              (COND
                 ((EVENP NEXTPM WORDSPERPAGE)                (* ; "must add a new page map page")
                  (SETQ PX (\ADDBASE \PAGEMAP NEXTPM))
                  (OR NEWPAGEOK (IGREATERP (PAGELOC PX)
                                       VP)
                      (HELP "page map needs new page after page map written out"))
                  (\NEWPAGE PX NIL T)))
              (\PUTBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)
                     (SETQ PMP NEXTPM))
              (SETQ NEXTPM (IPLUS NEXTPM \PMblockSize]
          (SETQ PX (IPLUS PMP (fetch (VP SECONDARYKEY) of VP)))
          (COND
             ((NEQ (\GETBASE \PAGEMAP PX)
                   0)
              (HELP "page already in pagemap" VP))
             (T (\PUTBASE \PAGEMAP PX NEXTVMEM)
                [COND
                   ((LOCKEDPAGEP VP)                         (* ; 
                                                           "Set lock bit in locked page table")
                    (\PUTBASE (SETQ LOCKBASE (.LOCKEDVPBASE. VP))
                           0
                           (LOGOR (.LOCKEDVPMASK. VP)
                                  (\GETBASE LOCKBASE 0]
                (SETQ NEXTVMEM (ADD1 NEXTVMEM])

(CHECKIFPAGE
  [LAMBDA NIL                                            (* mjs "19-Jul-84 13:24")
    (CHECKIF Key EQUAL \IFPValidKey "Interface page key"])

(DUMPINITPAGES
  [LAMBDA (CODEFIRSTPAGE CODENEXTPAGE VERSIONS)          (* bvm%: "14-Jan-85 12:51")
                                                             (* ; "called only under MAKEINIT")
    (ADDPME (PAGELOC \InterfacePage)
           T)                                                (* ; 
                                                        "THE INTERFACE PAGE MUST BE THE FIRST PAGE")
    (for I from CODEFIRSTPAGE to (SUB1 CODENEXTPAGE) do 
                                                             (* ; 
                    "add the pagemap entries for the pages which were written directly to the file")
                                                                       (ADDPME I T))
    (MAPPAGES 0 (ADD1 \MAXVMPAGE)
           (FUNCTION MAKEROOMFORPME))
    (MAPPAGES 0 (ADD1 \MAXVMPAGE)
           (FUNCTION ADDPME))
    (PROGN                                                   (* ; 
                     "set interface page locations --- stack pointers already set up IN SETUPSTACK")
           (replace (IFPAGE NxtPMAddr) of \InterfacePage with NEXTPM)
           (replace (IFPAGE NActivePages) of \InterfacePage with (SUB1 NEXTVMEM))
           (replace (IFPAGE NDirtyPages) of \InterfacePage with (SUB1 NEXTVMEM))
           (replace (IFPAGE filePnPMP0) of \InterfacePage with (\GETBASE \PAGEMAP 0))
           (replace (IFPAGE filePnPMT0) of \InterfacePage with (\GETBASE
                                                                            (.PAGEMAPBASE.
                                                                             (PAGELOC \PageMapTBL))
                                                                            0))
           [COND
              (VERSIONS (replace (IFPAGE LVersion) of \InterfacePage with (CAR VERSIONS))
                     (replace (IFPAGE MinBVersion) of \InterfacePage with (CADDR VERSIONS
                                                                                             ))
                     (replace (IFPAGE MinRVersion) of \InterfacePage with (CADR VERSIONS]
           (replace (IFPAGE Key) of \InterfacePage with \IFPValidKey))
    (MAPPAGES 0 (ADD1 \MAXVMPAGE)
           (FUNCTION DUMPVP))
    (ALLOCAL (PROG ((FILE (OUTPUT)))
                   [COND
                      ((NOT (RANDACCESSP FILE))              (* ; 
                                "SYSOUT file is sequential;  have to get it random access for this")
                       (OUTPUT (SETQ FILE (OPENFILE (CLOSEF FILE)
                                                 'BOTH]
                   (SETFILEPTR FILE MKI.Page0Byte)))
    (DUMPVP (PAGELOC \InterfacePage])

(MAKEROOMFORPME
  [LAMBDA (VP)                                           (* bvm%: "29-MAR-83 17:11")

    (* ;; 
 "make sure that the pagemap-page for page VP exists;  we later will want to add it to the pagemap")

    (COND
       ((IEQ (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP))
             \EmptyPMTEntry)                                 (* ; 
                                      "empty entries in the PageMapTBL have 177777q as their value")
        (COND
           ((EVENP NEXTPM WORDSPERPAGE)                      (* ; "must add a new page map page")
            (\NEWPAGE (\ADDBASE \PAGEMAP NEXTPM)
                   NIL T)))
        (\PUTBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)
               NEXTPM)
        (SETQ NEXTPM (IPLUS NEXTPM \PMblockSize])

(MAPPAGES
  [LAMBDA (BOT TOP FN)                        (* ; 
                                                "Edited  5-Nov-92 15:41 by sybalsky:mv:envos")

    (* ;; "Map thru all pages from BOT to TOP that exist, skipping the interface page, if it falls into that range.  Call FN on the page number.")

    (PROG ((VP BOT)
           (IVP (PAGELOC \InterfacePage)))
      LP  (COND
             ((AND (SETQ VP (MKI.NEXTPAGE VP))
                   (IGREATERP TOP VP))
              (COND
                 ((NOT (IEQ VP IVP))
                  (APPLY* FN VP)))
              (SETQ VP (ADD1 VP))
              (GO LP])

(READPAGEMAP
  [LAMBDA NIL                                            (* bvm%: "10-Dec-84 21:54")
                                                             (* ; 
                          "called only under READSYS -- reads in pagemap so that SETVMPTR can work")
    (PROG (D)
          (LOCAL (MAPVMPAGE (fetch (POINTER PAGE#) of \InterfacePage)
                        1))                                  (* ; "Install interface page by magic")
                                                             (* PROGN (SETQ FPSTART
                                                           (fetch (IFPAGE LastDominoFilePage) 
                                                           of \InterfacePage))
                                                           (SETQ NPAGES (fetch
                                                           (IFPAGE NActivePages) of 
                                                           \InterfacePage)) (* ;
                                                           "Note: have to do these fetches before the SETFILEPTR since they indirectly do SETFILEPTR themselves")
                                                           (SETFILEPTR VMEMFILE
                                                           (IPLUS (UNFOLD (SUB1
                                                           (fetch (IFPAGE FPTOVPStart) of 
                                                           \InterfacePage)) BYTESPERPAGE)
                                                           (UNFOLD FPSTART BYTESPERWORD)))
                                                           (for I from FPSTART to NPAGES bind 
                                                           VP when (NEQ (SETQ VP
                                                           (VBIN2)) \NO.VMEM.PAGE) do
                                                           (* ; "Read in all of FPTOVP")
                                                           (MAPVMPAGE VP (SUB1 I))))
          [LOCAL (MAPVMPAGE (PAGELOC \PAGEMAP)
                        (SUB1 (fetch (IFPAGE filePnPMP0) of \InterfacePage]
                                                             (* ; "map in first page of secondary page map, which is where all the secondary map pages themselves live")
          (LOCAL (SETVMPTR \PAGEMAP))
          (for I from 0 to (SUB1 (FOLDHI PAGESPERSEGMENT \PMblockSize)) as VP
             from (PAGELOC \PAGEMAP) by \PMblockSize do 
                                                             (* ; 
"Have to read all the addresses of secondary map pages themselves before we can read their contents")
                                                                   (READPAGEMAPBLOCK VP))
          (for J from 0 to (SUB1 \NumPMTpages) as FP
             from (SUB1 (fetch (IFPAGE filePnPMT0) of \InterfacePage))
             do                                          (* ; 
                                                          "read in all the primary map table pages")
                   (LOCAL (MAPVMPAGE (IPLUS (PAGELOC \PageMapTBL)
                                            J)
                                 FP)))
          (for I from 0 to (SUB1 (UNFOLD \NumPMTpages WORDSPERPAGE))
             do (COND
                       ((IEQ (SETQ D (GETBASE \PageMapTBL I))
                             \EmptyPMTEntry))
                       (T (LOCAL (SETVMPTR (ADDBASE \PAGEMAP D)))
                          (READPAGEMAPBLOCK (UNFOLD I \PMblockSize])

(READPAGEMAPBLOCK
  [LAMBDA (VP)                                           (* lmm " 4-MAY-82 21:12")
    (PROG ((B VP)
           P)
          (FRPTQ \PMblockSize [COND
                                 ((NEQ (SETQ P (VBIN2))
                                       0)
                                  (LOCAL (MAPVMPAGE B (SUB1 P]
                 (SETQ B (ADD1 B])

(SETUPPAGEMAP
  [LAMBDA NIL                                 (* ; 
                                                "Edited  5-Nov-92 16:03 by sybalsky:mv:envos")
                                                             (* ; 
                                             "called only from MAKEINIT to initialize the page map")
    (PROG NIL                                                (* ; "set up page map")
          (\NEWPAGE \PAGEMAP NIL T)                      (* ; 
                                                           "Create 1 page worth of real page table")
          (CREATEPAGES \PageMapTBL \NumPMTpages NIL T)       (* ; "And the segment table.")

     (* ;; "init PageMapTBL pages to 177777q:")

          (for I from 0 to (SUB1 (UNFOLD \NumPMTpages WORDSPERPAGE))
             do (\PUTBASE \PageMapTBL I \EmptyPMTEntry))
          (SETQ NEXTPM 0)
          (for I from 0 to (SUB1 (fetch (VP PRIMARYKEY) of \NumPageMapPages))
             bind (PAGEMAPKEY _ (fetch (VP PRIMARYKEY) of (PAGELOC \PAGEMAP)))
             do 

                   (* ;; "Assign pagemap pages to cover all pagemap pages, so that \DONEWPAGE can guarantee that when it needs to allocate a new pagemap page, that the pagemap page for the new page already exists")

                   (\PUTBASE \PageMapTBL (IPLUS PAGEMAPKEY I)
                          NEXTPM)
                   (SETQ NEXTPM (IPLUS NEXTPM \PMblockSize)))
          (SETQ NEXTVMEM \FirstVmemBlock)                    (* ; 
                                      "add entry for InterfacePage which must be on FirstVMemBlock")
          (CREATEPAGES \LOCKEDPAGETABLE \NumLPTPages NIL T])
)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(PUTPROPS CHECKIF MACRO [(FLD COMPARISON VALUE STR)
                                 (COND
                                    ((NOT (COMPARISON VALUE (fetch (IFPAGE FLD) of 
                                                                                       \InterfacePage
                                                                   )))
                                     (printout T "Warning: " STR "= " (PROGN VALUE)
                                            ", but \InterfacePage says "
                                            (fetch (IFPAGE FLD) of \InterfacePage)
                                            T])
)


(ADDTOVAR INEWCOMS (FNS DUMPINITPAGES)
                       (VARS INITCONSTANTS)
                       (FNS SETUPPAGEMAP ADDPME MAKEROOMFORPME MAPPAGES))

(ADDTOVAR RDCOMS (FNS READPAGEMAP READPAGEMAPBLOCK CHECKIFPAGE \LOCKEDPAGEP \LOOKUPPAGEMAP 
                          CHECKPAGEMAP CHECKFPTOVP CHECKFPTOVP1 \SHOWPAGETABLE \PRINTFPTOVP))

(ADDTOVAR EXPANDMACROFNS CHECKIF .LOCKEDVPBASE. .LOCKEDVPMASK. .PAGEMAPBASE.)

(ADDTOVAR MKI.SUBFNS (\NEWPAGE . MKI.NEWPAGE)
                         (\LOCKPAGES . MKI.LOCKPAGES))

(ADDTOVAR RD.SUBFNS (\NEWPAGE . VNEWPAGE)
                        (\LOCKPAGES . VLOCKPAGES))

(ADDTOVAR RDPTRS (\REALPAGETABLE))

(ADDTOVAR RDVALS (\RPTSIZE))
EVAL@COMPILE 

(ADDTOVAR DONTCOMPILEFNS DUMPINITPAGES SETUPPAGEMAP ADDPME MAKEROOMFORPME MAPPAGES READPAGEMAP 
                                   READPAGEMAPBLOCK CHECKIFPAGE)
)
(DEFINEQ

(\LOCKFN
  [LAMBDA (FN)                                           (* bvm%: "22-NOV-82 17:39")
    [\LOCKCELL (SETQ FN (fetch (LITATOM DEFINITIONCELL) of (EVQ FN]
    (COND
       ((fetch (DEFINITIONCELL CCODEP) of FN)
        (\LOCKCODE (fetch (DEFINITIONCELL DEFPOINTER) of FN])

(\LOCKCODE
  [LAMBDA (CODEBLOCK)                                    (* rmk%: "15-Aug-84 13:35")
    (\LOCKWORDS CODEBLOCK (UNFOLD (\#BLOCKDATACELLS CODEBLOCK)
                                     WORDSPERCELL])

(\LOCKVAR
  [LAMBDA (VAR)                                          (* lmm " 5-APR-82 00:43")
    (\LOCKCELL (fetch (LITATOM VCELL) of (EVQ VAR])

(\LOCKCELL
  [LAMBDA (X NPGS)                                       (* bvm%: "22-NOV-82 17:54")
    (\LOCKPAGES (PAGEBASE X)
           (OR NPGS 1])

(\LOCKWORDS
  [LAMBDA (BASE NWORDS)                                  (* bvm%: "22-NOV-82 17:35")
    (\LOCKPAGES (PAGEBASE BASE)
           (COND
              (NWORDS (FOLDHI (IPLUS (fetch (POINTER WORDINPAGE) of BASE)
                                     NWORDS)
                             WORDSPERPAGE))
              (T 1])
)
(DECLARE%: DONTCOPY 

(ADDTOVAR INEWCOMS
          (FNS \LOCKFN \LOCKVAR \LOCKCELL \LOCKWORDS \LOCKCODE)
          (ALLOCAL (ADDVARS (LOCKEDFNS \FAULTHANDLER \FAULTINIT \DOVE.FAULTINIT \D01.FAULTINIT 
                                   \DL.FAULTINIT \CHAIN.UP.RPT \MAKESPACEFORLOCKEDPAGE \PAGEFAULT 
                                   \WRITEMAP \LOOKUPPAGEMAP \LOCKEDPAGEP \LOADVMEMPAGE \MOVEREALPAGE
                                   \INVALIDADDR \INVALIDVP \SELECTREALPAGE \TRANSFERPAGE \SPECIALRP 
                                   \UPDATECHAIN \MARKPAGEVACANT \FLUSHPAGE \CLEARWORDS \FLUSHVM 
                                   \DONEWPAGE \ASSURE.FPTOVP.PAGE \DONEWEPHEMERALPAGE 
                                   \WRITEDIRTYPAGE1 \COPYSYS0 \COPYSYS0SUBR \RELEASEWORKINGSET 
                                   \DOFLUSHVM \DOLOCKPAGES \DOTEMPLOCKPAGES \TEMPUNLOCKPAGES 
                                   \MP.ERROR RAID \DL.NEWFAULTINIT \DL.MARK.PAGES.UNAVAILABLE 
                                   \DL.UNMAPPAGES \DL.ASSIGNBUFFERS \D01.ASSIGNBUFFERS 
                                   \DOCOMPRESSVMEM \MOVEVMEMFILEPAGE \SET.VMEM.FULL.STATE \HINUM 
                                   \LONUM \ATOMCELL SETTOPVAL)
                          (LOCKEDVARS \REALPAGETABLE \RPTLAST \PAGEFAULTCOUNTER \UPDATECHAINFREQ 
                                 \RPOFFSET \RPTSIZE \LOCKEDPAGETABLE \EMBUFBASE \EMBUFVP \EMBUFRP 
                                 \LASTACCESSEDVMEMPAGE \MAXSHORTSEEK \MAXCLEANPROBES \MINSHORTSEEK 
                                 \DIRTYPAGECOUNTER \DIRTYPAGEHINT \VMEM.INHIBIT.WRITE 
                                 \VMEM.PURE.LIMIT \VMEM.FULL.STATE \GUARDVMEMFULL VMEM.COMPRESS.FLG 
                                 \KBDSTACKBASE \MISCSTACKBASE \DOFAULTINIT \FPTOVP \MACHINETYPE 
                                 \VMEMACCESSFN \TELERAIDBUFFER \EMUDISKBUFFERS \EMUDISKBUFEND 
                                 \MAXSWAPBUFFERS \EMUBUFFERS \#EMUBUFFERS \#SWAPBUFFERS \#DISKBUFFERS
                                 \RCLKSECOND \RCLKMILLISECOND \VALSPACE \EMUSWAPBUFFERS 
                                 \EM.CURSORBITMAP \PAGEMAP \PageMapTBL \IOCBPAGE \IOPAGE \MISCSTATS 
                                 \DEFSPACE \InterfacePage \LASTVMEMFILEPAGE \DoveIORegion 
                                 \MaxScreenPage \NEWVMEMPAGEADDED))))
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA CHECKPAGEMAP \SHOWPAGETABLE VMEM.PURE.STATE \COUNTREALPAGES \WRITEDIRTYPAGE 
                         \UNLOCKPAGES \TEMPUNLOCKPAGES \DOTEMPLOCKPAGES \DOLOCKPAGES \LOCKPAGES 
                         \LOADVMEMPAGE)
)
(PUTPROPS LLFAULT COPYRIGHT ("Venue & Xerox Corporation" 3676Q 3677Q 3700Q 3701Q 3702Q 3703Q 3704Q 
3705Q 3706Q 3707Q 3710Q 3711Q 3745Q))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (31106Q 65232Q (\FAULTINIT 31120Q . 40347Q) (\D01.FAULTINIT 40351Q . 45776Q) (
\D01.ASSIGNBUFFERS 46000Q . 51545Q) (\MAIKO.FAULTINIT 51547Q . 54334Q) (\MAIKO.NEWFAULTINIT 54336Q . 
55672Q) (\MAIKO.ASSIGNBUFFERS 55674Q . 61450Q) (\M-VMEMSAVE 61452Q . 64672Q) (\MAIKO.NEWPAGE 64674Q . 
65230Q)) (65432Q 73060Q (\MAIKO.DO.MOVDS 65444Q . 73056Q)) (74217Q 164677Q (\DOVE.FAULTINIT 74231Q . 
100624Q) (\DL.FAULTINIT 100626Q . 105717Q) (\DL.NEWFAULTINIT 105721Q . 152433Q) (\DL.UNMAPPAGES 
152435Q . 153423Q) (\DL.MARK.PAGES.UNAVAILABLE 153425Q . 154363Q) (\DL.ASSIGNBUFFERS 154365Q . 160106Q
) (\CHAIN.UP.RPT 160110Q . 164675Q)) (164742Q 251155Q (\FAULTHANDLER 164754Q . 165632Q) (\PAGEFAULT 
165634Q . 171373Q) (\INVALIDADDR 171375Q . 171651Q) (\INVALIDVP 171653Q . 172112Q) (\FLUSHPAGE 172114Q
 . 177255Q) (\LOADVMEMPAGE 177257Q . 203331Q) (\MOVEREALPAGE 203333Q . 206573Q) (\LOOKUPPAGEMAP 
206575Q . 207567Q) (\VALIDADDRESSP 207571Q . 210061Q) (\LOCKEDPAGEP 210063Q . 211265Q) (
\SELECTREALPAGE 211267Q . 233224Q) (\SPECIALRP 233226Q . 234243Q) (\TRANSFERPAGE 234245Q . 242106Q) (
\UPDATECHAIN 242110Q . 251153Q)) (251237Q 326030Q (\NEWPAGE 251251Q . 253267Q) (\DONEWPAGE 253271Q . 
263030Q) (\ASSURE.FPTOVP.PAGE 263032Q . 266004Q) (\MAKESPACEFORLOCKEDPAGE 266006Q . 273410Q) (
\MOVEVMEMFILEPAGE 273412Q . 276033Q) (\NEWEPHEMERALPAGE 276035Q . 276566Q) (\DONEWEPHEMERALPAGE 
276570Q . 304006Q) (\LOCKPAGES 304010Q . 304434Q) (\DOLOCKPAGES 304436Q . 314202Q) (\TEMPLOCKPAGES 
314204Q . 314713Q) (\DOTEMPLOCKPAGES 314715Q . 317730Q) (\TEMPUNLOCKPAGES 317732Q . 322614Q) (
\UNLOCKPAGES 322616Q . 326026Q)) (326076Q 350675Q (\DOFLUSHVM 326110Q . 330574Q) (\RELEASEWORKINGSET 
330576Q . 332366Q) (\WRITEDIRTYPAGE 332370Q . 346134Q) (\WRITEDIRTYPAGE1 346136Q . 347463Q) (
\COUNTREALPAGES 347465Q . 350673Q)) (350743Q 354272Q (\DOCOMPRESSVMEM 350755Q . 353273Q) (
VMEM.PURE.STATE 353275Q . 354270Q)) (354541Q 365050Q (32MBADDRESSABLE 354553Q . 355221Q) (
\SET.VMEM.FULL.STATE 355223Q . 357144Q) (\SET.LASTVMEMFILEPAGE 357146Q . 360517Q) (
\DOVMEMFULLINTERRUPT 360521Q . 364264Q) (\FLUSHVMOK? 364266Q . 365046Q)) (366524Q 367160Q (\MP.ERROR 
366536Q . 367156Q)) (367311Q 417121Q (\ACTONVMEMFILE 367323Q . 370122Q) (\SHOWPAGETABLE 370124Q . 
375625Q) (CHECKPAGEMAP 375627Q . 403511Q) (CHECKFPTOVP 403513Q . 404525Q) (CHECKFPTOVP1 404527Q . 
405716Q) (\PRINTFPTOVP 405720Q . 416603Q) (\PRINTVP 416605Q . 417117Q)) (437066Q 466564Q (ADDPME 
437100Q . 442447Q) (CHECKIFPAGE 442451Q . 442723Q) (DUMPINITPAGES 442725Q . 450343Q) (MAKEROOMFORPME 
450345Q . 452045Q) (MAPPAGES 452047Q . 453246Q) (READPAGEMAP 453250Q . 462425Q) (READPAGEMAPBLOCK 
462427Q . 463217Q) (SETUPPAGEMAP 463221Q . 466562Q)) (471673Q 474241Q (\LOCKFN 471705Q . 472410Q) (
\LOCKCODE 472412Q . 472754Q) (\LOCKVAR 472756Q . 473226Q) (\LOCKCELL 473230Q . 473474Q) (\LOCKWORDS 
473476Q . 474237Q)))))
STOP
\ No newline at end of file
diff --git a/sources/LLFAULT.LCOM b/sources/LLFAULT.LCOM
index 4befe3fe..a003e883 100644
Binary files a/sources/LLFAULT.LCOM and b/sources/LLFAULT.LCOM differ
diff --git a/sources/LOADUP-LISP b/sources/LOADUP-LISP
index c05c31bb..9968095a 100644
--- a/sources/LOADUP-LISP
+++ b/sources/LOADUP-LISP
@@ -1 +1 @@
-(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
(FILECREATED "12-Mar-2021 12:35:42" |{DSK}<home>larry>ilisp>med>sources>LOADUP-LISP.;4| 8422   

      |changes| |to:|  (FNS LOADUP-LISP)

      |previous| |date:| "12-Mar-2021 10:15:45" |{DSK}<home>larry>ilisp>med>sources>LOADUP-LISP.;3|
)


(PRETTYCOMPRINT LOADUP-LISPCOMS)

(RPAQQ LOADUP-LISPCOMS ((FNS LOADUP-LISP)
                            (FNS MEDLEY-INIT-VARS MEDLEYDIR)
                            (INITVARS (FILING.ENUMERATION.DEPTH T))
                            (VARS MEDLEY-INIT-VARS)
                            (GLOBALVARS XCL::*WHERE-IS-CASH-FILES* LISPMAKESYSDATE MAKESYSFILENAME 
                                   MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)))
(DEFINEQ

(LOADUP-LISP
  (LAMBDA NIL                                         (* \; "Edited 12-Mar-2021 12:35 by larry")
    (SETQQ COMPILE.EXT LCOM)                                 (* \; "should be set earlier")
    (DRIBBLE (MEDLEYDIR "tmp" "lisp.dribble" T))
    (FOR X IN BOOTLOADEDFILES DO (CL:UNLESS (MEMB X SYSFILES)
                                                 (PRINTOUT T X " bootloaded" T)
                                                 (SETQ SYSFILES (CONS X SYSFILES))))
    (SETQ BOOTLOADEDFILES NIL)
    (IF (NOT (BOUNDP 'DIRECTORIES))
        THEN (SETQ DIRECTORIES LOADUPDIRECTORIES))

    (* |;;| "following files are really loaded earlier, this call to LOADUP just cleans up")

    (LOADUP '(ACODE MACHINEINDEPENDENT POSTLOADUP))

    (* |;;| "establish all package exports early")

    (LOADUP '(LISP-PACKAGE FASL-PACKAGE D-ASSEM-PACKAGE COMPILER-PACKAGE))

    (* |;;| "load FASL loader here, so we can load DFASLs earlier in loadup")

    (LOADUP '(ERROR-RUNTIME CMLARITH CONDITION-HIERARCHY CMLHASH D-ASSEM FASLOAD))

    (* |;;| "These are needed by any FASL files")

    (LOADUP '(DEFFER-RUNTIME CMLPRINT CLSTREAMS CMLSTRING CMLSYMBOL CMLTYPES CMLSEQCOMMON 
                    CMLSEQMAPPERS CMLPATHNAME CMLFILESYS))

(* |;;;| "* 'FASL files may be loaded after this point' * * *")

    (LOADUP '(CMLDEFFER ERROR-RUNTIME-AFTER-FASL WRAPPERS))

    (* |;;| "early runtime support for Common Lisp and (temporarily) debugger")

    (LOADUP '(STACKFNS CMLMVS MACROS MACROAUX UNWINDMACROS))
    (LOADUP '(COMMON XCLC-RUNTIME CMLTYPES CL-ERROR))
    (LOADUP '(AFONT EDIT WEDIT PRETTY DSPRINTDEF NEWPRINTDEF FONTPROFILE SPELLFILE PRINTFN LOADFNS 
                    DMISC DIRECTORY SPELLFILE FILEPKG RESOURCE))

    (* |;;| "needed for makesys")

    (LOADUP '(MOD44IO))                                      (* \; 
                                                        "some needed functions here, should remove")

    (* |;;| "The Byte Compiler (DLAP, BYTECOMPILER, COMPILER) used to be here.  Moved after    XCL Compiler so that one byte compiler init will work.  JDS 10/11/89")

    (LOADUP '(HIST UNDO SPELL DWIM WTFIX CLISP DWIMIFY CLISPIFY RECORD))
    (LOADUP '(GAINSPACE COROUTINE ARGLIST ASKUSER SYSPRETTY COMMON COMPARE))
    (DWIM 'C)

    (* |;;| "Kernel Common Lisp files")

    (LOADUP '(CMLSTEP CMLDOC CMLPARSE CMLSETF CMLPRED CMLREAD WALKER CMLSEQFINDER CMLSEQMODIFY 
                    CMLSORT DEFSTRUCT CMLMISCIO CMLCOMPILE CMLDESTRUCT CL-ERROR CMLFORMAT 
                    CMLENVIRONMENT CMLLOAD CMLFLOAT CMLTIME CMLRAND CMLMODULES))
    (LOADUP '(PROFILE CMLEXEC EXEC-COMMANDS DEBUGGER IL-ERROR-STUFF DEBUGEDIT))
    (LOADUP '(ADDARITH))
    (LOADUP '(CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY MENU WINDOWOBJ WINDOWSCROLL WINDOW 
                    WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT DESCRIBE 
                    CMLARRAYINSPECTOR EDITINTERFACE TTYIN))
    (LOADUP '(BREAK-AND-TRACE))
    (LOADUP '(FASDUMP XCL-COMPILER ADVISE))

    (* |;;| "the bytecompiler and Interlisp compiler interface functions")

    (LOADUP '(DLAP BYTECOMPILER COMPILE))
    (LOADUP '(HARDCOPY LOGOW IDLER ICONW FREEMENU SEDIT))    (* \; "don't want LOGOW ")
    (CLOSEW (LOGOW))
    (MOVD 'NILL 'LOGOW)
    (LOADUP '(DSK UFS UFSCALLC MAIKOBITBLT))
    (LOADUP '(TIME))
    (LOADUP '(BRKDWN))
    (LOADUP '(XCL-EXTRAS))                                   (* 
                                                           "CMLPACKAGE pushes onto INSPECTMACROS")
    (LOADUP '(CMLPACKAGE))

    (* |;;| "Puts ARGNAME properties on CL and XCL functions that IL:SMARTARGLIST can't hack. Keep this last so everything will be defined when it runs")

    (LOADUP '(CMLSMARTARGS))
    (LOADUP '(IMPLICIT-KEY-HASH CLOSURE-CACHE))

    (* |;;| "Already enabled, but this time fixes tables that weren't defined in the init")

    (PACKAGE-ENABLE)
    (DRIBBLE)
    (SETQ MAKESSNAME ':MEDLEY)))
)
(DEFINEQ

(MEDLEY-INIT-VARS
  (LAMBDA (CLEAR)                                     (* \; "Edited 17-Jan-2021 14:29 by larry")

    (* |;;| "MEDLEY-INIT-VARS has variables that might need to get reset. ")

    (|if| CLEAR
        |then| (SETQ MEDLEYDIR NIL)
              (SETQ XCL::*WHERE-IS-CASH-FILES* NIL)
              (|for| X |in| MEDLEY-INIT-VARS |do| (SET (CAR X)))
      |elseif| (OR (NOT (BOUNDP 'MEDLEYDIR))
                       (AND (NULL MEDLEYDIR)
                            (NULL (MEDLEYDIR))))
        |then| (PRINTOUT T "WARNING: MEDLEYDIR not set correctly" 
                          " set it and call (MEDLEY-INIT-VARS) again" T)
      |else| (|for| X |in| MEDLEY-INIT-VARS |do| (SET (CAR X)
                                                                      (EVAL (CADR X)))) 

            (* |;;| "WHEREIS doesn't follow conventions")

            (CL:WHEN (GETD 'XCL::ADD-WHERE-IS-DATABASE)
                (SETQ XCL::*WHERE-IS-CASH-FILES* NIL)
                (NLSETQ (XCL::ADD-WHERE-IS-DATABASE (MEDLEYDIR "loadups" "WHEREIS.HASH"))))
            NIL)))

(MEDLEYDIR
  (LAMBDA (DIRNAME FILENAME OUTPUT NOERROR)           (* \; "Edited 14-Dec-2020 17:12 by larry")
    (|if| (NULL DIRNAME)
        |then| (|if| (OR (NOT (BOUNDP 'MEDLEYDIR))
                                 (NOT MEDLEYDIR))
                       |then| (OR (SETQ MEDLEYDIR (DIRECTORYNAME (OR (UNIX-GETENV "MEDLEYDIR")
                                                                         T)))
                                      (DIRECTORYNAME T))
                     |elseif| (STRPOS "/" MEDLEYDIR)
                       |then| (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR))
                     |else| MEDLEYDIR)
      |elseif| (LISTP DIRNAME)
        |then| (|for| X |in| DIRNAME |collect| (MEDLEYDIR X))
      |elseif| FILENAME
        |then| (SETQ FILENAME (CONCAT (MEDLEYDIR DIRNAME)
                                         FILENAME))
              (|if| OUTPUT
                  |then| FILENAME
                |else| (OR NOERROR (INFILEP FILENAME)
                               (ERROR "No such medley file" FILENAME)))
      |else| (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR)
                                           DIRNAME))
                     NOERROR
                     (ERROR "No such medley directory" DIRNAME)))))
)

(RPAQ? FILING.ENUMERATION.DEPTH T)

(RPAQQ MEDLEY-INIT-VARS
       ((LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal/library")))
        (LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources")))
        (LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES))
        (IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo"))
        (IRM.DINFOGRAPH)
        (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))
        (LOGINHOST/DIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
                                          (UNIX-GETENV "HOME"))))
        (USERGREETFILES `((,LOGINHOST/DIR "INIT" COM)
                          (,LOGINHOST/DIR "INIT")))
        (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/displayfonts" "fonts/altofonts")))
        (POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts")))
        (INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts")))
        (XCL::*WHERE-IS-CASH-FILES*)))
(DECLARE\: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS XCL::*WHERE-IS-CASH-FILES* LISPMAKESYSDATE MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR 
       SYSTEMINITVARS USERRECLST)
)
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (758 4802 (LOADUP-LISP 768 . 4800)) (4803 7302 (MEDLEY-INIT-VARS 4813 . 5958) (MEDLEYDIR
 5960 . 7300)))))
STOP
\ No newline at end of file
+(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
(FILECREATED "16-Mar-2021 10:17:58" |{DSK}<home>larry>ilisp>medley>sources>LOADUP-LISP.;6| 8250   

      |changes| |to:|  (FNS LOADUP-LISP)

      |previous| |date:| "12-Mar-2021 12:35:42" |{DSK}<home>larry>ilisp>medley>sources>LOADUP-LISP.;5|
)


(PRETTYCOMPRINT LOADUP-LISPCOMS)

(RPAQQ LOADUP-LISPCOMS ((FNS LOADUP-LISP)
                            (FNS MEDLEY-INIT-VARS MEDLEYDIR)
                            (INITVARS (FILING.ENUMERATION.DEPTH T))
                            (VARS MEDLEY-INIT-VARS)
                            (GLOBALVARS XCL::*WHERE-IS-CASH-FILES* LISPMAKESYSDATE MAKESYSFILENAME 
                                   MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)))
(DEFINEQ

(LOADUP-LISP
  (LAMBDA NIL                                         (* \; "Edited 16-Mar-2021 10:17 by larry")
    (SETQQ COMPILE.EXT LCOM)                                 (* \; "should be set earlier")
    (DRIBBLE (MEDLEYDIR "tmp" "lisp.dribble" T))
    (FOR X IN BOOTLOADEDFILES DO (CL:UNLESS (MEMB X SYSFILES)
                                                 (PRINTOUT T X " bootloaded" T)
                                                 (SETQ SYSFILES (CONS X SYSFILES))))
    (SETQ BOOTLOADEDFILES NIL)
    (IF (NOT (BOUNDP 'DIRECTORIES))
        THEN (SETQ DIRECTORIES LOADUPDIRECTORIES))

    (* |;;| "following files are really loaded earlier, this call to LOADUP just cleans up")

    (LOADUP '(ACODE MACHINEINDEPENDENT POSTLOADUP))

    (* |;;| "establish all package exports early")

    (LOADUP '(LISP-PACKAGE FASL-PACKAGE D-ASSEM-PACKAGE COMPILER-PACKAGE))

    (* |;;| "load FASL loader here, so we can load DFASLs earlier in loadup")

    (LOADUP '(ERROR-RUNTIME CMLARITH CONDITION-HIERARCHY CMLHASH D-ASSEM FASLOAD))

    (* |;;| "These are needed by any FASL files")

    (LOADUP '(DEFFER-RUNTIME CMLPRINT CLSTREAMS CMLSTRING CMLSYMBOL CMLTYPES CMLSEQCOMMON 
                    CMLSEQMAPPERS CMLPATHNAME CMLFILESYS))

(* |;;;| "* 'FASL files may be loaded after this point' * * *")

    (LOADUP '(CMLDEFFER ERROR-RUNTIME-AFTER-FASL WRAPPERS))

    (* |;;| "early runtime support for Common Lisp and (temporarily) debugger")

    (LOADUP '(STACKFNS CMLMVS MACROS MACROAUX UNWINDMACROS))
    (LOADUP '(COMMON XCLC-RUNTIME CMLTYPES CL-ERROR))
    (LOADUP '(AFONT EDIT WEDIT PRETTY DSPRINTDEF NEWPRINTDEF FONTPROFILE SPELLFILE PRINTFN LOADFNS 
                    DMISC DIRECTORY SPELLFILE FILEPKG RESOURCE))

    (* |;;| "needed for makesys")

    (* |;;| "The Byte Compiler (DLAP, BYTECOMPILER, COMPILER) used to be here.  Moved after    XCL Compiler so that one byte compiler init will work.  JDS 10/11/89")

    (LOADUP '(HIST UNDO SPELL DWIM WTFIX CLISP DWIMIFY CLISPIFY RECORD))
    (LOADUP '(GAINSPACE COROUTINE ARGLIST ASKUSER SYSPRETTY COMMON COMPARE))
    (DWIM 'C)

    (* |;;| "Kernel Common Lisp files")

    (LOADUP '(CMLSTEP CMLDOC CMLPARSE CMLSETF CMLPRED CMLREAD WALKER CMLSEQFINDER CMLSEQMODIFY 
                    CMLSORT DEFSTRUCT CMLMISCIO CMLCOMPILE CMLDESTRUCT CL-ERROR CMLFORMAT 
                    CMLENVIRONMENT CMLLOAD CMLFLOAT CMLTIME CMLRAND CMLMODULES))
    (LOADUP '(PROFILE CMLEXEC EXEC-COMMANDS DEBUGGER IL-ERROR-STUFF DEBUGEDIT))
    (LOADUP '(ADDARITH))
    (LOADUP '(CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY MENU WINDOWOBJ WINDOWSCROLL WINDOW 
                    WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT DESCRIBE 
                    CMLARRAYINSPECTOR EDITINTERFACE TTYIN))
    (LOADUP '(BREAK-AND-TRACE))
    (LOADUP '(FASDUMP XCL-COMPILER ADVISE))

    (* |;;| "the bytecompiler and Interlisp compiler interface functions")

    (LOADUP '(DLAP BYTECOMPILER COMPILE))
    (LOADUP '(HARDCOPY LOGOW IDLER ICONW FREEMENU SEDIT))    (* \; "don't want LOGOW ")
    (CLOSEW (LOGOW))
    (MOVD 'NILL 'LOGOW)
    (LOADUP '(DSK UFS UFSCALLC MAIKOBITBLT))
    (LOADUP '(TIME))
    (LOADUP '(BRKDWN))
    (LOADUP '(XCL-EXTRAS))                                   (* 
                                                           "CMLPACKAGE pushes onto INSPECTMACROS")
    (LOADUP '(CMLPACKAGE))

    (* |;;| "Puts ARGNAME properties on CL and XCL functions that IL:SMARTARGLIST can't hack. Keep this last so everything will be defined when it runs")

    (LOADUP '(CMLSMARTARGS))
    (LOADUP '(IMPLICIT-KEY-HASH CLOSURE-CACHE))

    (* |;;| "Already enabled, but this time fixes tables that weren't defined in the init")

    (PACKAGE-ENABLE)
    (DRIBBLE)
    (SETQ MAKESSNAME ':MEDLEY)))
)
(DEFINEQ

(MEDLEY-INIT-VARS
  (LAMBDA (CLEAR)                                     (* \; "Edited 17-Jan-2021 14:29 by larry")

    (* |;;| "MEDLEY-INIT-VARS has variables that might need to get reset. ")

    (|if| CLEAR
        |then| (SETQ MEDLEYDIR NIL)
              (SETQ XCL::*WHERE-IS-CASH-FILES* NIL)
              (|for| X |in| MEDLEY-INIT-VARS |do| (SET (CAR X)))
      |elseif| (OR (NOT (BOUNDP 'MEDLEYDIR))
                       (AND (NULL MEDLEYDIR)
                            (NULL (MEDLEYDIR))))
        |then| (PRINTOUT T "WARNING: MEDLEYDIR not set correctly" 
                          " set it and call (MEDLEY-INIT-VARS) again" T)
      |else| (|for| X |in| MEDLEY-INIT-VARS |do| (SET (CAR X)
                                                                      (EVAL (CADR X)))) 

            (* |;;| "WHEREIS doesn't follow conventions")

            (CL:WHEN (GETD 'XCL::ADD-WHERE-IS-DATABASE)
                (SETQ XCL::*WHERE-IS-CASH-FILES* NIL)
                (NLSETQ (XCL::ADD-WHERE-IS-DATABASE (MEDLEYDIR "loadups" "WHEREIS.HASH"))))
            NIL)))

(MEDLEYDIR
  (LAMBDA (DIRNAME FILENAME OUTPUT NOERROR)           (* \; "Edited 14-Dec-2020 17:12 by larry")
    (|if| (NULL DIRNAME)
        |then| (|if| (OR (NOT (BOUNDP 'MEDLEYDIR))
                                 (NOT MEDLEYDIR))
                       |then| (OR (SETQ MEDLEYDIR (DIRECTORYNAME (OR (UNIX-GETENV "MEDLEYDIR")
                                                                         T)))
                                      (DIRECTORYNAME T))
                     |elseif| (STRPOS "/" MEDLEYDIR)
                       |then| (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR))
                     |else| MEDLEYDIR)
      |elseif| (LISTP DIRNAME)
        |then| (|for| X |in| DIRNAME |collect| (MEDLEYDIR X))
      |elseif| FILENAME
        |then| (SETQ FILENAME (CONCAT (MEDLEYDIR DIRNAME)
                                         FILENAME))
              (|if| OUTPUT
                  |then| FILENAME
                |else| (OR NOERROR (INFILEP FILENAME)
                               (ERROR "No such medley file" FILENAME)))
      |else| (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR)
                                           DIRNAME))
                     NOERROR
                     (ERROR "No such medley directory" DIRNAME)))))
)

(RPAQ? FILING.ENUMERATION.DEPTH T)

(RPAQQ MEDLEY-INIT-VARS
       ((LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal/library")))
        (LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources")))
        (LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES))
        (IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo"))
        (IRM.DINFOGRAPH)
        (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))
        (LOGINHOST/DIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
                                          (UNIX-GETENV "HOME"))))
        (USERGREETFILES `((,LOGINHOST/DIR "INIT" COM)
                          (,LOGINHOST/DIR "INIT")))
        (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/displayfonts" "fonts/altofonts")))
        (POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts")))
        (INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts")))
        (XCL::*WHERE-IS-CASH-FILES*)))
(DECLARE\: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS XCL::*WHERE-IS-CASH-FILES* LISPMAKESYSDATE MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR 
       SYSTEMINITVARS USERRECLST)
)
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (764 4630 (LOADUP-LISP 774 . 4628)) (4631 7130 (MEDLEY-INIT-VARS 4641 . 5786) (MEDLEYDIR
 5788 . 7128)))))
STOP
\ No newline at end of file
diff --git a/sources/LOADUP-LISP.LCOM b/sources/LOADUP-LISP.LCOM
index 20f5cb78..4b5f92ec 100644
Binary files a/sources/LOADUP-LISP.LCOM and b/sources/LOADUP-LISP.LCOM differ
diff --git a/sources/MOD44IO b/sources/MOD44IO
index c89b0672..04e34022 100644
--- a/sources/MOD44IO
+++ b/sources/MOD44IO
@@ -1 +1 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "21-Jan-91 23:56:42" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>MOD44IO.;4| 143621 

      changes to%:  (VARS MOD44IOCOMS)
                    (FNS \M44AddDiskPages \M44CompleteFH \M44CREATEFILE \M44DeleteFile \M44EVENTFN 
                         \M44ExtendFilePageMap \M44FillInMap \M44GetFileHandle \M44GetFileInfo 
                         \M44GetFileName \M44GetPageLoc \M44KillFilePageMap \M44MAKEDIRENTRY 
                         \M44OpenFile \M44OPENFILEFROMFP \M44ReadDiskPage \M44ReadLeaderPage 
                         \M44SetAccessTimes \M44SetEndOfFile \M44SetFileInfo \M44SETFILETYPE 
                         \M44TruncateFile \M44WriteDiskPage \M44WriteLeaderPage \M44WritePages 
                         \M44WritePages1 \ADDDISKPAGES \M44DELETEPAGES \ASSIGNDISKPAGE 
                         \M44FLUSHDISKDESCRIPTOR \MAKELEADERDAS \M44GENERATENEXT \M44NEXTFILEFN 
                         \M44SORTEDNEXTFILEFN \M44FILEINFOFN \M44PARSEFILENAME \FINDDIRHOLE 
                         \OPENDISKDESCRIPTOR \M44READDIRFID \M44SEARCHDIR \M44UNPACKFILENAME 
                         \CREATE.FID.FOR.DD \OPENDISK \OPENDISKDEVICE GATHERSTATS)

      previous date%: "16-May-90 20:44:00" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>MOD44IO.;3|)


(* ; "
Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT MOD44IOCOMS)

(RPAQQ MOD44IOCOMS
       (

(* ;;; "Dorado disk driver")

        (COMS 
              (* ;; "Device dependent code for the Model44 disk")

              (FNS \M44AddDiskPages \M44CloseFile \M44CompleteFH \M44CREATEFILE \M44DeleteFile 
                   \M44EVENTFN \M44ExtendFilePageMap \M44FillInMap \M44GetFileHandle \M44GetFileInfo
                   \M44GETDATEPROP \M44GetFileName \M44GetPageLoc \M44KillFilePageMap 
                   \M44MAKEDIRENTRY \M44OpenFile \M44OPENFILEFROMFP \M44ReadDiskPage 
                   \M44ReadLeaderPage \M44ReadPages \M44SetAccessTimes \M44SetEndOfFile 
                   \M44SetFileInfo \M44SETFILETYPE \M44TruncateFile \M44WriteDiskPage 
                   \M44WriteLeaderPage \M44WritePages \M44WritePages1))
        (COMS 
              (* ;; "Disk allocation")

              (FNS \ADDDISKPAGES \M44DELETEPAGES \ASSIGNDISKPAGE \COUNTDISKFREEPAGES \M44MARKPAGEFREE
                   \M44FLUSHDISKDESCRIPTOR \MAKELEADERDAS DISKFREEPAGES \M44FREEPAGECOUNT VMEMSIZE))
        (COMS (INITVARS (\M44MULTFLG T))
              (DECLARE%: DONTCOPY (MACROS UCASECHAR UPDATEVALIDATION)
                     (RECORDS M44DEVICE)
                     (GLOBALVARS \OPENFILES \M44MULTFLG \DISKNAMECASEARRAY)
                     (MACROS .LISP.TO.BFS. .BFS.TO.LISP. .DISKCASEARRAY.)
                     (CONSTANTS (PageMapIncrement 64)
                            (\MAX.ALTO.NAME.LENGTH 39))
                     (COMS 
                           (* ;; "File properties")

                           (RECORDS M44FILEPROP)
                           (CONSTANTS * FPROPTYPES)
                           (CONSTANTS * FPTYPES))
                     (GLOBALRESOURCES \M44PAGEBUFFER))
              (INITRESOURCES \M44PAGEBUFFER))
        (COMS 
              (* ;; "Directory enumeration")

              (FNS \M44GENERATEFILES \M44SORTFILES \M44GENERATENEXT \M44NEXTFILEFN 
                   \M44SORTEDNEXTFILEFN \M44FILEINFOFN))
        (COMS 
              (* ;; "Directory lookup routines")

              (FNS \M44PARSEFILENAME \FINDDIRHOLE \M44PACKFILENAME \M44READVERSION 
                   \OPENDISKDESCRIPTOR \M44READDIRFID \M44READDIRNAME \M44SEARCHDIR 
                   \M44UNPACKFILENAME)
              (VARS \FILENAMECHARSLST)
              (GLOBALVARS \FILENAMECHARSLST)
              (DECLARE%: DONTCOPY (RECORDS UNAME FILESPEC M44GENFILESTATE M44DIRSEARCHSTATE)
                     (MACROS BETWEEN)))
        (COMS (FNS \CREATE.FID.FOR.DD \OPENDISK \OPENDISKDEVICE \OPENDIR \M44CHECKPASSWORD 
                   \M44HOSTNAMEP)
              (DECLARE%: DONTCOPY (CONSTANTS \OFFSET.BCPLUSERNAME \OFFSET.BCPLPASSWORD 
                                         \NWORDS.BCPLPASSWORD)))
        [COMS 
              (* ;; "SYSOUT etc.")

              (FNS \COPYSYS \COPYSYS1)
              
              (* ;; "For MAIKO. \COPYSYS use UNIX-PAGEPERBLOCK.")

              (FNS \MAIKO.CHECKFREESPACE)
              (INITVARS (\LDEDESTOVERWRITE NIL))
              (DECLARE%: DONTCOPY (CONSTANTS (LISPPAGE-PER-UNIXBLOCK 2]
        (COMS 
              (* ;; "Stats code.  On MOD44IO because it writes on the disk and uses records not exported from MOD44IO.  (For this and other reasons, GATHERSTATS only works on Dorados.)")

              (FNS GATHERSTATS)
              (VARS (\STATSON NIL)))
        (DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
               (FILES (LOADCOMP)
                      LLBFS))))



(* ;;; "Dorado disk driver")




(* ;; "Device dependent code for the Model44 disk")

(DEFINEQ

(\M44AddDiskPages
  [LAMBDA (STREAM NEWLASTPAGE NEWLASTBYTE)               (* ; "Edited 21-Jan-91 23:35 by jds")

    (* ;; "Add pages to an existing Model44 file.  NEWLASTPAGE is the page number of the last page in the extended file.  Return the disk address of the new last page.")

    (\M44FillInMap STREAM (fetch (M44STREAM LastPage) of STREAM))
                                                             (* ; 
                     "Fill in map to end of file.  Code below assumes at least one valid map entry")
    (\ADDDISKPAGES STREAM (ADD1 (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM))
           (IDIFFERENCE NEWLASTPAGE (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM))
           (fetch (ARRAYP BASE) of (\M44ExtendFilePageMap STREAM NEWLASTPAGE))
           NEWLASTBYTE)
    (replace (M44STREAM LASTMAPPEDPAGE) of STREAM with NEWLASTPAGE)
    (replace (M44STREAM LastPage) of STREAM with NEWLASTPAGE)
    (replace (M44STREAM LastOffset) of STREAM with NEWLASTBYTE)
                                                             (* ; 
                                                           "record new eof in filehandle only")
    NEWLASTPAGE])

(\M44CloseFile
(LAMBDA (STREAM) (* hdj "25-Sep-86 11:03") (\CLEARMAP STREAM) (COND ((NEQ (fetch ACCESS of STREAM) (QUOTE INPUT)) (* ; "Update EOF in leader page") (\M44TruncateFile STREAM (fetch EPAGE of STREAM) (fetch EOFFSET of STREAM) T) (\M44FLUSHDISKDESCRIPTOR (fetch DEVICE of STREAM)))) STREAM)
)

(\M44CompleteFH
  [LAMBDA (STREAM)                                       (* ; "Edited 21-Jan-91 23:41 by jds")

    (* ;; "Completes the fields of a file handle that describes an existing file by reading in its leader page which it leaves for its caller")

    (PROG ((NUMCHARS (CONS))
           (LEADERPAGE (\M44ReadLeaderPage STREAM))
           (DSK (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE of STREAM)))
           LASTPAGE# NBYTES)

     (* ;; "Get the page number and the number of bytes on the last page of the file specified by fHandle.  If the last page number hint is wrong in the leader page, then find the real last page and change the hint.")

          (COND
             ((AND (NEQ (SETQ LASTPAGE# (.BFS.TO.LISP. (fetch (\M44LeaderPage LastPageNumber)
                                                          of LEADERPAGE)))
                        -1)
                   (EQ [PROG ((DAs (ARRAY 3 'WORD \FILLINDA 0))
                              (BFSPG# (.LISP.TO.BFS. LASTPAGE#)))
                             (SETA DAs 1 (fetch (\M44LeaderPage LastPageAddress) of 
                                                                                           LEADERPAGE
                                                ))
                             (SETA DAs 2 \EOFDA)
                             (RETURN (AND (EQ (\ACTONDISKPAGES DSK NIL (fetch (ARRAYP BASE)
                                                                          of DAs)
                                                     LASTPAGE# STREAM BFSPG# BFSPG# \DC.READD 
                                                     NUMCHARS NIL T)
                                              BFSPG#)
                                          (SETQ NBYTES (CAR NUMCHARS]
                       (fetch (\M44LeaderPage LastPageByteCount) of LEADERPAGE)))
              (replace (M44STREAM LastPage) of STREAM with LASTPAGE#)
                                                             (* ; "Update STREAM eof")
              (replace (M44STREAM LastOffset) of STREAM with NBYTES))
             (T                                              (* ; 
                                                    "Hint was wrong so scan the file for last page")
                (for PN from PageMapIncrement by PageMapIncrement
                   do (SETQ LASTPAGE# (\M44FillInMap STREAM PN)) 
                                                             (* ; 
                                                           "Wait until attempt to find page fails")
                   repeatwhile (EQ PN LASTPAGE#))
                (SETQ NBYTES (\ACTONDISKPAGES DSK NIL (fetch (ARRAYP BASE)
                                                         of (fetch (M44STREAM FILEPAGEMAP)
                                                                   of STREAM))
                                    -1 STREAM (.LISP.TO.BFS. LASTPAGE#)
                                    (.LISP.TO.BFS. LASTPAGE#)
                                    \DC.READD NUMCHARS))     (* ; 
                                              "Read last page to find out how many bytes are on it")
                (\M44SetEndOfFile STREAM LASTPAGE# (CAR NUMCHARS)
                       T)))
          (UPDATEVALIDATION STREAM LEADERPAGE)               (* ; 
                                         "Validation is low order bits of creation and write dates")
          [COND
             ((EQ (fetch (M44STREAM LastOffset) of STREAM)
                  BYTESPERPAGE)

              (* ;; "Shouldn't happen, because alto files should never have a full last page.  However, cope if it happens...")

              (replace EPAGE of STREAM with (ADD1 (fetch (M44STREAM LastPage)
                                                                 of STREAM)))
              (replace EOFFSET of STREAM with 0))
             (T (replace EPAGE of STREAM with (fetch (M44STREAM LastPage)
                                                             of STREAM))
                (replace EOFFSET of STREAM with (fetch (M44STREAM LastOffset)
                                                               of STREAM]
          (RETURN STREAM])

(\M44CREATEFILE
  [LAMBDA (FDEV UNAME LENGTH CRDATE TYPE DIRECTORYP)     (* ; "Edited 21-Jan-91 23:41 by jds")

    (* ;; "Create a file on the Model44 disk.")

    (PROG ((DSK (fetch (M44DEVICE DSKOBJ) of FDEV))
           (PNAME (\M44PACKFILENAME UNAME))
           (LEADERPAGE (create \M44LeaderPage))
           (NC 0)
           STREAM FP MAP FPBASE DAT PSTART)
          (OR PNAME (RETURN))                                (* ; 
                                                           "Cant create as name wasnt complete")
          (SETQ STREAM (create M44STREAM))
          (replace FULLFILENAME of STREAM with PNAME)
          (replace DEVICE of STREAM with FDEV)
          (replace (M44STREAM FID) of STREAM with (SETQ FP (create FID)))
          (replace (M44STREAM FILEPAGEMAP) of STREAM
             with (SETQ MAP (ARRAY (COND
                                          ((FIXP LENGTH)
                                           (IPLUS 4 (FOLDHI LENGTH BYTESPERPAGE)))
                                          (T PageMapIncrement))
                                       'WORD \FILLINDA 0)))
          (replace (M44STREAM LASTMAPPEDPAGE) of STREAM with 0)
          (replace MULTIBUFFERHINT of STREAM with \M44MULTFLG)
          (replace (M44STREAM LEADERPAGE) of STREAM with LEADERPAGE)
          (SETQ FPBASE (fetch (ARRAYP BASE) of FP))
          (replace (FP FPSERIAL#) of FPBASE with (add (fetch (DSKOBJ 
                                                                                      DISKLASTSERIAL#
                                                                                        )
                                                                         of DSK)
                                                                    1))
          (COND
             (DIRECTORYP (add (fetch (FP FPSERIALHI) of FPBASE)
                                \FP.DIRECTORYP)))
          (replace (FP FPVERSION) of FPBASE with 1)
          (SETA MAP 0 \EOFDA)
          (SETA MAP 3 \EOFDA)                                (* ; 
                             "We are about to create pages 0 and 1, everything else is nonexistent")
                                                             (* ; 
                         "Done by the NCREATE -- (\ZEROPAGE (fetch (POINTER PAGE#) of LEADERPAGE))")
          (\BLT (LOCF (fetch (\M44LeaderPage TimeWrite) of LEADERPAGE))
                (SETQ DAT (\DAYTIME0 (create FIXP)))
                WORDSPERCELL)                                (* ; "Set creation and write dates")
          (\BLT (LOCF (fetch (\M44LeaderPage TimeCreate) of LEADERPAGE))
                (OR CRDATE DAT)
                WORDSPERCELL)                                (* ; 
                                                         "See \M44MAKEDIRENTRY for the name logic.")
          (for C in (fetch (UNAME ORIGCHARS) of UNAME)
             bind (NAMEBASE _ (LOCF (fetch (\M44LeaderPage NameCharCount) of LEADERPAGE))
                             )
                   (V _ (fetch (UNAME VERSION) of UNAME))
             do (\PUTBASEBYTE NAMEBASE (add NC 1)
                           C) finally [COND
                                             ((NEQ V 1)
                                              (\PUTBASEBYTE NAMEBASE (add NC 1)
                                                     (CHARCODE !))
                                              (for C in (CHCON V)
                                                 do (\PUTBASEBYTE NAMEBASE (add NC 1)
                                                               C]
                                    (\PUTBASEBYTE NAMEBASE (add NC 1)
                                           (CHARCODE %.))    (* ; 
                                                          "Last character of all alto names is dot")
                                    (replace (\M44LeaderPage NameCharCount) of LEADERPAGE
                                       with NC))
          (replace (\M44LeaderPage PropertyBegin) of LEADERPAGE
             with (INDEXF (FETCH (\M44LeaderPage LeaderProps) of LEADERPAGE)))
          [replace (\M44LeaderPage PropertyLength) of LEADERPAGE
             with (CONSTANT (- (INDEXF (FETCH (\M44LeaderPage Spares) of LEADERPAGE))
                                   (INDEXF (FETCH (\M44LeaderPage LeaderProps) of LEADERPAGE]
                                                             (* ; "The start and length of the property section are theoretically variable, but at least some %"official%" Alto software, such as Scavenge, believes that file names must be no more than 39 chars.")
          (\M44SETFILETYPE STREAM TYPE)
          (\WRITEDISKPAGES DSK (LIST LEADERPAGE NIL)
                 (fetch (ARRAYP BASE) of MAP)
                 -1 STREAM 0 1 NIL NIL 0 0)                  (* ; 
                    "The end of file will be zero and the validation not set as befits a new file.")
          (replace (FP FPLEADERVDA) of FPBASE with (\WORDELT MAP 1))
                                                             (* ; 
                                     "Now that the file is safely created, make entry in directory")
          (replace (M44STREAM DIRINFO) of STREAM with (\M44MAKEDIRENTRY
                                                                   (fetch (M44STREAM FID)
                                                                      of STREAM)
                                                                   UNAME NC FDEV))
          (RETURN STREAM])

(\M44DeleteFile
  [LAMBDA (FILENAME DEV)                                 (* ; "Edited 21-Jan-91 23:35 by jds")
                                                             (* ; "Delete a Model44 file.")
    (PROG ((STREAM (\M44GetFileHandle FILENAME 'OLDEST DEV T)))
          (COND
             ((OR (NOT STREAM)
                  (FDEVOP 'OPENP DEV (fetch FULLFILENAME of STREAM)
                         NIL DEV))                           (* ; "Can't delete an open file")
              (RETURN)))
          (\M44DELETEPAGES STREAM -1)
          (PROG ((DIROFD (fetch (M44DEVICE SYSDIROFD) of DEV)))
                                                             (* ; "Delete directory entry")
                (\SETFILEPTR DIROFD (fetch (M44STREAM DIRINFO) of STREAM))
                (\BOUT DIROFD (LOGAND 3 (\PEEKBIN DIROFD)))
                (FLUSHMAP DIROFD))
          (\M44KillFilePageMap STREAM)
          (replace (M44STREAM FID) of STREAM with NIL)
          (RETURN (fetch FULLFILENAME of STREAM])

(\M44EVENTFN
  [LAMBDA (FDEV EVENT)                                   (* ; "Edited 21-Jan-91 23:31 by jds")
    (DECLARE (GLOBALVARS \DEVICENAMETODEVICE \MACHINETYPE))
    (SELECTQ EVENT
        ((AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM) 
                                                            (* ;; 
                                          "reinitialize DSK device and revalidate its open streams")

             [PROG ((DSKOBJ (fetch (M44DEVICE DSKOBJ) of FDEV))
                    DD)
                   (COND
                      ((SETQ DD (fetch (DSKOBJ DISKDESCRIPTOROFD) of DSKOBJ))
                                                             (* ; 
                                                           "Flush out of date disk descriptor")
                       (FORGETPAGES DD)
                       (FDEVOP 'UNREGISTERFILE FDEV FDEV DD) (* ; 
      "Stream no longer in use.  Don't go thru \M44CloseFile because it will try to Truncate, etc.")
                       (replace (DSKOBJ DDVALID) of DSKOBJ with NIL)
                       (replace (DSKOBJ DISKDESCRIPTOROFD) of DSKOBJ with NIL)))
                   (FORGETPAGES (fetch (DSKOBJ SYSDIROFD) of DSKOBJ))
                   (FDEVOP 'UNREGISTERFILE FDEV FDEV (fetch (DSKOBJ SYSDIROFD) of DSKOBJ))
                   (COND
                      [(AND (EQ \MACHINETYPE \DORADO)
                            (LET [(PARTZEROP (EQ (fetch (M44DEVICE DSKPARTITION) of FDEV)
                                                 0))
                                  (CURPARTP (EQ (fetch (FDEV DEVICENAME) of FDEV)
                                                (PACK* 'DSK (DISKPARTITION]
                                 (COND
                                    (PARTZEROP               (* ; 
       "This is interlock with \M44EXTENDVMEMFILE which doesn't want to mess up the DiskDescriptor")
                                           (SETQ \M44.READY T)))
                                 (COND
                                    ((OR (AND PARTZEROP CURPARTP)
                                         (\DEVICE-OPEN-STREAMS FDEV))
                                     (COND
                                        ((EQ PARTZEROP CURPARTP)
                                                             (* ; 
                                              "No partition change to worry about, just reopen dir")
                                         (\OPENDIR FDEV))
                                        (PARTZEROP 

                                   (* ;; "This was the default partition, no longer is, so reopen it as if from scratch.  Also, remove the mapping of DSK to this device")

                                               (\REMOVEDEVICE.NAMES FDEV 'DSK)
                                               (\OPENDISK (SUBATOM (fetch (FDEV DEVICENAME)
                                                                          of FDEV)
                                                                     4)
                                                      FDEV))
                                        (T                   (* ; 
       "This was a non-default partition, now the default.  Reopen it with \MAINDISK as its DSKOBJ")
                                           (\OPENDISKDEVICE NIL NIL FDEV]
                      (T 
                         (* ;; "Device no longer exists if machine is now Dandelion;  and if there were no open files, no need to try reopening the dir")

                         (replace (DSKOBJ SYSDIROFD) of DSKOBJ with NIL)

                         (* ;; "Have to explicitly clear these fields, because when we drop the DSKOBJ on the floor, GC does not know about its POINTER fields")

                         (replace REOPENFILE of FDEV with (FUNCTION NILL))
                                                             (* ; 
                            "In case there are files open over sysout as we come back on Dandelion")
                         (\REMOVEDEVICE FDEV]
             (\PAGED.REVALIDATEFILELST FDEV))
        (BEFORELOGOUT (\FLUSH.OPEN.STREAMS FDEV)
                      (\M44FLUSHDISKDESCRIPTOR FDEV))
        NIL])

(\M44ExtendFilePageMap
  [LAMBDA (STREAM TOPAGE#)                               (* ; "Edited 21-Jan-91 23:35 by jds")

    (* ;; "If the file's page map is not big enough to map the given page, then create a new one that is big enough and copy the old OLDMAP information into the new map.  If the file has no map, then create one big enough to map the given page.  Return the new map.  --- Map entry 0 corresponds to bfs page -1, entry 1 corresponds to the leader page, and entry 2 corresponds to Lisp page 0")

    (PROG ((OLDMAP (fetch (M44STREAM FILEPAGEMAP) of STREAM))
           OLDSIZE NEWMAP)
          (RETURN (COND
                     ([AND OLDMAP (ILESSP (IPLUS TOPAGE# 3)
                                         (SETQ OLDSIZE (fetch (ARRAYP LENGTH) of OLDMAP]
                      OLDMAP)
                     (T (SETQ NEWMAP (ARRAY (CEIL (IPLUS TOPAGE# 4)
                                                  PageMapIncrement)
                                            'SMALLPOSP \FILLINDA 0))
                        [COND
                           (OLDMAP                           (* ; "Copy old map into new")
                                  (\BLT (fetch (ARRAYP BASE) of NEWMAP)
                                        (fetch (ARRAYP BASE) of OLDMAP)
                                        OLDSIZE))
                           (T                                (* ; 
                                                           "Initialize with leader page hint")
                              (SETA NEWMAP 0 \EOFDA)
                              (SETA NEWMAP 1 (fetch (FP FPLEADERVDA)
                                                of (fetch (ARRAYP BASE)
                                                          of (fetch (M44STREAM FID)
                                                                    of STREAM]
                        (replace (M44STREAM FILEPAGEMAP) of STREAM with NEWMAP)
                        NEWMAP])

(\M44FillInMap
  [LAMBDA (STREAM UPTOPAGE)                              (* ; "Edited 21-Jan-91 23:42 by jds")

(* ;;; "Assures that the disk address map for STREAM is filled in up thru page# UPTOPAGE.  Reads file as needed")

    (PROG ((MAP (\M44ExtendFilePageMap STREAM UPTOPAGE))
           (DSK (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE of STREAM)))
           (LASTKNOWNPAGE (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM))
           NPAGES LASTPAGEREAD LASTATTEMPTED DAs DA)         (* ; "Extend MAP")
          (SETQ DAs (fetch (ARRAYP BASE) of MAP))
          [while (ILESSP LASTKNOWNPAGE UPTOPAGE)
             do (COND
                       [(NEQ (SETQ DA (\GETBASE DAs (IPLUS LASTKNOWNPAGE 1 2)))
                             \FILLINDA)                      (* ; 
                               "There already is an entry for the next page, so no need to read it")
                        (COND
                           ((EQ DA \EOFDA)
                            (RETURN))
                           (T (add LASTKNOWNPAGE 1]
                       (T [SETQ NPAGES (IMIN \MAXDISKDAs (ADD1 (IDIFFERENCE UPTOPAGE LASTKNOWNPAGE]

                          (* ;; "We know where LASTKNOWNPAGE lives, so read it to find out where the next page after that is.  Can do this for many pages at once to make it reasonable")

                          (SETQ LASTPAGEREAD (\ACTONDISKPAGES DSK NIL DAs -1 STREAM (.LISP.TO.BFS.
                                                                                     LASTKNOWNPAGE)
                                                    [SETQ LASTATTEMPTED
                                                     (.LISP.TO.BFS. (SUB1 (IPLUS LASTKNOWNPAGE NPAGES
                                                                                 ]
                                                    \DC.READD))
                          (SETQ LASTKNOWNPAGE (.BFS.TO.LISP. LASTPAGEREAD))
                          (COND
                             ((ILESSP LASTPAGEREAD LASTATTEMPTED)
                                                             (* ; "Hit end of file")
                              (RETURN]
          (replace (M44STREAM LASTMAPPEDPAGE) of STREAM with LASTKNOWNPAGE)
          (RETURN LASTKNOWNPAGE])

(\M44GetFileHandle
  [LAMBDA (NAME RECOG FDEV FAST CREATEFLG)               (* ; "Edited 21-Jan-91 23:48 by jds")

    (* ;; "Creates a STREAM for dsk file NAME.  If file does not exist, but CREATEFLG is true, returns the UNAME of the file so that it may be created.  If FAST is true, does not fill in any fields of STREAM that would require reading the file, e.g., the length and full map")

    (LET ((DIRSTREAM (fetch (M44DEVICE SYSDIROFD) of FDEV))
          FS DP STREAM)
         (COND
            ((NULL DIRSTREAM)                                (* ; "Non-existent device")
             NIL)
            ((NULL (SETQ FS (\M44PARSEFILENAME NAME RECOG FDEV CREATEFLG)))
                                                             (* ; "File not found")
             NIL)
            ((SETQ DP (fetch (FILESPEC FSDIRPTR) of FS))
                                                             (* ; 
                                                     "File was found--here's the directory pointer")
             (SETQ STREAM (create M44STREAM))
             (replace DEVICE of STREAM with FDEV)
             (replace (M44STREAM FID) of STREAM with (\M44READDIRFID DIRSTREAM DP))
             (replace (M44STREAM DIRINFO) of STREAM with DP)
             (replace FULLFILENAME of STREAM with (\M44PACKFILENAME
                                                               (fetch (FILESPEC UNAME)
                                                                  of FS)
                                                               DP DIRSTREAM))
             (replace MULTIBUFFERHINT of STREAM with \M44MULTFLG)
             (OR FAST (\M44CompleteFH STREAM))
             STREAM)
            ((NULL (fetch (FILESPEC UNAME) of FS))   (* ; 
                                           "Name was malformed--can't create it even if we want to")
             (LISPERROR "BAD FILE NAME" NAME))
            (CREATEFLG (fetch (FILESPEC UNAME) of FS])

(\M44GetFileInfo
  [LAMBDA (STREAM ATTRIBUTE DEV)                         (* ; "Edited 21-Jan-91 23:44 by jds")

    (* ;; "Get the value of the ATTRIBUTE for a model44 file.  If STREAM is a filename, then the file is not open.")

    (COND
       ((OR (type? STREAM STREAM)
            (SETQ STREAM (\M44GetFileHandle STREAM 'OLD DEV T)))
        (SELECTQ ATTRIBUTE
            ((LENGTH SIZE) 
                 (COND
                    ((NULL (fetch VALIDATION of STREAM))
                                                             (* ; 
                                                       "Need to read leader page etc to get length")
                     (\M44CompleteFH STREAM)))
                 (SELECTQ ATTRIBUTE
                     (LENGTH (create BYTEPTR
                                    PAGE _ (fetch EPAGE of STREAM)
                                    OFFSET _ (fetch EOFFSET of STREAM)))
                     (IPLUS (fetch EPAGE of STREAM)
                            (FOLDHI (fetch EOFFSET of STREAM)
                                   BYTESPERPAGE))))
            (TYPE [PROG ((BUF (\M44ReadLeaderPage STREAM)))
                        (RETURN
                         (COND
                            ((IGREATERP (fetch (\M44LeaderPage PropertyLength) of BUF)
                                    0)
                             (SETQ BUF (\ADDBASE BUF (fetch (\M44LeaderPage PropertyBegin)
                                                        of BUF)))
                             (do (SELECTC (fetch (M44FILEPROP FPROPTYPE) of BUF)
                                         (0                  (* ; "End of properties")
                                            (RETURN))
                                         (\FPROP.TYPE [RETURN (SELECTC (fetch (M44FILEPROP 
                                                                                         FPROPWORD0)
                                                                          of BUF)
                                                                  (\FPTYPE.TEXT 'TEXT)
                                                                  (\FPTYPE.BINARY 
                                                                       'BINARY)
                                                                  (\FPTYPE.UNKNOWN 
                                                                       NIL)
                                                                  (\TYPE.FROM.FILETYPE
                                                                   (fetch (M44FILEPROP FPROPWORD0
                                                                                     ) of BUF])
                                         NIL)
                                    (SETQ BUF (\ADDBASE BUF (fetch (M44FILEPROP FPROPLENGTH)
                                                               of BUF])
            (CREATIONDATE (\M44GETDATEPROP STREAM (INDEXF (fetch (\M44LeaderPage TimeCreate)
                                                                 of T))
                                 T))
            (WRITEDATE (\M44GETDATEPROP STREAM (INDEXF (fetch (\M44LeaderPage TimeWrite)
                                                              of T))
                              T))
            (READDATE (\M44GETDATEPROP STREAM (INDEXF (fetch (\M44LeaderPage TimeRead)
                                                             of T))
                             T))
            (ICREATIONDATE (\M44GETDATEPROP STREAM (INDEXF (fetch (\M44LeaderPage TimeCreate)
                                                                  of T))))
            (IWRITEDATE (\M44GETDATEPROP STREAM (INDEXF (fetch (\M44LeaderPage TimeWrite)
                                                               of T))))
            (IREADDATE (\M44GETDATEPROP STREAM (INDEXF (fetch (\M44LeaderPage TimeRead)
                                                              of T))))
            NIL])

(\M44GETDATEPROP
(LAMBDA (STREAM OFFSET STRINGIFY) (* bvm%: "27-May-84 22:57") (* ;; "Returns the create/write/read date of STREAM that lives at OFFSET in its leader page, as a string if STRINGIFY is true, else as a Lisp date fixp") (PROG ((DATEBASE (\ADDBASE (\M44ReadLeaderPage STREAM) OFFSET)) DAT) (SETQ DAT (\MAKENUMBER (\GETBASE DATEBASE 0) (\GETBASE DATEBASE 1))) (RETURN (COND ((NEQ DAT 0) (SETQ DAT (ALTO.TO.LISP.DATE DAT)) (COND (STRINGIFY (GDATE DAT)) (T DAT)))))))
)

(\M44GetFileName
  [LAMBDA (NAME RECOG FDEV)                              (* ; "Edited 21-Jan-91 23:48 by jds")
    (LET ((FS (\M44PARSEFILENAME NAME RECOG FDEV))
          DP UNAME)
         (AND FS (SETQ UNAME (fetch (FILESPEC UNAME) of FS))
              (\M44PACKFILENAME UNAME (SETQ DP (fetch (FILESPEC FSDIRPTR) of FS))
                     (AND DP (fetch (M44DEVICE SYSDIROFD) of FDEV])

(\M44GetPageLoc
  [LAMBDA (STREAM PAGENO CREATE?)                        (* ; "Edited 21-Jan-91 23:35 by jds")

    (* ;; "Look in the file's page map to find the disk address of the page.  If the map does not include the page, then extend it appropriately.  If page does not exit, create it if CREATE?  is true, else return \EOFDA")

    (COND
       ((ILEQ PAGENO (fetch (M44STREAM LastPage) of STREAM))
        (COND
           ((IGREATERP PAGENO (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM))
            (\M44FillInMap STREAM PAGENO)))
        (\WORDELT (fetch (M44STREAM FILEPAGEMAP) of STREAM)
               (IPLUS PAGENO 2)))
       (CREATE? (\M44AddDiskPages STREAM PAGENO 0)
              (\M44GetPageLoc STREAM PAGENO))
       (T \EOFDA])

(\M44KillFilePageMap
  [LAMBDA (fHandle)                                      (* ; "Edited 21-Jan-91 23:35 by jds")
                                                             (* ; "Remove the file's page map.")
    (replace (M44STREAM FILEPAGEMAP) of fHandle with NIL)
    (replace (M44STREAM LASTMAPPEDPAGE) of fHandle with -1])

(\M44MAKEDIRENTRY
  [LAMBDA (FID UNAME NC FDEV)                            (* ; "Edited 21-Jan-91 23:38 by jds")

    (* ;; "Makes a directory entry for a new file.  FID is file's ID, NC the number of characters in the full Alto name.")

    (PROG ((DIRSTREAM (fetch (M44DEVICE SYSDIROFD) of FDEV))
           (VERSION (fetch (UNAME VERSION) of UNAME))
           POS)
          (SETQ POS (\FINDDIRHOLE (LRSH (IPLUS NC 14)
                                            1)
                           DIRSTREAM))
          (\BOUTS DIRSTREAM (fetch (FID FIDBLOCK) of FID)
                 0
                 (UNFOLD 5 BYTESPERWORD))
          (\BOUT DIRSTREAM NC)

     (* ;; "Now write out the alto-style name 'name[.ext]!ver.' with ver omitted if 1;  This is basically the same logic as is used to write the name in the leader page in \M44CREATEFILE.  We can't share cause here we do bouts, cause we might run over a page;  there we must do PUTBASEBYTE's cause we can't set the fileptr to the leader page.")

          (for C in (fetch (UNAME ORIGCHARS) of UNAME) do (\BOUT DIRSTREAM C))
          [COND
             ((NEQ VERSION 1)
              (\BOUT DIRSTREAM (CHARCODE !))
              (LET ((*PRINT-BASE* 10))
                   (PRIN3 VERSION DIRSTREAM]
          (\BOUT DIRSTREAM (CHARCODE %.))
          (COND
             ((EVENP NC BYTESPERWORD)
              (\BOUT DIRSTREAM 0)))
          (\SETFILEPTR DIRSTREAM POS)
          (\BOUT DIRSTREAM (LOGOR 4 (\PEEKBIN DIRSTREAM)))   (* ; 
                             "When everything is ready, finally change the type from hole to file.")
          (FORCEOUTPUT DIRSTREAM)
          (RETURN POS])

(\M44OpenFile
  [LAMBDA (NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM)  (* ; "Edited 21-Jan-91 23:38 by jds")

    (* ;; "Open a Model44 file.  Gets the physical end of file and sets up ofd")

    (PROG (PAGESTIMATE STREAM CRDATE TYPE DON'T.CHANGE.DATE X)
                                                             (* ; 
                                                       "if file is open in a conflicting way, barf")
          [COND
             ((NEQ ACCESS 'INPUT)                            (* ; 
                                                      "Interesting parameters when creating a file")
              (for X in PARAMETERS do (SELECTQ (CAR (LISTP X))
                                                      (LENGTH (SETQ PAGESTIMATE
                                                               (IPLUS 2 (FOLDHI (CADR X)
                                                                               BYTESPERPAGE))))
                                                      (CREATIONDATE (SETQ CRDATE (IDATE (CADR X))))
                                                      (ICREATIONDATE (SETQ CRDATE (CADR X)))
                                                      (TYPE (SETQ TYPE (CADR X)))
                                                      (DON'T.CHANGE.DATE 
                                                           (SETQ DON'T.CHANGE.DATE T))
                                                      NIL]
          (COND
             [(type? STREAM NAME)
              (COND
                 ((OR (fetch (M44DEVICE DSKPASSWORDOK) of (fetch DEVICE of NAME))
                      (EQ (fetch (FID W0) of (fetch (M44STREAM FID) of NAME))
                          32768))                            (* ; 
                            "Make sure password is ok if trying to reopen anything but a directory")
                  (\M44CompleteFH (SETQ STREAM NAME)))
                 (T (RETURN]
             ([NULL (SETQ STREAM (\M44GetFileHandle NAME RECOG FDEV NIL (NEQ ACCESS 'INPUT]
                                                             (* ; 
                  "File not found.  Return NIL to let generic open generate a FILE NOT FOUND error")
              (RETURN NIL)))
          (if OLDSTREAM
              then                                       (* ; "REOPENFILE--nothing more to do")
                    (RETURN STREAM))
          [COND
             ([AND PAGESTIMATE (IGREATERP PAGESTIMATE (IPLUS (fetch (M44DEVICE DISKFREEPAGES)
                                                                of FDEV)
                                                             (COND
                                                                ((type? STREAM STREAM)
                                                                 (fetch (M44STREAM LastPage)
                                                                    of STREAM))
                                                                (T 
                                                             (* ; "New file")
                                                                   0]
              (RETURN (LISPERROR "FILE SYSTEM RESOURCES EXCEEDED" (COND
                                                                     ((type? STREAM STREAM)
                                                                      (fetch FULLFILENAME
                                                                         of STREAM))
                                                                     (T NAME]
          [COND
             (CRDATE                                         (* ; "Convert to alto format")
                    (COND
                       ([NOT (type? FIXP (SETQ CRDATE (LISP.TO.ALTO.DATE CRDATE]
                                                             (* ; "sigh, wanted a number box")
                        (\PUTBASEFIXP (SETQ X (create FIXP))
                               0 CRDATE)
                        (SETQ CRDATE X]
          [COND
             ((NOT (type? STREAM STREAM))                (* ; "New file")
              (SETQ STREAM (\M44CREATEFILE FDEV STREAM PAGESTIMATE CRDATE TYPE)))
             (T                                              (* ; "Old file")
                [LET ((MYNAME (fetch FULLFILENAME of STREAM)))
                     (COND
                        ([for OTHER in (fetch (FDEV OPENFILELST) of FDEV)
                            when (STRING-EQUAL (fetch FULLFILENAME of OTHER)
                                            MYNAME)
                            do (RETURN (OR (NEQ ACCESS 'INPUT)
                                               (NEQ (fetch ACCESS of OTHER)
                                                    'INPUT]  (* ; 
                                                          "Access conflict with existing open file")
                         (RETURN (LISPERROR "FILE WON'T OPEN" MYNAME]
                [COND
                   ((EQ ACCESS 'OUTPUT)                      (* ; "File is EMPTY even if it is old")
                    (replace EPAGE of STREAM with (replace EOFFSET of STREAM
                                                                 with 0]
                                                             (* ; 
                                              "Leader page is read in during STREAM initialization")
                (COND
                   ((NOT DON'T.CHANGE.DATE)
                    (\M44SetAccessTimes STREAM ACCESS CRDATE)
                                                             (* ; "Resets validation")
                    (\M44WriteLeaderPage STREAM)         (* ; 
                                                  "We write out accumulated changes to leader page")
                    ]
          (COND
             (CRDATE (replace NONDEFAULTDATEFLG of STREAM with T)))
          (RETURN STREAM])

(\M44OPENFILEFROMFP
  [LAMBDA (DEV NAME ACCESS FID DIRINFO)                  (* ; "Edited 21-Jan-91 23:36 by jds")
                                                             (* ; "Opens a disk file given its FP")
    (LET ((STREAM (create M44STREAM)))
         (replace FULLFILENAME of STREAM with (SETQ NAME (PACK* '{ (fetch
                                                                                (FDEV DEVICENAME)
                                                                                  of DEV)
                                                                            '} NAME)))
         (replace DEVICE of STREAM with DEV)
         (replace (M44STREAM FID) of STREAM with FID)
         (replace (M44STREAM DIRINFO) of STREAM with DIRINFO)
         (replace MULTIBUFFERHINT of STREAM with \M44MULTFLG)
         (\OPENFILE STREAM ACCESS)
         (replace USERVISIBLE of STREAM with NIL)
         STREAM])

(\M44ReadDiskPage
  [LAMBDA (STREAM PAGENO BUF)                            (* ; "Edited 21-Jan-91 23:42 by jds")

    (* ;; "The functions for reading a disk page called by \M44ReadPages.  Returns the number of bytes read.  If PAGEADDR is 0, then assume 0 bytes read.  Fill the BUF with zeros beyond the last byte read.")

    (COND
       ((AND (IGEQ PAGENO (fetch EPAGE of STREAM))
             (OR (NOT (IEQP PAGENO (fetch EPAGE of STREAM)))
                 (EQ (fetch EOFFSET of STREAM)
                     0)))                                    (* ; 
                        "Asking for page after eof.  PMAP system really ought to catch this itself")
        (\CLEARWORDS BUF WORDSPERPAGE)
        0)
       (T (PROG ((PAGEADDR (\M44GetPageLoc STREAM PAGENO))
                 (BFSPG# (ADD1 PAGENO)))
                (RETURN (COND
                           ((EQ PAGEADDR \EOFDA)             (* ; 
                                                           "no bytes read, fill with zeroes.")
                            (\CLEARWORDS BUF WORDSPERPAGE)
                            0)
                           ((EQ PAGEADDR \FILLINDA)
                            (SHOULDNT))
                           ((EQ (\ACTONDISKPAGES (fetch (M44DEVICE DSKOBJ)
                                                    of (fetch DEVICE of STREAM))
                                       BUF
                                       (fetch (ARRAYP BASE) of (fetch (M44STREAM 
                                                                                         FILEPAGEMAP)
                                                                          of STREAM))
                                       -1 STREAM BFSPG# BFSPG# \DC.READD)
                                BFSPG#)
                            BYTESPERPAGE)
                           (T 
                              (* ;; "if READDISKPAGE returns NIL, presumably there is an error of some kind, hope it was with the file map and try again.")

                              (\M44KillFilePageMap STREAM)
                              (\M44ReadDiskPage STREAM PAGENO BUF])

(\M44ReadLeaderPage
  [LAMBDA (STREAM AGAIN)                                 (* ; "Edited 21-Jan-91 23:42 by jds")

(* ;;; "Returns the leader page of STREAM, reading it if necessary.  If AGAIN is true, will read it afresh even if it already has a cached leader page")

    (* ;; "File leader page format: Words 0-1, time created.  Words 2-3, time last written.  Words 4-5, time last read.  Words 6-25, name of file.  Words 26-235, leader properties.  Words 236-245, spare.  Word 246, property pointer.  Word 247, change serial number.  Words 248-252, STREAM hint for directory.  Word 253, disk address of last page.  Word 254, page number of last page.  Word 255, number of bytes on last page.")

    (PROG ((BUFFER (fetch (M44STREAM LEADERPAGE) of STREAM)))
          (COND
             [(NULL BUFFER)
              (SETQ BUFFER (NCREATE 'VMEMPAGEP]
             ((NOT AGAIN)
              (RETURN BUFFER)))
          (\ACTONDISKPAGES (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE of STREAM))
                 BUFFER
                 (fetch (ARRAYP BASE) of (OR (fetch (M44STREAM FILEPAGEMAP) of STREAM
                                                            )
                                                     (\MAKELEADERDAS STREAM)))
                 -1 STREAM 0 0 \DC.READD)
          (replace (M44STREAM LEADERPAGE) of STREAM with BUFFER)
          (RETURN BUFFER])

(\M44ReadPages
(LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* bvm%: "26-DEC-81 23:50") (* ; "Read pages from a Model44 file.") (for BUF inside BUFFERS as PAGENO from FIRSTPAGE# sum (\M44ReadDiskPage STREAM PAGENO BUF)))
)

(\M44SetAccessTimes
  [LAMBDA (STREAM ACCESS CRDATE)                         (* ; "Edited 21-Jan-91 23:36 by jds")

(* ;;; "Set the 'last read' and/or 'last written' times in the leader page according to access, which is assumed to be either INPUT, OUTPUT, BOTH, or APPEND.")

    (PROG ((DAT (\DAYTIME0 (create FIXP)))
           (BUF (fetch (M44STREAM LEADERPAGE) of STREAM)))

     (* ;; "Note: DAYTIME0 returns an Alto time, not Lisp time.  This is consistent with the dates in the leader page")

          (SELECTQ ACCESS
              ((OUTPUT BOTH APPEND) 
                   (\BLT (LOCF (fetch (\M44LeaderPage TimeCreate) of BUF))
                         (OR CRDATE DAT)
                         WORDSPERCELL)
                   (\BLT (LOCF (fetch (\M44LeaderPage TimeWrite) of BUF))
                         DAT WORDSPERCELL)                   (* ; 
                                                    "Must revalidate because write DAT has changed")
                   (UPDATEVALIDATION STREAM BUF))
              NIL)
          (SELECTQ ACCESS
              ((INPUT BOTH) 
                   (\BLT (LOCF (fetch (\M44LeaderPage TimeRead) of BUF))
                         DAT WORDSPERCELL))
              NIL])

(\M44SetEndOfFile
  [LAMBDA (STREAM EPAGE EOFFSET UPDATENOW)               (* ; "Edited 21-Jan-91 23:36 by jds")

    (* ;; "Reset the file's leader page end-of-file hint.  If UPDATENOW is NIL, then simply update the leader page.  If it is not, then read and write the leader page.")

    (UNINTERRUPTABLY
        
        (* ;; "Must update STREAM handle and leader page in synch")

        (replace (M44STREAM LastPage) of STREAM with EPAGE)
        (replace (M44STREAM LastOffset) of STREAM with EOFFSET)
        [LET ((LEADERPAGE (\M44ReadLeaderPage STREAM)))
             (if (NEQ (fetch (\M44LeaderPage LastPageNumber) of LEADERPAGE)
                          (ADD1 EPAGE))
                 then                                    (* ; 
                                                    "if LastPage hasn't changed, don't do anything")
                                                             (* ; "ADD1 because M44 counts from 1")
                       (replace (\M44LeaderPage LastPageAddress) of LEADERPAGE
                          with (\M44GetPageLoc STREAM EPAGE))
                       (replace (\M44LeaderPage LastPageNumber) of LEADERPAGE
                          with (ADD1 EPAGE)))
             (replace (\M44LeaderPage LastPageByteCount) of LEADERPAGE with EOFFSET)
             (COND
                (UPDATENOW (\M44WriteLeaderPage STREAM])])

(\M44SetFileInfo
  [LAMBDA (STREAM ATTRIBUTE VALUE DEV)                   (* ; "Edited 21-Jan-91 23:34 by jds")
    (PROG ((WASOPEN (type? STREAM STREAM)))
          (SELECTQ ATTRIBUTE
              (CREATIONDATE (SETQ VALUE (OR (IDATE VALUE)
                                            (LISPERROR "ILLEGAL ARG" VALUE))))
              (ICREATIONDATE (OR (FIXP VALUE)
                                 (LISPERROR "NON-NUMERIC ARG" VALUE)))
              (TYPE)
              (RETURN))
          (RETURN (COND
                     ((OR WASOPEN (SETQ STREAM (\M44GetFileHandle STREAM 'OLD DEV T)))
                      (COND
                         ((SELECTQ ATTRIBUTE
                              (TYPE (\M44SETFILETYPE STREAM VALUE))
                              (PROGN (replace (\M44LeaderPage TimeCreate) of (
                                                                                 \M44ReadLeaderPage
                                                                                      STREAM)
                                        with (LISP.TO.ALTO.DATE VALUE))
                                     T))
                          (\M44WriteLeaderPage STREAM)
                          T])

(\M44SETFILETYPE
  [LAMBDA (STREAM TYPE)                                  (* ; "Edited 21-Jan-91 23:44 by jds")

    (* ;; "Set TYPE attribute of file to be TYPE -- assumes someone else will be writing out the leader page later")

    (PROG ((TYPECODE (SELECTQ TYPE
                         (TEXT \FPTYPE.TEXT)
                         (BINARY \FPTYPE.BINARY)
                         (NIL \FPTYPE.UNKNOWN)
                         (OR (\FILETYPE.FROM.TYPE TYPE)
                             \FPTYPE.BINARY)))
           (BUF (\M44ReadLeaderPage STREAM))
           PTR TOTALLENGTH)

     (* ;; "Computation of TYPECODE done this way for backward compatibility -- the \FPTYPE.xx constants were defined before \FILETYPE.FROM.TYPE was written, and the numbers are incompatible")

          (SETQ PTR (\ADDBASE BUF (fetch (\M44LeaderPage PropertyBegin) of BUF)))
          (SETQ TOTALLENGTH (fetch (\M44LeaderPage PropertyLength) of BUF))
          (RETURN (while (IGREATERP TOTALLENGTH 0)
                     do (SELECTC (fetch (M44FILEPROP FPROPTYPE) of PTR)
                                (0                           (* ; "End of properties")
                                   (RETURN (COND
                                              ((IGREATERP TOTALLENGTH 1)
                                               (replace (M44FILEPROP FPROPWORD0) of PTR
                                                  with TYPECODE)
                                               (replace (M44FILEPROP FPROPLENGTH) of PTR
                                                  with 2)
                                               (replace (M44FILEPROP FPROPTYPE) of PTR
                                                  with \FPROP.TYPE)
                                               T))))
                                (\FPROP.TYPE                 (* ; "Already has a type, change it")
                                             (replace (M44FILEPROP FPROPWORD0) of PTR
                                                with TYPECODE)
                                             (RETURN T))
                                NIL)
                           (SETQ PTR (\ADDBASE PTR (fetch (M44FILEPROP FPROPLENGTH) of PTR)))
                           (SETQ TOTALLENGTH (IDIFFERENCE TOTALLENGTH (fetch (M44FILEPROP 
                                                                                        FPROPLENGTH)
                                                                         of PTR])

(\M44TruncateFile
  [LAMBDA (STREAM LP LO UPDATENOW)                       (* ; "Edited 21-Jan-91 23:36 by jds")

    (* ;; 
  "Resets the length of the file to LP page and LO offset.  Can both shorten and lengthen files.")

    [COND
       ((NOT LP)
        (SETQ LP (fetch EPAGE of STREAM))
        (SETQ LO (fetch EOFFSET of STREAM]
    (COND
       ((IGREATERP LP (fetch (M44STREAM LastPage) of STREAM))
        (\M44AddDiskPages STREAM LP LO))
       ((ILESSP LP (fetch (M44STREAM LastPage) of STREAM))
        (\M44DELETEPAGES STREAM (ADD1 LP))
        (COND
           ((ILESSP LP (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM))
            (for I from (ADD1 LP) to (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM)
               do (SETA (fetch (M44STREAM FILEPAGEMAP) of STREAM)
                            (IPLUS I 2)
                            \EOFDA))
            (replace (M44STREAM LASTMAPPEDPAGE) of STREAM with LP)))
        (\M44SetEndOfFile STREAM LP LO)                  (* ; 
                                 "Now need to rewrite last page with new length, null next pointer")
        (\MAPPAGE LP STREAM)
        (\SETIODIRTY STREAM LP)
        (FORCEOUTPUT STREAM))
       (T (replace (M44STREAM LastOffset) of STREAM with LO)))
    (AND UPDATENOW (\M44SetEndOfFile STREAM LP LO T))
    STREAM])

(\M44WriteDiskPage
  [LAMBDA (STREAM PAGENO BUF NBYTES)                     (* ; "Edited 21-Jan-91 23:42 by jds")
                                                             (* ; 
                                                           "Write a disk page on the Model44.")
    (\M44GetPageLoc STREAM PAGENO T)                     (* ; "Ensure that PAGENO is in map")
    (PROG ((BFSPG# (ADD1 PAGENO)))
          (RETURN (COND
                     ([COND
                         ((NEQ PAGENO (fetch (M44STREAM LastPage) of STREAM))
                                                             (* ; "Writing only data")
                          (\ACTONDISKPAGES (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE
                                                                                   of STREAM))
                                 BUF
                                 (fetch (ARRAYP BASE) of (fetch (M44STREAM FILEPAGEMAP)
                                                                    of STREAM))
                                 -1 STREAM BFSPG# BFSPG# \DC.WRITED))
                         (T                                  (* ; 
           "When writing last page, need to fill in the numchars field of label, so this is harder")
                            (COND
                               ((EQ PAGENO (fetch EPAGE of STREAM))
                                (EQ (\WRITEDISKPAGES (fetch (M44DEVICE DSKOBJ)
                                                        of (fetch DEVICE of STREAM))
                                           BUF
                                           (fetch (ARRAYP BASE) of (fetch (M44STREAM
                                                                                       FILEPAGEMAP)
                                                                              of STREAM))
                                           -1 STREAM BFSPG# BFSPG# NIL NIL NBYTES)
                                    BFSPG#))
                               (T 

                                 (* ;; "We will have to write more pages after this one, too, unless the file is truncated back to here, so extend the file while we're at it.  This may save a call to \ADDDISKPAGES")

                                  [COND
                                     ((ILEQ (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM)
                                            PAGENO)
                                      (\M44ExtendFilePageMap STREAM (ADD1 PAGENO]
                                  (COND
                                     ((EQ (\WRITEDISKPAGES (fetch (M44DEVICE DSKOBJ)
                                                              of (fetch DEVICE of STREAM)
                                                                  )
                                                 (LIST BUF NIL)
                                                 (fetch (ARRAYP BASE) of (fetch
                                                                                  (M44STREAM 
                                                                                         FILEPAGEMAP)
                                                                                    of STREAM))
                                                 -1 STREAM BFSPG# (ADD1 BFSPG#)
                                                 NIL NIL 0)
                                          (ADD1 BFSPG#))     (* ; 
                                                    "Write two pages, the second of which is blank")
                                      (replace (M44STREAM LastPage) of STREAM
                                         with (ADD1 PAGENO))
                                      (replace (M44STREAM LastOffset) of STREAM with
                                                                                        0)
                                      T]
                      NBYTES)
                     (T (\M44KillFilePageMap STREAM)
                        (\M44WriteDiskPage STREAM PAGENO BUF NBYTES])

(\M44WriteLeaderPage
  [LAMBDA (STREAM)                                       (* ; "Edited 21-Jan-91 23:42 by jds")
                                                             (* ; "Write the file's leader page")
    (PROG ((BUFFER (fetch (M44STREAM LEADERPAGE) of STREAM)))
          (AND BUFFER (\ACTONDISKPAGES (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE
                                                                               of STREAM))
                             BUFFER
                             (fetch (ARRAYP BASE) of (OR (fetch (M44STREAM FILEPAGEMAP)
                                                                    of STREAM)
                                                                 (\MAKELEADERDAS STREAM)))
                             -1 STREAM 0 0 \DC.WRITED])

(\M44WritePages
  [LAMBDA (STREAM FIRSTPAGE# BUFFERS)                    (* ; "Edited 21-Jan-91 23:36 by jds")
                                                             (* ; 
                                                           "Write pages onto a Model44 file.")
    (PROG ([NPAGES (COND
                      ((NLISTP BUFFERS)
                       1)
                      (T (for B in BUFFERS sum 1]
           LASTPAGE#)
          (COND
             ((fetch REVALIDATEFLG of STREAM)

              (* ;; "Need to update creationdate, since a SAVEVM etc has occurred since the last write.  Otherwise, it is possible to see a change to the file but no change to the creationdate")

              (\M44SetAccessTimes STREAM 'OUTPUT)
              (\M44WriteLeaderPage STREAM)
              (replace REVALIDATEFLG of STREAM with NIL)))
          (\M44GetPageLoc STREAM FIRSTPAGE# T)           (* ; 
                                                 "Make sure we know where we are starting to write")
          [COND
             ([ILESSP (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM)
                     (SETQ LASTPAGE# (IPLUS FIRSTPAGE# (SUB1 NPAGES]
                                                             (* ; 
                                                 "Need enough pagemap to cover everything we write")
              (\M44ExtendFilePageMap STREAM (ADD1 LASTPAGE#]
          [COND
             ([AND (IGEQ NPAGES \#DISKBUFFERS)
                   (for B in BUFFERS thereis (NOT (EMADDRESSP B]

              (* ;; "More pages to write than we have disk buffers to do it in one command, so break it up.  Buffers already in emulator space are free, though, so we can write lots of them")

              (bind (MAXPAGES _ (SUB1 \#DISKBUFFERS))
                 do (\M44WritePages1 STREAM FIRSTPAGE# (IPLUS FIRSTPAGE# (SUB1 MAXPAGES))
                               (to MAXPAGES collect (pop BUFFERS)))
                       (add FIRSTPAGE# MAXPAGES)
                       (SETQ NPAGES (IDIFFERENCE NPAGES MAXPAGES)) repeatwhile (IGREATERP NPAGES
                                                                                          MAXPAGES]
          (\M44WritePages1 STREAM FIRSTPAGE# LASTPAGE# BUFFERS])

(\M44WritePages1
  [LAMBDA (STREAM FIRSTPAGE# LASTPAGE# BUFFERS)          (* ; "Edited 21-Jan-91 23:42 by jds")

(* ;;; "Writes BUFFERS to STREAM, covering pages FIRSTPAGE# thru LASTPAGE#.  Caller guarantees that we have enough disk buffers to do it.  --- There are two cases: easy one is if the pages already exist, in which case we just rewrite their data;  hard case is writing pages at end of file, in which case we need to write labels and maybe allocate pages")

    (COND
       ((ILESSP LASTPAGE# (fetch (M44STREAM LastPage) of STREAM))
                                                             (* ; "Writing only data")
        (\ACTONDISKPAGES (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE of STREAM))
               BUFFERS
               (fetch (ARRAYP BASE) of (fetch (M44STREAM FILEPAGEMAP) of STREAM))
               -1 STREAM (.LISP.TO.BFS. FIRSTPAGE#)
               (.LISP.TO.BFS. LASTPAGE#)
               \DC.WRITED))
       (T                                                    (* ; 
           "When writing last page, need to fill in the numchars field of label, so this is harder")
          (PROG (MYBUFS NBYTES)
                [SETQ MYBUFS (COND
                                ((AND (EQ LASTPAGE# (fetch EPAGE of STREAM))
                                      (NEQ (SETQ NBYTES (fetch EOFFSET of STREAM))
                                           BYTESPERPAGE))    (* ; 
                                                           "Only write to the end of the file")
                                 BUFFERS)
                                (T 

                                 (* ;; "We will have to write more pages after this one, too, unless the file is truncated back to here, so extend the file while we're at it.  This may save a call to \ADDDISKPAGES")

                                   (PROG1 (SETQ MYBUFS (CONS))
                                       [for B inside BUFFERS
                                          do (RPLACA MYBUFS B)
                                                (SETQ MYBUFS (CDR (RPLACD MYBUFS (CONS]
                                       (RPLACD (RPLACA MYBUFS NIL)
                                              NIL)           (* ; "Write a final blank page")
                                       (SETQ NBYTES 0)
                                       (add LASTPAGE# 1))]
                (\WRITEDISKPAGES (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE of STREAM
                                                                             ))
                       MYBUFS
                       (fetch (ARRAYP BASE) of (fetch (M44STREAM FILEPAGEMAP)
                                                          of STREAM))
                       -1 STREAM (.LISP.TO.BFS. FIRSTPAGE#)
                       (.LISP.TO.BFS. LASTPAGE#)
                       NIL NIL NBYTES)
                (replace (M44STREAM LastPage) of STREAM with LASTPAGE#)
                (replace (M44STREAM LastOffset) of STREAM with NBYTES])
)



(* ;; "Disk allocation")

(DEFINEQ

(\ADDDISKPAGES
  [LAMBDA (STREAM FIRSTNEWPAGE NPAGES DAs LASTNUMCHARS)  (* ; "Edited 21-Jan-91 23:42 by jds")

    (* ;; "Adds to file STREAM NPAGES, where FIRSTNEWPAGE-1 is the last existing page.  DAs is the vector of disk addresses, where first element corresponds to BFS page -1")
                                                             (* ; 
                    "Note FIRSTNEWPAGE is in Lisp terms, so it is actually LASTOLDPAGE for the BFS")
    (PROG ((LASTPAGEBUF (NCREATE 'VMEMPAGEP))
           (LASTEXISTINGPAGE FIRSTNEWPAGE)
           (DSK (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE of STREAM)))
           BUFFERS CHUNK)
          (SETQ BUFFERS (CONS LASTPAGEBUF (for I from 1 to (IMIN NPAGES \MAXDISKDAs)
                                             collect NIL)))
          (\ACTONDISKPAGES DSK LASTPAGEBUF DAs -1 STREAM LASTEXISTINGPAGE LASTEXISTINGPAGE \DC.READD
                 NIL NIL NIL LASTEXISTINGPAGE)               (* ; 
                                     "Read last existing page, so we can rewrite it with new label")
          (while (IGREATERP NPAGES 0) do (SETQ CHUNK (IMIN \MAXDISKDAs NPAGES))
                                                (\WRITEDISKPAGES DSK BUFFERS DAs -1 STREAM 
                                                       LASTEXISTINGPAGE (IPLUS LASTEXISTINGPAGE CHUNK
                                                                               )
                                                       NIL NIL LASTNUMCHARS LASTEXISTINGPAGE)
                                                (RPLACA BUFFERS NIL)
                                                (add LASTEXISTINGPAGE CHUNK)
                                                (SETQ NPAGES (IDIFFERENCE NPAGES CHUNK])

(\M44DELETEPAGES
  [LAMBDA (STREAM FIRSTPAGE)                             (* ; "Edited 21-Jan-91 23:42 by jds")
                                                             (* ; 
                                               "FIRSTPAGE is in Lisp terms, i.e.  -1 = leader page")
    (PROG ((DEV (fetch DEVICE of STREAM))
           (NPAGES (COND
                      ((fetch VALIDATION of STREAM)
                       (IPLUS (ADD1 (IDIFFERENCE (fetch (M44STREAM LastPage) of STREAM)
                                           FIRSTPAGE))
                              2))
                      (T PageMapIncrement)))
           (PN (ADD1 FIRSTPAGE))
           DAs FIRSTDA LASTPAGESEEN DSK)

     (* ;; "NPAGES is used to decide how much to do at once.  Need be no more than number of pages known to exist.  The ADD1 is that, plus two for the pages around it")

          (COND
             ((ILESSP NPAGES 2)                              (* ; "Nothing to delete")
              (RETURN)))
          (SETQ DSK (fetch (M44DEVICE DSKOBJ) of DEV))
                                                             (* (\FLUSHDISKDESCRIPTOR
                                                           (EMPOINTER (fetch (DSKOBJ DSKDDMGR) 
                                                           of DSK)) (fetch (DSKOBJ ALTODSKOBJ) 
                                                           of DSK)))
                                                             (* ; 
                                                "Tell Alto to clear out anything it knows about dd")
                                                             (* ; 
         "IF STREAM:LASTMAPPEDPAGE GE FIRSTPAGE+NPAGES THEN DAs _ STREAM:FILEPAGEMAP DAorigin _ -1")
          (SETQ DAs (ARRAY (SETQ NPAGES (IMIN NPAGES \MAXDISKDAs))
                           'WORD NIL 0))
          [SETQ FIRSTDA (COND
                           [(EQ FIRSTPAGE -1)
                            (fetch (FP FPLEADERVDA) of (fetch (FID FIDBLOCK)
                                                                  of (fetch (M44STREAM FID)
                                                                            of STREAM]
                           (T (\M44GetPageLoc STREAM FIRSTPAGE]
          (while (NEQ FIRSTDA \EOFDA)
             do (SETA DAs 0 \FILLINDA)
                   (SETA DAs 1 FIRSTDA)                      (* ; "Corresponds to PN")
                   (for I from 2 to (SUB1 NPAGES) do (SETA DAs I \FILLINDA))
                   [SETQ LASTPAGESEEN (\ACTONDISKPAGES DSK NIL (fetch (ARRAYP BASE) of DAs)
                                             (SUB1 PN)
                                             STREAM PN (IPLUS PN NPAGES -3)
                                             \DC.READD NIL NIL NIL (ADD1 (fetch EPAGE
                                                                            of STREAM] 
                                                             (* ; "Read DAs for the next NPAGES-2")
                   (\WRITEDISKPAGES DSK NIL (fetch (ARRAYP BASE) of DAs)
                          (SUB1 PN)
                          \FREEPAGEFID PN LASTPAGESEEN (UNSIGNED -1 BITSPERWORD))
                   [for I from PN to LASTPAGESEEN
                      do (\M44MARKPAGEFREE DEV (ELT DAs (ADD1 (IDIFFERENCE I PN]
                   (SETQ FIRSTDA (ELT DAs (IPLUS (IDIFFERENCE LASTPAGESEEN PN)
                                                 2)))
                   (SETQ PN (ADD1 LASTPAGESEEN)))            (* (FLUSHMAP (fetch
                                                           (M44DEVICE DISKDESCRIPTOROFD) of DEV))
                                                           (FORGETPAGES (fetch
                                                           (M44DEVICE DISKDESCRIPTOROFD) of DEV)))
          (\M44FLUSHDISKDESCRIPTOR DEV])

(\ASSIGNDISKPAGE
  [LAMBDA (DSK PREVDA)                                   (* ; "Edited 21-Jan-91 23:32 by jds")

(* ;;; "Assigns a new page on DSK.  If PREVDA is \EOFDA will pick random page, otherwise will attempt to allocate PREVDA+1.  Returns NIL if disk is full")

    (PROG ([VDA (COND
                   ((OR (EQ PREVDA \EOFDA)
                        (COND
                           ((EQ PREVDA \FILLINDA)
                            (AND \DISKDEBUG (RAID 
                                "[Disk debug] \ASSIGNDISKPAGE called with \FILLINDA.  ^N to continue"
                                                  ))
                            T)))
                    (fetch (DSKOBJ DISKLASTPAGEALLOC) of DSK))
                   (T (ADD1 PREVDA]
           (DD (fetch (DSKOBJ DISKDESCRIPTOROFD) of DSK))
           (MASK 128)
           BITS A LOOPEDONCE FREE)
          (OR (fetch (DSKOBJ DDVALID) of DSK)
              (RAID "DISKDESCRIPTOR not open" DSK))
          (\SETFILEPTR DD (IPLUS \DDBITTABSTART (FOLDLO VDA BITSPERBYTE)))
          (SETQ A (MOD VDA BITSPERBYTE))
          (FRPTQ A (SETQ MASK (LRSH MASK 1)))
      LP  (COND
             ((NULL (SETQ BITS (\BIN DD)))

              (* ;; "End of file -- wrap around to start.  This technique takes longer than necessary to bomb out when disk is full, but who cares?")

              (COND
                 (LOOPEDONCE (RETURN NIL)))
              (SETQ LOOPEDONCE T)
              (\SETFILEPTR DD \DDBITTABSTART))
             ((NEQ BITS 255)
              (until (OR (EQ (LOGAND BITS MASK)
                                 0)
                             (EQ (SETQ MASK (LRSH MASK 1))
                                 0)) do (add A 1))
              (COND
                 ((NEQ MASK 0)                               (* ; "Found a free page")
                  (\BACKFILEPTR DD)
                  (SETQ VDA (IPLUS (UNFOLD (IDIFFERENCE (\GETFILEPTR DD)
                                                  \DDBITTABSTART)
                                          BITSPERBYTE)
                                   A))
                  (\BOUT DD (LOGOR BITS MASK))               (* ; 
                                                          "Set bit indicating we snarfed this page")
                                                             (* ; "Decrement free page count hint")
                  [replace (DSKOBJ DISKFREEPAGES) of DSK
                     with (COND
                                 ((EQ (SETQ FREE (fetch (DSKOBJ DISKFREEPAGES) of DSK))
                                      0)
                                  (AND \DISKDEBUG (RAID 
                                         "[Disk debug] Free page hint went negative.  ^N to continue"
                                                        ))
                                  (\COUNTDISKFREEPAGES DD))
                                 (T (SUB1 FREE]
                  (replace (DSKOBJ DISKLASTPAGEALLOC) of DSK with VDA)
                  (replace (DSKOBJ DDDIRTY) of DSK with T)
                  (RETURN VDA)))
              (SETQ MASK 128)
              (SETQ A 0)))
          (GO LP])

(\COUNTDISKFREEPAGES
(LAMBDA (DD) (* bvm%: "13-Feb-85 19:32") (* ;;; "Counts number of free pages on a disk.  DD is the diskdescriptor stream") (OR (type? STREAM DD) (SETQ DD (\OPENDISKDESCRIPTOR (\GETDEVICEFROMNAME (OR DD (QUOTE DSK)))))) (PROG ((CNT 0) MASK BITS) (\SETFILEPTR DD \DDBITTABSTART) LP (COND ((NULL (SETQ BITS (\BIN DD))) (* ; "End of file") (RETURN CNT)) ((EQ BITS 0) (add CNT 8)) ((NEQ BITS 255) (SETQ MASK 128) (do (COND ((EQ (LOGAND BITS MASK) 0) (add CNT 1))) until (EQ (SETQ MASK (LRSH MASK 1)) 0)))) (GO LP)))
)

(\M44MARKPAGEFREE
(LAMBDA (DEV DA) (* bvm%: "17-Jan-85 17:11") (* ;; "Mark disk address DA on disk device DEV free") (PROG ((DSK (COND ((type? FDEV DEV) (fetch (M44DEVICE DSKOBJ) of DEV)) (T DEV))) DD BITS MASK) (SETQ DD (COND ((fetch (DSKOBJ DDVALID) of DSK) (fetch (DSKOBJ DISKDESCRIPTOROFD) of DSK)) (T (\OPENDISKDESCRIPTOR DEV)))) (SETFILEPTR DD (IPLUS \DDBITTABSTART (FOLDLO DA BITSPERBYTE))) (SETQ BITS (\BIN DD)) (SETQ MASK (LLSH 1 (IDIFFERENCE 7 (MOD DA BITSPERBYTE)))) (COND ((NEQ (LOGAND BITS MASK) 0) (* ; "Page is marked occupied, so free it") (\BACKFILEPTR DD) (\BOUT DD (LOGXOR BITS MASK)) (add (fetch (DSKOBJ DISKFREEPAGES) of DSK) 1) (replace (DSKOBJ DDDIRTY) of DSK with T)))))
)

(\M44FLUSHDISKDESCRIPTOR
  [LAMBDA (DEV)                                          (* ; "Edited 21-Jan-91 23:32 by jds")
    (PROG ((DSK (COND
                   ((type? FDEV DEV)
                    (fetch (M44DEVICE DSKOBJ) of DEV))
                   (T DEV)))
           DD)
          (OR (fetch (DSKOBJ DDDIRTY) of DSK)
              (RETURN))
          (OR (SETQ DD (fetch (DSKOBJ DISKDESCRIPTOROFD) of DSK))
              (RETURN (RAID "[Disk debug] no disk descriptor stream")))
          (\SETFILEPTR DD \OFFSET.DISKLASTSERIAL#)
          (\BOUTS DD (LOCF (fetch (DSKOBJ DISKLASTSERIAL#) of DSK))
                 0 \NBYTES.DISKINFO)                         (* ; 
                                                "Copy interesting stuff into diskdescriptor header")
          (FORCEOUTPUT DD)
          (replace (DSKOBJ DDDIRTY) of DSK with NIL)
          (RETURN T])

(\MAKELEADERDAS
  [LAMBDA (STREAM)                                       (* ; "Edited 21-Jan-91 23:30 by jds")

    (* ;; "Makes a page map for STREAM that includes the leader vda")

    (PROG ((MAP (ARRAY 4 'WORD \FILLINDA 0)))
          (SETA MAP 0 \EOFDA)
          [SETA MAP 1 (fetch (FP FPLEADERVDA) of (fetch (ARRAYP BASE)
                                                            of (fetch (M44STREAM FID)
                                                                      of STREAM]
          (replace (M44STREAM FILEPAGEMAP) of STREAM with MAP)
          (replace (M44STREAM LASTMAPPEDPAGE) of STREAM with -1)
          (RETURN MAP])

(DISKFREEPAGES
(LAMBDA (DSK RECOMPUTE) (* ejs%: " 7-Nov-85 16:33") (* ; "DSK ignored for now") (SELECTC \MACHINETYPE ((LIST \DANDELION \DAYBREAK) (* ; "Temporary until this become a device op") (\DFSFreeDiskPages DSK RECOMPUTE)) (\M44FREEPAGECOUNT (COND ((type? FDEV DSK) DSK) (T (\GETDEVICEFROMNAME (OR DSK (QUOTE DSK))))) NIL RECOMPUTE)))
)

(\M44FREEPAGECOUNT
(LAMBDA (DEV DIRECTORY RECOMPUTE) (* bvm%: "12-Oct-85 15:43") (PROG (CNT) (COND ((NOT (type? M44DEVICE DEV)) (\ILLEGAL.ARG DEV))) (RETURN (COND (RECOMPUTE (SETQ CNT (\COUNTDISKFREEPAGES (\OPENDISKDESCRIPTOR DEV))) (COND ((NEQ CNT (fetch (M44DEVICE DISKFREEPAGES) of DEV)) (replace (M44DEVICE DISKFREEPAGES) of DEV with CNT) (replace (M44DEVICE DDDIRTY) of DEV with T))) CNT) (T (fetch (M44DEVICE DISKFREEPAGES) of DEV))))))
)

(VMEMSIZE
(LAMBDA NIL (* bvm%: " 1-NOV-82 16:44") (fetch (IFPAGE NActivePages) of \InterfacePage)))
)

(RPAQ? \M44MULTFLG T)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(PUTPROPS UCASECHAR MACRO [(C)
                                   (COND
                                      ((ILESSP C (CHARCODE a))
                                       C)
                                      (T (IDIFFERENCE C (IDIFFERENCE (CHARCODE a)
                                                               (CHARCODE A])

(PUTPROPS UPDATEVALIDATION MACRO [(STREAM BUF)
                                          (replace VALIDATION of STREAM
                                             with (\MAKENUMBER (\GETBASE BUF 1)
                                                             (\GETBASE BUF 3])
)

(DECLARE%: EVAL@COMPILE

(ACCESSFNS M44DEVICE ((DSKOBJ (fetch DEVICEINFO of DATUM)
                                 (replace DEVICEINFO of DATUM with NEWVALUE)))
                         [TYPE? (AND (type? FDEV DATUM)
                                         (EQ (fetch OPENFILE of DATUM)
                                             '\M44OpenFile])
)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \OPENFILES \M44MULTFLG \DISKNAMECASEARRAY)
)

(DECLARE%: EVAL@COMPILE 

(PUTPROPS .LISP.TO.BFS. MACRO (= . ADD1))

(PUTPROPS .BFS.TO.LISP. MACRO (= . SUB1))

(PUTPROPS .DISKCASEARRAY. MACRO [NIL (fetch (ARRAYP BASE) of (\DTEST 
                                                                                   \DISKNAMECASEARRAY
                                                                                    'ARRAYP])
)

(DECLARE%: EVAL@COMPILE 

(RPAQQ PageMapIncrement 64)

(RPAQQ \MAX.ALTO.NAME.LENGTH 39)


(CONSTANTS (PageMapIncrement 64)
       (\MAX.ALTO.NAME.LENGTH 39))
)




(* ;; "File properties")

(DECLARE%: EVAL@COMPILE

(BLOCKRECORD M44FILEPROP ((FPROPTYPE BYTE)               (* ; "Type of property")
                              (FPROPLENGTH BYTE)             (* ; "Length of entire entry in words")
                              (FPROPWORD0 WORD)              (* ; "value starts here")
                              )                              (* ; 
                                      "Overlays a piece of leader page to describe a file property")
                             )
)

(RPAQQ FPROPTYPES ((\FPROP.TYPE 136)
                       (\FPROP.PAGEMAP 137)))
(DECLARE%: EVAL@COMPILE 

(RPAQQ \FPROP.TYPE 136)

(RPAQQ \FPROP.PAGEMAP 137)


(CONSTANTS (\FPROP.TYPE 136)
       (\FPROP.PAGEMAP 137))
)

(RPAQQ FPTYPES ((\FPTYPE.UNKNOWN 0)
                    (\FPTYPE.TEXT 1)
                    (\FPTYPE.BINARY 2)))
(DECLARE%: EVAL@COMPILE 

(RPAQQ \FPTYPE.UNKNOWN 0)

(RPAQQ \FPTYPE.TEXT 1)

(RPAQQ \FPTYPE.BINARY 2)


(CONSTANTS (\FPTYPE.UNKNOWN 0)
       (\FPTYPE.TEXT 1)
       (\FPTYPE.BINARY 2))
)

(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

[PUTDEF '\M44PAGEBUFFER 'RESOURCES '(NEW (NCREATE 'VMEMPAGEP]
)
)

(/SETTOPVAL '\\M44PAGEBUFFER.GLOBALRESOURCE NIL)
)

(/SETTOPVAL '\\M44PAGEBUFFER.GLOBALRESOURCE NIL)



(* ;; "Directory enumeration")

(DEFINEQ

(\M44GENERATEFILES
(LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* bvm%: "12-Oct-85 15:13") (* ;; "Returns a file-generator object that will generate AT LEAST all files in the sys-dir of FDEV whose names match PATTERN.  Clients might need to provide additional filtering.  For M44, the generate state consists of the HOSTNAME (DSK) followed by a 'search state' , a directory pointer and a character list of the sort that \SEARCHDIR1 expects.  DIRPTR is the position of the next file to be considered in the directory.") (PROG ((DIRSTREAM (fetch (M44DEVICE SYSDIROFD) of FDEV)) (SORT? (EQMEMB (QUOTE SORT) OPTIONS)) (CASEBASE (.DISKCASEARRAY.)) (EXT (QUOTE *)) HOSTNAME NAME VERSION CHARLIST GENSTREAM FILTER DESIREDVERSION SEARCHSTATE HOSTPREFIX) (OR DIRSTREAM (RETURN (\NULLFILEGENERATOR))) (COND ((for TAIL on (UNPACKFILENAME.STRING PATTERN) by (CDDR TAIL) do (SELECTQ (CAR TAIL) (HOST (SETQ HOSTNAME (CADR TAIL))) (NAME (SETQ NAME (CADR TAIL))) (EXTENSION (SETQ EXT (CADR TAIL))) (VERSION (COND ((OR (EQ (NCHARS (SETQ VERSION (MKATOM (CADR TAIL)))) 0) (EQ VERSION 0)) (* ; "Newest version only") (SETQ SORT? T) (* ; "Can only get highest version by sorting") (SETQ VERSION NIL) (SETQ DESIREDVERSION T)) ((SMALLP VERSION) (* ; "An actual specific version to look for") (SETQ DESIREDVERSION VERSION)) ((NEQ VERSION (QUOTE *)) (* ; "Bogus version") (RETURN T)))) (RETURN T))) (* ; "Bad file name") (RETURN (\NULLFILEGENERATOR)))) (SETQ FILTER (DIRECTORY.MATCH.SETUP (CONCAT NAME (QUOTE %.) EXT ";*"))) (SETQ CHARLIST (for C instring (COND ((OR (EQ 0 (NCHARS EXT)) (EQ (CHCON1 EXT) (CHARCODE *))) NAME) (T (CONCAT NAME (QUOTE %.) EXT))) until (SELCHARQ (SETQ C (\GETBASEBYTE CASEBASE C)) ((%# *) (* ;; "\SEARCHDIR1 currently only checks prefixes, so we truncate at the first * or escape.  Also ignore version specifications, because of the alternative representations of version 1") T) NIL) collect C)) (COND (DESIREDPROPS (* ; "Create a scratch stream for \M44FILEINFOFN to use") (SETQ GENSTREAM (create M44STREAM)) (replace DEVICE of GENSTREAM with FDEV))) (SETQ SEARCHSTATE (create M44DIRSEARCHSTATE DIRPTR _ 0 CHARLIST _ CHARLIST)) (SETQ HOSTPREFIX (CONCAT (QUOTE {) HOSTNAME (QUOTE }))) (RETURN (COND (SORT? (* ; "Have to generate the matching files first, sort them, then enumerate") (create FILEGENOBJ NEXTFILEFN _ (FUNCTION \M44SORTEDNEXTFILEFN) FILEINFOFN _ (FUNCTION \M44FILEINFOFN) GENFILESTATE _ (create M44GENFILESTATE DIROFD _ DIRSTREAM SEARCHSTATE _ (\M44SORTFILES DIRSTREAM SEARCHSTATE FILTER DESIREDVERSION HOSTPREFIX (LENGTH CHARLIST)) GENVERSION _ DESIREDVERSION GENSTREAM _ GENSTREAM))) (T (* ; "Order not important") (create FILEGENOBJ NEXTFILEFN _ (FUNCTION \M44NEXTFILEFN) FILEINFOFN _ (FUNCTION \M44FILEINFOFN) GENFILESTATE _ (create M44GENFILESTATE DIROFD _ DIRSTREAM SEARCHSTATE _ SEARCHSTATE GENFILTER _ FILTER GENVERSION _ DESIREDVERSION HOSTNAME _ HOSTPREFIX GENSTREAM _ GENSTREAM)))))))
)

(\M44SORTFILES
(LAMBDA (DIRSTREAM SEARCHSTATE FILTER DESIREDVERSION HOSTPREFIX PATTERNLENGTH) (* bvm%: " 7-Jun-84 14:38") (SORT (bind FL while (SETQ FL (\M44GENERATENEXT DIRSTREAM SEARCHSTATE FILTER DESIREDVERSION HOSTPREFIX PATTERNLENGTH)) collect FL) (FUNCTION (LAMBDA (X Y) (SELECTQ (UALPHORDER (CAR X) (CAR Y)) (LESSP T) (EQUAL (IGREATERP (CADR X) (CADR Y))) NIL)))))
)

(\M44GENERATENEXT
  [LAMBDA (DIRSTREAM SEARCHSTATE FILTER DESIREDVERSION HOSTPREFIX PATTERNLENGTH GENFILESTATE)
                                                             (* ; "Edited 21-Jan-91 23:53 by jds")

(* ;;; "Produces the next filename from directory DIRSTREAM satisfying SEARCHSTATE and the more constrained FILTER and DESIREDVERSION, or returns NIL if no more files.  HOSTPREFIX is string to put on front, or NIL for names only.  PATTERNLENGTH is the length of the pattern in SEARCHSTATE.  GENFILESTATE is a a M44GENFILESTATE whose GENSTREAM and ENTRYSTART want to be set appropriately for \M44FILEINFOFN;  if NIL, then the value is returned for SORTFILES in the form (name version entrystart)")

    (PROG ((PATTERNHASDOT (MEMB (CHARCODE %.)
                                (fetch (M44DIRSEARCHSTATE CHARLIST) of SEARCHSTATE)))
           SAWDOT ENTRYSTART TEMP PREFIXLEN TOTALLEN THISVERSION RESULT INDEX)
      LP  (COND
             ((NOT (SETQ TEMP (\M44SEARCHDIR DIRSTREAM SEARCHSTATE)))
                                                             (* ; "Enumeration finished")
              (RETURN NIL)))
          (SETQ SAWDOT PATTERNHASDOT)
          (SETQ ENTRYSTART (IDIFFERENCE (GETFILEPTR DIRSTREAM)
                                  (IPLUS PATTERNLENGTH 13))) (* ; 
                                                       "Read all the characters from the directory")
          (SETQ TOTALLEN (IPLUS PATTERNLENGTH (SUB1 TEMP)))
          (for I from (SUB1 TEMP) to 1 by -1
             do                                          (* ; 
                                      "The SUB1 is because the last character is the undesired dot")
                   (SELCHARQ (\BIN DIRSTREAM)
                        (! [RETURN (SETQ THISVERSION (\M44READVERSION DIRSTREAM (SUB1 I])
                        (%. (SETQ SAWDOT T))
                        NIL) finally (SETQ THISVERSION 1))
          (COND
             ((AND DESIREDVERSION (NEQ THISVERSION DESIREDVERSION)
                   (NEQ DESIREDVERSION T))                   (* ; "Failure, try next")
              (GO LP)))
          [SETQ RESULT (ALLOCSTRING (IPLUS TOTALLEN (SETQ PREFIXLEN (COND
                                                                       (HOSTPREFIX (NCHARS HOSTPREFIX
                                                                                          ))
                                                                       (T 0)))
                                           (COND
                                              ((AND (EQ THISVERSION 1)
                                                    HOSTPREFIX)
                                               2)
                                              (T 0))
                                           (COND
                                              (SAWDOT 0)
                                              (T 1]
          (AND HOSTPREFIX (RPLSTRING RESULT 1 HOSTPREFIX))
          (\SETFILEPTR DIRSTREAM (IPLUS ENTRYSTART 13))      (* ; "Now read the whole name")
          (SETQ INDEX PREFIXLEN)
          (for I from TOTALLEN to 1 by -1
             do (SELCHARQ (SETQ TEMP (\BIN DIRSTREAM))
                         (%. (SETQ SAWDOT T))
                         (! (OR SAWDOT (RPLCHARCODE RESULT (add INDEX 1)
                                              (CHARCODE %.)))
                            (SETQ SAWDOT T)
                            [COND
                               (HOSTPREFIX (RPLCHARCODE RESULT (add INDEX 1)
                                                  (CHARCODE ;))
                                      (to (SUB1 I)
                                         do (RPLCHARCODE RESULT (add INDEX 1)
                                                       (COND
                                                          (GENFILESTATE (\BIN DIRSTREAM))
                                                          (T 

                                 (* ;; "Make everything a constant version for benefit of SORT.  Will replace with real thing later.  The constant version is chosen in a way that makes 2-digit versions sort in front of 1-digit versions, etc, and single-digit versions come out as ;1 to match the ;1 inserted below")

                                                             (IDIFFERENCE (CHARCODE 3)
                                                                    I]
                            (RETURN))
                         NIL)
                   (RPLCHARCODE RESULT (add INDEX 1)
                          TEMP))
          (OR SAWDOT (RPLCHARCODE RESULT (add INDEX 1)
                            (CHARCODE %.)))
          (COND
             ((AND (EQ THISVERSION 1)
                   HOSTPREFIX)
              (RPLSTRING RESULT (ADD1 INDEX)
                     ";1")))
          (COND
             ((AND FILTER (NOT (DIRECTORY.MATCH FILTER RESULT)))
              (GO LP)))
          (RETURN (COND
                     (GENFILESTATE (replace (M44GENFILESTATE ENTRYSTART) of GENFILESTATE
                                      with ENTRYSTART)
                            (replace (M44STREAM DIRINFO) of (fetch (M44GENFILESTATE
                                                                                GENSTREAM)
                                                                       of GENFILESTATE)
                               with NIL)
                            RESULT)
                     (T (LIST RESULT THISVERSION ENTRYSTART])

(\M44NEXTFILEFN
  [LAMBDA (GENFILESTATE NAMEONLY)                        (* ; "Edited 21-Jan-91 23:53 by jds")

    (* ;; "GENFILESTATE is the state information from the file-generator object created by \M44GENERATEFILES.  This function returns the next file name as a string.  Returns NIL if no files left.  It updates GENFILESTATE so that it will get the following satisfactory file on the next call to this function.  --- NAMEONLY => returns the filenames without the semi-colon and version number")

    (PROG ((DIRSTREAM (fetch (M44GENFILESTATE DIROFD) of GENFILESTATE))
           (SEARCHSTATE (fetch (M44GENFILESTATE SEARCHSTATE) of GENFILESTATE))
           (DESIREDVERSION (fetch (M44GENFILESTATE GENVERSION) of GENFILESTATE))
           (FILTER (fetch (M44GENFILESTATE GENFILTER) of GENFILESTATE))
           (HOSTPREFIX (AND (NOT NAMEONLY)
                            (fetch (M44GENFILESTATE HOSTNAME) of GENFILESTATE)))
           PATTERNLENGTH)
          (SETQ PATTERNLENGTH (LENGTH (fetch (M44DIRSEARCHSTATE CHARLIST) of SEARCHSTATE)))
          (RETURN (\M44GENERATENEXT DIRSTREAM SEARCHSTATE FILTER DESIREDVERSION HOSTPREFIX 
                         PATTERNLENGTH GENFILESTATE])

(\M44SORTEDNEXTFILEFN
  [LAMBDA (GENFILESTATE NAMEONLY)                        (* ; "Edited 21-Jan-91 23:51 by jds")
    (LET ((FILES (fetch (M44GENFILESTATE SEARCHSTATE) of GENFILESTATE))
          THISFILE THISNAME V LEN)
         (COND
            ((SETQ THISFILE (CAR FILES))                     (* ; 
                                                           "THISFILE = (name version entryStart)")
             (SETQ THISNAME (CAR THISFILE))
             (SETQ V (CADR THISFILE))

             (* ;; "need to fill in the correct version number, since the names were generated with constant version number")

             (SETQ LEN (NCHARS THISNAME))
             [COND
                [(ILESSP V 10)                               (* ; "Easy, 1-digit version")
                 (\RPLCHARCODE THISNAME LEN (PLUS V (CHARCODE 0]
                (T (SETQ V (CHCON V))
                   (for C in V as I from [SETQ LEN (ADD1 (IDIFFERENCE LEN
                                                                                (LENGTH V]
                      do (\RPLCHARCODE THISNAME I C]
             (replace (M44STREAM DIRINFO) of (fetch (M44GENFILESTATE GENSTREAM)
                                                        of GENFILESTATE) with NIL)
             (replace (M44GENFILESTATE ENTRYSTART) of GENFILESTATE with (CADDR THISFILE))
             (SETQ FILES (CDR FILES))
             (COND
                ((EQ (fetch (M44GENFILESTATE GENVERSION) of GENFILESTATE)
                     T)
                 (bind (THISNAMEONLY _ (SUBSTRING THISNAME 1 (SUB1 LEN)))
                    while (AND FILES (STRING-EQUAL (SUBSTRING (CAAR FILES)
                                                              1
                                                              (SUB1 LEN))
                                                THISNAMEONLY)) do (SETQ FILES (CDR FILES)))
                 FILES))
             (replace (M44GENFILESTATE SEARCHSTATE) of GENFILESTATE with FILES)
             THISNAME])

(\M44FILEINFOFN
  [LAMBDA (GENFILESTATE ATTRIBUTE)                       (* ; "Edited 21-Jan-91 23:51 by jds")

    (* ;; 
 "Retrieves info of file currently being enumerated.  State has a directory pointer to help us out")

    (PROG ((STREAM (fetch (M44GENFILESTATE GENSTREAM) of GENFILESTATE)))
          (OR STREAM (RETURN))
          (COND
             ((NULL (fetch (M44STREAM DIRINFO) of STREAM))
              (replace VALIDATION of STREAM with (replace (M44STREAM FILEPAGEMAP)
                                                                of STREAM with NIL))
              (replace (M44STREAM DIRINFO) of STREAM with (fetch (M44GENFILESTATE
                                                                                  ENTRYSTART)
                                                                         of GENFILESTATE))
              (replace (M44STREAM FID) of STREAM with (\M44READDIRFID
                                                                   (fetch (M44GENFILESTATE DIROFD
                                                                                     ) of 
                                                                                         GENFILESTATE
                                                                          )
                                                                   (fetch (M44GENFILESTATE 
                                                                                     ENTRYSTART)
                                                                      of GENFILESTATE)
                                                                   (fetch (M44STREAM FID)
                                                                      of STREAM)))
              (\M44ReadLeaderPage STREAM T)))
          (RETURN (\M44GetFileInfo STREAM ATTRIBUTE])
)



(* ;; "Directory lookup routines")

(DEFINEQ

(\M44PARSEFILENAME
  [LAMBDA (X RECOG DEV CREATEFLG)                        (* ; "Edited 21-Jan-91 23:47 by jds")

    (* ;; "This returns a full file specification, with all the information needed to do open, delete, etc.  A filespec is a (uname dirptr) pair, with the true version number smashed into the uname.  The dirptr is NIL if the file does not currently exist in the directory.")

    (PROG ((DIRSTREAM (fetch (M44DEVICE SYSDIROFD) of DEV))
           UNAME ENDNAMEOFFSET MAYBENEW EXPLICITVERSION FIXEDVERSION UCHARS SOMEPTR TLIST PTR 
           NCHARSLEFT BESTVERSION BESTPTR VERS HMIN OLDESTP)
          [COND
             ([NULL (SETQ UNAME (\M44UNPACKFILENAME X DEV (SELECTQ RECOG
                                                                  ((NEW OLD/NEW) 
                                                             (* ; 
                 "We might create a new file here, so tell unpack to save the original characters.")
                                                                       (SETQ MAYBENEW T))
                                                                  NIL]
                                                             (* ; "BAD FILE NAME")
              (RETURN (create FILESPEC
                             UNAME _ NIL]

     (* ;; "Name parsed ok, get ready to search directory for it.")

          (SETQ UCHARS (fetch (UNAME UCASECHARS) of UNAME))
          (SETQ ENDNAMEOFFSET (+ 13 (LENGTH UCHARS)))        (* ; "ENDNAMEOFFSET is length of name we're searching for plus fixed overhead (header word, FID, name length byte)")
          [COND
             (CREATEFLG                                      (* ; "Want to look for a hole, in case we need to create the file.  The 6 is to allow for the maximum number of chars in a version number")
                    (SETQ HMIN (FOLDLO (+ ENDNAMEOFFSET 6)
                                      BYTESPERWORD]
          (SETQ TLIST (CONS 0 UCHARS))                       (* ; 
                                    "Pair of dirptr & chars used to communicate with \M44SEARCHDIR")
          (if (AND (FIXP (SETQ EXPLICITVERSION (fetch (UNAME VERSION) of UNAME)))
                       (NEQ EXPLICITVERSION 0))
              then                                       (* ; 
        "If caller gave a real explicit version, then if we find that version, we know we're done.")
                    (SETQ FIXEDVERSION EXPLICITVERSION))
          (SETQ OLDESTP (EQ (OR EXPLICITVERSION RECOG)
                            'OLDEST))
      SEARCHLP
          (COND
             ((NULL (SETQ NCHARSLEFT (\M44SEARCHDIR DIRSTREAM TLIST HMIN)))
                                                             (* ; "No more prefix matches found")
              (GO DONE)))
          (SETQ PTR (\GETFILEPTR DIRSTREAM))                 (* ; "Note current position")
          (COND
             ((EQ NCHARSLEFT 1)                              (* ; 
                        "No version, just the final dot remains, so we must have matched version 1")
              (SETQ VERS 1))
             ((NEQ (\BIN DIRSTREAM)
                   (CHARCODE !))                             (* ; 
                                                    "More chars follow before version, so no match")
              (GO NEXT))
             ([NULL (SETQ VERS (\M44READVERSION DIRSTREAM (- NCHARSLEFT 2]
              (GO NEXT)))

     (* ;; "Name matches.  VERS is the version number.  Is it better than we've seen?  Accumulate extreme vers,ptr in BESTVERSION,BESTPTR.")

          (SETQ PTR (- PTR ENDNAMEOFFSET))                   (* ; 
                                                           "Beginning of the directory entry")
          (COND
             [FIXEDVERSION                                   (* ; "Version must match")
                    (SETQ BESTPTR PTR)                       (* ; 
                                        "Always note a pointer, for benefit of getting case right.")
                    (COND
                       ((EQ VERS FIXEDVERSION)               (* ; "The one we've been looking for")
                        (SETQ BESTVERSION VERS)
                        (GO DONE]
             ((OR (NULL BESTVERSION)
                  (if OLDESTP
                      then (< VERS BESTVERSION)
                    else (> VERS BESTVERSION)))          (* ; "More extreme than the last one")
              (SETQ BESTVERSION VERS)
              (SETQ BESTPTR PTR)))
      NEXT
          (COND
             ((AND HMIN (fetch (M44STREAM DIRHOLEPTR) of DIRSTREAM))
                                                             (* ; 
                                                           "Stop looking for a hole if found one")
              (SETQ HMIN NIL)))
          (GO SEARCHLP)
      DONE
          

     (* ;; "At this point, BESTVERSION is the version, if any, that best matches RECOG or funny version spec in UNAME, i.e., it is the oldest or newest version.  BESTPTR is the corresponding directory pointer.  In the case where an explicit version was requested but not found, BESTPTR is the directory pointer of SOME version.  So now we need to bump the version up for RECOG = NEW, and maybe adjust the characters.")

          (SETQ SOMEPTR BESTPTR)                             (* ; 
                                        "Save dir pointer for getting at true chars for new files.")
          (if BESTVERSION
              then                                       (* ; "Found one")
                    (if (if EXPLICITVERSION
                                then                     (* ; "Ignore funny version N when asking for %"OLD%" recognition--don't want FOO;N to mean next highest version, since that's a lie. e.g., it's not infilep.")
                                      (AND (EQ EXPLICITVERSION 'NEW)
                                           MAYBENEW)
                              else (EQ RECOG 'NEW))
                        then (add BESTVERSION 1)     (* ; 
                                     "Bump version, clear directory pointer (since we're creating)")
                              (SETQ BESTPTR NIL))
            elseif MAYBENEW
              then                                       (* ; 
                                     "Specified file doesn't exist, but we're willing to create it")
                    (SETQ BESTVERSION (OR FIXEDVERSION 1))
                    (SETQ BESTPTR NIL))
          (RETURN (if BESTVERSION
                      then                               (* ; "Success")
                            (if (NULL BESTPTR)
                                then                     (* ; 
                                     "New file.  Get the case right if some other version existed.")
                                      (if SOMEPTR
                                          then (replace (UNAME ORIGCHARS) of UNAME
                                                      with (\M44READDIRNAME DIRSTREAM SOMEPTR
                                                                      )))
                              elseif (fetch (UNAME ORIGCHARS) of UNAME)
                                then                     (* ; 
  "New recog but existing file--happens when overwriting.  Still want to get the characters right.")
                                      (replace (UNAME ORIGCHARS) of UNAME
                                         with (\M44READDIRNAME DIRSTREAM BESTPTR)))
                            (replace (UNAME VERSION) of UNAME with BESTVERSION)
                            (create FILESPEC
                                   UNAME _ UNAME
                                   FSDIRPTR _ BESTPTR])

(\FINDDIRHOLE
  [LAMBDA (NWORDS DIRSTREAM)                             (* ; "Edited 21-Jan-91 23:37 by jds")

    (* ;; "Returns the byte address of a directory hole of size NWORDS.  The directory file is positioned just after the 2-byte length field of the hole.")

    (PROG ((HINT (fetch (M44STREAM DIRHOLEPTR) of DIRSTREAM))
           PTR ENTRYLENGTH C)
          (SETQ PTR (OR HINT 0))
      NEXT
          (\SETFILEPTR DIRSTREAM PTR)
          (COND
             ((\EOFP DIRSTREAM)
              (if (AND HINT (> HINT 0))
                  then                                   (* ; 
                                                           "Hint failed, so try from the start.")
                        (SETQ HINT NIL)
                        (SETQ PTR 0)
                        (GO NEXT)
                else (GO END)))
             ((AND (>= (SETQ ENTRYLENGTH (+ (LLSH (LOGAND (SETQ C (\BIN DIRSTREAM))
                                                         3)
                                                  8)
                                            (\BIN DIRSTREAM)))
                       NWORDS)
                   (< C 4))

              (* ;; "First 6 bits is entry type, next 10 bits are length of entry in words.  Free entries have type zero.  Thus C < 4 implies this is free entry.")

              (\SETFILEPTR DIRSTREAM PTR)                    (* ; "Hole is large enough")
              [COND
                 ((> ENTRYLENGTH NWORDS)                     (* ; 
                "Too large, so split hole into 2 parts.  We'll return the second half of the hole.")
                  (\WOUT DIRSTREAM (SETQ ENTRYLENGTH (- ENTRYLENGTH NWORDS)))
                  (\SETFILEPTR DIRSTREAM (add PTR (UNFOLD ENTRYLENGTH BYTESPERWORD]
              (GO END)))
          (add PTR (UNFOLD ENTRYLENGTH BYTESPERWORD))
          (GO NEXT)
      END (\WOUT DIRSTREAM NWORDS)
          (RETURN PTR])

(\M44PACKFILENAME
(LAMBDA (UNAME DIRPTR DIRSTREAM) (* ; "Edited 12-Jan-88 12:01 by bvm") (* ;; "Produces a Lisp style file-name of the form 'name.[ext];ver'") (LET* ((CHARS (OR (AND (NULL *UPPER-CASE-FILE-NAMES*) (OR (fetch (UNAME ORIGCHARS) of UNAME) (if DIRPTR then (* ; "Get the exact name out of the directory") (\M44READDIRNAME DIRSTREAM DIRPTR)))) (fetch (UNAME UCASECHARS) of UNAME))) (NAME (CONCAT (QUOTE {) (fetch (UNAME PARTNAME) of UNAME) (QUOTE }) (CONCATCODES CHARS) (COND ((MEMB (CHARCODE %.) CHARS) ";") (T ".;")) (fetch (UNAME VERSION) of UNAME)))) (if *UPPER-CASE-FILE-NAMES* then (MKATOM NAME) else NAME)))
)

(\M44READVERSION
(LAMBDA (DIRSTREAM MAXCHARS) (* bvm%: " 7-Jun-84 11:38") (to MAXCHARS bind (VERSION _ 0) C do (SETQ C (\BIN DIRSTREAM)) (COND ((AND (IGEQ C (CHARCODE 0)) (ILEQ C (CHARCODE 9))) (SETQ VERSION (IPLUS (ITIMES VERSION 10) (IDIFFERENCE C (CHARCODE 0))))) (T (* ;; "A non-numeric after a ! means that it wasn't the version marker.  This is permissible by alto file spec") (RETURN))) finally (RETURN VERSION)))
)

(\OPENDISKDESCRIPTOR
  [LAMBDA (DEV)                                          (* ; "Edited 21-Jan-91 23:43 by jds")

    (* ;; "Opens and returns a stream on the disk descriptor file for DEV")

    [COND
       ((NOT (type? FDEV DEV))
        (SETQ DEV (\GETDEVICEFROMNAME (fetch (DSKOBJ DISKDEVICENAME) of DEV]
    (OR (fetch (M44DEVICE DDVALID) of DEV)
        (PROG ((OLDD (fetch (M44DEVICE DISKDESCRIPTOROFD) of DEV))
               STREAM)
              (COND
                 (OLDD (FORGETPAGES OLDD)))
              [SETQ STREAM (COND
                              ((EQ (fetch (M44DEVICE DSKOBJ) of DEV)
                                   \MAINDISK)
                               (\M44OPENFILEFROMFP DEV "DISKDESCRIPTOR.;1" 'BOTH (
                                                                                 \CREATE.FID.FOR.DD
                                                                                      DEV)))
                              (T (\OPENFILE (CONCAT "{" (fetch (FDEV DEVICENAME) of DEV)
                                                   "}" "DISKDESCRIPTOR.;1")
                                        'BOTH]
              (replace USERVISIBLE of STREAM with NIL)
              (replace (M44DEVICE DISKDESCRIPTOROFD) of DEV with STREAM)
              (replace MAXBUFFERS of STREAM with (ADD1 (fetch EPAGE of STREAM)))
                                                             (* ; 
                 "Prepare to buffer the whole file, so that we don't get in trouble under \NEWPAGE")
              (for I from 0 to (fetch EPAGE of STREAM)
                 do (\MAPPAGE I STREAM))                 (* ; 
                                          "Ought to define a \MAPPAGES to do that more efficiently")
              (replace ENDOFSTREAMOP of STREAM with (FUNCTION NILL))
              (replace (M44DEVICE DDVALID) of DEV with T)))
    (fetch (M44DEVICE DISKDESCRIPTOROFD) of DEV])

(\M44READDIRFID
  [LAMBDA (DIRSTREAM DIRPTR FID)                         (* ; "Edited 21-Jan-91 23:39 by jds")

    (* ;; "Read the 5-word FID from the directory into FID (or create a new one if FID is nil).  Return the new FID.")

    (\SETFILEPTR DIRSTREAM (+ DIRPTR 2))
    (\BINS DIRSTREAM [fetch (FID FIDBLOCK) of (OR FID (SETQ FID (create FID]
           0
           (UNFOLD 5 BYTESPERWORD))
    FID])

(\M44READDIRNAME
(LAMBDA (DIRSTREAM DIRPTR) (* ; "Edited 11-Jan-88 14:39 by bvm") (* ;; "Read the exact file name, sans version number, from directory stream as a list of char codes.") (* ;; "Format of a directory entry is --- Type&WordLength (1 word), FP (5 words), Name as a BcplString") (SETFILEPTR DIRSTREAM (+ DIRPTR 12)) (to (SUB1 (BIN DIRSTREAM)) bind CH until (EQ (SETQ CH (BIN DIRSTREAM)) (CHARCODE !)) collect CH))
)

(\M44SEARCHDIR
  [LAMBDA (STREAM TLIST HMIN)                            (* ; "Edited 21-Jan-91 23:37 by jds")

    (* ;; "TLIST is a list of the form (POS . NAMECHARS), where POS at entry is a fileptr in the directory file at which to start searching and NAMECHARS is like the characters pairs of a uname.  Finds next directory entry for which NAMECHARS is a prefix of the filename.  Returns NIL if no entry found, else the length of the remaining chars in the entry.  Leaves the directory positioned after the char matching the last char of NAMECHARS --- STREAM is the ofd of the directory file --- At exit, TLIST is smashed so that POS is the fileptr just beyond the found entry.  --- if HMIN~=NIL, sets STREAM's DIRHOLEPTR to NIL or the fileptr of the first hole of at least HMIN words.")

    (PROG ((CASEBASE (.DISKCASEARRAY.))
           (NEXT (CAR TLIST))
           (NAMECHARS (CDR TLIST))
           THISNAMELENGTH TARGETLENGTH PTR L TYP ENTRYLENGTH)
          (COND
             (HMIN (replace (M44STREAM DIRHOLEPTR) of STREAM with NIL)))
          (SETQ TARGETLENGTH (LENGTH NAMECHARS))
      NEXT
          (\SETFILEPTR STREAM (SETQ PTR NEXT))
          (COND
             ((\EOFP STREAM)
              (RETURN)))

     (* ;; "Format of a directory entry is --- Type (0 = hole, 1 = file), 6 bits --- Length of entry in words, 10 bits --- FP 5 words --- Name as a BcplString")

          (SETQ TYP (\BIN STREAM))
          (SETQ ENTRYLENGTH (IPLUS (LLSH (LOGAND TYP 3)
                                         8)
                                   (\BIN STREAM)))
          (SETQ NEXT (IPLUS (UNFOLD ENTRYLENGTH BYTESPERWORD)
                            PTR))
          (COND
             ((NEQ (LRSH TYP 2)
                   1)                                        (* ; "Not a file")
              (COND
                 ((AND HMIN (NOT (IGREATERP HMIN ENTRYLENGTH)))
                  (replace (M44STREAM DIRHOLEPTR) of STREAM with PTR)
                  (SETQ HMIN NIL)))
              (GO NEXT)))
          (\SETFILEPTR STREAM (IPLUS PTR 12))
          (COND
             ((ILESSP (SETQ THISNAMELENGTH (\BIN STREAM))
                     TARGETLENGTH)
              (GO NEXT)))
          (SETQ L NAMECHARS)
      READ
          (COND
             ((NULL L)                                       (* ; 
                                      "Exhausted the pattern before finding a mismatch, so take it")
              (RPLACA TLIST NEXT)
              (RETURN (IDIFFERENCE THISNAMELENGTH TARGETLENGTH)))
             ((EQ (\GETBASEBYTE CASEBASE (\BIN STREAM))
                  (CAR L))
              (SETQ L (CDR L))
              (GO READ))
             (T (GO NEXT])

(\M44UNPACKFILENAME
  [LAMBDA (NAME DEV CREATEFLG)                           (* ; "Edited 21-Jan-91 23:47 by jds")

    (* ;; "Unpacks file name into a UNAME whose VERSION is the version indicator (either a positive integer or one of OLD, OLDEST, NEW);  PARTNAME is the name of DEV.  UCASECHARS is a list of uppercase charcodes from the name.  If CREATEFLG is true, also sets ORIGCHARS to be list of original char codes, for sake of setting real file name")

    (PROG ((CASEBASE (.DISKCASEARRAY.))
           (NC 0)
           J C UPC END ORIGEND VERSION RESULT DOTPREV ORIGDOTPREV EXCESS TAIL)
          (COND
             ((OR (NOT NAME)
                  (EQ NAME T)
                  (NOT (OR (LITATOM NAME)
                           (STRINGP NAME)))
                  (NEQ (NTHCHARCODE NAME 1)
                       (CHARCODE {))
                  (NOT (SETQ J (STRPOS "}" NAME 5)))
                  (EQ (NTHCHARCODE NAME (add J 1))
                      (CHARCODE <)))

              (* ;; "Name is not a non-null string/atom, or doesn't have a host on front, or { is mismatched, or there's a directory.  There used to be some junk in here about passing back a different value if the name had a directory than if it was otherwise malformed, but we really have no use for that.")

              (RETURN NIL)))
          [SETQ END (fetch (UNAME UCASECHARHEAD) of (SETQ RESULT (create UNAME
                                                                                PARTNAME _
                                                                                (fetch DEVICENAME
                                                                                   of DEV]
                                                             (* ; 
                                                        "End is the cell whose CDR can be smashed.")
          (SETQ ORIGEND (fetch (UNAME ORIGCHARHEAD) of RESULT))
      COLLECTNAME
          (COND
             ((NOT (SETQ C (NTHCHARCODE NAME J)))            (* ; "End of name")
              (GO RET))
             ((EQ (SETQ UPC (\GETBASEBYTE CASEBASE C))
                  0)                                         (* ; "Illegal char")
              (GO ERR))
             (T [RPLACD END (SETQ END (LIST (SELCHARQ UPC
                                                 (; (GO SEMI))
                                                 ((%# *)     (* ; "Wildcards not allowed")
                                                      (GO ERR))
                                                 (%.         (* ; "Omit trailing dots")
                                                     (PROG1 (SELCHARQ (NTHCHARCODE NAME (ADD1 J))
                                                                 (NIL (GO RET))
                                                                 ((; !) 
                                                                      (add J 1)
                                                                      (GO SEMI))
                                                                 UPC)
                                                         (SETQ DOTPREV END)
                                                             (* ; 
                                                   "Save tail position here in case name gets long")
                                                         (AND CREATEFLG (SETQ ORIGDOTPREV ORIGEND))))
                                                 UPC]
                [COND
                   (CREATEFLG                                (* ; "Save orig chars as well")
                          (RPLACD ORIGEND (SETQ ORIGEND (LIST C]
                (add J 1)
                (add NC 1)
                (GO COLLECTNAME)))
      SEMI
          

     (* ;; "Parsing the stuff after the semicolon;  we only accept version, though we do accept the funny symbolic versions H, L and N.")

          (COND
             ([NULL (SETQ C (NTHCHARCODE NAME (add J 1]
              (GO RET))
             ((EQ (SETQ C (\GETBASEBYTE CASEBASE C))
                  0)                                         (* ; "Illegal char")
              (GO ERR)))
          (SELCHARQ C
               (H (SETQQ VERSION OLD))
               (L (SETQQ VERSION OLDEST))
               (N (SETQQ VERSION NEW))
               (GO COLLECTVERSION))
          (if (EQ J (NCHARS NAME))
              then                                       (* ; "Done")
                    (GO RET)
            else                                         (* ; "Malformed name")
                  (GO ERR))
      COLLECTVERSION
          (SETQ VERSION 0)
          [while (AND C (BETWEEN C (CHARCODE 0)
                                   (CHARCODE 9))) do [SETQ VERSION (+ (TIMES VERSION 10)
                                                                          (- C (CHARCODE 0]
                                                        (SETQ C (NTHCHARCODE NAME (add J 1]
          (COND
             ((EQ VERSION 0)
              (SETQQ VERSION OLD))
             ((IGREATERP VERSION 65535)
              (GO ERR)))
          (if (NULL C)
              then                                       (* ; "end of name ok")
                    (GO RET))
      ERR                                                    (* ; "BAD FILE NAME")
          (RETURN NIL)
      RET (replace (UNAME VERSION) of RESULT with VERSION)
          [if (> (SETQ EXCESS (- NC (- \MAX.ALTO.NAME.LENGTH 7)))
                     0)
              then

              (* ;; "Hmm, is name too long?  7 counts for a possible !, 5 version chars and the final dot.  This is unnecessarily restrictive for names with shorter versions, but it would get quite untidy if you let version 9 squeak in and then complain or shorten on 10.  So best to shorten now.  We prefer to leave the extension intact, since that can convey info, and shorten the name.")

              [if DOTPREV
                  then (SETQ DOTPREV (CDR DOTPREV))      (* ; "Now (CAR DOTPREV) is the period")
                        (SETQ ORIGDOTPREV (CDR ORIGDOTPREV))
                        (if (CDR (SETQ TAIL (CL:NTHCDR 10 DOTPREV)))
                            then                         (* ; 
             "Extension longer than 10 chars (this allows, e.g., INTERPRESS), so let's shorten it.")
                                  (if (<= (SETQ NC (LENGTH (CDR TAIL)))
                                              EXCESS)
                                      then               (* ; "Chop off the entire excess")
                                            (RPLACD TAIL NIL)
                                            (if CREATEFLG
                                                then (RPLACD (CL:NTHCDR 10 ORIGDOTPREV)
                                                                NIL))
                                            (SETQ EXCESS (- EXCESS NC))
                                    else                 (* ; "only have to get rid of some")
                                          (RPLACD (CL:NTHCDR (- NC EXCESS)
                                                         TAIL)
                                                 NIL)
                                          (if CREATEFLG
                                              then (RPLACD (CL:NTHCDR (+ 10 (- NC EXCESS))
                                                                      ORIGDOTPREV)
                                                              NIL))
                                          (SETQ EXCESS 0]
              (if (> EXCESS 0)
                  then                                   (* ; "Chop away at name")
                        (RPLACD (NLEFT (fetch (UNAME UCASECHARS) of RESULT)
                                       (ADD1 EXCESS)
                                       DOTPREV)
                               DOTPREV)
                        (if CREATEFLG
                            then (RPLACD (NLEFT (fetch (UNAME ORIGCHARS) of RESULT)
                                                    (ADD1 EXCESS)
                                                    ORIGDOTPREV)
                                            ORIGDOTPREV]
          (RETURN RESULT])
)

(RPAQQ \FILENAMECHARSLST (36 43 45 46))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \FILENAMECHARSLST)
)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE

(RECORD UNAME (VERSION . UCASECHARHEAD)
                  (RECORD UCASECHARHEAD (ORIGCHARHEAD . UCASECHARS)
                         (RECORD ORIGCHARHEAD (PARTNAME . ORIGCHARS))))

(RECORD FILESPEC (UNAME FSDIRPTR)
                     [ACCESSFNS FILESPEC ((PNAME (\M44PACKFILENAME (fetch UNAME of DATUM])

(RECORD M44GENFILESTATE (DIROFD SEARCHSTATE GENFILTER GENVERSION HOSTNAME GENSTREAM ENTRYSTART))

(RECORD M44DIRSEARCHSTATE (DIRPTR . CHARLIST))
)

(DECLARE%: EVAL@COMPILE 

(PUTPROPS BETWEEN MACRO (OPENLAMBDA (V LO HI)
                                       (AND (IGEQ V LO)
                                            (ILEQ V HI))))
)
)
(DEFINEQ

(\CREATE.FID.FOR.DD
  [LAMBDA (FDEV)                                         (* ; "Edited 21-Jan-91 23:39 by jds")

    (* ;; "Creates a FID for the file DISKDESCRIPTOR on FDEV, which must be the default disk partition's device")

    (PROG ((FID (create FID)))

     (* ;; "Currently \SYSDISK has a copy of the diskdescriptor fp inside it, as looked up by alto at beginning of world, so be lazy and use that")

          (\BLT (fetch (FID FIDBLOCK) of FID)
                (LOCF (fetch (M44DEVICE DSKDDBLK) of FDEV))
                \LENFP)
          (RETURN FID])

(\OPENDISK
  [LAMBDA (PARTNUM FDEV)                                 (* ; "Edited 21-Jan-91 23:32 by jds")
    (PROG (DSK DD)
          (OR (\TESTPARTITION PARTNUM)
              (RETURN))
          (SETQ DSK (create DSKOBJ))
          (\LOCKWORDS DSK \NWORDS.DSKOBJ)
          (replace (DSKOBJ DSKPARTITION) of DSK with PARTNUM)
          (replace (DSKOBJ ddPOINTER) of DSK with (LOCF (fetch (DSKOBJ ddLASTSERIAL#)
                                                                       of DSK)))
          (replace (DSKOBJ NDISKS) of DSK with 2)
          (replace (DSKOBJ NTRACKS) of DSK with 406)
          (replace (DSKOBJ NHEADS) of DSK with 2)
          (replace (DSKOBJ NSECTORS) of DSK with 14)
          (replace (DSKOBJ RETRYCOUNT) of DSK with 8)
          (replace (DSKOBJ CBQUEUE) of DSK with (fetch (DSKOBJ CBQUEUE) of 
                                                                                            \MAINDISK
                                                                   ))
                                                             (* ; "Really should have our own")
          (RETURN (\OPENDISKDEVICE PARTNUM DSK FDEV])

(\OPENDISKDEVICE
  [LAMBDA (PARTITION DSKOBJ FDEV)                        (* ; "Edited 21-Jan-91 23:43 by jds")
    (DECLARE (GLOBALVARS \MAINDISK))                     (* ; 
                                            "Creates the model 44 DSK device and opens its SYSDIR.")
    (PROG ([NAME (PACK* 'DSK (OR PARTITION (DISKPARTITION]
           FDEV)
          [OR FDEV (SETQ FDEV (\MAKE.PMAP.DEVICE (create FDEV
                                                        DEVICENAME _ NAME
                                                        NODIRECTORIES _ T
                                                        CLOSEFILE _ (FUNCTION \M44CloseFile)
                                                        DELETEFILE _ (FUNCTION \M44DeleteFile)
                                                        GETFILEINFO _ (FUNCTION \M44GetFileInfo)
                                                        GETFILENAME _ (FUNCTION \M44GetFileName)
                                                        OPENFILE _ (FUNCTION \M44OpenFile)
                                                        READPAGES _ (FUNCTION \M44ReadPages)
                                                        SETFILEINFO _ (FUNCTION \M44SetFileInfo)
                                                        TRUNCATEFILE _ (FUNCTION \M44TruncateFile)
                                                        WRITEPAGES _ (FUNCTION \M44WritePages)
                                                        REOPENFILE _ (FUNCTION \M44OpenFile)
                                                        GENERATEFILES _ (FUNCTION \M44GENERATEFILES)
                                                        EVENTFN _ (FUNCTION \M44EVENTFN)
                                                        DIRECTORYNAMEP _ [FUNCTION (LAMBDA (NAME)
                                                             (* ; 
                                                       "Assume host is OK, check that no directory")
                                                                                     (EQ (NTHCHARCODE
                                                                                          NAME -1)
                                                                                         (CHARCODE
                                                                                          }]
                                                        HOSTNAMEP _ (FUNCTION NILL)
                                                        FREEPAGECOUNT _ (FUNCTION \M44FREEPAGECOUNT)
                                                        OPENP _ (FUNCTION \GENERIC.OPENP)
                                                        REGISTERFILE _ (FUNCTION \ADD-OPEN-STREAM)
                                                        UNREGISTERFILE _ (FUNCTION 
                                                                          \GENERIC-UNREGISTER-STREAM]
          (replace (M44DEVICE DSKOBJ) of FDEV with (OR DSKOBJ (SETQ DSKOBJ \MAINDISK)))
          (replace (DSKOBJ DISKDEVICENAME) of DSKOBJ with NAME)
          (RETURN (RESETLST
                      (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (DEV)
                                                       (COND
                                                          ((NOT (fetch (M44DEVICE DSKPASSWORDOK)
                                                                   of DEV))
                                                             (* ; 
                                                           "Oops, it didn't work, take it away")
                                                           (\REMOVEDEVICE DEV]
                                           FDEV))
                      (\DEFINEDEVICE NAME FDEV)              (* ; 
                        "have to define it tentatively first so that \OPENDISKDESCRIPTOR will work")
                      (COND
                         ((\OPENDIR FDEV)
                          (COND
                             ((NULL PARTITION)               (* ; "this is also the default disk")
                              (\DEFINEDEVICE 'DSK FDEV)))
                          FDEV)))])

(\OPENDIR
(LAMBDA (FDEV) (* bvm%: " 6-APR-83 12:16") (* ;; "Opens the model44 directory on the current partition") (PROG ((PART (fetch (M44DEVICE DSKPARTITION) of FDEV)) STREAM DD) (replace (M44DEVICE DSKPASSWORDOK) of FDEV with NIL) (COND ((AND (NEQ PART 0) (NOT (\TESTPARTITION PART))) (replace (M44DEVICE SYSDIROFD) of FDEV with NIL) (RETURN))) (SETQ STREAM (\M44OPENFILEFROMFP FDEV "SYSDIR.;1" (QUOTE BOTH) (create FID W0 _ 32768 W1 _ 100 W2 _ 1 W3 _ 0 W4 _ 1))) (* ; "{DSK}SYSDIR.;1 always has sn 100, leader page on virtual page 1") (replace MAXBUFFERS of STREAM with (IMAX 64 (ADD1 (fetch EPAGE of STREAM)))) (* ; "Enough buffers so that directory is effectively always in core") (replace (M44DEVICE SYSDIROFD) of FDEV with STREAM) (COND ((NEQ PART 0) (SETQ DD (\OPENDISKDESCRIPTOR FDEV)) (\SETFILEPTR DD \OFFSET.DISKLASTSERIAL#) (\BINS DD (LOCF (fetch (M44DEVICE DISKLASTSERIAL#) of FDEV)) 0 \NBYTES.DISKINFO) (add (fetch (M44DEVICE DISKLASTSERIAL#) of FDEV) 3) (* ; "Try to avoid collisions") (COND ((NOT (\M44CHECKPASSWORD FDEV)) (replace (M44DEVICE SYSDIROFD) of FDEV with NIL) (RETURN))))) (replace (M44DEVICE DSKPASSWORDOK) of FDEV with T) (RETURN STREAM)))
)

(\M44CHECKPASSWORD
(LAMBDA (DEV) (* bvm%: "11-Jun-86 12:20") (PROG ((STREAM (\OPENFILE (PACK* (QUOTE {) (fetch (FDEV DEVICENAME) of DEV) "}SYS.BOOT;1") (QUOTE INPUT) (QUOTE OLD))) PASSVECTOR BUF PASSINFO ASKEDONCE NAME N) (COND ((NULL STREAM) (RETURN T))) (SETQ PASSVECTOR (\ALLOCBLOCK (FOLDHI \NWORDS.BCPLPASSWORD WORDSPERCELL))) (SETFILEPTR STREAM \OFFSET.BCPLPASSWORD) (\BINS STREAM PASSVECTOR 0 (UNFOLD \NWORDS.BCPLPASSWORD BYTESPERWORD)) (COND ((EQ (\GETBASE PASSVECTOR 0) 0) (* ; "No password") (\CLOSEFILE STREAM) (RETURN T))) (SETFILEPTR STREAM \OFFSET.BCPLUSERNAME) (SETQ NAME (ALLOCSTRING (SETQ N (\BIN STREAM)))) (* ; "Read in a bcpl string which is the username installed on the disk") (\BINS STREAM (fetch (STRINGP BASE) of NAME) 0 N) (\CLOSEFILE STREAM) (SETQ NAME (MKATOM NAME)) LP (SETQ PASSINFO (\INTERNAL/GETPASSWORD (fetch (FDEV DEVICENAME) of DEV) ASKEDONCE NIL NIL NAME)) (COND ((NULL PASSINFO) (RETURN NIL))) (COND ((UNINTERRUPTABLY (SETQ BUF (\GETPACKETBUFFER)) (* ; "HORRIBLE CHEAP TRICK to get some emulator space") (\BLT (\ADDBASE BUF 64) PASSVECTOR \NWORDS.BCPLPASSWORD) (SetBcplString (\ADDBASE BUF (IPLUS 64 \NWORDS.BCPLPASSWORD)) (\DECRYPT.PWD (CDR PASSINFO))) (\CHECKBCPLPASSWORD (\ADDBASE BUF (IPLUS 64 \NWORDS.BCPLPASSWORD)) (\ADDBASE BUF 64))) (RETURN T)) (T (SETQ ASKEDONCE T) (GO LP)))))
)

(\M44HOSTNAMEP
(LAMBDA (NAME DEV) (* bvm%: "20-Nov-84 16:06") (PROG (PARTNUM) (RETURN (COND ((EQ NAME (QUOTE DSK)) (\OPENDISKDEVICE)) ((AND (STRPOS (QUOTE DSK) NAME 1 NIL T) (SETQ PARTNUM (FIXP (SUBATOM NAME 4))) (\TESTPARTITION PARTNUM)) (COND ((EQ PARTNUM (DISKPARTITION)) (RETURN (\GETDEVICEFROMNAME (QUOTE DSK)))) (T (\OPENDISK PARTNUM))))))))
)
)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(RPAQQ \OFFSET.BCPLUSERNAME 512)

(RPAQQ \OFFSET.BCPLPASSWORD 768)

(RPAQQ \NWORDS.BCPLPASSWORD 9)


(CONSTANTS \OFFSET.BCPLUSERNAME \OFFSET.BCPLPASSWORD \NWORDS.BCPLPASSWORD)
)
)



(* ;; "SYSOUT etc.")

(DEFINEQ

(\COPYSYS
(LAMBDA (FILE SYSNAME DONTSAVE) (DECLARE (GLOBALVARS SYSOUTCURSOR \VMEM.INHIBIT.WRITE IDLE.PROFILE)) (* ; "Edited  1-Apr-90 16:27 by nm") (PROG (FULLNAME VAL HOST) RETRY (RECLAIM) (RETURN (COND ((NULL (SETQ VAL (OR (COND ((NOT DONTSAVE) (* ; "Make vmem consistent on disk (like SAVEVM)") (COND (\VMEM.INHIBIT.WRITE (* ; "Force this to NIL, in case someone accidentally got it set to T") (PROMPTPRINT "***WARNING: VMEM.INHIBIT.WRITE was true; setting it to NIL now.") (SETQ \VMEM.INHIBIT.WRITE NIL))) (SETQ FILE (\ADD.CONNECTED.DIR FILE)) (SELECTQ (MACHINETYPE) (MAIKO (SELECTQ (SETQ HOST (U-CASE (FILENAMEFIELD FILE (QUOTE HOST)))) (DSK (* ; "OPENSTREAM with file attributes is not available on DSK and UNIX, so check is done by \DOFLUSHVM ") (* ;; "If  \MAIKO.SYSOUTNAME is non NIL, image is saved by \FLUSHVM, no need to copy") (\FLUSHVM (SETQ FULLNAME (CONCAT "{" HOST "}" (\UFS.RECOGNIZE.FILE FILE (QUOTE NON) (\GETDEVICEFROMNAME HOST)))))) (UNIX (* ; "OPENSTREAM with file attributes is not available on DSK and UNIX, so check is done by \DOFLUSHVM ") (* ;; "If  \MAIKO.SYSOUTNAME is non NIL, image is saved by \FLUSHVM, no need to copy") (\FLUSHVM (SETQ FULLNAME (CONCAT "{" HOST "}" (\UFS.RECOGNIZE.FILE FILE (QUOTE NON) (\GETDEVICEFROMNAME HOST)))))) (RESETLST (PROG1 (\FLUSHVM) (RESETSAVE (CURSOR (COND ((type? CURSOR SYSOUTCURSOR) SYSOUTCURSOR) (T T)))) (LET ((UNIXVAR (UNIX-GETENV "LDEDESTSYSOUT"))) (* ; "\FLSUVM saves image to  Unix enviroment var  or lisp.virtualmem") (SETQ FULLNAME (COPYFILE (COND (UNIXVAR (CONCAT "{DSK}" UNIXVAR)) (T "{DSK}~/lisp.virtualmem")) FILE (QUOTE ((TYPE BINARY)))))))))) (\FLUSHVM)))) (CL:UNWIND-PROTECT (COND ((EQ \MACHINETYPE \MAIKO) NIL) (T (PROGN (SETQ \VMEM.INHIBIT.WRITE T) (* ; "Prevent dirty pages from being written after the \FLUSHVM") (RESETLST (LET ((LASTPAGE (fetch (IFPAGE NActivePages) of \InterfacePage)) STREAM) (* ; "Note length of sysout now, because NActivePages can grow as we prepare to write the sysout") (SETQ STREAM (OPENSTREAM FILE (QUOTE OUTPUT) (QUOTE NEW) NIL (BQUOTE ((LENGTH (\, (UNFOLD LASTPAGE BYTESPERPAGE))) (SEQUENTIAL T) (TYPE BINARY))))) (SETQ FULLNAME (fetch (STREAM FULLNAME) of STREAM)) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (FILE) (CLOSEF FILE) (AND RESETSTATE (DELFILE (fetch (STREAM FULLNAME) of FILE))))) STREAM)) (COND (SYSNAME (SET SYSNAME FULLNAME))) (RESETSAVE (CURSOR (COND ((type? CURSOR SYSOUTCURSOR) (* ; "Comes from a later file") SYSOUTCURSOR) (T T)))) (RESETSAVE IDLE.PROFILE NIL) (* ; "Disable idler") (\COPYSYS1 STREAM LASTPAGE)))))) (* ;; "For cleanup, set \vmem.inhibit.write back to NIL.  This is done as its own cleanup so that impatiently aborting a sysout with repeated ^E will be less likely to miss this restoration.") (SETQ \VMEM.INHIBIT.WRITE NIL))))) (* ;; "First clause of OR is T when resuming this vmem;  second is starting the sysout.  Unless \COPYSYS1 itself does a \FLUSHVM, the second never returns T, yes?  NIL is normal return (continuing in same image), <fixp> is error return") (* ; "Continuing in the current image") (\DAYTIME0 \LASTUSERACTION) FULLNAME) ((AND (SMALLP VAL) (IGREATERP 0 VAL)) (* ; "Error occurred while making sysout.") (LISPERROR (IMINUS VAL) FULLNAME) (GO RETRY)) (T (* ; "Starting sysout") (\CLEARSYSBUF T) (* ; "Get rid of any spurious typeahead") (\RESETKEYBOARD) (* ; "Enable keyhandler") (LIST FULLNAME))))))
)

(\COPYSYS1
(LAMBDA (STREAM LASTPAGE) (* ; "Edited 21-Aug-88 13:54 by bvm") (COND ((AND (type? M44DEVICE (fetch DEVICE of STREAM)) (EQ (fetch DEVICENAME of (fetch DEVICE of STREAM)) (QUOTE DSK))) (ERROR "Sysout to Dorado login partition no longer supported."))) (PROG ((ACTONVMEMFN \VMEMACCESSFN) (PAGEMAPPED (fetch PAGEMAPPED of (fetch DEVICE of STREAM))) (NBUFS (SUB1 \#EMUBUFFERS)) (BUFBASE \EMUBUFFERS) (FIRSTPAGE 2) (CURSORBAR \EM.CURSORBITMAP) (CURSORMASK (LLSH 1 (SUB1 BITSPERWORD))) (DOMINOPAGE (fetch LastDominoFilePage of \InterfacePage)) (DAYBREAKP (EQ \MACHINETYPE \DAYBREAK)) CURSORINC CURSORNEXT NPAGES BUFFERS) (* ;; "Strategy is to copy from the vmem file to STREAM --- The vmem file is read with \ACTONVMEMFILE to finesse the differences among machines.  As buffers we use the set of pre-allocated swap buffers, reducing the number available for swapping to a bare minimum of one.  If STREAM is pagemapped, we take advantage of knowledge of pagemapped streams to write these buffers directly to the destination stream, which saves the copying that would occur if we just generically used \BOUTS for all streams.  In the case of Mod44 DSK, this also lets us use more buffers at a time, because DSK can write directly from the buffers we use for reading the vmem, rather than copying into its own buffers") (RESETSAVE \#SWAPBUFFERS 1) (* ; "Reduce us to one swap buffer, so we can use the rest for copying the vmem") (RESETSAVE \EMUSWAPBUFFERS (\ADDBASE BUFBASE (UNFOLD NBUFS WORDSPERPAGE))) (RESETSAVE \#DISKBUFFERS (COND ((type? M44DEVICE (fetch DEVICE of STREAM)) (* ; "DSK code needs 1 extra buffer beyond the ones we give to \WRITEPAGES") (SETQ NBUFS (SUB1 NBUFS)) (SETQ BUFBASE (\ADDBASE BUFBASE WORDSPERPAGE)) 1) (T 0))) (SETQ BUFFERS (to NBUFS as (BUF _ BUFBASE) by (\ADDBASE BUF WORDSPERPAGE) collect BUF)) (SETQ CURSORINC (SETQ CURSORNEXT (FOLDLO LASTPAGE (ITIMES 16 16)))) (* ; "How often to do something to the cursor") (COND ((EQ DOMINOPAGE 0) (* ; "First page to write is the ISF map page, which should be blank in a sysout") (\CLEARWORDS BUFBASE WORDSPERPAGE)) (T (CL:FUNCALL ACTONVMEMFN DOMINOPAGE BUFBASE 1))) (COND (PAGEMAPPED (replace EPAGE of STREAM with LASTPAGE) (* ; "Set up end of file correctly.  LASTPAGE is last alto page (full), which is last Lisp page plus 1") (replace EOFFSET of STREAM with 0) (\WRITEPAGES STREAM 0 (CAR BUFFERS))) (T (\BOUTS STREAM (CAR BUFFERS) 0 BYTESPERPAGE))) (while (<= FIRSTPAGE LASTPAGE) do (COND ((>= FIRSTPAGE CURSORNEXT) (* ; "Gradually complement the cursor") (\PUTBASE CURSORBAR 0 (LOGXOR (\GETBASE CURSORBAR 0) CURSORMASK)) (COND (DAYBREAKP (\DoveDisplay.SetCursorShape))) (add CURSORNEXT CURSORINC) (COND ((EQ (SETQ CURSORMASK (LRSH CURSORMASK 1)) 0) (SETQ CURSORBAR (\ADDBASE CURSORBAR 1)) (SETQ CURSORMASK (LLSH 1 (SUB1 BITSPERWORD))))))) (CL:FUNCALL ACTONVMEMFN FIRSTPAGE BUFBASE (SETQ NPAGES (IMIN NBUFS (ADD1 (- LASTPAGE FIRSTPAGE))))) (* ; "Read NBUFS pages from vmem, then write them to output") (COND ((NOT PAGEMAPPED) (* ; "Have to just ship the bits") (\BOUTS STREAM BUFBASE 0 (UNFOLD NPAGES BYTESPERPAGE))) (T (\WRITEPAGES STREAM (SUB1 FIRSTPAGE) (COND ((< NPAGES NBUFS) BUFFERS) (T (* ; "Don't write too many pages on the last pass if NPAGES is less than length of BUFFERS") (to NPAGES as BUF in BUFFERS collect BUF)))))) (add FIRSTPAGE NPAGES)) (RETURN NIL)))
)
)



(* ;; "For MAIKO. \COPYSYS use UNIX-PAGEPERBLOCK.")

(DEFINEQ

(\MAIKO.CHECKFREESPACE
(LAMBDA (FILENAME) (* ; "Edited  1-Apr-90 18:24 by nm") (DECLARE (GLOBALVARS \LDEDESTOVERWRITE \DSKdevice)) (LET ((LASTPAGE (fetch (IFPAGE NActivePages) of \InterfacePage)) (BUFFER (CREATECELL \FIXP)) FULLNAME FILESIZE FREEPAGES HOST) (* ;; "FULLNAME is  UNIX/DSK format pathname with UNIX/DSK. And type is string.") (SETQ FULLNAME (if (NULL FILENAME) then (SETQ HOST (QUOTE DSK)) (\UFS.RECOGNIZE.FILE (CONCAT "{" HOST "}" (OR (UNIX-GETENV "LDEDESTSYSOUT") "~/lisp.virtualmem")) (QUOTE NON) (\GETDEVICEFROMNAME HOST)) else (SETQ HOST (U-CASE (FILENAMEFIELD FILENAME (QUOTE HOST)))) (\UFS.RECOGNIZE.FILE FILENAME (QUOTE NON) (\GETDEVICEFROMNAME HOST)))) (SETQ FULLNAME (CONCAT "{" HOST "}" FULLNAME)) (* ;; "get current free space") (OR (\UFSGetFreeBlock-C FULLNAME BUFFER) (LISPERROR "FILE NOT FOUND" FULLNAME)) (if (IGREATERP LASTPAGE (SETQ FREEPAGES (ITIMES BUFFER LISPPAGE-PER-UNIXBLOCK))) then (* ;; "not enough free space ") (if \LDEDESTOVERWRITE then (* ;; "if possible, try to overwrite") (OR (INFILEP FULLNAME) (CL:ERROR (QUOTE XCL:FS-RESOURCES-EXCEEDED) :PATHNAME FULLNAME)) (* ;; "file exist, check file size") (SETQ FILESIZE (GETFILEINFO FULLNAME (QUOTE SIZE))) (if (IGREATERP LASTPAGE (IPLUS FILESIZE FREEPAGES)) then (* ;; "also, not ehough space") (CL:ERROR (QUOTE XCL:FS-RESOURCES-EXCEEDED) :PATHNAME FULLNAME) else (* ;; "Remove file, then get enoght space to save") (DELFILE FULLNAME)) else (CL:ERROR (QUOTE XCL:FS-RESOURCES-EXCEEDED) :PATHNAME FULLNAME)))))
)
)

(RPAQ? \LDEDESTOVERWRITE NIL)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(RPAQQ LISPPAGE-PER-UNIXBLOCK 2)


(CONSTANTS (LISPPAGE-PER-UNIXBLOCK 2))
)
)



(* ;; 
"Stats code.  On MOD44IO because it writes on the disk and uses records not exported from MOD44IO.  (For this and other reasons, GATHERSTATS only works on Dorados.)"
)

(DEFINEQ

(GATHERSTATS
  [LAMBDA (FILENAME)                                     (* ; "Edited 21-Jan-91 23:33 by jds")

    (* ;; "Enables and disables statistics gathering.  Uses low level file operations to avoid stats file being visible from Lisp b/c the file position is not updated as it is written")

    (DECLARE (GLOBALVARS \STATSON))
    (COND
       ((NEQ \MACHINETYPE \DORADO)
        (ERROR "Stats not implemented for this type of machine" FILENAME))
       [FILENAME (AND \STATSON (GATHERSTATS))
              (SELECTQ (FILENAMEFIELD FILENAME 'HOST)
                  (DSK)
                  (NIL (SETQ FILENAME (PACKFILENAME.STRING 'HOST 'DSK 'BODY FILENAME)))
                  (ERROR "Stats file must be on DSK" FILENAME))
              (SETQ \STATSON T)
              (\GATHERSTATS (PROG [(STREAM (\OPENFILE FILENAME 'OUTPUT 'NEW]
                                                             (* ; 
                "CLose before doing stats, cause file isn't really open from Lisp's point of view.")
                                  (RETURN (fetch (ARRAYP BASE)
                                             of (fetch (M44STREAM FID)
                                                       of (PROG1 STREAM
                                                                  (\CLOSEFILE STREAM)
                                                                  (\M44FLUSHDISKDESCRIPTOR
                                                                   (fetch DEVICE of STREAM))
                                                                  (replace (DSKOBJ DDVALID)
                                                                     of (fetch DEVICE
                                                                               of STREAM)
                                                                     with NIL))]
       (\STATSON (\GATHERSTATS)
              (SETQ \STATSON NIL])
)

(RPAQQ \STATSON NIL)
(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)


(FILESLOAD (LOADCOMP)
       LLBFS)
)
(PUTPROPS MOD44IO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989 
1990 1991))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (5090 66819 (\M44AddDiskPages 5100 . 6368) (\M44CloseFile 6370 . 6677) (\M44CompleteFH 
6679 . 11093) (\M44CREATEFILE 11095 . 17025) (\M44DeleteFile 17027 . 18116) (\M44EVENTFN 18118 . 22495
) (\M44ExtendFilePageMap 22497 . 24548) (\M44FillInMap 24550 . 26900) (\M44GetFileHandle 26902 . 29006
) (\M44GetFileInfo 29008 . 33191) (\M44GETDATEPROP 33193 . 33675) (\M44GetFileName 33677 . 34114) (
\M44GetPageLoc 34116 . 34917) (\M44KillFilePageMap 34919 . 35290) (\M44MAKEDIRENTRY 35292 . 37023) (
\M44OpenFile 37025 . 43158) (\M44OPENFILEFROMFP 43160 . 44188) (\M44ReadDiskPage 44190 . 46417) (
\M44ReadLeaderPage 46419 . 47871) (\M44ReadPages 47873 . 48090) (\M44SetAccessTimes 48092 . 49377) (
\M44SetEndOfFile 49379 . 50870) (\M44SetFileInfo 50872 . 52126) (\M44SETFILETYPE 52128 . 54741) (
\M44TruncateFile 54743 . 56196) (\M44WriteDiskPage 56198 . 60420) (\M44WriteLeaderPage 60422 . 61280) 
(\M44WritePages 61282 . 63666) (\M44WritePages1 63668 . 66817)) (66853 79777 (\ADDDISKPAGES 66863 . 
68676) (\M44DELETEPAGES 68678 . 72720) (\ASSIGNDISKPAGE 72722 . 75974) (\COUNTDISKFREEPAGES 75976 . 
76513) (\M44MARKPAGEFREE 76515 . 77215) (\M44FLUSHDISKDESCRIPTOR 77217 . 78159) (\MAKELEADERDAS 78161
 . 78872) (DISKFREEPAGES 78874 . 79220) (\M44FREEPAGECOUNT 79222 . 79670) (VMEMSIZE 79672 . 79775)) (
82930 97231 (\M44GENERATEFILES 82940 . 85860) (\M44SORTFILES 85862 . 86239) (\M44GENERATENEXT 86241 . 
91886) (\M44NEXTFILEFN 91888 . 93151) (\M44SORTEDNEXTFILEFN 93153 . 95276) (\M44FILEINFOFN 95278 . 
97229)) (97275 122542 (\M44PARSEFILENAME 97285 . 105317) (\FINDDIRHOLE 105319 . 107302) (
\M44PACKFILENAME 107304 . 107934) (\M44READVERSION 107936 . 108362) (\OPENDISKDESCRIPTOR 108364 . 
110471) (\M44READDIRFID 110473 . 110909) (\M44READDIRNAME 110911 . 111341) (\M44SEARCHDIR 111343 . 
114084) (\M44UNPACKFILENAME 114086 . 122540)) (123381 132404 (\CREATE.FID.FOR.DD 123391 . 123996) (
\OPENDISK 123998 . 125287) (\OPENDISKDEVICE 125289 . 129538) (\OPENDIR 129540 . 130716) (
\M44CHECKPASSWORD 130718 . 132047) (\M44HOSTNAMEP 132049 . 132402)) (132673 139416 (\COPYSYS 132683 . 
136057) (\COPYSYS1 136059 . 139414)) (139477 140993 (\MAIKO.CHECKFREESPACE 139487 . 140991)) (141341 
143329 (GATHERSTATS 141351 . 143327)))))
STOP
\ No newline at end of file
+(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "16-Mar-2021 19:55:51" {DSK}<home>larry>ilisp>medley>sources>MOD44IO.;3 139027 

      changes to%:  (VARS MOD44IOCOMS)

      previous date%: "16-Mar-2021 10:09:07" {DSK}<home>larry>ilisp>medley>sources>MOD44IO.;2)


(* ; "
Copyright (c) 1981-1991, 2021 by Venue & Xerox Corporation.
")

(PRETTYCOMPRINT MOD44IOCOMS)

(RPAQQ MOD44IOCOMS
       (

(* ;;; "Dorado disk driver")

        (COMS 
              (* ;; "Device dependent code for the Model44 disk")

              (FNS \M44AddDiskPages \M44CloseFile \M44CompleteFH \M44CREATEFILE \M44DeleteFile 
                   \M44EVENTFN \M44ExtendFilePageMap \M44FillInMap \M44GetFileHandle \M44GetFileInfo
                   \M44GETDATEPROP \M44GetFileName \M44GetPageLoc \M44KillFilePageMap 
                   \M44MAKEDIRENTRY \M44OpenFile \M44OPENFILEFROMFP \M44ReadDiskPage 
                   \M44ReadLeaderPage \M44ReadPages \M44SetAccessTimes \M44SetEndOfFile 
                   \M44SetFileInfo \M44SETFILETYPE \M44TruncateFile \M44WriteDiskPage 
                   \M44WriteLeaderPage \M44WritePages \M44WritePages1))
        (COMS 
              (* ;; "Disk allocation")

              (FNS \ADDDISKPAGES \M44DELETEPAGES \ASSIGNDISKPAGE \COUNTDISKFREEPAGES \M44MARKPAGEFREE
                   \M44FLUSHDISKDESCRIPTOR \MAKELEADERDAS DISKFREEPAGES \M44FREEPAGECOUNT))
        (COMS (INITVARS (\M44MULTFLG T))
              (DECLARE%: DONTCOPY (MACROS UCASECHAR UPDATEVALIDATION)
                     (RECORDS M44DEVICE)
                     (GLOBALVARS \OPENFILES \M44MULTFLG \DISKNAMECASEARRAY)
                     (MACROS .LISP.TO.BFS. .BFS.TO.LISP. .DISKCASEARRAY.)
                     (CONSTANTS (PageMapIncrement 64)
                            (\MAX.ALTO.NAME.LENGTH 39))
                     (COMS 
                           (* ;; "File properties")

                           (RECORDS M44FILEPROP)
                           (CONSTANTS * FPROPTYPES)
                           (CONSTANTS * FPTYPES))
                     (GLOBALRESOURCES \M44PAGEBUFFER))
              (INITRESOURCES \M44PAGEBUFFER))
        (COMS 
              (* ;; "Directory enumeration")

              (FNS \M44GENERATEFILES \M44SORTFILES \M44GENERATENEXT \M44NEXTFILEFN 
                   \M44SORTEDNEXTFILEFN \M44FILEINFOFN))
        (COMS 
              (* ;; "Directory lookup routines")

              (FNS \M44PARSEFILENAME \FINDDIRHOLE \M44PACKFILENAME \M44READVERSION 
                   \OPENDISKDESCRIPTOR \M44READDIRFID \M44READDIRNAME \M44SEARCHDIR 
                   \M44UNPACKFILENAME)
              (VARS \FILENAMECHARSLST)
              (GLOBALVARS \FILENAMECHARSLST)
              (DECLARE%: DONTCOPY (RECORDS UNAME FILESPEC M44GENFILESTATE M44DIRSEARCHSTATE)
                     (MACROS BETWEEN)))
        (COMS (FNS \CREATE.FID.FOR.DD \OPENDISK \OPENDISKDEVICE \OPENDIR \M44CHECKPASSWORD 
                   \M44HOSTNAMEP)
              (DECLARE%: DONTCOPY (CONSTANTS \OFFSET.BCPLUSERNAME \OFFSET.BCPLPASSWORD 
                                         \NWORDS.BCPLPASSWORD)))
        [COMS 
              (* ;; "SYSOUT etc.")

              (FNS \COPYSYS1)
              
              (* ;; "For MAIKO. \COPYSYS use UNIX-PAGEPERBLOCK.")

              (FNS \MAIKO.CHECKFREESPACE)
              (INITVARS (\LDEDESTOVERWRITE NIL))
              (DECLARE%: DONTCOPY (CONSTANTS (LISPPAGE-PER-UNIXBLOCK 2]
        (COMS 
              (* ;; "Stats code.  On MOD44IO because it writes on the disk and uses records not exported from MOD44IO.  (For this and other reasons, GATHERSTATS only works on Dorados.)")

              (FNS GATHERSTATS)
              (VARS (\STATSON NIL)))
        (DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
               (FILES (LOADCOMP)
                      LLBFS))))



(* ;;; "Dorado disk driver")




(* ;; "Device dependent code for the Model44 disk")

(DEFINEQ

(\M44AddDiskPages
  [LAMBDA (STREAM NEWLASTPAGE NEWLASTBYTE)               (* ; "Edited 21-Jan-91 23:35 by jds")

    (* ;; "Add pages to an existing Model44 file.  NEWLASTPAGE is the page number of the last page in the extended file.  Return the disk address of the new last page.")

    (\M44FillInMap STREAM (fetch (M44STREAM LastPage) of STREAM))
                                                             (* ; 
                     "Fill in map to end of file.  Code below assumes at least one valid map entry")
    (\ADDDISKPAGES STREAM (ADD1 (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM))
           (IDIFFERENCE NEWLASTPAGE (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM))
           (fetch (ARRAYP BASE) of (\M44ExtendFilePageMap STREAM NEWLASTPAGE))
           NEWLASTBYTE)
    (replace (M44STREAM LASTMAPPEDPAGE) of STREAM with NEWLASTPAGE)
    (replace (M44STREAM LastPage) of STREAM with NEWLASTPAGE)
    (replace (M44STREAM LastOffset) of STREAM with NEWLASTBYTE)
                                                             (* ; 
                                                           "record new eof in filehandle only")
    NEWLASTPAGE])

(\M44CloseFile
(LAMBDA (STREAM) (* hdj "25-Sep-86 11:03") (\CLEARMAP STREAM) (COND ((NEQ (fetch ACCESS of STREAM) (QUOTE INPUT)) (* ; "Update EOF in leader page") (\M44TruncateFile STREAM (fetch EPAGE of STREAM) (fetch EOFFSET of STREAM) T) (\M44FLUSHDISKDESCRIPTOR (fetch DEVICE of STREAM)))) STREAM)
)

(\M44CompleteFH
  [LAMBDA (STREAM)                                       (* ; "Edited 21-Jan-91 23:41 by jds")

    (* ;; "Completes the fields of a file handle that describes an existing file by reading in its leader page which it leaves for its caller")

    (PROG ((NUMCHARS (CONS))
           (LEADERPAGE (\M44ReadLeaderPage STREAM))
           (DSK (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE of STREAM)))
           LASTPAGE# NBYTES)

     (* ;; "Get the page number and the number of bytes on the last page of the file specified by fHandle.  If the last page number hint is wrong in the leader page, then find the real last page and change the hint.")

          (COND
             ((AND (NEQ (SETQ LASTPAGE# (.BFS.TO.LISP. (fetch (\M44LeaderPage LastPageNumber)
                                                          of LEADERPAGE)))
                        -1)
                   (EQ [PROG ((DAs (ARRAY 3 'WORD \FILLINDA 0))
                              (BFSPG# (.LISP.TO.BFS. LASTPAGE#)))
                             (SETA DAs 1 (fetch (\M44LeaderPage LastPageAddress) of 
                                                                                           LEADERPAGE
                                                ))
                             (SETA DAs 2 \EOFDA)
                             (RETURN (AND (EQ (\ACTONDISKPAGES DSK NIL (fetch (ARRAYP BASE)
                                                                          of DAs)
                                                     LASTPAGE# STREAM BFSPG# BFSPG# \DC.READD 
                                                     NUMCHARS NIL T)
                                              BFSPG#)
                                          (SETQ NBYTES (CAR NUMCHARS]
                       (fetch (\M44LeaderPage LastPageByteCount) of LEADERPAGE)))
              (replace (M44STREAM LastPage) of STREAM with LASTPAGE#)
                                                             (* ; "Update STREAM eof")
              (replace (M44STREAM LastOffset) of STREAM with NBYTES))
             (T                                              (* ; 
                                                    "Hint was wrong so scan the file for last page")
                (for PN from PageMapIncrement by PageMapIncrement
                   do (SETQ LASTPAGE# (\M44FillInMap STREAM PN)) 
                                                             (* ; 
                                                           "Wait until attempt to find page fails")
                   repeatwhile (EQ PN LASTPAGE#))
                (SETQ NBYTES (\ACTONDISKPAGES DSK NIL (fetch (ARRAYP BASE)
                                                         of (fetch (M44STREAM FILEPAGEMAP)
                                                                   of STREAM))
                                    -1 STREAM (.LISP.TO.BFS. LASTPAGE#)
                                    (.LISP.TO.BFS. LASTPAGE#)
                                    \DC.READD NUMCHARS))     (* ; 
                                              "Read last page to find out how many bytes are on it")
                (\M44SetEndOfFile STREAM LASTPAGE# (CAR NUMCHARS)
                       T)))
          (UPDATEVALIDATION STREAM LEADERPAGE)               (* ; 
                                         "Validation is low order bits of creation and write dates")
          [COND
             ((EQ (fetch (M44STREAM LastOffset) of STREAM)
                  BYTESPERPAGE)

              (* ;; "Shouldn't happen, because alto files should never have a full last page.  However, cope if it happens...")

              (replace EPAGE of STREAM with (ADD1 (fetch (M44STREAM LastPage)
                                                                 of STREAM)))
              (replace EOFFSET of STREAM with 0))
             (T (replace EPAGE of STREAM with (fetch (M44STREAM LastPage)
                                                             of STREAM))
                (replace EOFFSET of STREAM with (fetch (M44STREAM LastOffset)
                                                               of STREAM]
          (RETURN STREAM])

(\M44CREATEFILE
  [LAMBDA (FDEV UNAME LENGTH CRDATE TYPE DIRECTORYP)     (* ; "Edited 21-Jan-91 23:41 by jds")

    (* ;; "Create a file on the Model44 disk.")

    (PROG ((DSK (fetch (M44DEVICE DSKOBJ) of FDEV))
           (PNAME (\M44PACKFILENAME UNAME))
           (LEADERPAGE (create \M44LeaderPage))
           (NC 0)
           STREAM FP MAP FPBASE DAT PSTART)
          (OR PNAME (RETURN))                                (* ; 
                                                           "Cant create as name wasnt complete")
          (SETQ STREAM (create M44STREAM))
          (replace FULLFILENAME of STREAM with PNAME)
          (replace DEVICE of STREAM with FDEV)
          (replace (M44STREAM FID) of STREAM with (SETQ FP (create FID)))
          (replace (M44STREAM FILEPAGEMAP) of STREAM
             with (SETQ MAP (ARRAY (COND
                                          ((FIXP LENGTH)
                                           (IPLUS 4 (FOLDHI LENGTH BYTESPERPAGE)))
                                          (T PageMapIncrement))
                                       'WORD \FILLINDA 0)))
          (replace (M44STREAM LASTMAPPEDPAGE) of STREAM with 0)
          (replace MULTIBUFFERHINT of STREAM with \M44MULTFLG)
          (replace (M44STREAM LEADERPAGE) of STREAM with LEADERPAGE)
          (SETQ FPBASE (fetch (ARRAYP BASE) of FP))
          (replace (FP FPSERIAL#) of FPBASE with (add (fetch (DSKOBJ 
                                                                                      DISKLASTSERIAL#
                                                                                        )
                                                                         of DSK)
                                                                    1))
          (COND
             (DIRECTORYP (add (fetch (FP FPSERIALHI) of FPBASE)
                                \FP.DIRECTORYP)))
          (replace (FP FPVERSION) of FPBASE with 1)
          (SETA MAP 0 \EOFDA)
          (SETA MAP 3 \EOFDA)                                (* ; 
                             "We are about to create pages 0 and 1, everything else is nonexistent")
                                                             (* ; 
                         "Done by the NCREATE -- (\ZEROPAGE (fetch (POINTER PAGE#) of LEADERPAGE))")
          (\BLT (LOCF (fetch (\M44LeaderPage TimeWrite) of LEADERPAGE))
                (SETQ DAT (\DAYTIME0 (create FIXP)))
                WORDSPERCELL)                                (* ; "Set creation and write dates")
          (\BLT (LOCF (fetch (\M44LeaderPage TimeCreate) of LEADERPAGE))
                (OR CRDATE DAT)
                WORDSPERCELL)                                (* ; 
                                                         "See \M44MAKEDIRENTRY for the name logic.")
          (for C in (fetch (UNAME ORIGCHARS) of UNAME)
             bind (NAMEBASE _ (LOCF (fetch (\M44LeaderPage NameCharCount) of LEADERPAGE))
                             )
                   (V _ (fetch (UNAME VERSION) of UNAME))
             do (\PUTBASEBYTE NAMEBASE (add NC 1)
                           C) finally [COND
                                             ((NEQ V 1)
                                              (\PUTBASEBYTE NAMEBASE (add NC 1)
                                                     (CHARCODE !))
                                              (for C in (CHCON V)
                                                 do (\PUTBASEBYTE NAMEBASE (add NC 1)
                                                               C]
                                    (\PUTBASEBYTE NAMEBASE (add NC 1)
                                           (CHARCODE %.))    (* ; 
                                                          "Last character of all alto names is dot")
                                    (replace (\M44LeaderPage NameCharCount) of LEADERPAGE
                                       with NC))
          (replace (\M44LeaderPage PropertyBegin) of LEADERPAGE
             with (INDEXF (FETCH (\M44LeaderPage LeaderProps) of LEADERPAGE)))
          [replace (\M44LeaderPage PropertyLength) of LEADERPAGE
             with (CONSTANT (- (INDEXF (FETCH (\M44LeaderPage Spares) of LEADERPAGE))
                                   (INDEXF (FETCH (\M44LeaderPage LeaderProps) of LEADERPAGE]
                                                             (* ; "The start and length of the property section are theoretically variable, but at least some %"official%" Alto software, such as Scavenge, believes that file names must be no more than 39 chars.")
          (\M44SETFILETYPE STREAM TYPE)
          (\WRITEDISKPAGES DSK (LIST LEADERPAGE NIL)
                 (fetch (ARRAYP BASE) of MAP)
                 -1 STREAM 0 1 NIL NIL 0 0)                  (* ; 
                    "The end of file will be zero and the validation not set as befits a new file.")
          (replace (FP FPLEADERVDA) of FPBASE with (\WORDELT MAP 1))
                                                             (* ; 
                                     "Now that the file is safely created, make entry in directory")
          (replace (M44STREAM DIRINFO) of STREAM with (\M44MAKEDIRENTRY
                                                                   (fetch (M44STREAM FID)
                                                                      of STREAM)
                                                                   UNAME NC FDEV))
          (RETURN STREAM])

(\M44DeleteFile
  [LAMBDA (FILENAME DEV)                                 (* ; "Edited 21-Jan-91 23:35 by jds")
                                                             (* ; "Delete a Model44 file.")
    (PROG ((STREAM (\M44GetFileHandle FILENAME 'OLDEST DEV T)))
          (COND
             ((OR (NOT STREAM)
                  (FDEVOP 'OPENP DEV (fetch FULLFILENAME of STREAM)
                         NIL DEV))                           (* ; "Can't delete an open file")
              (RETURN)))
          (\M44DELETEPAGES STREAM -1)
          (PROG ((DIROFD (fetch (M44DEVICE SYSDIROFD) of DEV)))
                                                             (* ; "Delete directory entry")
                (\SETFILEPTR DIROFD (fetch (M44STREAM DIRINFO) of STREAM))
                (\BOUT DIROFD (LOGAND 3 (\PEEKBIN DIROFD)))
                (FLUSHMAP DIROFD))
          (\M44KillFilePageMap STREAM)
          (replace (M44STREAM FID) of STREAM with NIL)
          (RETURN (fetch FULLFILENAME of STREAM])

(\M44EVENTFN
  [LAMBDA (FDEV EVENT)                                   (* ; "Edited 21-Jan-91 23:31 by jds")
    (DECLARE (GLOBALVARS \DEVICENAMETODEVICE \MACHINETYPE))
    (SELECTQ EVENT
        ((AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM) 
                                                            (* ;; 
                                          "reinitialize DSK device and revalidate its open streams")

             [PROG ((DSKOBJ (fetch (M44DEVICE DSKOBJ) of FDEV))
                    DD)
                   (COND
                      ((SETQ DD (fetch (DSKOBJ DISKDESCRIPTOROFD) of DSKOBJ))
                                                             (* ; 
                                                           "Flush out of date disk descriptor")
                       (FORGETPAGES DD)
                       (FDEVOP 'UNREGISTERFILE FDEV FDEV DD) (* ; 
      "Stream no longer in use.  Don't go thru \M44CloseFile because it will try to Truncate, etc.")
                       (replace (DSKOBJ DDVALID) of DSKOBJ with NIL)
                       (replace (DSKOBJ DISKDESCRIPTOROFD) of DSKOBJ with NIL)))
                   (FORGETPAGES (fetch (DSKOBJ SYSDIROFD) of DSKOBJ))
                   (FDEVOP 'UNREGISTERFILE FDEV FDEV (fetch (DSKOBJ SYSDIROFD) of DSKOBJ))
                   (COND
                      [(AND (EQ \MACHINETYPE \DORADO)
                            (LET [(PARTZEROP (EQ (fetch (M44DEVICE DSKPARTITION) of FDEV)
                                                 0))
                                  (CURPARTP (EQ (fetch (FDEV DEVICENAME) of FDEV)
                                                (PACK* 'DSK (DISKPARTITION]
                                 (COND
                                    (PARTZEROP               (* ; 
       "This is interlock with \M44EXTENDVMEMFILE which doesn't want to mess up the DiskDescriptor")
                                           (SETQ \M44.READY T)))
                                 (COND
                                    ((OR (AND PARTZEROP CURPARTP)
                                         (\DEVICE-OPEN-STREAMS FDEV))
                                     (COND
                                        ((EQ PARTZEROP CURPARTP)
                                                             (* ; 
                                              "No partition change to worry about, just reopen dir")
                                         (\OPENDIR FDEV))
                                        (PARTZEROP 

                                   (* ;; "This was the default partition, no longer is, so reopen it as if from scratch.  Also, remove the mapping of DSK to this device")

                                               (\REMOVEDEVICE.NAMES FDEV 'DSK)
                                               (\OPENDISK (SUBATOM (fetch (FDEV DEVICENAME)
                                                                          of FDEV)
                                                                     4)
                                                      FDEV))
                                        (T                   (* ; 
       "This was a non-default partition, now the default.  Reopen it with \MAINDISK as its DSKOBJ")
                                           (\OPENDISKDEVICE NIL NIL FDEV]
                      (T 
                         (* ;; "Device no longer exists if machine is now Dandelion;  and if there were no open files, no need to try reopening the dir")

                         (replace (DSKOBJ SYSDIROFD) of DSKOBJ with NIL)

                         (* ;; "Have to explicitly clear these fields, because when we drop the DSKOBJ on the floor, GC does not know about its POINTER fields")

                         (replace REOPENFILE of FDEV with (FUNCTION NILL))
                                                             (* ; 
                            "In case there are files open over sysout as we come back on Dandelion")
                         (\REMOVEDEVICE FDEV]
             (\PAGED.REVALIDATEFILELST FDEV))
        (BEFORELOGOUT (\FLUSH.OPEN.STREAMS FDEV)
                      (\M44FLUSHDISKDESCRIPTOR FDEV))
        NIL])

(\M44ExtendFilePageMap
  [LAMBDA (STREAM TOPAGE#)                               (* ; "Edited 21-Jan-91 23:35 by jds")

    (* ;; "If the file's page map is not big enough to map the given page, then create a new one that is big enough and copy the old OLDMAP information into the new map.  If the file has no map, then create one big enough to map the given page.  Return the new map.  --- Map entry 0 corresponds to bfs page -1, entry 1 corresponds to the leader page, and entry 2 corresponds to Lisp page 0")

    (PROG ((OLDMAP (fetch (M44STREAM FILEPAGEMAP) of STREAM))
           OLDSIZE NEWMAP)
          (RETURN (COND
                     ([AND OLDMAP (ILESSP (IPLUS TOPAGE# 3)
                                         (SETQ OLDSIZE (fetch (ARRAYP LENGTH) of OLDMAP]
                      OLDMAP)
                     (T (SETQ NEWMAP (ARRAY (CEIL (IPLUS TOPAGE# 4)
                                                  PageMapIncrement)
                                            'SMALLPOSP \FILLINDA 0))
                        [COND
                           (OLDMAP                           (* ; "Copy old map into new")
                                  (\BLT (fetch (ARRAYP BASE) of NEWMAP)
                                        (fetch (ARRAYP BASE) of OLDMAP)
                                        OLDSIZE))
                           (T                                (* ; 
                                                           "Initialize with leader page hint")
                              (SETA NEWMAP 0 \EOFDA)
                              (SETA NEWMAP 1 (fetch (FP FPLEADERVDA)
                                                of (fetch (ARRAYP BASE)
                                                          of (fetch (M44STREAM FID)
                                                                    of STREAM]
                        (replace (M44STREAM FILEPAGEMAP) of STREAM with NEWMAP)
                        NEWMAP])

(\M44FillInMap
  [LAMBDA (STREAM UPTOPAGE)                              (* ; "Edited 21-Jan-91 23:42 by jds")

(* ;;; "Assures that the disk address map for STREAM is filled in up thru page# UPTOPAGE.  Reads file as needed")

    (PROG ((MAP (\M44ExtendFilePageMap STREAM UPTOPAGE))
           (DSK (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE of STREAM)))
           (LASTKNOWNPAGE (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM))
           NPAGES LASTPAGEREAD LASTATTEMPTED DAs DA)         (* ; "Extend MAP")
          (SETQ DAs (fetch (ARRAYP BASE) of MAP))
          [while (ILESSP LASTKNOWNPAGE UPTOPAGE)
             do (COND
                       [(NEQ (SETQ DA (\GETBASE DAs (IPLUS LASTKNOWNPAGE 1 2)))
                             \FILLINDA)                      (* ; 
                               "There already is an entry for the next page, so no need to read it")
                        (COND
                           ((EQ DA \EOFDA)
                            (RETURN))
                           (T (add LASTKNOWNPAGE 1]
                       (T [SETQ NPAGES (IMIN \MAXDISKDAs (ADD1 (IDIFFERENCE UPTOPAGE LASTKNOWNPAGE]

                          (* ;; "We know where LASTKNOWNPAGE lives, so read it to find out where the next page after that is.  Can do this for many pages at once to make it reasonable")

                          (SETQ LASTPAGEREAD (\ACTONDISKPAGES DSK NIL DAs -1 STREAM (.LISP.TO.BFS.
                                                                                     LASTKNOWNPAGE)
                                                    [SETQ LASTATTEMPTED
                                                     (.LISP.TO.BFS. (SUB1 (IPLUS LASTKNOWNPAGE NPAGES
                                                                                 ]
                                                    \DC.READD))
                          (SETQ LASTKNOWNPAGE (.BFS.TO.LISP. LASTPAGEREAD))
                          (COND
                             ((ILESSP LASTPAGEREAD LASTATTEMPTED)
                                                             (* ; "Hit end of file")
                              (RETURN]
          (replace (M44STREAM LASTMAPPEDPAGE) of STREAM with LASTKNOWNPAGE)
          (RETURN LASTKNOWNPAGE])

(\M44GetFileHandle
  [LAMBDA (NAME RECOG FDEV FAST CREATEFLG)               (* ; "Edited 21-Jan-91 23:48 by jds")

    (* ;; "Creates a STREAM for dsk file NAME.  If file does not exist, but CREATEFLG is true, returns the UNAME of the file so that it may be created.  If FAST is true, does not fill in any fields of STREAM that would require reading the file, e.g., the length and full map")

    (LET ((DIRSTREAM (fetch (M44DEVICE SYSDIROFD) of FDEV))
          FS DP STREAM)
         (COND
            ((NULL DIRSTREAM)                                (* ; "Non-existent device")
             NIL)
            ((NULL (SETQ FS (\M44PARSEFILENAME NAME RECOG FDEV CREATEFLG)))
                                                             (* ; "File not found")
             NIL)
            ((SETQ DP (fetch (FILESPEC FSDIRPTR) of FS))
                                                             (* ; 
                                                     "File was found--here's the directory pointer")
             (SETQ STREAM (create M44STREAM))
             (replace DEVICE of STREAM with FDEV)
             (replace (M44STREAM FID) of STREAM with (\M44READDIRFID DIRSTREAM DP))
             (replace (M44STREAM DIRINFO) of STREAM with DP)
             (replace FULLFILENAME of STREAM with (\M44PACKFILENAME
                                                               (fetch (FILESPEC UNAME)
                                                                  of FS)
                                                               DP DIRSTREAM))
             (replace MULTIBUFFERHINT of STREAM with \M44MULTFLG)
             (OR FAST (\M44CompleteFH STREAM))
             STREAM)
            ((NULL (fetch (FILESPEC UNAME) of FS))   (* ; 
                                           "Name was malformed--can't create it even if we want to")
             (LISPERROR "BAD FILE NAME" NAME))
            (CREATEFLG (fetch (FILESPEC UNAME) of FS])

(\M44GetFileInfo
  [LAMBDA (STREAM ATTRIBUTE DEV)                         (* ; "Edited 21-Jan-91 23:44 by jds")

    (* ;; "Get the value of the ATTRIBUTE for a model44 file.  If STREAM is a filename, then the file is not open.")

    (COND
       ((OR (type? STREAM STREAM)
            (SETQ STREAM (\M44GetFileHandle STREAM 'OLD DEV T)))
        (SELECTQ ATTRIBUTE
            ((LENGTH SIZE) 
                 (COND
                    ((NULL (fetch VALIDATION of STREAM))
                                                             (* ; 
                                                       "Need to read leader page etc to get length")
                     (\M44CompleteFH STREAM)))
                 (SELECTQ ATTRIBUTE
                     (LENGTH (create BYTEPTR
                                    PAGE _ (fetch EPAGE of STREAM)
                                    OFFSET _ (fetch EOFFSET of STREAM)))
                     (IPLUS (fetch EPAGE of STREAM)
                            (FOLDHI (fetch EOFFSET of STREAM)
                                   BYTESPERPAGE))))
            (TYPE [PROG ((BUF (\M44ReadLeaderPage STREAM)))
                        (RETURN
                         (COND
                            ((IGREATERP (fetch (\M44LeaderPage PropertyLength) of BUF)
                                    0)
                             (SETQ BUF (\ADDBASE BUF (fetch (\M44LeaderPage PropertyBegin)
                                                        of BUF)))
                             (do (SELECTC (fetch (M44FILEPROP FPROPTYPE) of BUF)
                                         (0                  (* ; "End of properties")
                                            (RETURN))
                                         (\FPROP.TYPE [RETURN (SELECTC (fetch (M44FILEPROP 
                                                                                         FPROPWORD0)
                                                                          of BUF)
                                                                  (\FPTYPE.TEXT 'TEXT)
                                                                  (\FPTYPE.BINARY 
                                                                       'BINARY)
                                                                  (\FPTYPE.UNKNOWN 
                                                                       NIL)
                                                                  (\TYPE.FROM.FILETYPE
                                                                   (fetch (M44FILEPROP FPROPWORD0
                                                                                     ) of BUF])
                                         NIL)
                                    (SETQ BUF (\ADDBASE BUF (fetch (M44FILEPROP FPROPLENGTH)
                                                               of BUF])
            (CREATIONDATE (\M44GETDATEPROP STREAM (INDEXF (fetch (\M44LeaderPage TimeCreate)
                                                                 of T))
                                 T))
            (WRITEDATE (\M44GETDATEPROP STREAM (INDEXF (fetch (\M44LeaderPage TimeWrite)
                                                              of T))
                              T))
            (READDATE (\M44GETDATEPROP STREAM (INDEXF (fetch (\M44LeaderPage TimeRead)
                                                             of T))
                             T))
            (ICREATIONDATE (\M44GETDATEPROP STREAM (INDEXF (fetch (\M44LeaderPage TimeCreate)
                                                                  of T))))
            (IWRITEDATE (\M44GETDATEPROP STREAM (INDEXF (fetch (\M44LeaderPage TimeWrite)
                                                               of T))))
            (IREADDATE (\M44GETDATEPROP STREAM (INDEXF (fetch (\M44LeaderPage TimeRead)
                                                              of T))))
            NIL])

(\M44GETDATEPROP
(LAMBDA (STREAM OFFSET STRINGIFY) (* bvm%: "27-May-84 22:57") (* ;; "Returns the create/write/read date of STREAM that lives at OFFSET in its leader page, as a string if STRINGIFY is true, else as a Lisp date fixp") (PROG ((DATEBASE (\ADDBASE (\M44ReadLeaderPage STREAM) OFFSET)) DAT) (SETQ DAT (\MAKENUMBER (\GETBASE DATEBASE 0) (\GETBASE DATEBASE 1))) (RETURN (COND ((NEQ DAT 0) (SETQ DAT (ALTO.TO.LISP.DATE DAT)) (COND (STRINGIFY (GDATE DAT)) (T DAT)))))))
)

(\M44GetFileName
  [LAMBDA (NAME RECOG FDEV)                              (* ; "Edited 21-Jan-91 23:48 by jds")
    (LET ((FS (\M44PARSEFILENAME NAME RECOG FDEV))
          DP UNAME)
         (AND FS (SETQ UNAME (fetch (FILESPEC UNAME) of FS))
              (\M44PACKFILENAME UNAME (SETQ DP (fetch (FILESPEC FSDIRPTR) of FS))
                     (AND DP (fetch (M44DEVICE SYSDIROFD) of FDEV])

(\M44GetPageLoc
  [LAMBDA (STREAM PAGENO CREATE?)                        (* ; "Edited 21-Jan-91 23:35 by jds")

    (* ;; "Look in the file's page map to find the disk address of the page.  If the map does not include the page, then extend it appropriately.  If page does not exit, create it if CREATE?  is true, else return \EOFDA")

    (COND
       ((ILEQ PAGENO (fetch (M44STREAM LastPage) of STREAM))
        (COND
           ((IGREATERP PAGENO (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM))
            (\M44FillInMap STREAM PAGENO)))
        (\WORDELT (fetch (M44STREAM FILEPAGEMAP) of STREAM)
               (IPLUS PAGENO 2)))
       (CREATE? (\M44AddDiskPages STREAM PAGENO 0)
              (\M44GetPageLoc STREAM PAGENO))
       (T \EOFDA])

(\M44KillFilePageMap
  [LAMBDA (fHandle)                                      (* ; "Edited 21-Jan-91 23:35 by jds")
                                                             (* ; "Remove the file's page map.")
    (replace (M44STREAM FILEPAGEMAP) of fHandle with NIL)
    (replace (M44STREAM LASTMAPPEDPAGE) of fHandle with -1])

(\M44MAKEDIRENTRY
  [LAMBDA (FID UNAME NC FDEV)                            (* ; "Edited 21-Jan-91 23:38 by jds")

    (* ;; "Makes a directory entry for a new file.  FID is file's ID, NC the number of characters in the full Alto name.")

    (PROG ((DIRSTREAM (fetch (M44DEVICE SYSDIROFD) of FDEV))
           (VERSION (fetch (UNAME VERSION) of UNAME))
           POS)
          (SETQ POS (\FINDDIRHOLE (LRSH (IPLUS NC 14)
                                            1)
                           DIRSTREAM))
          (\BOUTS DIRSTREAM (fetch (FID FIDBLOCK) of FID)
                 0
                 (UNFOLD 5 BYTESPERWORD))
          (\BOUT DIRSTREAM NC)

     (* ;; "Now write out the alto-style name 'name[.ext]!ver.' with ver omitted if 1;  This is basically the same logic as is used to write the name in the leader page in \M44CREATEFILE.  We can't share cause here we do bouts, cause we might run over a page;  there we must do PUTBASEBYTE's cause we can't set the fileptr to the leader page.")

          (for C in (fetch (UNAME ORIGCHARS) of UNAME) do (\BOUT DIRSTREAM C))
          [COND
             ((NEQ VERSION 1)
              (\BOUT DIRSTREAM (CHARCODE !))
              (LET ((*PRINT-BASE* 10))
                   (PRIN3 VERSION DIRSTREAM]
          (\BOUT DIRSTREAM (CHARCODE %.))
          (COND
             ((EVENP NC BYTESPERWORD)
              (\BOUT DIRSTREAM 0)))
          (\SETFILEPTR DIRSTREAM POS)
          (\BOUT DIRSTREAM (LOGOR 4 (\PEEKBIN DIRSTREAM)))   (* ; 
                             "When everything is ready, finally change the type from hole to file.")
          (FORCEOUTPUT DIRSTREAM)
          (RETURN POS])

(\M44OpenFile
  [LAMBDA (NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM)  (* ; "Edited 21-Jan-91 23:38 by jds")

    (* ;; "Open a Model44 file.  Gets the physical end of file and sets up ofd")

    (PROG (PAGESTIMATE STREAM CRDATE TYPE DON'T.CHANGE.DATE X)
                                                             (* ; 
                                                       "if file is open in a conflicting way, barf")
          [COND
             ((NEQ ACCESS 'INPUT)                            (* ; 
                                                      "Interesting parameters when creating a file")
              (for X in PARAMETERS do (SELECTQ (CAR (LISTP X))
                                                      (LENGTH (SETQ PAGESTIMATE
                                                               (IPLUS 2 (FOLDHI (CADR X)
                                                                               BYTESPERPAGE))))
                                                      (CREATIONDATE (SETQ CRDATE (IDATE (CADR X))))
                                                      (ICREATIONDATE (SETQ CRDATE (CADR X)))
                                                      (TYPE (SETQ TYPE (CADR X)))
                                                      (DON'T.CHANGE.DATE 
                                                           (SETQ DON'T.CHANGE.DATE T))
                                                      NIL]
          (COND
             [(type? STREAM NAME)
              (COND
                 ((OR (fetch (M44DEVICE DSKPASSWORDOK) of (fetch DEVICE of NAME))
                      (EQ (fetch (FID W0) of (fetch (M44STREAM FID) of NAME))
                          32768))                            (* ; 
                            "Make sure password is ok if trying to reopen anything but a directory")
                  (\M44CompleteFH (SETQ STREAM NAME)))
                 (T (RETURN]
             ([NULL (SETQ STREAM (\M44GetFileHandle NAME RECOG FDEV NIL (NEQ ACCESS 'INPUT]
                                                             (* ; 
                  "File not found.  Return NIL to let generic open generate a FILE NOT FOUND error")
              (RETURN NIL)))
          (if OLDSTREAM
              then                                       (* ; "REOPENFILE--nothing more to do")
                    (RETURN STREAM))
          [COND
             ([AND PAGESTIMATE (IGREATERP PAGESTIMATE (IPLUS (fetch (M44DEVICE DISKFREEPAGES)
                                                                of FDEV)
                                                             (COND
                                                                ((type? STREAM STREAM)
                                                                 (fetch (M44STREAM LastPage)
                                                                    of STREAM))
                                                                (T 
                                                             (* ; "New file")
                                                                   0]
              (RETURN (LISPERROR "FILE SYSTEM RESOURCES EXCEEDED" (COND
                                                                     ((type? STREAM STREAM)
                                                                      (fetch FULLFILENAME
                                                                         of STREAM))
                                                                     (T NAME]
          [COND
             (CRDATE                                         (* ; "Convert to alto format")
                    (COND
                       ([NOT (type? FIXP (SETQ CRDATE (LISP.TO.ALTO.DATE CRDATE]
                                                             (* ; "sigh, wanted a number box")
                        (\PUTBASEFIXP (SETQ X (create FIXP))
                               0 CRDATE)
                        (SETQ CRDATE X]
          [COND
             ((NOT (type? STREAM STREAM))                (* ; "New file")
              (SETQ STREAM (\M44CREATEFILE FDEV STREAM PAGESTIMATE CRDATE TYPE)))
             (T                                              (* ; "Old file")
                [LET ((MYNAME (fetch FULLFILENAME of STREAM)))
                     (COND
                        ([for OTHER in (fetch (FDEV OPENFILELST) of FDEV)
                            when (STRING-EQUAL (fetch FULLFILENAME of OTHER)
                                            MYNAME)
                            do (RETURN (OR (NEQ ACCESS 'INPUT)
                                               (NEQ (fetch ACCESS of OTHER)
                                                    'INPUT]  (* ; 
                                                          "Access conflict with existing open file")
                         (RETURN (LISPERROR "FILE WON'T OPEN" MYNAME]
                [COND
                   ((EQ ACCESS 'OUTPUT)                      (* ; "File is EMPTY even if it is old")
                    (replace EPAGE of STREAM with (replace EOFFSET of STREAM
                                                                 with 0]
                                                             (* ; 
                                              "Leader page is read in during STREAM initialization")
                (COND
                   ((NOT DON'T.CHANGE.DATE)
                    (\M44SetAccessTimes STREAM ACCESS CRDATE)
                                                             (* ; "Resets validation")
                    (\M44WriteLeaderPage STREAM)         (* ; 
                                                  "We write out accumulated changes to leader page")
                    ]
          (COND
             (CRDATE (replace NONDEFAULTDATEFLG of STREAM with T)))
          (RETURN STREAM])

(\M44OPENFILEFROMFP
  [LAMBDA (DEV NAME ACCESS FID DIRINFO)                  (* ; "Edited 21-Jan-91 23:36 by jds")
                                                             (* ; "Opens a disk file given its FP")
    (LET ((STREAM (create M44STREAM)))
         (replace FULLFILENAME of STREAM with (SETQ NAME (PACK* '{ (fetch
                                                                                (FDEV DEVICENAME)
                                                                                  of DEV)
                                                                            '} NAME)))
         (replace DEVICE of STREAM with DEV)
         (replace (M44STREAM FID) of STREAM with FID)
         (replace (M44STREAM DIRINFO) of STREAM with DIRINFO)
         (replace MULTIBUFFERHINT of STREAM with \M44MULTFLG)
         (\OPENFILE STREAM ACCESS)
         (replace USERVISIBLE of STREAM with NIL)
         STREAM])

(\M44ReadDiskPage
  [LAMBDA (STREAM PAGENO BUF)                            (* ; "Edited 21-Jan-91 23:42 by jds")

    (* ;; "The functions for reading a disk page called by \M44ReadPages.  Returns the number of bytes read.  If PAGEADDR is 0, then assume 0 bytes read.  Fill the BUF with zeros beyond the last byte read.")

    (COND
       ((AND (IGEQ PAGENO (fetch EPAGE of STREAM))
             (OR (NOT (IEQP PAGENO (fetch EPAGE of STREAM)))
                 (EQ (fetch EOFFSET of STREAM)
                     0)))                                    (* ; 
                        "Asking for page after eof.  PMAP system really ought to catch this itself")
        (\CLEARWORDS BUF WORDSPERPAGE)
        0)
       (T (PROG ((PAGEADDR (\M44GetPageLoc STREAM PAGENO))
                 (BFSPG# (ADD1 PAGENO)))
                (RETURN (COND
                           ((EQ PAGEADDR \EOFDA)             (* ; 
                                                           "no bytes read, fill with zeroes.")
                            (\CLEARWORDS BUF WORDSPERPAGE)
                            0)
                           ((EQ PAGEADDR \FILLINDA)
                            (SHOULDNT))
                           ((EQ (\ACTONDISKPAGES (fetch (M44DEVICE DSKOBJ)
                                                    of (fetch DEVICE of STREAM))
                                       BUF
                                       (fetch (ARRAYP BASE) of (fetch (M44STREAM 
                                                                                         FILEPAGEMAP)
                                                                          of STREAM))
                                       -1 STREAM BFSPG# BFSPG# \DC.READD)
                                BFSPG#)
                            BYTESPERPAGE)
                           (T 
                              (* ;; "if READDISKPAGE returns NIL, presumably there is an error of some kind, hope it was with the file map and try again.")

                              (\M44KillFilePageMap STREAM)
                              (\M44ReadDiskPage STREAM PAGENO BUF])

(\M44ReadLeaderPage
  [LAMBDA (STREAM AGAIN)                                 (* ; "Edited 21-Jan-91 23:42 by jds")

(* ;;; "Returns the leader page of STREAM, reading it if necessary.  If AGAIN is true, will read it afresh even if it already has a cached leader page")

    (* ;; "File leader page format: Words 0-1, time created.  Words 2-3, time last written.  Words 4-5, time last read.  Words 6-25, name of file.  Words 26-235, leader properties.  Words 236-245, spare.  Word 246, property pointer.  Word 247, change serial number.  Words 248-252, STREAM hint for directory.  Word 253, disk address of last page.  Word 254, page number of last page.  Word 255, number of bytes on last page.")

    (PROG ((BUFFER (fetch (M44STREAM LEADERPAGE) of STREAM)))
          (COND
             [(NULL BUFFER)
              (SETQ BUFFER (NCREATE 'VMEMPAGEP]
             ((NOT AGAIN)
              (RETURN BUFFER)))
          (\ACTONDISKPAGES (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE of STREAM))
                 BUFFER
                 (fetch (ARRAYP BASE) of (OR (fetch (M44STREAM FILEPAGEMAP) of STREAM
                                                            )
                                                     (\MAKELEADERDAS STREAM)))
                 -1 STREAM 0 0 \DC.READD)
          (replace (M44STREAM LEADERPAGE) of STREAM with BUFFER)
          (RETURN BUFFER])

(\M44ReadPages
(LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* bvm%: "26-DEC-81 23:50") (* ; "Read pages from a Model44 file.") (for BUF inside BUFFERS as PAGENO from FIRSTPAGE# sum (\M44ReadDiskPage STREAM PAGENO BUF)))
)

(\M44SetAccessTimes
  [LAMBDA (STREAM ACCESS CRDATE)                         (* ; "Edited 21-Jan-91 23:36 by jds")

(* ;;; "Set the 'last read' and/or 'last written' times in the leader page according to access, which is assumed to be either INPUT, OUTPUT, BOTH, or APPEND.")

    (PROG ((DAT (\DAYTIME0 (create FIXP)))
           (BUF (fetch (M44STREAM LEADERPAGE) of STREAM)))

     (* ;; "Note: DAYTIME0 returns an Alto time, not Lisp time.  This is consistent with the dates in the leader page")

          (SELECTQ ACCESS
              ((OUTPUT BOTH APPEND) 
                   (\BLT (LOCF (fetch (\M44LeaderPage TimeCreate) of BUF))
                         (OR CRDATE DAT)
                         WORDSPERCELL)
                   (\BLT (LOCF (fetch (\M44LeaderPage TimeWrite) of BUF))
                         DAT WORDSPERCELL)                   (* ; 
                                                    "Must revalidate because write DAT has changed")
                   (UPDATEVALIDATION STREAM BUF))
              NIL)
          (SELECTQ ACCESS
              ((INPUT BOTH) 
                   (\BLT (LOCF (fetch (\M44LeaderPage TimeRead) of BUF))
                         DAT WORDSPERCELL))
              NIL])

(\M44SetEndOfFile
  [LAMBDA (STREAM EPAGE EOFFSET UPDATENOW)               (* ; "Edited 21-Jan-91 23:36 by jds")

    (* ;; "Reset the file's leader page end-of-file hint.  If UPDATENOW is NIL, then simply update the leader page.  If it is not, then read and write the leader page.")

    (UNINTERRUPTABLY
        
        (* ;; "Must update STREAM handle and leader page in synch")

        (replace (M44STREAM LastPage) of STREAM with EPAGE)
        (replace (M44STREAM LastOffset) of STREAM with EOFFSET)
        [LET ((LEADERPAGE (\M44ReadLeaderPage STREAM)))
             (if (NEQ (fetch (\M44LeaderPage LastPageNumber) of LEADERPAGE)
                          (ADD1 EPAGE))
                 then                                    (* ; 
                                                    "if LastPage hasn't changed, don't do anything")
                                                             (* ; "ADD1 because M44 counts from 1")
                       (replace (\M44LeaderPage LastPageAddress) of LEADERPAGE
                          with (\M44GetPageLoc STREAM EPAGE))
                       (replace (\M44LeaderPage LastPageNumber) of LEADERPAGE
                          with (ADD1 EPAGE)))
             (replace (\M44LeaderPage LastPageByteCount) of LEADERPAGE with EOFFSET)
             (COND
                (UPDATENOW (\M44WriteLeaderPage STREAM])])

(\M44SetFileInfo
  [LAMBDA (STREAM ATTRIBUTE VALUE DEV)                   (* ; "Edited 21-Jan-91 23:34 by jds")
    (PROG ((WASOPEN (type? STREAM STREAM)))
          (SELECTQ ATTRIBUTE
              (CREATIONDATE (SETQ VALUE (OR (IDATE VALUE)
                                            (LISPERROR "ILLEGAL ARG" VALUE))))
              (ICREATIONDATE (OR (FIXP VALUE)
                                 (LISPERROR "NON-NUMERIC ARG" VALUE)))
              (TYPE)
              (RETURN))
          (RETURN (COND
                     ((OR WASOPEN (SETQ STREAM (\M44GetFileHandle STREAM 'OLD DEV T)))
                      (COND
                         ((SELECTQ ATTRIBUTE
                              (TYPE (\M44SETFILETYPE STREAM VALUE))
                              (PROGN (replace (\M44LeaderPage TimeCreate) of (
                                                                                 \M44ReadLeaderPage
                                                                                      STREAM)
                                        with (LISP.TO.ALTO.DATE VALUE))
                                     T))
                          (\M44WriteLeaderPage STREAM)
                          T])

(\M44SETFILETYPE
  [LAMBDA (STREAM TYPE)                                  (* ; "Edited 21-Jan-91 23:44 by jds")

    (* ;; "Set TYPE attribute of file to be TYPE -- assumes someone else will be writing out the leader page later")

    (PROG ((TYPECODE (SELECTQ TYPE
                         (TEXT \FPTYPE.TEXT)
                         (BINARY \FPTYPE.BINARY)
                         (NIL \FPTYPE.UNKNOWN)
                         (OR (\FILETYPE.FROM.TYPE TYPE)
                             \FPTYPE.BINARY)))
           (BUF (\M44ReadLeaderPage STREAM))
           PTR TOTALLENGTH)

     (* ;; "Computation of TYPECODE done this way for backward compatibility -- the \FPTYPE.xx constants were defined before \FILETYPE.FROM.TYPE was written, and the numbers are incompatible")

          (SETQ PTR (\ADDBASE BUF (fetch (\M44LeaderPage PropertyBegin) of BUF)))
          (SETQ TOTALLENGTH (fetch (\M44LeaderPage PropertyLength) of BUF))
          (RETURN (while (IGREATERP TOTALLENGTH 0)
                     do (SELECTC (fetch (M44FILEPROP FPROPTYPE) of PTR)
                                (0                           (* ; "End of properties")
                                   (RETURN (COND
                                              ((IGREATERP TOTALLENGTH 1)
                                               (replace (M44FILEPROP FPROPWORD0) of PTR
                                                  with TYPECODE)
                                               (replace (M44FILEPROP FPROPLENGTH) of PTR
                                                  with 2)
                                               (replace (M44FILEPROP FPROPTYPE) of PTR
                                                  with \FPROP.TYPE)
                                               T))))
                                (\FPROP.TYPE                 (* ; "Already has a type, change it")
                                             (replace (M44FILEPROP FPROPWORD0) of PTR
                                                with TYPECODE)
                                             (RETURN T))
                                NIL)
                           (SETQ PTR (\ADDBASE PTR (fetch (M44FILEPROP FPROPLENGTH) of PTR)))
                           (SETQ TOTALLENGTH (IDIFFERENCE TOTALLENGTH (fetch (M44FILEPROP 
                                                                                        FPROPLENGTH)
                                                                         of PTR])

(\M44TruncateFile
  [LAMBDA (STREAM LP LO UPDATENOW)                       (* ; "Edited 21-Jan-91 23:36 by jds")

    (* ;; 
  "Resets the length of the file to LP page and LO offset.  Can both shorten and lengthen files.")

    [COND
       ((NOT LP)
        (SETQ LP (fetch EPAGE of STREAM))
        (SETQ LO (fetch EOFFSET of STREAM]
    (COND
       ((IGREATERP LP (fetch (M44STREAM LastPage) of STREAM))
        (\M44AddDiskPages STREAM LP LO))
       ((ILESSP LP (fetch (M44STREAM LastPage) of STREAM))
        (\M44DELETEPAGES STREAM (ADD1 LP))
        (COND
           ((ILESSP LP (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM))
            (for I from (ADD1 LP) to (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM)
               do (SETA (fetch (M44STREAM FILEPAGEMAP) of STREAM)
                            (IPLUS I 2)
                            \EOFDA))
            (replace (M44STREAM LASTMAPPEDPAGE) of STREAM with LP)))
        (\M44SetEndOfFile STREAM LP LO)                  (* ; 
                                 "Now need to rewrite last page with new length, null next pointer")
        (\MAPPAGE LP STREAM)
        (\SETIODIRTY STREAM LP)
        (FORCEOUTPUT STREAM))
       (T (replace (M44STREAM LastOffset) of STREAM with LO)))
    (AND UPDATENOW (\M44SetEndOfFile STREAM LP LO T))
    STREAM])

(\M44WriteDiskPage
  [LAMBDA (STREAM PAGENO BUF NBYTES)                     (* ; "Edited 21-Jan-91 23:42 by jds")
                                                             (* ; 
                                                           "Write a disk page on the Model44.")
    (\M44GetPageLoc STREAM PAGENO T)                     (* ; "Ensure that PAGENO is in map")
    (PROG ((BFSPG# (ADD1 PAGENO)))
          (RETURN (COND
                     ([COND
                         ((NEQ PAGENO (fetch (M44STREAM LastPage) of STREAM))
                                                             (* ; "Writing only data")
                          (\ACTONDISKPAGES (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE
                                                                                   of STREAM))
                                 BUF
                                 (fetch (ARRAYP BASE) of (fetch (M44STREAM FILEPAGEMAP)
                                                                    of STREAM))
                                 -1 STREAM BFSPG# BFSPG# \DC.WRITED))
                         (T                                  (* ; 
           "When writing last page, need to fill in the numchars field of label, so this is harder")
                            (COND
                               ((EQ PAGENO (fetch EPAGE of STREAM))
                                (EQ (\WRITEDISKPAGES (fetch (M44DEVICE DSKOBJ)
                                                        of (fetch DEVICE of STREAM))
                                           BUF
                                           (fetch (ARRAYP BASE) of (fetch (M44STREAM
                                                                                       FILEPAGEMAP)
                                                                              of STREAM))
                                           -1 STREAM BFSPG# BFSPG# NIL NIL NBYTES)
                                    BFSPG#))
                               (T 

                                 (* ;; "We will have to write more pages after this one, too, unless the file is truncated back to here, so extend the file while we're at it.  This may save a call to \ADDDISKPAGES")

                                  [COND
                                     ((ILEQ (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM)
                                            PAGENO)
                                      (\M44ExtendFilePageMap STREAM (ADD1 PAGENO]
                                  (COND
                                     ((EQ (\WRITEDISKPAGES (fetch (M44DEVICE DSKOBJ)
                                                              of (fetch DEVICE of STREAM)
                                                                  )
                                                 (LIST BUF NIL)
                                                 (fetch (ARRAYP BASE) of (fetch
                                                                                  (M44STREAM 
                                                                                         FILEPAGEMAP)
                                                                                    of STREAM))
                                                 -1 STREAM BFSPG# (ADD1 BFSPG#)
                                                 NIL NIL 0)
                                          (ADD1 BFSPG#))     (* ; 
                                                    "Write two pages, the second of which is blank")
                                      (replace (M44STREAM LastPage) of STREAM
                                         with (ADD1 PAGENO))
                                      (replace (M44STREAM LastOffset) of STREAM with
                                                                                        0)
                                      T]
                      NBYTES)
                     (T (\M44KillFilePageMap STREAM)
                        (\M44WriteDiskPage STREAM PAGENO BUF NBYTES])

(\M44WriteLeaderPage
  [LAMBDA (STREAM)                                       (* ; "Edited 21-Jan-91 23:42 by jds")
                                                             (* ; "Write the file's leader page")
    (PROG ((BUFFER (fetch (M44STREAM LEADERPAGE) of STREAM)))
          (AND BUFFER (\ACTONDISKPAGES (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE
                                                                               of STREAM))
                             BUFFER
                             (fetch (ARRAYP BASE) of (OR (fetch (M44STREAM FILEPAGEMAP)
                                                                    of STREAM)
                                                                 (\MAKELEADERDAS STREAM)))
                             -1 STREAM 0 0 \DC.WRITED])

(\M44WritePages
  [LAMBDA (STREAM FIRSTPAGE# BUFFERS)                    (* ; "Edited 21-Jan-91 23:36 by jds")
                                                             (* ; 
                                                           "Write pages onto a Model44 file.")
    (PROG ([NPAGES (COND
                      ((NLISTP BUFFERS)
                       1)
                      (T (for B in BUFFERS sum 1]
           LASTPAGE#)
          (COND
             ((fetch REVALIDATEFLG of STREAM)

              (* ;; "Need to update creationdate, since a SAVEVM etc has occurred since the last write.  Otherwise, it is possible to see a change to the file but no change to the creationdate")

              (\M44SetAccessTimes STREAM 'OUTPUT)
              (\M44WriteLeaderPage STREAM)
              (replace REVALIDATEFLG of STREAM with NIL)))
          (\M44GetPageLoc STREAM FIRSTPAGE# T)           (* ; 
                                                 "Make sure we know where we are starting to write")
          [COND
             ([ILESSP (fetch (M44STREAM LASTMAPPEDPAGE) of STREAM)
                     (SETQ LASTPAGE# (IPLUS FIRSTPAGE# (SUB1 NPAGES]
                                                             (* ; 
                                                 "Need enough pagemap to cover everything we write")
              (\M44ExtendFilePageMap STREAM (ADD1 LASTPAGE#]
          [COND
             ([AND (IGEQ NPAGES \#DISKBUFFERS)
                   (for B in BUFFERS thereis (NOT (EMADDRESSP B]

              (* ;; "More pages to write than we have disk buffers to do it in one command, so break it up.  Buffers already in emulator space are free, though, so we can write lots of them")

              (bind (MAXPAGES _ (SUB1 \#DISKBUFFERS))
                 do (\M44WritePages1 STREAM FIRSTPAGE# (IPLUS FIRSTPAGE# (SUB1 MAXPAGES))
                               (to MAXPAGES collect (pop BUFFERS)))
                       (add FIRSTPAGE# MAXPAGES)
                       (SETQ NPAGES (IDIFFERENCE NPAGES MAXPAGES)) repeatwhile (IGREATERP NPAGES
                                                                                          MAXPAGES]
          (\M44WritePages1 STREAM FIRSTPAGE# LASTPAGE# BUFFERS])

(\M44WritePages1
  [LAMBDA (STREAM FIRSTPAGE# LASTPAGE# BUFFERS)          (* ; "Edited 21-Jan-91 23:42 by jds")

(* ;;; "Writes BUFFERS to STREAM, covering pages FIRSTPAGE# thru LASTPAGE#.  Caller guarantees that we have enough disk buffers to do it.  --- There are two cases: easy one is if the pages already exist, in which case we just rewrite their data;  hard case is writing pages at end of file, in which case we need to write labels and maybe allocate pages")

    (COND
       ((ILESSP LASTPAGE# (fetch (M44STREAM LastPage) of STREAM))
                                                             (* ; "Writing only data")
        (\ACTONDISKPAGES (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE of STREAM))
               BUFFERS
               (fetch (ARRAYP BASE) of (fetch (M44STREAM FILEPAGEMAP) of STREAM))
               -1 STREAM (.LISP.TO.BFS. FIRSTPAGE#)
               (.LISP.TO.BFS. LASTPAGE#)
               \DC.WRITED))
       (T                                                    (* ; 
           "When writing last page, need to fill in the numchars field of label, so this is harder")
          (PROG (MYBUFS NBYTES)
                [SETQ MYBUFS (COND
                                ((AND (EQ LASTPAGE# (fetch EPAGE of STREAM))
                                      (NEQ (SETQ NBYTES (fetch EOFFSET of STREAM))
                                           BYTESPERPAGE))    (* ; 
                                                           "Only write to the end of the file")
                                 BUFFERS)
                                (T 

                                 (* ;; "We will have to write more pages after this one, too, unless the file is truncated back to here, so extend the file while we're at it.  This may save a call to \ADDDISKPAGES")

                                   (PROG1 (SETQ MYBUFS (CONS))
                                       [for B inside BUFFERS
                                          do (RPLACA MYBUFS B)
                                                (SETQ MYBUFS (CDR (RPLACD MYBUFS (CONS]
                                       (RPLACD (RPLACA MYBUFS NIL)
                                              NIL)           (* ; "Write a final blank page")
                                       (SETQ NBYTES 0)
                                       (add LASTPAGE# 1))]
                (\WRITEDISKPAGES (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE of STREAM
                                                                             ))
                       MYBUFS
                       (fetch (ARRAYP BASE) of (fetch (M44STREAM FILEPAGEMAP)
                                                          of STREAM))
                       -1 STREAM (.LISP.TO.BFS. FIRSTPAGE#)
                       (.LISP.TO.BFS. LASTPAGE#)
                       NIL NIL NBYTES)
                (replace (M44STREAM LastPage) of STREAM with LASTPAGE#)
                (replace (M44STREAM LastOffset) of STREAM with NBYTES])
)



(* ;; "Disk allocation")

(DEFINEQ

(\ADDDISKPAGES
  [LAMBDA (STREAM FIRSTNEWPAGE NPAGES DAs LASTNUMCHARS)  (* ; "Edited 21-Jan-91 23:42 by jds")

    (* ;; "Adds to file STREAM NPAGES, where FIRSTNEWPAGE-1 is the last existing page.  DAs is the vector of disk addresses, where first element corresponds to BFS page -1")
                                                             (* ; 
                    "Note FIRSTNEWPAGE is in Lisp terms, so it is actually LASTOLDPAGE for the BFS")
    (PROG ((LASTPAGEBUF (NCREATE 'VMEMPAGEP))
           (LASTEXISTINGPAGE FIRSTNEWPAGE)
           (DSK (fetch (M44DEVICE DSKOBJ) of (fetch DEVICE of STREAM)))
           BUFFERS CHUNK)
          (SETQ BUFFERS (CONS LASTPAGEBUF (for I from 1 to (IMIN NPAGES \MAXDISKDAs)
                                             collect NIL)))
          (\ACTONDISKPAGES DSK LASTPAGEBUF DAs -1 STREAM LASTEXISTINGPAGE LASTEXISTINGPAGE \DC.READD
                 NIL NIL NIL LASTEXISTINGPAGE)               (* ; 
                                     "Read last existing page, so we can rewrite it with new label")
          (while (IGREATERP NPAGES 0) do (SETQ CHUNK (IMIN \MAXDISKDAs NPAGES))
                                                (\WRITEDISKPAGES DSK BUFFERS DAs -1 STREAM 
                                                       LASTEXISTINGPAGE (IPLUS LASTEXISTINGPAGE CHUNK
                                                                               )
                                                       NIL NIL LASTNUMCHARS LASTEXISTINGPAGE)
                                                (RPLACA BUFFERS NIL)
                                                (add LASTEXISTINGPAGE CHUNK)
                                                (SETQ NPAGES (IDIFFERENCE NPAGES CHUNK])

(\M44DELETEPAGES
  [LAMBDA (STREAM FIRSTPAGE)                             (* ; "Edited 21-Jan-91 23:42 by jds")
                                                             (* ; 
                                               "FIRSTPAGE is in Lisp terms, i.e.  -1 = leader page")
    (PROG ((DEV (fetch DEVICE of STREAM))
           (NPAGES (COND
                      ((fetch VALIDATION of STREAM)
                       (IPLUS (ADD1 (IDIFFERENCE (fetch (M44STREAM LastPage) of STREAM)
                                           FIRSTPAGE))
                              2))
                      (T PageMapIncrement)))
           (PN (ADD1 FIRSTPAGE))
           DAs FIRSTDA LASTPAGESEEN DSK)

     (* ;; "NPAGES is used to decide how much to do at once.  Need be no more than number of pages known to exist.  The ADD1 is that, plus two for the pages around it")

          (COND
             ((ILESSP NPAGES 2)                              (* ; "Nothing to delete")
              (RETURN)))
          (SETQ DSK (fetch (M44DEVICE DSKOBJ) of DEV))
                                                             (* (\FLUSHDISKDESCRIPTOR
                                                           (EMPOINTER (fetch (DSKOBJ DSKDDMGR) 
                                                           of DSK)) (fetch (DSKOBJ ALTODSKOBJ) 
                                                           of DSK)))
                                                             (* ; 
                                                "Tell Alto to clear out anything it knows about dd")
                                                             (* ; 
         "IF STREAM:LASTMAPPEDPAGE GE FIRSTPAGE+NPAGES THEN DAs _ STREAM:FILEPAGEMAP DAorigin _ -1")
          (SETQ DAs (ARRAY (SETQ NPAGES (IMIN NPAGES \MAXDISKDAs))
                           'WORD NIL 0))
          [SETQ FIRSTDA (COND
                           [(EQ FIRSTPAGE -1)
                            (fetch (FP FPLEADERVDA) of (fetch (FID FIDBLOCK)
                                                                  of (fetch (M44STREAM FID)
                                                                            of STREAM]
                           (T (\M44GetPageLoc STREAM FIRSTPAGE]
          (while (NEQ FIRSTDA \EOFDA)
             do (SETA DAs 0 \FILLINDA)
                   (SETA DAs 1 FIRSTDA)                      (* ; "Corresponds to PN")
                   (for I from 2 to (SUB1 NPAGES) do (SETA DAs I \FILLINDA))
                   [SETQ LASTPAGESEEN (\ACTONDISKPAGES DSK NIL (fetch (ARRAYP BASE) of DAs)
                                             (SUB1 PN)
                                             STREAM PN (IPLUS PN NPAGES -3)
                                             \DC.READD NIL NIL NIL (ADD1 (fetch EPAGE
                                                                            of STREAM] 
                                                             (* ; "Read DAs for the next NPAGES-2")
                   (\WRITEDISKPAGES DSK NIL (fetch (ARRAYP BASE) of DAs)
                          (SUB1 PN)
                          \FREEPAGEFID PN LASTPAGESEEN (UNSIGNED -1 BITSPERWORD))
                   [for I from PN to LASTPAGESEEN
                      do (\M44MARKPAGEFREE DEV (ELT DAs (ADD1 (IDIFFERENCE I PN]
                   (SETQ FIRSTDA (ELT DAs (IPLUS (IDIFFERENCE LASTPAGESEEN PN)
                                                 2)))
                   (SETQ PN (ADD1 LASTPAGESEEN)))            (* (FLUSHMAP (fetch
                                                           (M44DEVICE DISKDESCRIPTOROFD) of DEV))
                                                           (FORGETPAGES (fetch
                                                           (M44DEVICE DISKDESCRIPTOROFD) of DEV)))
          (\M44FLUSHDISKDESCRIPTOR DEV])

(\ASSIGNDISKPAGE
  [LAMBDA (DSK PREVDA)                                   (* ; "Edited 21-Jan-91 23:32 by jds")

(* ;;; "Assigns a new page on DSK.  If PREVDA is \EOFDA will pick random page, otherwise will attempt to allocate PREVDA+1.  Returns NIL if disk is full")

    (PROG ([VDA (COND
                   ((OR (EQ PREVDA \EOFDA)
                        (COND
                           ((EQ PREVDA \FILLINDA)
                            (AND \DISKDEBUG (RAID 
                                "[Disk debug] \ASSIGNDISKPAGE called with \FILLINDA.  ^N to continue"
                                                  ))
                            T)))
                    (fetch (DSKOBJ DISKLASTPAGEALLOC) of DSK))
                   (T (ADD1 PREVDA]
           (DD (fetch (DSKOBJ DISKDESCRIPTOROFD) of DSK))
           (MASK 128)
           BITS A LOOPEDONCE FREE)
          (OR (fetch (DSKOBJ DDVALID) of DSK)
              (RAID "DISKDESCRIPTOR not open" DSK))
          (\SETFILEPTR DD (IPLUS \DDBITTABSTART (FOLDLO VDA BITSPERBYTE)))
          (SETQ A (MOD VDA BITSPERBYTE))
          (FRPTQ A (SETQ MASK (LRSH MASK 1)))
      LP  (COND
             ((NULL (SETQ BITS (\BIN DD)))

              (* ;; "End of file -- wrap around to start.  This technique takes longer than necessary to bomb out when disk is full, but who cares?")

              (COND
                 (LOOPEDONCE (RETURN NIL)))
              (SETQ LOOPEDONCE T)
              (\SETFILEPTR DD \DDBITTABSTART))
             ((NEQ BITS 255)
              (until (OR (EQ (LOGAND BITS MASK)
                                 0)
                             (EQ (SETQ MASK (LRSH MASK 1))
                                 0)) do (add A 1))
              (COND
                 ((NEQ MASK 0)                               (* ; "Found a free page")
                  (\BACKFILEPTR DD)
                  (SETQ VDA (IPLUS (UNFOLD (IDIFFERENCE (\GETFILEPTR DD)
                                                  \DDBITTABSTART)
                                          BITSPERBYTE)
                                   A))
                  (\BOUT DD (LOGOR BITS MASK))               (* ; 
                                                          "Set bit indicating we snarfed this page")
                                                             (* ; "Decrement free page count hint")
                  [replace (DSKOBJ DISKFREEPAGES) of DSK
                     with (COND
                                 ((EQ (SETQ FREE (fetch (DSKOBJ DISKFREEPAGES) of DSK))
                                      0)
                                  (AND \DISKDEBUG (RAID 
                                         "[Disk debug] Free page hint went negative.  ^N to continue"
                                                        ))
                                  (\COUNTDISKFREEPAGES DD))
                                 (T (SUB1 FREE]
                  (replace (DSKOBJ DISKLASTPAGEALLOC) of DSK with VDA)
                  (replace (DSKOBJ DDDIRTY) of DSK with T)
                  (RETURN VDA)))
              (SETQ MASK 128)
              (SETQ A 0)))
          (GO LP])

(\COUNTDISKFREEPAGES
(LAMBDA (DD) (* bvm%: "13-Feb-85 19:32") (* ;;; "Counts number of free pages on a disk.  DD is the diskdescriptor stream") (OR (type? STREAM DD) (SETQ DD (\OPENDISKDESCRIPTOR (\GETDEVICEFROMNAME (OR DD (QUOTE DSK)))))) (PROG ((CNT 0) MASK BITS) (\SETFILEPTR DD \DDBITTABSTART) LP (COND ((NULL (SETQ BITS (\BIN DD))) (* ; "End of file") (RETURN CNT)) ((EQ BITS 0) (add CNT 8)) ((NEQ BITS 255) (SETQ MASK 128) (do (COND ((EQ (LOGAND BITS MASK) 0) (add CNT 1))) until (EQ (SETQ MASK (LRSH MASK 1)) 0)))) (GO LP)))
)

(\M44MARKPAGEFREE
(LAMBDA (DEV DA) (* bvm%: "17-Jan-85 17:11") (* ;; "Mark disk address DA on disk device DEV free") (PROG ((DSK (COND ((type? FDEV DEV) (fetch (M44DEVICE DSKOBJ) of DEV)) (T DEV))) DD BITS MASK) (SETQ DD (COND ((fetch (DSKOBJ DDVALID) of DSK) (fetch (DSKOBJ DISKDESCRIPTOROFD) of DSK)) (T (\OPENDISKDESCRIPTOR DEV)))) (SETFILEPTR DD (IPLUS \DDBITTABSTART (FOLDLO DA BITSPERBYTE))) (SETQ BITS (\BIN DD)) (SETQ MASK (LLSH 1 (IDIFFERENCE 7 (MOD DA BITSPERBYTE)))) (COND ((NEQ (LOGAND BITS MASK) 0) (* ; "Page is marked occupied, so free it") (\BACKFILEPTR DD) (\BOUT DD (LOGXOR BITS MASK)) (add (fetch (DSKOBJ DISKFREEPAGES) of DSK) 1) (replace (DSKOBJ DDDIRTY) of DSK with T)))))
)

(\M44FLUSHDISKDESCRIPTOR
  [LAMBDA (DEV)                                          (* ; "Edited 21-Jan-91 23:32 by jds")
    (PROG ((DSK (COND
                   ((type? FDEV DEV)
                    (fetch (M44DEVICE DSKOBJ) of DEV))
                   (T DEV)))
           DD)
          (OR (fetch (DSKOBJ DDDIRTY) of DSK)
              (RETURN))
          (OR (SETQ DD (fetch (DSKOBJ DISKDESCRIPTOROFD) of DSK))
              (RETURN (RAID "[Disk debug] no disk descriptor stream")))
          (\SETFILEPTR DD \OFFSET.DISKLASTSERIAL#)
          (\BOUTS DD (LOCF (fetch (DSKOBJ DISKLASTSERIAL#) of DSK))
                 0 \NBYTES.DISKINFO)                         (* ; 
                                                "Copy interesting stuff into diskdescriptor header")
          (FORCEOUTPUT DD)
          (replace (DSKOBJ DDDIRTY) of DSK with NIL)
          (RETURN T])

(\MAKELEADERDAS
  [LAMBDA (STREAM)                                       (* ; "Edited 21-Jan-91 23:30 by jds")

    (* ;; "Makes a page map for STREAM that includes the leader vda")

    (PROG ((MAP (ARRAY 4 'WORD \FILLINDA 0)))
          (SETA MAP 0 \EOFDA)
          [SETA MAP 1 (fetch (FP FPLEADERVDA) of (fetch (ARRAYP BASE)
                                                            of (fetch (M44STREAM FID)
                                                                      of STREAM]
          (replace (M44STREAM FILEPAGEMAP) of STREAM with MAP)
          (replace (M44STREAM LASTMAPPEDPAGE) of STREAM with -1)
          (RETURN MAP])

(DISKFREEPAGES
(LAMBDA (DSK RECOMPUTE) (* ejs%: " 7-Nov-85 16:33") (* ; "DSK ignored for now") (SELECTC \MACHINETYPE ((LIST \DANDELION \DAYBREAK) (* ; "Temporary until this become a device op") (\DFSFreeDiskPages DSK RECOMPUTE)) (\M44FREEPAGECOUNT (COND ((type? FDEV DSK) DSK) (T (\GETDEVICEFROMNAME (OR DSK (QUOTE DSK))))) NIL RECOMPUTE)))
)

(\M44FREEPAGECOUNT
(LAMBDA (DEV DIRECTORY RECOMPUTE) (* bvm%: "12-Oct-85 15:43") (PROG (CNT) (COND ((NOT (type? M44DEVICE DEV)) (\ILLEGAL.ARG DEV))) (RETURN (COND (RECOMPUTE (SETQ CNT (\COUNTDISKFREEPAGES (\OPENDISKDESCRIPTOR DEV))) (COND ((NEQ CNT (fetch (M44DEVICE DISKFREEPAGES) of DEV)) (replace (M44DEVICE DISKFREEPAGES) of DEV with CNT) (replace (M44DEVICE DDDIRTY) of DEV with T))) CNT) (T (fetch (M44DEVICE DISKFREEPAGES) of DEV))))))
)
)

(RPAQ? \M44MULTFLG T)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(PUTPROPS UCASECHAR MACRO [(C)
                                   (COND
                                      ((ILESSP C (CHARCODE a))
                                       C)
                                      (T (IDIFFERENCE C (IDIFFERENCE (CHARCODE a)
                                                               (CHARCODE A])

(PUTPROPS UPDATEVALIDATION MACRO [(STREAM BUF)
                                          (replace VALIDATION of STREAM
                                             with (\MAKENUMBER (\GETBASE BUF 1)
                                                             (\GETBASE BUF 3])
)

(DECLARE%: EVAL@COMPILE

(ACCESSFNS M44DEVICE ((DSKOBJ (fetch DEVICEINFO of DATUM)
                                 (replace DEVICEINFO of DATUM with NEWVALUE)))
                         [TYPE? (AND (type? FDEV DATUM)
                                         (EQ (fetch OPENFILE of DATUM)
                                             '\M44OpenFile])
)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \OPENFILES \M44MULTFLG \DISKNAMECASEARRAY)
)

(DECLARE%: EVAL@COMPILE 

(PUTPROPS .LISP.TO.BFS. MACRO (= . ADD1))

(PUTPROPS .BFS.TO.LISP. MACRO (= . SUB1))

(PUTPROPS .DISKCASEARRAY. MACRO [NIL (fetch (ARRAYP BASE) of (\DTEST 
                                                                                   \DISKNAMECASEARRAY
                                                                                    'ARRAYP])
)

(DECLARE%: EVAL@COMPILE 

(RPAQQ PageMapIncrement 64)

(RPAQQ \MAX.ALTO.NAME.LENGTH 39)


(CONSTANTS (PageMapIncrement 64)
       (\MAX.ALTO.NAME.LENGTH 39))
)




(* ;; "File properties")

(DECLARE%: EVAL@COMPILE

(BLOCKRECORD M44FILEPROP ((FPROPTYPE BYTE)               (* ; "Type of property")
                              (FPROPLENGTH BYTE)             (* ; "Length of entire entry in words")
                              (FPROPWORD0 WORD)              (* ; "value starts here")
                              )                              (* ; 
                                      "Overlays a piece of leader page to describe a file property")
                             )
)

(RPAQQ FPROPTYPES ((\FPROP.TYPE 136)
                       (\FPROP.PAGEMAP 137)))
(DECLARE%: EVAL@COMPILE 

(RPAQQ \FPROP.TYPE 136)

(RPAQQ \FPROP.PAGEMAP 137)


(CONSTANTS (\FPROP.TYPE 136)
       (\FPROP.PAGEMAP 137))
)

(RPAQQ FPTYPES ((\FPTYPE.UNKNOWN 0)
                    (\FPTYPE.TEXT 1)
                    (\FPTYPE.BINARY 2)))
(DECLARE%: EVAL@COMPILE 

(RPAQQ \FPTYPE.UNKNOWN 0)

(RPAQQ \FPTYPE.TEXT 1)

(RPAQQ \FPTYPE.BINARY 2)


(CONSTANTS (\FPTYPE.UNKNOWN 0)
       (\FPTYPE.TEXT 1)
       (\FPTYPE.BINARY 2))
)

(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

[PUTDEF '\M44PAGEBUFFER 'RESOURCES '(NEW (NCREATE 'VMEMPAGEP]
)
)

(/SETTOPVAL '\\M44PAGEBUFFER.GLOBALRESOURCE NIL)
)

(/SETTOPVAL '\\M44PAGEBUFFER.GLOBALRESOURCE NIL)



(* ;; "Directory enumeration")

(DEFINEQ

(\M44GENERATEFILES
(LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* bvm%: "12-Oct-85 15:13") (* ;; "Returns a file-generator object that will generate AT LEAST all files in the sys-dir of FDEV whose names match PATTERN.  Clients might need to provide additional filtering.  For M44, the generate state consists of the HOSTNAME (DSK) followed by a 'search state' , a directory pointer and a character list of the sort that \SEARCHDIR1 expects.  DIRPTR is the position of the next file to be considered in the directory.") (PROG ((DIRSTREAM (fetch (M44DEVICE SYSDIROFD) of FDEV)) (SORT? (EQMEMB (QUOTE SORT) OPTIONS)) (CASEBASE (.DISKCASEARRAY.)) (EXT (QUOTE *)) HOSTNAME NAME VERSION CHARLIST GENSTREAM FILTER DESIREDVERSION SEARCHSTATE HOSTPREFIX) (OR DIRSTREAM (RETURN (\NULLFILEGENERATOR))) (COND ((for TAIL on (UNPACKFILENAME.STRING PATTERN) by (CDDR TAIL) do (SELECTQ (CAR TAIL) (HOST (SETQ HOSTNAME (CADR TAIL))) (NAME (SETQ NAME (CADR TAIL))) (EXTENSION (SETQ EXT (CADR TAIL))) (VERSION (COND ((OR (EQ (NCHARS (SETQ VERSION (MKATOM (CADR TAIL)))) 0) (EQ VERSION 0)) (* ; "Newest version only") (SETQ SORT? T) (* ; "Can only get highest version by sorting") (SETQ VERSION NIL) (SETQ DESIREDVERSION T)) ((SMALLP VERSION) (* ; "An actual specific version to look for") (SETQ DESIREDVERSION VERSION)) ((NEQ VERSION (QUOTE *)) (* ; "Bogus version") (RETURN T)))) (RETURN T))) (* ; "Bad file name") (RETURN (\NULLFILEGENERATOR)))) (SETQ FILTER (DIRECTORY.MATCH.SETUP (CONCAT NAME (QUOTE %.) EXT ";*"))) (SETQ CHARLIST (for C instring (COND ((OR (EQ 0 (NCHARS EXT)) (EQ (CHCON1 EXT) (CHARCODE *))) NAME) (T (CONCAT NAME (QUOTE %.) EXT))) until (SELCHARQ (SETQ C (\GETBASEBYTE CASEBASE C)) ((%# *) (* ;; "\SEARCHDIR1 currently only checks prefixes, so we truncate at the first * or escape.  Also ignore version specifications, because of the alternative representations of version 1") T) NIL) collect C)) (COND (DESIREDPROPS (* ; "Create a scratch stream for \M44FILEINFOFN to use") (SETQ GENSTREAM (create M44STREAM)) (replace DEVICE of GENSTREAM with FDEV))) (SETQ SEARCHSTATE (create M44DIRSEARCHSTATE DIRPTR _ 0 CHARLIST _ CHARLIST)) (SETQ HOSTPREFIX (CONCAT (QUOTE {) HOSTNAME (QUOTE }))) (RETURN (COND (SORT? (* ; "Have to generate the matching files first, sort them, then enumerate") (create FILEGENOBJ NEXTFILEFN _ (FUNCTION \M44SORTEDNEXTFILEFN) FILEINFOFN _ (FUNCTION \M44FILEINFOFN) GENFILESTATE _ (create M44GENFILESTATE DIROFD _ DIRSTREAM SEARCHSTATE _ (\M44SORTFILES DIRSTREAM SEARCHSTATE FILTER DESIREDVERSION HOSTPREFIX (LENGTH CHARLIST)) GENVERSION _ DESIREDVERSION GENSTREAM _ GENSTREAM))) (T (* ; "Order not important") (create FILEGENOBJ NEXTFILEFN _ (FUNCTION \M44NEXTFILEFN) FILEINFOFN _ (FUNCTION \M44FILEINFOFN) GENFILESTATE _ (create M44GENFILESTATE DIROFD _ DIRSTREAM SEARCHSTATE _ SEARCHSTATE GENFILTER _ FILTER GENVERSION _ DESIREDVERSION HOSTNAME _ HOSTPREFIX GENSTREAM _ GENSTREAM)))))))
)

(\M44SORTFILES
(LAMBDA (DIRSTREAM SEARCHSTATE FILTER DESIREDVERSION HOSTPREFIX PATTERNLENGTH) (* bvm%: " 7-Jun-84 14:38") (SORT (bind FL while (SETQ FL (\M44GENERATENEXT DIRSTREAM SEARCHSTATE FILTER DESIREDVERSION HOSTPREFIX PATTERNLENGTH)) collect FL) (FUNCTION (LAMBDA (X Y) (SELECTQ (UALPHORDER (CAR X) (CAR Y)) (LESSP T) (EQUAL (IGREATERP (CADR X) (CADR Y))) NIL)))))
)

(\M44GENERATENEXT
  [LAMBDA (DIRSTREAM SEARCHSTATE FILTER DESIREDVERSION HOSTPREFIX PATTERNLENGTH GENFILESTATE)
                                                             (* ; "Edited 21-Jan-91 23:53 by jds")

(* ;;; "Produces the next filename from directory DIRSTREAM satisfying SEARCHSTATE and the more constrained FILTER and DESIREDVERSION, or returns NIL if no more files.  HOSTPREFIX is string to put on front, or NIL for names only.  PATTERNLENGTH is the length of the pattern in SEARCHSTATE.  GENFILESTATE is a a M44GENFILESTATE whose GENSTREAM and ENTRYSTART want to be set appropriately for \M44FILEINFOFN;  if NIL, then the value is returned for SORTFILES in the form (name version entrystart)")

    (PROG ((PATTERNHASDOT (MEMB (CHARCODE %.)
                                (fetch (M44DIRSEARCHSTATE CHARLIST) of SEARCHSTATE)))
           SAWDOT ENTRYSTART TEMP PREFIXLEN TOTALLEN THISVERSION RESULT INDEX)
      LP  (COND
             ((NOT (SETQ TEMP (\M44SEARCHDIR DIRSTREAM SEARCHSTATE)))
                                                             (* ; "Enumeration finished")
              (RETURN NIL)))
          (SETQ SAWDOT PATTERNHASDOT)
          (SETQ ENTRYSTART (IDIFFERENCE (GETFILEPTR DIRSTREAM)
                                  (IPLUS PATTERNLENGTH 13))) (* ; 
                                                       "Read all the characters from the directory")
          (SETQ TOTALLEN (IPLUS PATTERNLENGTH (SUB1 TEMP)))
          (for I from (SUB1 TEMP) to 1 by -1
             do                                          (* ; 
                                      "The SUB1 is because the last character is the undesired dot")
                   (SELCHARQ (\BIN DIRSTREAM)
                        (! [RETURN (SETQ THISVERSION (\M44READVERSION DIRSTREAM (SUB1 I])
                        (%. (SETQ SAWDOT T))
                        NIL) finally (SETQ THISVERSION 1))
          (COND
             ((AND DESIREDVERSION (NEQ THISVERSION DESIREDVERSION)
                   (NEQ DESIREDVERSION T))                   (* ; "Failure, try next")
              (GO LP)))
          [SETQ RESULT (ALLOCSTRING (IPLUS TOTALLEN (SETQ PREFIXLEN (COND
                                                                       (HOSTPREFIX (NCHARS HOSTPREFIX
                                                                                          ))
                                                                       (T 0)))
                                           (COND
                                              ((AND (EQ THISVERSION 1)
                                                    HOSTPREFIX)
                                               2)
                                              (T 0))
                                           (COND
                                              (SAWDOT 0)
                                              (T 1]
          (AND HOSTPREFIX (RPLSTRING RESULT 1 HOSTPREFIX))
          (\SETFILEPTR DIRSTREAM (IPLUS ENTRYSTART 13))      (* ; "Now read the whole name")
          (SETQ INDEX PREFIXLEN)
          (for I from TOTALLEN to 1 by -1
             do (SELCHARQ (SETQ TEMP (\BIN DIRSTREAM))
                         (%. (SETQ SAWDOT T))
                         (! (OR SAWDOT (RPLCHARCODE RESULT (add INDEX 1)
                                              (CHARCODE %.)))
                            (SETQ SAWDOT T)
                            [COND
                               (HOSTPREFIX (RPLCHARCODE RESULT (add INDEX 1)
                                                  (CHARCODE ;))
                                      (to (SUB1 I)
                                         do (RPLCHARCODE RESULT (add INDEX 1)
                                                       (COND
                                                          (GENFILESTATE (\BIN DIRSTREAM))
                                                          (T 

                                 (* ;; "Make everything a constant version for benefit of SORT.  Will replace with real thing later.  The constant version is chosen in a way that makes 2-digit versions sort in front of 1-digit versions, etc, and single-digit versions come out as ;1 to match the ;1 inserted below")

                                                             (IDIFFERENCE (CHARCODE 3)
                                                                    I]
                            (RETURN))
                         NIL)
                   (RPLCHARCODE RESULT (add INDEX 1)
                          TEMP))
          (OR SAWDOT (RPLCHARCODE RESULT (add INDEX 1)
                            (CHARCODE %.)))
          (COND
             ((AND (EQ THISVERSION 1)
                   HOSTPREFIX)
              (RPLSTRING RESULT (ADD1 INDEX)
                     ";1")))
          (COND
             ((AND FILTER (NOT (DIRECTORY.MATCH FILTER RESULT)))
              (GO LP)))
          (RETURN (COND
                     (GENFILESTATE (replace (M44GENFILESTATE ENTRYSTART) of GENFILESTATE
                                      with ENTRYSTART)
                            (replace (M44STREAM DIRINFO) of (fetch (M44GENFILESTATE
                                                                                GENSTREAM)
                                                                       of GENFILESTATE)
                               with NIL)
                            RESULT)
                     (T (LIST RESULT THISVERSION ENTRYSTART])

(\M44NEXTFILEFN
  [LAMBDA (GENFILESTATE NAMEONLY)                        (* ; "Edited 21-Jan-91 23:53 by jds")

    (* ;; "GENFILESTATE is the state information from the file-generator object created by \M44GENERATEFILES.  This function returns the next file name as a string.  Returns NIL if no files left.  It updates GENFILESTATE so that it will get the following satisfactory file on the next call to this function.  --- NAMEONLY => returns the filenames without the semi-colon and version number")

    (PROG ((DIRSTREAM (fetch (M44GENFILESTATE DIROFD) of GENFILESTATE))
           (SEARCHSTATE (fetch (M44GENFILESTATE SEARCHSTATE) of GENFILESTATE))
           (DESIREDVERSION (fetch (M44GENFILESTATE GENVERSION) of GENFILESTATE))
           (FILTER (fetch (M44GENFILESTATE GENFILTER) of GENFILESTATE))
           (HOSTPREFIX (AND (NOT NAMEONLY)
                            (fetch (M44GENFILESTATE HOSTNAME) of GENFILESTATE)))
           PATTERNLENGTH)
          (SETQ PATTERNLENGTH (LENGTH (fetch (M44DIRSEARCHSTATE CHARLIST) of SEARCHSTATE)))
          (RETURN (\M44GENERATENEXT DIRSTREAM SEARCHSTATE FILTER DESIREDVERSION HOSTPREFIX 
                         PATTERNLENGTH GENFILESTATE])

(\M44SORTEDNEXTFILEFN
  [LAMBDA (GENFILESTATE NAMEONLY)                        (* ; "Edited 21-Jan-91 23:51 by jds")
    (LET ((FILES (fetch (M44GENFILESTATE SEARCHSTATE) of GENFILESTATE))
          THISFILE THISNAME V LEN)
         (COND
            ((SETQ THISFILE (CAR FILES))                     (* ; 
                                                           "THISFILE = (name version entryStart)")
             (SETQ THISNAME (CAR THISFILE))
             (SETQ V (CADR THISFILE))

             (* ;; "need to fill in the correct version number, since the names were generated with constant version number")

             (SETQ LEN (NCHARS THISNAME))
             [COND
                [(ILESSP V 10)                               (* ; "Easy, 1-digit version")
                 (\RPLCHARCODE THISNAME LEN (PLUS V (CHARCODE 0]
                (T (SETQ V (CHCON V))
                   (for C in V as I from [SETQ LEN (ADD1 (IDIFFERENCE LEN
                                                                                (LENGTH V]
                      do (\RPLCHARCODE THISNAME I C]
             (replace (M44STREAM DIRINFO) of (fetch (M44GENFILESTATE GENSTREAM)
                                                        of GENFILESTATE) with NIL)
             (replace (M44GENFILESTATE ENTRYSTART) of GENFILESTATE with (CADDR THISFILE))
             (SETQ FILES (CDR FILES))
             (COND
                ((EQ (fetch (M44GENFILESTATE GENVERSION) of GENFILESTATE)
                     T)
                 (bind (THISNAMEONLY _ (SUBSTRING THISNAME 1 (SUB1 LEN)))
                    while (AND FILES (STRING-EQUAL (SUBSTRING (CAAR FILES)
                                                              1
                                                              (SUB1 LEN))
                                                THISNAMEONLY)) do (SETQ FILES (CDR FILES)))
                 FILES))
             (replace (M44GENFILESTATE SEARCHSTATE) of GENFILESTATE with FILES)
             THISNAME])

(\M44FILEINFOFN
  [LAMBDA (GENFILESTATE ATTRIBUTE)                       (* ; "Edited 21-Jan-91 23:51 by jds")

    (* ;; 
 "Retrieves info of file currently being enumerated.  State has a directory pointer to help us out")

    (PROG ((STREAM (fetch (M44GENFILESTATE GENSTREAM) of GENFILESTATE)))
          (OR STREAM (RETURN))
          (COND
             ((NULL (fetch (M44STREAM DIRINFO) of STREAM))
              (replace VALIDATION of STREAM with (replace (M44STREAM FILEPAGEMAP)
                                                                of STREAM with NIL))
              (replace (M44STREAM DIRINFO) of STREAM with (fetch (M44GENFILESTATE
                                                                                  ENTRYSTART)
                                                                         of GENFILESTATE))
              (replace (M44STREAM FID) of STREAM with (\M44READDIRFID
                                                                   (fetch (M44GENFILESTATE DIROFD
                                                                                     ) of 
                                                                                         GENFILESTATE
                                                                          )
                                                                   (fetch (M44GENFILESTATE 
                                                                                     ENTRYSTART)
                                                                      of GENFILESTATE)
                                                                   (fetch (M44STREAM FID)
                                                                      of STREAM)))
              (\M44ReadLeaderPage STREAM T)))
          (RETURN (\M44GetFileInfo STREAM ATTRIBUTE])
)



(* ;; "Directory lookup routines")

(DEFINEQ

(\M44PARSEFILENAME
  [LAMBDA (X RECOG DEV CREATEFLG)                        (* ; "Edited 21-Jan-91 23:47 by jds")

    (* ;; "This returns a full file specification, with all the information needed to do open, delete, etc.  A filespec is a (uname dirptr) pair, with the true version number smashed into the uname.  The dirptr is NIL if the file does not currently exist in the directory.")

    (PROG ((DIRSTREAM (fetch (M44DEVICE SYSDIROFD) of DEV))
           UNAME ENDNAMEOFFSET MAYBENEW EXPLICITVERSION FIXEDVERSION UCHARS SOMEPTR TLIST PTR 
           NCHARSLEFT BESTVERSION BESTPTR VERS HMIN OLDESTP)
          [COND
             ([NULL (SETQ UNAME (\M44UNPACKFILENAME X DEV (SELECTQ RECOG
                                                                  ((NEW OLD/NEW) 
                                                             (* ; 
                 "We might create a new file here, so tell unpack to save the original characters.")
                                                                       (SETQ MAYBENEW T))
                                                                  NIL]
                                                             (* ; "BAD FILE NAME")
              (RETURN (create FILESPEC
                             UNAME _ NIL]

     (* ;; "Name parsed ok, get ready to search directory for it.")

          (SETQ UCHARS (fetch (UNAME UCASECHARS) of UNAME))
          (SETQ ENDNAMEOFFSET (+ 13 (LENGTH UCHARS)))        (* ; "ENDNAMEOFFSET is length of name we're searching for plus fixed overhead (header word, FID, name length byte)")
          [COND
             (CREATEFLG                                      (* ; "Want to look for a hole, in case we need to create the file.  The 6 is to allow for the maximum number of chars in a version number")
                    (SETQ HMIN (FOLDLO (+ ENDNAMEOFFSET 6)
                                      BYTESPERWORD]
          (SETQ TLIST (CONS 0 UCHARS))                       (* ; 
                                    "Pair of dirptr & chars used to communicate with \M44SEARCHDIR")
          (if (AND (FIXP (SETQ EXPLICITVERSION (fetch (UNAME VERSION) of UNAME)))
                       (NEQ EXPLICITVERSION 0))
              then                                       (* ; 
        "If caller gave a real explicit version, then if we find that version, we know we're done.")
                    (SETQ FIXEDVERSION EXPLICITVERSION))
          (SETQ OLDESTP (EQ (OR EXPLICITVERSION RECOG)
                            'OLDEST))
      SEARCHLP
          (COND
             ((NULL (SETQ NCHARSLEFT (\M44SEARCHDIR DIRSTREAM TLIST HMIN)))
                                                             (* ; "No more prefix matches found")
              (GO DONE)))
          (SETQ PTR (\GETFILEPTR DIRSTREAM))                 (* ; "Note current position")
          (COND
             ((EQ NCHARSLEFT 1)                              (* ; 
                        "No version, just the final dot remains, so we must have matched version 1")
              (SETQ VERS 1))
             ((NEQ (\BIN DIRSTREAM)
                   (CHARCODE !))                             (* ; 
                                                    "More chars follow before version, so no match")
              (GO NEXT))
             ([NULL (SETQ VERS (\M44READVERSION DIRSTREAM (- NCHARSLEFT 2]
              (GO NEXT)))

     (* ;; "Name matches.  VERS is the version number.  Is it better than we've seen?  Accumulate extreme vers,ptr in BESTVERSION,BESTPTR.")

          (SETQ PTR (- PTR ENDNAMEOFFSET))                   (* ; 
                                                           "Beginning of the directory entry")
          (COND
             [FIXEDVERSION                                   (* ; "Version must match")
                    (SETQ BESTPTR PTR)                       (* ; 
                                        "Always note a pointer, for benefit of getting case right.")
                    (COND
                       ((EQ VERS FIXEDVERSION)               (* ; "The one we've been looking for")
                        (SETQ BESTVERSION VERS)
                        (GO DONE]
             ((OR (NULL BESTVERSION)
                  (if OLDESTP
                      then (< VERS BESTVERSION)
                    else (> VERS BESTVERSION)))          (* ; "More extreme than the last one")
              (SETQ BESTVERSION VERS)
              (SETQ BESTPTR PTR)))
      NEXT
          (COND
             ((AND HMIN (fetch (M44STREAM DIRHOLEPTR) of DIRSTREAM))
                                                             (* ; 
                                                           "Stop looking for a hole if found one")
              (SETQ HMIN NIL)))
          (GO SEARCHLP)
      DONE
          

     (* ;; "At this point, BESTVERSION is the version, if any, that best matches RECOG or funny version spec in UNAME, i.e., it is the oldest or newest version.  BESTPTR is the corresponding directory pointer.  In the case where an explicit version was requested but not found, BESTPTR is the directory pointer of SOME version.  So now we need to bump the version up for RECOG = NEW, and maybe adjust the characters.")

          (SETQ SOMEPTR BESTPTR)                             (* ; 
                                        "Save dir pointer for getting at true chars for new files.")
          (if BESTVERSION
              then                                       (* ; "Found one")
                    (if (if EXPLICITVERSION
                                then                     (* ; "Ignore funny version N when asking for %"OLD%" recognition--don't want FOO;N to mean next highest version, since that's a lie. e.g., it's not infilep.")
                                      (AND (EQ EXPLICITVERSION 'NEW)
                                           MAYBENEW)
                              else (EQ RECOG 'NEW))
                        then (add BESTVERSION 1)     (* ; 
                                     "Bump version, clear directory pointer (since we're creating)")
                              (SETQ BESTPTR NIL))
            elseif MAYBENEW
              then                                       (* ; 
                                     "Specified file doesn't exist, but we're willing to create it")
                    (SETQ BESTVERSION (OR FIXEDVERSION 1))
                    (SETQ BESTPTR NIL))
          (RETURN (if BESTVERSION
                      then                               (* ; "Success")
                            (if (NULL BESTPTR)
                                then                     (* ; 
                                     "New file.  Get the case right if some other version existed.")
                                      (if SOMEPTR
                                          then (replace (UNAME ORIGCHARS) of UNAME
                                                      with (\M44READDIRNAME DIRSTREAM SOMEPTR
                                                                      )))
                              elseif (fetch (UNAME ORIGCHARS) of UNAME)
                                then                     (* ; 
  "New recog but existing file--happens when overwriting.  Still want to get the characters right.")
                                      (replace (UNAME ORIGCHARS) of UNAME
                                         with (\M44READDIRNAME DIRSTREAM BESTPTR)))
                            (replace (UNAME VERSION) of UNAME with BESTVERSION)
                            (create FILESPEC
                                   UNAME _ UNAME
                                   FSDIRPTR _ BESTPTR])

(\FINDDIRHOLE
  [LAMBDA (NWORDS DIRSTREAM)                             (* ; "Edited 21-Jan-91 23:37 by jds")

    (* ;; "Returns the byte address of a directory hole of size NWORDS.  The directory file is positioned just after the 2-byte length field of the hole.")

    (PROG ((HINT (fetch (M44STREAM DIRHOLEPTR) of DIRSTREAM))
           PTR ENTRYLENGTH C)
          (SETQ PTR (OR HINT 0))
      NEXT
          (\SETFILEPTR DIRSTREAM PTR)
          (COND
             ((\EOFP DIRSTREAM)
              (if (AND HINT (> HINT 0))
                  then                                   (* ; 
                                                           "Hint failed, so try from the start.")
                        (SETQ HINT NIL)
                        (SETQ PTR 0)
                        (GO NEXT)
                else (GO END)))
             ((AND (>= (SETQ ENTRYLENGTH (+ (LLSH (LOGAND (SETQ C (\BIN DIRSTREAM))
                                                         3)
                                                  8)
                                            (\BIN DIRSTREAM)))
                       NWORDS)
                   (< C 4))

              (* ;; "First 6 bits is entry type, next 10 bits are length of entry in words.  Free entries have type zero.  Thus C < 4 implies this is free entry.")

              (\SETFILEPTR DIRSTREAM PTR)                    (* ; "Hole is large enough")
              [COND
                 ((> ENTRYLENGTH NWORDS)                     (* ; 
                "Too large, so split hole into 2 parts.  We'll return the second half of the hole.")
                  (\WOUT DIRSTREAM (SETQ ENTRYLENGTH (- ENTRYLENGTH NWORDS)))
                  (\SETFILEPTR DIRSTREAM (add PTR (UNFOLD ENTRYLENGTH BYTESPERWORD]
              (GO END)))
          (add PTR (UNFOLD ENTRYLENGTH BYTESPERWORD))
          (GO NEXT)
      END (\WOUT DIRSTREAM NWORDS)
          (RETURN PTR])

(\M44PACKFILENAME
(LAMBDA (UNAME DIRPTR DIRSTREAM) (* ; "Edited 12-Jan-88 12:01 by bvm") (* ;; "Produces a Lisp style file-name of the form 'name.[ext];ver'") (LET* ((CHARS (OR (AND (NULL *UPPER-CASE-FILE-NAMES*) (OR (fetch (UNAME ORIGCHARS) of UNAME) (if DIRPTR then (* ; "Get the exact name out of the directory") (\M44READDIRNAME DIRSTREAM DIRPTR)))) (fetch (UNAME UCASECHARS) of UNAME))) (NAME (CONCAT (QUOTE {) (fetch (UNAME PARTNAME) of UNAME) (QUOTE }) (CONCATCODES CHARS) (COND ((MEMB (CHARCODE %.) CHARS) ";") (T ".;")) (fetch (UNAME VERSION) of UNAME)))) (if *UPPER-CASE-FILE-NAMES* then (MKATOM NAME) else NAME)))
)

(\M44READVERSION
(LAMBDA (DIRSTREAM MAXCHARS) (* bvm%: " 7-Jun-84 11:38") (to MAXCHARS bind (VERSION _ 0) C do (SETQ C (\BIN DIRSTREAM)) (COND ((AND (IGEQ C (CHARCODE 0)) (ILEQ C (CHARCODE 9))) (SETQ VERSION (IPLUS (ITIMES VERSION 10) (IDIFFERENCE C (CHARCODE 0))))) (T (* ;; "A non-numeric after a ! means that it wasn't the version marker.  This is permissible by alto file spec") (RETURN))) finally (RETURN VERSION)))
)

(\OPENDISKDESCRIPTOR
  [LAMBDA (DEV)                                          (* ; "Edited 21-Jan-91 23:43 by jds")

    (* ;; "Opens and returns a stream on the disk descriptor file for DEV")

    [COND
       ((NOT (type? FDEV DEV))
        (SETQ DEV (\GETDEVICEFROMNAME (fetch (DSKOBJ DISKDEVICENAME) of DEV]
    (OR (fetch (M44DEVICE DDVALID) of DEV)
        (PROG ((OLDD (fetch (M44DEVICE DISKDESCRIPTOROFD) of DEV))
               STREAM)
              (COND
                 (OLDD (FORGETPAGES OLDD)))
              [SETQ STREAM (COND
                              ((EQ (fetch (M44DEVICE DSKOBJ) of DEV)
                                   \MAINDISK)
                               (\M44OPENFILEFROMFP DEV "DISKDESCRIPTOR.;1" 'BOTH (
                                                                                 \CREATE.FID.FOR.DD
                                                                                      DEV)))
                              (T (\OPENFILE (CONCAT "{" (fetch (FDEV DEVICENAME) of DEV)
                                                   "}" "DISKDESCRIPTOR.;1")
                                        'BOTH]
              (replace USERVISIBLE of STREAM with NIL)
              (replace (M44DEVICE DISKDESCRIPTOROFD) of DEV with STREAM)
              (replace MAXBUFFERS of STREAM with (ADD1 (fetch EPAGE of STREAM)))
                                                             (* ; 
                 "Prepare to buffer the whole file, so that we don't get in trouble under \NEWPAGE")
              (for I from 0 to (fetch EPAGE of STREAM)
                 do (\MAPPAGE I STREAM))                 (* ; 
                                          "Ought to define a \MAPPAGES to do that more efficiently")
              (replace ENDOFSTREAMOP of STREAM with (FUNCTION NILL))
              (replace (M44DEVICE DDVALID) of DEV with T)))
    (fetch (M44DEVICE DISKDESCRIPTOROFD) of DEV])

(\M44READDIRFID
  [LAMBDA (DIRSTREAM DIRPTR FID)                         (* ; "Edited 21-Jan-91 23:39 by jds")

    (* ;; "Read the 5-word FID from the directory into FID (or create a new one if FID is nil).  Return the new FID.")

    (\SETFILEPTR DIRSTREAM (+ DIRPTR 2))
    (\BINS DIRSTREAM [fetch (FID FIDBLOCK) of (OR FID (SETQ FID (create FID]
           0
           (UNFOLD 5 BYTESPERWORD))
    FID])

(\M44READDIRNAME
(LAMBDA (DIRSTREAM DIRPTR) (* ; "Edited 11-Jan-88 14:39 by bvm") (* ;; "Read the exact file name, sans version number, from directory stream as a list of char codes.") (* ;; "Format of a directory entry is --- Type&WordLength (1 word), FP (5 words), Name as a BcplString") (SETFILEPTR DIRSTREAM (+ DIRPTR 12)) (to (SUB1 (BIN DIRSTREAM)) bind CH until (EQ (SETQ CH (BIN DIRSTREAM)) (CHARCODE !)) collect CH))
)

(\M44SEARCHDIR
  [LAMBDA (STREAM TLIST HMIN)                            (* ; "Edited 21-Jan-91 23:37 by jds")

    (* ;; "TLIST is a list of the form (POS . NAMECHARS), where POS at entry is a fileptr in the directory file at which to start searching and NAMECHARS is like the characters pairs of a uname.  Finds next directory entry for which NAMECHARS is a prefix of the filename.  Returns NIL if no entry found, else the length of the remaining chars in the entry.  Leaves the directory positioned after the char matching the last char of NAMECHARS --- STREAM is the ofd of the directory file --- At exit, TLIST is smashed so that POS is the fileptr just beyond the found entry.  --- if HMIN~=NIL, sets STREAM's DIRHOLEPTR to NIL or the fileptr of the first hole of at least HMIN words.")

    (PROG ((CASEBASE (.DISKCASEARRAY.))
           (NEXT (CAR TLIST))
           (NAMECHARS (CDR TLIST))
           THISNAMELENGTH TARGETLENGTH PTR L TYP ENTRYLENGTH)
          (COND
             (HMIN (replace (M44STREAM DIRHOLEPTR) of STREAM with NIL)))
          (SETQ TARGETLENGTH (LENGTH NAMECHARS))
      NEXT
          (\SETFILEPTR STREAM (SETQ PTR NEXT))
          (COND
             ((\EOFP STREAM)
              (RETURN)))

     (* ;; "Format of a directory entry is --- Type (0 = hole, 1 = file), 6 bits --- Length of entry in words, 10 bits --- FP 5 words --- Name as a BcplString")

          (SETQ TYP (\BIN STREAM))
          (SETQ ENTRYLENGTH (IPLUS (LLSH (LOGAND TYP 3)
                                         8)
                                   (\BIN STREAM)))
          (SETQ NEXT (IPLUS (UNFOLD ENTRYLENGTH BYTESPERWORD)
                            PTR))
          (COND
             ((NEQ (LRSH TYP 2)
                   1)                                        (* ; "Not a file")
              (COND
                 ((AND HMIN (NOT (IGREATERP HMIN ENTRYLENGTH)))
                  (replace (M44STREAM DIRHOLEPTR) of STREAM with PTR)
                  (SETQ HMIN NIL)))
              (GO NEXT)))
          (\SETFILEPTR STREAM (IPLUS PTR 12))
          (COND
             ((ILESSP (SETQ THISNAMELENGTH (\BIN STREAM))
                     TARGETLENGTH)
              (GO NEXT)))
          (SETQ L NAMECHARS)
      READ
          (COND
             ((NULL L)                                       (* ; 
                                      "Exhausted the pattern before finding a mismatch, so take it")
              (RPLACA TLIST NEXT)
              (RETURN (IDIFFERENCE THISNAMELENGTH TARGETLENGTH)))
             ((EQ (\GETBASEBYTE CASEBASE (\BIN STREAM))
                  (CAR L))
              (SETQ L (CDR L))
              (GO READ))
             (T (GO NEXT])

(\M44UNPACKFILENAME
  [LAMBDA (NAME DEV CREATEFLG)                           (* ; "Edited 21-Jan-91 23:47 by jds")

    (* ;; "Unpacks file name into a UNAME whose VERSION is the version indicator (either a positive integer or one of OLD, OLDEST, NEW);  PARTNAME is the name of DEV.  UCASECHARS is a list of uppercase charcodes from the name.  If CREATEFLG is true, also sets ORIGCHARS to be list of original char codes, for sake of setting real file name")

    (PROG ((CASEBASE (.DISKCASEARRAY.))
           (NC 0)
           J C UPC END ORIGEND VERSION RESULT DOTPREV ORIGDOTPREV EXCESS TAIL)
          (COND
             ((OR (NOT NAME)
                  (EQ NAME T)
                  (NOT (OR (LITATOM NAME)
                           (STRINGP NAME)))
                  (NEQ (NTHCHARCODE NAME 1)
                       (CHARCODE {))
                  (NOT (SETQ J (STRPOS "}" NAME 5)))
                  (EQ (NTHCHARCODE NAME (add J 1))
                      (CHARCODE <)))

              (* ;; "Name is not a non-null string/atom, or doesn't have a host on front, or { is mismatched, or there's a directory.  There used to be some junk in here about passing back a different value if the name had a directory than if it was otherwise malformed, but we really have no use for that.")

              (RETURN NIL)))
          [SETQ END (fetch (UNAME UCASECHARHEAD) of (SETQ RESULT (create UNAME
                                                                                PARTNAME _
                                                                                (fetch DEVICENAME
                                                                                   of DEV]
                                                             (* ; 
                                                        "End is the cell whose CDR can be smashed.")
          (SETQ ORIGEND (fetch (UNAME ORIGCHARHEAD) of RESULT))
      COLLECTNAME
          (COND
             ((NOT (SETQ C (NTHCHARCODE NAME J)))            (* ; "End of name")
              (GO RET))
             ((EQ (SETQ UPC (\GETBASEBYTE CASEBASE C))
                  0)                                         (* ; "Illegal char")
              (GO ERR))
             (T [RPLACD END (SETQ END (LIST (SELCHARQ UPC
                                                 (; (GO SEMI))
                                                 ((%# *)     (* ; "Wildcards not allowed")
                                                      (GO ERR))
                                                 (%.         (* ; "Omit trailing dots")
                                                     (PROG1 (SELCHARQ (NTHCHARCODE NAME (ADD1 J))
                                                                 (NIL (GO RET))
                                                                 ((; !) 
                                                                      (add J 1)
                                                                      (GO SEMI))
                                                                 UPC)
                                                         (SETQ DOTPREV END)
                                                             (* ; 
                                                   "Save tail position here in case name gets long")
                                                         (AND CREATEFLG (SETQ ORIGDOTPREV ORIGEND))))
                                                 UPC]
                [COND
                   (CREATEFLG                                (* ; "Save orig chars as well")
                          (RPLACD ORIGEND (SETQ ORIGEND (LIST C]
                (add J 1)
                (add NC 1)
                (GO COLLECTNAME)))
      SEMI
          

     (* ;; "Parsing the stuff after the semicolon;  we only accept version, though we do accept the funny symbolic versions H, L and N.")

          (COND
             ([NULL (SETQ C (NTHCHARCODE NAME (add J 1]
              (GO RET))
             ((EQ (SETQ C (\GETBASEBYTE CASEBASE C))
                  0)                                         (* ; "Illegal char")
              (GO ERR)))
          (SELCHARQ C
               (H (SETQQ VERSION OLD))
               (L (SETQQ VERSION OLDEST))
               (N (SETQQ VERSION NEW))
               (GO COLLECTVERSION))
          (if (EQ J (NCHARS NAME))
              then                                       (* ; "Done")
                    (GO RET)
            else                                         (* ; "Malformed name")
                  (GO ERR))
      COLLECTVERSION
          (SETQ VERSION 0)
          [while (AND C (BETWEEN C (CHARCODE 0)
                                   (CHARCODE 9))) do [SETQ VERSION (+ (TIMES VERSION 10)
                                                                          (- C (CHARCODE 0]
                                                        (SETQ C (NTHCHARCODE NAME (add J 1]
          (COND
             ((EQ VERSION 0)
              (SETQQ VERSION OLD))
             ((IGREATERP VERSION 65535)
              (GO ERR)))
          (if (NULL C)
              then                                       (* ; "end of name ok")
                    (GO RET))
      ERR                                                    (* ; "BAD FILE NAME")
          (RETURN NIL)
      RET (replace (UNAME VERSION) of RESULT with VERSION)
          [if (> (SETQ EXCESS (- NC (- \MAX.ALTO.NAME.LENGTH 7)))
                     0)
              then

              (* ;; "Hmm, is name too long?  7 counts for a possible !, 5 version chars and the final dot.  This is unnecessarily restrictive for names with shorter versions, but it would get quite untidy if you let version 9 squeak in and then complain or shorten on 10.  So best to shorten now.  We prefer to leave the extension intact, since that can convey info, and shorten the name.")

              [if DOTPREV
                  then (SETQ DOTPREV (CDR DOTPREV))      (* ; "Now (CAR DOTPREV) is the period")
                        (SETQ ORIGDOTPREV (CDR ORIGDOTPREV))
                        (if (CDR (SETQ TAIL (CL:NTHCDR 10 DOTPREV)))
                            then                         (* ; 
             "Extension longer than 10 chars (this allows, e.g., INTERPRESS), so let's shorten it.")
                                  (if (<= (SETQ NC (LENGTH (CDR TAIL)))
                                              EXCESS)
                                      then               (* ; "Chop off the entire excess")
                                            (RPLACD TAIL NIL)
                                            (if CREATEFLG
                                                then (RPLACD (CL:NTHCDR 10 ORIGDOTPREV)
                                                                NIL))
                                            (SETQ EXCESS (- EXCESS NC))
                                    else                 (* ; "only have to get rid of some")
                                          (RPLACD (CL:NTHCDR (- NC EXCESS)
                                                         TAIL)
                                                 NIL)
                                          (if CREATEFLG
                                              then (RPLACD (CL:NTHCDR (+ 10 (- NC EXCESS))
                                                                      ORIGDOTPREV)
                                                              NIL))
                                          (SETQ EXCESS 0]
              (if (> EXCESS 0)
                  then                                   (* ; "Chop away at name")
                        (RPLACD (NLEFT (fetch (UNAME UCASECHARS) of RESULT)
                                       (ADD1 EXCESS)
                                       DOTPREV)
                               DOTPREV)
                        (if CREATEFLG
                            then (RPLACD (NLEFT (fetch (UNAME ORIGCHARS) of RESULT)
                                                    (ADD1 EXCESS)
                                                    ORIGDOTPREV)
                                            ORIGDOTPREV]
          (RETURN RESULT])
)

(RPAQQ \FILENAMECHARSLST (36 43 45 46))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \FILENAMECHARSLST)
)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE

(RECORD UNAME (VERSION . UCASECHARHEAD)
                  (RECORD UCASECHARHEAD (ORIGCHARHEAD . UCASECHARS)
                         (RECORD ORIGCHARHEAD (PARTNAME . ORIGCHARS))))

(RECORD FILESPEC (UNAME FSDIRPTR)
                     [ACCESSFNS FILESPEC ((PNAME (\M44PACKFILENAME (fetch UNAME of DATUM])

(RECORD M44GENFILESTATE (DIROFD SEARCHSTATE GENFILTER GENVERSION HOSTNAME GENSTREAM ENTRYSTART))

(RECORD M44DIRSEARCHSTATE (DIRPTR . CHARLIST))
)

(DECLARE%: EVAL@COMPILE 

(PUTPROPS BETWEEN MACRO (OPENLAMBDA (V LO HI)
                                  (AND (IGEQ V LO)
                                       (ILEQ V HI))))
)
)
(DEFINEQ

(\CREATE.FID.FOR.DD
  [LAMBDA (FDEV)                                         (* ; "Edited 21-Jan-91 23:39 by jds")

    (* ;; "Creates a FID for the file DISKDESCRIPTOR on FDEV, which must be the default disk partition's device")

    (PROG ((FID (create FID)))

     (* ;; "Currently \SYSDISK has a copy of the diskdescriptor fp inside it, as looked up by alto at beginning of world, so be lazy and use that")

          (\BLT (fetch (FID FIDBLOCK) of FID)
                (LOCF (fetch (M44DEVICE DSKDDBLK) of FDEV))
                \LENFP)
          (RETURN FID])

(\OPENDISK
  [LAMBDA (PARTNUM FDEV)                                 (* ; "Edited 21-Jan-91 23:32 by jds")
    (PROG (DSK DD)
          (OR (\TESTPARTITION PARTNUM)
              (RETURN))
          (SETQ DSK (create DSKOBJ))
          (\LOCKWORDS DSK \NWORDS.DSKOBJ)
          (replace (DSKOBJ DSKPARTITION) of DSK with PARTNUM)
          (replace (DSKOBJ ddPOINTER) of DSK with (LOCF (fetch (DSKOBJ ddLASTSERIAL#)
                                                                       of DSK)))
          (replace (DSKOBJ NDISKS) of DSK with 2)
          (replace (DSKOBJ NTRACKS) of DSK with 406)
          (replace (DSKOBJ NHEADS) of DSK with 2)
          (replace (DSKOBJ NSECTORS) of DSK with 14)
          (replace (DSKOBJ RETRYCOUNT) of DSK with 8)
          (replace (DSKOBJ CBQUEUE) of DSK with (fetch (DSKOBJ CBQUEUE) of 
                                                                                            \MAINDISK
                                                                   ))
                                                             (* ; "Really should have our own")
          (RETURN (\OPENDISKDEVICE PARTNUM DSK FDEV])

(\OPENDISKDEVICE
  [LAMBDA (PARTITION DSKOBJ FDEV)                        (* ; "Edited 21-Jan-91 23:43 by jds")
    (DECLARE (GLOBALVARS \MAINDISK))                     (* ; 
                                            "Creates the model 44 DSK device and opens its SYSDIR.")
    (PROG ([NAME (PACK* 'DSK (OR PARTITION (DISKPARTITION]
           FDEV)
          [OR FDEV (SETQ FDEV (\MAKE.PMAP.DEVICE (create FDEV
                                                        DEVICENAME _ NAME
                                                        NODIRECTORIES _ T
                                                        CLOSEFILE _ (FUNCTION \M44CloseFile)
                                                        DELETEFILE _ (FUNCTION \M44DeleteFile)
                                                        GETFILEINFO _ (FUNCTION \M44GetFileInfo)
                                                        GETFILENAME _ (FUNCTION \M44GetFileName)
                                                        OPENFILE _ (FUNCTION \M44OpenFile)
                                                        READPAGES _ (FUNCTION \M44ReadPages)
                                                        SETFILEINFO _ (FUNCTION \M44SetFileInfo)
                                                        TRUNCATEFILE _ (FUNCTION \M44TruncateFile)
                                                        WRITEPAGES _ (FUNCTION \M44WritePages)
                                                        REOPENFILE _ (FUNCTION \M44OpenFile)
                                                        GENERATEFILES _ (FUNCTION \M44GENERATEFILES)
                                                        EVENTFN _ (FUNCTION \M44EVENTFN)
                                                        DIRECTORYNAMEP _ [FUNCTION (LAMBDA (NAME)
                                                             (* ; 
                                                       "Assume host is OK, check that no directory")
                                                                                     (EQ (NTHCHARCODE
                                                                                          NAME -1)
                                                                                         (CHARCODE
                                                                                          }]
                                                        HOSTNAMEP _ (FUNCTION NILL)
                                                        FREEPAGECOUNT _ (FUNCTION \M44FREEPAGECOUNT)
                                                        OPENP _ (FUNCTION \GENERIC.OPENP)
                                                        REGISTERFILE _ (FUNCTION \ADD-OPEN-STREAM)
                                                        UNREGISTERFILE _ (FUNCTION 
                                                                          \GENERIC-UNREGISTER-STREAM]
          (replace (M44DEVICE DSKOBJ) of FDEV with (OR DSKOBJ (SETQ DSKOBJ \MAINDISK)))
          (replace (DSKOBJ DISKDEVICENAME) of DSKOBJ with NAME)
          (RETURN (RESETLST
                      (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (DEV)
                                                       (COND
                                                          ((NOT (fetch (M44DEVICE DSKPASSWORDOK)
                                                                   of DEV))
                                                             (* ; 
                                                           "Oops, it didn't work, take it away")
                                                           (\REMOVEDEVICE DEV]
                                           FDEV))
                      (\DEFINEDEVICE NAME FDEV)              (* ; 
                        "have to define it tentatively first so that \OPENDISKDESCRIPTOR will work")
                      (COND
                         ((\OPENDIR FDEV)
                          (COND
                             ((NULL PARTITION)               (* ; "this is also the default disk")
                              (\DEFINEDEVICE 'DSK FDEV)))
                          FDEV)))])

(\OPENDIR
(LAMBDA (FDEV) (* bvm%: " 6-APR-83 12:16") (* ;; "Opens the model44 directory on the current partition") (PROG ((PART (fetch (M44DEVICE DSKPARTITION) of FDEV)) STREAM DD) (replace (M44DEVICE DSKPASSWORDOK) of FDEV with NIL) (COND ((AND (NEQ PART 0) (NOT (\TESTPARTITION PART))) (replace (M44DEVICE SYSDIROFD) of FDEV with NIL) (RETURN))) (SETQ STREAM (\M44OPENFILEFROMFP FDEV "SYSDIR.;1" (QUOTE BOTH) (create FID W0 _ 32768 W1 _ 100 W2 _ 1 W3 _ 0 W4 _ 1))) (* ; "{DSK}SYSDIR.;1 always has sn 100, leader page on virtual page 1") (replace MAXBUFFERS of STREAM with (IMAX 64 (ADD1 (fetch EPAGE of STREAM)))) (* ; "Enough buffers so that directory is effectively always in core") (replace (M44DEVICE SYSDIROFD) of FDEV with STREAM) (COND ((NEQ PART 0) (SETQ DD (\OPENDISKDESCRIPTOR FDEV)) (\SETFILEPTR DD \OFFSET.DISKLASTSERIAL#) (\BINS DD (LOCF (fetch (M44DEVICE DISKLASTSERIAL#) of FDEV)) 0 \NBYTES.DISKINFO) (add (fetch (M44DEVICE DISKLASTSERIAL#) of FDEV) 3) (* ; "Try to avoid collisions") (COND ((NOT (\M44CHECKPASSWORD FDEV)) (replace (M44DEVICE SYSDIROFD) of FDEV with NIL) (RETURN))))) (replace (M44DEVICE DSKPASSWORDOK) of FDEV with T) (RETURN STREAM)))
)

(\M44CHECKPASSWORD
(LAMBDA (DEV) (* bvm%: "11-Jun-86 12:20") (PROG ((STREAM (\OPENFILE (PACK* (QUOTE {) (fetch (FDEV DEVICENAME) of DEV) "}SYS.BOOT;1") (QUOTE INPUT) (QUOTE OLD))) PASSVECTOR BUF PASSINFO ASKEDONCE NAME N) (COND ((NULL STREAM) (RETURN T))) (SETQ PASSVECTOR (\ALLOCBLOCK (FOLDHI \NWORDS.BCPLPASSWORD WORDSPERCELL))) (SETFILEPTR STREAM \OFFSET.BCPLPASSWORD) (\BINS STREAM PASSVECTOR 0 (UNFOLD \NWORDS.BCPLPASSWORD BYTESPERWORD)) (COND ((EQ (\GETBASE PASSVECTOR 0) 0) (* ; "No password") (\CLOSEFILE STREAM) (RETURN T))) (SETFILEPTR STREAM \OFFSET.BCPLUSERNAME) (SETQ NAME (ALLOCSTRING (SETQ N (\BIN STREAM)))) (* ; "Read in a bcpl string which is the username installed on the disk") (\BINS STREAM (fetch (STRINGP BASE) of NAME) 0 N) (\CLOSEFILE STREAM) (SETQ NAME (MKATOM NAME)) LP (SETQ PASSINFO (\INTERNAL/GETPASSWORD (fetch (FDEV DEVICENAME) of DEV) ASKEDONCE NIL NIL NAME)) (COND ((NULL PASSINFO) (RETURN NIL))) (COND ((UNINTERRUPTABLY (SETQ BUF (\GETPACKETBUFFER)) (* ; "HORRIBLE CHEAP TRICK to get some emulator space") (\BLT (\ADDBASE BUF 64) PASSVECTOR \NWORDS.BCPLPASSWORD) (SetBcplString (\ADDBASE BUF (IPLUS 64 \NWORDS.BCPLPASSWORD)) (\DECRYPT.PWD (CDR PASSINFO))) (\CHECKBCPLPASSWORD (\ADDBASE BUF (IPLUS 64 \NWORDS.BCPLPASSWORD)) (\ADDBASE BUF 64))) (RETURN T)) (T (SETQ ASKEDONCE T) (GO LP)))))
)

(\M44HOSTNAMEP
(LAMBDA (NAME DEV) (* bvm%: "20-Nov-84 16:06") (PROG (PARTNUM) (RETURN (COND ((EQ NAME (QUOTE DSK)) (\OPENDISKDEVICE)) ((AND (STRPOS (QUOTE DSK) NAME 1 NIL T) (SETQ PARTNUM (FIXP (SUBATOM NAME 4))) (\TESTPARTITION PARTNUM)) (COND ((EQ PARTNUM (DISKPARTITION)) (RETURN (\GETDEVICEFROMNAME (QUOTE DSK)))) (T (\OPENDISK PARTNUM))))))))
)
)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(RPAQQ \OFFSET.BCPLUSERNAME 512)

(RPAQQ \OFFSET.BCPLPASSWORD 768)

(RPAQQ \NWORDS.BCPLPASSWORD 9)


(CONSTANTS \OFFSET.BCPLUSERNAME \OFFSET.BCPLPASSWORD \NWORDS.BCPLPASSWORD)
)
)



(* ;; "SYSOUT etc.")

(DEFINEQ

(\COPYSYS1
(LAMBDA (STREAM LASTPAGE) (* ; "Edited 21-Aug-88 13:54 by bvm") (COND ((AND (type? M44DEVICE (fetch DEVICE of STREAM)) (EQ (fetch DEVICENAME of (fetch DEVICE of STREAM)) (QUOTE DSK))) (ERROR "Sysout to Dorado login partition no longer supported."))) (PROG ((ACTONVMEMFN \VMEMACCESSFN) (PAGEMAPPED (fetch PAGEMAPPED of (fetch DEVICE of STREAM))) (NBUFS (SUB1 \#EMUBUFFERS)) (BUFBASE \EMUBUFFERS) (FIRSTPAGE 2) (CURSORBAR \EM.CURSORBITMAP) (CURSORMASK (LLSH 1 (SUB1 BITSPERWORD))) (DOMINOPAGE (fetch LastDominoFilePage of \InterfacePage)) (DAYBREAKP (EQ \MACHINETYPE \DAYBREAK)) CURSORINC CURSORNEXT NPAGES BUFFERS) (* ;; "Strategy is to copy from the vmem file to STREAM --- The vmem file is read with \ACTONVMEMFILE to finesse the differences among machines.  As buffers we use the set of pre-allocated swap buffers, reducing the number available for swapping to a bare minimum of one.  If STREAM is pagemapped, we take advantage of knowledge of pagemapped streams to write these buffers directly to the destination stream, which saves the copying that would occur if we just generically used \BOUTS for all streams.  In the case of Mod44 DSK, this also lets us use more buffers at a time, because DSK can write directly from the buffers we use for reading the vmem, rather than copying into its own buffers") (RESETSAVE \#SWAPBUFFERS 1) (* ; "Reduce us to one swap buffer, so we can use the rest for copying the vmem") (RESETSAVE \EMUSWAPBUFFERS (\ADDBASE BUFBASE (UNFOLD NBUFS WORDSPERPAGE))) (RESETSAVE \#DISKBUFFERS (COND ((type? M44DEVICE (fetch DEVICE of STREAM)) (* ; "DSK code needs 1 extra buffer beyond the ones we give to \WRITEPAGES") (SETQ NBUFS (SUB1 NBUFS)) (SETQ BUFBASE (\ADDBASE BUFBASE WORDSPERPAGE)) 1) (T 0))) (SETQ BUFFERS (to NBUFS as (BUF _ BUFBASE) by (\ADDBASE BUF WORDSPERPAGE) collect BUF)) (SETQ CURSORINC (SETQ CURSORNEXT (FOLDLO LASTPAGE (ITIMES 16 16)))) (* ; "How often to do something to the cursor") (COND ((EQ DOMINOPAGE 0) (* ; "First page to write is the ISF map page, which should be blank in a sysout") (\CLEARWORDS BUFBASE WORDSPERPAGE)) (T (CL:FUNCALL ACTONVMEMFN DOMINOPAGE BUFBASE 1))) (COND (PAGEMAPPED (replace EPAGE of STREAM with LASTPAGE) (* ; "Set up end of file correctly.  LASTPAGE is last alto page (full), which is last Lisp page plus 1") (replace EOFFSET of STREAM with 0) (\WRITEPAGES STREAM 0 (CAR BUFFERS))) (T (\BOUTS STREAM (CAR BUFFERS) 0 BYTESPERPAGE))) (while (<= FIRSTPAGE LASTPAGE) do (COND ((>= FIRSTPAGE CURSORNEXT) (* ; "Gradually complement the cursor") (\PUTBASE CURSORBAR 0 (LOGXOR (\GETBASE CURSORBAR 0) CURSORMASK)) (COND (DAYBREAKP (\DoveDisplay.SetCursorShape))) (add CURSORNEXT CURSORINC) (COND ((EQ (SETQ CURSORMASK (LRSH CURSORMASK 1)) 0) (SETQ CURSORBAR (\ADDBASE CURSORBAR 1)) (SETQ CURSORMASK (LLSH 1 (SUB1 BITSPERWORD))))))) (CL:FUNCALL ACTONVMEMFN FIRSTPAGE BUFBASE (SETQ NPAGES (IMIN NBUFS (ADD1 (- LASTPAGE FIRSTPAGE))))) (* ; "Read NBUFS pages from vmem, then write them to output") (COND ((NOT PAGEMAPPED) (* ; "Have to just ship the bits") (\BOUTS STREAM BUFBASE 0 (UNFOLD NPAGES BYTESPERPAGE))) (T (\WRITEPAGES STREAM (SUB1 FIRSTPAGE) (COND ((< NPAGES NBUFS) BUFFERS) (T (* ; "Don't write too many pages on the last pass if NPAGES is less than length of BUFFERS") (to NPAGES as BUF in BUFFERS collect BUF)))))) (add FIRSTPAGE NPAGES)) (RETURN NIL)))
)
)



(* ;; "For MAIKO. \COPYSYS use UNIX-PAGEPERBLOCK.")

(DEFINEQ

(\MAIKO.CHECKFREESPACE
(LAMBDA (FILENAME) (* ; "Edited  1-Apr-90 18:24 by nm") (DECLARE (GLOBALVARS \LDEDESTOVERWRITE \DSKdevice)) (LET ((LASTPAGE (fetch (IFPAGE NActivePages) of \InterfacePage)) (BUFFER (CREATECELL \FIXP)) FULLNAME FILESIZE FREEPAGES HOST) (* ;; "FULLNAME is  UNIX/DSK format pathname with UNIX/DSK. And type is string.") (SETQ FULLNAME (if (NULL FILENAME) then (SETQ HOST (QUOTE DSK)) (\UFS.RECOGNIZE.FILE (CONCAT "{" HOST "}" (OR (UNIX-GETENV "LDEDESTSYSOUT") "~/lisp.virtualmem")) (QUOTE NON) (\GETDEVICEFROMNAME HOST)) else (SETQ HOST (U-CASE (FILENAMEFIELD FILENAME (QUOTE HOST)))) (\UFS.RECOGNIZE.FILE FILENAME (QUOTE NON) (\GETDEVICEFROMNAME HOST)))) (SETQ FULLNAME (CONCAT "{" HOST "}" FULLNAME)) (* ;; "get current free space") (OR (\UFSGetFreeBlock-C FULLNAME BUFFER) (LISPERROR "FILE NOT FOUND" FULLNAME)) (if (IGREATERP LASTPAGE (SETQ FREEPAGES (ITIMES BUFFER LISPPAGE-PER-UNIXBLOCK))) then (* ;; "not enough free space ") (if \LDEDESTOVERWRITE then (* ;; "if possible, try to overwrite") (OR (INFILEP FULLNAME) (CL:ERROR (QUOTE XCL:FS-RESOURCES-EXCEEDED) :PATHNAME FULLNAME)) (* ;; "file exist, check file size") (SETQ FILESIZE (GETFILEINFO FULLNAME (QUOTE SIZE))) (if (IGREATERP LASTPAGE (IPLUS FILESIZE FREEPAGES)) then (* ;; "also, not ehough space") (CL:ERROR (QUOTE XCL:FS-RESOURCES-EXCEEDED) :PATHNAME FULLNAME) else (* ;; "Remove file, then get enoght space to save") (DELFILE FULLNAME)) else (CL:ERROR (QUOTE XCL:FS-RESOURCES-EXCEEDED) :PATHNAME FULLNAME)))))
)
)

(RPAQ? \LDEDESTOVERWRITE NIL)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(RPAQQ LISPPAGE-PER-UNIXBLOCK 2)


(CONSTANTS (LISPPAGE-PER-UNIXBLOCK 2))
)
)



(* ;; 
"Stats code.  On MOD44IO because it writes on the disk and uses records not exported from MOD44IO.  (For this and other reasons, GATHERSTATS only works on Dorados.)"
)

(DEFINEQ

(GATHERSTATS
  [LAMBDA (FILENAME)                                     (* ; "Edited 21-Jan-91 23:33 by jds")

    (* ;; "Enables and disables statistics gathering.  Uses low level file operations to avoid stats file being visible from Lisp b/c the file position is not updated as it is written")

    (DECLARE (GLOBALVARS \STATSON))
    (COND
       ((NEQ \MACHINETYPE \DORADO)
        (ERROR "Stats not implemented for this type of machine" FILENAME))
       [FILENAME (AND \STATSON (GATHERSTATS))
              (SELECTQ (FILENAMEFIELD FILENAME 'HOST)
                  (DSK)
                  (NIL (SETQ FILENAME (PACKFILENAME.STRING 'HOST 'DSK 'BODY FILENAME)))
                  (ERROR "Stats file must be on DSK" FILENAME))
              (SETQ \STATSON T)
              (\GATHERSTATS (PROG [(STREAM (\OPENFILE FILENAME 'OUTPUT 'NEW]
                                                             (* ; 
                "CLose before doing stats, cause file isn't really open from Lisp's point of view.")
                                  (RETURN (fetch (ARRAYP BASE)
                                             of (fetch (M44STREAM FID)
                                                       of (PROG1 STREAM
                                                                  (\CLOSEFILE STREAM)
                                                                  (\M44FLUSHDISKDESCRIPTOR
                                                                   (fetch DEVICE of STREAM))
                                                                  (replace (DSKOBJ DDVALID)
                                                                     of (fetch DEVICE
                                                                               of STREAM)
                                                                     with NIL))]
       (\STATSON (\GATHERSTATS)
              (SETQ \STATSON NIL])
)

(RPAQQ \STATSON NIL)
(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)


(FILESLOAD (LOADCOMP)
       LLBFS)
)
(PUTPROPS MOD44IO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989 
1990 1991 2021))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (3982 65711 (\M44AddDiskPages 3992 . 5260) (\M44CloseFile 5262 . 5569) (\M44CompleteFH 
5571 . 9985) (\M44CREATEFILE 9987 . 15917) (\M44DeleteFile 15919 . 17008) (\M44EVENTFN 17010 . 21387) 
(\M44ExtendFilePageMap 21389 . 23440) (\M44FillInMap 23442 . 25792) (\M44GetFileHandle 25794 . 27898) 
(\M44GetFileInfo 27900 . 32083) (\M44GETDATEPROP 32085 . 32567) (\M44GetFileName 32569 . 33006) (
\M44GetPageLoc 33008 . 33809) (\M44KillFilePageMap 33811 . 34182) (\M44MAKEDIRENTRY 34184 . 35915) (
\M44OpenFile 35917 . 42050) (\M44OPENFILEFROMFP 42052 . 43080) (\M44ReadDiskPage 43082 . 45309) (
\M44ReadLeaderPage 45311 . 46763) (\M44ReadPages 46765 . 46982) (\M44SetAccessTimes 46984 . 48269) (
\M44SetEndOfFile 48271 . 49762) (\M44SetFileInfo 49764 . 51018) (\M44SETFILETYPE 51020 . 53633) (
\M44TruncateFile 53635 . 55088) (\M44WriteDiskPage 55090 . 59312) (\M44WriteLeaderPage 59314 . 60172) 
(\M44WritePages 60174 . 62558) (\M44WritePages1 62560 . 65709)) (65745 78564 (\ADDDISKPAGES 65755 . 
67568) (\M44DELETEPAGES 67570 . 71612) (\ASSIGNDISKPAGE 71614 . 74866) (\COUNTDISKFREEPAGES 74868 . 
75405) (\M44MARKPAGEFREE 75407 . 76107) (\M44FLUSHDISKDESCRIPTOR 76109 . 77051) (\MAKELEADERDAS 77053
 . 77764) (DISKFREEPAGES 77766 . 78112) (\M44FREEPAGECOUNT 78114 . 78562)) (81717 96018 (
\M44GENERATEFILES 81727 . 84647) (\M44SORTFILES 84649 . 85026) (\M44GENERATENEXT 85028 . 90673) (
\M44NEXTFILEFN 90675 . 91938) (\M44SORTEDNEXTFILEFN 91940 . 94063) (\M44FILEINFOFN 94065 . 96016)) (
96062 121329 (\M44PARSEFILENAME 96072 . 104104) (\FINDDIRHOLE 104106 . 106089) (\M44PACKFILENAME 
106091 . 106721) (\M44READVERSION 106723 . 107149) (\OPENDISKDESCRIPTOR 107151 . 109258) (
\M44READDIRFID 109260 . 109696) (\M44READDIRNAME 109698 . 110128) (\M44SEARCHDIR 110130 . 112871) (
\M44UNPACKFILENAME 112873 . 121327)) (122158 131181 (\CREATE.FID.FOR.DD 122168 . 122773) (\OPENDISK 
122775 . 124064) (\OPENDISKDEVICE 124066 . 128315) (\OPENDIR 128317 . 129493) (\M44CHECKPASSWORD 
129495 . 130824) (\M44HOSTNAMEP 130826 . 131179)) (131450 134817 (\COPYSYS1 131460 . 134815)) (134878 
136394 (\MAIKO.CHECKFREESPACE 134888 . 136392)) (136742 138730 (GATHERSTATS 136752 . 138728)))))
STOP
\ No newline at end of file
diff --git a/sources/MOD44IO.LCOM b/sources/MOD44IO.LCOM
index a940dcb9..9b2759c6 100644
Binary files a/sources/MOD44IO.LCOM and b/sources/MOD44IO.LCOM differ
