(FILECREATED " 7-Jan-86 17:47:13" {ERIS}<LISPCORE>LIBRARY>VMEM.;10 11913
changes to: (FNS REOPENVMFILE)
previous date: "19-Feb-85 14:58:00" {ERIS}<LISPCORE>LIBRARY>VMEM.;9)
(* Copyright (c) 1982, 1984, 1985, 1986 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 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 " 7-Jan-86 16:30")
[SETQ VMEMFILE (FULLNAME (SETQ VMEMFILEX (OPENSTREAM 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 -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)))
(PUTPROPS VBIN1 MACRO (NIL (\BIN VMEMFILEX)))
[PUTPROPS VBIN2 MACRO (NIL (IPLUS (LLSH (VBIN1)
8)
(VBIN1]
[PUTPROPS .LOOKUPMAP. MACRO ((VP)
(FASTELTN (FASTELT PGTAB (LRSH VP 8))
(LOGAND VP 255]
)
[DECLARE: EVAL@COMPILE
(DATATYPE REMOTEPOINTER ((RPTYPE POINTER)
(RPHILOC WORD)
(RPLOLOC WORD)))
]
(/DECLAREDATATYPE (QUOTE REMOTEPOINTER)
(QUOTE (POINTER WORD WORD))
[QUOTE ((REMOTEPOINTER 0 POINTER)
(REMOTEPOINTER 2 (BITS . 15))
(REMOTEPOINTER 3 (BITS . 15]
(QUOTE 4))
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))
[QUOTE ((REMOTEPOINTER 0 POINTER)
(REMOTEPOINTER 2 (BITS . 15))
(REMOTEPOINTER 3 (BITS . 15]
(QUOTE 4))
(DECLARE: DONTEVAL@LOAD DOCOPY
(DEFPRINT (QUOTE REMOTEPOINTER)
(QUOTE \REMOTEPOINTER.DEFPRINT))
)
(ADDTOVAR VMEMVARS (PGEMPTY (FIXPARRAY 256))
(PGTAB (POINTERARRAY 256 PGEMPTY))
(RDSYSINIT T))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PGTAB PGEMPTY VMEMFILEX VMEMFILE FIRSTPMT)
)
(PUTPROPS VMEM COPYRIGHT ("Xerox Corporation" 1982 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1326 2623 (INITVMEM 1336 . 1942) (REOPENVMFILE 1944 . 2266) (VVAG2 2268 . 2621)) (2647
4442 (VGETBASE0 2657 . 2918) (VPUTBASE0 2920 . 3248) (VGETBASEPTR0 3250 . 3665) (VPUTBASEPTR0 3667 .
4229) (INVALIDADDR 4231 . 4440)) (4443 5904 (PRINTVM 4453 . 5329) (ENDVMPRINT 5331 . 5902)) (5996 7739
(OPENVMFILE 6006 . 6358) (UNMAPVM 6360 . 6614) (CLOSEVMEMFILE 6616 . 6836) (MAPVMPAGE 6838 . 7222) (
VBIN1 7224 . 7347) (VBOUT1 7349 . 7498) (VBIN2 7500 . 7578) (VBOUT2 7580 . 7737)) (7740 8561 (SETVMPTR
7750 . 8401) (VMPAGEP 8403 . 8559)) (10367 11321 (VTYPEDPOINTER 10377 . 10827) (
\REMOTEPOINTER.DEFPRINT 10829 . 11319)))))
STOP