(FILECREATED " 4-MAY-82 21:48:22" <BLISP>VMEM.;30 9861
changes to: VBIN1 VBIN2 SETVMPTR VMEMCOMS NOPAGE PRINTVM ENDVMPRINT
previous date: "19-DEC-81 00:23:40" <BLISP>VMEM.;29)
(* Copyright (c) 1982 by Xerox Corporation)
(PRETTYCOMPRINT VMEMCOMS)
(RPAQQ VMEMCOMS ((FNS INITVMEM REOPENVMFILE VVAG2)
(VARS (VMEMFILE))
(FNS VGETBASE0 VPUTBASE0 VGETBASEPTR0 VPUTBASEPTR0 INVALIDADDR)
(MACROS VPAGEBASE VADDBASE VHILOC VVAG2 VGETBASEBYTE VLOLOC VPAGELOC VGETBASE
VPUTBASE VGETBASEPTR VPUTBASEPTR)
(COMS (FNS PRINTVM ENDVMPRINT)
(DECLARE: DONTCOPY (CONSTANTS NOPAGE)))
(FNS OPENVMFILE UNMAPVM CLOSEVMEMFILE MAPVMPAGE VBIN1 VBOUT1 VBIN2 VBOUT2)
[DECLARE: EVAL@COMPILE DONTCOPY (PROP MACRO VBIN1 VBIN2)
DONTEVAL@LOAD
(P (OR (SELECTQ (AND (GETD (QUOTE COMPILEMODE))
(COMPILEMODE))
((ALTO D)
T)
NIL)
(FILESLOAD (LOADCOMP)
DCODEFOR10]
(FNS SETVMPTR VMPAGEP)
(ADDVARS (VMEMVARS (PGEMPTY (FIXPARRAY 400Q))
(PGTAB (POINTERARRAY 400Q PGEMPTY))
(RDSYSINIT T)))
(GLOBALVARS PGTAB PGEMPTY VMEMFILEX VMEMFILE FIRSTPMT)))
(DEFINEQ
(INITVMEM
[LAMBDA (FILE WRITEABLE) (* lmm "19-DEC-81 00:22")
(AND (NLISTP VMEMFILE)
(CLOSEF? VMEMFILE))
(COND
((LITATOM FILE)
(SETQ FILE (OPENVMFILE (OR FILE (QUOTE LISP.SYSOUT))
WRITEABLE))
(SETQ VMOUTFILEX (AND WRITEABLE VMEMFILEX))
[for X in VMEMVARS do (OR (BOUNDP (CAR X))
(SET (CAR X)
(EVAL (CADR X]
(UNMAPVM) (* Read the pagemap pages and record the page addresses.)
(VREADPAGEMAP))
(T (CLEARPAGECACHE)
(SETQ VMEMFILE (LIST (QUOTE PMAP)
(FUNCTION REMOTEPMAP)
FILE])
(REOPENVMFILE
[LAMBDA (FILE WRITEABLE) (* lmm "19-DEC-81 00:20")
[SETQ VMEMFILEX (GETOFD (SETQ VMEMFILE (OPENFILE FILE (COND
(WRITEABLE (QUOTE BOTH))
(T (QUOTE INPUT)))
(QUOTE OLD)
8]
VMEMFILE])
(VVAG2
[LAMBDA (HI LO) (* lmm " 9-MAR-81 09:34")
(* DOESN'T BELONG HERE, BUT ON MEM! INCLUDED BECAUSE REMOTE-PRINTCODE CALLS VVAG2
BUT DIDN'T IMPORT MEM)
([LAMBDA (X)
(DECLARE (LOCALVARS . T))
(COND
((ZEROP X)
NIL)
(T X]
(IPLUS (LLSH HI 16)
LO])
)
(RPAQQ VMEMFILE NIL)
(DEFINEQ
(VGETBASE0
[LAMBDA (PTR) (* lmm "20-AUG-81 16:43")
(COND
((NLISTP VMEMFILE)
(SETVMPTR PTR)
(VBIN2))
(T (WORDCONTENTS (WORDOFFSET (VMAPPAGE (LRSH PTR 10Q))
(LOGAND PTR 377Q])
(VPUTBASE0
[LAMBDA (PTR VALUE) (* lmm "20-AUG-81 16:43")
(COND
((NLISTP VMEMFILE)
(SETVMPTR PTR)
(VBOUT2 VALUE))
(T (SETWORDCONTENTS (WORDOFFSET (VMAPPAGE (LRSH PTR 10Q))
(LOGAND PTR 377Q))
VALUE)
(REMOTESETWORD PTR VALUE)))
VALUE])
(VGETBASEPTR0
[LAMBDA (PTR) (* lmm " 8-SEP-81 23:12")
(AND [NOT (ZEROP (SETQ PTR (COND
((NLISTP VMEMFILE)
(SETVMPTR PTR)
(VBIN1)
(VVAG2 (VBIN1)
(VBIN2)))
(T (VVAG2 [LOGAND 255 (WORDCONTENTS (SETQ PTR
(WORDOFFSET (VMAPPAGE (LRSH PTR 8))
(LOGAND 255 PTR]
(WORDCONTENTS (WORDOFFSET PTR 1]
PTR])
(VPUTBASEPTR0
[LAMBDA (PTR VALUE) (* lmm "20-AUG-81 16:43")
(COND
((NLISTP VMEMFILE)
(SETVMPTR PTR)
(VBOUT2 (VHILOC VALUE))
(VBOUT2 (VLOLOC VALUE)))
(T (PROG (WORD)
(SETWORDCONTENTS (SETQ WORD (WORDOFFSET (VMAPPAGE (LRSH PTR 10Q))
(LOGAND PTR 377Q)))
(VHILOC VALUE))
(SETWORDCONTENTS (WORDOFFSET WORD 1)
(VLOLOC VALUE))
(REMOTESETWORD PTR (VHILOC VALUE))
(REMOTESETWORD (ADD1 PTR)
(VLOLOC VALUE))
(RETURN VALUE])
(INVALIDADDR
[LAMBDA (PTR) (* lmm " 9-MAR-81 22:04")
(HELP "INVALID ADDR" PTR])
)
(DECLARE: EVAL@COMPILE
(PUTPROPS VPAGEBASE MACRO ((PTR)
(LOGAND PTR -400Q)))
(PUTPROPS VADDBASE MACRO ((PTR D)
(IPLUS PTR D)))
(PUTPROPS VHILOC MACRO ((PTR)
(LRSH (OR PTR 0)
20Q)))
(PUTPROPS VVAG2 MACRO ((HI LO)
(IPLUS (LLSH HI 20Q)
LO)))
(PUTPROPS VGETBASEBYTE MACRO [LAMBDA (PTR N)
(* lmm " 9-MAR-81 09:49")
(COND
((ZEROP (LOGAND N 1))
(LRSH (VGETBASE PTR (LRSH N 1))
10Q))
(T (LOGAND 377Q (VGETBASE PTR (LRSH N 1])
(PUTPROPS VLOLOC MACRO ((PTR)
(LOGAND (OR PTR 0)
177777Q)))
(PUTPROPS VPAGELOC MACRO ((PTR)
(LRSH (OR PTR 0)
10Q)))
(PUTPROPS VGETBASE MACRO ((PTR D)
(VGETBASE0 (VADDBASE PTR D))))
(PUTPROPS VPUTBASE MACRO ((PTR D VAL)
(VPUTBASE0 (VADDBASE PTR D)
VAL)))
(PUTPROPS VGETBASEPTR MACRO ((PTR D)
(VGETBASEPTR0 (VADDBASE PTR D))))
(PUTPROPS VPUTBASEPTR MACRO ((PTR D VALUE)
(VPUTBASEPTR0 (VADDBASE PTR D)
VALUE)))
)
(DEFINEQ
(PRINTVM
[LAMBDA NIL (* lmm " 4-MAY-82 21:09")
(PROG ((LASTSEG NOPAGE)
(LASTPAGE NOPAGE)
LASTE FIRSTE)
[for SEG from 0 to 377Q bind P
do (OR (EQ (SETQ P (FASTELT PGTAB SEG))
PGEMPTY)
(for PAGE from 0 to 377Q bind E do (COND
((NEQ (SETQ E (FASTELTN P PAGE))
0)
(COND
((NOT (IEQ SEG LASTSEG))
(ENDVMPRINT)
(printout T T "segment " (SETQ LASTSEG
SEG)
T)))
(COND
((OR (NOT (IEQ (SUB1 PAGE)
LASTPAGE))
(NOT (IEQ (SUB1 E)
LASTE)))
(ENDVMPRINT)
(printout T PAGE)
(SETQ FIRSTE E)))
(SETQ LASTPAGE PAGE)
(SETQ LASTE E]
(ENDVMPRINT])
(ENDVMPRINT
[LAMBDA NIL (* lmm " 4-MAY-82 21:47")
(COND
((NOT (IEQ LASTPAGE NOPAGE))
(COND
((IEQ FIRSTE LASTE)
(printout T 12Q (COND
((IGEQ FIRSTE 100000Q)
(SETQ FIRSTE (LOGAND FIRSTE 77777Q))
(SETQ LASTE (LOGAND LASTE 77777Q))
"*")
(T " "))
FIRSTE T))
(T (printout T "-" LASTPAGE 12Q (COND
((IGEQ FIRSTE 100000Q)
(SETQ FIRSTE (LOGAND FIRSTE 77777Q))
(SETQ LASTE (LOGAND LASTE 77777Q))
"*")
(T " "))
FIRSTE "-" LASTE T)))
(SETQ LASTPAGE NOPAGE])
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ NOPAGE -2)
(CONSTANTS NOPAGE)
)
)
(DEFINEQ
(OPENVMFILE
[LAMBDA (NAME WRITEABLE) (* lmm "19-DEC-81 00:21")
(WHENCLOSE (REOPENVMFILE NAME WRITEABLE)
(QUOTE CLOSEALL)
(QUOTE NO)
(QUOTE AFTER)
(QUOTE CLOSEVMEMFILE)
(QUOTE STATUS)
(FUNCTION (LAMBDA (FILE)
(LIST (QUOTE REOPENVMFILE)
FILE
(OPENP FILE (QUOTE BOTH])
(UNMAPVM
[LAMBDA NIL (* lmm " 3-AUG-80 22:12")
(for I from 0 to 255 bind P do (OR (EQ (SETQ P (FASTELT PGTAB I))
PGEMPTY)
(for J from 0 to 255 do (FASTSETAN P J 0])
(CLOSEVMEMFILE
[LAMBDA NIL (* lmm " 9-MAR-81 22:40")
(AND (NLISTP VMEMFILE)
(CLOSEF? VMEMFILE))
(SETQ VMEMFILE])
(MAPVMPAGE
[LAMBDA (VP PAGE) (* lmm "21-AUG-81 22:38")
(* Associate virtual page VP with page PAGE of the vmem file)
(PROG ((A (LRSH VP 8))
(B (LOGAND VP 255))
D)
[COND
((EQ (SETQ D (FASTELT PGTAB A))
PGEMPTY)
(FASTSETA PGTAB A (SETQ D (FIXPARRAY 256]
(FASTSETAN D B PAGE])
(VBIN1
[LAMBDA NIL (* lmm " 7-MAY-81 20:36")
(\BIN VMEMFILEX])
(VBOUT1
[LAMBDA (BYTE) (* lmm "16-MAY-81 16:52")
(\BOUT (OR VMOUTFILEX (ERROR "Can't write on " VMEMFILE))
BYTE])
(VBIN2
[LAMBDA NIL
(IPLUS (LLSH (VBIN1)
10Q)
(VBIN1])
(VBOUT2
[LAMBDA (VALUE) (* lmm "19-MAR-81 12:24")
(VBOUT1 (LRSH VALUE 10Q))
(VBOUT1 (LOGAND VALUE 377Q))
VALUE])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(PUTPROPS VBIN1 MACRO (NIL (\BIN VMEMFILEX)))
(PUTPROPS VBIN2 MACRO (NIL (IPLUS (LLSH (VBIN1)
10Q)
(VBIN1))))
DONTEVAL@LOAD
(OR (SELECTQ (AND (GETD (QUOTE COMPILEMODE))
(COMPILEMODE))
((ALTO D)
T)
NIL)
(FILESLOAD (LOADCOMP)
DCODEFOR10))
)
(DEFINEQ
(SETVMPTR
[LAMBDA (PTR) (* lmm " 4-MAY-82 20:42")
(* Positions VMEMFILE to start reading at virtual address PTR, and sets
VMBYTESLEFT to the number of bytes left on the page.)
(PROG ((A (FASTELT PGTAB (VHILOC PTR)))
(J (LRSH (VLOLOC PTR)
10Q))) (* The multiple FASTELTNs are to avoid boxing)
[COND
((IEQP (FASTELTN A J)
0)
(INVALIDADDR (IPLUS PTR 0]
(SETFILEPTR VMEMFILE (IPLUS (LLSH (LOGAND (FASTELTN A J)
77777Q)
11Q)
(LLSH (LOGAND (VLOLOC PTR)
377Q)
1])
(VMPAGEP
[LAMBDA (VP) (* lmm " 2-AUG-80 16:07")
(NOT (IEQP (FASTELTN (FASTELT PGTAB (LRSH VP 8))
(LOGAND VP 255))
0])
)
(ADDTOVAR VMEMVARS (PGEMPTY (FIXPARRAY 400Q))
(PGTAB (POINTERARRAY 400Q PGEMPTY))
(RDSYSINIT T))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS PGTAB PGEMPTY VMEMFILEX VMEMFILE FIRSTPMT)
)
(DECLARE: DONTCOPY (PUTPROPS VMEM COPYRIGHT ("Xerox Corporation" 3676Q)))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1145 2387 (INITVMEM 1155 . 1760) (REOPENVMFILE 1762 . 2030) (VVAG2 2032 . 2385)) (2414
4110 (VGETBASE0 2424 . 2685) (VPUTBASE0 2687 . 3015) (VGETBASEPTR0 3017 . 3432) (VPUTBASEPTR0 3434 .
3996) (INVALIDADDR 3998 . 4108)) (5167 6628 (PRINTVM 5177 . 6053) (ENDVMPRINT 6055 . 6626)) (6720 8396
(OPENVMFILE 6730 . 7082) (UNMAPVM 7084 . 7338) (CLOSEVMEMFILE 7340 . 7493) (MAPVMPAGE 7495 . 7879) (
VBIN1 7881 . 8004) (VBOUT1 8006 . 8155) (VBIN2 8157 . 8235) (VBOUT2 8237 . 8394)) (8726 9552 (SETVMPTR
8736 . 9387) (VMPAGEP 9389 . 9550)))))
STOP
770Q)) (21526Q 23251Q (SETVMPTR 21542Q . 22775Q) (
VMPAGEP 23001Q . 23246Q)))))
STOP