(FILECREATED "13-Jul-84 18:00:13" {ERIS}<LISPCORE>SOURCES>VMEM.;2 9913
changes to: (FNS INITVMEM CLOSEVMEMFILE)
previous date: " 4-MAY-82 21:48:22" {ERIS}<LISPCORE>SOURCES>VMEM.;1)
(* Copyright (c) 1982, 1984 by Xerox Corporation. All rights reserved.)
(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 256))
(PGTAB (POINTERARRAY 256 PGEMPTY))
(RDSYSINIT T)))
(GLOBALVARS PGTAB PGEMPTY VMEMFILEX VMEMFILE FIRSTPMT)))
(DEFINEQ
(INITVMEM
[LAMBDA (FILE WRITEABLE) (* bvm: "13-Jul-84 17:15")
(COND
(VMEMFILE (CLOSEVMEMFILE)))
(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 (OPENREMOTEVMEMFILE (CAR 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 -256)))
(PUTPROPS VADDBASE MACRO ((PTR D)
(IPLUS PTR D)))
(PUTPROPS VHILOC MACRO ((PTR)
(LRSH (OR PTR 0)
16)))
(PUTPROPS VVAG2 MACRO ((HI LO)
(IPLUS (LLSH HI 16)
LO)))
(PUTPROPS VGETBASEBYTE MACRO [LAMBDA (PTR N) (* lmm " 9-MAR-81 09:49")
(COND
((ZEROP (LOGAND N 1))
(LRSH (VGETBASE PTR (LRSH N 1))
8))
(T (LOGAND 255 (VGETBASE PTR (LRSH N 1])
(PUTPROPS VLOLOC MACRO ((PTR)
(LOGAND (OR PTR 0)
65535)))
(PUTPROPS VPAGELOC MACRO ((PTR)
(LRSH (OR PTR 0)
8)))
(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 (* bvm: "13-Jul-84 17:22")
(COND
((NLISTP VMEMFILE)
(CLOSEF? VMEMFILE))
(T (CLOSEREMOTEVMEMFILE)))
(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)
8)
(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 256))
(PGTAB (POINTERARRAY 256 PGEMPTY))
(RDSYSINIT T))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS PGTAB PGEMPTY VMEMFILEX VMEMFILE FIRSTPMT)
)
(PUTPROPS VMEM COPYRIGHT ("Xerox Corporation" 1982 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1178 2421 (INITVMEM 1188 . 1794) (REOPENVMFILE 1796 . 2064) (VVAG2 2066 . 2419)) (2448
4144 (VGETBASE0 2458 . 2719) (VPUTBASE0 2721 . 3049) (VGETBASEPTR0 3051 . 3466) (VPUTBASEPTR0 3468 .
4030) (INVALIDADDR 4032 . 4142)) (5172 6633 (PRINTVM 5182 . 6058) (ENDVMPRINT 6060 . 6631)) (6725 8468
(OPENVMFILE 6735 . 7087) (UNMAPVM 7089 . 7343) (CLOSEVMEMFILE 7345 . 7565) (MAPVMPAGE 7567 . 7951) (
VBIN1 7953 . 8076) (VBOUT1 8078 . 8227) (VBIN2 8229 . 8307) (VBOUT2 8309 . 8466)) (8796 9622 (SETVMPTR
8806 . 9457) (VMPAGEP 9459 . 9620)))))
STOP