(FILECREATED " 3-Jan-84 13:38:02" {PHYLUM}<LISPCORE>LIBRARY>READSYS.;2 7402
changes to: (VARS READSYSCOMS)
previous date: "18-AUG-83 13:14:27" {PHYLUM}<LISP>LIBRARY>READSYS.;1)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT READSYSCOMS)
(RPAQQ READSYSCOMS ((FNS PRINTSYSOUT READSYS TELERAID VRAID SHOWREMOTESCREEN CLEARATOMCACHE VGETVAL)
(INITVARS (RDSYSINIT)
(ATOMPAGELST NIL)
(ATOMCACHE NIL)
(NEWATOMARRAY (HASHARRAY 30)))
(FNS VATOM VATOMNUMBER)
(DECLARE: EVAL@COMPILE DONTCOPY (PROP (DMACRO MACRO)
IEQ)
DONTEVAL@LOAD
(FILES (LOADCOMP)
VMEM))
(FILES VMEM)
(DECLARE: DONTEVAL@LOAD COPYWHEN (SELECTQ (AND (GETD (QUOTE COMPILEMODE))
(COMPILEMODE))
((ALTO D)
NIL)
T)
(FILES (SYSLOAD)
DCODEFOR10))))
(DEFINEQ
(PRINTSYSOUT
[LAMBDA (OUTF RADIX SHORTFLG) (* lmm "16-JUN-82 17:50")
(RESETLST (OR RADIX (SETQ RADIX 20Q))
(PROG (MAP (LINECOUNT 0)
(PAGECOUNT 0)
(LINESPERPAGE LINESPERPAGE)
CURFN
(VDEFSPACE (VGETTOPVAL (QUOTE \DEFSPACE)))
(INUM 0)
(.I6 (NUMFORMATCODE (LIST (QUOTE FIX)
6 RADIX)))
D FN ILIST MX)
[OUTFILE (OR OUTF (PACKFILENAME (QUOTE EXTENSION)
(QUOTE LISTING)
(QUOTE NAME)
(FILENAMEFIELD VMEMFILE (QUOTE NAME]
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
(OUTPUT)))
(RESETSAVE (LINELENGTH 1750Q))
(RESETSAVE (RADIX 12Q))
[SETQ MX (SUB1 (V\UNCOPY (VGETTOPVAL (QUOTE \AtomFrLst]
(SETQ ILIST (for I from 0 to MX when (SETQ D (VGETBASEPTR VDEFSPACE
(LLSH I 1)))
collect (LIST (V\UNCOPY I)
D)))
(printout NIL "code listing for " VMEMFILE " created " (GETFILEINFO VMEMFILE
(QUOTE
CREATIONDATE))
T)
[SORT ILIST (FUNCTION (LAMBDA (X Y)
(ILESSP (CADR X)
(CADR Y]
(for X in ILIST do (PRINTNUM .I6 (VHILOC (CADR X)))
(SPACES 1)
(PRINTNUM .I6 (VLOLOC (CADR X)))
(SPACES 12Q)
(PRINT (CAR X)))
(PRINTOUT NIL .PAGE)
(SORT ILIST (FUNCTION FILEINDEXALPHORDER))
[for X in ILIST do (printout NIL (CAR X)
": " 62Q)
(PRINTNUM .I6 (VHILOC (CADR X)))
(SPACES 1)
(PRINTNUM .I6 (VLOLOC (CADR X)))
(TERPRI)
(COND
((NOT SHORTFLG)
(VDPRINTCODE (CAR X)
NIL RADIX)
(TERPRI)
(TERPRI]
(RETURN OUTF])
(READSYS
[LAMBDA (FILE WRITEABLE) (* lmm "20-AUG-81 14:29")
(COND
[FILE (INITVMEM FILE WRITEABLE)
(CLEARATOMCACHE)
(AND RDPTRS (HELP))
(SETQ VAtomFrLst)
(for X in RDVALS do (SET (PACK* (QUOTE V)
(SUBATOM (CAR X)
2 -1))
(VGETVAL (CAR X]
(T (CLOSEVMEMFILE])
(TELERAID
[LAMBDA (HOST RAIDIX) (* bvm: " 2-AUG-83 11:18")
[COND
(HOST (READSYS (LIST HOST]
(COND
((LISTP VMEMFILE)
(VRAID RAIDIX])
(VRAID
[LAMBDA (RAIDIX) (* bvm: "18-AUG-83 13:10")
(DECLARE (SPECVARS RAIDIX ROOTFRAME ALINKS? FRAME# REMOTESCREEN))
(printout T "virtual RAID" T)
(OR RAIDIX (SETQ RAIDIX 10Q))
(PROG ((ROOTFRAME)
(ALINKS? T)
(FRAME#)
(REMOTESCREEN))
(RESETLST (RESETSAVE (OUTPUT T))
(RESETSAVE (INTCHAR (CHARCODE ↑G)))
(SETQ .I2 (NUMFORMATCODE (LIST (QUOTE FIX)
2 RAIDIX)))
(SETQ .I5 (NUMFORMATCODE (LIST (QUOTE FIX)
5 RAIDIX)))
(SETQ .I6 (NUMFORMATCODE (LIST (QUOTE FIX)
6 RAIDIX)))
(SETQ .I7 (NUMFORMATCODE (LIST (QUOTE FIX)
7 RAIDIX)))
(bind RESULT until [SETQ RESULT (ERSETQ (when (SETQ $$VAL (VRAIDCOMMAND))
do (RETURN $$VAL]
finally (COND
((AND (LISTP VMEMFILE)
(EQ (CAR RESULT)
(QUOTE RETURN)))
(CLEARPAGECACHE)
(REMOTERETURN])
(SHOWREMOTESCREEN
[LAMBDA NIL (* bvm: "18-AUG-83 13:12")
(DECLARE (USEDFREE REMOTESCREEN))
(PROG ((WINDOW REMOTESCREEN)
BITMAPBASE)
(COND
((NOT WINDOW)
(SETQ WINDOW (CREATEW WHOLEDISPLAY NIL 0 T))
(SETQ BITMAPBASE (fetch BITMAPBASE of (fetch (WINDOW SAVE) of WINDOW)))
(COND
([NOT (IEQP (UNFOLD \NP.DISPLAY BYTESPERPAGE)
(TIMES SCREENHEIGHT (QUOTIENT SCREENWIDTH BITSPERBYTE]
(ERROR "Confused about screen size")))
[COND
[(LISTP VMEMFILE)
(for I from \VP.DISPLAY to (IPLUS \VP.DISPLAY \NP.DISPLAY -1)
do (REMOTEPMAP VMEMFILE I BITMAPBASE)
(SETQ BITMAPBASE (\ADDBASE BITMAPBASE WORDSPERPAGE]
(T (SETVMPTR (UNFOLD \VP.DISPLAY WORDSPERPAGE))
(\BINS (GETSTREAM VMEMFILE)
BITMAPBASE 0 (UNFOLD \NP.DISPLAY BYTESPERPAGE)
(TIMES SCREENHEIGHT (QUOTIENT SCREENWIDTH BITSPERBYTE]
(SETQ REMOTESCREEN WINDOW)))
(OPENW WINDOW)
(until (OR (READP T)
(NOT (OPENWP WINDOW)))
do (TOTOPW WINDOW)
(BLOCK))
(COND
((OPENWP WINDOW)
(CLOSEW WINDOW])
(CLEARATOMCACHE
[LAMBDA NIL (* lmm " 9-MAR-81 09:43")
(for X in ATOMPAGELST do (for I from 0 to 255 do (FASTSETA (CDR X)
I 0])
(VGETVAL
[LAMBDA (X) (* lmm "20-AUG-81 12:51")
(V\UNCOPY (VGETTOPVAL X])
)
(RPAQ? RDSYSINIT )
(RPAQ? ATOMPAGELST NIL)
(RPAQ? ATOMCACHE NIL)
(RPAQ? NEWATOMARRAY (HASHARRAY 30))
(DEFINEQ
(VATOM
[LAMBDA (N) (* lmm " 4-AUG-81 14:25")
(* Converts a VM atom number into a Lisp atom.)
(COND
[(NOT VMEMFILE)
(COND
((ILESSP N \AtomFrLst)
(ATOMNAME N))
(T (CONCAT (QUOTE ATOM#)
N]
(T (PROG ((PAGE (FASSOC (LRSH N 10Q)
ATOMPAGELST))
ATM FPTR)
(COND
((AND PAGE (NEQ (SETQ ATM (FASTELT (CDR PAGE)
(LOGAND N 377Q)))
0))
(RETURN ATM)))
(SETQ ATM (VUNCOPYATOM N))
[COND
((NULL PAGE)
(SETQ PAGE (CONS (LRSH N 10Q)
(POINTERARRAY 400Q 0)))
(COND
(ATOMCACHE (ATTACH PAGE ATOMCACHE))
(T (SETQ ATOMPAGELST (NCONC ATOMPAGELST (SETQ ATOMCACHE (LIST PAGE]
(FASTSETA (CDR PAGE)
(LOGAND N 377Q)
ATM)
(RETURN ATM])
(VATOMNUMBER
[LAMBDA (AT NEWOK) (* lmm "20-AUG-81 14:38")
(COND
((NOT VMEMFILE)
(ATOMNUMBER AT))
(T (V\MKATOM AT 1 (NCHARS AT])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(PUTPROPS IEQ DMACRO (= . EQ))
(PUTPROPS IEQ MACRO ((X Y)
(IEQP X Y)))
DONTEVAL@LOAD
(FILESLOAD (LOADCOMP)
VMEM)
)
(FILESLOAD VMEM)
(DECLARE: DONTEVAL@LOAD COPYWHEN (SELECTQ (AND (GETD (QUOTE COMPILEMODE))
(COMPILEMODE))
((ALTO D)
NIL)
T)
(FILESLOAD (SYSLOAD)
DCODEFOR10)
)
(PUTPROPS READSYS COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (915 5741 (PRINTSYSOUT 925 . 2670) (READSYS 2672 . 3030) (TELERAID 3032 . 3239) (VRAID
3241 . 4209) (SHOWREMOTESCREEN 4211 . 5401) (CLEARATOMCACHE 5403 . 5604) (VGETVAL 5606 . 5739)) (5863
6946 (VATOM 5873 . 6748) (VATOMNUMBER 6750 . 6944)))))
STOP