<<>> <> <> <> <> <> <> <> <> <<>> 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] }; <<... 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>> <> 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. <<>>