(FILECREATED "13-Sep-86 14:36:21" {ERIS}<LISPCORE>LIBRARY>VMEM.;11 16623
changes to: (FNS INITVMEM)
previous date: " 7-Jan-86 17:47:13" {ERIS}<LISPCORE>LIBRARY>VMEM.;10)
(* 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-Sep-86 14:26")
(COND
(VMEMFILE (CLOSEVMEMFILE)))
(COND
((NLISTP 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 8))
(LOGAND PTR 255])
(VPUTBASE0
[LAMBDA (PTR VALUE) (* lmm "20-AUG-81 16:43")
(COND
((NLISTP VMEMFILE)
(SETVMPTR PTR)
(VBOUT2 VALUE))
(T (SETWORDCONTENTS (WORDOFFSET (VMAPPAGE (LRSH PTR 8))
(LOGAND PTR 255))
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 8))
(LOGAND PTR 255)))
(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 255 bind P
do (OR (EQ (SETQ P (FASTELT PGTAB SEG))
PGEMPTY)
(for PAGE from 0 to 255 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 10 (COND
((IGEQ FIRSTE 32768)
(SETQ FIRSTE (LOGAND FIRSTE 32767))
(SETQ LASTE (LOGAND LASTE 32767))
"*")
(T " "))
FIRSTE T))
(T (printout T "-" LASTPAGE 10 (COND
((IGEQ FIRSTE 32768)
(SETQ FIRSTE (LOGAND FIRSTE 32767))
(SETQ LASTE (LOGAND LASTE 32767))
"*")
(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)
8)
(VBIN1])
(VBOUT2
[LAMBDA (VALUE) (* lmm "19-MAR-81 12:24")
(VBOUT1 (LRSH VALUE 8))
(VBOUT1 (LOGAND VALUE 255))
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)
8))) (* 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)
32767)
9)
(LLSH (LOGAND (VLOLOC PTR)
255)
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 (1803 3644 (INITVMEM 1813 . 2581) (REOPENVMFILE 2583 . 3071) (VVAG2 3073 . 3642)) (3668
6153 (VGETBASE0 3678 . 3980) (VPUTBASE0 3982 . 4371) (VGETBASEPTR0 4373 . 5234) (VPUTBASEPTR0 5236 .
5952) (INVALIDADDR 5954 . 6151)) (6154 8501 (PRINTVM 6164 . 7519) (ENDVMPRINT 7521 . 8499)) (8593
10813 (OPENVMFILE 8603 . 9071) (UNMAPVM 9073 . 9420) (CLOSEVMEMFILE 9422 . 9655) (MAPVMPAGE 9657 .
10207) (VBIN1 10209 . 10336) (VBOUT1 10338 . 10524) (VBIN2 10526 . 10623) (VBOUT2 10625 . 10811)) (
10814 12199 (SETVMPTR 10824 . 12036) (VMPAGEP 12038 . 12197)) (14785 15974 (VTYPEDPOINTER 14795 .
15434) (\REMOTEPOINTER.DEFPRINT 15436 . 15972)))))
STOP