
DIRECTORY
Basics,
SafeStorage;

SafeStorageImpl: CEDAR PROGRAM
IMPORTS Basics, SafeStorage
EXPORTS SafeStorage
~ BEGIN
ExternalNames: PROC = TRUSTED MACHINE CODE {
"^ExternalNames\n";
"XRAssignRef   	XR_AssignRef\n";
"XRAssignRefInit    	XR_AssignRefInit\n";
"XRNewObject    	XR_NewObject\n";
"XRNewUntracedObject	XR_NewUntracedObject\n";
"XRCheckProc 	XR_CheckProc\n";
"NarrowRef 	XR_Narrow\n";
"GetReferentType	 XR_GetReferentType\n";
"XRAssignRefComposite	 XR_AssignRefComposite\n";
"XRAssignRefCompositeInit	 XR_AssignRefCompositeInit\n";
};
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]} ;

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] ~ {
RETURN [GetSystemZone[]];
} ;
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] ~ {
XRDoCollection: PROC [] ~ TRUSTED MACHINE CODE { "XR_GCollect" };
XRDoCollection[];
} ;
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[]]
};
TypeIndex: TYPE = SafeStorage.Type;

Type: TYPE = SafeStorage.TypeIndex;

GetCanonicalReferentType: PUBLIC PROC[ref: REF ANY] RETURNS[type: SafeStorage.Type] ~ {
type м GetReferentType[ref]
};

EquivalentTypes: PUBLIC PROC[t1, t2: SafeStorage.Type] RETURNS[BOOL] ~ {
RETURN[GetCanonicalType[t1] = GetCanonicalType[t2]];
};

GetCanonicalType: PUBLIC PROC[type: SafeStorage.Type] RETURNS[SafeStorage.Type]  ~ {
RETURN[type];
};

IsReferentType: PUBLIC PROC[ref: REF ANY, type: SafeStorage.Type] RETURNS[BOOL] ~ {
IF ref = NIL THEN RETURN[TRUE];
RETURN[type = GetReferentType[ref]]
};
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;
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_atomic"
};
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
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
Basics.CopyWords[dst: LOOPHOLE[dst], src: LOOPHOLE[src], count: size];
};

ExternalNames[];


END.
   м  
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

ExternalNames
Zones
this is the default ZONE used by NEW
Fake implementation.
use this for NEW objects that will never be collected
Controlling the garbage collector
Note: With versions of PCR newer than 4_4.X, there will be a procedure called XR_GCollect2, which will make sense of the parameters.  Until then, we'll just ignore them.
Statistics

Types
... gets the canonical type for the given type
... tests the two types for equivalence (GetCanonicalType[t1] = GetCanonicalType[t2])
...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.
... gets the canonical type for the given type
... tests the given ref for having the given referent type
Signals and Errors
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.

size is in words (32 bits) 
size is in words (32 bits) 

