SafeStorageImpl.mesa
Copyright Ó 1988, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Carl Hauser, June 29, 1989 5:36:44 pm PDT
JKF August 26, 1988 1:03:51 pm PDT
Chauser, September 4, 1990 4:28 pm PDT
Willie-s, July 25, 1991 5:34 pm PDT
Doug Wyatt, August 24, 1991 6:19 pm PDT
Michael Plass, August 31, 1992 9:13 am PDT
DIRECTORY
Basics,
SafeStorage;
SafeStorageImpl: CEDAR PROGRAM
IMPORTS Basics, SafeStorage
EXPORTS SafeStorage
~ BEGIN
ExternalNames
ExternalNames: PROC = TRUSTED MACHINE CODE {
"^ExternalNames\n";
"XRAssignRef  XR𡤊ssignRef\n";
"XRAssignRefInit  XR𡤊ssignRefInit\n";
"XRNewObject  XR←NewObject\n";
"XRNewUntracedObject XR←NewUntracedObject\n";
"XRCheckProc  XR𡤌heckProc\n";
"NarrowRef  XR←Narrow\n";
"GetReferentType  XR←GetReferentType\n";
"XRAssignRefComposite  XR𡤊ssignRefComposite\n";
"XRAssignRefCompositeInit  XR𡤊ssignRefCompositeInit\n";
};
Zones
Zone: TYPE = REF ZoneRecord;
ZoneRecord: TYPE = MACHINE DEPENDENT RECORD [new: NewProc, free: FreeProc];
NewProc: TYPE = UNSAFE PROC[self: Zone, units: CARD32, type: SafeStorage.Type] RETURNS[REF];
FreeProc: TYPE = UNSAFE PROC[self: Zone, object: REF];
systemZone: ZONE ¬ GetZone[New, Free];
GetSystemZone: PUBLIC PROC RETURNS[ZONE] ~ {
RETURN[systemZone]} ;
this is the default ZONE used by NEW
GetZone: PROC [new: NewProc, free: FreeProc] RETURNS [ZONE] = TRUSTED {
zone: Zone ¬ LOOPHOLE[new[NIL, UNITS[ZoneRecord], null]];
zone­ ¬ [new, free];
RETURN[LOOPHOLE[zone]]};
New: NewProc = { RETURN[SafeStorage.NewObject[nUnits: units, type: type]]};
Free: FreeProc = { NULL }; -- no explicit free in these zones;
untracedZone: ZONE ¬ NIL;
GetUntracedZone: PUBLIC UNSAFE PROC RETURNS[ZONE] ~ {
IF untracedZone#NIL THEN RETURN[untracedZone];
RETURN [untracedZone ¬ GetZone[UntracedNew, Free]];
};
UntracedNew: NewProc ~ TRUSTED {
r: REF ~ SafeStorage.NewUntracedObject[nUnits: units, type: type];
Basics.FillWords[dst: LOOPHOLE[r], count: units/UNITS[Basics.Word], value: 0];
RETURN[r]
};
GetPermanentZone: PUBLIC PROC RETURNS [ZONE] ~ {
Fake implementation.
RETURN [GetSystemZone[]];
} ;
use this for NEW objects that will never be collected
Controlling the garbage collector
SetCollectionInterval: PUBLIC PROC [newInterval: CARD] RETURNS [previous: CARD] ~ {
XRSetBytesAfterWhichToCollect: PROC [newInterval: CARD] RETURNS [CARD] ~ TRUSTED MACHINE CODE {
"XR←SetBytesAfterWhichToCollect"
};
previous ¬ XRSetBytesAfterWhichToCollect[newInterval];
};
ReclaimCollectibleObjects: PUBLIC PROC [suspendMe: BOOL ¬ TRUE, traceAndSweep: BOOL ¬ FALSE] ~ {
Note: With versions of PCR newer than 4𡤄.X, there will be a procedure called XR←GCollect2, which will make sense of the parameters. Until then, we'll just ignore them.
XRDoCollection: PROC [] ~ TRUSTED MACHINE CODE { "XR←GCollect" };
XRDoCollection[];
} ;
Statistics
CurrentByteCount: PUBLIC PROC RETURNS [CARD] ~ {
P: PROC RETURNS [CARD] ~ TRUSTED MACHINE CODE {"XR←GCCurrentByteCount"};
RETURN [P[]]
};
CurrentObjectCount: PUBLIC PROC RETURNS [CARD] ~ {
P: PROC RETURNS [CARD] ~ TRUSTED MACHINE CODE {"XR←GCCurrentObjectCount"};
RETURN [P[]]
};
TotalByteCount: PUBLIC PROC RETURNS [CARD] ~ {
P: PROC RETURNS [CARD] ~ TRUSTED MACHINE CODE {"XR←GCTotalByteCount"};
RETURN [P[]]
};
TotalObjectCount: PUBLIC PROC RETURNS [CARD] ~ {
P: PROC RETURNS [CARD] ~ TRUSTED MACHINE CODE {"XR←GCTotalObjectCount"};
RETURN [P[]]
};
HeapSize: PUBLIC PROC RETURNS [CARD] ~ {
P: PROC RETURNS [CARD] ~ TRUSTED MACHINE CODE {"XR←GCHeapSize"};
RETURN [P[]]
};
Types
TypeIndex: TYPE = SafeStorage.Type;
Type: TYPE = SafeStorage.TypeIndex;
GetCanonicalReferentType: PUBLIC PROC[ref: REF ANY] RETURNS[type: SafeStorage.Type] ~ {
type ¬ GetReferentType[ref]
};
... gets the canonical type for the given type
EquivalentTypes: PUBLIC PROC[t1, t2: SafeStorage.Type] RETURNS[BOOL] ~ {
RETURN[GetCanonicalType[t1] = GetCanonicalType[t2]];
};
... tests the two types for equivalence (GetCanonicalType[t1] = GetCanonicalType[t2])
GetCanonicalType: PUBLIC PROC[type: SafeStorage.Type] RETURNS[SafeStorage.Type] ~ {
...n.b. this works now, but as the rest of the runtime type system and abstract machine arrive it will become incorrect. Right now the only source of types in the system provides only canonical types, but this will change.
RETURN[type];
};
... gets the canonical type for the given type
IsReferentType: PUBLIC PROC[ref: REF ANY, type: SafeStorage.Type] RETURNS[BOOL] ~ {
IF ref = NIL THEN RETURN[TRUE];
RETURN[type = GetReferentType[ref]]
};
... tests the given ref for having the given referent type
Signals and Errors
MemoryExhausted: PUBLIC ERROR ~ CODE;
NarrowFault: PUBLIC ERROR ~ CODE;
NarrowRefFault: PUBLIC ERROR [ref: REF ANY, targetType: SafeStorage.Type] ~ CODE;
UnsafeProcAssignment: PUBLIC SIGNAL [proc: PROC ANY RETURNS ANY] ~ CODE;
InvalidType: PUBLIC ERROR [type: SafeStorage.Type] ~ CODE;
Implementations for XR← routines presumed by the compiler
Moved up from safestorage.c in CedarPreBasics. These are given the appropriate C names by the SafeStorageImpl.externProcs and compiling with the -r switch.
XRAssignRef: UNSAFE PROC [dstPtr: POINTER TO POINTER, src: POINTER] ~ UNCHECKED { -- XR¬AssignRef
dstPtr­ ¬ src
};
XRAssignRefInit: UNSAFE PROC [dstPtr: POINTER TO POINTER, src: POINTER] ~ UNCHECKED { -- XR¬AssignRefInit
dstPtr­ ¬ src
};
XRNewObject: PROC [nAddressingUnits: CARD32, type: SafeStorage.Type] RETURNS [new: REF] ~ TRUSTED { -- XR¬NewObject
malloc: PROC[units: CARD32] RETURNS [CARDINAL] ~ TRUSTED MACHINE CODE {
"GC←malloc"
};
ptr: CARDINAL ¬ malloc[nAddressingUnits+overheadBytes];
IF ptr = 0 THEN ERROR MemoryExhausted;
new ¬ LOOPHOLE[ptr+overheadBytes, REF];
PutTypeInRef[new, type]
};
XRNewUntracedObject: PROC [nAddressingUnits: CARD32, type: SafeStorage.Type] RETURNS [new: REF] ~ TRUSTED { -- XR¬NewUntracedObject
mallocAtomic: PROC[units: CARD32] RETURNS [CARDINAL] ~ TRUSTED MACHINE CODE {
"GC←malloc𡤊tomic"
};
ptr: CARDINAL ¬ mallocAtomic[nAddressingUnits+overheadBytes];
IF ptr = 0 THEN ERROR MemoryExhausted;
new ¬ LOOPHOLE[ptr+overheadBytes, REF];
PutTypeInRef[new, type]
};
XRCheckProc: PROC [proc: PROC] RETURNS [WORD] ~ TRUSTED { -- XR¬CheckProc
CProcRep: TYPE ~ RECORD [pc: WORD, xx: WORD];
x: POINTER TO CProcRep ~ LOOPHOLE [proc];
IF x # NIL AND x.xx = 1 THEN SIGNAL UnsafeProcAssignment[proc];
RETURN[LOOPHOLE[proc, WORD]];
};
NarrowRef: PUBLIC PROC [ref: REF, type: SafeStorage.Type] RETURNS[REF] ~ TRUSTED { -- XR¬Narrow
IF ref=NIL THEN RETURN[ref];
IF type=GetTypeFromRef[ref] THEN RETURN[ref];
ERROR NarrowRefFault[ref, type];
};
GetReferentType: PUBLIC PROC [ref: REF] RETURNS[SafeStorage.Type] ~ TRUSTED { -- XR¬GetReferentType
IF ref=NIL THEN RETURN [null];
RETURN[GetTypeFromRef[ref]];
};
unitsBefore: CARD = 4; -- runtime-dependent location of the type before a REF
overheadBytes: CARD = 8; -- GC¬malloc returns doubleword aligned object; the actual REF must also be doubleword aligned and at least unitsBefore units are required for the type info
GetTypeFromRef: UNSAFE PROC [ref: REF] RETURNS [SafeStorage.Type] ~ UNCHECKED INLINE {
p: POINTER TO SafeStorage.Type ~ LOOPHOLE[(LOOPHOLE[ref, CARD]-unitsBefore)];
RETURN [p­]
};
PutTypeInRef: UNSAFE PROC [ref: REF, type: SafeStorage.Type] ~ UNCHECKED INLINE {
p: POINTER TO SafeStorage.Type ~ LOOPHOLE[(LOOPHOLE[ref, CARD]-unitsBefore)];
p­ ¬ type;
};
XRAssignRefComposite: UNSAFE PROC [dst, src: POINTER TO WORD32, type: SafeStorage.Type, size: CARD32] ~ UNCHECKED { -- XR¬AssignRefComposite
size is in words (32 bits)
Basics.CopyWords[dst: LOOPHOLE[dst], src: LOOPHOLE[src], count: size];
};
XRAssignRefCompositeInit: UNSAFE PROC [dst, src: POINTER TO WORD32, type: SafeStorage.Type, size: CARD32] ~ UNCHECKED { -- XR¬AssignRefComposite
size is in words (32 bits)
Basics.CopyWords[dst: LOOPHOLE[dst], src: LOOPHOLE[src], count: size];
};
ExternalNames[];
END.