(FILECREATED " 7-SEP-83 12:50:45" {PHYLUM}<LISPCORE>SOURCES>MEM.;7 25372Q
changes to: (FNS MKI.NEWPAGE PRINTPAGEMAP)
(VARS MEMCOMS)
previous date: "29-MAR-83 16:40:49" {PHYLUM}<LISPCORE>SOURCES>MEM.;6)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT MEMCOMS)
(RPAQQ MEMCOMS [(FNS MKI.NEXTPAGE WriteoutPage MKI.NEWPAGE MKI.LOCKPAGES MKI.LOCKEDPAGEP RESETMEMORY
PRINTMEMORY PRINTPAGEMAP)
(DECLARE: EVAL@COMPILE (VARS (PTRNIL 0)
(PTRNOBIND 1))
DONTCOPY
(ADDVARS (SIMPLEFNS I.HILOC I.LOLOC I.VAG2 I.ADDBASE PROGN PROG1)
(CONSTANTFNS QUOTE CONSTANT))
(RECORDS ALTOPOINTER)
(FNS DOCONSTANT CONSTANTP))
(VARS (NEWPAGETRACE)
(BLANKPAGE))
(FNS I.PUTBASE I.GETBASE I.PUTBASEPTR I.GETBASEPTR I.ADDBASE I.VAG2)
(DECLARE: EVAL@COMPILE DONTCOPY (IFPROP (MACRO ALTOMACRO DMACRO)
.DOADDBASE. I.HILOC I.LOLOC I.GETBASEPTR
I.ADDBASE I.PUTBASE I.GETBASE I.PUTBASEPTR
I.PAGELOC I.VAG2))
(DECLARE: DONTEVAL@LOAD DONTCOPY EVAL@COMPILEWHEN (SELECTQ (COMPILEMODE)
((ALTO D)
NIL)
T)
(FILES (LOADCOMP)
DCODEFOR10))
(VARS (MEMARRAY))
(GLOBALVARS MEMARRAY NONPAGE NONPAGE2 PTRNIL BLANKPAGE NEWPAGETRACE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML
DOCONSTANT)
(LAMA])
(DEFINEQ
(MKI.NEXTPAGE
[LAMBDA (VP) (* lmm "30-JUL-80 13:33")
(PROG (A I)
L1 (COND
((IGREATERP VP 65535)
(RETURN))
((EQ (SETQ A (FASTELT MEMARRAY (LRSH VP 8)))
NONPAGE2)
(SETQ VP (ADD1 (LOGOR VP 255)))
(GO L1)))
(SETQ I (LOGAND VP 255))
L2 [COND
((EQ I 256)
(SETQ VP (ADD1 (LOGOR VP 255)))
(GO L1))
((NEQ (FASTELT A I)
NONPAGE)
(RETURN (IPLUS (LOGAND VP 65280)
I]
(SETQ I (ADD1 I))
(GO L2])
(WriteoutPage
[LAMBDA (FX VP) (* lmm "17-MAR-81 16:20")
(* For MAXC)
(PROG [(A (FASTELT (FASTELT MEMARRAY (LRSH VP 10Q))
(LOGAND VP 377Q]
(AOUT A 0 400Q FX (QUOTE SMALLPOSP])
(MKI.NEWPAGE
[LAMBDA (PTR NOERROR LOCK? BLANKFLG) (* edited: " 7-SEP-83 12:04")
(PROG (A LO1 PAGE)
[COND
((EQ (SETQ A (FASTELT MEMARRAY (LRSH PTR 20Q)))
NONPAGE2)
(FASTSETA MEMARRAY (LRSH PTR 20Q)
(SETQ A (POINTERARRAY 400Q NONPAGE]
[COND
((NEQ (FASTELT A (SETQ LO1 (LRSH (LOGAND PTR 177777Q)
10Q)))
NONPAGE)
(HELP PTR (QUOTE "already allocated"]
(COND
(NEWPAGETRACE (printout NEWPAGETRACE "page " .I3.8 (I.HILOC PTR)
"," .I3.8 (LRSH (I.LOLOC PTR)
10Q)
,,,)))
[FASTSETA A LO1 (COND
((NOT BLANKFLG)
(WORDARRAY 400Q))
(T (OR BLANKPAGE (SETQ BLANKPAGE (WORDARRAY 400Q]
(AND LOCK? (MKI.LOCKPAGES PTR 1))
(RETURN PTR])
(MKI.LOCKPAGES
[LAMBDA (PTR NPAGES) (* lmm "11-AUG-80 21:53")
(push LOCKEDPAGES (CONS (I.PAGELOC PTR)
NPAGES])
(MKI.LOCKEDPAGEP
[LAMBDA (VP) (* lmm " 9-FEB-82 21:54")
(for X in LOCKEDPAGES when [AND (IGEQ VP (CAR X))
(ILESSP VP (IPLUS (CAR X)
(CDR X]
do (RETURN T])
(RESETMEMORY
[LAMBDA NIL (* lmm "26-MAR-81 09:23")
(SETQ LOCKEDPAGES)
(COND
((NULL MEMARRAY)
(SETQ NONPAGE (WORDARRAY 256))
(SETQ NONPAGE2 (POINTERARRAY 256 NONPAGE))
(SETQ MEMARRAY (POINTERARRAY 256 NONPAGE2)))
(T (for I from 0 to 255 do (FASTSETA MEMARRAY I NONPAGE2])
(PRINTMEMORY
[LAMBDA NIL (* lmm " 5-APR-82 12:24")
(RESETFORM (RADIX 8)
(for SEG from 0 to 255 bind A when (NEQ (SETQ A (FASTELT MEMARRAY SEG))
NONPAGE2)
do (printout T "segment " .I3.8 SEG 4)
(for J from 0 to 255 when (NEQ (FASTELT A J)
NONPAGE)
do (PRIN1 J T)
(PRIN1 (COND
((MKI.LOCKEDPAGEP (LOGOR (LLSH SEG 8)
J))
"*, ")
(T ", "))
T))
(TERPRI T])
(PRINTPAGEMAP
[LAMBDA (TOFILE) (* edited: " 7-SEP-83 12:28")
(bind LASTSEG for VPH from 0 to (LRSH \MAXVMPAGE 5) bind PMP
when (NOT (IEQ (SETQ PMP (I.GETBASE (I.VAG2 26Q 0)
VPH))
177777Q))
do (for VPL from 0 to 37Q bind VP when (NEQ (I.GETBASE (I.VAG2 25Q 0)
(IPLUS PMP VPL))
0)
do (SETQ VP (LOGOR VPL (LLSH VPH 5)))
(COND
((NEQ LASTSEG (SETQ LASTSEG (LRSH VP 10Q)))
(printout TOFILE T "segment " .I3.8 LASTSEG T)))
(printout TOFILE (LOGAND VP 377Q)
(COND
((MKI.LOCKEDPAGEP VP)
"*,")
(T ","))
,])
)
(DECLARE: EVAL@COMPILE
(RPAQQ PTRNIL 0)
(RPAQQ PTRNOBIND 1)
DONTCOPY
(ADDTOVAR SIMPLEFNS I.HILOC I.LOLOC I.VAG2 I.ADDBASE PROGN PROG1)
(ADDTOVAR CONSTANTFNS QUOTE CONSTANT)
[DECLARE: EVAL@COMPILE
(ACCESSFNS ALTOPOINTER ((HILOC (LRSH DATUM 20Q))
(LOLOC (LOGAND DATUM 177777Q)))
(CREATE (IPLUS (LLSH HILOC 20Q)
LOLOC))
[ACCESSFNS ALTOPOINTER ((6to13 (LRSH (LOGAND DATUM 177777Q)
10Q))
[bit12 (NOT (ZEROP (LOGAND 1000Q DATUM]
(0to13 (I.PAGELOC DATUM))
(0to11 (LRSH (I.PAGELOC DATUM)
2])
]
(DEFINEQ
(DOCONSTANT
[NLAMBDA (FORMALS FORM) (* lmm "26-MAR-81 09:17")
(SETQ FORM (SUBPAIR FORMALS ARGS FORM))
(COND
((EVERY ARGS (FUNCTION CONSTANTP))
(EVAL FORM))
(T FORM])
(CONSTANTP
[LAMBDA (X) (* lmm "11-OCT-78 18:45")
(OR (NULL X)
(EQ X T)
(NUMBERP X)
(STRINGP X)
(FMEMB (CAR X)
CONSTANTFNS)
(AND (FMEMB (CAR X)
SIMPLEFNS)
(EVERY (CDR X)
(FUNCTION CONSTANTP])
)
)
(RPAQQ NEWPAGETRACE NIL)
(RPAQQ BLANKPAGE NIL)
(DEFINEQ
(I.PUTBASE
[LAMBDA (PTR D V)
(PROG (HI LO1 LO2)
(DECLARE (LOCALVARS . T))
(.DOADDBASE. PTR D)
(AND (EQ (SETQ HI (FASTELT (FASTELT MEMARRAY HI)
LO1))
NONPAGE)
(INVALIDADDR))
(RETURN (FASTSETAW HI LO2 V])
(I.GETBASE
[LAMBDA (PTR D)
(PROG (HI LO1 LO2)
(DECLARE (LOCALVARS HI LO1 LO2))
(.DOADDBASE. PTR D)
(COND
((EQ (SETQ HI (FASTELT (FASTELT MEMARRAY HI)
LO1))
NONPAGE)
(INVALIDADDR)))
(RETURN (FASTELTW HI LO2])
(I.PUTBASEPTR
[LAMBDA (PTR D V)
(PROG (HI LO1 LO2 (VAL (OR V PTRNIL)))
(DECLARE (LOCALVARS . T))
(.DOADDBASE. PTR D)
(AND (EQ (SETQ HI (FASTELT (FASTELT MEMARRAY HI)
LO1))
NONPAGE)
(INVALIDADDR))
(FASTSETAW HI LO2 (LRSH VAL 16))
(FASTSETAW HI (ADD1 LO2)
(LOGAND VAL 65535))
(RETURN VAL])
(I.GETBASEPTR
[LAMBDA (PTR D)
(PROG (HI LO1 LO2)
(DECLARE (LOCALVARS . T))
(.DOADDBASE. PTR D)
(COND
((EQ (SETQ HI (FASTELT (FASTELT MEMARRAY HI)
LO1))
NONPAGE)
(INVALIDADDR)))
(RETURN (I.VAG2 (LOGAND 255 (FASTELTW HI LO2))
(FASTELTW HI (ADD1 LO2])
(I.ADDBASE
[LAMBDA (PTR D)
(IPLUS (OR PTR PTRNIL)
D])
(I.VAG2
[LAMBDA (HI LO)
([LAMBDA (X)
(DECLARE (LOCALVARS . T))
(COND
((ZEROP X)
NIL)
(T X]
(IPLUS (LLSH HI 16)
LO])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(PUTPROPS .DOADDBASE. MACRO ((PTR D)
(ASSEMBLE NIL
(CQ (VAG (IPLUS PTR D)))
(LSHC 1 , -20Q)
(ADDI 1 , ASZ)
(SETQ HI)
(LSHC 1 , 10Q)
(ANDI 1 , 377Q)
(ADDI 1 , ASZ)
(SETQ LO1)
(LSHC 1 , 10Q)
(ANDI 1 , 377Q)
(ADDI 1 , ASZ)
(SETQ LO2))))
(PUTPROPS I.HILOC MACRO (ARGS (DOCONSTANT (PTR)
(LRSH (OR PTR PTRNIL)
20Q))))
(PUTPROPS I.LOLOC MACRO (ARGS (DOCONSTANT (PTR)
(LOGAND (OR PTR PTRNIL)
177777Q))))
(PUTPROPS I.GETBASEPTR MACRO [(PTR D)
(PROG (HI LO1 LO2)
(DECLARE (LOCALVARS . T))
(.DOADDBASE. PTR D)
(COND
((EQ (SETQ HI (FASTELT (FASTELT MEMARRAY HI)
LO1))
NONPAGE)
(INVALIDADDR)))
(RETURN (I.VAG2 (LOGAND 377Q (FASTELTW HI LO2))
(FASTELTW HI (ADD1 LO2])
(PUTPROPS I.ADDBASE MACRO (ARGS (DOCONSTANT (PTR D)
(IPLUS (OR PTR PTRNIL)
D))))
(PUTPROPS I.PUTBASE MACRO [(PTR D V)
(PROG (HI LO1 LO2)
(DECLARE (LOCALVARS . T))
(.DOADDBASE. PTR D)
(AND (EQ (SETQ HI (FASTELT (FASTELT MEMARRAY HI)
LO1))
NONPAGE)
(INVALIDADDR))
(RETURN (FASTSETAW HI LO2 V])
(PUTPROPS I.GETBASE MACRO [(PTR D)
(PROG (HI LO1 LO2)
(DECLARE (LOCALVARS HI LO1 LO2))
(.DOADDBASE. PTR D)
(COND
((EQ (SETQ HI (FASTELT (FASTELT MEMARRAY HI)
LO1))
NONPAGE)
(INVALIDADDR)))
(RETURN (FASTELTW HI LO2])
(PUTPROPS I.PUTBASEPTR MACRO ((PTR D V)
(PROG (HI LO1 LO2 (VAL (OR V PTRNIL)))
(DECLARE (LOCALVARS . T))
(.DOADDBASE. PTR D)
(AND (EQ (SETQ HI (FASTELT (FASTELT MEMARRAY HI)
LO1))
NONPAGE)
(INVALIDADDR))
(FASTSETAW HI LO2 (LRSH VAL 20Q))
(FASTSETAW HI (ADD1 LO2)
(LOGAND VAL 177777Q))
(RETURN VAL))))
(PUTPROPS I.PAGELOC MACRO (ARGS (DOCONSTANT (PTR)
(LRSH (OR PTR PTRNIL)
10Q))))
(PUTPROPS I.VAG2 MACRO [ARGS (DOCONSTANT (HI LO)
([LAMBDA (X)
(DECLARE (LOCALVARS . T))
(COND
((ZEROP X)
NIL)
(T X]
(IPLUS (LLSH HI 20Q)
LO])
(PUTPROPS .DOADDBASE. ALTOMACRO ((PTR D)
(SETQ HI (LRSH (SETQ LO2 (IPLUS PTR D))
20Q))
(SETQ LO1 (LOGAND 377Q (LRSH LO2 10Q)))
(SETQ LO2 (LOGAND LO2 377Q))))
(PUTPROPS I.GETBASEPTR ALTOMACRO T)
(PUTPROPS I.PUTBASE ALTOMACRO T)
(PUTPROPS I.GETBASE ALTOMACRO T)
(PUTPROPS I.PUTBASEPTR ALTOMACRO T)
)
(DECLARE: DONTEVAL@LOAD DONTCOPY EVAL@COMPILEWHEN (SELECTQ (COMPILEMODE)
((ALTO D)
NIL)
T)
(FILESLOAD (LOADCOMP)
DCODEFOR10)
)
(RPAQQ MEMARRAY NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS MEMARRAY NONPAGE NONPAGE2 PTRNIL BLANKPAGE NEWPAGETRACE)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML DOCONSTANT)
(ADDTOVAR LAMA )
)
(PUTPROPS MEM COPYRIGHT ("Xerox Corporation" 3676Q 3677Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2615Q 11714Q (MKI.NEXTPAGE 2627Q . 3655Q) (WriteoutPage 3657Q . 4264Q) (MKI.NEWPAGE
4266Q . 5741Q) (MKI.LOCKPAGES 5743Q . 6164Q) (MKI.LOCKEDPAGEP 6166Q . 6535Q) (RESETMEMORY 6537Q .
7261Q) (PRINTMEMORY 7263Q . 10347Q) (PRINTPAGEMAP 10351Q . 11712Q)) (13032Q 13761Q (DOCONSTANT 13044Q
. 13357Q) (CONSTANTP 13361Q . 13757Q)) (14055Q 17044Q (I.PUTBASE 14067Q . 14515Q) (I.GETBASE 14517Q
. 15152Q) (I.PUTBASEPTR 15154Q . 15762Q) (I.GETBASEPTR 15764Q . 16501Q) (I.ADDBASE 16503Q . 16606Q) (
I.VAG2 16610Q . 17042Q)))))
STOP