(FILECREATED "29-MAR-83 16:40:49" {PHYLUM}<LISPCORE>SOURCES>MEM.;6 10192
changes to: (FNS MKI.NEWPAGE)
previous date: " 5-APR-82 12:25:07" {PHYLUM}<LISPCORE>SOURCES>MEM.;5)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT MEMCOMS)
(RPAQQ MEMCOMS [(FNS MKI.NEXTPAGE WriteoutPage MKI.NEWPAGE MKI.LOCKPAGES MKI.LOCKEDPAGEP RESETMEMORY
PRINTMEMORY)
(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) (* bvm: "29-MAR-83 16:39")
(PROG (A LO1 PAGE)
[COND
((EQ (SETQ A (FASTELT MEMARRAY (LRSH PTR 16)))
NONPAGE2)
(FASTSETA MEMARRAY (LRSH PTR 16)
(SETQ A (POINTERARRAY 256 NONPAGE]
[COND
((NEQ (FASTELT A (SETQ LO1 (LRSH (LOGAND PTR 65535)
8)))
NONPAGE)
(HELP PTR (QUOTE "already allocated"]
(COND
(NEWPAGETRACE (PRIN1 (QUOTE "page ")
NEWPAGETRACE)
(PRIN2 (I.PAGELOC PTR)
NEWPAGETRACE)
(PRIN1 (QUOTE ", ")
NEWPAGETRACE)))
[FASTSETA A LO1 (COND
((NOT BLANKFLG)
(WORDARRAY 256))
(T (OR BLANKPAGE (SETQ BLANKPAGE (WORDARRAY 256]
(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])
)
(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 16))
(LOLOC (LOGAND DATUM 65535)))
(CREATE (IPLUS (LLSH HILOC 16)
LOLOC))
[ACCESSFNS ALTOPOINTER ((6to13 (LRSH (LOGAND DATUM 65535)
8))
[bit12 (NOT (ZEROP (LOGAND 512 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)
16))))
(PUTPROPS I.LOLOC MACRO (ARGS (DOCONSTANT (PTR)
(LOGAND (OR PTR PTRNIL)
65535))))
(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 255 (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 16))
(FASTSETAW HI (ADD1 LO2)
(LOGAND VAL 65535))
(RETURN VAL))))
(PUTPROPS I.PAGELOC MACRO (ARGS (DOCONSTANT (PTR)
(LRSH (OR PTR PTRNIL)
8))))
(PUTPROPS I.VAG2 MACRO [ARGS (DOCONSTANT (HI LO)
([LAMBDA (X)
(DECLARE (LOCALVARS . T))
(COND
((ZEROP X)
NIL)
(T X]
(IPLUS (LLSH HI 16)
LO])
(PUTPROPS .DOADDBASE. ALTOMACRO ((PTR D)
(SETQ HI (LRSH (SETQ LO2 (IPLUS PTR D))
16))
(SETQ LO1 (LOGAND 255 (LRSH LO2 8)))
(SETQ LO2 (LOGAND LO2 255))))
(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" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1377 4285 (MKI.NEXTPAGE 1387 . 1921) (WriteoutPage 1923 . 2184) (MKI.NEWPAGE 2186 .
2997) (MKI.LOCKPAGES 2999 . 3144) (MKI.LOCKEDPAGEP 3146 . 3377) (RESETMEMORY 3379 . 3717) (PRINTMEMORY
3719 . 4283)) (4865 5336 (DOCONSTANT 4875 . 5078) (CONSTANTP 5080 . 5334)) (5396 6923 (I.PUTBASE 5406
. 5684) (I.GETBASE 5686 . 5969) (I.PUTBASEPTR 5971 . 6361) (I.GETBASEPTR 6363 . 6696) (I.ADDBASE 6698
. 6765) (I.VAG2 6767 . 6921)))))
STOP