[Vm-dev] VM Maker: VMMaker.oscog.seperateMarking-WoC.3256.mcz
Eliot Miranda
eliot.miranda at gmail.com
Thu Sep 1 08:28:50 UTC 2022
Hi, fantastic progress! If you have time let’s meet next week briefly so I can catch up and improve my understanding.
_,,,^..^,,,_ (phone)
> On Aug 31, 2022, at 7:26 AM, commits at source.squeak.org wrote:
>
> Tom Braun uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3256.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog.seperateMarking-WoC.3256
> Author: WoC
> Time: 31 August 2022, 4:25:24.728984 pm
> UUID: 1e46fa16-0827-45d5-8ee0-4e5c2515b517
> Ancestors: VMMaker.oscog.seperateMarking-WoC.3255, VMMaker.oscog-nice.3251
>
> runnable stack vm (that runs for some time until it crashes)
>
> fixed various bugs:
> - ignored BitArrays in the write barrier
> - renamed initilize... to init methods to avoid Slang mischief
> - replaced fullGC by running incremental GC often (will be changed later on)
> - hide reserved segment from other Memory manager parts and fix leak checker to take this into account
>
> (some changes from pulling the newest VMMaker version in BitBltSimulation, SocketPlugin and CCodeGenerator)
>
> =============== Diff against VMMaker.oscog.seperateMarking-WoC.3255 ===============
>
> Item was changed:
> ----- Method: BitBltSimulation>>alphaBlendConst:with:paintMode: (in category 'combination rules') -----
> alphaBlendConst: sourceWord with: destinationWord paintMode: paintMode
> "Blend sourceWord with destinationWord using a constant alpha.
> Alpha is encoded as 0 meaning 0.0, and 255 meaning 1.0.
> The blend produced is alpha*source + (1.0-alpha)*dest, with the
> computation being performed independently on each color component.
> This function could eventually blend into any depth destination,
> using the same color averaging and mapping as warpBlt.
> paintMode = true means do nothing if the source pixel value is zero."
>
> "This first implementation works with dest depths of 16 and 32 bits only.
> Normal color mapping will allow sources of lower depths in this case,
> and results can be mapped directly by truncation, so no extra color maps are needed.
> To allow storing into any depth will require subsequent addition of two other
> colormaps, as is the case with WarpBlt."
>
> | pixMask destShifted sourceShifted destPixVal rgbMask sourcePixVal unAlpha result pixBlend shift blend maskShifted bitsPerColor blendAG blendRB |
> <inline: false>
> <returnTypeC: 'unsigned int'>
> <var: 'sourceWord' type: #'unsigned int'>
> <var: 'destinationWord' type: #'unsigned int'>
> <var: 'blendRB' type: #'unsigned int'>
> <var: 'blendAG' type: #'unsigned int'>
> <var: 'result' type: #'unsigned int'>
> <var: 'sourceAlpha' type: #'unsigned int'>
> <var: 'unAlpha' type: #'unsigned int'>
> <var: 'sourceShifted' type: #'unsigned int'>
> <var: 'destShifted' type: #'unsigned int'>
> <var: 'maskShifted' type: #'unsigned int'>
> <var: 'pixMask' type: #'unsigned int'>
> <var: 'rgbMask' type: #'unsigned int'>
> <var: 'pixBlend' type: #'unsigned int'>
> <var: 'blend' type: #'unsigned int'>
> destDepth < 16 ifTrue: [^ destinationWord "no-op"].
> unAlpha := 255 - sourceAlpha.
> result := destinationWord.
> destPPW = 1 ifTrue:["32bpp blends include alpha"
> paintMode & (sourceWord = 0) "painting a transparent pixel" ifFalse:[
>
> blendRB := ((sourceWord bitAnd: 16rFF00FF) * sourceAlpha) +
> + ((destinationWord bitAnd: 16rFF00FF) * unAlpha) + 16r800080. "blend red and blue"
> - ((destinationWord bitAnd: 16rFF00FF) * unAlpha) + 16rFF00FF. "blendRB red and blue"
>
> blendAG := ((sourceWord>> 8 bitAnd: 16rFF00FF) * sourceAlpha) +
> + ((destinationWord>>8 bitAnd: 16rFF00FF) * unAlpha) + 16r800080. "blend alpha and green"
> - ((destinationWord>>8 bitAnd: 16rFF00FF) * unAlpha) + 16rFF00FF. "blendRB alpha and green"
>
> + blendRB := (blendRB >> 8 bitAnd: 16rFF00FF) + blendRB >> 8 bitAnd: 16rFF00FF. "divide by 255"
> + blendAG := (blendAG >> 8 bitAnd: 16rFF00FF) + blendAG >> 8 bitAnd: 16rFF00FF.
> - blendRB := blendRB + (blendRB - 16r10001 >> 8 bitAnd: 16rFF00FF) >> 8 bitAnd: 16rFF00FF. "divide by 255"
> - blendAG := blendAG + (blendAG - 16r10001 >> 8 bitAnd: 16rFF00FF) >> 8 bitAnd: 16rFF00FF.
> result := blendRB bitOr: blendAG<<8.
> ].
> ] ifFalse:[
> pixMask := maskTable at: destDepth.
> bitsPerColor := 5.
> rgbMask := 16r1F.
> maskShifted := destMask.
> destShifted := destinationWord.
> sourceShifted := sourceWord.
> 1 to: destPPW do:[:j |
> sourcePixVal := sourceShifted bitAnd: pixMask.
> ((maskShifted bitAnd: pixMask) = 0 "no effect if outside of dest rectangle"
> or: [paintMode & (sourcePixVal = 0) "or painting a transparent pixel"])
> ifFalse:
> [destPixVal := destShifted bitAnd: pixMask.
> pixBlend := 0.
> 1 to: 3 do:
> [:i | shift := (i-1)*bitsPerColor.
> blend := (((sourcePixVal>>shift bitAnd: rgbMask) * sourceAlpha)
> + ((destPixVal>>shift bitAnd: rgbMask) * unAlpha))
> + + 128. "+128 for rounding"
> + blend := blend >> 8 + blend >> 8 bitAnd: rgbMask. "divide by 255"
> - + 254 // 255 bitAnd: rgbMask.
> pixBlend := pixBlend bitOr: blend<<shift].
> result := (result bitAnd: (pixMask << (j-1*16)) bitInvert32)
> bitOr: pixBlend << (j-1*16)].
> maskShifted := maskShifted >> destDepth.
> sourceShifted := sourceShifted >> destDepth.
> destShifted := destShifted >> destDepth].
> ].
> ^ result
> !
>
> Item was changed:
> ----- Method: BitBltSimulation>>alphaBlendScaled:with: (in category 'combination rules') -----
> alphaBlendScaled: sourceWord with: destinationWord
> "Blend sourceWord with destinationWord using the alpha value from sourceWord.
> Alpha is encoded as 0 meaning 0.0, and 255 meaning 1.0.
> In contrast to alphaBlend:with: the color produced is
>
> srcColor + (1-srcAlpha) * dstColor
>
> e.g., it is assumed that the source color is already scaled."
> <returnTypeC: #'unsigned int'>
> <inline: false> "Do NOT inline this into optimized loops"
> | unAlpha rb ag |
> <var: 'sourceWord' type: #'unsigned int'>
> <var: 'destinationWord' type: #'unsigned int'>
> <var: 'rb' type: #'unsigned int'>
> <var: 'ag' type: #'unsigned int'>
> <var: 'unAlpha' type: #'unsigned int'>
> unAlpha := 255 - (sourceWord >> 24). "High 8 bits of source pixel is source opacity (ARGB format)"
> + rb := (destinationWord bitAnd: 16rFF00FF) * unAlpha + 16r800080. "add 16r80 for rounding division to nearest byte"
> + ag := (destinationWord >> 8 bitAnd: 16rFF00FF) * unAlpha + 16r800080. "add 16r80 for rounding division to nearest byte"
> + rb := (rb >> 8 bitAnd: 16rFF00FF) + rb >> 8. "divide by 255"
> + ag := (ag >> 8 bitAnd: 16rFF00FF) + ag >> 8. "divide by 255"
> + rb := (rb bitAnd: 16rFF00FF) + (sourceWord bitAnd: 16rFF00FF). "blend red and blue components"
> + ag := (ag bitAnd: 16rFF00FF) + (sourceWord >> 8 bitAnd: 16rFF00FF). "blend alpha and green components"
> - rb := ((destinationWord bitAnd: 16rFF00FF) * unAlpha >> 8 bitAnd: 16rFF00FF) + (sourceWord bitAnd: 16rFF00FF). "blend red and blue components"
> - ag := ((destinationWord >> 8 bitAnd: 16rFF00FF) * unAlpha >> 8 bitAnd: 16rFF00FF) + (sourceWord >> 8 bitAnd: 16rFF00FF). "blend alpha and green components"
> rb := (rb bitAnd: 16rFF00FF) bitOr: (rb bitAnd: 16r01000100) * 16rFF >> 8. "saturate red and blue components if there is a carry"
> ag := (ag bitAnd: 16rFF00FF) << 8 bitOr: (ag bitAnd: 16r01000100) * 16rFF. "saturate alpha and green components if there is a carry"
> ^ag bitOr: rb "recompose"!
>
> Item was changed:
> ----- Method: BitBltSimulation>>alphaBlendUnscaled:with: (in category 'combination rules') -----
> alphaBlendUnscaled: sourceWord with: destinationWord
> "Blend sourceWord with destinationWord using the alpha value from both sourceWord and destinationWord.
> Alpha is encoded as 0 meaning 0.0, and 255 meaning 1.0.
> The alpha channel and color produced are
>
> srcAlpha + (destAlpha*(1-srcAlpha))
> (srcAlpha*srcColor + (destAlpha*(1-srcAlpha)*dstColor)) / (srcAlpha + (destAlpha*(1-srcAlpha)))
>
> In contrast to alphaBlend:with: the method does not assume that destination form is opaque.
> In contrast to alphaBlendScaled:with: the method does not assume that colors have been pre-scaled (muliplied) by alpha channel."
> | alpha blendA result blendR blendB blendG |
> <inline: false>
> <returnTypeC: 'unsigned int'>
> <var: 'sourceWord' type: #'unsigned int'>
> <var: 'destinationWord' type: #'unsigned int'>
> <var: 'blendA' type: #'unsigned int'>
> <var: 'blendR' type: #'unsigned int'>
> <var: 'blendG' type: #'unsigned int'>
> <var: 'blendB' type: #'unsigned int'>
> <var: 'result' type: #'unsigned int'>
> <var: 'alpha' type: #'unsigned int'>
> alpha := sourceWord >> 24. "High 8 bits of source pixel, assuming ARGB encoding"
> alpha = 0 ifTrue: [ ^ destinationWord ].
> alpha = 255 ifTrue: [ ^ sourceWord ].
>
> blendA := 16rFF * alpha + (16rFF - alpha * (destinationWord >> 24)) + 16r80. "blend alpha channels"
> + blendA := blendA >> 8 + blendA >> 8 bitAnd: 16rFF. "divide by 255"
> - blendA := blendA + (blendA - 1 >> 8 bitAnd: 16rFF) >> 8 bitAnd: 16rFF. "divide by 255"
>
> blendR := ((sourceWord bitAnd: 16rFF0000) * alpha) +
> ((destinationWord bitAnd: 16rFF0000) * (blendA-alpha))
> +(blendA<<15)
> // blendA bitAnd: 16rFF0000. "blend red"
>
> blendG := ((sourceWord bitAnd: 16r00FF00) * alpha) +
> ((destinationWord bitAnd: 16r00FF00) * (blendA-alpha))
> +(blendA<<7)
> // blendA bitAnd: 16r00FF00. "blend green"
>
> blendB := ((sourceWord bitAnd: 16r0000FF) * alpha) +
> ((destinationWord bitAnd: 16r0000FF) * (blendA-alpha))
> +(blendA>>1)
> // blendA bitAnd: 16r0000FF. "blend blue"
>
> result := ((blendR bitOr: blendB) bitOr: blendG) bitOr: blendA << 24.
> ^ result
> !
>
> Item was removed:
> - ----- Method: BitBltSimulation>>partitionedMul:with:nBits:nPartitions: (in category 'combination rules') -----
> - partitionedMul: word1 with: word2 nBits: nBits nPartitions: nParts
> - "Multiply word1 with word2 as nParts partitions of nBits each.
> - This is useful for packed pixels, or packed colors.
> - Bug in loop version when non-white background"
> -
> - | sMask product result dMask |
> - "In C, integer multiplication might answer a wrong value if the unsigned values are declared as signed.
> - This problem does not affect this method, because the most significant bit (i.e. the sign bit) will
> - always be zero (jmv)"
> - <returnTypeC: 'unsigned int'>
> - <var: 'word1' type: #'unsigned int'>
> - <var: 'word2' type: #'unsigned int'>
> - <var: 'sMask' type: #'unsigned int'>
> - <var: 'dMask' type: #'unsigned int'>
> - <var: 'result' type: #'unsigned int'>
> - <var: 'product' type: #'unsigned int'>
> - sMask := maskTable at: nBits. "partition mask starts at the right"
> - dMask := sMask << nBits.
> - result := (((word1 bitAnd: sMask)+1) * ((word2 bitAnd: sMask)+1) - 1
> - bitAnd: dMask) >> nBits. "optimized first step"
> - nParts = 1
> - ifTrue: [ ^result ].
> - product := (((word1>>nBits bitAnd: sMask)+1) * ((word2>>nBits bitAnd: sMask)+1) - 1 bitAnd: dMask).
> - result := result bitOr: product.
> - nParts = 2
> - ifTrue: [ ^result ].
> - product := (((word1>>(2*nBits) bitAnd: sMask)+1) * ((word2>>(2*nBits) bitAnd: sMask)+1) - 1 bitAnd: dMask).
> - result := result bitOr: product << nBits.
> - nParts = 3
> - ifTrue: [ ^result ].
> - product := (((word1>>(3*nBits) bitAnd: sMask)+1) * ((word2>>(3*nBits) bitAnd: sMask)+1) - 1 bitAnd: dMask).
> - result := result bitOr: product << (2*nBits).
> - ^ result
> -
> - " | sMask product result dMask |
> - sMask := maskTable at: nBits. 'partition mask starts at the right'
> - dMask := sMask << nBits.
> - result := (((word1 bitAnd: sMask)+1) * ((word2 bitAnd: sMask)+1) - 1
> - bitAnd: dMask) >> nBits. 'optimized first step'
> - nBits to: nBits * (nParts-1) by: nBits do: [:ofs |
> - product := (((word1>>ofs bitAnd: sMask)+1) * ((word2>>ofs bitAnd: sMask)+1) - 1 bitAnd: dMask).
> - result := result bitOr: (product bitAnd: dMask) << (ofs-nBits)].
> - ^ result"!
>
> Item was added:
> + ----- Method: BitBltSimulation>>partitionedMul:with:nBits:wordBits: (in category 'combination rules') -----
> + partitionedMul: word1 with: word2 nBits: nBits wordBits: wordBits
> + "Multiply each channel of nBits in word1 and word2.
> + We assume that for each channel of nBits, we multiply ratios in interval [0..1], scaled by (1 << nBits - 1).
> + result := ((channel1/scale) * (channel2/scale) * scale) rounded
> + Or after simplification:
> + result := (channel1 * channel2 / scale) rounded
> + This is implemented by first forming the double precision products (channel1 * channel2) on a double-word.
> + Then dividing each double precision channel by scale, with correctly rounded operation.
> + With proper tricks, some of these operations can be multiplexed
> + (all channels are formed in parallel with a single sequence of operation)."
> +
> + | channelMask groupMask doubleGroupMask doubleWord1 doubleWord2 doubleWordMul half shift result highWordShift nGroups n2 |
> + <returnTypeC: 'unsigned int'>
> + <var: 'word1' type: #'unsigned int'>
> + <var: 'word2' type: #'unsigned int'>
> + <var: 'channelMask' type: #'unsigned int'>
> + <var: 'groupMask' type: #'unsigned int'>
> + <var: 'half' type: #'unsigned int'>
> + <var: 'doubleGroupMask' type: #'unsigned long long'>
> + <var: 'doubleWord1' type: #'unsigned long long'>
> + <var: 'doubleWord2' type: #'unsigned long long'>
> + <var: 'doubleWordMul' type: #'unsigned long long'>
> + <var: 'result' type: #'unsigned int'>
> + n2 := 2 * nBits. "width of double-precision channel"
> + channelMask := 1 << nBits - 1. "partition mask starts at the right"
> + nGroups := wordBits // nBits + 1 // 2. "number of channels that fit in a word, when alternating with group of zeros"
> + groupMask := channelMask. "form a word mask with alternate nBits 0 and nBits 1, so as to select even channels"
> + 2 to: nGroups do: [:i | groupMask := groupMask << n2 + channelMask].
> + highWordShift := nGroups * n2. "shift for putting odd channels in high-word - usually wordBits, except if wordBits \\ nBits ~= 0"
> +
> + doubleWord1 := word1 >> nBits bitAnd: groupMask. "select odd channel interleaved with groups of nBits zeros, so as to leave room for double-precision multiplication"
> + doubleWord2 := word2 >> nBits bitAnd: groupMask.
> + doubleWord1 := doubleWord1 << highWordShift + (word1 bitAnd: groupMask). "Put odd channels in high word, and even channels in low word"
> + doubleWord2 := doubleWord2 << highWordShift + (word2 bitAnd: groupMask).
> +
> + half := channelMask >> 1 + 1. "mid-value to add for getting a correctly rounded division"
> + shift := 0.
> + doubleWordMul := 0.
> + 1 to: wordBits // nBits do: [:i |
> + doubleWordMul := doubleWordMul + ((doubleWord1 >> shift bitAnd: channelMask) * (doubleWord2 >> shift bitAnd: channelMask) + half << shift). "multiply each channel of the two operands"
> + shift := shift + n2].
> +
> + doubleGroupMask := groupMask. "form a mask for extracting single-precision channels in the double word"
> + doubleGroupMask := doubleGroupMask << highWordShift + groupMask.
> +
> + doubleWordMul := (doubleWordMul >> nBits bitAnd: doubleGroupMask) + doubleWordMul >> nBits bitAnd: doubleGroupMask. "divide by scale"
> + result := doubleWordMul >> (highWordShift - nBits) + (doubleWordMul bitAnd: groupMask). "compact channels back into a single word"
> + ^result!
>
> Item was changed:
> ----- Method: BitBltSimulation>>rgbMul:with: (in category 'combination rules') -----
> rgbMul: sourceWord with: destinationWord
> <inline: false>
> <returnTypeC: 'unsigned int'>
> <var: 'sourceWord' type: #'unsigned int'>
> <var: 'destinationWord' type: #'unsigned int'>
> destDepth < 16 ifTrue:
> ["Mul each pixel separately"
> + destDepth = 1 ifTrue: [^self bitAnd: sourceWord with: destinationWord].
> + ^ self partitionedMul: sourceWord with: destinationWord nBits: destDepth wordBits: 32].
> - ^ self partitionedMul: sourceWord with: destinationWord
> - nBits: destDepth nPartitions: destPPW].
> destDepth = 16 ifTrue:
> ["Mul RGB components of each pixel separately"
> + ^ (self partitionedMul: (sourceWord bitAnd: 16rFFFF) with: (destinationWord bitAnd: 16rFFFF) nBits: 5 wordBits: 16)
> + + ((self partitionedMul: sourceWord>>16 with: destinationWord>>16 nBits: 5 wordBits: 16) << 16)]
> - ^ (self partitionedMul: sourceWord with: destinationWord
> - nBits: 5 nPartitions: 3)
> - + ((self partitionedMul: sourceWord>>16 with: destinationWord>>16
> - nBits: 5 nPartitions: 3) << 16)]
> ifFalse:
> ["Mul RGBA components of the pixel separately"
> + ^ self partitionedMul: sourceWord with: destinationWord nBits: 8 wordBits: 32]!
> - ^ self partitionedMul: sourceWord with: destinationWord
> - nBits: 8 nPartitions: 4]
> -
> - " | scanner |
> - Display repaintMorphicDisplay.
> - scanner := DisplayScanner quickPrintOn: Display.
> - MessageTally time: [0 to: 760 by: 4 do: [:y |scanner drawString: 'qwrepoiuasfd=)(/&()=#!!lkjzxv.,mn124+09857907QROIYTOAFDJZXNBNB,M-.,Mqwrepoiuasfd=)(/&()=#!!lkjzxv.,mn124+09857907QROIYTOAFDJZXNBNB,M-.,M1234124356785678' at: 0 at y]]. "!
>
> Item was added:
> + ----- Method: BitBltSimulationTest>>testRgbMulDepth16 (in category 'tests') -----
> + testRgbMulDepth16
> + | x f1 f2 f3 bb |
> + x := 1 << 5.
> + f1 := Form extent: x at x depth: 16.
> + f2 := Form extent: x at x depth: 16.
> + 0 to: x-1 do: [:ix |
> + 0 to: x-1 do: [:iy |
> + f1 pixelValueAt: ix at iy put: ((ix bitOr: ix+10\\x<<5) bitOr: ix+20\\x<<10).
> + f2 pixelValueAt: ix at iy put: ((iy bitOr: iy+10\\x<<5) bitOr: iy+20\\x<<10)]].
> + f3 := f2 copy.
> + bb := BitBlt new.
> + bb setDestForm: f3; sourceForm: f1.
> + bb sourceX: 0; sourceY: 0; destX: 0; destY: 0.
> + bb width: x; height: x.
> + bb combinationRule: Form rgbMul.
> + bb copyBits.
> + 0 to: x-1 do: [:ix |
> + 0 to: x-1 do: [:iy |
> + "Test that each 5 bits rgb channel is correctly rounded multiplication"
> + self assert: ((f3 pixelValueAt: ix at iy) >> 10 bitAnd: 31)
> + = (((f1 pixelValueAt: ix at iy) >> 10 bitAnd: 31)
> + * ((f2 pixelValueAt: ix at iy) >>10 bitAnd: 31) / (x - 1)) rounded.
> + self assert: ((f3 pixelValueAt: ix at iy) >> 5 bitAnd: 31)
> + = (((f1 pixelValueAt: ix at iy) >> 5 bitAnd: 31)
> + * ((f2 pixelValueAt: ix at iy) >>5 bitAnd: 31) / (x - 1)) rounded.
> + self assert: ((f3 pixelValueAt: ix at iy) bitAnd: 31)
> + = (((f1 pixelValueAt: ix at iy) bitAnd: 31)
> + * ((f2 pixelValueAt: ix at iy) bitAnd: 31) / (x - 1)) rounded]]!
>
> Item was added:
> + ----- Method: BitBltSimulationTest>>testRgbMulDepth1to8 (in category 'tests') -----
> + testRgbMulDepth1to8
> + "Note that depth=32 and depth=8 have exactly same effect 32bits-word-wise
> + since we decompose 32 bits depth in four 8-bits channels, ARGB.
> + Only depth 16 is special, with 3 channels of 5 bits, and 1 dead bit."
> + #(1 2 4 8) do: [:d |
> + | x f1 f2 f3 bb |
> + x := 1 << d.
> + f1 := Form extent: x at x depth: d.
> + f2 := Form extent: x at x depth: d.
> + 0 to: x-1 do: [:ix |
> + 0 to: x-1 do: [:iy |
> + f1 pixelValueAt: ix at iy put: ix.
> + f2 pixelValueAt: ix at iy put: iy]].
> + f3 := f2 copy.
> + bb := BitBlt new.
> + bb setDestForm: f3; sourceForm: f1.
> + bb sourceX: 0; sourceY: 0; destX: 0; destY: 0.
> + bb width: x; height: x.
> + bb combinationRule: Form rgbMul.
> + bb copyBits.
> + 0 to: x-1 do: [:ix |
> + 0 to: x-1 do: [:iy |
> + self assert: (f3 pixelValueAt: ix at iy) = ((f1 pixelValueAt: ix at iy) * (f2 pixelValueAt: ix at iy) / (x - 1)) rounded]]]!
>
> Item was changed:
> ----- Method: CCodeGenerator>>generateShiftLeft:on:indent: (in category 'C translation') -----
> generateShiftLeft: msgNode on: aStream indent: level
> "Generate a C bitShift. If the receiver type is unsigned avoid C99 undefined behaviour of
> left shifting negative values (what?!!?!!? such quiche eating idiocy to treat this like anything
> other than a truncated left shift) by casting signed receiver types to unsigned and back.
> If we can determine the result would overflow the word size, cast to a long integer."
> | rcvr arg castToLong type mustCastBackToSign mustCastToUnsigned canSuffixTheConstant typeIsUnsigned |
> (self generateAsConstantExpression: msgNode on: aStream) ifTrue:
> [^self].
> rcvr := msgNode receiver.
> arg := msgNode args first.
> castToLong := false.
> (rcvr constantNumbericValueIfAtAllPossibleOrNilIn: self) ifNotNil:
> [:rcvrVal |
> (arg constantNumbericValueIfAtAllPossibleOrNilIn: self)
> ifNil: [castToLong := vmClass notNil and: [vmClass objectMemoryClass wordSize = 8]]
> ifNotNil:
> [:argVal |
> | valueBeyondInt |
> valueBeyondInt := 1 bitShift: 32. "The default type of const << N is int."
> castToLong := rcvrVal < valueBeyondInt
> and: [(rcvrVal bitShift: argVal) >= valueBeyondInt]]].
> canSuffixTheConstant := rcvr isConstant and: [rcvr name isEmpty and: [rcvr value >= 0]].
> canSuffixTheConstant ifTrue:
> [aStream nextPutAll: (self cLiteralForUnsignedInteger: rcvr value longlong: castToLong).
> aStream nextPutAll: ' << '.
> self emitCExpression: arg on: aStream indent: level.
> ^self].
> type := self typeFor: rcvr in: currentMethod.
> castToLong := castToLong and: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)].
> + typeIsUnsigned := type first = $u or: [type = #'size_t'].
> - typeIsUnsigned := type first = $u.
> mustCastToUnsigned := typeIsUnsigned not
> or: [castToLong
> or: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)]].
> mustCastBackToSign := typeIsUnsigned not.
> mustCastBackToSign ifTrue:
> [| promotedType |
> promotedType := castToLong
> ifTrue: [#sqLong]
> ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #sqInt)
> ifTrue: [#sqInt]
> ifFalse: [type]].
> aStream nextPutAll: '(('; nextPutAll: promotedType; nextPut: $)].
> mustCastToUnsigned ifTrue:
> [| unsigned |
> unsigned := castToLong
> ifTrue: [#usqLong]
> ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
> ifTrue: [#usqInt]
> ifFalse: [self unsignedTypeForIntegralType: type]].
> aStream nextPutAll: '(('; nextPutAll: unsigned; nextPutAll: ')('].
> self emitCExpression: rcvr on: aStream indent: level.
> mustCastToUnsigned ifTrue: [aStream nextPut: $)].
>
> aStream nextPutAll: ' << '.
> self emitCExpression: arg on: aStream indent: level.
>
> mustCastToUnsigned ifTrue: [aStream nextPut: $)].
> mustCastBackToSign ifTrue: [aStream nextPut: $)]!
>
> Item was changed:
> ----- Method: CCodeGenerator>>generateSignedShiftRight:on:indent: (in category 'C translation') -----
> generateSignedShiftRight: msgNode on: aStream indent: level
> "Generate the C code for >>> onto the given stream."
>
> | type typeIsUnsigned mustCastToSigned signedType |
> type := self typeFor: msgNode receiver in: currentMethod.
> + typeIsUnsigned := type first = $u or: [type = #'size_t'].
> - typeIsUnsigned := type first = $u.
> mustCastToSigned := typeIsUnsigned or:
> ["cast to sqInt if the int is shorter: we want to avoid UB related to a shift exceeeding bit width"
> (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
> mustCastToSigned
> ifTrue:
> ["If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
> signedType := (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
> ifTrue: [#sqInt]
> ifFalse: [self signedTypeForIntegralType: type].
> aStream nextPutAll: '(('; nextPutAll: signedType; nextPutAll: ')('.
> self emitCExpression: msgNode receiver on: aStream indent: level.
> aStream nextPutAll: '))']
> ifFalse:
> [aStream nextPutAll: '('.
> self emitCExpression: msgNode receiver on: aStream indent: level.
> aStream nextPut: $)].
> aStream nextPutAll: ' >> '.
> self emitCExpression: msgNode args first on: aStream!
>
> Item was changed:
> ----- Method: CCodeGenerator>>signedTypeForIntegralType: (in category 'type inference') -----
> signedTypeForIntegralType: aCTypeString
> (aCTypeString beginsWith: 'unsigned ') ifTrue:
> [^aCTypeString allButFirst: 8].
>
> (aCTypeString beginsWith: 'usq') ifTrue:
> [^aCTypeString allButFirst].
>
> + aCTypeString = #'size_t' ifTrue:
> + ["could be ssize_t if only it were universal...
> + On all targetted systems so far, this is as long as a pointer type."
> + ^#sqIntptr_t].
> - aCTypeString = 'size_t' ifTrue: [^#usqIntptr_t].
>
> self error: 'unknown type'.
> ^#long!
>
> Item was changed:
> ----- Method: CCodeGenerator>>unsignedTypeForIntegralType: (in category 'type inference') -----
> unsignedTypeForIntegralType: aCTypeString
> ^aCTypeString first = $u
> ifTrue: [aCTypeString]
> ifFalse:
> [(aCTypeString beginsWith: 'sq')
> ifTrue: ['u' , aCTypeString]
> + ifFalse: [aCTypeString = #'size_t'
> + ifTrue: [aCTypeString]
> + ifFalse: ['unsigned ' , aCTypeString]]]!
> - ifFalse: ['unsigned ' , aCTypeString]]!
>
> Item was changed:
> ----- Method: CoInterpreter>>incrementalMarkAndTracePrimTraceLog (in category 'debug support') -----
> incrementalMarkAndTracePrimTraceLog
> "The prim trace log is a circular buffer of objects. If there is
> an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has entries.
> If there is something at primTraceLogIndex it has wrapped."
> <inline: false>
> | entryOop |
> (primTraceLog at: (self safe: primTraceLogIndex - 1 mod: PrimTraceLogSize)) = 0 ifTrue:
> [^self].
> (primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
> [primTraceLogIndex to: PrimTraceLogSize - 1 do:
> [:i|
> entryOop := primTraceLog at: i.
> (entryOop ~= 0
> and: [objectMemory isNonImmediate: entryOop]) ifTrue:
> + [objectMemory marker markAndShouldScan: entryOop]]].
> - [objectMemory marker pushOnMarkingStackAndMakeGreyIfNecessary: entryOop]]].
> 0 to: primTraceLogIndex - 1 do:
> [:i|
> entryOop := primTraceLog at: i.
> (entryOop ~= 0
> and: [objectMemory isNonImmediate: entryOop]) ifTrue:
> + [objectMemory marker markAndShouldScan: entryOop]]!
> - [objectMemory marker pushOnMarkingStackAndMakeGreyIfNecessary: entryOop]]!
>
> Item was changed:
> ----- Method: CoInterpreter>>incrementalMarkAndTraceStackPage: (in category 'object memory support') -----
> incrementalMarkAndTraceStackPage: thePage
> | theSP theFP frameRcvrOffset callerFP oop |
> <var: #thePage type: #'StackPage *'>
> <var: #theSP type: #'char *'>
> <var: #theFP type: #'char *'>
> <var: #frameRcvrOffset type: #'char *'>
> <var: #callerFP type: #'char *'>
> <inline: false>
>
> self assert: (stackPages isFree: thePage) not.
> self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
> self assert: thePage trace ~= StackPageTraced.
> thePage trace: StackPageTraced.
>
> theSP := thePage headSP.
> theFP := thePage headFP.
> "Skip the instruction pointer on top of stack of inactive pages."
> thePage = stackPage ifFalse:
> [theSP := theSP + objectMemory wordSize].
> [frameRcvrOffset := self frameReceiverLocation: theFP.
> [theSP <= frameRcvrOffset] whileTrue:
> [oop := stackPages longAt: theSP.
> (objectMemory isOopForwarded: oop) ifTrue:
> [oop := objectMemory followForwarded: oop.
> stackPages longAt: theSP put: oop].
> (objectMemory isImmediate: oop) ifFalse:
> + [objectMemory marker markAndShouldScan: oop].
> - [objectMemory marker pushOnMarkingStackAndMakeGrey: oop].
> theSP := theSP + objectMemory wordSize].
> (self frameHasContext: theFP) ifTrue:
> [self assert: (objectMemory isContext: (self frameContext: theFP)).
> + objectMemory marker markAndShouldScan: (self frameContext: theFP)].
> - objectMemory marker pushOnMarkingStackAndMakeGrey: (self frameContext: theFP)].
> (self isMachineCodeFrame: theFP)
> ifTrue: [self markAndTraceMachineCodeMethod: (self mframeCogMethod: theFP)]
> + ifFalse: [objectMemory marker markAndShouldScan: (self iframeMethod: theFP)].
> - ifFalse: [objectMemory marker pushOnMarkingStackAndMakeGrey: (self iframeMethod: theFP)].
> (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
> [theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
> theFP := callerFP].
> theSP := theFP + FoxCallerSavedIP + objectMemory wordSize. "caller ip is ceBaseReturnPC"
> [theSP <= thePage baseAddress] whileTrue:
> [oop := stackPages longAt: theSP.
> (objectMemory isOopForwarded: oop) ifTrue:
> [oop := objectMemory followForwarded: oop.
> stackPages longAt: theSP put: oop].
> (objectMemory isImmediate: oop) ifFalse:
> + [objectMemory marker markAndShouldScan: oop].
> - [objectMemory marker pushOnMarkingStackAndMakeGrey: oop].
> theSP := theSP + objectMemory wordSize]!
>
> Item was changed:
> ----- Method: CoInterpreter>>incrementalMarkAndTraceTraceLog (in category 'object memory support') -----
> incrementalMarkAndTraceTraceLog
> "The trace log is a circular buffer of pairs of entries. If there is an entry at
> traceLogIndex - 3 \\ TraceBufferSize it has entries. If there is something at
> traceLogIndex it has wrapped."
> <inline: false>
> | limit |
> limit := self safe: traceLogIndex - 3 mod: TraceBufferSize.
> (traceLog at: limit) = 0 ifTrue: [^self].
> (traceLog at: traceLogIndex) ~= 0 ifTrue:
> [limit := TraceBufferSize - 3].
> 0 to: limit by: 3 do:
> [:i| | oop |
> oop := traceLog at: i.
> (objectMemory isImmediate: oop) ifFalse:
> + [objectMemory marker markAndShouldScan: oop].
> - [objectMemory marker pushOnMarkingStackAndMakeGreyIfNecessary: oop].
> oop := traceLog at: i + 1.
> (objectMemory isImmediate: oop) ifFalse:
> + [objectMemory marker markAndShouldScan: oop]]!
> - [objectMemory marker pushOnMarkingStackAndMakeGreyIfNecessary: oop]]!
>
> Item was changed:
> ----- Method: SocketPlugin>>primitiveSocket:connectTo:port: (in category 'primitives') -----
> primitiveSocket: socket connectTo: address port: port
> | addr s okToConnect |
> <var: #s type: 'SocketPtr'>
> self primitive: 'primitiveSocketConnectToPort' parameters: #(#Oop #ByteArray #SmallInteger ).
> addr := self netAddressToInt: (self cCoerce: address to: 'unsigned char *').
> "If the security plugin can be loaded, use it to check for permission.
> If not, assume it's ok"
> + interpreterProxy failed ifFalse:
> + [sCCTPfn ~= 0 ifTrue:
> + [okToConnect := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCTPfn)(addr, port)'.
> + okToConnect ifFalse:
> + [^ interpreterProxy primitiveFail]]].
> - sCCTPfn ~= 0 ifTrue:
> - [okToConnect := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCTPfn)(addr, port)'.
> - okToConnect ifFalse:
> - [^ interpreterProxy primitiveFail]].
> s := self socketValueOf: socket.
> interpreterProxy failed ifFalse:
> [self sqSocket: s ConnectTo: addr Port: port]!
>
> Item was changed:
> ----- Method: SocketPlugin>>primitiveSocket:listenOnPort: (in category 'primitives') -----
> primitiveSocket: socket listenOnPort: port
> "one part of the wierdass dual prim primitiveSocketListenOnPort which
> was warped by some demented evil person determined to twist the very
> nature of reality"
> | s okToListen |
> <var: #s type: 'SocketPtr '>
> self primitive: 'primitiveSocketListenOnPort' parameters: #(#Oop #SmallInteger ).
> s := self socketValueOf: socket.
> "If the security plugin can be loaded, use it to check for permission.
> If not, assume it's ok"
> - sCCLOPfn ~= 0 ifTrue:
> - [okToListen := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCLOPfn)((sqInt)s, port)'.
> - okToListen ifFalse:
> - [^ interpreterProxy primitiveFail]].
> interpreterProxy failed ifFalse:
> + [sCCLOPfn ~= 0 ifTrue:
> + [okToListen := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCLOPfn)((sqInt)s, port)'.
> + okToListen ifFalse:
> + [^ interpreterProxy primitiveFail]]].
> + interpreterProxy failed ifFalse:
> [self sqSocket: s ListenOnPort: port]!
>
> Item was changed:
> ----- Method: SocketPlugin>>primitiveSocket:listenOnPort:backlogSize: (in category 'primitives') -----
> primitiveSocket: socket listenOnPort: port backlogSize: backlog
> "second part of the wierdass dual prim primitiveSocketListenOnPort
> which was warped by some demented evil person determined to twist the
> very nature of reality"
> | s okToListen |
> <var: #s type: 'SocketPtr'>
> self primitive: 'primitiveSocketListenOnPortBacklog' parameters: #(#Oop #SmallInteger #SmallInteger ).
> "If the security plugin can be loaded, use it to check for permission.
> If not, assume it's ok"
> - sCCLOPfn ~= 0 ifTrue:
> - [okToListen := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCLOPfn)((sqInt)s, port)'.
> - okToListen ifFalse:
> - [^interpreterProxy primitiveFail]].
> s := self socketValueOf: socket.
> interpreterProxy failed ifFalse:
> + [sCCLOPfn ~= 0 ifTrue:
> + [okToListen := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCLOPfn)((sqInt)s, port)'.
> + okToListen ifFalse:
> + [^interpreterProxy primitiveFail]]].
> + interpreterProxy failed ifFalse:
> [self sqSocket: s ListenOnPort: port BacklogSize: backlog]!
>
> Item was changed:
> ----- Method: SocketPlugin>>primitiveSocket:listenOnPort:backlogSize:interface: (in category 'primitives') -----
> primitiveSocket: socket listenOnPort: port backlogSize: backlog interface: ifAddr
> "Bind a socket to the given port and interface address with no more than backlog pending connections. The socket can be UDP, in which case the backlog should be specified as zero."
>
> | s okToListen addr |
> <var: #s type: #SocketPtr>
> self primitive: 'primitiveSocketListenOnPortBacklogInterface' parameters: #(#Oop #SmallInteger #SmallInteger #ByteArray).
> "If the security plugin can be loaded, use it to check for permission.
> If not, assume it's ok"
> - sCCLOPfn ~= 0 ifTrue:
> - [okToListen := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCLOPfn)((sqInt)s, port)'.
> - okToListen ifFalse:
> - [^ interpreterProxy primitiveFail]].
> s := self socketValueOf: socket.
> + interpreterProxy failed ifFalse:
> + [sCCLOPfn ~= 0 ifTrue:
> + [okToListen := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCLOPfn)((sqInt)s, port)'.
> + okToListen ifFalse:
> + [^ interpreterProxy primitiveFail]]].
> addr := self netAddressToInt: (self cCoerce: ifAddr to: #'unsigned char *').
> interpreterProxy failed ifFalse:
> [self sqSocket: s ListenOnPort: port BacklogSize: backlog Interface: addr]!
>
> Item was changed:
> ----- Method: Spur64BitMMLESimulator>>setIsGreyOf:to: (in category 'header access') -----
> setIsGreyOf: objOop to: aBoolean
> "objOop = 16rB26020 ifTrue: [self halt]."
> "(#(16r1971D0 16r196EE0 16r197048 16r197148) includes: objOop) ifTrue:
> [self halt]."
> + "GCEventLog register: ((aBoolean
> - GCEventLog register: ((aBoolean
> ifTrue: [GCGreyEvent]
> + ifFalse: [GCUngreyEvent]) address: objOop)."
> - ifFalse: [GCUngreyEvent]) address: objOop).
>
> super setIsGreyOf: objOop to: aBoolean.
> "(aBoolean
> and: [(self isContextNonImm: objOop)
> and: [(coInterpreter
> checkIsStillMarriedContext: objOop
> currentFP: coInterpreter framePointer)
> and: [(coInterpreter stackPages stackPageFor: (coInterpreter frameOfMarriedContext: objOop)) trace = 0]]]) ifTrue:
> [self halt]"!
>
> Item was changed:
> ----- Method: Spur64BitMMLESimulator>>setIsMarkedOf:to: (in category 'header access') -----
> setIsMarkedOf: objOop to: aBoolean
> "objOop = 16rB26020 ifTrue: [self halt]."
> "(#(16r1971D0 16r196EE0 16r197048 16r197148) includes: objOop) ifTrue:
> [self halt]."
> + "GCEventLog register: ((aBoolean
> - GCEventLog register: ((aBoolean
> ifTrue: [GCMarkEvent]
> + ifFalse: [GCUnmarkEvent]) address: objOop)."
> - ifFalse: [GCUnmarkEvent]) address: objOop).
>
> super setIsMarkedOf: objOop to: aBoolean.
> "(aBoolean
> and: [(self isContextNonImm: objOop)
> and: [(coInterpreter
> checkIsStillMarriedContext: objOop
> currentFP: coInterpreter framePointer)
> and: [(coInterpreter stackPages stackPageFor: (coInterpreter frameOfMarriedContext: objOop)) trace = 0]]]) ifTrue:
> [self halt]"!
>
> Item was changed:
> ----- Method: Spur64BitMMLESimulator>>unlinkFreeChunk:chunkBytes: (in category 'as yet unclassified') -----
> unlinkFreeChunk: freeChunk chunkBytes: chunkBytes
>
> + "GCEventLog register: (GCUnlinkEvent address: freeChunk)."
> - GCEventLog register: (GCUnlinkEvent address: freeChunk).
> ^ super unlinkFreeChunk: freeChunk chunkBytes: chunkBytes!
>
> Item was changed:
> ----- Method: SpurGenerationScavenger>>copyToOldSpace:bytes:format: (in category 'scavenger') -----
> copyToOldSpace: survivor bytes: bytesInObject format: formatOfSurvivor
> "Copy survivor to oldSpace. Answer the new oop of the object."
> <inline: #never> "Should be too infrequent to lower icache density of copyAndForward:"
> | nTenures startOfSurvivor newStart newOop |
> self assert: (formatOfSurvivor = (manager formatOf: survivor)
> and: [((manager isMarked: survivor) not or: [tenureCriterion = MarkOnTenure])
> and: [tenureCriterion = TenureToShrinkRT
> or: [(manager isPinned: survivor) not
> and: [(manager isRemembered: survivor) not]]]]).
> nTenures := statTenures.
> startOfSurvivor := manager startOfObject: survivor.
> newStart := manager allocateOldSpaceChunkOfBytes: bytesInObject.
> newStart ifNil:
> [manager growOldSpaceByAtLeast: 0. "grow by growHeadroom"
> newStart := manager allocateOldSpaceChunkOfBytes: bytesInObject.
> newStart ifNil:
> [self error: 'out of memory']].
> "manager checkFreeSpace."
> manager memcpy: newStart asVoidPointer _: startOfSurvivor asVoidPointer _: bytesInObject.
> newOop := newStart + (survivor - startOfSurvivor).
> tenureCriterion >= (TenureToShrinkRT min: MarkOnTenure) ifTrue:
> [tenureCriterion = TenureToShrinkRT ifTrue:
> [manager rtRefCountOf: newOop put: 0].
> tenureCriterion = MarkOnTenure ifTrue:
> [manager setIsMarkedOf: newOop to: true]].
> +
> + manager gc maybeModifyGCFlagsOf: newOop.
> statTenures := nTenures + 1.
> (manager isAnyPointerFormat: formatOfSurvivor) ifTrue:
> ["A very quick and dirty scan to find young referents. If we misidentify bytes
> in a CompiledMethod as young we don't care; it's unlikely, and a subsequent
> scan of the rt will filter the object out. But it's good to filter here because
> otherwise an attempt to shrink the RT may simply fill it up with new objects,
> and here the data is likely in the cache."
> manager baseHeaderSize to: bytesInObject - (survivor - startOfSurvivor) - manager wordSize by: manager wordSize do:
> [:p| | field |
> field := manager longAt: survivor + p.
> (manager isReallyYoung: field) ifTrue:
> [self remember: newOop.
> ^newOop]]].
> ^newOop!
>
> Item was changed:
> ----- Method: SpurIncrementalCompactor>>completeCompact (in category 'as yet unclassified') -----
> completeCompact
>
> | segInfo |
> + self initCompactionIfNecessary.
> +
> 0 to: manager numSegments - 1 do:
> [:i |
> segInfo := self addressOf: (manager segmentManager segments at: i).
> (self isSegmentBeingCompacted: segInfo)
> ifTrue: [currentSegment := i.
> + currentHeapPointer := self compactSegment: segInfo freeStart: currentHeapPointer segIndex: i]].
> +
> + self postCompactionAction.
> + self finishCompaction.!
> - currentHeapPointer := self compactSegment: segInfo freeStart: currentHeapPointer segIndex: i]]!
>
> Item was changed:
> ----- Method: SpurIncrementalCompactor>>doIncrementalCompact (in category 'incremental compaction') -----
> doIncrementalCompact
>
> | segInfo |
> currentSegment to: manager numSegments - 1 do:
> [:i |
> segInfo := self addressOf: (manager segmentManager segments at: i).
> (self isSegmentBeingCompacted: segInfo)
> ifTrue: [currentSegment := i.
> +
> + coInterpreter cr; print: 'Compact from: '; printNum: segInfo segStart; print: ' to: '; printNum: segInfo segStart + segInfo segSize; print: ' into: ' ; printNum: segmentToFill segStart; tab; flush.
> +
> currentHeapPointer := self compactSegment: segInfo freeStart: currentHeapPointer segIndex: i.
> self assert: manager totalFreeOldSpace = manager totalFreeListBytes.
>
> self flag: #Todo. "for now we compact on segment at a time"
> ^ currentSegment = (manager numSegments - 1)
> ifTrue: [true]
> ifFalse: [false]]].
> ^ true!
>
> Item was changed:
> ----- Method: SpurIncrementalCompactor>>finishCompaction (in category 'incremental compaction') -----
> finishCompaction
>
> - self setFreeChunkOfCompactedIntoSegment.
> - self postCompactionAction.
> self resetCompactor!
>
> Item was changed:
> ----- Method: SpurIncrementalCompactor>>freePastSegmentsAndSetSegmentToFill (in category 'api') -----
> freePastSegmentsAndSetSegmentToFill
> "The first segment being claimed met becomes the segmentToFill. The others are just freed."
> | segInfo |
> <var: 'segInfo' type: #'SpurSegmentInfo *'>
> - segmentToFill := nil.
> 0 to: manager numSegments - 1 do:
> [:i|
> segInfo := self addressOf: (manager segmentManager segments at: i).
> (self isSegmentBeingCompacted: segInfo)
> ifTrue:
> [ | freeChunk chunkBytes |
> chunkBytes := segInfo segSize - manager bridgeSize.
> freeChunk := manager
> addFreeChunkWithBytes: chunkBytes
> at: segInfo segStart.
> segmentToFill
> ifNil: [manager detachFreeObject: freeChunk.
> segmentToFill := segInfo]]]!
>
> Item was changed:
> ----- Method: SpurIncrementalCompactor>>incrementalCompact (in category 'api') -----
> incrementalCompact
>
> + self initCompactionIfNecessary.
> - self initializeCompactionIfNecessary.
>
> shouldCompact
> + ifTrue: [ | finishedCompacting |
> + finishedCompacting := self doIncrementalCompact.
> + self postCompactionAction.
> +
> + finishedCompacting
> - ifTrue: [
> - self doIncrementalCompact
> ifTrue: [
> self finishCompaction.
> ^ true]]
> ifFalse: [^ true "nothing to compact => we are finished"].
>
> ^ false!
>
> Item was added:
> + ----- Method: SpurIncrementalCompactor>>initCompactionIfNecessary (in category 'incremental compaction') -----
> + initCompactionIfNecessary
> +
> + isCompacting
> + ifFalse: [self assertNoSegmentBeingCompacted.
> + self planCompactionAndReserveSpace.
> +
> + self assert: manager totalFreeOldSpace = manager totalFreeListBytes.
> +
> + shouldCompact ifTrue: [currentHeapPointer := segmentToFill segStart]].
> +
> + isCompacting := true.
> +
> + self assert: currentSegment notNil
> + !
>
> Item was removed:
> - ----- Method: SpurIncrementalCompactor>>initializeCompactionIfNecessary (in category 'incremental compaction') -----
> - initializeCompactionIfNecessary
> -
> - isCompacting
> - ifFalse: [self assertNoSegmentBeingCompacted.
> - self planCompactionAndReserveSpace.
> -
> - self assert: manager totalFreeOldSpace = manager totalFreeListBytes.
> -
> - shouldCompact ifTrue: [currentHeapPointer := segmentToFill segStart]].
> -
> - isCompacting := true.
> -
> - self assert: currentSegment notNil
> - !
>
> Item was changed:
> ----- Method: SpurIncrementalCompactor>>resetCompactor (in category 'as yet unclassified') -----
> resetCompactor
>
> + self setFreeChunkOfCompactedIntoSegment.
> +
> isCompacting := false.
> shouldCompact := nil.
> currentHeapPointer := nil.
> currentSegment := 0!
>
> Item was changed:
> ----- Method: SpurIncrementalCompactor>>segmentToFill (in category 'as yet unclassified') -----
> segmentToFill
>
> + <cmacro: '() GIV(segmentToFill)'>
> ^ segmentToFill!
>
> Item was changed:
> ----- Method: SpurIncrementalCompactor>>setFreeChunkOfCompactedIntoSegment (in category 'segment access') -----
> setFreeChunkOfCompactedIntoSegment
>
> segmentToFill ifNil: [^ self].
>
> manager
> addFreeChunkWithBytes: segmentToFill segSize - manager bridgeSize + segmentToFill segStart - currentHeapPointer
> + at: currentHeapPointer.
> +
> + "we have compacted into segmentToFill. It is now not empty anymore and we need to look for a new one"
> + shouldCompact
> + ifTrue: [segmentToFill := nil]
> + !
> - at: currentHeapPointer.!
>
> Item was added:
> + ----- Method: SpurIncrementalGarbageCollector class>>declareCVarsIn: (in category 'as yet unclassified') -----
> + declareCVarsIn: aCCodeGenerator
> + super declareCVarsIn: aCCodeGenerator.
> + aCCodeGenerator var: 'phase' declareC: 'sqInt phase = 0'!
>
> Item was changed:
> ----- Method: SpurIncrementalGarbageCollector class>>initialize (in category 'as yet unclassified') -----
> initialize
>
> + InMarkingPhase := 0.
> + InSweepingPhase := 1.
> + InCompactingPhase := 2.!
> - InCompactingPhase := 0.
> - InMarkingPhase := 1.
> - InSweepingPhase := 2.!
>
> Item was changed:
> ----- Method: SpurIncrementalGarbageCollector class>>simulatorClass (in category 'as yet unclassified') -----
> simulatorClass
>
> + "^ SpurIncrementalGarbageCollectorSimulator"
> + ^ self!
> - ^ SpurIncrementalGarbageCollectorSimulator!
>
> Item was changed:
> ----- Method: SpurIncrementalGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
> doIncrementalCollect
> +
> -
> phase = InMarkingPhase
> ifTrue: [
> + coInterpreter cr; print: 'start marking '; tab; flush.
> marker incrementalMarkObjects
> ifTrue: [
> manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)].
> - manager
> - setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
> - runLeakCheckerFor: GCModeFull;
> - checkFreeSpace: GCModeFull.
>
> "when sweeping the mutator needs to allocate new objects black as we do not have any information about them.
> We only know if they should get swept after the next marking -> keep them alive for this cycle"
> self allocatorShouldAllocateBlack: true.
> + compactor setInitialSweepingEntity.
> phase := InSweepingPhase.
>
> "marking is done and thus all forwarding references are resolved -> we can use the now free segments that were
> compacted during the last cycle"
> compactor freePastSegmentsAndSetSegmentToFill.
>
> + coInterpreter cr; print: 'finish marking '; tab; flush.
> +
> + manager
> + setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
> + runLeakCheckerFor: GCModeFull;
> + checkFreeSpace: GCModeFull.
> +
> +
> ^ self]
> + ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush.manager runLeakCheckerFor: GCModeIncremental]].
> - ifFalse: [manager runLeakCheckerFor: GCModeIncremental]].
>
> phase = InSweepingPhase
> ifTrue: [
> + coInterpreter cr; print: 'start sweeping '; tab; flush.
> compactor incrementalSweep
> ifTrue: [
> self allocatorShouldAllocateBlack: false.
> manager allOldSpaceObjectsDo: [:ea | self assert: (manager isWhite: ea) ].
> "self assert: manager allObjectsUnmarked."
> +
> + coInterpreter cr; print: 'finish sweeping '; tab; flush.
> +
> + manager
> + setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
> + runLeakCheckerFor: GCModeFull;
> + checkFreeSpace: GCModeFull.
> +
> phase := InCompactingPhase.
> ^ self]].
>
> phase = InCompactingPhase
> ifTrue: [
> + coInterpreter cr; print: 'start compacting '; tab; flush.
> compactor incrementalCompact
> + ifTrue: [
> + coInterpreter cr; print: 'finish compacting '; tab; flush.
> + manager
> + setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
> + runLeakCheckerFor: GCModeFull;
> + checkFreeSpace: GCModeFull.
> +
> + phase := InMarkingPhase.
> - ifTrue: [phase := InMarkingPhase.
> ^ self]]!
>
> Item was changed:
> ----- Method: SpurIncrementalGarbageCollector>>fullGC (in category 'global') -----
> fullGC
> "We need to be able to make a full GC, e.g. when we save the image. Use the made progress and finish the collection"
>
> + "incredible hacky solution. Will later on be replaced with the old collection, but for now use this to keep the state transitions consistent"
> +
> self assert: manager validObjStacks.
>
> + coInterpreter cr; print: 'start fullGC '; tab; flush.
> - "we are not sweeping anymore => reset it"
> - allocatorShouldAllocateBlack := false.
> - compactor resetComponents.
> - manager shutDownGlobalIncrementalGC: true.
>
> coInterpreter setGCMode: GCModeNewSpace.
> self doScavengeWithoutIncrementalCollect: MarkOnTenure.
> - coInterpreter setGCMode: GCModeIncremental.
>
> + phase = InMarkingPhase
> + ifTrue: [
> + "end marking"
> + [phase = InMarkingPhase]
> + whileTrue: [self doIncrementalCollect]].
> +
> + "end this collection cycle"
> + [phase ~= InMarkingPhase]
> + whileTrue: [self doIncrementalCollect].
> +
> + "resolve forwarders in young space"
> + coInterpreter setGCMode: GCModeNewSpace.
> + self doScavengeWithoutIncrementalCollect: MarkOnTenure.
> +
> + "mark completely"
> + [phase = InMarkingPhase]
> + whileTrue: [self doIncrementalCollect].
> + "do rest of collection"
> + [phase ~= InMarkingPhase]
> + whileTrue: [self doIncrementalCollect].
> - marker completeMarkObjects.
> - compactor sweepAndCompact.
>
> + manager setHeapSizeAtPreviousGC.
> - "we do not need to make a complete mark, we just need to resolve and delete forwarders"
> - "marker resolveAllForwarders"
> - "lets be lazy here as this won't be the final implementation"
> - marker completeMarkObjects.
>
> + coInterpreter cr; print: 'end fullGC '; tab; flush.
> +
> + ^(manager freeLists at: 0) ~= 0
> + ifTrue: [manager bytesInBody: manager findLargestFreeChunk]
> + ifFalse: [0]!
> - manager setHeapSizeAtPreviousGC!
>
> Item was changed:
> ----- Method: SpurIncrementalGarbageCollector>>maybeModifyGCFlagsOf: (in category 'as yet unclassified') -----
> maybeModifyGCFlagsOf: objOop
>
> + "when allocating a new object behind the current sweeping hight mark it should be allocated black so it does not get garbage
> + collected although we do not know if this is correct"
> <inline: true>
> ((manager isOldObject: objOop) and: [allocatorShouldAllocateBlack and: [objOop >= compactor currentSweepingEntity]])
> ifTrue: [manager setIsMarkedOf: objOop to: true]!
>
> Item was added:
> + ----- Method: SpurIncrementalGarbageCollector>>phase (in category 'accessing') -----
> + phase
> +
> + ^ phase!
>
> Item was added:
> + ----- Method: SpurIncrementalGarbageCollector>>phase: (in category 'accessing') -----
> + phase: anObject
> +
> + phase := anObject.!
>
> Item was changed:
> ----- Method: SpurIncrementalGarbageCollectorSimulator>>doIncrementalCollect (in category 'as yet unclassified') -----
> doIncrementalCollect
>
> | context |
> manager statScavenges \\ 50 = 0 ifTrue: [GCEventLog reset].
> "(manager statScavenges > 218 and: [phase = InSweepingPhase]) ifTrue: [self halt]."
> "manager statScavenges = 320 ifTrue: [self halt]."
>
> "pop mutator context"
> context := GCEventLog instance popContext.
> + self assert: (context kind = #mutator or: [context kind = #fullGC]).
> - self assert: context kind = #mutator.
> super doIncrementalCollect.
> +
> + context kind = #fullGC
> + ifTrue: [GCEventLog instance pushContext: context]
> + ifFalse: [GCEventLog instance pushMutatorContext]
> + !
> - GCEventLog instance pushMutatorContext!
>
> Item was added:
> + ----- Method: SpurIncrementalGarbageCollectorSimulator>>fullGC (in category 'global') -----
> + fullGC
> +
> + GCEventLog
> + inContext: #fullGC
> + do: [super fullGC]!
>
> Item was changed:
> + ----- Method: SpurIncrementalGarbageCollectorSimulator>>initialize (in category 'initialize-release') -----
> - ----- Method: SpurIncrementalGarbageCollectorSimulator>>initialize (in category 'as yet unclassified') -----
> initialize
>
> super initialize.
> GCEventLog reset!
>
> Item was changed:
> + ----- Method: SpurIncrementalGarbageCollectorSimulator>>manager: (in category 'accessing') -----
> - ----- Method: SpurIncrementalGarbageCollectorSimulator>>manager: (in category 'as yet unclassified') -----
> manager: manager
>
> super manager: manager.
> GCEventLog instance manager: manager!
>
> Item was changed:
> ----- Method: SpurIncrementalMarker class>>simulatorClass (in category 'as yet unclassified') -----
> simulatorClass
>
> + "^ SpurIncrementalMarkerSimulation"
> + ^ self!
> - ^ SpurIncrementalMarkerSimulation!
>
> Item was changed:
> ----- Method: SpurIncrementalMarker>>completeMarkObjects (in category 'marking - global') -----
> completeMarkObjects
> "this method is meant to be run for a complete GC that is used for snapshots. It discards previous marking information, because
> this will probably include some objects that should be collected
> It makes me a bit sad but I cannot see how this could be avoided"
>
> <inline: #never> "for profiling"
> + coInterpreter cr; print: 'completeMarkObjects '; tab; flush.
> -
> "reset and reinitialize all helper structures and do actions to be done at the start of marking"
> + manager shutDownGlobalIncrementalGC: true.
> self resetMarkProgress.
> + self initForNewMarkingPassIfNecessary.
> - self initializeForNewMarkingPassIfNecessary.
>
> self pushAllRootsOnMarkStack.
> self completeMark.
>
> self finishMarking.
> +
> + manager gc compactor setInitialSweepingEntity.
> + manager gc compactor freePastSegmentsAndSetSegmentToFill.
> +
> manager runLeakCheckerFor: GCModeFull.
>
> !
>
> Item was changed:
> ----- Method: SpurIncrementalMarker>>incrementalMarkObjects (in category 'marking - incremental') -----
> incrementalMarkObjects
> "this method is to be run directly after a scavenge -> we can assume there are ony objects in the now past survivor space"
>
> <inline: #never> "for profiling"
>
> "manager runLeakCheckerFor: GCModeIncremental."
>
> + self initForNewMarkingPassIfNecessary.
> - self initializeForNewMarkingPassIfNecessary.
>
> [ | continueMarking |
> (manager isEmptyObjStack: manager markStack)
> ifTrue: [self pushAllRootsOnMarkStack.
> " manager sizeOfObjStack: manager markStack.
> did we finish marking?"
> (manager isEmptyObjStack: manager markStack)
> ifTrue: [self finishMarking.
> ^ true]].
>
>
> "due to a slang limitations we have to assign the result into variable => do not remove!!"
> continueMarking := self incrementalMark.
> continueMarking] whileTrue.
>
> ^ false
> !
>
> Item was added:
> + ----- Method: SpurIncrementalMarker>>initForNewMarkingPassIfNecessary (in category 'marking-initialization') -----
> + initForNewMarkingPassIfNecessary
> +
> + isCurrentlyMarking
> + ifFalse: [
> + manager initializeMarkStack.
> + manager initializeWeaklingStack.
> + manager initializeEphemeronStack.
> +
> + "This must come first to enable stack page reclamation. It clears
> + the trace flags on stack pages and so must precede any marking.
> + Otherwise it will clear the trace flags of reached pages."
> + coInterpreter initStackPageGC.
> +
> + self markHelperStructures].
> +
> + isCurrentlyMarking := true.
> + marking := true!
>
> Item was removed:
> - ----- Method: SpurIncrementalMarker>>initializeForNewMarkingPassIfNecessary (in category 'marking-initialization') -----
> - initializeForNewMarkingPassIfNecessary
> -
> - isCurrentlyMarking
> - ifFalse: [
> - manager initializeMarkStack.
> - manager initializeWeaklingStack.
> - manager initializeEphemeronStack.
> -
> - "This must come first to enable stack page reclamation. It clears
> - the trace flags on stack pages and so must precede any marking.
> - Otherwise it will clear the trace flags of reached pages."
> - coInterpreter initStackPageGC.
> -
> - self markHelperStructures].
> -
> - isCurrentlyMarking := true.
> - marking := true!
>
> Item was changed:
> ----- Method: SpurIncrementalMarker>>isLeafInObjectGraph: (in category 'barrier') -----
> isLeafInObjectGraph: anObject
>
> + ^ (manager isImmediate: anObject)!
> - ^ (manager isImmediate: anObject) or: [manager isPureBitsNonImm: anObject]!
>
> Item was changed:
> ----- Method: SpurIncrementalMarker>>markAndShouldScan: (in category 'marking - incremental') -----
> markAndShouldScan: objOop
> "marks the object (grey or black as neccessary) and returns if the object should be scanned
> Objects that get handled later on get marked as black, as they are practically a leaf in the object tree (we scan them later on, so we cannot lose objects and do not
> need to adhere to the tricolor invariant)"
>
> | format |
> <inline: true>
> (manager isYoung: objOop)
> ifTrue: [^ false].
>
> (manager isImmediate: objOop) ifTrue:
> [^false].
>
> self assert: (manager isForwarded: objOop) not.
>
> "if it is marked we already did everything we needed to do and if is grey we already saw it and do not have to do anything here"
> (manager isWhite: objOop) not ifTrue:
> [^false].
>
> format := manager formatOf: objOop.
>
> (manager isPureBitsFormat: format) ifTrue: "avoid pushing non-pointer objects on the markStack."
> ["Avoid tracing classes of non-objects on the heap, e.g. IRC caches, Sista counters."
> (manager classIndexOf: objOop) > manager lastClassIndexPun ifTrue:
> [self markAndTraceClassOf: objOop].
>
> "the object does not need to enter the marking stack as there are no pointer to visit -> it is already finished and we can make it black"
> self blackenObject: objOop.
> ^false].
>
> (manager isWeakFormat: format) ifTrue: "push weaklings on the weakling stack to scan later"
> [manager push: objOop onObjStack: manager weaklingStack.
> "do not follow weak references. They get scanned at the end of marking -> it should be ok to not follow the tricolor invariant"
> self blackenObject: objOop.
> ^false].
>
> ((manager isEphemeronFormat: format)
> and: [manager activeAndDeferredScan: objOop]) ifTrue:
> [self blackenObject: objOop.
> ^false].
>
> "we know it is an object that can contain we have to follow"
> self pushOnMarkingStackAndMakeGrey: objOop.
>
> ^ true!
>
> Item was changed:
> ----- Method: SpurIncrementalMarker>>markFrom:nSlots:of: (in category 'as yet unclassified') -----
> markFrom: startIndex nSlots: anAmount of: objOop
>
> startIndex to: startIndex + anAmount - 1
> do: [:index | | slot |
> slot := manager fetchPointer: index ofObject: objOop.
>
> (manager isNonImmediate: slot)
> ifTrue: [
> (manager isForwarded: slot)
> ifTrue: [slot := manager fixFollowedField: slot ofObject: objOop withInitialValue: slot].
> self markAndShouldScan: slot]]!
>
> Item was changed:
> ----- Method: SpurIncrementalMarker>>pushNewSpaceReferencesOnMarkingStack (in category 'root-scanning') -----
> pushNewSpaceReferencesOnMarkingStack
>
> manager allNewSpaceObjectsDo: [:objOop | | format |
> format := manager formatOf: objOop.
> +
> + "has the object pointers to visit?"
> ((manager isNonImmediate: objOop) and: [(manager isPureBitsFormat: format) not])
> ifTrue: [ | slotNumber |
> slotNumber := manager numStrongSlotsOfInephemeral: objOop.
>
> 0 to: slotNumber - 1
> do: [ :slotIndex | | slot |
> slot := manager fetchPointer: slotIndex ofObject: objOop.
>
> (self shoudlBeOnMarkingStack: slot)
> ifTrue: [self markAndShouldScan: slot]]]]
> !
>
> Item was changed:
> ----- Method: SpurIncrementalMarker>>writeBarrierFor:at:with: (in category 'barrier') -----
> writeBarrierFor: anObject at: index with: value
> "a dijkstra style write barrier with the addition of the generation check
> objects that are not able to contain pointers are ignored too, as the write barries
> should ensure we lose no references and this objects do not hold any of them"
> <inline: true>
>
> self flag: #Todo. "we probably want the oldObject check to be the first one as it is only a pointer comparison and no dereferencing is needed"
> + (self marking and: [(self isLeafInObjectGraph: value) not and: [(manager isOldObject: anObject) and: [(manager isOldObject: value) and: [manager isMarked: anObject]]]])
> - (self marking and: [(self isLeafInObjectGraph: anObject) not and: [(self isLeafInObjectGraph: value) not and: [(manager isOldObject: anObject) and: [(manager isOldObject: value) and: [manager isMarked: anObject]]]]])
> ifTrue: [self pushOnMarkingStackAndMakeGreyIfNecessary: value]!
>
> Item was added:
> + ----- Method: SpurIncrementalMarkerSimulation>>initForNewMarkingPassIfNecessary (in category 'marking-initialization') -----
> + initForNewMarkingPassIfNecessary
> +
> + ^ GCEventLog
> + inContext: #markingInit
> + do: [super initForNewMarkingPassIfNecessary]!
>
> Item was removed:
> - ----- Method: SpurIncrementalMarkerSimulation>>initializeForNewMarkingPassIfNecessary (in category 'marking-initialization') -----
> - initializeForNewMarkingPassIfNecessary
> -
> - ^ GCEventLog
> - inContext: #markingInit
> - do: [super initializeForNewMarkingPassIfNecessary]!
>
> Item was changed:
> ----- Method: SpurIncrementalSweepAndCompact class>>simulatorClass (in category 'as yet unclassified') -----
> simulatorClass
>
> + "^ SpurIncrementalSweepAndCompactSimulator"
> + ^ self!
> - ^ SpurIncrementalSweepAndCompactSimulator!
>
> Item was added:
> + ----- Method: SpurIncrementalSweepAndCompact>>setInitialSweepingEntity (in category 'as yet unclassified') -----
> + setInitialSweepingEntity
> +
> + sweeper currentSweepingEntity: manager firstObject!
>
> Item was changed:
> ----- Method: SpurIncrementalSweeper class>>simulatorClass (in category 'as yet unclassified') -----
> simulatorClass
>
> + "^ SpurIncrementalSweeperSimulator"
> + ^ self!
> - ^ SpurIncrementalSweeperSimulator!
>
> Item was changed:
> ----- Method: SpurIncrementalSweeper>>bulkFreeChunkFrom: (in category 'api - global') -----
> bulkFreeChunkFrom: objOop
> "The old space entity before objOop is necessarily a marked object. Attempts to free as many bytes
> from objOop start as possible, looking ahead to free contiguous freechunks / unmarked objects"
> | bytes start next currentObj |
> self assert: (self canUseAsFreeSpace: objOop).
> +
> start := manager startOfObject: objOop.
> currentObj := objOop.
> bytes := 0.
> +
> [bytes := bytes + (manager bytesInBody: currentObj).
> (manager isRemembered: currentObj)
> ifTrue:
> [self assert: (manager isFreeObject: currentObj) not.
> scavenger forgetObject: currentObj].
>
> next := manager objectStartingAt: start + bytes.
> self assert: ((manager oop: next isLessThan: manager endOfMemory)
> or: [next = manager endOfMemory and: [(self canUseAsFreeSpace: next) not]]).
> +
> + "we found the end of a segment (old space segments always end in a bridge). Advance to the next"
> + next = currentSegmentsBridge
> + ifTrue: [self advanceSegment].
>
> + (self canUseAsFreeSpace: next)]
> - self canUseAsFreeSpace: next]
> whileTrue: [currentObj := next].
> +
> + currentSegmentUnused := currentSegmentUnused + bytes.
> -
> ^ manager addFreeChunkWithBytes: bytes at: start!
>
> Item was changed:
> ----- Method: SpurIncrementalSweeper>>cautiousBulkFreeChunkFrom: (in category 'api - incremental') -----
> cautiousBulkFreeChunkFrom: objOop
> "The old space entity before objOop is necessarily a marked object. Attempts to free as many bytes
> from objOop start as possible, looking ahead to free contiguous freechunks / unmarked objects"
> | bytes start next currentObj |
> self assert: (self canUseAsFreeSpace: objOop).
>
> start := manager startOfObject: objOop.
> currentObj := objOop.
> bytes := 0.
>
> [bytes := bytes + (manager bytesInBody: currentObj).
> (manager isRemembered: currentObj)
> ifTrue:
> [self assert: (manager isFreeObject: currentObj) not.
> scavenger forgetObject: currentObj].
>
> (manager isFreeObject: currentObj)
> ifTrue: [ "we need to unlink chunks for concurrent sweeping. In the stop the world sweeper we can just reset the freeLists but here we need to keep them
> around so the mutator can still work between sweeping passes"
>
> self flag: #Todo. "we want to optimize for lilliputian chunks!! For now it is ok(ish) but we have to do something about it.
> At the moment I see 3 possibilities:
> - have the lilliputian list always sorted (O(n) insert in the worst case!!)
> - sort the lilliputian part before sweeping (O(n log n) at the start. but everytime before sweeping)
> - be cheeky and discard the lilliputian list (problem: the mutator has no access to the list + it can insert unsorted chunks (for the duration of sweeping we could let it use a second list and just append it after sweeping)"
> + manager detachFreeObject: currentObj.
> - manager unlinkFreeChunk: currentObj chunkBytes: (manager bytesInBody: currentObj).
> - manager totalFreeOldSpace: manager totalFreeOldSpace - (manager bytesInBody: currentObj).
> self assert: manager totalFreeOldSpace = manager totalFreeListBytes.
> currentSegmentUnused := currentSegmentUnused + (manager bytesInBody: currentSweepingEntity)].
>
> next := manager objectStartingAt: start + bytes.
> currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 1.
> self assert: ((manager oop: next isLessThan: manager endOfMemory)
> or: [next = manager endOfMemory and: [(self canUseAsFreeSpace: next) not]]).
>
> "we found the end of a segment (old space segments always end in a bridge). Advance to the next"
> next = currentSegmentsBridge
> ifTrue: [self advanceSegment].
>
> (self canUseAsFreeSpace: next) and: [currentsCycleSeenObjectCount < MaxObjectsToFree]]
> whileTrue: [currentObj := next].
>
> ^ manager addFreeChunkWithBytes: bytes at: start!
>
> Item was added:
> + ----- Method: SpurIncrementalSweeper>>completeSweepCurrentSweepingEntity (in category 'api - incremental') -----
> + completeSweepCurrentSweepingEntity
> +
> + (self canUseAsFreeSpace: currentSweepingEntity)
> + ifTrue: [currentSweepingEntity := self bulkFreeChunkFrom: currentSweepingEntity]
> + ifFalse: [self unmarkAndUpdateStats].
> + !
>
> Item was changed:
> ----- Method: SpurIncrementalSweeper>>doGlobalSweep (in category 'api - global') -----
> doGlobalSweep
> "Iterate over all entities, in order, making large free chunks from free chunks and unmarked objects,
> unmarking live objects and rebuilding the free lists."
>
> + self initIfNecessary.
> +
> - currentSweepingEntity := manager firstObject.
> [self oop: currentSweepingEntity isLessThan: manager endOfMemory] whileTrue:
> + [currentSweepingEntity = currentSegmentsBridge
> + ifTrue: [self advanceSegment]
> + ifFalse: [self completeSweepCurrentSweepingEntity].
> +
> + currentSweepingEntity := self nextSweepingEntity].
> - [(self canUseAsFreeSpace: currentSweepingEntity)
> - ifTrue: [currentSweepingEntity := self bulkFreeChunkFrom: currentSweepingEntity]
> - ifFalse: [self unmark: currentSweepingEntity].
> - currentSweepingEntity := manager objectAfter: currentSweepingEntity limit: manager endOfMemory].
>
> manager checkFreeSpace: GCModeFull.
> +
> + "not sure if I need this (probably not), but it was in the original implementation"
> manager unmarkSurvivingObjectsForCompact.!
>
> Item was changed:
> ----- Method: SpurIncrementalSweeper>>doIncrementalSweeping (in category 'api - incremental') -----
> doIncrementalSweeping
>
> "Scan the heap for unmarked objects and free them. Coalescence "
> self assert: currentSweepingEntity notNil.
>
> currentsCycleSeenObjectCount := 0.
>
> [self oop: currentSweepingEntity isLessThan: manager endOfMemory] whileTrue:
> [ currentSweepingEntity = currentSegmentsBridge
> ifTrue: [self advanceSegment]
> ifFalse: [self sweepCurrentSweepingEntity].
>
> + currentSweepingEntity := self nextSweepingEntity.
> - currentSweepingEntity :=self nextSweepingEntity .
>
> currentsCycleSeenObjectCount >= MaxObjectsToFree
> ifTrue: [^ false]].
>
> manager checkFreeSpace: GCModeIncremental.
> ^ true!
>
> Item was changed:
> ----- Method: SpurIncrementalSweeper>>incrementalSweep (in category 'api - incremental') -----
> incrementalSweep
> <inline: #never> "for profiling"
>
> + self initIfNecessary.
> - self initializeIfNecessary.
>
> self doIncrementalSweeping
> ifTrue: [self finishSweeping.
> ^ true].
>
> ^ false
> !
>
> Item was added:
> + ----- Method: SpurIncrementalSweeper>>initIfNecessary (in category 'api - incremental') -----
> + initIfNecessary
> +
> + isCurrentlySweeping
> + ifFalse: [currentSegmentUsed := currentSegmentUnused := 0.
> + currentSegmentsIndex := 0.
> + currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex.
> +
> + currentSweepingEntity := manager firstObject.
> +
> + isCurrentlySweeping := true]
> + !
>
> Item was removed:
> - ----- Method: SpurIncrementalSweeper>>initializeIfNecessary (in category 'api - incremental') -----
> - initializeIfNecessary
> -
> - isCurrentlySweeping
> - ifFalse: [currentSegmentUsed := currentSegmentUnused := 0.
> - currentSegmentsIndex := 0.
> - currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex.
> -
> - currentSweepingEntity := manager firstObject.
> -
> - isCurrentlySweeping := true]
> - !
>
> Item was changed:
> ----- Method: SpurIncrementalSweeper>>resetSweeper (in category 'as yet unclassified') -----
> resetSweeper
>
> "reset all incremental progress. To be used before doing a global sweep to leave the sweeper in the correct state for the next time"
> isCurrentlySweeping := false.
> currentSweepingEntity := nil.
> currentSegmentUsed := nil.
> currentSegmentUnused := nil.
> currentSegmentsIndex := nil.
> + currentsCycleSeenObjectCount := 0
> - currentsCycleSeenObjectCount := nil
>
> !
>
> Item was added:
> + ----- Method: SpurIncrementalSweeperSimulator>>initIfNecessary (in category 'api - incremental') -----
> + initIfNecessary
> +
> + ^ GCEventLog
> + inContext: #sweepInit
> + do: [super initIfNecessary]!
>
> Item was removed:
> - ----- Method: SpurIncrementalSweeperSimulator>>initializeIfNecessary (in category 'api - incremental') -----
> - initializeIfNecessary
> -
> - ^ GCEventLog
> - inContext: #sweepInit
> - do: [super initializeIfNecessary]!
>
> Item was changed:
> ----- Method: SpurMemoryManager>>addFreeChunkWithBytes:at: (in category 'free space') -----
> addFreeChunkWithBytes: bytes at: address
> +
> + <var: 'aCString' type: #'usqInt'>
> totalFreeOldSpace := totalFreeOldSpace + bytes.
> ^self freeChunkWithBytes: bytes at: address!
>
> Item was changed:
> ----- Method: SpurMemoryManager>>addToFreeList:bytes: (in category 'free space') -----
> addToFreeList: freeChunk bytes: chunkBytes
> "Add freeChunk to the relevant freeList.
> For the benefit of sortedFreeObject:, if freeChunk is large, answer the treeNode it
> is added to, if it is added to the next list of a freeTreeNode, otherwise answer 0."
> | index |
> + <var: 'chunkBytes' type: #'usqInt'>
> "coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk."
> self assert: (self isFreeObject: freeChunk).
> self assert: chunkBytes = (self bytesInBody: freeChunk).
> "Too slow to be enabled byt default but useful to debug Selective...
> self deny: (compactor isSegmentBeingCompacted: (segmentManager segmentContainingObj: freeChunk))."
> index := chunkBytes / self allocationUnit.
> index < self numFreeLists ifTrue:
> [self setNextFreeChunkOf: freeChunk withValue: (freeLists at: index) chunkBytes: chunkBytes.
> (self isLilliputianSize: chunkBytes) ifFalse:
> [self storePointer: self freeChunkPrevIndex ofFreeChunk: freeChunk withValue: 0].
> freeLists at: index put: freeChunk.
> freeListsMask := freeListsMask bitOr: 1 << index.
> ^0].
>
> ^self addToFreeTree: freeChunk bytes: chunkBytes!
>
> Item was changed:
> ----- Method: SpurMemoryManager>>allObjects (in category 'primitive support') -----
> allObjects
> "Attempt to answer an array of all objects, excluding those that may
> be garbage collected as a side effect of allocating the result array.
> If no memory is available answer the number of objects as a SmallInteger.
> Since objects are at least 16 bytes big, and the largest SmallInteger covers
> 1/4 of the address space, the count can never overflow."
> | freeChunk ptr start limit count bytes |
> gc markObjectsForEnumerationPrimitives ifTrue:
> [marker markObjects: true]. "may not want to revive objects unnecessarily; but marking is sloooow."
> freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace"
> ptr := start := freeChunk + self baseHeaderSize.
> limit := self addressAfter: freeChunk.
> count := 0.
> self allHeapEntitiesDo:
> [:obj| "continue enumerating even if no room so as to unmark all objects."
> (gc markObjectsForEnumerationPrimitives
> ifTrue: [self isMarked: obj]
> ifFalse: [true]) ifTrue:
> [(self isNormalObject: obj)
> ifTrue:
> [gc markObjectsForEnumerationPrimitives ifTrue:
> [self setIsMarkedOf: obj to: false].
> count := count + 1.
> ptr < limit ifTrue:
> [self longAt: ptr put: obj.
> ptr := ptr + self bytesPerOop]]
> ifFalse:
> [gc markObjectsForEnumerationPrimitives ifTrue:
> [(self isSegmentBridge: obj) ifFalse:
> [self setIsMarkedOf: obj to: false]]]]].
> self assert: (self isEmptyObjStack: markStack).
> gc markObjectsForEnumerationPrimitives
> ifTrue:
> [self assert: self allObjectsUnmarked.
> self emptyObjStack: weaklingStack]
> ifFalse:
> [self assert: (self isEmptyObjStack: weaklingStack)].
> self assert: count >= self numSlotsMask.
> (count > (ptr - start / self bytesPerOop) "not enough room"
> or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
> [self freeChunkWithBytes: (self bytesInBody: freeChunk) at: (self startOfObject: freeChunk).
> self checkFreeSpace: GCModeFull.
> ^self integerObjectOf: count].
> bytes := self largeObjectBytesForSlots: count.
> start := self startOfObject: freeChunk.
> self freeChunkWithBytes: limit - start - bytes at: start + bytes.
> totalFreeOldSpace := totalFreeOldSpace - bytes.
> self rawOverflowSlotsOf: freeChunk put: count.
> self set: freeChunk classIndexTo: ClassArrayCompactIndex formatTo: self arrayFormat.
> + gc maybeModifyGCFlagsOf: freeChunk.
> self possibleRootStoreInto: freeChunk.
> self checkFreeSpace: GCModeFull.
> self runLeakCheckerFor: GCModeFull.
> ^freeChunk!
>
> Item was changed:
> ----- Method: SpurMemoryManager>>checkHeapFreeSpaceIntegrity (in category 'debug support') -----
> checkHeapFreeSpaceIntegrity
> "Perform an integrity/leak check using the heapMap. Assume clearLeakMapAndMapAccessibleFreeSpace
> has set a bit at each free chunk's header. Scan all objects in the heap checking that no pointer points
> to a free chunk and that all free chunks that refer to others refer to marked chunks. Answer if all checks pass."
> | ok total |
> <inline: false>
> <var: 'total' type: #usqInt>
> ok := true.
> total := 0.
> 0 to: self numFreeLists - 1 do:
> [:i|
> (freeLists at: i) ~= 0 ifTrue:
> [(heapMap heapMapAtWord: (self pointerForOop: (freeLists at: i))) = 0 ifTrue:
> [coInterpreter print: 'leak in free list '; printNum: i; print: ' to non-free '; printHex: (freeLists at: i); eekcr.
> ok := false]]].
>
> "Excuse the duplication but performance is at a premium and we avoid
> some tests by splitting the newSpace and oldSpace enumerations."
> self allNewSpaceEntitiesDo:
> [:obj| | fieldOop |
> (self isFreeObject: obj)
> ifTrue:
> [coInterpreter print: 'young object '; printHex: obj; print: ' is free'; eekcr.
> + coInterpreter longPrintOop: obj.
> ok := false]
> ifFalse:
> [obj ~= freeSpaceCheckOopToIgnore ifTrue:
> [0 to: (self numPointerSlotsOf: obj) - 1 do:
> [:fi|
> fieldOop := self fetchPointer: fi ofObject: obj.
> (self isNonImmediate: fieldOop) ifTrue:
> [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) ~= 0 ifTrue:
> [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is free'; eekcr.
> + coInterpreter longPrintOop: obj.
> ok := false]]]]]].
> self allOldSpaceEntitiesDo:
> [:obj| | fieldOop |
> (self isFreeObject: obj)
> ifTrue:
> + [
> + (compactor compactor segmentToFill isNil or: [(self objectStartingAt: (compactor compactor segmentToFill segStart)) ~= obj])
> + ifTrue: [
> + (heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
> + [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' is unmapped?!! '; eekcr.
> + coInterpreter longPrintOop: obj.
> + ok := false].
> + fieldOop := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj.
> - [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
> - [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' is unmapped?!! '; eekcr.
> - ok := false].
> - fieldOop := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj.
> - (fieldOop ~= 0
> - and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
> - [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is unmapped'; eekcr.
> - ok := false].
> - (self isLilliputianSize: (self bytesInBody: obj)) ifFalse:
> - [fieldOop := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: obj.
> (fieldOop ~= 0
> and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
> [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is unmapped'; eekcr.
> + coInterpreter longPrintOop: obj.
> + ok := false].
> + (self isLilliputianSize: (self bytesInBody: obj)) ifFalse:
> + [fieldOop := self fetchPointer: self freeChunkPrevIndex ofFreeChunk: obj.
> - ok := false]].
> - (self isLargeFreeObject: obj) ifTrue:
> - [self freeChunkParentIndex to: self freeChunkLargerIndex do:
> - [:fi|
> - fieldOop := self fetchPointer: fi ofFreeChunk: obj.
> (fieldOop ~= 0
> and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
> + [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is unmapped'; eekcr.
> + coInterpreter longPrintOop: obj.
> + ok := false]].
> + (self isLargeFreeObject: obj) ifTrue:
> + [self freeChunkParentIndex to: self freeChunkLargerIndex do:
> + [:fi|
> + fieldOop := self fetchPointer: fi ofFreeChunk: obj.
> + (fieldOop ~= 0
> + and: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
> + [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is unmapped'; eekcr.
> + coInterpreter longPrintOop: obj.
> + ok := false]]].
> + total := total + (self bytesInBody: obj)]]
> +
> - [coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is unmapped'; eekcr.
> - ok := false]]].
> - total := total + (self bytesInBody: obj)]
> ifFalse:
> [obj ~= freeSpaceCheckOopToIgnore ifTrue:
> [0 to: (self numPointerSlotsOf: obj) - 1 do:
> [:fi|
> (self isForwarded: obj)
> ifTrue:
> [self assert: fi = 0. "I'm now trying to use forwarders in GC algorithms..."
> fieldOop := self fetchPointer: fi ofMaybeForwardedObject: obj]
> ifFalse: "We keep #fetchPointer:ofObject: API here for assertions"
> [fieldOop := self fetchPointer: fi ofObject: obj].
> (self isNonImmediate: fieldOop) ifTrue:
> [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) ~= 0 ifTrue:
> [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is free'; eekcr.
> + coInterpreter longPrintOop: obj.
> ok := false]]]]]].
> +
> + total - totalFreeOldSpace ~= 0 ifTrue:
> - total ~= totalFreeOldSpace ifTrue:
> [coInterpreter print: 'incorrect totalFreeOldSpace; expected '; printNum: totalFreeOldSpace; print: ' found '; printNum: total; eekcr.
> ok := false].
> ^ok!
>
> Item was changed:
> ----- Method: SpurMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') -----
> (excessive size, no diff calculated)
>
> Item was added:
> + ----- Method: SpurMemoryManager>>firstInstanceWithClassIndex: (in category 'debug printing') -----
> + firstInstanceWithClassIndex: classIndex
> + "Scan the heap printing the oops of any and all objects whose classIndex equals the argument."
> + <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h"
> + <inline: false>
> + self allHeapEntitiesDo:
> + [:obj|
> + (self classIndexOf: obj) = classIndex ifTrue:
> + [^ obj]]!
>
> Item was added:
> + ----- Method: SpurMemoryManager>>firstInstanceWithClassOop: (in category 'debug printing') -----
> + firstInstanceWithClassOop: classOop
> + "Scan the heap printing the oops of any and all objects whose classIndex equals the argument."
> + <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h"
> + <inline: false>
> + | classIndex |
> + classIndex := (self rawHashBitsOf: classOop).
> + self allHeapEntitiesDo:
> + [:obj|
> + (self classIndexOf: obj) = classIndex ifTrue:
> + [^ obj]]!
>
> Item was changed:
> ----- Method: SpurMemoryManager>>fullGC (in category 'gc - global') -----
> fullGC
> <doNotGenerate>
>
> + ^ gc fullGC!
> - gc fullGC!
>
> Item was changed:
> ----- Method: SpurMemoryManager>>objectsReachableFromRoots: (in category 'image segment in/out') -----
> objectsReachableFromRoots: arrayOfRoots
> "This is part of storeImageSegmentInto:outPointers:roots:.
> Answer an Array of all the objects only reachable from the argument, an Array of root objects,
> starting with arrayOfRoots. If there is no space, answer a SmallInteger whose value is the
> number of slots required. This is used to collect the objects to include in an image segment
> on Spur, separate from creating the segment, hence simplifying the implementation.
> Thanks to Igor Stasenko for this idea."
>
> | freeChunk ptr start limit count oop objOop |
> <var: #freeChunk type: #usqInt> "& hence start & ptr are too; limit is also because of addressAfter:"
> <inline: #never>
> self assert: (self isArray: arrayOfRoots).
> "Mark all objects except those only reachable from the arrayOfRoots by marking
> each object in arrayOfRoots and then marking all reachable objects (from the
> system roots). This leaves unmarked only objects reachable from the arrayOfRoots.
> N.B. A side-effect of the marking is that all forwarders in arrayOfRoots will be followed."
> self assert: self allObjectsUnmarked.
> self markObjectsIn: arrayOfRoots.
> marker markObjects: false.
>
> "After the mark phase all unreachable weak slots will have been nilled
> and all active ephemerons fired."
> self assert: (self isEmptyObjStack: markStack).
> self assert: (self isEmptyObjStack: weaklingStack).
> self assert: self noUnscannedEphemerons.
>
> "Now unmark the roots before collecting the transitive closure of unmarked objects accessible from the roots."
> self unmarkObjectsIn: arrayOfRoots.
>
> "Use the largest free chunk to answer the result."
> freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace"
> totalFreeOldSpace := totalFreeOldSpace - (self bytesInBody: freeChunk). "but must update so that growth in the markStack does not cause assert fails."
> ptr := start := freeChunk + self baseHeaderSize.
> limit := self addressAfter: freeChunk.
> count := 0.
>
> "First put the arrayOfRoots; order is important."
> self noCheckPush: arrayOfRoots onObjStack: markStack.
>
> "Now collect the roots and the transitive closure of unmarked objects from them."
> [self isEmptyObjStack: markStack] whileFalse:
> [objOop := self popObjStack: markStack.
> self assert: (self isMarked: objOop).
> count := count + 1.
> ptr < limit ifTrue:
> [self longAt: ptr put: objOop.
> ptr := ptr + self bytesPerOop].
> oop := self fetchClassOfNonImm: objOop.
> (self isMarked: oop) ifFalse:
> [self setIsMarkedOf: oop to: true.
> self noCheckPush: oop onObjStack: markStack].
> ((self isContextNonImm: objOop)
> and: [coInterpreter isStillMarriedContext: objOop]) "widow now, before the copy loop"
> ifTrue:
> [0 to: (coInterpreter numSlotsOfMarriedContext: objOop) - 1 do:
> [:i|
> oop := coInterpreter fetchPointer: i ofMarriedContext: objOop.
> ((self isImmediate: oop)
> or: [self isMarked: oop]) ifFalse:
> [self setIsMarkedOf: oop to: true.
> self noCheckPush: oop onObjStack: markStack]]]
> ifFalse:
> [0 to: (self numPointerSlotsOf: objOop) - 1 do:
> [:i|
> oop := self fetchPointer: i ofObject: objOop.
> ((self isImmediate: oop)
> or: [self isMarked: oop]) ifFalse:
> [self setIsMarkedOf: oop to: true.
> self noCheckPush: oop onObjStack: markStack]]]].
>
> self unmarkAllObjects.
>
> "Now try and allocate the result"
> (count > (ptr - start / self bytesPerOop) "not enough room"
> or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
> [self freeObject: freeChunk.
> self checkFreeSpace: GCCheckImageSegment.
> ^self integerObjectOf: count].
> "There's room; set the format, & classIndex and shorten."
> self setFormatOf: freeChunk to: self arrayFormat.
> self setClassIndexOf: freeChunk to: ClassArrayCompactIndex.
> + gc maybeModifyGCFlagsOf: freeChunk.
> - gc allocatorShouldAllocateBlack ifTrue: [self setIsMarkedOf: freeChunk to: true].
> self shorten: freeChunk toIndexableSize: count.
> (self isForwarded: freeChunk) ifTrue:
> [freeChunk := self followForwarded: freeChunk].
> self possibleRootStoreInto: freeChunk.
> self checkFreeSpace: GCCheckImageSegment.
> self runLeakCheckerFor: GCCheckImageSegment.
> ^freeChunk!
>
> Item was changed:
> ----- Method: StackInterpreter>>incrementalMarkAndTraceInterpreterOops (in category 'object memory support') -----
> incrementalMarkAndTraceInterpreterOops
> "Mark and trace all oops in the interpreter's state."
> "Assume: All traced variables contain valid oops.
> N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
> only during message lookup and because createActualMessageTo will not
> cause a GC these cannot change during message lookup."
> | oop |
> "Must mark stack pages first to initialize the per-page trace
> flags for full garbage collect before any subsequent tracing."
> self incrementalMarkAndTraceStackPages.
> self incrementalMarkAndTraceTraceLog.
> self incrementalMarkAndTracePrimTraceLog.
> + objectMemory marker markAndShouldScan: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
> - objectMemory marker pushOnMarkingStackAndMakeGreyIfNecessary: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
> (objectMemory isImmediate: newMethod) ifFalse:
> + [objectMemory marker markAndShouldScan: newMethod].
> - [objectMemory marker pushOnMarkingStackAndMakeGreyIfNecessary: newMethod].
> self incrementalTraceProfileState.
> + tempOop = 0 ifFalse: [objectMemory marker markAndShouldScan: tempOop].
> + tempOop2 = 0 ifFalse: [objectMemory marker markAndShouldScan: tempOop2].
> - tempOop = 0 ifFalse: [objectMemory marker pushOnMarkingStackAndMakeGreyIfNecessary: tempOop].
> - tempOop2 = 0 ifFalse: [objectMemory marker pushOnMarkingStackAndMakeGreyIfNecessary: tempOop2].
>
> "V3 memory manager support"
> 1 to: objectMemory remapBufferCount do:
> [:i |
> oop := objectMemory remapBuffer at: i.
> + (objectMemory isImmediate: oop) ifFalse: [objectMemory marker markAndShouldScan: oop]]!
> - (objectMemory isImmediate: oop) ifFalse: [objectMemory marker pushOnMarkingStackAndMakeGreyIfNecessary: oop]]!
>
> Item was changed:
> ----- Method: VMClass class>>openSpurMultiWindowBrowser (in category 'utilities') -----
> openSpurMultiWindowBrowser
> "Answer a new multi-window browser on the Spur classes, the Cog StackInterpreter classes, and the support classes"
> "self openSpurMultiWindowBrowser"
> | b |
> b := Browser open.
> + #( SpurIncrementalGarbageCollector SpurMemoryManager Spur32BitMemoryManager Spur64BitMemoryManager
> - #( SpurIncrementalMarker SpurMemoryManager Spur32BitMemoryManager Spur64BitMemoryManager
> SpurGenerationScavenger SpurSegmentManager
> Spur32BitMMLESimulator SpurGenerationScavengerSimulator
> InterpreterPrimitives StackInterpreter StackInterpreterPrimitives
> VMStructType VMMaker CCodeGenerator TMethod)
> do: [:className|
> (Smalltalk classNamed: className) ifNotNil:
> [:class| b selectCategoryForClass: class; selectClass: class]]
> separatedBy:
> [b multiWindowState addNewWindow].
> b multiWindowState selectWindowIndex: 1!
>
>
More information about the Vm-dev
mailing list