<> <> <> <> <> DIRECTORY Allocator USING [BlockSizeIndex, bsiEscape, BSIToSizeObj, EHeaderP, ExtendedHeader, FNHeaderP, Header, HeaderP, LastAddress, logPagesPerQuantum, maxSmallBlockSize, minLargeBlockSize, NHeaderP, NormalHeader, pagesPerQuantum, PUZone, QMObject, QuantumCount, QuantumIndex, QuantumMap, RefCount, SizeToBSIObj, UZoneObject, wordsPerQuantum, Zone, ZoneObject], AllocatorOps USING [CreateMediumSizedHeapObject, DFHeaderP, DoubleFreeHeader, FreeMediumSizedHeapObject, nonNullType, permanentPageZone, REFToNHP, Rover], Basics USING [BITAND, BITOR, BITXOR, CARD, DoubleShiftLeft, DoubleShiftRight, HighHalf, LongNumber, LowHalf], DebuggerSwap USING [CallDebugger], PrincOps USING [SD, StateVector, zRET], PrincOpsUtils USING [LongZero, MyLocalFrame], RCMicrocodeOps USING [Allocate, CreateRef, FREEPLEASE, Free, InsertQuanta, rcMicrocodeExists, SoftwareAllocate, SoftwareFree], RTSD USING [sSystemZone], SafeStorage USING [GetCanonicalType, NarrowRefFault, nullType, Type], SafeStoragePrivate USING [], -- TEMPORARY export of NewObject StorageAccounting USING [ConsiderCollection, nObjectsCreated, nObjectsReclaimed, nWordsReclaimed], StorageTraps USING [], SystemVersion USING [machineType], TrapSupport USING [BumpPC, GetTrapParam], UnsafeStorage USING [], UnsafeStoragePrivate USING[FreeTransientPageObject, InitializeTransientPageZone, NewTransientPageObject], VM USING [AddressForPageNumber, Allocate, CantAllocate, Free, Interval, logWordsPerPage, PageNumber, PageNumberForAddress, PagesForWords, Pin, SimpleAllocate, SwapIn, Unpin, WordsForPages, wordsPerPage], ZCT USING [Enter, ExpandZCT]; AllocatorImpl: MONITOR <> IMPORTS AllocatorOps, Basics, DebuggerSwap, PrincOpsUtils, RCMicrocodeOps, SafeStorage, StorageAccounting, SystemVersion, TrapSupport, UnsafeStoragePrivate, VM, ZCT EXPORTS AllocatorOps, SafeStorage, SafeStoragePrivate, StorageTraps, UnsafeStorage = BEGIN OPEN Allocator, AllocatorOps; CARD: TYPE = Basics.CARD; Ptr: TYPE = LONG POINTER; SmallFreeTable: TYPE = ARRAY Allocator.BlockSizeIndex OF Allocator.FNHeaderP; Type: TYPE = SafeStorage.Type; UZone: TYPE = UNCOUNTED ZONE; <> <<>> InsufficientVM: ERROR = CODE; InvalidRef: PUBLIC ERROR[ref: REF ANY] = CODE; <> <<>> checking: BOOL _ TRUE; <> paranoid: BOOL _ SystemVersion.machineType # dorado; <> <> <<>> maxSmallBlockRealSize: NAT = QuantizedSize[maxSmallBlockSize]; minLargeBlockRealSize: NAT = QuantizedSize[minLargeBlockSize]; wordsPerPage: NAT = VM.wordsPerPage; logWordsPerPage: NAT = VM.logWordsPerPage; wordsPerQuantum: NAT = Allocator.wordsPerQuantum; logWordsPerQuantum: NAT = logWordsPerPage+Allocator.logPagesPerQuantum; nullType: SafeStorage.Type = SafeStorage.nullType; NormalHeaderInit: Allocator.NormalHeader = [ type: nullType, blockSizeIndex: 0]; NormalHeaderEscape: Allocator.NormalHeader = [ type: nullType, blockSizeIndex: Allocator.bsiEscape]; ExtendedHeaderInit: Allocator.ExtendedHeader = [ sizeTag: pages, extendedSize: 0, blockSizeIndex: Allocator.bsiEscape, normalHeader: NormalHeaderEscape]; <> hackPtr: LONG POINTER _ VM.AddressForPageNumber[VM.SimpleAllocate[1].page]; HackAlloc: PROC [nWords: CARDINAL] RETURNS [ptr: LONG POINTER] = { ptr _ hackPtr; PrincOpsUtils.LongZero[ptr, nWords]; hackPtr _ hackPtr + nWords; }; <> innerStats: LONG POINTER TO InnerStats _ HackAlloc[SIZE[InnerStats]]; InnerStats: TYPE = RECORD [ countedSmallNewAllocs: INT _ 0, countedBigNewAllocs: INT _ 0, uncountedSmallNewAllocs: INT _ 0, uncountedBigNewAllocs: INT _ 0, countedSmallNewFrees: INT _ 0, countedBigNewFrees: INT _ 0, uncountedSmallNewFrees: INT _ 0, uncountedBigNewFrees: INT _ 0, quantaAllocated: INT _ 0, quantaFreed: INT _ 0 ]; <> <<>> <> <<>> rZnHeapSystem: UZoneObject _ [new: NewHeapObject, free: FreeHeapObject]; znHeapSystem: Ptr _ LONG[@rZnHeapSystem]; zhs: UZone _ LOOPHOLE[LONG[@znHeapSystem], UZone]; <<>> <> <<>> transientPageUZoneObject: UZoneObject _ [ new: UnsafeStoragePrivate.NewTransientPageObject, free: UnsafeStoragePrivate.FreeTransientPageObject]; transientPageUZonePointer: Ptr _ LONG[@transientPageUZoneObject]; transientPageUZone: UZone _ LOOPHOLE[LONG[@transientPageUZonePointer], UZone]; <<>> <> <<>> bsiToSize: PUBLIC LONG POINTER TO BSIToSizeObj _ permanentPageZone.NEW[BSIToSizeObj _ ALL[0]]; <> <<>> sizeToBSI: PUBLIC LONG POINTER TO SizeToBSIObj _ permanentPageZone.NEW[SizeToBSIObj]; <> <> <<>> <> <> <> <> <> <<];>> msRover: Rover _ HackAlloc[SIZE[DoubleFreeHeader]]; <<(Obsolete, but necessary as a place holder)>> <<>> <> <> <> <> <> <<];>> permRover: Rover _ HackAlloc[SIZE[DoubleFreeHeader]]; <<(Obsolete, but necessary as a place holder)>> <<>> quantumMap: PUBLIC QuantumMap _ permanentPageZone.NEW[QMObject]; <> systemZone: ZONE _ NIL; permanentZone: ZONE _ NIL; <<>> <> nQMapEntries: INT _ 0; <<>> <> <> <<>> <> <<>> NewUObject: PUBLIC PROC [size: CARDINAL, zone: UZone] RETURNS [Ptr] = { RETURN [NewHeapObject[LOOPHOLE[zone, PUZone], size]]; }; GetSystemUZone: PUBLIC PROC RETURNS [UZone] = { RETURN [zhs]; }; GetTransientPageUZone: PUBLIC PROC RETURNS [UZone] = { RETURN [transientPageUZone]; }; <> <<>> <> NewHeapObject: PROC [self: PUZone, size: CARDINAL] RETURNS [p: Ptr] = { <> ENABLE UNWIND => Crash[]; realSize: INT = QuantizedSize[MAX[size, SIZE[ExtendedHeader]]]; nhp: NHeaderP; IF size > maxSmallBlockRealSize THEN { <> nhp _ AllocateNewStyle[realSize, FALSE, FALSE]; p _ LOOPHOLE[nhp, NHeaderP] + SIZE[NormalHeader]; } ELSE { <> p _ AllocatorOps.CreateMediumSizedHeapObject[realSize]; <<(this is a monitored call to DoCreateMediumSizedObject)>> nhp _ LOOPHOLE[p, NHeaderP] - SIZE[NormalHeader]; }; nhp.type _ nonNullType; IF UsableWords[nhp] < size THEN Crash[]; }; DoCreateMediumSizedObject: PUBLIC --INTERNAL-- PROC [size: NAT, type: Type, roverP: LONG POINTER TO--VAR-- Rover, counted: BOOL] RETURNS [p: Ptr _ NIL] = { <> <= SIZE[DoubleFreeHeader].>> <> nhp: NHeaderP _ AllocateNewStyle[size, FALSE, FALSE]; nhp.type _ type; p _ nhp+SIZE[NormalHeader]; -- here for the conservative scan IF counted THEN Crash[]; }; FreeHeapObject: PROC [self: PUZone, object: Ptr] = { <> ENABLE UNWIND => Crash[]; nhp: NHeaderP = LOOPHOLE[object - SIZE[NormalHeader]]; IF checking AND (CheckAfterAlloc[nhp] # 0 OR nhp.type # nonNullType) THEN Crash[]; IF nhp.blockSizeIndex = Allocator.bsiEscape THEN { <> FreeNewStyle[object, FALSE]; } ELSE { <> AllocatorOps.FreeMediumSizedHeapObject[object-SIZE[NormalHeader]]; <<(this is a monitored call to DoFreeMediumSizedObject)>> }; }; DoFreeMediumSizedObject: PUBLIC --INTERNAL-- PROC [ptr: DFHeaderP, rover: Rover] = { <> <> bsi: Allocator.BlockSizeIndex _ ptr.eh.blockSizeIndex; counted: BOOL _ rover = permRover; <> IF rover = msRover THEN counted _ TRUE; <> IF bsi # Allocator.bsiEscape THEN { <> FreeNewStyle[LOOPHOLE[ptr, Ptr] + SIZE[Allocator.NormalHeader], counted]; RETURN; }; IF ptr.eh.sizeTag = pages THEN { <> FreeNewStyle[LOOPHOLE[ptr, Ptr] + SIZE[Allocator.ExtendedHeader], counted]; RETURN; }; Crash[]; }; <> <<>> <> GetSystemZone: PUBLIC SAFE PROC RETURNS [ZONE] = TRUSTED{ RETURN [systemZone]; }; GetPermanentZone: PUBLIC SAFE PROC RETURNS [ZONE] = TRUSTED{ RETURN [permanentZone]; }; TrimSystemZone: PUBLIC SAFE PROC = TRUSTED { <> NULL; }; NewObject: PUBLIC PROC [type: Type, size: CARDINAL, zone: ZONE _ NIL] RETURNS [ans: REF _ NIL] = { SELECT zone FROM NIL, systemZone => ans _ NewSystemObject[NIL, size, type]; permanentZone => ans _ NewPermanentObject[NIL, size, type]; ENDCASE => Crash[]; }; ValidateRef: PUBLIC ENTRY PROC [ref: REF] = { ENABLE UNWIND => NULL; IF NOT IsValidRef[LOOPHOLE[ref, Ptr]] THEN RETURN WITH ERROR InvalidRef[ref]; }; IsValidRef: PUBLIC --INTERNAL-- PROC [p: Ptr] RETURNS [BOOL] = { SELECT TRUE FROM p = NIL => RETURN [TRUE]; LOOPHOLE[p, CARD] >= LastAddress => RETURN [FALSE]; Basics.LowHalf[LOOPHOLE[p, CARD]] MOD 2 = 1 => RETURN [FALSE]; ENDCASE => { <> qi: QuantumIndex _ LPToQI[p]; IF quantumMap[qi] THEN { hp: HeaderP _ NIL; UNTIL qi = FIRST[QuantumIndex] OR NOT quantumMap[qi-1] DO qi _ qi-1; ENDLOOP; hp _ QIToLP[qi]; WHILE LOOPHOLE[hp, CARD] < LOOPHOLE[p, CARD] DO bs: Basics.LongNumber; nhp: NHeaderP _ LOOPHOLE[hp, NHeaderP]; extended: BOOL _ nhp.blockSizeIndex = bsiEscape; r: Ptr; IF extended THEN { <> ehp: EHeaderP _ LOOPHOLE[hp]; nhp _ nhp + (SIZE[ExtendedHeader] - SIZE[NormalHeader]); SELECT ehp.sizeTag FROM words => bs.lc _ ehp.extendedSize; pages => bs.lc _ VM.WordsForPages[ehp.extendedSize]; ENDCASE => Crash[]; r _ hp + SIZE[ExtendedHeader]; } ELSE { <> bs.lc _ bsiToSize[nhp.blockSizeIndex]; r _ hp + SIZE[NormalHeader]; }; SELECT TRUE FROM bs.lc = 0, bs.lc >= LastAddress, bs.lo MOD 2 = 1 => <> Crash[]; r = p => RETURN [nhp.type # nullType]; <> ENDCASE; hp _ hp + bs.lc; ENDLOOP; }; RETURN [FALSE]; }; }; <> PinObject: PUBLIC SAFE PROC [ref: REF] = TRUSTED { <<... pins the object & its header in memory>> IF ref # NIL THEN { nhp: HeaderP _ LOOPHOLE[ref, HeaderP] - SIZE[NormalHeader]; hp: HeaderP _ IF IsExtendedBlock[nhp] THEN LOOPHOLE[ref, HeaderP] - SIZE[ExtendedHeader] ELSE nhp; words: INT _ BlockSize[hp]; low: VM.PageNumber _ VM.PageNumberForAddress[hp]; next: VM.PageNumber _ VM.PageNumberForAddress[hp+(words-1)] + 1; VM.Pin[[low, next-low]]; }; }; UnpinObject: PUBLIC SAFE PROC [ref: REF] = TRUSTED { <<... unpins the object & its header (provided it was already pinned)>> IF ref # NIL THEN { nhp: HeaderP _ LOOPHOLE[ref, HeaderP] - SIZE[NormalHeader]; hp: HeaderP _ IF IsExtendedBlock[nhp] THEN LOOPHOLE[ref, HeaderP] - SIZE[ExtendedHeader] ELSE nhp; words: INT _ BlockSize[hp]; low: VM.PageNumber _ VM.PageNumberForAddress[hp]; next: VM.PageNumber _ VM.PageNumberForAddress[hp+(words-1)] + 1; VM.Unpin[[low, next-low]]; }; }; <> <<>> NewSystemObject: PROC [self: Zone, size: CARDINAL, type: Type] RETURNS [r: REF] = { <> <> nhp: NHeaderP _ NIL; realSize: INT _ size; IF type = nullType THEN ERROR; <> IF (r _ RCMicrocodeOps.Allocate[size, type]) # NIL THEN { <> nhp _ LOOPHOLE[r, NHeaderP] - SIZE[NormalHeader]; IF checking AND CheckAfterNewRef[nhp, type] # 0 THEN Crash[]; realSize _ bsiToSize[nhp.blockSizeIndex]; IF realSize = 0 THEN Crash[]; } ELSE { <> nhp: NHeaderP _ NIL; realSize _ QuantizedSize[size]; IF size >= minLargeBlockSize THEN realSize _ LONG[size] + SIZE[ExtendedHeader]; nhp _ AllocateNewStyleEntry[realSize, TRUE, FALSE]; nhp.type _ type; IF checking AND CheckAfterAlloc[nhp] # 0 THEN Crash[]; r _ LOOPHOLE[nhp+SIZE[NormalHeader]]; RCMicrocodeOps.CreateRef[nhp]; IF paranoid THEN { <> IF CheckAfterNewRef[nhp, type] # 0 THEN Crash[]; IF UsableWords[nhp] < size THEN Crash[]; }; }; StorageAccounting.nObjectsCreated _ StorageAccounting.nObjectsCreated + 1; StorageAccounting.ConsiderCollection[size, realSize]; }; ExpandNormalFreeList: PUBLIC PROC [bsi: BlockSizeIndex] = { <> [] _ ExpandAnyFreeList[bsi, TRUE, FALSE]; }; ExpandAnyFreeList: PROC [bsi: BlockSizeIndex, install, permanent: BOOL] RETURNS [first, last, next: FNHeaderP _ NIL] = { <> qi: QuantumIndex; qc: QuantumCount; incr: NAT = bsiToSize[bsi]; druthers: QuantumCount = WordsToQC[Lcm[incr, wordsPerQuantum]]; <> [qi, qc] _ GetQuanta[druthers, NOT install]; first _ last _ LOOPHOLE[QIToLP[qi], FNHeaderP]; next _ LOOPHOLE[QIToLP[qi+qc], FNHeaderP]; Clear[first, QCToWords[qc]]; <> DO after: FNHeaderP _ last+incr; last.fnh _ [blockSizeIndex: bsi]; IF after = next THEN EXIT; last.nextFree _ after; last _ after; ENDLOOP; last.nextFree _ NIL; IF install THEN <> PutQuantaOnNormalFreeList[bsi, first, last, qi, qc]; }; PutQuantaOnNormalFreeList: ENTRY PROC [bsi: BlockSizeIndex, first, last: FNHeaderP, qi: QuantumIndex, qc: QuantumCount] = { <> <> ENABLE UNWIND => NULL; RCMicrocodeOps.InsertQuanta[bsi, first, last]; <> StuffQMapRange[qi, qc]; }; <<>> NewPermanentObject: PROC [self: Zone, size: CARDINAL, type: Type] RETURNS [r: REF _ NIL] = { <> <> realSize: CARD _ LONG[size] + SIZE[NormalHeader]; nhp: NHeaderP _ NIL; IF type = nullType THEN ERROR; <> IF size >= minLargeBlockSize THEN realSize _ LONG[size] + SIZE[ExtendedHeader]; nhp _ AllocateNewStyleEntry[realSize, TRUE, TRUE]; nhp.type _ type; StorageAccounting.nObjectsCreated _ StorageAccounting.nObjectsCreated + 1; StorageAccounting.ConsiderCollection[size, realSize]; IF checking AND UsableWords[nhp] < size THEN Crash[]; RCMicrocodeOps.CreateRef[nhp]; IF paranoid THEN { <> IF CheckAfterNewRef[nhp, type] # 0 THEN Crash[]; IF UsableWords[nhp] < size THEN Crash[]; }; RETURN [LOOPHOLE[nhp+SIZE[NormalHeader]]]; }; FreeSystemObject: PROC [self: Zone, object: REF ANY] = { <> <> }; <> <<>> FreeObject: PUBLIC PROC [nhp: NHeaderP] = { realSize: INT _ RealWords[nhp]; IF checking AND (CheckAfterAlloc[nhp] # 0 OR nhp.type = nullType) THEN Crash[]; BumpWordsReclaimed[realSize]; <> IF NOT RCMicrocodeOps.Free[nhp].success THEN { <> ehp: EHeaderP = NHPToEHP[nhp]; IF nhp.blockSizeIndex # Allocator.bsiEscape THEN Crash[]; SELECT ehp.sizeTag FROM pages => { qi: QuantumIndex _ LPToQI[ehp]; qc: QuantumCount _ WordsToQC[realSize]; IF checking THEN { ln: Basics.LongNumber _ [li[realSize]]; IF ln.lo MOD wordsPerQuantum # 0 THEN Crash[]; IF Basics.LowHalf[LOOPHOLE[ehp, CARD]] MOD wordsPerQuantum # 0 THEN Crash[]; IF NOT IsFullQMapRange[qi, qc] THEN Crash[]; }; ClearQMapRange[qi, qc]; FreeQuanta[qi, qc]; }; ENDCASE => Crash[]; }; }; <<>> TAndSFreeObject: PUBLIC --INTERNAL-- PROC [nhp: NHeaderP] = { realSize: INT _ RealWords[nhp]; IF checking AND CheckAfterAlloc[nhp] # 0 THEN Crash[]; IF nhp.type # nullType THEN { <> StorageAccounting.nObjectsReclaimed _ StorageAccounting.nObjectsReclaimed + 1; StorageAccounting.nWordsReclaimed _ StorageAccounting.nWordsReclaimed + realSize; }; IF NOT RCMicrocodeOps.FREEPLEASE[nhp].success THEN { <> ehp: EHeaderP = NHPToEHP[nhp]; IF nhp.blockSizeIndex # Allocator.bsiEscape THEN Crash[]; SELECT ehp.sizeTag FROM pages => { qi: QuantumIndex _ LPToQI[ehp]; qc: QuantumCount _ WordsToQC[realSize]; IF checking THEN { ln: Basics.LongNumber _ [li[realSize]]; IF ln.lo MOD wordsPerQuantum # 0 THEN Crash[]; IF Basics.LowHalf[LOOPHOLE[ehp, CARD]] MOD wordsPerQuantum # 0 THEN Crash[]; IF NOT IsFullQMapRangeInternal[qi, qc] THEN Crash[]; }; ClearQMapRangeInternal[qi, qc]; FreeQuanta[qi, qc]; }; ENDCASE => Crash[]; }; }; EnterAndCallBack: PUBLIC ENTRY PROC [proc: PROC] = { <> ENABLE UNWIND => NULL; proc[]; }; BumpWordsReclaimed: ENTRY PROC [words: INT] = { StorageAccounting.nObjectsReclaimed _ StorageAccounting.nObjectsReclaimed + 1; StorageAccounting.nWordsReclaimed _ StorageAccounting.nWordsReclaimed + words; }; <> AllocateTrap: PUBLIC PROC [size: CARDINAL, type: Type] RETURNS [r: REF] = { state: PrincOps.StateVector; state _ STATE; -- incantation SELECT (IF RCMicrocodeOps.rcMicrocodeExists THEN TrapSupport.GetTrapParam[] ELSE 0) FROM 0 => <> r _ RCMicrocodeOps.SoftwareAllocate[size, type]; 2 => { <> p: PROC [size: CARDINAL, type: Type] = MACHINE CODE{PrincOps.zRET}; ZCT.Enter[]; state.dest _ LOOPHOLE[PrincOpsUtils.MyLocalFrame[]]; TRANSFER WITH state; -- incantation p[size, type]; }; 4 => { <> p: PROC [size: CARDINAL, type: Type] = MACHINE CODE{PrincOps.zRET}; ZCT.ExpandZCT[]; state.dest _ LOOPHOLE[PrincOpsUtils.MyLocalFrame[]]; TRANSFER WITH state; -- incantation p[size, type]; }; 6 => { <> p: PROC [size: CARDINAL, type: Type] = MACHINE CODE{PrincOps.zRET}; ExpandNormalFreeList[sizeToBSI[size]]; state.dest _ LOOPHOLE[PrincOpsUtils.MyLocalFrame[]]; TRANSFER WITH state; -- incantation p[size, type]; }; ENDCASE => Crash[]; TrapSupport.BumpPC[2]; -- length of opcode state.dest _ LOOPHOLE[PrincOpsUtils.MyLocalFrame[]]; TRANSFER WITH state; -- incantation }; FreeTrap: PUBLIC PROC [nhp: NHeaderP] RETURNS [success: BOOL] = { state: PrincOps.StateVector; state _ STATE; -- incantation SELECT (IF RCMicrocodeOps.rcMicrocodeExists THEN TrapSupport.GetTrapParam[] ELSE 0) FROM 0 => success _ RCMicrocodeOps.SoftwareFree[nhp]; -- no microcode 2 => { -- uCode is disabled; someone is inside this monitor p: PROC [nhp: NHeaderP] = MACHINE CODE{PrincOps.zRET}; ZCT.Enter[]; state.dest _ LOOPHOLE[PrincOpsUtils.MyLocalFrame[]]; TRANSFER WITH state; -- incantation p[nhp]; }; ENDCASE => Crash[]; TrapSupport.BumpPC[2]; -- length of opcode state.dest _ LOOPHOLE[PrincOpsUtils.MyLocalFrame[]]; TRANSFER WITH state; -- incantation }; <> GetReferentType: PUBLIC SAFE PROC [ref: REF] RETURNS [type: Type] = TRUSTED { RETURN [GetCanonicalReferentType[ref]] }; GetCanonicalReferentType: PUBLIC SAFE PROC [ref: REF] RETURNS [type: Type] = TRUSTED { IF ref = NIL THEN RETURN [nullType] ELSE RETURN [REFToNHP[ref].type] }; GetCanonicalReferentTypeTrap: PUBLIC PROC [ref: REF] RETURNS [type: Type] = { state: PrincOps.StateVector; kludge: CARD; state _ STATE; -- incantation kludge _ 0; type _ GetCanonicalReferentType[ref]; TrapSupport.BumpPC[2]; state.dest _ LOOPHOLE[PrincOpsUtils.MyLocalFrame[]]; TRANSFER WITH state -- incantation }; IsReferentType: PUBLIC SAFE PROC [ref: REF, type: Type] RETURNS [BOOL] = TRUSTED { RETURN [SafeStorage.GetCanonicalType[type] = GetCanonicalReferentType[ref]]; }; NarrowRef: PUBLIC SAFE PROC [ref: REF, type: Type] RETURNS [REF] = TRUSTED { SELECT TRUE FROM ref = NIL => RETURN [NIL]; SafeStorage.GetCanonicalType[type] = GetCanonicalReferentType[ref] => RETURN [ref]; ENDCASE => ERROR SafeStorage.NarrowRefFault[ref, type]; }; <<>> <> StuffQMapRange: --INTERNAL-- PROC [qi: QuantumIndex, qc: QuantumCount] = { nQMapEntries _ nQMapEntries + qc; FOR i: QuantumIndex _ qi, i+1 UNTIL i = qi + qc DO quantumMap[i] _ TRUE; ENDLOOP; }; ClearQMapRange: ENTRY PROC [qi: QuantumIndex, qc: QuantumCount] = { ENABLE UNWIND => NULL; ClearQMapRangeInternal[qi, qc]; }; ClearQMapRangeInternal: --INTERNAL-- PROC [qi: QuantumIndex, qc: QuantumCount] = { nQMapEntries _ nQMapEntries - qc; FOR i: QuantumIndex _ qi, i+1 UNTIL i = qi + qc DO quantumMap[i] _ FALSE; ENDLOOP; }; IsFullQMapRange: ENTRY PROC [qi: QuantumIndex, qc: QuantumCount] RETURNS [ans: BOOL _ TRUE] = { ENABLE UNWIND => NULL; RETURN [IsFullQMapRangeInternal[qi, qc]]; }; IsFullQMapRangeInternal: --INTERNAL-- PROC [qi: QuantumIndex, qc: QuantumCount] RETURNS [ans: BOOL _ TRUE] = { FOR i: QuantumIndex _ qi, i+1 UNTIL i = qi + qc DO IF NOT quantumMap[i] THEN RETURN [FALSE]; ENDLOOP; }; <> AllocateNewStyleEntry: ENTRY PROC [size: CARD, counted, permanent: BOOL] RETURNS [nhp: NHeaderP _ NIL] = { ENABLE UNWIND => Crash[]; RETURN [AllocateNewStyle[size, counted, permanent]]; }; AllocateNewStyle: PROC [size: CARD, counted, permanent: BOOL] RETURNS [nhp: NHeaderP _ NIL] = { <> <= SIZE[DoubleFreeHeader].>> <> <> ehp: EHeaderP _ NIL; SELECT size FROM <= SIZE[Allocator.NormalHeader] => Crash[]; <= maxSmallBlockRealSize => { <> words: CARDINAL _ SELECT Basics.LowHalf[size] FROM <> <= 20B => Basics.BITAND[Basics.LowHalf[size]+7, 177777B-7], <<8, 16>> <= 100B => Basics.BITAND[Basics.LowHalf[size]+17B, 177777B-17B], <<32, 48, 64 >> <= 1000B => Basics.BITAND[Basics.LowHalf[size]+177B, 177777B-177B], <<128, 256, 384, 512>> ENDCASE => maxSmallBlockRealSize; <<576>> bsi: Allocator.BlockSizeIndex _ sizeToBSI[words-SIZE[Allocator.NormalHeader]]; objectWords: CARDINAL _ bsiToSize[bsi]; table: LONG POINTER TO SmallFreeTable _ IF counted THEN countedFreeTable ELSE uncountedFreeTable; fhp: Allocator.FNHeaderP _ table[bsi]; IF counted THEN innerStats.countedSmallNewAllocs _ innerStats.countedSmallNewAllocs + 1 ELSE innerStats.uncountedSmallNewAllocs _ innerStats.uncountedSmallNewAllocs + 1; IF fhp = NIL THEN { <> first, last, next: FNHeaderP; [first, last, next] _ ExpandAnyFreeList[bsi, FALSE, permanent]; <> IF counted THEN <> StuffQMapRange[qi: LPToQI[first], qc: LPToQI[next]-LPToQI[first]]; fhp _ table[bsi] _ first; }; table[bsi] _ fhp.nextFree; nhp _ LOOPHOLE[fhp]; IF nhp.blockSizeIndex # bsi OR nhp.type # nullType THEN <> Crash[]; Clear[nhp+SIZE[Allocator.NormalHeader], objectWords-SIZE[Allocator.NormalHeader]]; nhp^ _ NormalHeaderInit; nhp.blockSizeIndex _ bsi; }; ENDCASE => { <> qi: QuantumIndex; qc: QuantumCount _ WordsToQC[size]; np: INT _ QCToPages[qc]; [qi, qc] _ GetQuanta[qc, permanent]; ehp _ QIToLP[qi]; Clear[ehp, VM.WordsForPages[np]]; IF counted THEN { <> StuffQMapRange[qi: LPToQI[ehp], qc: qc]; innerStats.countedBigNewAllocs _ innerStats.countedBigNewAllocs + 1; } ELSE { <> innerStats.uncountedBigNewAllocs _ innerStats.uncountedBigNewAllocs + 1; }; ehp^ _ ExtendedHeaderInit; ehp.extendedSize _ np; nhp _ @ehp.normalHeader; }; IF checking AND CheckAfterAlloc[nhp] # 0 THEN Crash[]; }; FreeNewStyle: PROC [ptr: Ptr, counted: BOOL] = { <> IF Basics.HighHalf[LOOPHOLE[ptr]] # 0 AND Basics.LowHalf[LOOPHOLE[ptr]] MOD 2 = 0 THEN { nhp: NHeaderP _ LOOPHOLE[ptr, NHeaderP]-SIZE[Allocator.NormalHeader]; IF nhp.type = nullType THEN Crash[]; SELECT TRUE FROM nhp.blockSizeIndex = Allocator.bsiEscape => { <> ehp: EHeaderP _ LOOPHOLE[ptr, EHeaderP]-SIZE[Allocator.ExtendedHeader]; SELECT ehp.sizeTag FROM pages => { np: CARDINAL _ ehp.extendedSize; qi: QuantumIndex _ LPToQI[ehp]; qc: QuantumCount _ PagesToQC[np]; ehp.extendedSize _ 0; IF np = 0 THEN Crash[]; IF Basics.BITAND[wordsPerQuantum-1, Basics.LowHalf[LOOPHOLE[ehp]] ] # 0 THEN Crash[]; IF counted THEN { ClearQMapRangeInternal[qi, qc]; innerStats.countedBigNewFrees _ innerStats.countedBigNewFrees + 1 } ELSE innerStats.uncountedBigNewFrees _ innerStats.uncountedBigNewFrees + 1; FreeQuanta[qi, qc]; RETURN; }; ENDCASE; }; ENDCASE => { <> bsi: Allocator.BlockSizeIndex _ nhp.blockSizeIndex; table: LONG POINTER TO SmallFreeTable _ IF counted THEN countedFreeTable ELSE uncountedFreeTable; fhp: Allocator.FNHeaderP _ LOOPHOLE[nhp, Allocator.FNHeaderP]; IF counted THEN innerStats.countedSmallNewFrees _ innerStats.countedSmallNewFrees + 1 ELSE innerStats.uncountedSmallNewFrees _ innerStats.uncountedSmallNewFrees + 1; fhp.fnh _ NormalHeaderInit; fhp.fnh.blockSizeIndex _ bsi; fhp.nextFree _ table[bsi]; table[bsi] _ fhp; RETURN; }; }; IF ptr # NIL THEN Crash[]; }; countedFreeTable: LONG POINTER TO SmallFreeTable _ InitSmallAllocator[]; <> uncountedFreeTable: LONG POINTER TO SmallFreeTable _ InitSmallAllocator[]; <> InitSmallAllocator: PROC RETURNS [ptr: LONG POINTER TO SmallFreeTable] = { pages: NAT _ VM.PagesForWords[SIZE[SmallFreeTable]]; interval: VM.Interval _ VM.Allocate[count: pages, in64K: TRUE]; VM.SwapIn[interval]; ptr _ LOOPHOLE[VM.AddressForPageNumber[interval.page]]; Clear[ptr, SIZE[SmallFreeTable]]; }; <<>> <> QuantizedSize: PROC [size: CARDINAL] RETURNS [rtn: INT] = { < maxSmallBlockSize require extended headers. It is not true that the difference between any two quantized sizes is a valid quantized size.>> n: NAT = SIZE[NormalHeader]; -- minimum overhead e: NAT = SIZE[ExtendedHeader]; -- additional overhead for extended headers IF checking AND size = 0 THEN Crash[]; IF size <= Allocator.maxSmallBlockSize THEN { adj: NAT _ size-1+n; SELECT size FROM <= 22B => rtn _ (adj/2 + 1)*2; -- 4, 6, 10B, 12B, 14B, 16B, 20B, 22B, 24B <= 42B => rtn _ (adj/4B + 1)*4B; -- 30B, 34B, 40B, 44B <= 106B => rtn _ (adj/10B + 1)*10B; -- 50B, 60B, 70B, 100B, 110B <= 216B => rtn _ (adj/20B + 1)*20B; -- 120B, 140B, 160B, 200B, 220B <= 436B => rtn _ (adj/40B + 1)*40B; -- 240B, 300B, 340B, 400B, 440B ENDCASE => rtn _ (adj/100B + 1)*100B; -- 500B, 600B, 700B, 1000B, 1100B RETURN }; IF size <= Allocator.maxSmallBlockSize*2 THEN <> RETURN [((size-1+e)/200B + 1)*200B]; <> RETURN [VM.WordsForPages[VM.PagesForWords[LONG[size]+e]]]; }; BlockSize: PUBLIC PROC [hp: HeaderP] RETURNS [INT] = { nhp: NHeaderP = LOOPHOLE[hp, NHeaderP]; IF nhp.blockSizeIndex = bsiEscape THEN RETURN [ExtendedBlockSize[LOOPHOLE[hp, EHeaderP]]] ELSE RETURN [bsiToSize[nhp.blockSizeIndex]]; }; IsExtendedBlock: PROC [hp: HeaderP] RETURNS [BOOL] = INLINE { RETURN [LOOPHOLE[hp, NHeaderP].blockSizeIndex = bsiEscape]; }; ExtendedBlockSize: PROC [ehp: EHeaderP] RETURNS [words: INT _ 0] = INLINE { SELECT ehp.sizeTag FROM words => words _ ehp.extendedSize; pages => words _ VM.WordsForPages[ehp.extendedSize]; ENDCASE => Crash[]; }; RealWords: PROC [nhp: NHeaderP] RETURNS [words: INT] = INLINE { IF nhp.blockSizeIndex # bsiEscape THEN RETURN [bsiToSize[nhp.blockSizeIndex]] ELSE { ehp: EHeaderP _ NHPToEHP[nhp]; SELECT ehp.sizeTag FROM words => words _ ehp.extendedSize; pages => words _ VM.WordsForPages[ehp.extendedSize]; ENDCASE => Crash[]; RETURN [words]; }; }; UsableWords: PROC [nhp: NHeaderP] RETURNS [INT] = INLINE { IF nhp.blockSizeIndex # bsiEscape THEN RETURN [bsiToSize[nhp.blockSizeIndex] - SIZE[NormalHeader]] ELSE RETURN [ExtendedBlockSize[NHPToEHP[nhp]] - SIZE[ExtendedHeader]]; }; QIToLP: PROC [qi: QuantumIndex] RETURNS [Ptr] = INLINE { RETURN [Basics.DoubleShiftLeft[[lc[qi]], logWordsPerQuantum].lp]; }; LPToQI: PROC [ptr: Ptr] RETURNS [QuantumIndex] = INLINE { RETURN [Basics.DoubleShiftRight[[lp[ptr]], logWordsPerQuantum].lo]; }; QCToWords: PROC [qc: QuantumCount] RETURNS [INT] = INLINE { RETURN [Basics.DoubleShiftLeft[[lc[qc]], logWordsPerQuantum].li]; }; WordsToQC: PROC [words: INT] RETURNS [QuantumCount] = INLINE { RETURN [Basics.DoubleShiftRight[[li[words+(wordsPerQuantum-1)]], logWordsPerQuantum].lo]; }; PagesToQC: PROC [pages: INT] RETURNS [qc: QuantumCount] = INLINE { IF Allocator.logPagesPerQuantum = 0 THEN RETURN [pages]; pages _ pages + (pagesPerQuantum-1); RETURN [Basics.DoubleShiftRight[[li[pages]], Allocator.logPagesPerQuantum].lo]; }; QCToPages: PROC [qc: QuantumCount] RETURNS [pages: INT] = INLINE { IF Allocator.logPagesPerQuantum = 0 THEN RETURN [qc] ELSE RETURN [Basics.DoubleShiftLeft[[lc[qc]], Allocator.logPagesPerQuantum].li]; }; EHPToNHP: PROC [ehp: EHeaderP] RETURNS [NHeaderP] = INLINE { RETURN [@ehp.normalHeader]; }; NHPToEHP: PROC [nhp: NHeaderP] RETURNS [EHeaderP] = INLINE { RETURN [LOOPHOLE[nhp - (SIZE[ExtendedHeader] - SIZE[NormalHeader]), EHeaderP]]; }; DFHPToNHP: PROC [dfhp: DFHeaderP] RETURNS [NHeaderP] = INLINE { RETURN [@dfhp.eh.normalHeader]; }; FunnyHeaderPtr: TYPE = LONG POINTER TO FunnyHeader; FunnyHeader: TYPE = MACHINE DEPENDENT RECORD [ preType (0): WORD, type (1): WORD]; CheckAfterAlloc: PROC [nhp: NHeaderP] RETURNS [WORD] = INLINE { RETURN [Basics.BITAND[LOOPHOLE[nhp, FunnyHeaderPtr].preType, maskWord1]]; <> }; maskWord1: WORD = LOOPHOLE[Allocator.NormalHeader[ inZCT: TRUE, f: TRUE, rcOverflowed: TRUE, refCount: LAST[Allocator.RefCount], blockSizeIndex: 0], FunnyHeader].preType; CheckAfterNewRef: PROC [nhp: NHeaderP, type: Type] RETURNS [WORD] = INLINE { RETURN [Basics.BITOR[ Basics.BITAND[LOOPHOLE[nhp, FunnyHeaderPtr].preType, maskWord2], Basics.BITXOR[LOOPHOLE[nhp, FunnyHeaderPtr].type, type] ]]; }; maskWord2: WORD = LOOPHOLE[Allocator.NormalHeader[ f: TRUE, rcOverflowed: TRUE, refCount: LAST[Allocator.RefCount], blockSizeIndex: 0], FunnyHeader].preType; Clear: PROC [ptr: Ptr, size: INT] = { delta: CARDINAL = 20000B; WHILE size > delta DO PrincOpsUtils.LongZero[ptr, delta]; size _ size - delta; ptr _ ptr + delta; ENDLOOP; PrincOpsUtils.LongZero[ptr, Basics.LowHalf[size]]; }; Lcm: PROC [m,n: INT] RETURNS [INT] = { RETURN [(m*n)/Gcd[m,n]]; }; Gcd: PROC [m,n: INT] RETURNS [INT] = { DO r: INT = m MOD n; IF r = 0 THEN RETURN [n]; m _ n; n _ r; ENDLOOP; }; GetQuanta: PROC [needed: QuantumCount, permanent: BOOL _ FALSE] RETURNS [qi: QuantumIndex, qc: QuantumCount] = { <> np: INT _ QCToPages[qc _ needed]; interval: VM.Interval _ VM.Allocate[ count: np, alignment: logPagesPerQuantum, in64K: permanent ! VM.CantAllocate => GO TO noVM ]; VM.SwapIn[interval]; qi _ PagesToQC[interval.page]; innerStats.quantaAllocated _ innerStats.quantaAllocated + qc; EXITS noVM => ERROR InsufficientVM; }; FreeQuanta: PROC [qi: QuantumIndex, qc: QuantumCount] = { <> VM.Free[[page: QCToPages[qi], count: QCToPages[qc]]]; innerStats.quantaFreed _ innerStats.quantaFreed + qc; }; <<>> Initialize: PUBLIC PROC = { <> systemZone _ LOOPHOLE[NewSystemObject[NIL, SIZE[ZoneObject], CODE[ZoneObject]], ZONE]; LOOPHOLE[systemZone, Zone]^ _ [new: NewSystemObject, free: FreeSystemObject]; LOOPHOLE[@PrincOps.SD[RTSD.sSystemZone], POINTER TO Ptr]^ _ LOOPHOLE[systemZone, Ptr]; permanentZone _ LOOPHOLE[NEW[ZoneObject _ [new: NewPermanentObject, free: FreeSystemObject]]]; UnsafeStoragePrivate.InitializeTransientPageZone[]; }; Reset: PUBLIC PROC = { <> countedFreeTable^ _ ALL[NIL]; uncountedFreeTable^ _ ALL[NIL]; }; Crash: PROC = { DebuggerSwap.CallDebugger["Kosher it's not!"L]; }; <> { <> oldQS: NAT _ 0; nextBSI: BlockSizeIndex _ 0; <> FOR i: QuantumIndex IN QuantumIndex DO quantumMap[i] _ FALSE ENDLOOP; FOR size: --requested-- [0..maxSmallBlockSize] IN [0..maxSmallBlockSize] DO qs: NAT = QuantizedSize[IF size = 0 THEN 1 ELSE size]; IF qs # oldQS THEN { <> IF nextBSI = bsiEscape THEN Crash[]; oldQS _ qs; bsiToSize[nextBSI] _ qs; nextBSI _ nextBSI + 1; }; sizeToBSI[size] _ nextBSI - 1; ENDLOOP; <> }; END. <> <> <<>> <> <> <> <> <<>> <<>>