Fix \MAPMDS, compile STORAGE lispusers, fixes HARDRESET problem too (#1159)
* Fix \MAPMDS, compile STORAGE lispusers, fixes HARDRESET problem too * don't use BCOMPL on LLDATATYPE, needs FAKE-COMPILE-FILE
This commit is contained in:
Larry Masinter
GitHub
parent
3c237c1937
commit
a80788201f
BIN
lispusers/STORAGE.LCOM
Normal file
BIN
lispusers/STORAGE.LCOM
Normal file
Binary file not shown.
@ -1,35 +1,37 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "28-Jun-99 16:57:50" {DSK}<project>medley3.5>sources>LLDATATYPE.;2 95620
|
||||
|
||||
changes to%: (FNS TYPENAME)
|
||||
(FILECREATED "17-Apr-2023 08:04:06" {DSK}<home>larry>il>medley>sources>LLDATATYPE.;2 94197
|
||||
|
||||
previous date%: " 2-Feb-95 16:27:02" {DSK}<project>medley3.5>sources>LLDATATYPE.;1)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (VARS LLDATATYPECOMS)
|
||||
(FNS \SET.STORAGE.STATE \MAPMDS)
|
||||
|
||||
:PREVIOUS-DATE "28-Jun-99 16:57:50" {DSK}<home>larry>il>medley>sources>LLDATATYPE.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1999 by VENUE, Oakland, CA. All rights reserved.
|
||||
Copyright (c) 1982-1995, 1999 by VENUE, Oakland, CA.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LLDATATYPECOMS)
|
||||
|
||||
(RPAQQ LLDATATYPECOMS
|
||||
((COMS (* ;
|
||||
"Because we use the UNLESSINEW macro in this file, we need it when compiling.")
|
||||
((COMS (* ;
|
||||
"Because we use the UNLESSINEW macro in this file, we need it when compiling.")
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
|
||||
RENAMEMACROS)))
|
||||
(COMS (* ; "Storage management")
|
||||
(COMS (* ; "Storage management")
|
||||
(FNS NTYPX \TYPEMASK.UFN \TYPEP.UFN \ALLOCMDSPAGE \ALLOCPAGEBLOCK
|
||||
\ALLOCVIRTUALPAGEBLOCK \MAPMDS \CHECKFORSTORAGEFULL \DOSTORAGEFULLINTERRUPT
|
||||
\SET.STORAGE.STATE \SETTYPEMASK \ADVANCE.STORAGE.STATE \NEW2PAGE \MAKEMDSENTRY
|
||||
\INITMDSPAGE \ASSIGNDATATYPE1 \RESOLVE.TYPENUMBER \TYPENUMBERFROMNAME CREATECELL
|
||||
\CREATECELL)
|
||||
|
||||
(* ;;
|
||||
"For NEW_STORAGE option was set in Maiko, then \maiko.set.storage.state is active")
|
||||
(* ;;
|
||||
"For NEW_STORAGE option was set in Maiko, then \maiko.set.storage.state is active")
|
||||
|
||||
(FNS \MAIKO.SET.STORAGE.STATE)
|
||||
[P (AND (EQ \MACHINETYPE \MAIKO)
|
||||
(MOVD '\MAIKO.SET.STORAGE.STATE '\SET.STORAGE.STATE]
|
||||
SP
|
||||
(INITVARS (CROSSCOMPILING)
|
||||
(ASSIGNDATATYPE.ASKUSERWAIT 300)
|
||||
(\STORAGEFULLSTATE)
|
||||
@ -37,7 +39,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
|
||||
(GLOBALVARS CROSSCOMPILING \STORAGEFULLSTATE \STORAGEFULL \SYSTEMCACHEVARS
|
||||
\NxtArrayPage)
|
||||
(SPECVARS ASSIGNDATATYPE.ASKUSERWAIT))
|
||||
(COMS (* ; "fetch and replace")
|
||||
(COMS (* ; "fetch and replace")
|
||||
(FNS FETCHFIELD REPLACEFIELD BOXCOUNT CONSCOUNT \DTEST \TYPECHECK \DTEST.UFN
|
||||
\INSTANCEP.UFN \INSTANCE-P \TYPECHECK.UFN GETDESCRIPTORS GETSUPERTYPE
|
||||
GETFIELDSPECS NCREATE NCREATE2 REPLACEFIELDVAL PUTBASEPTRX /REPLACEFIELD TYPENAME
|
||||
@ -46,7 +48,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
|
||||
(MOVD? 'REPLACEFIELD 'FREPLACEFIELD NIL T)
|
||||
(MOVD? 'REPLACEFIELDVAL 'FREPLACEFIELDVAL NIL T))
|
||||
(OPTIMIZERS TYPENAMEP \INSTANCE-P))
|
||||
[COMS (* ; "STORAGE")
|
||||
[COMS (* ; "STORAGE")
|
||||
(FNS STORAGE STORAGE.LEFT \STORAGE.TYPE \STLINP \STMDSTYPE \STMDS.APPROX
|
||||
\STORAGE.HUNKTYPE)
|
||||
(DECLARE%: DONTCOPY (RECORDS HUNKSTAT))
|
||||
@ -55,15 +57,15 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
|
||||
(CONSTANTS \SMALLP \FIXP \FLOATP \LITATOM \LISTP \ARRAYP \STACKP \VMEMPAGEP
|
||||
\STREAM \NEW-ATOM)
|
||||
|
||||
(* ;;
|
||||
"This is the list of datatypes whos type #s must be known to microcode or to C.")
|
||||
(* ;;
|
||||
"This is the list of datatypes whos type #s must be known to microcode or to C.")
|
||||
|
||||
|
||||
(* ;; "It is used in \SETUP.HUNK.TYPENUMBERS (in LLARRAYELT) to create the list INITIALDTDCONTENTS for INITDATATYPES.")
|
||||
(* ;; "It is used in \SETUP.HUNK.TYPENUMBERS (in LLARRAYELT) to create the list INITIALDTDCONTENTS for INITDATATYPES.")
|
||||
|
||||
|
||||
(* ;;
|
||||
"Changes to this lit need to be reflected in C and maybe in microcode.")
|
||||
(* ;;
|
||||
"Changes to this lit need to be reflected in C and maybe in microcode.")
|
||||
|
||||
(VARS \BUILT-IN-SYSTEM-TYPES))
|
||||
DONTCOPY
|
||||
@ -75,7 +77,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
|
||||
\MDSFREELISTPAGE \MaxSysTypeNum \MaxTypeNumber \STORAGEFULL
|
||||
\INTERRUPTSTATE \PENDINGINTERRUPT))
|
||||
(CONSTANTS * STORAGEFULLSTATES))
|
||||
[COMS (* ; "for MAKEINIT")
|
||||
[COMS (* ; "for MAKEINIT")
|
||||
(FNS CREATEMDSTYPETABLE INITDATATYPES INITDATATYPENAMES)
|
||||
(DECLARE%: DONTCOPY
|
||||
(ADDVARS (INITVALUES (\NxtMDSPage \FirstMDSPage)
|
||||
@ -233,8 +235,28 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
|
||||
PAGE# _ FIRSTPAGE))))])
|
||||
|
||||
(\MAPMDS
|
||||
(LAMBDA (TYPE FN) (* ; "Edited 19-Oct-94 09:29 by sybalsky") (* ;;; "Applies FN to each virtual page number that is of type TYPE, or to all MDS pages if TYPE is NIL") (OR (NULL TYPE) (FIXP TYPE) (SETQ TYPE (\TYPENUMBERFROMNAME TYPE))) (CHECK (EQ (FOLDLO \MDSIncrement PAGESPERSEGMENT) 2)) (* ; "I'd put this FOLDLO as the increment in the FOR below, but the translation is atrocious") (for I from 0 to (COND ((EQ \STORAGEFULLSTATE \SFS.FULLYSWITCHED) 1) (T 0)) bind TYP do (* ;; "This is pretty grody because of the two different regions MDS can live in. Could just do everything from (IMIN \NxtMDSPage \LeastMDSPage) to \MaxMDSPage but waste time on the stuff in between") (for VP from (COND ((EQ I 0) (IMIN \NxtMDSPage \LeastMDSPage)) (T \NxtMDSPage)) by 2 to (COND ((EQ I 0) \DefaultSecondArrayPage) (T \MaxMDSPage)) do (* ;; "We could just access \MDSTypeTable directly here, but since NTYPX should be ucoded, we benefit by 'modularizing' this access.") (COND ((OR (EQ (SETQ TYP (NTYPX (create POINTER PAGE# _ VP))) TYPE) (AND (NULL TYPE) (NEQ TYP 0) (NEQ TYP \SMALLP))) (SPREADAPPLY* FN VP))))))
|
||||
)
|
||||
[LAMBDA (TYPE FN) (* ; "Edited 17-Apr-2023 07:49 by lmm")
|
||||
(* ; "Edited 19-Oct-94 09:29 by sybalsky")
|
||||
|
||||
(* ;;;
|
||||
"Applies FN to each virtual page number that is of type TYPE, or to all MDS pages if TYPE is NIL")
|
||||
|
||||
(OR (NULL TYPE)
|
||||
(FIXP TYPE)
|
||||
(SETQ TYPE (\TYPENUMBERFROMNAME TYPE)))
|
||||
(LET* ((VP (\CREATECELL \FIXP))
|
||||
(END (IMAX \DefaultSecondArrayPage \MaxMDSPage))
|
||||
TYP)
|
||||
(\PUTBASEFIXP VP 0 (IMIN \NxtMDSPage \LeastMDSPage))
|
||||
(WHILE (ILEQ VP END) DO (COND
|
||||
((OR (EQ (SETQ TYP (NTYPX (create POINTER
|
||||
PAGE# _ VP)))
|
||||
TYPE)
|
||||
(AND (NULL TYPE)
|
||||
(NEQ TYP 0)
|
||||
(NEQ TYP \SMALLP)))
|
||||
(SPREADAPPLY* FN VP)))
|
||||
(\BOXIPLUS VP 2])
|
||||
|
||||
(\CHECKFORSTORAGEFULL
|
||||
[LAMBDA (NPAGES) (* ; "Edited 4-Jan-93 02:04 by jds")
|
||||
@ -311,18 +333,14 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
|
||||
(LISPERROR "STORAGE FULL" '"save your work & reload a.s.a.p." T])
|
||||
|
||||
(\SET.STORAGE.STATE
|
||||
[LAMBDA NIL (* bvm%: "12-Aug-85 14:46")
|
||||
(PROG1 (SETQ \STORAGEFULLSTATE (COND
|
||||
((SELECTC \MACHINETYPE
|
||||
(\DOLPHIN NIL)
|
||||
(\DANDELION (NEQ 0 (fetch (IFPAGE DL24BitAddressable)
|
||||
of \InterfacePage)))
|
||||
T) (* ; "we can use high addresses")
|
||||
\SFS.SWITCHABLE)
|
||||
(T \SFS.NOTSWITCHABLE)))
|
||||
(push \SYSTEMCACHEVARS '\STORAGEFULLSTATE) (* ;
|
||||
"Want to recompute this if we come back from logout")
|
||||
)])
|
||||
[LAMBDA NIL (* ; "Edited 24-May-90 19:11 by Takeshi")
|
||||
(COND
|
||||
((EQ (FETCH (IFPAGE DL24BitAddressable) OF \InterfacePage)
|
||||
0)
|
||||
(SETQ \STORAGEFULLSTATE \SFS.NOTSWITCHABLE))
|
||||
(T (SETQ \STORAGEFULLSTATE \SFS.SWITCHABLE)))
|
||||
(PUSH \SYSTEMCACHEVARS '\STORAGEFULLSTATE)
|
||||
\STORAGEFULLSTATE])
|
||||
|
||||
(\SETTYPEMASK
|
||||
[LAMBDA (NTYPX BITS)
|
||||
@ -600,21 +618,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
|
||||
|
||||
(* ;; "For NEW_STORAGE option was set in Maiko, then \maiko.set.storage.state is active")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\MAIKO.SET.STORAGE.STATE
|
||||
[LAMBDA NIL (* ; "Edited 24-May-90 19:11 by Takeshi")
|
||||
(COND
|
||||
((EQ (FETCH (IFPAGE DL24BitAddressable) OF \InterfacePage)
|
||||
0)
|
||||
(SETQ \STORAGEFULLSTATE \SFS.NOTSWITCHABLE))
|
||||
(T (SETQ \STORAGEFULLSTATE \SFS.SWITCHABLE)))
|
||||
(PUSH \SYSTEMCACHEVARS '\STORAGEFULLSTATE)
|
||||
\STORAGEFULLSTATE])
|
||||
)
|
||||
|
||||
(AND (EQ \MACHINETYPE \MAIKO)
|
||||
(MOVD '\MAIKO.SET.STORAGE.STATE '\SET.STORAGE.STATE))
|
||||
(RPAQQ SP NOBIND)
|
||||
|
||||
(RPAQ? CROSSCOMPILING )
|
||||
|
||||
@ -1063,38 +1068,38 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
|
||||
(MOVD? 'REPLACEFIELDVAL 'FREPLACEFIELDVAL NIL T)
|
||||
|
||||
(DEFOPTIMIZER TYPENAMEP (DATUM TYPE &ENVIRONMENT ENV)
|
||||
(LET [(TYPE-NAME (CL:IF (AND (CL:CONSP TYPE)
|
||||
(EQ (CAR TYPE)
|
||||
'QUOTE)
|
||||
(CL:SYMBOLP (CADR TYPE)))
|
||||
(CADR TYPE]
|
||||
(CL:IF [AND TYPE-NAME (NOT (EQ TYPE-NAME 'STRINGP]
|
||||
[COND
|
||||
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`((OPCODES INSTANCEP 0 0 0 (ATOM \, (CADR TYPE)))
|
||||
,DATUM]
|
||||
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`((OPCODES INSTANCEP 0 0 (ATOM \, (CADR TYPE)))
|
||||
,DATUM]
|
||||
(T `((OPCODES INSTANCEP 0 (ATOM \, (CADR TYPE)))
|
||||
,DATUM]
|
||||
'COMPILER:PASS)))
|
||||
(LET [(TYPE-NAME (CL:IF (AND (CL:CONSP TYPE)
|
||||
(EQ (CAR TYPE)
|
||||
'QUOTE)
|
||||
(CL:SYMBOLP (CADR TYPE)))
|
||||
(CADR TYPE]
|
||||
(CL:IF [AND TYPE-NAME (NOT (EQ TYPE-NAME 'STRINGP]
|
||||
[COND
|
||||
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`((OPCODES INSTANCEP 0 0 0 (ATOM \, (CADR TYPE)))
|
||||
,DATUM]
|
||||
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`((OPCODES INSTANCEP 0 0 (ATOM \, (CADR TYPE)))
|
||||
,DATUM]
|
||||
(T `((OPCODES INSTANCEP 0 (ATOM \, (CADR TYPE)))
|
||||
,DATUM]
|
||||
'COMPILER:PASS)))
|
||||
|
||||
(DEFOPTIMIZER \INSTANCE-P (&BODY BODY &ENVIRONMENT ENV)
|
||||
(COND
|
||||
[[AND (EQ (CAADR BODY)
|
||||
'QUOTE)
|
||||
(CL:SYMBOLP (CADR (CADR BODY]
|
||||
(COND
|
||||
[[AND (EQ (CAADR BODY)
|
||||
'QUOTE)
|
||||
(CL:SYMBOLP (CADR (CADR BODY]
|
||||
(COND
|
||||
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`([OPCODES INSTANCEP 0 0 0 (ATOM \, (CADR (CADR BODY]
|
||||
,(CAR BODY]
|
||||
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`([OPCODES INSTANCEP 0 0 (ATOM \, (CADR (CADR BODY]
|
||||
,(CAR BODY]
|
||||
(T `([OPCODES INSTANCEP 0 (ATOM \, (CADR (CADR BODY]
|
||||
,(CAR BODY]
|
||||
(T 'IGNOREMACRO)))
|
||||
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`([OPCODES INSTANCEP 0 0 0 (ATOM \, (CADR (CADR BODY]
|
||||
,(CAR BODY]
|
||||
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`([OPCODES INSTANCEP 0 0 (ATOM \, (CADR (CADR BODY]
|
||||
,(CAR BODY]
|
||||
(T `([OPCODES INSTANCEP 0 (ATOM \, (CADR (CADR BODY]
|
||||
,(CAR BODY]
|
||||
(T 'IGNOREMACRO)))
|
||||
|
||||
|
||||
|
||||
@ -1363,7 +1368,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD HUNKSTAT (NPAGES NITEMS NFREE NINUSE NALLOCATED)
|
||||
NPAGES _ 0 NITEMS _ 0 NFREE _ 0 NINUSE _ 0 NALLOCATED _ 0)
|
||||
NPAGES _ 0 NITEMS _ 0 NFREE _ 0 NINUSE _ 0 NALLOCATED _ 0)
|
||||
)
|
||||
)
|
||||
|
||||
@ -1371,17 +1376,16 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
|
||||
(DECLARE%:
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")
|
||||
(DEFOPTIMIZER PUTBASEPTRX (&REST ARGS)
|
||||
(CONS '(OPENLAMBDA (DATUM OFFSET NEWVALUE)
|
||||
(UNINTERRUPTABLY
|
||||
(\PUTBASE DATUM OFFSET (LOGOR (LOGAND 61440
|
||||
(\GETBASE DATUM
|
||||
OFFSET))
|
||||
(LOGAND (\HILOC NEWVALUE)
|
||||
4095)))
|
||||
(\PUTBASE DATUM (ADD1 OFFSET)
|
||||
(\LOLOC NEWVALUE))
|
||||
NEWVALUE))
|
||||
ARGS))
|
||||
(CONS '(OPENLAMBDA (DATUM OFFSET NEWVALUE)
|
||||
(UNINTERRUPTABLY
|
||||
(\PUTBASE DATUM OFFSET (LOGOR (LOGAND 61440 (\GETBASE DATUM
|
||||
OFFSET))
|
||||
(LOGAND (\HILOC NEWVALUE)
|
||||
4095)))
|
||||
(\PUTBASE DATUM (ADD1 OFFSET)
|
||||
(\LOLOC NEWVALUE))
|
||||
NEWVALUE))
|
||||
ARGS))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \SMALLP 1)
|
||||
@ -1446,58 +1450,56 @@ DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(BLOCKRECORD DTD ((NIL BITS 2)
|
||||
(DTDOBSOLETE FLAG) (* ;
|
||||
"True for type of a redeclared datatype--not allowed to allocate more of these")
|
||||
(DTDFINALIZABLE FLAG) (* ;
|
||||
"True if finalization exists for this type")
|
||||
(DTDNAME POINTER) (* ; "Type name -- a symbol ")
|
||||
(DTDCNT0 WORD) (* ;
|
||||
"Incremental box count -- this plus DTDOLDCNT is the true box count")
|
||||
(DTDSIZE WORD) (* ; "Length of datum in words")
|
||||
(DTDFREE FULLXPOINTER) (* ;
|
||||
"Pointer to first object on free chain, or NIL. Not used for LISTP")
|
||||
(DTDLOCKEDP FLAG) (* ;
|
||||
"True if objects of this type must be locked down (not pagefault)")
|
||||
(DTDHUNKP FLAG) (* ;
|
||||
"True if this type is used as an array hunk type")
|
||||
(DTDGCTYPE BITS 2) (* ;
|
||||
"For hunk datatypes, is analogous to arrayblock's GCTYPE")
|
||||
(DTDDESCRS POINTER)
|
||||
(DTDTYPESPECS POINTER)
|
||||
(DTDPTRS POINTER) (* ;
|
||||
"List of word offsets inside datum where reference-counted pointers are stored -- used by GC")
|
||||
(DTDOLDCNT FIXP) (* ;
|
||||
"'Box count' -- number of objects of this type ever allocated")
|
||||
(DTDNEXTPAGE FIXP) (* ;
|
||||
"Currently only for LISTP pages -- page number of next page on chain of non-full cons pages")
|
||||
(DTDTYPEENTRY WORD)
|
||||
(DTDOBSOLETE FLAG) (* ;
|
||||
"True for type of a redeclared datatype--not allowed to allocate more of these")
|
||||
(DTDFINALIZABLE FLAG) (* ;
|
||||
"True if finalization exists for this type")
|
||||
(DTDNAME POINTER) (* ; "Type name -- a symbol ")
|
||||
(DTDCNT0 WORD) (* ;
|
||||
"Incremental box count -- this plus DTDOLDCNT is the true box count")
|
||||
(DTDSIZE WORD) (* ; "Length of datum in words")
|
||||
(DTDFREE FULLXPOINTER) (* ;
|
||||
"Pointer to first object on free chain, or NIL. Not used for LISTP")
|
||||
(DTDLOCKEDP FLAG) (* ;
|
||||
"True if objects of this type must be locked down (not pagefault)")
|
||||
(DTDHUNKP FLAG) (* ;
|
||||
"True if this type is used as an array hunk type")
|
||||
(DTDGCTYPE BITS 2) (* ;
|
||||
"For hunk datatypes, is analogous to arrayblock's GCTYPE")
|
||||
(DTDDESCRS POINTER)
|
||||
(DTDTYPESPECS POINTER)
|
||||
(DTDPTRS POINTER) (* ;
|
||||
"List of word offsets inside datum where reference-counted pointers are stored -- used by GC")
|
||||
(DTDOLDCNT FIXP) (* ;
|
||||
"'Box count' -- number of objects of this type ever allocated")
|
||||
(DTDNEXTPAGE FIXP) (* ;
|
||||
"Currently only for LISTP pages -- page number of next page on chain of non-full cons pages")
|
||||
(DTDTYPEENTRY WORD)
|
||||
|
||||
(* ;; "The word stored in the type table for objects of this type. Hi bits have numberp tags, ref countable, etc.")
|
||||
(* ;; "The word stored in the type table for objects of this type. Hi bits have numberp tags, ref countable, etc.")
|
||||
|
||||
(DTDSUPERTYPE WORD) (* ;
|
||||
"Type number of immediate supertype, or zero if none")
|
||||
)
|
||||
[ACCESSFNS DTD ((DTDCNTLOC (\ADDBASE DATUM 4))
|
||||
(DTDCNT (IPLUS (fetch DTDOLDCNT DATUM)
|
||||
(fetch DTDCNT0 DATUM))
|
||||
(UNINTERRUPTABLY
|
||||
(replace DTDOLDCNT of DATUM with NEWVALUE
|
||||
)
|
||||
(replace DTDCNT0 of DATUM with 0))])
|
||||
(DTDSUPERTYPE WORD) (* ;
|
||||
"Type number of immediate supertype, or zero if none")
|
||||
)
|
||||
[ACCESSFNS DTD ((DTDCNTLOC (\ADDBASE DATUM 4))
|
||||
(DTDCNT (IPLUS (fetch DTDOLDCNT DATUM)
|
||||
(fetch DTDCNT0 DATUM))
|
||||
(UNINTERRUPTABLY
|
||||
(replace DTDOLDCNT of DATUM with NEWVALUE)
|
||||
(replace DTDCNT0 of DATUM with 0))])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \GETDTD MACRO
|
||||
((typeNum)
|
||||
(ADDBASE \DTDSpaceBase (ITIMES typeNum 18))))
|
||||
(PUTPROPS \GETDTD MACRO ((typeNum)
|
||||
(ADDBASE \DTDSpaceBase (ITIMES typeNum 18))))
|
||||
)
|
||||
|
||||
(DEFOPTIMIZER \TYPEMASK.UFN (&REST X)
|
||||
(LET [(CE (CONSTANTEXPRESSIONP (CADR X]
|
||||
(if CE
|
||||
then `((OPCODES TYPEMASK.N ,(CAR CE))
|
||||
,(CAR X))
|
||||
else 'IGNOREMACRO)))
|
||||
(LET [(CE (CONSTANTEXPRESSIONP (CADR X]
|
||||
(if CE
|
||||
then `((OPCODES TYPEMASK.N ,(CAR CE))
|
||||
,(CAR X))
|
||||
else 'IGNOREMACRO)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \GUARDSTORAGEFULL 128)
|
||||
@ -1518,10 +1520,10 @@ DONTCOPY
|
||||
|
||||
|
||||
(RPAQQ STORAGEFULLSTATES ((\SFS.NORMAL NIL)
|
||||
(\SFS.NOTSWITCHABLE 1)
|
||||
(\SFS.SWITCHABLE 2)
|
||||
(\SFS.ARRAYSWITCHED 3)
|
||||
(\SFS.FULLYSWITCHED 4)))
|
||||
(\SFS.NOTSWITCHABLE 1)
|
||||
(\SFS.SWITCHABLE 2)
|
||||
(\SFS.ARRAYSWITCHED 3)
|
||||
(\SFS.FULLYSWITCHED 4)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \SFS.NORMAL NIL)
|
||||
@ -1699,34 +1701,34 @@ DONTCOPY
|
||||
(DECLARE%: DONTCOPY
|
||||
|
||||
(ADDTOVAR INITVALUES (\NxtMDSPage \FirstMDSPage)
|
||||
(\LeastMDSPage \FirstMDSPage)
|
||||
(\SecondMDSPage \DefaultSecondMDSPage)
|
||||
(\SecondArrayPage \DefaultSecondArrayPage)
|
||||
(\MDSFREELISTPAGE)
|
||||
(\MaxSysTypeNum 0)
|
||||
(\MaxTypeNumber))
|
||||
(\LeastMDSPage \FirstMDSPage)
|
||||
(\SecondMDSPage \DefaultSecondMDSPage)
|
||||
(\SecondArrayPage \DefaultSecondArrayPage)
|
||||
(\MDSFREELISTPAGE)
|
||||
(\MaxSysTypeNum 0)
|
||||
(\MaxTypeNumber))
|
||||
|
||||
(ADDTOVAR INITPTRS (\FINALIZATION.FUNCTIONS))
|
||||
|
||||
(ADDTOVAR INEWCOMS (FNS NTYPX \ALLOCMDSPAGE \MAKEMDSENTRY \INITMDSPAGE \ASSIGNDATATYPE1
|
||||
\TYPENUMBERFROMNAME \CREATECELL \NEW2PAGE)
|
||||
(FNS CREATEMDSTYPETABLE INITDATATYPES INITDATATYPENAMES)
|
||||
(VARS \BUILT-IN-SYSTEM-TYPES))
|
||||
\TYPENUMBERFROMNAME \CREATECELL \NEW2PAGE)
|
||||
(FNS CREATEMDSTYPETABLE INITDATATYPES INITDATATYPENAMES)
|
||||
(VARS \BUILT-IN-SYSTEM-TYPES))
|
||||
|
||||
(ADDTOVAR RDCOMS (FNS NTYPX TYPENAME \TYPENAMEFROMNUMBER))
|
||||
|
||||
(ADDTOVAR RDVALS (\MaxTypeNumber))
|
||||
|
||||
(ADDTOVAR RD.SUBFNS (\ARRAYTYPENAME LAMBDA (X)
|
||||
'ARRAYP))
|
||||
'ARRAYP))
|
||||
|
||||
(ADDTOVAR EXPANDMACROFNS \GETDTD PUTBASEPTRX REPLACEFIELD FETCHFIELD \GETBITS \PUTBITS \TESTBITS
|
||||
GETBASEBITS PUTBASEBITS FFETCHFIELD FREPLACEFIELD FREPLACEFIELDVAL
|
||||
REPLACEFIELDVAL NCREATE)
|
||||
GETBASEBITS PUTBASEBITS FFETCHFIELD FREPLACEFIELD FREPLACEFIELDVAL
|
||||
REPLACEFIELDVAL NCREATE)
|
||||
|
||||
(ADDTOVAR MKI.SUBFNS (\GCDISABLED . NILL)
|
||||
(CREATECELL . I.\CREATECELL)
|
||||
(\CHECKFORSTORAGEFULL . NILL))
|
||||
(CREATECELL . I.\CREATECELL)
|
||||
(\CHECKFORSTORAGEFULL . NILL))
|
||||
EVAL@COMPILE
|
||||
|
||||
(ADDTOVAR DONTCOMPILEFNS CREATEMDSTYPETABLE INITDATATYPES INITDATATYPENAMES)
|
||||
@ -1745,22 +1747,22 @@ EVAL@COMPILE
|
||||
(PUTPROPS LLDATATYPE COPYRIGHT ("VENUE, Oakland, CA" 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991
|
||||
1992 1993 1994 1995 1999))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6675 37676 (NTYPX 6685 . 7162) (\TYPEMASK.UFN 7164 . 7688) (\TYPEP.UFN 7690 . 7859) (
|
||||
\ALLOCMDSPAGE 7861 . 9263) (\ALLOCPAGEBLOCK 9265 . 9971) (\ALLOCVIRTUALPAGEBLOCK 9973 . 12588) (
|
||||
\MAPMDS 12590 . 13706) (\CHECKFORSTORAGEFULL 13708 . 18854) (\DOSTORAGEFULLINTERRUPT 18856 . 19150) (
|
||||
\SET.STORAGE.STATE 19152 . 20025) (\SETTYPEMASK 20027 . 20974) (\ADVANCE.STORAGE.STATE 20976 . 21484)
|
||||
(\NEW2PAGE 21486 . 21672) (\MAKEMDSENTRY 21674 . 22120) (\INITMDSPAGE 22122 . 23914) (\ASSIGNDATATYPE1
|
||||
23916 . 33544) (\RESOLVE.TYPENUMBER 33546 . 34011) (\TYPENUMBERFROMNAME 34013 . 34553) (CREATECELL
|
||||
34555 . 34688) (\CREATECELL 34690 . 37674)) (37775 38201 (\MAIKO.SET.STORAGE.STATE 37785 . 38199)) (
|
||||
38662 60724 (FETCHFIELD 38672 . 41863) (REPLACEFIELD 41865 . 47491) (BOXCOUNT 47493 . 47994) (
|
||||
CONSCOUNT 47996 . 48130) (\DTEST 48132 . 48265) (\TYPECHECK 48267 . 48404) (\DTEST.UFN 48406 . 51661)
|
||||
(\INSTANCEP.UFN 51663 . 52891) (\INSTANCE-P 52893 . 53156) (\TYPECHECK.UFN 53158 . 53721) (
|
||||
GETDESCRIPTORS 53723 . 54241) (GETSUPERTYPE 54243 . 54757) (GETFIELDSPECS 54759 . 55396) (NCREATE
|
||||
55398 . 55570) (NCREATE2 55572 . 56287) (REPLACEFIELDVAL 56289 . 56553) (PUTBASEPTRX 56555 . 57034) (
|
||||
/REPLACEFIELD 57036 . 57301) (TYPENAME 57303 . 58145) (TYPENAMEP 58147 . 58371) (\TYPENAMEFROMNUMBER
|
||||
58373 . 58603) (\BLOCKDATAP 58605 . 58925) (USERDATATYPES 58927 . 59059) (DATATYPEP 59061 . 60210) (
|
||||
DATATYPES 60212 . 60722)) (63086 78237 (STORAGE 63096 . 67517) (STORAGE.LEFT 67519 . 71060) (
|
||||
\STORAGE.TYPE 71062 . 75122) (\STLINP 75124 . 75310) (\STMDSTYPE 75312 . 76511) (\STMDS.APPROX 76513
|
||||
. 76781) (\STORAGE.HUNKTYPE 76783 . 78235)) (85121 93820 (CREATEMDSTYPETABLE 85131 . 86920) (
|
||||
INITDATATYPES 86922 . 91767) (INITDATATYPENAMES 91769 . 93818)))))
|
||||
(FILEMAP (NIL (6524 37135 (NTYPX 6534 . 7011) (\TYPEMASK.UFN 7013 . 7537) (\TYPEP.UFN 7539 . 7708) (
|
||||
\ALLOCMDSPAGE 7710 . 9112) (\ALLOCPAGEBLOCK 9114 . 9820) (\ALLOCVIRTUALPAGEBLOCK 9822 . 12437) (
|
||||
\MAPMDS 12439 . 13626) (\CHECKFORSTORAGEFULL 13628 . 18774) (\DOSTORAGEFULLINTERRUPT 18776 . 19070) (
|
||||
\SET.STORAGE.STATE 19072 . 19484) (\SETTYPEMASK 19486 . 20433) (\ADVANCE.STORAGE.STATE 20435 . 20943)
|
||||
(\NEW2PAGE 20945 . 21131) (\MAKEMDSENTRY 21133 . 21579) (\INITMDSPAGE 21581 . 23373) (\ASSIGNDATATYPE1
|
||||
23375 . 33003) (\RESOLVE.TYPENUMBER 33005 . 33470) (\TYPENUMBERFROMNAME 33472 . 34012) (CREATECELL
|
||||
34014 . 34147) (\CREATECELL 34149 . 37133)) (37627 59689 (FETCHFIELD 37637 . 40828) (REPLACEFIELD
|
||||
40830 . 46456) (BOXCOUNT 46458 . 46959) (CONSCOUNT 46961 . 47095) (\DTEST 47097 . 47230) (\TYPECHECK
|
||||
47232 . 47369) (\DTEST.UFN 47371 . 50626) (\INSTANCEP.UFN 50628 . 51856) (\INSTANCE-P 51858 . 52121) (
|
||||
\TYPECHECK.UFN 52123 . 52686) (GETDESCRIPTORS 52688 . 53206) (GETSUPERTYPE 53208 . 53722) (
|
||||
GETFIELDSPECS 53724 . 54361) (NCREATE 54363 . 54535) (NCREATE2 54537 . 55252) (REPLACEFIELDVAL 55254
|
||||
. 55518) (PUTBASEPTRX 55520 . 55999) (/REPLACEFIELD 56001 . 56266) (TYPENAME 56268 . 57110) (
|
||||
TYPENAMEP 57112 . 57336) (\TYPENAMEFROMNUMBER 57338 . 57568) (\BLOCKDATAP 57570 . 57890) (
|
||||
USERDATATYPES 57892 . 58024) (DATATYPEP 58026 . 59175) (DATATYPES 59177 . 59687)) (61931 77082 (
|
||||
STORAGE 61941 . 66362) (STORAGE.LEFT 66364 . 69905) (\STORAGE.TYPE 69907 . 73967) (\STLINP 73969 .
|
||||
74155) (\STMDSTYPE 74157 . 75356) (\STMDS.APPROX 75358 . 75626) (\STORAGE.HUNKTYPE 75628 . 77080)) (
|
||||
83752 92451 (CREATEMDSTYPETABLE 83762 . 85551) (INITDATATYPES 85553 . 90398) (INITDATATYPENAMES 90400
|
||||
. 92449)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user