-- RTPrefAllocImpl.Mesa -- last edited On August 30, 1982 10:34 am by Willie-Sue Haugeland -- last edited On November 24, 1982 4:40 pm by Paul Rovner DIRECTORY Inline USING[LowHalf, BITAND], -- for debugging Environment USING[wordsPerPage], PrincOps USING[StateVector], RCMap USING[nullIndex], RTBases USING[GetSubspaceQuanta], RTBasic USING[Pointer, nullType, TypeIndex], RTCommon USING[RepAddrPtr, ShortenLongCardinal], RTFlags USING[checking, clearing, takingStatistics, useMicrocode], RTMicrocode USING[ALLOCATEHEAPNODE, LONGZERO], RTOS USING[MyLocalFrame], RTQuanta USING[LASTAddress, QuantumSizeMULT, PagesPerQuantum, QuantumCount, QuantumIndex], RTRefCounts USING[CreateRef, GCMicrocodeExists, AllocatorTrapStatsRec], RTStorageAccounting USING[ConsiderCollection, nObjectsCreated, AllocatorCallbackProcForSpy], RTStorageOps USING[FreeCollectibleObject], RTTypesBasic USING[Type, InvalidType], RTTypesBasicPrivate USING[NPackageRefs, MapTiRcmx], Runs USING[AddInterval], Runtime USING[CallDebugger], SafeStorage USING[MemoryExhausted, InvalidSize, GetSystemZone], Space USING[Handle, GetHandle, Unmap, Create, Map, PageFromLongPointer, defaultWindow], SSExtra USING[SizeToZn, maxSizeToZnIndex, QuantizedSize, useSizeToZn], -- XXX UnsafeStorage USING[], TrapSupport USING[BumpPC, GetTrapParam], RTZones; RTPrefAllocImpl: MONITOR -- protects zones LOCKS zn.LOCK USING zn: PZone IMPORTS RTBases, RTCommon, RTMicrocode, RTOS, RTQuanta, RTRefCounts, RTStorageAccounting, RTStorageOps, RTTypesBasic, RTTypesBasicPrivate, Runs, Runtime, SafeStorage, Space, SSExtra, TrapSupport, RTZones EXPORTS RTRefCounts, RTZones, RTStorageOps SHARES RTBasic = BEGIN OPEN RTBasic, RTMicrocode, RTRefCounts, RTStorageOps, RTTypesBasic, RTTypesBasicPrivate, SafeStorage, RTZones, RTQuanta; -- Signals SuspectPtrSeen: SIGNAL[suspectPtr: Pointer] = CODE; -- hook for debugging InvalidZone: ERROR[zone: ZONE] = CODE; SizeTooBig: SIGNAL[size: CARDINAL] = CODE; -- Global variables and constants useAllocUCode: BOOLEAN _ RTFlags.useMicrocode AND NOT SSExtra.useSizeToZn; -- XXX useFreeUCode: BOOLEAN _ RTFlags.useMicrocode; checking: BOOLEAN = RTFlags.checking; clearing: BOOLEAN = RTFlags.clearing; traceAndMarkEnabled: BOOLEAN = FALSE; --NOTE takingStatistics: BOOLEAN = RTFlags.takingStatistics; -- "= FALSE" suppresses compilation of statistics code suspectPtr: Pointer _ NIL; -- for debugging -- Statistics Count: TYPE = LONG CARDINAL; Bump: PROC[p: POINTER TO Count, delta: Count _ 1] = INLINE BEGIN IF takingStatistics THEN p^ _ p^+delta END; AllocStatsRec: TYPE = RECORD [ nAllocateHeapNodeTraps: Count _ 0, nExpandPrefixedZone: Count _ 0 ]; Stats: AllocStatsRec _ []; -- the one and only PrefixedAllocatorTrapStats: PUBLIC RTRefCounts.AllocatorTrapStatsRec _ []; -- PUBLIC procedures (i.e. exported) -- The result will point to the beginning of a subspace (a page boundary) -- zone must be a prefixed ZONE -- type must not be RC -- Pages will all be from the same space NewCollectibleSubspace: PUBLIC PROC[nPages: CARDINAL, type: Type, zone: ZONE _ NIL] RETURNS[REF ANY] = { IF zone = NIL THEN zone _ zoneSystem; IF MapTiRcmx[LOOPHOLE[type]] # RCMap.nullIndex THEN ERROR RTTypesBasic.InvalidType[type]; WITH zn: LOOPHOLE[zone, Zone] SELECT FROM quantized => ERROR InvalidZone[zone]; prefixed => { size: CARDINAL = nPages*Environment.wordsPerPage + sizeNd; nQ: QuantumCount _ MapSizeNq[size]; ptr: Pointer _ ExtendZoneWithSubspace[LOOPHOLE[zone, PPrefixedZone], size, nPages, type, nQ, RTBases.GetSubspaceQuanta[nQ]]; IF checking THEN {IF LOOPHOLE[ptr, LONG CARDINAL] MOD Environment.wordsPerPage # 0 THEN ERROR; IF ptr = suspectPtr THEN SIGNAL SuspectPtrSeen[suspectPtr]}; IF takingStatistics THEN { zn.cellsInService _ zn.cellsInService + size; zn.overheadCells _ zn.overheadCells + sizeNd; zn.objectsInService _ zn.objectsInService + 1}; -- TandS: CreateRef OK outside the monitor if it is idempotent and new storage has been cleared CreateRef[NPackageRefs[type], LOOPHOLE[ptr, REF ANY]]; RTStorageAccounting.nObjectsCreated _ RTStorageAccounting.nObjectsCreated + 1; IF FALSE --checking THEN FOR i: CARDINAL IN [0..size) DO IF (LOOPHOLE[ptr, LONG POINTER TO CARDINAL] + i)^ # 0 THEN ERROR ENDLOOP; RTStorageAccounting.ConsiderCollection[size]; RETURN[LOOPHOLE[ptr, REF ANY]]}; ENDCASE => ERROR}; ExtendZoneWithSubspace: ENTRY PROC[zn: PPrefixedZone, size, nPages: CARDINAL, type: Type, nQ: QuantumCount, qNew: QuantumIndex] RETURNS[ptr: Pointer] = { ENABLE UNWIND => NULL; nPrefixPages: CARDINAL; fragSize: CARDINAL; fragSpace, space: Space.Handle; fragSize _ RTCommon.ShortenLongCardinal[QuantumSizeMULT[nQ] - size]; nPrefixPages _ nQ * PagesPerQuantum - nPages; ptr _ RTCommon.RepAddrPtr[QuantumSizeMULT[qNew]]; -- ptr to prefix fragment FOR q: QuantumIndex IN [qNew..qNew + nQ) DO MapQZf[q] _ [prefixed[zn.zi]]; ENDLOOP; Runs.AddInterval[@zn.runs, qNew, nQ]; space _ Space.GetHandle[Space.PageFromLongPointer[ptr]]; Space.Unmap[space]; fragSpace _ Space.Create[size: nPrefixPages, parent: space, base: 0]; [] _ Space.Create[size: nPages, parent: space, base: nPrefixPages]; Space.Map[fragSpace, Space.defaultWindow]; AddBlock[ptr, fragSize, zn.pfn]; IF clearing THEN [] _ LONGZERO[ptr + fragSize + sizeNd, size - sizeNd]; ptr _ MakeInuseHeapNode[ptr + fragSize, size, type] + sizeNd; }; NewPrefixedObject: PUBLIC PROC[self: PrefixedZone, size: CARDINAL, type: Type] RETURNS[ref: REF ANY] = { triedAgain: BOOLEAN _ FALSE; IF RTStorageAccounting.AllocatorCallbackProcForSpy # 0 THEN LOOPHOLE[RTStorageAccounting.AllocatorCallbackProcForSpy, PROC[CARDINAL]][size]; ref _ LOOPHOLE[CreatePrefixedObject[self, size, type]]; -- TandS: CreateRef OK outside the monitor if it is idempotent and new storage has been cleared CreateRef[NPackageRefs[type], ref]; RTStorageAccounting.nObjectsCreated _ RTStorageAccounting.nObjectsCreated + 1; IF FALSE --checking THEN FOR i: CARDINAL IN [0..size) DO IF (LOOPHOLE[ref, LONG POINTER TO CARDINAL] + i)^ # 0 THEN ERROR ENDLOOP; RTStorageAccounting.ConsiderCollection [Inline.LowHalf[NodeLength[LOOPHOLE[ref, PNode] - sizeNd]]]}; FreePrefixedObject: PUBLIC PROC[self: PrefixedZone, object: REF ANY] = { FreeCollectibleObject[object]}; NewPrefixedHeapObject: PUBLIC PROC[self: LONG POINTER TO PPrefixedZone, size: CARDINAL] RETURNS[ptr: LONG POINTER] = { triedAgain: BOOLEAN _ FALSE; ptr _ INLCreatePrefixedUObject[size, self^ ! MemoryExhausted => IF NOT triedAgain THEN {triedAgain _ TRUE;RETRY}]}; -- used by ExtendZone AddBlock: PUBLIC PROC[ptr: Pointer, size: LongNodeSize, pfnPrev: PFreeNode] = {IF clearing THEN {WHILE size > LAST[CARDINAL] DO [] _ LONGZERO[ptr, LAST[CARDINAL]]; size _ size - LAST[CARDINAL]; ENDLOOP; [] _ LONGZERO[ptr, Inline.LowHalf[size]]}; LinkHeapNode[MakeFreeHeapNode[ptr, size], pfnPrev]; }; -- *** The Prefixed Object Allocator --******************************************************************************** -- called when the microcode can't handle the allocation CreatePrefixedObjectTrap: PUBLIC PROC[zn: PPrefixedZone, size: CARDINAL, type: Type] RETURNS[ptr: Pointer] = { state: PrincOps.StateVector; param: CARDINAL; state_ STATE; -- incantation param_ IF RTRefCounts.GCMicrocodeExists THEN TrapSupport.GetTrapParam[] ELSE 0; IF param < 2 OR param > 4 THEN useAllocUCode _ FALSE; IF state.stkptr # 0 THEN Runtime.CallDebugger["CreateQuantizedObjectTrap: stack not empty"]; ptr _ InternalCreatePrefixedObject[zn, size, type]; IF takingStatistics THEN SELECT param FROM 0 => Bump[@PrefixedAllocatorTrapStats.NoUCodeTraps]; 1 => Bump[@PrefixedAllocatorTrapStats.OldUCodeTraps]; 2 => Bump[@PrefixedAllocatorTrapStats.ZoneLockedTraps]; 3 => Bump[@PrefixedAllocatorTrapStats.NoBlockFoundTraps]; 4 => Bump[@PrefixedAllocatorTrapStats.LongFreeListTraps]; ENDCASE => Bump[@PrefixedAllocatorTrapStats.UnKnownTraps]; TrapSupport.BumpPC[2]; state.dest_ LOOPHOLE[RTOS.MyLocalFrame[]]; TRANSFER WITH state; -- incantation }; AllocateHeapNodeSDTrap: PUBLIC PROC[zn: PPrefixedZone, size: CARDINAL, type: Type] RETURNS[ptr: Pointer] = {RETURN[InternalCreatePrefixedObject[zn, size, type]]}; InternalCreatePrefixedObject: PROC[zn: PPrefixedZone, size: CARDINAL, type: Type] RETURNS[ptr: Pointer] = { triedAgain: BOOLEAN; size _ Inline.BITAND[size+1, 177776B]; -- make even triedAgain _ FALSE; WHILE (ptr _ AllocateHeapNode[zn, size, type]) = NIL DO WITH zn.linkage SELECT FROM collectible => LOOPHOLE[zn.linkage, collectible ZoneLinkage].fullProc[LOOPHOLE[zn], size ! MemoryExhausted => -- try once more in case merger made a big enough block IF NOT triedAgain THEN {triedAgain _ TRUE; LOOP} ]; heap => LOOPHOLE[zn.linkage, heap ZoneLinkage].fullProc[LOOPHOLE[LONG[@zn]], size]; ENDCASE => ERROR; ENDLOOP}; --**************************************************************************** CreatePrefixedObject: PROC[zn: PrefixedZone, size: CARDINAL, type: Type] RETURNS[ptr: Pointer] = INLINE { IF checking AND size > MaxClientBlockSize THEN SIGNAL SizeTooBig[size]; size _ Inline.BITAND[size+1, 177776B]; -- make even IF SSExtra.useSizeToZn AND SSExtra.SizeToZn # NIL -- XXX THEN {size _ SSExtra.QuantizedSize[size]; zn _ MapSizeToZn[size]; }; IF useAllocUCode THEN ptr _ ALLOCATEHEAPNODE[LOOPHOLE[zn], size, type] ELSE { triedAgain: BOOLEAN _ FALSE; WHILE (ptr _ AllocateHeapNode[LOOPHOLE[zn], size, type]) = NIL DO LOOPHOLE[zn.linkage, collectible ZoneLinkage].fullProc[LOOPHOLE[zn], size ! MemoryExhausted => -- try once more in case merger made a big enough block IF NOT triedAgain THEN {triedAgain _ TRUE; LOOP}]; ENDLOOP}; IF checking THEN IF ptr = suspectPtr THEN SIGNAL SuspectPtrSeen[suspectPtr]}; -- XXX MapSizeToZn: PROC[size: CARDINAL] RETURNS[zn: PrefixedZone] = INLINE { RETURN[IF size <= SSExtra.maxSizeToZnIndex THEN LOOPHOLE[SSExtra.SizeToZn[size]] ELSE LOOPHOLE[SafeStorage.GetSystemZone[]]]; }; CreatePrefixedTypedUObject: PUBLIC PROC[type: Type, size: CARDINAL, zn: PPrefixedZone] RETURNS[ptr: Pointer] = { size _ Inline.BITAND[size+1, 177776B]; -- make even IF useAllocUCode THEN ptr _ ALLOCATEHEAPNODE[LOOPHOLE[zn], size, type] ELSE WHILE (ptr _ AllocateHeapNode[zn, size, type]) = NIL DO LOOPHOLE[zn.linkage, heap ZoneLinkage].fullProc[LOOPHOLE[LONG[@zn]], size]; ENDLOOP; IF checking THEN IF ptr = suspectPtr THEN SIGNAL SuspectPtrSeen[suspectPtr]}; CreatePrefixedUObject: PUBLIC PROC[size: CARDINAL, zn: PPrefixedZone] RETURNS[ptr: Pointer] = {RETURN[INLCreatePrefixedUObject[size, zn]]}; INLCreatePrefixedUObject: PROC[size: CARDINAL, zn: PPrefixedZone] RETURNS[ptr: Pointer] = INLINE { size _ Inline.BITAND[size+1, 177776B]; -- make even IF useAllocUCode THEN ptr _ ALLOCATEHEAPNODE[LOOPHOLE[zn], size, nullType] ELSE WHILE (ptr _ AllocateHeapNode[zn, size, nullType]) = NIL DO LOOPHOLE[zn.linkage, heap ZoneLinkage].fullProc[LOOPHOLE[LONG[@zn]], size]; ENDLOOP; IF checking THEN IF ptr = suspectPtr THEN SIGNAL SuspectPtrSeen[suspectPtr]}; AllocateHeapNode: ENTRY PROC[zn: PZone, s: CARDINAL, type: Type] RETURNS[Pointer] = BEGIN ENABLE UNWIND => NULL; size: CARDINAL = (IF s < SIZE[free NodeHeader]-sizeNd THEN SIZE[free NodeHeader] ELSE IF s > (LAST[CARDINAL]-sizeNd) THEN ERROR InvalidSize[s] ELSE (s+sizeNd)); pfnFirst: PFreeNode _ LOOPHOLE[zn, PPrefixedZone].pfn; pfn: PFreeNode _ pfnFirst; length, excess: LongNodeSize; pType: TypeIndex; ppzn: PPrefixedZone = LOOPHOLE[zn]; DO pfnEndpfn: PNode; IF (length _ NodeLength[pfn]) >= size THEN EXIT; IF checking AND length = 0 AND pfn # @ppzn.fnd THEN ERROR; pfnEndpfn _ pfn + length; IF length > 0 -- 0 indicates the dummy free node header in the zone. AND LOOPHOLE[pfnEndpfn, LONG CARDINAL] <= LASTAddress AND MapPtrZf[pfnEndpfn] = [prefixed[zi: zn.zi]] THEN WITH pfnEnd: pfnEndpfn SELECT FROM free => -- next guy is free, merge it with pfn { newLength: LongNodeSize = length + NodeLength[pfnEndpfn]; IF checking THEN {IF pfn.pfnNext.pfnPrev # pfn OR pfn.pfnPrev.pfnNext # pfn OR pfnEnd.pfnNext.pfnPrev # @pfnEnd OR pfnEnd.pfnPrev.pfnNext # @pfnEnd OR length < MinBlockSize OR NodeLength[@pfnEnd] < MinBlockSize THEN ERROR}; pfnEnd.pfnNext.pfnPrev _ pfnEnd.pfnPrev; pfnEnd.pfnPrev.pfnNext _ pfnEnd.pfnNext; IF @pfnEnd = pfnFirst THEN pfnFirst _ pfn.pfnPrev; IF RTFlags.clearing -- keep free objects clear THEN [] _ LONGZERO[pfnEndpfn, SIZE[free NodeHeader]]; pfn.SizeLo _ LOOPHOLE[newLength, MDRLongNodeSize].lnsLo; pfn.SizeHi _ LOOPHOLE[newLength, MDRLongNodeSize].lnsHi; ppzn.pfn _ pfn; -- update like ucode does LOOP}; ENDCASE; pfn _ pfn.pfnNext; ppzn.pfn _ pfn; -- update like ucode does IF pfn = pfnFirst THEN RETURN[NIL] -- no free block large enough ENDLOOP; -- Found a large enough free block pType _ LOOPHOLE[type]; IF checking AND Inline.BITAND[Inline.LowHalf[length], 1] # 0 THEN ERROR; -- debugging IF (excess _ length-size) >= (IF SSExtra.useSizeToZn THEN 1 ELSE 4) * MinBlockSize -- XXX THEN -- split the block {pfn.SizeLo_ LOOPHOLE[excess, MDRLongNodeSize].lnsLo; pfn.SizeHi_ LOOPHOLE[excess, MDRLongNodeSize].lnsHi; pfn_ LOOPHOLE[pfn + excess]; LOOPHOLE[pfn, PNode]^_ [SizeLo: size, body: inuse[type: pType]]} ELSE -- remove block from free list without splitting it {pfn.pfnNext.pfnPrev _ pfn.pfnPrev; ppzn.pfn _ pfn.pfnPrev.pfnNext _ pfn.pfnNext; pfn.pfnNext _ pfn.pfnPrev _ NIL; LOOPHOLE[pfn, PNode].body _ inuse[type: pType]}; RETURN[pfn + sizeNd]; END; MakeFreeHeapNode: PROC[pnp: PNode, size: LongNodeSize] RETURNS[PFreeNode] = INLINE { LOOPHOLE[pnp, PFreeNode]^_ [ SizeLo: LOOPHOLE[size, MDRLongNodeSize].lnsLo, body: free[SizeHi: LOOPHOLE[size, MDRLongNodeSize].lnsHi, pfnPrev: NIL, pfnNext: NIL] ]; RETURN[LOOPHOLE[pnp]]}; MakeInuseHeapNode: PROC[pnp: PNode, size: LongNodeSize, type: Type] RETURNS[PNode] = INLINE { pnp^ _ [ SizeLo: LOOPHOLE[size, MDRLongNodeSize].lnsLo, body: inuse[type: LOOPHOLE[type]]]; RETURN[LOOPHOLE[pnp]]}; -- *** The Prefixed Object Allocator (end) -- NOTE copied in RTTraceAndSweepImpl, RTReclaimerImpl LinkHeapNode: PROC[pfn, pfnPrev: PFreeNode] = INLINE BEGIN pfnNext: PFreeNode = pfnPrev.pfnNext; IF checking THEN IF LOOPHOLE[pfn, Pointer] = suspectPtr THEN SIGNAL SuspectPtrSeen[suspectPtr]; pfn.body _ free[pfnPrev: pfnPrev, pfnNext: pfnNext]; pfnNext.pfnPrev _ pfn; pfnPrev.pfnNext _ pfn; END; -- START HERE useAllocUCode _ useAllocUCode AND RTRefCounts.GCMicrocodeExists; useFreeUCode _ useFreeUCode AND RTRefCounts.GCMicrocodeExists; END. ��"Mesa" style�Iproc��c��k � �� +��-��D��r��M��S��(��+��"��7��W��;��5�� !��&��"��%��!��,��%�7�� n��t�� *�%��K�� )�� '�� :��*��`�+��k�� $��I��G�� v�� ;��2��+�`�� V��-��]��>��$��b�x��:��A�� d�� 4��"��"� ��,��#��/��4�8��2��(��O�� '��"� ��g�� /��4�8�� !��4��+��.��&��%��"� �� ,��(�� !��*��"� �� 0��(�� !�� !�� (��$�� )�� 7��4��'�\�� 2��2��9��9��.��:��*��2��B��F��2��#�� 4��-��>��4�� -��!��-��D��E��-��D�� +��7�� 3�� "��?��!��B�K