(FILECREATED " 6-Aug-84 13:46:01" {ERIS}<LISPCORE>LIBRARY>READSYS.;10 7253
changes to: (FNS READSYS VATOM VATOMNUMBER)
(VARS READSYSCOMS)
previous date: "30-Jul-84 02:25:13" {ERIS}<LISPCORE>LIBRARY>READSYS.;9)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT READSYSCOMS)
(RPAQQ READSYSCOMS ((FNS PRINTSYSOUT READSYS TELERAID VRAID SHOWREMOTESCREEN 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)))
(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 " 6-Aug-84 13:22")
(COND
[FILE (INITVMEM FILE WRITEABLE)
(* * clear atom cache)
(for X in ATOMPAGELST do (for I from 0 to 255 do (FASTSETA (CDR X)
I 0)))
(* * initialize those variables which are renamed "pointers", e.g., the array free list)
[for X in RDPTRS do (SET (PACK* (QUOTE V)
(SUBATOM (CAR X)
2 -1))
(VGETTOPVAL (CAR X]
(* * Initialize those variables which are renamed "values", e.g., \AtomFrLst = # of allocated atoms)
(for X in RDVALS do (SET (PACK* (QUOTE V)
(SUBATOM (CAR X)
2 -1))
(VGETVAL (CAR X]
((LISTP VMEMFILE)
(CLOSEREMOTEVMEMFILE))
(T (CLOSEVMEMFILE])
(TELERAID
[LAMBDA (HOST RAIDIX) (* bvm: "13-Jul-84 17:24")
(RESETLST [COND
(HOST (RESETSAVE NIL (QUOTE (CLOSEVMEMFILE)))
(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])
(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 " 6-Aug-84 13:20")
(* Converts a VM atom number into a Lisp atom.)
(PROG ((PAGE (FASSOC (LRSH N 8)
ATOMPAGELST))
ATM FPTR)
(COND
((AND PAGE (NEQ (SETQ ATM (FASTELT (CDR PAGE)
(LOGAND N 255)))
0))
(RETURN ATM)))
(SETQ ATM (VUNCOPYATOM N))
[COND
((NULL PAGE)
(SETQ PAGE (CONS (LRSH N 8)
(POINTERARRAY 256 0)))
(COND
(ATOMCACHE (ATTACH PAGE ATOMCACHE))
(T (SETQ ATOMPAGELST (NCONC ATOMPAGELST (SETQ ATOMCACHE (LIST PAGE]
(FASTSETA (CDR PAGE)
(LOGAND N 255)
ATM)
(RETURN ATM])
(VATOMNUMBER
[LAMBDA (AT NEWOK) (* lmm " 6-Aug-84 13:21")
(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)
(PUTPROPS READSYS COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (748 5945 (PRINTSYSOUT 758 . 2503) (READSYS 2505 . 3381) (TELERAID 3383 . 3646) (VRAID
3648 . 4616) (SHOWREMOTESCREEN 4618 . 5808) (VGETVAL 5810 . 5943)) (6067 6978 (VATOM 6077 . 6835) (
VATOMNUMBER 6837 . 6976)))))
STOP