Э╩
░  ХNewlineDelimiter
Ц(cedarcode) styleЩ ЪЬЩIcodeЪЬ
╧eЬCЩNKЩ)KЩ"KЩ&KЩ#KЩ'KЩ*KЩ ЧKШ Ъ╧k	Ш	KШKЪЬШKШ ЧЪ╨lnЬЮШKЪЮЬШKЪЮЬШKЪЬЮШЧheadЩЪ
╧nЬЮЬЮЬЮЬЮЬШ,KЪЬШKЪЬаЬЮЬШ KЪЬаЬЮЬШ)KЪЬаЬЮЬШ!KЪЬаЬЮЬШ-KЪЬаЬЮЬШKЪЬа	ЬЮЬШKЪЬаЬЮЬШ(KЪЬаЬЮЬШ0KЪЬаЬЮЬШ8KЪЬШЧЧЩKЪЬЮЬЮЬШKЪ	ЬЮЬЮЬЮ	ЬЮЬ ШKKЪЬ	ЮЬЮЬЮЬЮЬЮЬЮЬШ\KЪ	Ь
ЮЬЮЬЮЬЮЬШ6ЧШ KЪЬЮЬШ&KШ ЪаЬЮЬЮЬЮЬШ-KЪЮЬШKЪЬЮЬ	ЮЩ$KШ ЧЪ
аЬЮЬ ЮЬЮЬЮЬШGKЪЬЮЬЮЬЮЬШ9KЪЬШKЪЮЬЮЬ	ШKШ ЧKЪаЬЮЬ4ШKKШ ЪаЬЮЬ╧c#Ш>KШ ЧKЪЬЮЬЮЬШKШ ЪаЬЮЬЮЬЮЬЮЬЮЬШ5KЪЮЬЮЬЮЬЮЬШ.KЪЮЬ-Ш3KЪЬШKШ ЧЪаЬЮЬШ"KЪЬЮЬ<ШBKЪЬЮЬЮЬШNKЪЮЬШ	KЪЬШKШ ЧЪ
аЬЮЬЮЬЮЬЮЬШ0KЩKЪЮЬШKШKЪЬЮЬ%Щ5ЧЧЪЬ!Щ!ЪаЬЮЬЮЬЮЬЮЬЮЬШSЪаЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ_KШ KЪЬШЧKШ6KЪЬШKШ ЧЪаЬЮЬЮЬЮЬЮЬЮЬЮЬШ`KЩйKЪ
аЬЮЬЮЬЮЬЮЬШAKШKШЧЧЪЬ
Щ
Ъ
аЬЮЬЮЬЮЬЮЬШ0KЪаЬЮЬЮЬЮЬЮЬЮЬЮЬШHKЪЮЬШKЪЬШЧKШ Ъ
аЬЮЬЮЬЮЬЮЬШ2KЪаЬЮЬЮЬЮЬЮЬЮЬЮЬШJKЪЮЬШKЪЬШKШ ЧЪ
аЬЮЬЮЬЮЬЮЬШ.KЪаЬЮЬЮЬЮЬЮЬЮЬЮЬШFKЪЮЬШKЪЬШKШ ЧЪ
аЬЮЬЮЬЮЬЮЬШ0KЪаЬЮЬЮЬЮЬЮЬЮЬЮЬШHKЪЮЬШKЪЬШKЩ ЧЪ
аЬЮЬЮЬЮЬЮЬШ(KЪаЬЮЬЮЬЮЬЮЬЮЬЮЬШ@KЪЮЬШKЪЬШЧЧЩЪЬЮЬШ#KШ ЧKЪЬЮЬШ#KШ Ъ
аЬЮЬЮЬЮЬЮЬШWKШKЪЬШKЩ.KШ ЧЪаЬЮЬЮЬЮЬШHKЪЮЬ.Ш4KЪЬШKЪЬUЩUKШ ЧЪаЬЮЬЮЬШTKЩ▀KЪЮЬШKЪЬШKЩ.KШ ЧЪаЬЮЬЮЬЮЬЮЬЮЬШSKЪ
ЮЬЮЬЮЬЮЬЮЬШKЪЮЬШ#KЪЬШKЩ:ЧЧЪЬЩKЪаЬЮЬЮЬШ%KЪаЬЮЬЮЬЮЬШ!KЪаЬЮЬЮЬЮЬЮЬ"ЮЬШQKЪаЬЮЬЮЬЮЬЮЬЮЬЮЬШHKЪаЬЮЬЮЬШ:ЧЩ9KЩЬKЩ ЪаЬЮЬЮЬ
ЮЬЮЬЮЬЮЬЮ	ЬбШaKШKШKШ ЧЪаЬЮЬ
ЮЬЮЬЮЬЮЬЮ	ЬбШiKШKШЧЧШ ЪаЬЮЬЮЬЮЬЮЬЮЬбШsЪЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШGKШKЪЬШЧKЪЬЮЬ*Ш7KЪЮЬ	ЮЬЮЬШ&KЪЬЮЬЮЬШ'KШKШЧЧШ ЪаЬЮЬЮЬЮЬЮЬЮЬбШДЪЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШMKШKЪЬШЧKЪЬЮЬ0Ш=KЪЮЬ	ЮЬЮЬШ&KЪЬЮЬЮЬШ'KШKШЧЧШ ЪаЬЮЬЮЬЮЬЮЬЮЬбШIKЪ	Ь
ЮЬЮЬЮЬЮЬШ-KЪЬЮЬЮЬЮЬШ)KЪ
ЮЬЮЬЮЬ
ЮЬЮЬШ?KЪЮЬЮЬЮЬШKШKШ ЧЪа	ЬЮЬЮЬЮЬЮЬЮЬЮЬбШ_KЪЮЬЮЬЮЬЮЬШKЪЮЬЮЬЮЬШ-KЪЮЬШ KШKШ ЧЪаЬЮЬЮЬЮЬЮЬбШcKЪЮЬЮЬЮЬЮЬШKЪЮЬШKШKШ ЧKЪЬЮЬб7ШOKЪЬЮЬбЬШ╡KШ ЪаЬЮЬЮЬЮЬЮЬЮЬШWKЪЬЮЬЮЬЮЬЮЬЮЬШMKЪЮЬШKШKЪЬШKШ ЧЪаЬЮЬЮЬЮЬЮ	ЬЮЬШQKЪЬЮЬЮЬЮЬЮЬЮЬШMKШ
KШЧЧШ ЪаЬЮЬЮЬЮЬЮЬЮЬ ЮЬЮ	ЬбШМKЪЬЩKЪЬЮЬЮЬШFKШЧKШ ЪаЬЮЬЮЬЮЬЮЬЮЬ ЮЬЮ	ЬбШРKЪЬЩKЪЬЮЬЮЬШFKШKШ ЧШKШ KШ ЧЧKЪЮЬШJЩ Ч ЕЧ      )j  