(FILECREATED "18-AUG-83 13:14:27" {PHYLUM}<LISPCORE>SOURCES>READSYS.;10 16417Q
changes to: (VARS READSYSCOMS)
(FNS VRAID SHOWREMOTESCREEN)
previous date: " 2-AUG-83 12:37:23" {PHYLUM}<LISPCORE>SOURCES>READSYS.;9)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT READSYSCOMS)
(RPAQQ READSYSCOMS ((FNS PRINTSYSOUT READSYS TELERAID VRAID SHOWREMOTESCREEN CLEARATOMCACHE VGETVAL)
[INITVARS (RDSYSINIT)
(ATOMPAGELST NIL)
(ATOMCACHE NIL)
(NEWATOMARRAY (LIST (HARRAY 36Q]
(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 (LIST (HARRAY 36Q)))
(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" 3676Q 3677Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1666Q 13220Q (PRINTSYSOUT 1700Q . 5221Q) (READSYS 5223Q . 5771Q) (TELERAID 5773Q .
6312Q) (VRAID 6314Q . 10224Q) (SHOWREMOTESCREEN 10226Q . 12474Q) (CLEARATOMCACHE 12476Q . 13007Q) (
VGETVAL 13011Q . 13216Q)) (13417Q 15512Q (VATOM 13431Q . 15204Q) (VATOMNUMBER 15206Q . 15510Q)))))
STOP