(FILECREATED "19-Feb-85 14:58:00" {ERIS}<LISPCORE>LIBRARY>VMEM.;9 27133Q
changes to: (VARS VMEMCOMS)
(FNS VLOOKUPPAGEMAP)
previous date: "15-Feb-85 18:19:06" {ERIS}<LISPCORE>LIBRARY>VMEM.;7)
(* Copyright (c) 1982, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT VMEMCOMS)
(RPAQQ VMEMCOMS ((FNS INITVMEM REOPENVMFILE VVAG2)
(INITVARS (VMEMFILE))
(FNS VGETBASE0 VPUTBASE0 VGETBASEPTR0 VPUTBASEPTR0 INVALIDADDR)
(COMS (FNS PRINTVM ENDVMPRINT)
(DECLARE: DONTCOPY (CONSTANTS NOPAGE)))
(FNS OPENVMFILE UNMAPVM CLOSEVMEMFILE MAPVMPAGE VBIN1 VBOUT1 VBIN2 VBOUT2)
(FNS SETVMPTR VMPAGEP)
[DECLARE: EVAL@COMPILE DONTCOPY (MACROS * VMACROS)
(RECORDS REMOTEPOINTER)
DONTEVAL@LOAD
(P (OR (SELECTQ (AND (GETD (QUOTE COMPILEMODE))
(COMPILEMODE))
((ALTO D)
T)
NIL)
(FILESLOAD (LOADCOMP)
DCODEFOR10]
[COMS (FNS VTYPEDPOINTER \REMOTEPOINTER.DEFPRINT)
(INITRECORDS REMOTEPOINTER)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (DEFPRINT (QUOTE REMOTEPOINTER)
(QUOTE \REMOTEPOINTER.DEFPRINT]
(ADDVARS (VMEMVARS (PGEMPTY (FIXPARRAY 400Q))
(PGTAB (POINTERARRAY 400Q 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])
)
(RPAQ? VMEMFILE )
(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) (* bvm: "28-Jan-85 12:13")
(printout T "Invalid Address: ")
(VPRINTVA PTR)
(TERPRI T)
(ERROR!])
)
(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])
)
(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) (* bvm: "10-Dec-84 12:46")
(NOT (IEQP (.LOOKUPMAP. VP)
0])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ VMACROS (VPAGEBASE VADDBASE VHILOC VVAG2 VGETBASEBYTE VLOLOC VPAGELOC VGETBASE VPUTBASE
VGETBASEPTR VPUTBASEPTR VBIN1 VBIN2 .LOOKUPMAP.))
(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)))
(PUTPROPS VBIN1 MACRO (NIL (\BIN VMEMFILEX)))
(PUTPROPS VBIN2 MACRO (NIL (IPLUS (LLSH (VBIN1)
10Q)
(VBIN1))))
(PUTPROPS .LOOKUPMAP. MACRO ((VP)
(FASTELTN (FASTELT PGTAB (LRSH VP 10Q))
(LOGAND VP 377Q))))
)
[DECLARE: EVAL@COMPILE
(DATATYPE REMOTEPOINTER ((RPTYPE POINTER)
(RPHILOC WORD)
(RPLOLOC WORD)))
]
(/DECLAREDATATYPE (QUOTE REMOTEPOINTER)
(QUOTE (POINTER WORD WORD)))
DONTEVAL@LOAD
(OR (SELECTQ (AND (GETD (QUOTE COMPILEMODE))
(COMPILEMODE))
((ALTO D)
T)
NIL)
(FILESLOAD (LOADCOMP)
DCODEFOR10))
)
(DEFINEQ
(VTYPEDPOINTER
[LAMBDA (TYPE POINTER) (* bvm: "15-Feb-85 18:06")
(* Produces a local object that represents a remote
POINTER with type information.
Used for visual presentation to teleraid user)
(create REMOTEPOINTER
RPTYPE ← TYPE
RPHILOC ←(VHILOC POINTER)
RPLOLOC ←(VLOLOC POINTER])
(\REMOTEPOINTER.DEFPRINT
[LAMBDA (RPTR) (* bvm: "15-Feb-85 18:11")
(* How to print a REMOTEPOINTER)
(LIST (CONCAT (QUOTE {)
(OR (ffetch RPTYPE of (\DTEST RPTR (QUOTE REMOTEPOINTER)))
"")
"}#"
(OCTALSTRING (ffetch RPHILOC of RPTR))
(QUOTE ,)
(OCTALSTRING (ffetch RPLOLOC of RPTR])
)
(/DECLAREDATATYPE (QUOTE REMOTEPOINTER)
(QUOTE (POINTER WORD WORD)))
(DECLARE: DONTEVAL@LOAD DOCOPY
(DEFPRINT (QUOTE REMOTEPOINTER)
(QUOTE \REMOTEPOINTER.DEFPRINT))
)
(ADDTOVAR VMEMVARS (PGEMPTY (FIXPARRAY 400Q))
(PGTAB (POINTERARRAY 400Q PGEMPTY))
(RDSYSINIT T))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PGTAB PGEMPTY VMEMFILEX VMEMFILE FIRSTPMT)
)
(PUTPROPS VMEM COPYRIGHT ("Xerox Corporation" 3676Q 3700Q 3701Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2445Q 5000Q (INITVMEM 2457Q . 3615Q) (REOPENVMFILE 3617Q . 4233Q) (VVAG2 4235Q . 4776Q)
) (5030Q 10433Q (VGETBASE0 5042Q . 5447Q) (VPUTBASE0 5451Q . 6161Q) (VGETBASEPTR0 6163Q . 7022Q) (
VPUTBASEPTR0 7024Q . 10106Q) (INVALIDADDR 10110Q . 10431Q)) (10434Q 13321Q (PRINTVM 10446Q . 12222Q) (
ENDVMPRINT 12224Q . 13317Q)) (13455Q 16774Q (OPENVMFILE 13467Q . 14227Q) (UNMAPVM 14231Q . 14627Q) (
CLOSEVMEMFILE 14631Q . 15165Q) (MAPVMPAGE 15167Q . 15767Q) (VBIN1 15771Q . 16164Q) (VBOUT1 16166Q .
16413Q) (VBIN2 16415Q . 16533Q) (VBOUT2 16535Q . 16772Q)) (16775Q 20462Q (SETVMPTR 17007Q . 20222Q) (
VMPAGEP 20224Q . 20460Q)) (24316Q 26210Q (VTYPEDPOINTER 24330Q . 25232Q) (\REMOTEPOINTER.DEFPRINT
25234Q . 26206Q)))))
STOP