Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2126.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2126
Author: eem
Time: 9 February 2017, 10:05:18.350707 am
UUID: b4988a08-e56d-4b09-935e-631c2ae081cd
Ancestors: VMMaker.oscog-eem.2124, VMMaker.oscogSPC-eem.2126
Merge with VMMaker.oscogSPC-eem.2125 & VMMaker.oscogSPC-eem.2126
=============== Diff against VMMaker.oscog-eem.2124 ===============
Item was changed:
CogClass subclass: #Cogit
instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj enumeratingCogMethod methodHeader initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent primitiveIndex backEnd literalsManager postCompileHook methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry fullBlockEntry cbEntryOffset fullBlockNoContextSwitchEntry cbNoSwitchEntryOffset picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 firstCPICCaseOffset cPICCaseSize cP
ICEndSize closedPICSize openPICSize fixups abstractOpcodes generatorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceCallCogCodePopReceiverReg ceCallCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceEnclosingObjectTrampoline ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetFP ceGetSP ceCaptureCStackPointers ordinarySendTrampolines superSen
dTrampolines directedSuperSendTrampolines dynamicSuperSendTrampolines outerSendTrampolines selfSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner extA extB numExtB tempOop numIRCs indexOfIRC theIRCs implicitReceiverSendTrampolines cogMethodSurrogateClass cogBlockMethodSurrogateClass nsSendCacheSurrogateClass CStackPointer CFramePointer cPICPrototype cPICEndOfCodeOffset cPICEndOfCodeLabel maxCPICCases debugBytecodePointers debugOpcodeIndices disassemblingMethod ceMallocTrampoline ceFreeTrampoline ceFFICalloutTrampoline'
classVariableNames: 'AltBlockCreationBytecodeSize AltFirstSpecialSelector AltNSSendIsPCAnnotated AltNumSpecialSelectors AnnotationConstantNames AnnotationShift AnnotationsWithBytecodePCs BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration FirstAnnotation FirstSpecialSelector HasBytecodePC IsAbsPCReference IsAnnotationExtension IsDirectedSuperSend IsDisplacementX2N IsNSDynamicSuperSend IsNSImplicitReceiverSend IsNSSelfSend IsNSSendCall IsObjectReference IsRelativeCall IsSendCall IsSuperSend MapEnd MaxCPICCases MaxCompiledPrimitiveIndex MaxStackAllocSize MaxX2NDisplacement NSCClassTagIndex NSCEnclosingObjectIndex NSCNumArgsIndex NSCSelectorIndex NSCTargetIndex NSSendIsPCAnnotated NeedsFixupFlag NumObjRefsInRuntime NumOopsPerNSC NumSpecialSelectors NumTrampolines ProcessorClass RRRName'
poolDictionaries: 'CogAbstractRegisters CogCompilationConstants CogMethodConstants CogRTLOpcodes VMBasicConstants VMBytecodeConstants VMObjectIndices VMStackFrameOffsets'
category: 'VMMaker-JIT'!
Cogit class
instanceVariableNames: 'generatorTable primitiveTable'!
+ !Cogit commentStamp: 'eem 2/9/2017 10:01' prior: 0!
- !Cogit commentStamp: 'eem 4/6/2015 15:56' prior: 0!
I am the code generator for the Cog VM. My job is to produce machine code versions of methods for faster execution and to manage inline caches for faster send performance. I can be tested in the current image using my class-side in-image compilation facilities. e.g. try
StackToRegisterMappingCogit genAndDis: (Integer >> #benchFib)
I have concrete subclasses that implement different levels of optimization:
SimpleStackBasedCogit is the simplest code generator.
StackToRegisterMappingCogit is the current production code generator It defers pushing operands
to the stack until necessary and implements a register-based calling convention for low-arity sends.
StackToRegisterMappingCogit is an experimental code generator with support for counting
conditional branches, intended to support adaptive optimization.
coInterpreter <CoInterpreterSimulator>
the VM's interpreter with which I cooperate
methodZoneManager <CogMethodZoneManager>
the manager of the machine code zone
objectRepresentation <CogObjectRepresentation>
the object used to generate object accesses
processor <BochsIA32Alien|?>
the simulator that executes the IA32/x86 machine code I generate when simulating execution in Smalltalk
simulatedTrampolines <Dictionary of Integer -> MessageSend>
the dictionary mapping trap jump addresses to run-time routines used to warp from simulated machine code in to the Smalltalk run-time.
simulatedVariableGetters <Dictionary of Integer -> MessageSend>
the dictionary mapping trap read addresses to variables in run-time objects used to allow simulated machine code to read variables in the Smalltalk run-time.
simulatedVariableSetters <Dictionary of Integer -> MessageSend>
the dictionary mapping trap write addresses to variables in run-time objects used to allow simulated machine code to write variables in the Smalltalk run-time.
printRegisters printInstructions clickConfirm <Boolean>
flags controlling debug printing and code simulation
breakPC <Integer>
machine code pc breakpoint
cFramePointer cStackPointer <Integer>
the variables representing the C stack & frame pointers, which must change on FFI callback and return
selectorOop <sqInt>
the oop of the methodObj being compiled
methodObj <sqInt>
the bytecode method being compiled
initialPC endPC <Integer>
the start and end pcs of the methodObj being compiled
methodOrBlockNumArgs <Integer>
argument count of current method or block being compiled
needsFrame <Boolean>
whether methodObj or block needs a frame to execute
primitiveIndex <Integer>
primitive index of current method being compiled
methodLabel <CogAbstractOpcode>
label for the method header
blockEntryLabel <CogAbstractOpcode>
label for the start of the block dispatch code
stackOverflowCall <CogAbstractOpcode>
label for the call of ceStackOverflow in the method prolog
sendMissCall <CogAbstractOpcode>
label for the call of ceSICMiss in the method prolog
entryOffset <Integer>
offset of method entry code from start (header) of method
entry <CogAbstractOpcode>
label for the first instruction of the method entry code
noCheckEntryOffset <Integer>
offset of the start of a method proper (after the method entry code) from start (header) of method
noCheckEntry <CogAbstractOpcode>
label for the first instruction of start of a method proper
fixups <Array of <AbstractOpcode Label | nil>>
+ the labels for forward jumps that will be fixed up when reaching the relevant bytecode. fixups has one element per byte in methodObj's bytecode; initialPC maps to fixups[0].
- the labels for forward jumps that will be fixed up when reaching the relevant bytecode. fixup shas one element per byte in methodObj's bytecode
abstractOpcodes <Array of <AbstractOpcode>>
the code generated when compiling methodObj
byte0 byte1 byte2 byte3 <Integer>
individual bytes of current bytecode being compiled in methodObj
bytecodePointer <Integer>
bytecode pc (same as Smalltalk) of the current bytecode being compiled
opcodeIndex <Integer>
the index of the next free entry in abstractOpcodes (this code is translated into C where OrderedCollection et al do not exist)
numAbstractOpcodes <Integer>
the number of elements in abstractOpcocdes
blockStarts <Array of <BlockStart>>
the starts of blocks in the current method
blockCount
the index into blockStarts as they are being noted, and hence eventually the total number of blocks in the current method
labelCounter <Integer>
a nicety for numbering labels not needed in the production system but probably not expensive enough to worry about
ceStackOverflowTrampoline <Integer>
ceSend0ArgsTrampoline <Integer>
ceSend1ArgsTrampoline <Integer>
ceSend2ArgsTrampoline <Integer>
ceSendNArgsTrampoline <Integer>
ceSendSuper0ArgsTrampoline <Integer>
ceSendSuper1ArgsTrampoline <Integer>
ceSendSuper2ArgsTrampoline <Integer>
ceSendSuperNArgsTrampoline <Integer>
ceSICMissTrampoline <Integer>
ceCPICMissTrampoline <Integer>
ceStoreCheckTrampoline <Integer>
ceReturnToInterpreterTrampoline <Integer>
ceBaseFrameReturnTrampoline <Integer>
ceSendMustBeBooleanTrampoline <Integer>
ceClosureCopyTrampoline <Integer>
the various trampolines (system-call-like jumps from machine code to the run-time).
See Cogit>>generateTrampolines for the mapping from trampoline to run-time
routine and then read the run-time routine for a funcitonal description.
ceEnterCogCodePopReceiverReg <Integer>
the enilopmart (jump from run-time to machine-code)
methodZoneBase <Integer>
!
Cogit class
instanceVariableNames: 'generatorTable primitiveTable'!
Item was changed:
----- Method: Cogit>>compileAbstractInstructionsFrom:through: (in category 'compile abstract instructions') -----
compileAbstractInstructionsFrom: start through: end
"Loop over bytecodes, dispatching to the generator for each bytecode, handling fixups in due course."
| nextOpcodeIndex descriptor fixup result nExts |
<var: #descriptor type: #'BytecodeDescriptor *'>
<var: #fixup type: #'BytecodeFixup *'>
bytecodePC := start.
nExts := result := 0.
descriptor := nil.
[self maybeHaltIfDebugPC.
descriptor := self loadBytesAndGetDescriptor.
nextOpcodeIndex := opcodeIndex.
result := self perform: descriptor generator.
self assertExtsAreConsumed: descriptor.
+ fixup := self fixupAt: bytecodePC.
- fixup := self fixupAt: bytecodePC - initialPC.
self patchFixupTargetIfNeeded: fixup nextOpcodeIndex: nextOpcodeIndex.
self maybeDumpLiterals: descriptor.
bytecodePC := self nextBytecodePCFor: descriptor exts: nExts.
result = 0 and: [bytecodePC <= end]]
whileTrue:
[nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
self checkEnoughOpcodes.
^result!
Item was changed:
----- Method: Cogit>>ensureFixupAt: (in category 'compile abstract instructions') -----
ensureFixupAt: targetPC
"Make sure there's a flagged fixup at the target pc in fixups.
Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction."
<returnTypeC: #'BytecodeFixup *'>
| fixup |
<var: #fixup type: #'BytecodeFixup *'>
+ fixup := self fixupAt: targetPC.
- fixup := self fixupAt: targetPC - initialPC.
fixup notAFixup ifTrue:
[fixup becomeFixup].
fixup recordBcpc: bytecodePC.
^fixup!
Item was changed:
----- Method: Cogit>>fixupAt: (in category 'compile abstract instructions') -----
+ fixupAt: fixupPC
+ <inline: true>
+ ^self fixupAtIndex: fixupPC - initialPC!
- fixupAt: index
- <cmacro: '(index) (&fixups[index])'>
- <returnTypeC: #'BytecodeFixup *'>
- ^self addressOf: (fixups at: index)!
Item was added:
+ ----- Method: Cogit>>fixupAtIndex: (in category 'compile abstract instructions') -----
+ fixupAtIndex: index
+ "The fixups Array maps to bytecode pcs such that initialPC maps to index 0.
+ fixupAt: does the conversion."
+ <cmacro: '(index) (&fixups[index])'>
+ <returnTypeC: #'BytecodeFixup *'>
+ ^self addressOf: (fixups at: index)!
Item was changed:
----- Method: Cogit>>generateInstructionsAt: (in category 'generate machine code') -----
generateInstructionsAt: eventualAbsoluteAddress
"Size pc-dependent instructions and assign eventual addresses to all instructions.
Answer the size of the code.
Compute forward branches based on virtual address (abstract code starts at 0),
assuming that any branches branched over are long.
Compute backward branches based on actual address.
Reuse the fixups array to record the pc-dependent instructions that need to have
their code generation postponed until after the others."
| absoluteAddress pcDependentIndex abstractInstruction fixup |
<var: #abstractInstruction type: #'AbstractInstruction *'>
<var: #fixup type: #'BytecodeFixup *'>
absoluteAddress := eventualAbsoluteAddress.
pcDependentIndex := 0.
0 to: opcodeIndex - 1 do:
[:i|
self maybeBreakGeneratingAt: absoluteAddress.
abstractInstruction := self abstractInstructionAt: i.
abstractInstruction isPCDependent
ifTrue:
[abstractInstruction sizePCDependentInstructionAt: absoluteAddress.
+ fixup := self fixupAtIndex: pcDependentIndex.
- fixup := self fixupAt: pcDependentIndex.
pcDependentIndex := pcDependentIndex + 1.
fixup instructionIndex: i.
absoluteAddress := absoluteAddress + abstractInstruction machineCodeSize]
ifFalse:
[absoluteAddress := abstractInstruction concretizeAt: absoluteAddress]].
0 to: pcDependentIndex - 1 do:
[:j|
+ fixup := self fixupAtIndex: j.
- fixup := self fixupAt: j.
abstractInstruction := self abstractInstructionAt: fixup instructionIndex.
self maybeBreakGeneratingAt: abstractInstruction address.
abstractInstruction concretizeAt: abstractInstruction address].
^absoluteAddress - eventualAbsoluteAddress!
Item was changed:
----- Method: Cogit>>initializeFixupAt: (in category 'compile abstract instructions') -----
+ initializeFixupAt: targetPC
+ "Make sure there's a flagged fixup at the targetPC in fixups.
- initializeFixupAt: targetIndex
- "Make sure there's a flagged fixup at the targetIndex (pc relative to first pc) in fixups.
Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction."
<returnTypeC: #'BytecodeFixup *'>
+ (self fixupAt: targetPC) becomeFixup!
- (self fixupAt: targetIndex) becomeFixup!
Item was changed:
----- Method: Cogit>>scanMethod (in category 'compile abstract instructions') -----
scanMethod
"Scan the method (and all embedded blocks) to determine
- what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
- if the method needs a frame or not
- what are the targets of any backward branches.
- how many blocks it creates
- if it contans an unknown bytecode
Answer the block count or on error a negative error code"
| latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta |
<var: #descriptor type: #'BytecodeDescriptor *'>
needsFrame := false.
NewspeakVM ifTrue:
[numIRCs := 0].
(primitiveIndex > 0
and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
[^0].
pc := latestContinuation := initialPC.
numBlocks := framelessStackDelta := nExts := extA := numExtB := extB := 0.
[pc <= endPC] whileTrue:
[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
descriptor := self generatorAt: byte0.
descriptor isExtension ifTrue:
[descriptor opcode = Nop ifTrue: "unknown bytecode tag; see Cogit class>>#generatorTableFrom:"
[^EncounteredUnknownBytecode].
self loadSubsequentBytesForDescriptor: descriptor at: pc.
self perform: descriptor generator].
(descriptor isReturn
and: [pc >= latestContinuation]) ifTrue:
[endPC := pc].
needsFrame ifFalse:
[(descriptor needsFrameFunction isNil
or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
ifTrue: [needsFrame := true]
ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
descriptor isBranch ifTrue:
[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
targetPC := pc + descriptor numBytes + distance.
(self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
+ ifTrue: [self initializeFixupAt: targetPC]
- ifTrue: [self initializeFixupAt: targetPC - initialPC]
ifFalse: [latestContinuation := latestContinuation max: targetPC]].
descriptor isBlockCreation ifTrue:
[numBlocks := numBlocks + 1.
distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
targetPC := pc + descriptor numBytes + distance.
latestContinuation := latestContinuation max: targetPC].
NewspeakVM ifTrue:
[descriptor hasIRC ifTrue:
[numIRCs := numIRCs + 1]].
pc := pc + descriptor numBytes.
descriptor isExtension
ifTrue: [nExts := nExts + 1]
ifFalse: [nExts := extA := numExtB := extB := 0]].
^numBlocks!
Item was changed:
----- Method: RegisterAllocatingCogit>>ensureFixupAt: (in category 'bytecode generator support') -----
ensureFixupAt: targetPC
"Make sure there's a flagged fixup at the target pc in fixups.
Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction.
Override to enerate stack merging code if required."
| fixup |
<var: #fixup type: #'BytecodeFixup *'>
+ fixup := self fixupAt: targetPC.
- fixup := self fixupAt: targetPC - initialPC.
fixup needsFixup
ifTrue:
[fixup mergeSimStack
ifNil: [self setMergeSimStackOf: fixup]
ifNotNil: [self mergeCurrentSimStackWith: fixup]]
ifFalse:
[self assert: fixup mergeSimStack isNil.
self moveVolatileSimStackEntriesToRegisters.
self setMergeSimStackOf: fixup].
^super ensureFixupAt: targetPC!
Item was changed:
----- Method: RegisterAllocatingCogit>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genForwardersInlinedIdenticalOrNotIf: orNot
| nextPC branchDescriptor unforwardRcvr argReg targetBytecodePC
unforwardArg rcvrReg postBranchPC label fixup |
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #label type: #'AbstractInstruction *'>
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
"If an operand is an annotable constant, it may be forwarded, so we need to store it into a
register so the forwarder check can jump back to the comparison after unforwarding the constant.
However, if one of the operand is an unnanotable constant, does not allocate a register for it
(machine code will use operations on constants) and does not generate forwarder checks."
unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
self
allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
rcvrNeedsReg: unforwardRcvr
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
"If not followed by a branch, resolve to true or false."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: unforwardArg not
rcvrIsConstant: unforwardRcvr not
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
label := self Label.
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"For now just deny we're in the situation we have yet to implement ;-)
+ self printSimStack; printSimStack: (self fixupAt: postBranchPC) mergeSimStack"
- self printSimStack; printSimStack: (self fixupAt: postBranchPC - initialPC) mergeSimStack"
self deny: (self mergeRequiredForJumpTo: targetBytecodePC).
self deny: (self mergeRequiredForJumpTo: postBranchPC).
"Further since there is a following conditional jump bytecode, define
non-merge fixups and leave the cond bytecode to set the mergeness."
+ (self fixupAt: nextPC) notAFixup
- (self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
self ensureFixupAt: targetBytecodePC.
self ensureFixupAt: postBranchPC]
ifFalse:
[self deny: deadCode]. "push dummy value below"
self assert: (unforwardArg or: [unforwardRcvr]).
orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
ifFalse: "branchDescriptor is branchFalse"
[ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
ifTrue:
[ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger ].
deadCode ifFalse:
[self ssPushConstant: objectMemory trueObject]. "dummy value"
"The forwarders checks need to jump back to the comparison (label) if a forwarder is found, else
jump forward either to the next forwarder check or to the postBranch or branch target (fixup)."
unforwardArg ifTrue:
[ unforwardRcvr
ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: label ]
ifFalse: [ objectRepresentation
genEnsureOopInRegNotForwarded: argReg
scratchReg: TempReg
ifForwarder: label
ifNotForwarder: fixup ] ].
unforwardRcvr ifTrue:
[ objectRepresentation
genEnsureOopInRegNotForwarded: rcvrReg
scratchReg: TempReg
ifForwarder: label
ifNotForwarder: fixup ].
"Not reached, execution flow have jumped to fixup"
^0!
Item was changed:
----- Method: RegisterAllocatingCogit>>genJumpBackTo: (in category 'bytecode generator support') -----
genJumpBackTo: targetBytecodePC
| nothingToFlush label |
<var: #label type: #'AbstractInstruction *'>
"If there's nothing to flush then the stack state at this point is the same as that after
the check for interrups and we can avoid generating the register reload code twice."
(nothingToFlush := simStackPtr < 0 or: [self ssTop spilled]) ifTrue:
[label := self Label].
+ self reconcileRegisterStateForBackwardJoin: (self fixupAt: targetBytecodePC).
- self reconcileRegisterStateForBackwardJoin: (self fixupAt: targetBytecodePC - initialPC).
self MoveAw: coInterpreter stackLimitAddress R: TempReg.
self CmpR: TempReg R: SPReg. "N.B. FLAGS := SPReg - TempReg"
+ self JumpAboveOrEqual: (self fixupAt: targetBytecodePC).
- self JumpAboveOrEqual: (self fixupAt: targetBytecodePC - initialPC).
self ssFlushTo: simStackPtr.
self CallRT: ceCheckForInterruptTrampoline.
self annotateBytecode: self Label.
nothingToFlush
ifTrue:
[self Jump: label]
ifFalse:
+ [self reconcileRegisterStateForBackwardJoin: (self fixupAt: targetBytecodePC).
+ self Jump: (self fixupAt: targetBytecodePC)].
- [self reconcileRegisterStateForBackwardJoin: (self fixupAt: targetBytecodePC - initialPC).
- self Jump: (self fixupAt: targetBytecodePC - initialPC)].
deadCode := true. "can't fall through"
^0!
Item was changed:
----- Method: RegisterAllocatingCogit>>genStorePop:TemporaryVariable: (in category 'bytecode generator support') -----
genStorePop: popBoolean TemporaryVariable: tempIndex
<inline: false>
| srcRegOrNone destReg |
self ssFlushUpThroughTemporaryVariable: tempIndex.
"To avoid a stall writing through destReg, remember srcReg before the potential ssPop: 1 in ssStorePop:toReg:"
srcRegOrNone := self ssTop registerOrNone.
"ssStorePop:toPreferredReg: will allocate a register, and indeed may allocate ReceiverResultReg
if, for example, the ssEntry to be popped is already in ReceiverResultReg (as the result of a send).
ReceiverResultReg is not a good choice for a temporary variable; it has other uses. So if the ssEntry
at top of stack has ReceiverResultReg as its live variable, try and allocate an alternative."
+ ((self ssTop type = SSConstant
+ or: [self ssTop registerMaskOrNone anyMask: self registerMaskUndesirableForTempVars])
- ((self ssTop registerMaskOrNone anyMask: self registerMaskUndesirableForTempVars)
and: [(destReg := self availableRegOrNoneNotConflictingWith: (self registerMaskUndesirableForTempVars bitOr: self liveRegisters)) ~= NoReg])
ifTrue: [self ssStorePop: popBoolean toReg: destReg]
ifFalse: [destReg := self ssStorePop: popBoolean toPreferredReg: TempReg].
self MoveR: (srcRegOrNone ~= NoReg ifTrue: [srcRegOrNone] ifFalse: [destReg])
Mw: (self frameOffsetOfTemporary: tempIndex)
r: FPReg.
destReg ~= TempReg ifTrue:
[(self simStackAt: tempIndex) liveRegister: destReg.
self copyLiveRegisterToCopiesOf: (self simStackAt: tempIndex)].
^0!
Item was changed:
----- Method: RegisterAllocatingCogit>>genVanillaInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genVanillaInlinedIdenticalOrNotIf: orNot
| nextPC postBranchPC targetBytecodePC branchDescriptor
rcvrReg argReg argIsConstant rcvrIsConstant |
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
argIsConstant := self ssTop type = SSConstant.
"They can't be both constants to use correct machine opcodes.
However annotable constants can't be resolved statically, hence we need to careful."
rcvrIsConstant := argIsConstant not and: [(self ssValue: 1) type = SSConstant].
self
allocateEqualsEqualsRegistersArgNeedsReg: argIsConstant not
rcvrNeedsReg: rcvrIsConstant not
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
"If not followed by a branch, resolve to true or false."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: argIsConstant
rcvrIsConstant: rcvrIsConstant
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
self genCmpArgIsConstant: argIsConstant rcvrIsConstant: rcvrIsConstant argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"For now just deny we're in the situation we have yet to implement ;-)"
self deny: (self mergeRequiredForJumpTo: targetBytecodePC).
self deny: (self mergeRequiredForJumpTo: postBranchPC).
"Further since there is a following conditional jump bytecode, define
non-merge fixups and leave the cond bytecode to set the mergeness."
+ (self fixupAt: nextPC) notAFixup
- (self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
self ensureFixupAt: targetBytecodePC.
self ensureFixupAt: postBranchPC]
ifFalse:
[self deny: deadCode]. "push dummy value below"
self genConditionalBranch: (orNot == branchDescriptor isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero])
operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
"If the branch is dead, then we can just fall through postBranchPC (only a nop in-between), else
we need to jump over the code of the branch"
deadCode ifFalse:
[self Jump: (self ensureNonMergeFixupAt: postBranchPC).
self ssPushConstant: objectMemory trueObject]. "dummy value"
^0!
Item was changed:
----- Method: RegisterAllocatingCogit>>mergeRequiredForJumpTo: (in category 'bytecode generator support') -----
mergeRequiredForJumpTo: targetPC
"While this is a multi-pass compiler, no intermediate control-flow graph is built from bytecode and
there is a monotonically increasing one-to-one relationship between bytecode pcs and machine
code pcs that map to one another. Therefore, when jumping forward, any required code to merge
the state of the current simStack with that at the target must be generated before the jump
(because at the target the simStack state will be whatever falls through). If only one forward jump
to the target exists then that jump can simply install its simStack as the required simStack at the
target and the merge code wil be generated just before the target as control falls through. But if
there are two or more forward jumps to the target, a situation that occurs given that the
StackToRegisterMappingCogit follows jump chains, then jumps other than the first must generate
merge code before jumping. This poses a problem for conditional branches. The merge code must
only be generated along the path that takes the jump Therefore this must *not* be generated:
... merge code ...
jump cond Ltarget
which incorrectly executes the merge code along both the taken and untaken paths. Instead
this must be generated so that the merge code is only executed if the branch is taken.
jump not cond Lcontinue
... merge code ...
jump Ltarget
Lcontinue:
Note that no merge code is required for code such as self at: (expr ifTrue: [1] ifFalse: [2])
17 <70> self
18 <71> pushConstant: true
19 <99> jumpFalse: 22
20 <76> pushConstant: 1
21 <90> jumpTo: 23
22 <77> pushConstant: 2
23 <C0> send: at:
provided that 1 and 2 are assigned to the same target register."
self flag: 'be lazy for now; this needs more work to ignore compatible sim stacks'.
+ ^(self fixupAt: targetPC) hasMergeSimStack!
- ^(self fixupAt: targetPC - initialPC) hasMergeSimStack!
Item was changed:
----- Method: SimpleStackBasedCogit>>genJumpBackTo: (in category 'bytecode generator support') -----
genJumpBackTo: targetBytecodePC
self MoveAw: coInterpreter stackLimitAddress R: TempReg.
self CmpR: TempReg R: SPReg. "N.B. FLAGS := SPReg - TempReg"
+ self JumpAboveOrEqual: (self fixupAt: targetBytecodePC).
- self JumpAboveOrEqual: (self fixupAt: targetBytecodePC - initialPC).
self CallRT: ceCheckForInterruptTrampoline.
self annotateBytecode: self Label.
+ self Jump: (self fixupAt: targetBytecodePC).
- self Jump: (self fixupAt: targetBytecodePC - initialPC).
^0!
Item was changed:
----- Method: SistaCogit>>genBinaryInlineComparison:opFalse:destReg: (in category 'inline primitive generators') -----
genBinaryInlineComparison: opTrue opFalse: opFalse destReg: destReg
"Inlined comparison. opTrue = jump for true and opFalse = jump for false"
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
| nextPC branchDescriptor targetBytecodePC postBranchPC |
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse])
ifTrue: "This is the path where the inlined comparison is followed immediately by a branch"
+ [ (self fixupAt: nextPC) notAFixup
- [ (self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
self ensureFixupAt: targetBytecodePC.
self ensureFixupAt: postBranchPC ]
ifFalse:
[self ssPushConstant: objectMemory trueObject]. "dummy value"
self genConditionalBranch: (branchDescriptor isBranchTrue ifTrue: [opTrue] ifFalse: [opFalse])
operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
"We can only elide the jump if the pc after nextPC is the same as postBranchPC.
Branch following means it may not be."
self nextDescriptorExtensionsAndNextPCInto:
[:iguana1 :iguana2 :iguana3 :followingPC| nextPC := followingPC].
(deadCode and: [nextPC = postBranchPC]) ifFalse:
[ self Jump: (self ensureNonMergeFixupAt: postBranchPC) ] ]
ifFalse: "This is the path where the inlined comparison is *not* followed immediately by a branch"
[| condJump jump |
condJump := self genConditionalBranch: opTrue operand: 0.
self genMoveFalseR: destReg.
jump := self Jump: 0.
condJump jmpTarget: (self genMoveTrueR: destReg).
jump jmpTarget: self Label].
^ 0!
Item was changed:
----- Method: SistaCogit>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genForwardersInlinedIdenticalOrNotIf: orNot
"Override to count inlined branches if followed by a conditional branch.
We borrow the following conditional branch's counter and when about to
inline the comparison we decrement the counter (without writing it back)
and if it trips simply abort the inlining, falling back to the normal send which
will then continue to the conditional branch which will trip and enter the abort."
| nextPC postBranchPC targetBytecodePC branchDescriptor counterReg fixup jumpEqual jumpNotEqual
counterAddress countTripped unforwardArg unforwardRcvr argReg rcvrReg regMask |
<var: #fixup type: #'BytecodeFixup *'>
<var: #countTripped type: #'AbstractInstruction *'>
<var: #label type: #'AbstractInstruction *'>
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #jumpEqual type: #'AbstractInstruction *'>
<var: #jumpNotEqual type: #'AbstractInstruction *'>
((coInterpreter isOptimizedMethod: methodObj) or: [needsFrame not]) ifTrue:
[^super genForwardersInlinedIdenticalOrNotIf: orNot].
regMask := 0.
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
"If an operand is an annotable constant, it may be forwarded, so we need to store it into a
register so the forwarder check can jump back to the comparison after unforwarding the constant.
However, if one of the operand is an unnanotable constant, does not allocate a register for it
(machine code will use operations on constants)."
rcvrReg:= argReg := NoReg.
self
allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
rcvrNeedsReg: unforwardRcvr
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
argReg ~= NoReg ifTrue: [ regMask := self registerMaskFor: argReg ].
rcvrReg ~= NoReg ifTrue: [ regMask := regMask bitOr: (self registerMaskFor: rcvrReg) ].
"Only interested in inlining if followed by a conditional branch."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: unforwardArg not
rcvrIsConstant: unforwardRcvr not
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
"If branching the stack must be flushed for the merge"
self ssFlushTo: simStackPtr - 2.
unforwardArg ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg ].
unforwardRcvr ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg ].
counterReg := self allocateRegNotConflictingWith: regMask.
self
genExecutionCountLogicInto: [ :cAddress :countTripBranch |
counterAddress := cAddress.
countTripped := countTripBranch ]
counterReg: counterReg.
self assert: (unforwardArg or: [ unforwardRcvr ]).
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
ifFalse:
[ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
ifTrue:
[ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger ].
self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
self Jump: fixup.
countTripped jmpTarget: self Label.
"inlined version of #== ignoring the branchDescriptor if the counter trips to have normal state for the optimizer"
self ssPop: -2.
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"This code necessarily directly falls through the jumpIf: code which pops the top of the stack into TempReg.
We therefore directly assign the result to TempReg to save one move instruction"
jumpEqual := orNot ifFalse: [self JumpZero: 0] ifTrue: [self JumpNonZero: 0].
self genMoveFalseR: TempReg.
jumpNotEqual := self Jump: 0.
jumpEqual jmpTarget: (self genMoveTrueR: TempReg).
jumpNotEqual jmpTarget: self Label.
self ssPushRegister: TempReg.
+ (self fixupAt: nextPC) notAFixup ifTrue: [ branchReachedOnlyForCounterTrip := true ].
- (self fixupAt: nextPC - initialPC) notAFixup ifTrue: [ branchReachedOnlyForCounterTrip := true ].
^ 0!
Item was changed:
----- Method: SistaCogitClone>>genBinaryInlineComparison:opFalse:destReg: (in category 'inline primitive generators') -----
genBinaryInlineComparison: opTrue opFalse: opFalse destReg: destReg
"Inlined comparison. opTrue = jump for true and opFalse = jump for false"
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
| nextPC branchDescriptor targetBytecodePC postBranchPC |
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse])
ifTrue: "This is the path where the inlined comparison is followed immediately by a branch"
+ [ (self fixupAt: nextPC) notAFixup
- [ (self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
self ensureFixupAt: targetBytecodePC.
self ensureFixupAt: postBranchPC ]
ifFalse:
[self ssPushConstant: objectMemory trueObject]. "dummy value"
self genConditionalBranch: (branchDescriptor isBranchTrue ifTrue: [opTrue] ifFalse: [opFalse])
operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
deadCode ifFalse: [ self Jump: (self ensureNonMergeFixupAt: postBranchPC) ] ]
ifFalse: "This is the path where the inlined comparison is *not* followed immediately by a branch"
[| condJump jump |
condJump := self genConditionalBranch: opTrue operand: 0.
self genMoveFalseR: destReg.
jump := self Jump: 0.
condJump jmpTarget: (self genMoveTrueR: destReg).
jump jmpTarget: self Label].
^ 0!
Item was changed:
----- Method: SistaRegisterAllocatingCogit>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genForwardersInlinedIdenticalOrNotIf: orNot
"Override to count inlined branches if followed by a conditional branch.
We borrow the following conditional branch's counter and when about to
inline the comparison we decrement the counter (without writing it back)
and if it trips simply abort the inlining, falling back to the normal send which
will then continue to the conditional branch which will trip and enter the abort."
| nextPC postBranchPC targetBytecodePC branchDescriptor counterReg fixup jumpEqual jumpNotEqual
counterAddress countTripped unforwardArg unforwardRcvr argReg rcvrReg regMask |
<var: #fixup type: #'BytecodeFixup *'>
<var: #countTripped type: #'AbstractInstruction *'>
<var: #label type: #'AbstractInstruction *'>
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #jumpEqual type: #'AbstractInstruction *'>
<var: #jumpNotEqual type: #'AbstractInstruction *'>
((coInterpreter isOptimizedMethod: methodObj) or: [needsFrame not]) ifTrue:
[^super genForwardersInlinedIdenticalOrNotIf: orNot].
regMask := 0.
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
"If an operand is an annotable constant, it may be forwarded, so we need to store it into a
register so the forwarder check can jump back to the comparison after unforwarding the constant.
However, if one of the operand is an unnanotable constant, does not allocate a register for it
(machine code will use operations on constants)."
rcvrReg:= argReg := NoReg.
self
allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
rcvrNeedsReg: unforwardRcvr
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
argReg ~= NoReg ifTrue: [ regMask := self registerMaskFor: argReg ].
rcvrReg ~= NoReg ifTrue: [ regMask := regMask bitOr: (self registerMaskFor: rcvrReg) ].
"Only interested in inlining if followed by a conditional branch."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: unforwardArg not
rcvrIsConstant: unforwardRcvr not
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
unforwardArg ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg ].
unforwardRcvr ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg ].
counterReg := self allocateRegNotConflictingWith: regMask.
self
genExecutionCountLogicInto: [ :cAddress :countTripBranch |
counterAddress := cAddress.
countTripped := countTripBranch ]
counterReg: counterReg.
self assert: (unforwardArg or: [ unforwardRcvr ]).
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
ifFalse:
[ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
ifTrue:
[ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger ].
self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
self Jump: fixup.
countTripped jmpTarget: self Label.
"inlined version of #== ignoring the branchDescriptor if the counter trips to have normal state for the optimizer"
self ssPop: -2.
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"This code necessarily directly falls through the jumpIf: code which pops the top of the stack into TempReg.
We therefore directly assign the result to TempReg to save one move instruction"
jumpEqual := orNot ifFalse: [self JumpZero: 0] ifTrue: [self JumpNonZero: 0].
self genMoveFalseR: TempReg.
jumpNotEqual := self Jump: 0.
jumpEqual jmpTarget: (self genMoveTrueR: TempReg).
jumpNotEqual jmpTarget: self Label.
self ssPushRegister: TempReg.
+ (self fixupAt: nextPC) notAFixup ifTrue: [ branchReachedOnlyForCounterTrip := true ].
- (self fixupAt: nextPC - initialPC) notAFixup ifTrue: [ branchReachedOnlyForCounterTrip := true ].
^ 0!
Item was changed:
----- Method: StackToRegisterMappingCogit>>compileAbstractInstructionsFrom:through: (in category 'compile abstract instructions') -----
compileAbstractInstructionsFrom: start through: end
"Loop over bytecodes, dispatching to the generator for each bytecode, handling fixups in due course."
| nextOpcodeIndex descriptor nExts fixup result |
<var: #descriptor type: #'BytecodeDescriptor *'>
<var: #fixup type: #'BytecodeFixup *'>
self traceSimStack.
bytecodePC := start.
nExts := result := 0.
descriptor := nil.
deadCode := false.
[self maybeHaltIfDebugPC.
+ fixup := self fixupAt: bytecodePC.
- fixup := self fixupAt: bytecodePC - initialPC.
self mergeWithFixupIfRequired: fixup.
self assertCorrectSimStackPtr.
descriptor := self loadBytesAndGetDescriptor.
nextOpcodeIndex := opcodeIndex.
result := deadCode
ifTrue: [self mapDeadDescriptorIfNeeded: descriptor]
ifFalse: [self perform: descriptor generator].
self assertExtsAreConsumed: descriptor.
self traceDescriptor: descriptor; traceSimStack.
self patchFixupTargetIfNeeded: fixup nextOpcodeIndex: nextOpcodeIndex.
self maybeDumpLiterals: descriptor.
bytecodePC := self nextBytecodePCFor: descriptor exts: nExts.
result = 0 and: [bytecodePC <= end]] whileTrue:
[nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
self checkEnoughOpcodes.
^result!
Item was changed:
----- Method: StackToRegisterMappingCogit>>ensureFixupAt: (in category 'compile abstract instructions') -----
ensureFixupAt: targetPC
"Make sure there's a flagged fixup at the target pc in fixups.
Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction."
<returnTypeC: #'BytecodeFixup *'>
| fixup |
<var: #fixup type: #'BytecodeFixup *'>
+ fixup := self fixupAt: targetPC.
- fixup := self fixupAt: targetPC - initialPC.
self traceFixup: fixup.
self cCode: '' inSmalltalk:
[self assert: simStackPtr = (self debugStackPointerFor: targetPC).
(fixup isMergeFixupOrIsFixedUp
and: [fixup isBackwardBranchFixup not]) ifTrue: "ignore backward branch targets"
[self assert: fixup simStackPtr = simStackPtr]].
fixup isNonMergeFixupOrNotAFixup
ifTrue: "convert a non-merge into a merge"
[fixup becomeMergeFixup.
fixup simStackPtr: simStackPtr.
LowcodeVM ifTrue: [
fixup simNativeStackPtr: simNativeStackPtr.
fixup simNativeStackSize: simNativeStackSize]]
ifFalse:
[fixup isBackwardBranchFixup
ifTrue: "this is the target of a backward branch and
so doesn't have a simStackPtr assigned yet."
[fixup simStackPtr: simStackPtr.
LowcodeVM ifTrue:
[fixup simNativeStackPtr: simNativeStackPtr.
fixup simNativeStackSize: simNativeStackSize]]
ifFalse:
[self assert: fixup simStackPtr = simStackPtr.
LowcodeVM ifTrue:
[self assert: fixup simNativeStackPtr = simNativeStackPtr.
self assert: fixup simNativeStackSize = simNativeStackSize]]].
fixup recordBcpc: bytecodePC.
^fixup!
Item was changed:
----- Method: StackToRegisterMappingCogit>>ensureNonMergeFixupAt: (in category 'compile abstract instructions') -----
ensureNonMergeFixupAt: targetPC
"Make sure there's a flagged fixup at the target pc in fixups.
Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction."
<returnTypeC: #'BytecodeFixup *'>
| fixup |
<var: #fixup type: #'BytecodeFixup *'>
+ fixup := self fixupAt: targetPC.
- fixup := self fixupAt: targetPC - initialPC.
fixup notAFixup ifTrue:
[fixup becomeNonMergeFixup].
self cCode: '' inSmalltalk:
[fixup isMergeFixupOrIsFixedUp ifTrue:
[self assert:
(fixup isBackwardBranchFixup
or: [fixup simStackPtr = (self debugStackPointerFor: targetPC)])]].
fixup recordBcpc: bytecodePC.
^fixup!
Item was changed:
----- Method: StackToRegisterMappingCogit>>eventualTargetOf: (in category 'peephole optimizations') -----
eventualTargetOf: targetBytecodePC
"Attempt to follow a branch to a pc. Handle branches to unconditional jumps
and branches to push: aBoolean; conditional branch pairs. If the branch cannot
be followed answer targetBytecodePC."
| currentTarget nextPC nExts descriptor span cond |
<var: #descriptor type: #'BytecodeDescriptor *'>
nextPC := currentTarget := targetBytecodePC.
[ nExts := 0.
[descriptor := self generatorAt: bytecodeSetOffset
+ (objectMemory fetchByte: nextPC ofObject: methodObj).
descriptor isReturn ifTrue: [^currentTarget]. "avoid stepping off the end of methods"
descriptor isExtension]
whileTrue:
[nExts := nExts + 1.
nextPC := nextPC + descriptor numBytes].
descriptor isUnconditionalBranch
ifTrue:
[span := self spanFor: descriptor at: nextPC exts: nExts in: methodObj.
span < 0 ifTrue: "Do *not* follow backward branches; these are interrupt points and should not be elided."
[^currentTarget].
nextPC := nextPC + descriptor numBytes + span]
ifFalse:
[descriptor generator == #genPushConstantTrueBytecode ifTrue: [ cond := true ]
+ ifFalse: [ descriptor generator == #genPushConstantFalseBytecode ifTrue: [ cond := false ]
+ ifFalse: [ ^currentTarget ] ].
- ifFalse: [ descriptor generator == #genPushConstantFalseBytecode ifTrue: [ cond := false ] ifFalse: [ ^currentTarget ] ].
"Don't step into loops across a pushTrue; jump:if: boundary, so as not to confuse stack depth fixup."
+ (self fixupAt: nextPC) isBackwardBranchFixup ifTrue:
- (fixups at: nextPC - initialPC) isBackwardBranchFixup ifTrue:
[^currentTarget].
nextPC := self eventualTargetOf: nextPC + descriptor numBytes.
nExts := 0.
[descriptor := self generatorAt: bytecodeSetOffset
+ (objectMemory fetchByte: nextPC ofObject: methodObj).
descriptor isReturn ifTrue: [^currentTarget]. "avoid stepping off the end of methods"
descriptor isExtension]
whileTrue:
[nExts := nExts + 1.
nextPC := nextPC + descriptor numBytes].
descriptor isBranch ifFalse:
[^currentTarget].
descriptor isUnconditionalBranch ifTrue:
[^currentTarget].
nextPC := cond == descriptor isBranchTrue
ifTrue: [nextPC
+ descriptor numBytes
+ (self spanFor: descriptor at: nextPC exts: nExts in: methodObj)]
ifFalse: [nextPC + descriptor numBytes]].
currentTarget := nextPC]
repeat!
Item was removed:
- ----- Method: StackToRegisterMappingCogit>>fixupAt: (in category 'compile abstract instructions') -----
- fixupAt: index
- <cmacro: '(index) (&fixups[index])'>
- <returnTypeC: #'BytecodeFixup *'>
- ((debugFixupBreaks includes: index)
- and: [breakMethod isNil or: [methodObj = breakMethod]]) ifTrue:
- [self halt].
- ^self addressOf: (fixups at: index)!
Item was added:
+ ----- Method: StackToRegisterMappingCogit>>fixupAtIndex: (in category 'compile abstract instructions') -----
+ fixupAtIndex: index
+ "The fixups Array maps to bytecode pcs such that initialPC maps to index 0.
+ fixupAt: does the conversion. Override to add breakpointing for fixups of bytecode PCs."
+ <cmacro: '(index) (&fixups[index])'>
+ <returnTypeC: #'BytecodeFixup *'>
+ ((debugFixupBreaks includes: index + initialPC)
+ and: [breakMethod isNil or: [methodObj = breakMethod]]) ifTrue:
+ [self halt].
+ ^self addressOf: (fixups at: index)!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genForwardersInlinedIdenticalOrNotIf: orNot
| nextPC branchDescriptor unforwardRcvr argReg targetBytecodePC
unforwardArg rcvrReg postBranchPC label fixup |
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #label type: #'AbstractInstruction *'>
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
"If an operand is an annotable constant, it may be forwarded, so we need to store it into a
register so the forwarder check can jump back to the comparison after unforwarding the constant.
However, if one of the operand is an unnanotable constant, does not allocate a register for it
(machine code will use operations on constants) and does not generate forwarder checks."
unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
self
allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
rcvrNeedsReg: unforwardRcvr
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
"If not followed by a branch, resolve to true or false."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: unforwardArg not
rcvrIsConstant: unforwardRcvr not
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
"If branching the stack must be flushed for the merge"
self ssFlushTo: simStackPtr - 2.
label := self Label.
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"Further since there is a following conditional jump bytecode, define
non-merge fixups and leave the cond bytecode to set the mergeness."
+ (self fixupAt: nextPC) notAFixup
- (self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
self ensureFixupAt: targetBytecodePC.
self ensureFixupAt: postBranchPC]
ifFalse:
[self deny: deadCode]. "push dummy value below"
self assert: (unforwardArg or: [unforwardRcvr]).
orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
ifFalse:
[ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
ifTrue:
[ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger ].
deadCode ifFalse:
[self ssPushConstant: objectMemory trueObject]. "dummy value"
"The forwarders checks need to jump back to the comparison (label) if a forwarder is found, else
jump forward either to the next forwarder check or to the postBranch or branch target (fixup)."
unforwardArg ifTrue:
[ unforwardRcvr
ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: label ]
ifFalse: [ objectRepresentation
genEnsureOopInRegNotForwarded: argReg
scratchReg: TempReg
ifForwarder: label
ifNotForwarder: fixup ] ].
unforwardRcvr ifTrue:
[ objectRepresentation
genEnsureOopInRegNotForwarded: rcvrReg
scratchReg: TempReg
ifForwarder: label
ifNotForwarder: fixup ].
"Not reached, execution flow have jumped to fixup"
^0!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genVanillaInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genVanillaInlinedIdenticalOrNotIf: orNot
| nextPC postBranchPC targetBytecodePC branchDescriptor
rcvrReg argReg argIsConstant rcvrIsConstant |
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
argIsConstant := self ssTop type = SSConstant.
"They can't be both constants to use correct machine opcodes.
However annotable constants can't be resolved statically, hence we need to careful."
rcvrIsConstant := argIsConstant not and: [(self ssValue: 1) type = SSConstant].
self
allocateEqualsEqualsRegistersArgNeedsReg: argIsConstant not
rcvrNeedsReg: rcvrIsConstant not
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
"If not followed by a branch, resolve to true or false."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: argIsConstant
rcvrIsConstant: rcvrIsConstant
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
"If branching the stack must be flushed for the merge"
self ssFlushTo: simStackPtr - 2.
self genCmpArgIsConstant: argIsConstant rcvrIsConstant: rcvrIsConstant argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"Further since there is a following conditional jump bytecode, define
non-merge fixups and leave the cond bytecode to set the mergeness."
+ (self fixupAt: nextPC) notAFixup
- (self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
self ensureFixupAt: targetBytecodePC.
self ensureFixupAt: postBranchPC]
ifFalse:
[self deny: deadCode]. "push dummy value below"
self genConditionalBranch: (orNot == branchDescriptor isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero])
operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
"If the branch is dead, then we can just fall through postBranchPC (only a nop in-between), else
we need to jump over the code of the branch"
deadCode ifFalse:
[self Jump: (self ensureNonMergeFixupAt: postBranchPC).
self ssPushConstant: objectMemory trueObject]. "dummy value"
^0!
Item was changed:
----- Method: StackToRegisterMappingCogit>>generateInstructionsAt: (in category 'generate machine code') -----
generateInstructionsAt: eventualAbsoluteAddress
"Size pc-dependent instructions and assign eventual addresses to all instructions.
Answer the size of the code.
Compute forward branches based on virtual address (abstract code starts at 0),
assuming that any branches branched over are long.
Compute backward branches based on actual address.
Reuse the fixups array to record the pc-dependent instructions that need to have
their code generation postponed until after the others.
Override to andd handling for null branches (branches to the immediately following
instruction) occasioned by StackToRegisterMapping's following of jumps."
| absoluteAddress pcDependentIndex abstractInstruction fixup |
<var: #abstractInstruction type: #'AbstractInstruction *'>
<var: #fixup type: #'BytecodeFixup *'>
absoluteAddress := eventualAbsoluteAddress.
pcDependentIndex := 0.
0 to: opcodeIndex - 1 do:
[:i|
self maybeBreakGeneratingAt: absoluteAddress.
abstractInstruction := self abstractInstructionAt: i.
abstractInstruction isPCDependent
ifTrue:
[abstractInstruction sizePCDependentInstructionAt: absoluteAddress.
(abstractInstruction isJump
and: [i + 1 < opcodeIndex
and: [abstractInstruction getJmpTarget == (self abstractInstructionAt: i + 1)]])
ifTrue:
[abstractInstruction
opcode: Nop;
concretizeAt: absoluteAddress]
ifFalse:
+ [fixup := self fixupAtIndex: pcDependentIndex.
- [fixup := self fixupAt: pcDependentIndex.
pcDependentIndex := pcDependentIndex + 1.
fixup instructionIndex: i].
absoluteAddress := absoluteAddress + abstractInstruction machineCodeSize]
ifFalse:
[absoluteAddress := abstractInstruction concretizeAt: absoluteAddress]].
0 to: pcDependentIndex - 1 do:
[:j|
+ fixup := self fixupAtIndex: j.
- fixup := self fixupAt: j.
abstractInstruction := self abstractInstructionAt: fixup instructionIndex.
self maybeBreakGeneratingAt: abstractInstruction address.
abstractInstruction concretizeAt: abstractInstruction address].
^absoluteAddress - eventualAbsoluteAddress!
Item was changed:
----- Method: StackToRegisterMappingCogit>>initializeFixupAt: (in category 'compile abstract instructions') -----
+ initializeFixupAt: targetPC
+ "Make sure there's a flagged fixup at the targetPC in fixups.
- initializeFixupAt: targetIndex
- "Make sure there's a flagged fixup at the targetIndex (pc relative to first pc) in fixups.
These are the targets of backward branches. A backward branch fixup's simStackPtr
+ needs to be set when generating the code for the bytecode at the targetPC.
- needs to be set when generating the code for the bytecode at the targetIndex.
Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction."
<returnTypeC: #'BytecodeFixup *'>
| fixup |
<var: #fixup type: #'BytecodeFixup *'>
+ fixup := self fixupAt: targetPC.
- fixup := self fixupAt: targetIndex.
fixup
becomeMergeFixup;
setIsBackwardBranchFixup.
^fixup!
Item was changed:
----- Method: StackToRegisterMappingCogit>>reinitializeFixupsFrom:through: (in category 'compile abstract instructions') -----
reinitializeFixupsFrom: start through: end
"When a block must be recompiled due to overestimating the
numInitialNils fixups must be restored, which means rescannning
since backward branches need their targets initialized."
| descriptor nExts pc distance targetPC |
<var: #descriptor type: #'BytecodeDescriptor *'>
pc := start.
nExts := 0.
[pc <= end] whileTrue:
+ [(self fixupAt: pc) reinitialize.
- [(self fixupAt: pc - initialPC) reinitialize.
byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
descriptor := self generatorAt: byte0.
(descriptor isBranch
and: [self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj]) ifTrue:
[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
targetPC := pc + descriptor numBytes + distance.
+ self initializeFixupAt: targetPC].
- self initializeFixupAt: targetPC - initialPC].
descriptor isBlockCreation
ifTrue:
[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
pc := pc + descriptor numBytes + distance]
ifFalse: [pc := pc + descriptor numBytes].
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]!
Item was changed:
----- Method: StackToRegisterMappingCogit>>scanMethod (in category 'compile abstract instructions') -----
scanMethod
"Scan the method (and all embedded blocks) to determine
- what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
- if the method needs a frame or not
- what are the targets of any backward branches.
- how many blocks it creates
Answer the block count or on error a negative error code"
| latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta seenInstVarStore |
<var: #descriptor type: #'BytecodeDescriptor *'>
needsFrame := useTwoPaths := seenInstVarStore := false.
LowcodeVM ifTrue: [ hasNativeFrame := false ].
self maybeInitNumFixups.
self maybeInitNumCounters.
prevBCDescriptor := nil.
NewspeakVM ifTrue:
[numIRCs := 0].
(primitiveIndex > 0
and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
[^0].
pc := latestContinuation := initialPC.
numBlocks := framelessStackDelta := nExts := extA := numExtB := extB := 0.
[pc <= endPC] whileTrue:
[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
descriptor := self generatorAt: byte0.
descriptor isExtension ifTrue:
[descriptor opcode = Nop ifTrue: "unknown bytecode tag; see Cogit class>>#generatorTableFrom:"
[^EncounteredUnknownBytecode].
self loadSubsequentBytesForDescriptor: descriptor at: pc.
self perform: descriptor generator].
(descriptor isReturn
and: [pc >= latestContinuation]) ifTrue:
[endPC := pc].
needsFrame ifFalse:
[(descriptor needsFrameFunction isNil
or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
ifTrue:
["With immutability we win simply by avoiding a frame build if the receiver is young and not immutable."
self cppIf: IMMUTABILITY
ifTrue: [descriptor is1ByteInstVarStore
ifTrue: [useTwoPaths := true]
ifFalse: [needsFrame := true. useTwoPaths := false]]
ifFalse: [needsFrame := true. useTwoPaths := false]]
ifFalse:
[framelessStackDelta := framelessStackDelta + descriptor stackDelta.
"Without immutability we win if there are two or more stores and the receiver is new."
self cppIf: IMMUTABILITY
ifTrue: []
ifFalse:
[descriptor is1ByteInstVarStore ifTrue:
[seenInstVarStore
ifTrue: [useTwoPaths := true]
ifFalse: [seenInstVarStore := true]]]]].
descriptor isBranch ifTrue:
[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
targetPC := pc + descriptor numBytes + distance.
self maybeCountFixup: descriptor.
(self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
+ ifTrue: [self initializeFixupAt: targetPC]
- ifTrue: [self initializeFixupAt: targetPC - initialPC]
ifFalse:
[latestContinuation := latestContinuation max: targetPC.
self maybeCountCounter]].
descriptor isBlockCreation ifTrue:
[numBlocks := numBlocks + 1.
distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
targetPC := pc + descriptor numBytes + distance.
latestContinuation := latestContinuation max: targetPC.
self maybeCountFixup: descriptor].
NewspeakVM ifTrue:
[descriptor hasIRC ifTrue: [numIRCs := numIRCs + 1]].
pc := pc + descriptor numBytes.
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [extA := numExtB := extB := 0].
prevBCDescriptor := descriptor].
^numBlocks!
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2124.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2124
Author: eem
Time: 8 February 2017, 5:36:03.25071 pm
UUID: 194b7409-a53c-4d94-9488-7c573d6d418e
Ancestors: VMMaker.oscog-cb.2117, VMMaker.oscogSPC-eem.2124
Merge with VMMaker.oscogSPC-eem.2124
=============== Diff against VMMaker.oscog-cb.2117 ===============
Item was changed:
----- Method: CCodeGenerator>>localizeGlobalVariables (in category 'utilities') -----
localizeGlobalVariables
| candidates elected localized |
"find all globals used in only one method"
candidates := globalVariableUsage select: [:e | e size = 1].
+ "Don't localize globals; nor those that are only assigned to; they're for debugging..."
+ (candidates keys select: [:k| (vmClass mustBeGlobal: k)
+ or: [(self methodNamed: (globalVariableUsage at: k) anyOne)
+ ifNil: [false]
+ ifNotNil: [:m| (m readsVariable: k) not]]]) do:
- (candidates keys select: [:k| vmClass mustBeGlobal: k]) do:
[:k| candidates removeKey: k].
+
elected := Set new.
localized := Dictionary new. "for an ordered report"
"move any suitable global to be local to the single method using it"
candidates keysAndValuesDo:
[:key :targets |
targets do:
[:name |
(methods at: name ifAbsent: []) ifNotNil:
[:procedure | | newDeclaration |
(procedure isRealMethod
and: [self shouldGenerateMethod: procedure]) ifTrue:
[(localized at: name ifAbsentPut: [SortedCollection new]) add: key.
elected add: (procedure locals add: key).
newDeclaration := variableDeclarations at: key ifAbsent: ['sqInt ', key].
(self initializerForInstVar: key inStartClass: procedure definingClass) ifNotNil:
[:initializerNode|
newDeclaration := String streamContents:
[:s|
s nextPutAll: newDeclaration; nextPutAll: ' = '.
initializerNode emitCCodeOn: s level: 0 generator: self]].
procedure declarationAt: key put: newDeclaration.
variableDeclarations removeKey: key ifAbsent: []]]]].
logger ifNotNil:
[localized keys asSortedCollection do:
[:name|
(localized at: name) do:
[:var|
logger ensureCr; show: var, ' localised to ', name; cr]]].
elected do: [:ea| (variables includes: ea) ifTrue: [self checkDeleteVariable: ea]].
variables removeAllFoundIn: elected!
Item was changed:
----- Method: CogObjectRepresentationForSpur>>branchIf:isNotOop:target: (in category 'sista support') -----
+ branchIf: reg isNotOop: oop target: targetFixUp
- branchIf: reg isNotOop: oop target: targetFixup
<var: #targetFixUp type: #'AbstractInstruction *'>
<inline: true>
cogit CmpCq: oop R: reg.
+ cogit JumpNonZero: targetFixUp.
+ ^0!
- cogit JumpNonZero: targetFixup.
- ^ 0!
Item was changed:
----- Method: CogObjectRepresentationForSpur>>branchIf:isOop:target: (in category 'sista support') -----
+ branchIf: reg isOop: oop target: targetFixUp
- branchIf: reg isOop: oop target: targetFixup
<var: #targetFixUp type: #'AbstractInstruction *'>
<inline: true>
cogit CmpCq: oop R: reg.
+ cogit JumpZero: targetFixUp.
+ ^0!
- cogit JumpZero: targetFixup.
- ^ 0!
Item was changed:
----- Method: CogVMSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
primitiveDirectoryEntry
| name pathName arrayNilOrSymbol result |
name := self stringOf: self stackTop.
pathName := self stringOf: (self stackValue: 1).
"temporary work-around to make it work in Pharo..."
self cppIf: PharoVM ifTrue: [ pathName := Smalltalk imagePath ].
self successful ifFalse:
[^self primitiveFail].
arrayNilOrSymbol := FileDirectory default primLookupEntryIn: pathName name: name.
arrayNilOrSymbol ifNil:
[self pop: 3 thenPush: objectMemory nilObject.
^self].
arrayNilOrSymbol isArray ifFalse:
["arrayNilOrSymbol ~~ #primFailed ifTrue:
[self halt]. "
+ self transcript show: name, ' NOT FOUND'.
- Transcript show: name, ' NOT FOUND'.
^self primitiveFail].
result := PharoVM
ifTrue:
[self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size
createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3)
isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5)
posixPermissions: (arrayNilOrSymbol at: 6) isSymlink: (arrayNilOrSymbol at: 7) ]
ifFalse:
[self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size
createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3)
isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5) ].
self pop: 3 thenPush: result!
Item was changed:
----- Method: Cogit>>checkIfValidOopRefAndTarget:pc:cogMethod: (in category 'garbage collection') -----
checkIfValidOopRefAndTarget: annotation pc: mcpc cogMethod: cogMethod
"Check for a valid object reference, if any, at a map entry. Answer a code unique to each error for debugging."
<var: #mcpc type: #'char *'>
<var: #nsSendCache type: #'NSSendCache *'>
| literal entryPoint |
annotation = IsObjectReference ifTrue:
[literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
(self asserta: (objectRepresentation checkValidOopReference: literal)) ifFalse:
[^1].
((objectRepresentation couldBeObject: literal)
and: [objectMemory isReallyYoungObject: literal]) ifTrue:
[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
[^2]]].
NewspeakVM ifTrue:
[annotation = IsNSSendCall ifTrue:
[| nsSendCache classTag enclosingObject nsTargetMethod |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
(self asserta: (objectRepresentation checkValidOopReference: nsSendCache selector)) ifFalse:
[^9].
classTag := nsSendCache classTag.
(self asserta: (classTag = 0 or: [objectRepresentation validInlineCacheTag: classTag])) ifFalse:
[^10].
enclosingObject := nsSendCache enclosingObject.
(self asserta: (enclosingObject = 0 or: [objectRepresentation checkValidOopReference: enclosingObject])) ifFalse:
[^11].
entryPoint := nsSendCache target.
entryPoint ~= 0 ifTrue: [
nsTargetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
(self asserta: (nsTargetMethod cmType = CMMethod)) ifFalse:
[^12]]]].
(self isPureSendAnnotation: annotation) ifTrue:
[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmType = CMMethod) ifFalse:
[^3].
+ self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
+ [:entryPt :cacheTag :tagCouldBeObject|
+ entryPoint := entryPt.
- self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
- [:offset :cacheTag :tagCouldBeObject|
tagCouldBeObject
ifTrue:
[(objectRepresentation couldBeObject: cacheTag)
ifTrue:
[(self asserta: (objectRepresentation checkValidOopReference: cacheTag)) ifFalse:
[^4]]
ifFalse:
[(self asserta: (objectRepresentation validInlineCacheTag: cacheTag)) ifFalse:
[^5]].
((objectRepresentation couldBeObject: cacheTag)
and: [objectMemory isReallyYoungObject: cacheTag]) ifTrue:
[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
[^6]]]
ifFalse:
+ [(self inlineCacheTagsAreIndexes
+ and: [self self entryPointTagIsSelector: entryPoint])
+ ifTrue:
+ [cacheTag signedIntFromLong < 0
+ ifTrue:
+ [cacheTag signedIntFromLong negated > NumSpecialSelectors ifTrue:
+ [^7]]
+ ifFalse:
+ [cacheTag >= (objectMemory literalCountOf: enumeratingCogMethod methodObject) ifTrue:
+ [^8]]]
+ ifFalse:
+ [(self asserta: (objectRepresentation validInlineCacheTag: cacheTag)) ifFalse:
+ [^9]]]].
- [(self asserta: (objectRepresentation validInlineCacheTag: cacheTag)) ifFalse:
- [^7]]].
- entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint > methodZoneBase ifTrue:
["It's a linked send; find which kind."
self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
[:targetMethod :sendTable|
(self asserta: (targetMethod cmType = CMMethod
or: [targetMethod cmType = CMClosedPIC
or: [targetMethod cmType = CMOpenPIC]])) ifFalse:
+ [^10]]]].
- [^8]]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>ensureFixupAt: (in category 'compile abstract instructions') -----
+ ensureFixupAt: targetPC
+ "Make sure there's a flagged fixup at the target pc in fixups.
- ensureFixupAt: targetIndex
- "Make sure there's a flagged fixup at the targetIndex (pc relative to first pc) in fixups.
Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction."
<returnTypeC: #'BytecodeFixup *'>
| fixup |
<var: #fixup type: #'BytecodeFixup *'>
+ fixup := self fixupAt: targetPC - initialPC.
- fixup := self fixupAt: targetIndex.
fixup notAFixup ifTrue:
[fixup becomeFixup].
fixup recordBcpc: bytecodePC.
^fixup!
Item was added:
+ ----- Method: Cogit>>entryCacheTagAndCouldBeObjectAt:annotation:into: (in category 'in-line cacheing') -----
+ entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into: trinaryBlock
+ "Evaluate trinaryBlock with the entryPoint, inline cache tag and whether the cache
+ tag could be an object, for the send at mcpc with annotation annotation."
+ <inline: true>
+ | cacheTag entryPoint tagCouldBeObj |
+ cacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
+ entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
+ "in-line cache tags are the selectors of sends if sends are unlinked,
+ the selectors of super sends (entry offset = cmNoCheckEntryOffset),
+ the selectors of open PIC sends (entry offset = cmEntryOffset, target is an Open PIC)
+ or in-line cache tags (classes, class indices, immediate bit patterns, etc).
+ Note that selectors can be immediate so there is no guarantee that they
+ are markable/remappable objects."
+ tagCouldBeObj := self inlineCacheTagsAreIndexes not
+ and: [objectRepresentation inlineCacheTagsMayBeObjects
+ or: [self entryPointTagIsSelector: entryPoint]].
+ trinaryBlock
+ value: entryPoint
+ value: cacheTag
+ value: tagCouldBeObj!
Item was added:
+ ----- Method: Cogit>>entryPointTagIsSelector: (in category 'in-line cacheing') -----
+ entryPointTagIsSelector: entryPoint
+ "Answer if the entryPoint's tag is expected to be a selector reference, as opposed to a class tag."
+ ^entryPoint < methodZoneBase
+ or: [(entryPoint bitAnd: entryPointMask) = uncheckedEntryAlignment
+ or: [(entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
+ and: [(self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *') cmType = CMOpenPIC]]]!
Item was changed:
----- Method: Cogit>>markLiterals:pc:method: (in category 'garbage collection') -----
markLiterals: annotation pc: mcpc method: cogMethod
"Mark and trace literals.
Additionally in Newspeak, void push implicits that have unmarked classes."
<var: #mcpc type: #'char *'>
<var: #nsSendCache type: #'NSSendCache *'>
| literal |
annotation = IsObjectReference ifTrue:
[literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
(objectRepresentation
markAndTraceLiteral: literal
in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
atpc: mcpc asUnsignedInteger) ifTrue:
[codeModified := true]].
NewspeakVM ifTrue:
[annotation = IsNSSendCall ifTrue:
[| nsSendCache sel eo |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
sel := nsSendCache selector.
(objectMemory isForwarded: sel)
ifFalse: [objectMemory markAndTrace: sel]
ifTrue: [sel := objectMemory followForwarded: literal.
nsSendCache selector: sel.
self markAndTraceUpdatedLiteral: sel in: (self cCoerceSimple: cogMethod to: #'CogMethod *')].
eo := nsSendCache enclosingObject.
eo ~= 0 ifTrue:
[(objectMemory isForwarded: eo)
ifFalse: [objectMemory markAndTrace: eo]
ifTrue: [eo := objectMemory followForwarded: literal.
nsSendCache enclosingObject: eo.
self markAndTraceUpdatedLiteral: eo in: (self cCoerceSimple: cogMethod to: #'CogMethod *')]]]].
(self isPureSendAnnotation: annotation) ifTrue:
+ [self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
- [self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
[:entryPoint :cacheTag :tagCouldBeObj |
tagCouldBeObj ifTrue:
[(objectRepresentation
markAndTraceCacheTagLiteral: cacheTag
in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
atpc: mcpc asUnsignedInteger) ifTrue:
["cacheTag is selector" codeModified := true]]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>markLiteralsAndUnlinkIfUnmarkedSend:pc:method: (in category 'garbage collection') -----
markLiteralsAndUnlinkIfUnmarkedSend: annotation pc: mcpc method: cogMethod
"Mark and trace literals. Unlink sends that have unmarked cache tags or targets."
<var: #mcpc type: #'char *'>
<var: #nsSendCache type: #'NSSendCache *'>
| literal |
annotation = IsObjectReference ifTrue:
[literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
(objectRepresentation
markAndTraceLiteral: literal
in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
atpc: mcpc asUnsignedInteger) ifTrue:
[codeModified := true]].
NewspeakVM ifTrue:
[annotation = IsNSSendCall ifTrue:
[| nsSendCache entryPoint targetMethod sel eo |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
entryPoint := nsSendCache target.
entryPoint ~= 0 ifTrue: "Send is linked"
[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
(self markAndTraceOrFreeCogMethod: targetMethod
firstVisit: targetMethod asUnsignedInteger > mcpc asUnsignedInteger) ifTrue:
[self voidNSSendCache: nsSendCache]].
sel := nsSendCache selector.
(objectMemory isForwarded: sel)
ifFalse: [objectMemory markAndTrace: sel]
ifTrue: [sel := objectMemory followForwarded: literal.
nsSendCache selector: sel.
self markAndTraceUpdatedLiteral: sel in: (self cCoerceSimple: cogMethod to: #'CogMethod *')].
eo := nsSendCache enclosingObject.
eo ~= 0 ifTrue:
[(objectMemory isForwarded: eo)
ifFalse: [objectMemory markAndTrace: eo]
ifTrue: [eo := objectMemory followForwarded: literal.
nsSendCache enclosingObject: eo.
self markAndTraceUpdatedLiteral: eo in: (self cCoerceSimple: cogMethod to: #'CogMethod *')]]]].
(self isPureSendAnnotation: annotation) ifTrue:
+ [self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
- [self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
[:entryPoint :cacheTag :tagCouldBeObj | | cacheTagMarked |
cacheTagMarked := tagCouldBeObj and: [objectRepresentation cacheTagIsMarked: cacheTag].
entryPoint > methodZoneBase
ifTrue: "It's a linked send."
[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
[:targetMethod :sendTable|
(cacheTagMarked not
or: [self markAndTraceOrFreeCogMethod: targetMethod
firstVisit: targetMethod asUnsignedInteger > mcpc asUnsignedInteger]) ifTrue:
["Either the cacheTag is unmarked (e.g. new class) or the target
has been freed (because it is unmarked), so unlink the send."
self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable.
objectRepresentation
markAndTraceLiteral: targetMethod selector
in: targetMethod
at: (self addressOf: targetMethod selector put: [:val| targetMethod selector: val])]]]
ifFalse: "cacheTag is selector"
[(objectRepresentation
markAndTraceCacheTagLiteral: cacheTag
in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
atpc: mcpc asUnsignedInteger) ifTrue:
[codeModified := true]]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>markYoungObjects:pc:method: (in category 'garbage collection') -----
markYoungObjects: annotation pc: mcpc method: cogMethod
"Mark and trace young literals."
<var: #mcpc type: #'char *'>
<var: #nsSendCache type: #'NSSendCache *'>
| literal |
annotation = IsObjectReference ifTrue:
[literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
objectRepresentation markAndTraceLiteralIfYoung: literal].
NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
[| nsSendCache |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
objectRepresentation markAndTraceLiteralIfYoung: nsSendCache selector.
nsSendCache enclosingObject ~= 0 ifTrue:
[objectRepresentation markAndTraceLiteralIfYoung: nsSendCache enclosingObject]]].
(self isPureSendAnnotation: annotation) ifTrue:
+ [self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
- [self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
[:entryPoint :cacheTag :tagCouldBeObj |
tagCouldBeObj ifTrue:
[objectRepresentation markAndTraceLiteralIfYoung: cacheTag]]].
^0 "keep scanning"!
Item was removed:
- ----- Method: Cogit>>offsetCacheTagAndCouldBeObjectAt:annotation:into: (in category 'in-line cacheing') -----
- offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into: trinaryBlock
- "Evaluate trinaryBlock with the entry, inline cache tag and whether the cache
- tag could be an object, for the send at mcpc with annotation annotation."
- <inline: true>
- | cacheTag entryPoint tagCouldBeObj |
- cacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
- entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
- "in-line cache tags are the selectors of sends if sends are unlinked,
- the selectors of super sends (entry offset = cmNoCheckEntryOffset),
- the selectors of open PIC sends (entry offset = cmEntryOffset, target is an Open PIC)
- or in-line cache tags (classes, class indices, immediate bit patterns, etc).
- Note that selectors can be immediate so there is no guarantee that they
- are markable/remappable objects."
- tagCouldBeObj := self inlineCacheTagsAreIndexes not
- and: [objectRepresentation inlineCacheTagsMayBeObjects
- or: [entryPoint < methodZoneBase
- or: [(entryPoint bitAnd: entryPointMask) = uncheckedEntryAlignment
- or: [(entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
- and: [(self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *') cmType = CMOpenPIC]]]]].
- trinaryBlock
- value: entryPoint
- value: cacheTag
- value: tagCouldBeObj!
Item was changed:
----- Method: Cogit>>remapIfObjectRef:pc:hasYoung: (in category 'garbage collection') -----
remapIfObjectRef: annotation pc: mcpc hasYoung: hasYoungPtr
<var: #mcpc type: #'char *'>
<var: #targetMethod type: #'CogMethod *'>
<var: #nsSendCache type: #'NSSendCache *'>
annotation = IsObjectReference ifTrue:
[| literal mappedLiteral |
literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
(objectRepresentation couldBeObject: literal) ifTrue:
[mappedLiteral := objectRepresentation remapObject: literal.
literal ~= mappedLiteral ifTrue:
[literalsManager storeLiteral: mappedLiteral atAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
codeModified := true].
(hasYoungPtr ~= 0
and: [objectMemory isYoung: mappedLiteral]) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]].
NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
[| nsSendCache oop mappedOop |
nsSendCache := self nsSendCacheFromReturnAddress: mcpc.
oop := nsSendCache selector.
mappedOop := objectRepresentation remapObject: oop.
oop ~= mappedOop ifTrue:
[nsSendCache selector: mappedOop.
(hasYoungPtr ~= 0 and: [objectMemory isYoung: mappedOop]) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]].
oop := nsSendCache enclosingObject.
oop ~= 0 ifTrue: [
mappedOop := objectRepresentation remapObject: oop.
oop ~= mappedOop ifTrue:
[nsSendCache enclosingObject: mappedOop.
(hasYoungPtr ~= 0 and: [objectMemory isYoung: mappedOop]) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]].
^0 "keep scanning"]].
(self isPureSendAnnotation: annotation) ifTrue:
+ [self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
- [self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
[:entryPoint :cacheTag :tagCouldBeObj | | mappedCacheTag |
(tagCouldBeObj
and: [objectRepresentation couldBeObject: cacheTag]) ifTrue:
[mappedCacheTag := objectRepresentation remapObject: cacheTag.
cacheTag ~= mappedCacheTag ifTrue:
[backEnd rewriteInlineCacheTag: mappedCacheTag at: mcpc asUnsignedInteger.
codeModified := true].
(hasYoungPtr ~= 0
and: [objectMemory isYoung: mappedCacheTag]) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]].
hasYoungPtr ~= 0 ifTrue:
["Since the unlinking routines may rewrite the cacheTag to the send's selector, and
since they don't have the cogMethod to hand and can't add it to youngReferrers,
the method must remain in youngReferrers if the targetMethod's selector is young."
entryPoint > methodZoneBase ifTrue: "It's a linked send."
[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
[:targetMethod :ignored|
(objectMemory isYoung: targetMethod selector) ifTrue:
[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]]]]].
^0 "keep scanning"!
Item was changed:
----- Method: RegisterAllocatingCogit>>ensureFixupAt: (in category 'bytecode generator support') -----
+ ensureFixupAt: targetPC
+ "Make sure there's a flagged fixup at the target pc in fixups.
+ Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction.
+ Override to enerate stack merging code if required."
- ensureFixupAt: targetIndex
| fixup |
<var: #fixup type: #'BytecodeFixup *'>
+ fixup := self fixupAt: targetPC - initialPC.
- fixup := self fixupAt: targetIndex.
fixup needsFixup
ifTrue:
[fixup mergeSimStack
ifNil: [self setMergeSimStackOf: fixup]
ifNotNil: [self mergeCurrentSimStackWith: fixup]]
ifFalse:
[self assert: fixup mergeSimStack isNil.
+ self moveVolatileSimStackEntriesToRegisters.
+ self setMergeSimStackOf: fixup].
+ ^super ensureFixupAt: targetPC!
- self moveVolatileSimStackEntriesToRegisters.
- self setMergeSimStackOf: fixup].
- ^super ensureFixupAt: targetIndex!
Item was changed:
----- Method: RegisterAllocatingCogit>>ensureNonMergeFixupAt: (in category 'compile abstract instructions') -----
+ ensureNonMergeFixupAt: targetPC
+ "Make sure there's a flagged fixup at the target pc in fixups.
+ Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction.
+ Override to remember the simStack state at tyeh target, if required."
- ensureNonMergeFixupAt: targetIndex
- "Make sure there's a flagged fixup at the targetIndex (pc relative to first pc) in fixups.
- Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction."
| fixup |
+ fixup := super ensureNonMergeFixupAt: targetPC.
- fixup := super ensureNonMergeFixupAt: targetIndex.
fixup mergeSimStack ifNil: [self setMergeSimStackOf: fixup].
^fixup!
Item was changed:
----- Method: RegisterAllocatingCogit>>genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode (in category 'bytecode generators') -----
genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode
"SistaV1: * 254 11111110 kkkkkkkk jjjjjjjj branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
| reg literal distance targetFixUp |
reg := self allocateRegForStackEntryAt: 0.
self ssTop popToReg: reg.
literal := self getLiteral: (extA * 256 + byte1).
extA := 0.
distance := extB * 256 + byte2.
extB := 0.
numExtB := 0.
"Because ensureFixupAt: will generate code to merge with the target simStack when required, it is
necessary to tease apart the jump and the merge so that the merge code is only executed if the
branch is taken. i.e. if merge code is required we generate
jump not cond Lcontinue
... merge code ...
jump Ltarget
Lcontinue:
instead of the incorrect
... merge code ...
jump cond Ltarget"
+ (self mergeRequiredForJumpTo: bytecodePC + 3 + distance) ifTrue:
- (self mergeRequiredForJumpTo: bytecodePC + 3 + distance - initialPC) ifTrue:
[self shouldBeImplemented].
+ targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance) to: #'AbstractInstruction *'.
- targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
(objectMemory isArrayNonImm: literal)
ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp].
self ssPop: 1.
^0!
Item was changed:
----- Method: RegisterAllocatingCogit>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genForwardersInlinedIdenticalOrNotIf: orNot
| nextPC branchDescriptor unforwardRcvr argReg targetBytecodePC
unforwardArg rcvrReg postBranchPC label fixup |
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #label type: #'AbstractInstruction *'>
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
"If an operand is an annotable constant, it may be forwarded, so we need to store it into a
register so the forwarder check can jump back to the comparison after unforwarding the constant.
However, if one of the operand is an unnanotable constant, does not allocate a register for it
(machine code will use operations on constants) and does not generate forwarder checks."
unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
self
allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
rcvrNeedsReg: unforwardRcvr
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
"If not followed by a branch, resolve to true or false."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: unforwardArg not
rcvrIsConstant: unforwardRcvr not
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
label := self Label.
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
+ "For now just deny we're in the situation we have yet to implement ;-)
+ self printSimStack; printSimStack: (self fixupAt: postBranchPC - initialPC) mergeSimStack"
- "For now just deny we're in the situation we have yet to implement ;-)"
self deny: (self mergeRequiredForJumpTo: targetBytecodePC).
self deny: (self mergeRequiredForJumpTo: postBranchPC).
"Further since there is a following conditional jump bytecode, define
non-merge fixups and leave the cond bytecode to set the mergeness."
(self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
+ self ensureFixupAt: targetBytecodePC.
+ self ensureFixupAt: postBranchPC]
- self ensureFixupAt: targetBytecodePC - initialPC.
- self ensureFixupAt: postBranchPC - initialPC]
ifFalse:
[self deny: deadCode]. "push dummy value below"
self assert: (unforwardArg or: [unforwardRcvr]).
orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
ifFalse: "branchDescriptor is branchFalse"
+ [ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
- [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
ifTrue:
+ [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger ].
- [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ].
deadCode ifFalse:
[self ssPushConstant: objectMemory trueObject]. "dummy value"
"The forwarders checks need to jump back to the comparison (label) if a forwarder is found, else
jump forward either to the next forwarder check or to the postBranch or branch target (fixup)."
unforwardArg ifTrue:
[ unforwardRcvr
ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: label ]
ifFalse: [ objectRepresentation
genEnsureOopInRegNotForwarded: argReg
scratchReg: TempReg
ifForwarder: label
ifNotForwarder: fixup ] ].
unforwardRcvr ifTrue:
[ objectRepresentation
genEnsureOopInRegNotForwarded: rcvrReg
scratchReg: TempReg
ifForwarder: label
ifNotForwarder: fixup ].
"Not reached, execution flow have jumped to fixup"
^0!
Item was changed:
----- Method: RegisterAllocatingCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
genJumpIf: boolean to: targetBytecodePC
<inline: false>
| eventualTarget desc reg fixup ok mbb noMustBeBoolean |
<var: #fixup type: #'BytecodeFixup *'>
<var: #ok type: #'AbstractInstruction *'>
<var: #desc type: #'CogSimStackEntry *'>
<var: #mbb type: #'AbstractInstruction *'>
eventualTarget := self eventualTargetOf: targetBytecodePC.
desc := self ssTop.
self ssPop: 1.
noMustBeBoolean := self extASpecifiesNoMustBeBoolean.
extA := 0.
(desc type == SSConstant
and: [desc constant = objectMemory trueObject or: [desc constant = objectMemory falseObject]]) ifTrue:
["Must annotate the bytecode for correct pc mapping."
desc constant = boolean
ifTrue:
[deadCode := true. "Can't fall through."
+ fixup := self ensureFixupAt: eventualTarget.
- fixup := self ensureFixupAt: eventualTarget - initialPC.
self annotateBytecode: (self Jump: fixup)]
ifFalse:
[self annotateBytecode: (self prevInstIsPCAnnotated
ifTrue: [self Nop]
ifFalse: [self Label])].
^0].
"try and use the top entry's register if any, but only if it can be destroyed."
reg := (desc type ~= SSRegister
or: [(self anyReferencesToRegister: desc register inAllButTopNItems: 0)
or: [(desc register = ReceiverResultReg and: [optStatus isReceiverResultRegLive])]])
ifTrue: [TempReg]
ifFalse: [desc register].
desc popToReg: reg.
"Cunning trick by LPD. If true and false are contiguous subtract the smaller.
Correct result is either 0 or the distance between them. If result is not 0 or
their distance send mustBeBoolean."
self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
"Merge required; must not generate merge code along untaken branch, so flip the order."
(self mergeRequiredForJumpTo: eventualTarget)
ifTrue:
[self genSubConstant: (boolean = objectMemory trueObject
ifTrue: [objectMemory falseObject]
ifFalse: [objectMemory trueObject])
R: reg.
ok := self JumpZero: 0.
self CmpCq: (boolean = objectMemory trueObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: reg.
noMustBeBoolean ifTrue:
+ [self JumpZero: (self ensureFixupAt: eventualTarget). "generates merge code"
- [self JumpZero: (self ensureFixupAt: eventualTarget - initialPC). "generates merge code"
ok jmpTarget: (self annotateBytecode: self lastOpcode).
^0].
mbb := self JumpNonZero: 0.
+ self Jump: (self ensureFixupAt: eventualTarget). "generates merge code"
- self Jump: (self ensureFixupAt: eventualTarget - initialPC). "generates merge code"
mbb jmpTarget: self Label]
ifFalse:
[self genSubConstant: boolean R: reg.
+ self JumpZero: (self ensureFixupAt: eventualTarget).
- self JumpZero: (self ensureFixupAt: eventualTarget - initialPC).
noMustBeBoolean ifTrue:
[self annotateBytecode: self lastOpcode.
^0].
self CmpCq: (boolean = objectMemory falseObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: reg.
ok := self JumpZero: 0].
reg ~= TempReg ifTrue:
[self MoveR: reg R: TempReg].
self copySimStackToScratch: simSpillBase.
self ssFlushTo: simStackPtr.
self genCallMustBeBooleanFor: boolean.
"NOTREACHED"
ok jmpTarget: (self annotateBytecode: self Label).
self restoreSimStackFromScratch.
^0!
Item was changed:
----- Method: RegisterAllocatingCogit>>genJumpTo: (in category 'bytecode generator support') -----
genJumpTo: targetBytecodePC
"Overriden to avoid the flush because in this cogit stack state is merged at merge point."
deadCode := true. "can't fall through"
+ self Jump: (self ensureFixupAt: (self eventualTargetOf: targetBytecodePC)).
- self Jump: (self ensureFixupAt: (self eventualTargetOf: targetBytecodePC) - initialPC).
^ 0!
Item was changed:
----- Method: RegisterAllocatingCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
genSpecialSelectorComparison
| nextPC postBranchPC targetBytecodePC primDescriptor branchDescriptor
rcvrIsInt argIsInt argInt jumpNotSmallInts inlineCAB index rcvrReg argReg |
<var: #primDescriptor type: #'BytecodeDescriptor *'>
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
primDescriptor := self generatorAt: byte0.
argIsInt := self ssTop type = SSConstant
and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
rcvrIsInt := (self ssValue: 1) type = SSConstant
and: [objectMemory isIntegerObject: (self ssValue: 1) constant].
(argIsInt and: [rcvrIsInt]) ifTrue:
[^self genStaticallyResolvedSpecialSelectorComparison].
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
"Only interested in inlining if followed by a conditional branch."
inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse].
"Further, only interested in inlining = and ~= if there's a SmallInteger constant involved.
The relational operators successfully statically predict SmallIntegers; the equality operators do not."
(inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue:
[inlineCAB := argIsInt or: [rcvrIsInt]].
inlineCAB ifFalse:
[^self genSpecialSelectorSend].
"In-line the comparison and the jump, but if the types are not SmallInteger then we will need
to do a send and fall through to the following conditional branch. Since we're allocating values
in registers we would like to keep those registers live on the inlined path and reload registers
along the non-inlined send path. The merge logic at the branch destinations handles this."
argIsInt
ifTrue:
[rcvrReg := self allocateRegForStackEntryAt: 1.
(self ssValue: 1) popToReg: rcvrReg.
self MoveR: rcvrReg R: TempReg]
ifFalse:
[self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext| argReg := rTop. rcvrReg := rNext].
rcvrReg = Arg0Reg ifTrue:
[rcvrReg := argReg. argReg := Arg0Reg].
self ssTop popToReg: argReg.
(self ssValue: 1) popToReg: rcvrReg.
self MoveR: argReg R: TempReg].
self ssPop: 2.
jumpNotSmallInts := (argIsInt or: [rcvrIsInt])
ifTrue: [objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg]
ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: rcvrReg andScratch: TempReg scratch: ClassReg].
argIsInt
ifTrue: [self CmpCq: argInt R: rcvrReg]
ifFalse: [self CmpR: argReg R: rcvrReg].
"For now just deny we're in the situation we have yet to implement ;-)"
self deny: (self mergeRequiredForJumpTo: targetBytecodePC).
self deny: (self mergeRequiredForJumpTo: postBranchPC).
"Cmp is weird/backwards so invert the comparison. Further since there is a following conditional
jump bytecode define non-merge fixups and leave the cond bytecode to set the mergeness."
self genConditionalBranch: (branchDescriptor isBranchTrue
ifTrue: [primDescriptor opcode]
ifFalse: [self inverseBranchFor: primDescriptor opcode])
+ operand: (self ensureFixupAt: targetBytecodePC) asUnsignedInteger.
+ self Jump: (self ensureFixupAt: postBranchPC).
- operand: (self ensureFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- self Jump: (self ensureFixupAt: postBranchPC - initialPC).
jumpNotSmallInts jmpTarget: self Label.
self ssFlushTo: simStackPtr.
self deny: rcvrReg = Arg0Reg.
argIsInt
ifTrue: [self MoveCq: argInt R: Arg0Reg]
ifFalse: [argReg ~= Arg0Reg ifTrue: [self MoveR: argReg R: Arg0Reg]].
rcvrReg ~= ReceiverResultReg ifTrue: [self MoveR: rcvrReg R: ReceiverResultReg].
index := byte0 - self firstSpecialSelectorBytecodeOffset.
^self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines!
Item was changed:
----- Method: RegisterAllocatingCogit>>genVanillaInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genVanillaInlinedIdenticalOrNotIf: orNot
| nextPC postBranchPC targetBytecodePC branchDescriptor
rcvrReg argReg argIsConstant rcvrIsConstant |
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
argIsConstant := self ssTop type = SSConstant.
"They can't be both constants to use correct machine opcodes.
However annotable constants can't be resolved statically, hence we need to careful."
rcvrIsConstant := argIsConstant not and: [(self ssValue: 1) type = SSConstant].
self
allocateEqualsEqualsRegistersArgNeedsReg: argIsConstant not
rcvrNeedsReg: rcvrIsConstant not
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
"If not followed by a branch, resolve to true or false."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: argIsConstant
rcvrIsConstant: rcvrIsConstant
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
self genCmpArgIsConstant: argIsConstant rcvrIsConstant: rcvrIsConstant argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"For now just deny we're in the situation we have yet to implement ;-)"
self deny: (self mergeRequiredForJumpTo: targetBytecodePC).
self deny: (self mergeRequiredForJumpTo: postBranchPC).
"Further since there is a following conditional jump bytecode, define
non-merge fixups and leave the cond bytecode to set the mergeness."
(self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
+ self ensureFixupAt: targetBytecodePC.
+ self ensureFixupAt: postBranchPC]
- self ensureFixupAt: targetBytecodePC - initialPC.
- self ensureFixupAt: postBranchPC - initialPC]
ifFalse:
[self deny: deadCode]. "push dummy value below"
self genConditionalBranch: (orNot == branchDescriptor isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero])
+ operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
- operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
"If the branch is dead, then we can just fall through postBranchPC (only a nop in-between), else
we need to jump over the code of the branch"
deadCode ifFalse:
+ [self Jump: (self ensureNonMergeFixupAt: postBranchPC).
- [self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC).
self ssPushConstant: objectMemory trueObject]. "dummy value"
^0!
Item was changed:
----- Method: RegisterAllocatingCogit>>mergeRequiredForJumpTo: (in category 'bytecode generator support') -----
+ mergeRequiredForJumpTo: targetPC
- mergeRequiredForJumpTo: target
"While this is a multi-pass compiler, no intermediate control-flow graph is built from bytecode and
there is a monotonically increasing one-to-one relationship between bytecode pcs and machine
code pcs that map to one another. Therefore, when jumping forward, any required code to merge
the state of the current simStack with that at the target must be generated before the jump
(because at the target the simStack state will be whatever falls through). If only one forward jump
to the target exists then that jump can simply install its simStack as the required simStack at the
target and the merge code wil be generated just before the target as control falls through. But if
there are two or more forward jumps to the target, a situation that occurs given that the
StackToRegisterMappingCogit follows jump chains, then jumps other than the first must generate
merge code before jumping. This poses a problem for conditional branches. The merge code must
only be generated along the path that takes the jump Therefore this must *not* be generated:
... merge code ...
jump cond Ltarget
which incorrectly executes the merge code along both the taken and untaken paths. Instead
this must be generated so that the merge code is only executed if the branch is taken.
jump not cond Lcontinue
... merge code ...
jump Ltarget
Lcontinue:
Note that no merge code is required for code such as self at: (expr ifTrue: [1] ifFalse: [2])
17 <70> self
18 <71> pushConstant: true
19 <99> jumpFalse: 22
20 <76> pushConstant: 1
21 <90> jumpTo: 23
22 <77> pushConstant: 2
23 <C0> send: at:
provided that 1 and 2 are assigned to the same target register."
self flag: 'be lazy for now; this needs more work to ignore compatible sim stacks'.
+ ^(self fixupAt: targetPC - initialPC) hasMergeSimStack!
- ^(self fixupAt: target - initialPC) hasMergeSimStack!
Item was changed:
----- Method: SimpleStackBasedCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
genJumpIf: boolean to: targetBytecodePC
<inline: false>
"Cunning trick by LPD. If true and false are contiguous subtract the smaller.
Correct result is either 0 or the distance between them. If result is not 0 or
their distance send mustBeBoolean."
| ok |
<var: #ok type: #'AbstractInstruction *'>
extA := 0.
self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
self PopR: TempReg.
self genSubConstant: boolean R: TempReg.
+ self JumpZero: (self ensureFixupAt: targetBytecodePC).
- self JumpZero: (self ensureFixupAt: targetBytecodePC - initialPC).
self CmpCq: (boolean == objectMemory falseObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: TempReg.
ok := self JumpZero: 0.
self genCallMustBeBooleanFor: boolean.
ok jmpTarget: (self annotateBytecode: self Label).
^0!
Item was changed:
----- Method: SimpleStackBasedCogit>>genJumpTo: (in category 'bytecode generator support') -----
genJumpTo: targetBytecodePC
+ self Jump: (self ensureFixupAt: targetBytecodePC).
- self Jump: (self ensureFixupAt: targetBytecodePC - initialPC).
^0!
Item was changed:
----- Method: SistaCogit>>genBinaryInlineComparison:opFalse:destReg: (in category 'inline primitive generators') -----
genBinaryInlineComparison: opTrue opFalse: opFalse destReg: destReg
"Inlined comparison. opTrue = jump for true and opFalse = jump for false"
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
| nextPC branchDescriptor targetBytecodePC postBranchPC |
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse])
ifTrue: "This is the path where the inlined comparison is followed immediately by a branch"
[ (self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
+ self ensureFixupAt: targetBytecodePC.
+ self ensureFixupAt: postBranchPC ]
- self ensureFixupAt: targetBytecodePC - initialPC.
- self ensureFixupAt: postBranchPC - initialPC ]
ifFalse:
[self ssPushConstant: objectMemory trueObject]. "dummy value"
self genConditionalBranch: (branchDescriptor isBranchTrue ifTrue: [opTrue] ifFalse: [opFalse])
+ operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
- operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
"We can only elide the jump if the pc after nextPC is the same as postBranchPC.
Branch following means it may not be."
self nextDescriptorExtensionsAndNextPCInto:
[:iguana1 :iguana2 :iguana3 :followingPC| nextPC := followingPC].
(deadCode and: [nextPC = postBranchPC]) ifFalse:
+ [ self Jump: (self ensureNonMergeFixupAt: postBranchPC) ] ]
- [ self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC) ] ]
ifFalse: "This is the path where the inlined comparison is *not* followed immediately by a branch"
[| condJump jump |
condJump := self genConditionalBranch: opTrue operand: 0.
self genMoveFalseR: destReg.
jump := self Jump: 0.
condJump jmpTarget: (self genMoveTrueR: destReg).
jump jmpTarget: self Label].
^ 0!
Item was changed:
----- Method: SistaCogit>>genCounterTripOnlyJumpIf:to: (in category 'bytecode generator support') -----
genCounterTripOnlyJumpIf: boolean to: targetBytecodePC
"Specific version if the branch is only reached while falling through if the counter trips after an inlined #== branch. We do not regenerate the counter logic in this case to avoid 24 bytes instructions."
<var: #ok type: #'AbstractInstruction *'>
<var: #mustBeBooleanTrampoline type: #'AbstractInstruction *'>
| ok mustBeBooleanTrampoline |
extA := 0.
self ssFlushTo: simStackPtr - 1.
self ssTop popToReg: TempReg.
self ssPop: 1.
counterIndex := counterIndex + 1. "counters are increased / decreased in the inlined branch"
"We need SendNumArgsReg because of the mustBeBooleanTrampoline"
self ssAllocateRequiredReg: SendNumArgsReg.
self MoveCq: 1 R: SendNumArgsReg.
"The first time this is reached, it calls necessarily the counter trip for the trampoline because SendNumArgsReg is non zero"
mustBeBooleanTrampoline := self genCallMustBeBooleanFor: boolean.
self annotateBytecode: self Label.
"Cunning trick by LPD. If true and false are contiguous subtract the smaller.
Correct result is either 0 or the distance between them. If result is not 0 or
their distance send mustBeBoolean."
self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
self genSubConstant: boolean R: TempReg.
+ self JumpZero: (self ensureFixupAt: targetBytecodePC).
- self JumpZero: (self ensureFixupAt: targetBytecodePC - initialPC).
self CmpCq: (boolean = objectMemory falseObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: TempReg.
ok := self JumpZero: 0.
self MoveCq: 0 R: SendNumArgsReg. "if counterReg is 0 this is a mustBeBoolean, not a counter trip."
self Jump: mustBeBooleanTrampoline.
ok jmpTarget: self Label.
^0!
Item was changed:
----- Method: SistaCogit>>genExtJumpIfNotInstanceOfBehaviorsBytecode (in category 'bytecode generators') -----
genExtJumpIfNotInstanceOfBehaviorsBytecode
"SistaV1: * 254 11111110 kkkkkkkk jjjjjjjj branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
| reg literal distance targetFixUp inverse |
"We lose the information of in which register is stack top
when jitting the branch target so we need to flush everything.
We could use a fixed register here...."
reg := self allocateRegForStackEntryAt: 0.
self ssTop popToReg: reg.
self ssPop: 1.
self ssFlushTo: simStackPtr. "flushed but the value is still in reg"
literal := self getLiteral: (extA * 256 + byte1).
(inverse := extB < 0) ifTrue:
[extB := extB + 128].
distance := extB * 256 + byte2.
extA := extB := numExtB := 0.
+ targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance) to: #'AbstractInstruction *'.
- targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
inverse
ifFalse:
[(objectMemory isArrayNonImm: literal)
ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp] ]
ifTrue:
[(objectMemory isArrayNonImm: literal)
ifTrue: [objectRepresentation branchIf: reg instanceOfBehaviors: literal target: targetFixUp]
ifFalse: [objectRepresentation branchIf: reg instanceOfBehavior: literal target: targetFixUp]].
^0!
Item was changed:
----- Method: SistaCogit>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genForwardersInlinedIdenticalOrNotIf: orNot
"Override to count inlined branches if followed by a conditional branch.
We borrow the following conditional branch's counter and when about to
inline the comparison we decrement the counter (without writing it back)
and if it trips simply abort the inlining, falling back to the normal send which
will then continue to the conditional branch which will trip and enter the abort."
| nextPC postBranchPC targetBytecodePC branchDescriptor counterReg fixup jumpEqual jumpNotEqual
counterAddress countTripped unforwardArg unforwardRcvr argReg rcvrReg regMask |
<var: #fixup type: #'BytecodeFixup *'>
<var: #countTripped type: #'AbstractInstruction *'>
<var: #label type: #'AbstractInstruction *'>
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #jumpEqual type: #'AbstractInstruction *'>
<var: #jumpNotEqual type: #'AbstractInstruction *'>
((coInterpreter isOptimizedMethod: methodObj) or: [needsFrame not]) ifTrue:
[^super genForwardersInlinedIdenticalOrNotIf: orNot].
regMask := 0.
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
"If an operand is an annotable constant, it may be forwarded, so we need to store it into a
register so the forwarder check can jump back to the comparison after unforwarding the constant.
However, if one of the operand is an unnanotable constant, does not allocate a register for it
(machine code will use operations on constants)."
rcvrReg:= argReg := NoReg.
self
allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
rcvrNeedsReg: unforwardRcvr
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
argReg ~= NoReg ifTrue: [ regMask := self registerMaskFor: argReg ].
rcvrReg ~= NoReg ifTrue: [ regMask := regMask bitOr: (self registerMaskFor: rcvrReg) ].
"Only interested in inlining if followed by a conditional branch."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: unforwardArg not
rcvrIsConstant: unforwardRcvr not
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
"If branching the stack must be flushed for the merge"
self ssFlushTo: simStackPtr - 2.
unforwardArg ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg ].
unforwardRcvr ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg ].
counterReg := self allocateRegNotConflictingWith: regMask.
self
genExecutionCountLogicInto: [ :cAddress :countTripBranch |
counterAddress := cAddress.
countTripped := countTripBranch ]
counterReg: counterReg.
self assert: (unforwardArg or: [ unforwardRcvr ]).
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
ifFalse:
+ [ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
- [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
ifTrue:
+ [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger ].
- [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ].
self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
self Jump: fixup.
countTripped jmpTarget: self Label.
"inlined version of #== ignoring the branchDescriptor if the counter trips to have normal state for the optimizer"
self ssPop: -2.
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"This code necessarily directly falls through the jumpIf: code which pops the top of the stack into TempReg.
We therefore directly assign the result to TempReg to save one move instruction"
jumpEqual := orNot ifFalse: [self JumpZero: 0] ifTrue: [self JumpNonZero: 0].
self genMoveFalseR: TempReg.
jumpNotEqual := self Jump: 0.
jumpEqual jmpTarget: (self genMoveTrueR: TempReg).
jumpNotEqual jmpTarget: self Label.
self ssPushRegister: TempReg.
(self fixupAt: nextPC - initialPC) notAFixup ifTrue: [ branchReachedOnlyForCounterTrip := true ].
^ 0!
Item was changed:
----- Method: SistaCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
genJumpIf: boolean to: targetBytecodePC
"The heart of performance counting in Sista. Conditional branches are 6 times less
frequent than sends and can provide basic block frequencies (send counters can't).
Each conditional has a 32-bit counter split into an upper 16 bits counting executions
and a lower half counting untaken executions of the branch. Executing the branch
decrements the upper half, tripping if the count goes negative. Not taking the branch
decrements the lower half. N.B. We *do not* eliminate dead branches (true ifTrue:/true ifFalse:)
so that scanning for send and branch data is simplified and that branch data is correct."
<inline: false>
| ok counterAddress countTripped retry nextPC nextDescriptor desc eventualTarget |
<var: #ok type: #'AbstractInstruction *'>
<var: #desc type: #'CogSimStackEntry *'>
<var: #retry type: #'AbstractInstruction *'>
<var: #countTripped type: #'AbstractInstruction *'>
<var: #nextDescriptor type: #'BytecodeDescriptor *'>
"In optimized code we don't generate counters to improve performance"
(coInterpreter isOptimizedMethod: methodObj) ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ].
"If the branch is reached only for the counter trip trampoline
(typically, var1 == var2 ifTrue: falls through to the branch only for the trampoline)
we generate a specific path to drastically reduce the number of machine instructions"
branchReachedOnlyForCounterTrip ifTrue:
[ branchReachedOnlyForCounterTrip := false.
^ self genCounterTripOnlyJumpIf: boolean to: targetBytecodePC ].
"We detect and: / or:, if found, we don't generate the counters to avoid pathological counter slow down"
boolean = objectMemory falseObject ifTrue:
[ nextPC := bytecodePC + (self generatorAt: byte0) numBytes.
nextDescriptor := self generatorAt: (objectMemory fetchByte: nextPC ofObject: methodObj) + bytecodeSetOffset.
nextDescriptor generator == #genPushConstantTrueBytecode ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ].
nextDescriptor := self generatorAt: (objectMemory fetchByte: targetBytecodePC ofObject: methodObj) + bytecodeSetOffset.
nextDescriptor generator == #genPushConstantFalseBytecode ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ]. ].
extA := 0. "We ignore the noMustBeBoolean flag. It should not be present in methods with counters, and if it is we don't care."
"We don't generate counters on branches on true/false, the basicblock usage can be inferred"
desc := self ssTop.
(desc type == SSConstant
and: [desc constant = objectMemory trueObject or: [desc constant = objectMemory falseObject]]) ifTrue:
[ ^ super genJumpIf: boolean to: targetBytecodePC ].
eventualTarget := self eventualTargetOf: targetBytecodePC.
self ssFlushTo: simStackPtr - 1.
desc popToReg: TempReg.
self ssPop: 1.
"We need SendNumArgsReg because of the mustBeBooleanTrampoline"
self ssAllocateRequiredReg: SendNumArgsReg.
retry := self Label.
self
genExecutionCountLogicInto: [ :cAddress :countTripBranch |
counterAddress := cAddress.
countTripped := countTripBranch ]
counterReg: SendNumArgsReg.
counterIndex := counterIndex + 1.
"Cunning trick by LPD. If true and false are contiguous subtract the smaller.
Correct result is either 0 or the distance between them. If result is not 0 or
their distance send mustBeBoolean."
self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
self genSubConstant: boolean R: TempReg.
+ self JumpZero: (self ensureFixupAt: eventualTarget).
- self JumpZero: (self ensureFixupAt: eventualTarget - initialPC).
self genFallsThroughCountLogicCounterReg: SendNumArgsReg counterAddress: counterAddress.
self CmpCq: (boolean = objectMemory falseObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: TempReg.
ok := self JumpZero: 0.
self MoveCq: 0 R: SendNumArgsReg. "if counterReg is 0 this is a mustBeBoolean, not a counter trip."
countTripped jmpTarget: (self genCallMustBeBooleanFor: boolean).
"If we're in an image which hasn't got the Sista code loaded then the ceCounterTripped:
trampoline will return directly to machine code, returning the boolean. So the code should
jump back to the retry point. The trampoline makes sure that TempReg has been reloaded."
"Clément: For some reason if I write self annotateBytecode: (self Jump: retry) the annotation is not at the correct place."
"Eliot: Annotations apply the the address following an instruction, and the annotation must be for the return address
of the call (since this is the address the run-time sees), so it must be on a label before the jump, not after the jump."
self annotateBytecode: self Label.
self Jump: retry.
ok jmpTarget: self Label.
^0!
Item was changed:
----- Method: SistaCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
genSpecialSelectorComparison
"Override to count inlined branches if followed by a conditional branch.
We borrow the following conditional branch's counter and when about to
inline the comparison we decrement the counter (without writing it back)
and if it trips simply abort the inlining, falling back to the normal send which
will then continue to the conditional branch which will trip and enter the abort."
| nextPC postBranchPC targetBytecodePC primDescriptor branchDescriptor
rcvrIsInt argIsInt argInt jumpNotSmallInts inlineCAB
counterAddress countTripped counterReg index |
<var: #countTripped type: #'AbstractInstruction *'>
<var: #primDescriptor type: #'BytecodeDescriptor *'>
<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
(coInterpreter isOptimizedMethod: methodObj) ifTrue: [ ^ self genSpecialSelectorComparisonWithoutCounters ].
self ssFlushTo: simStackPtr - 2.
primDescriptor := self generatorAt: byte0.
argIsInt := self ssTop type = SSConstant
and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
rcvrIsInt := (self ssValue: 1) type = SSConstant
and: [objectMemory isIntegerObject: (self ssValue: 1) constant].
"short-cut the jump if operands are SmallInteger constants."
(argIsInt and: [rcvrIsInt]) ifTrue:
[^ self genStaticallyResolvedSpecialSelectorComparison].
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
"Only interested in inlining if followed by a conditional branch."
inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse].
"Further, only interested in inlining = and ~= if there's a SmallInteger constant involved.
The relational operators successfully statically predict SmallIntegers; the equality operators do not."
(inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue:
[inlineCAB := argIsInt or: [rcvrIsInt]].
inlineCAB ifFalse:
[^self genSpecialSelectorSend].
argIsInt
ifTrue:
[(self ssValue: 1) popToReg: ReceiverResultReg.
self ssPop: 2.
self MoveR: ReceiverResultReg R: TempReg]
ifFalse:
[self marshallSendArguments: 1.
self MoveR: Arg0Reg R: TempReg].
jumpNotSmallInts := (argIsInt or: [rcvrIsInt])
ifTrue: [objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg]
ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: ReceiverResultReg andScratch: TempReg scratch: ClassReg].
counterReg := self allocateRegNotConflictingWith: (self registerMaskFor: ReceiverResultReg and: Arg0Reg).
self
genExecutionCountLogicInto: [ :cAddress :countTripBranch |
counterAddress := cAddress.
countTripped := countTripBranch ]
counterReg: counterReg.
argIsInt
ifTrue: [self CmpCq: argInt R: ReceiverResultReg]
ifFalse: [self CmpR: Arg0Reg R: ReceiverResultReg].
"Cmp is weird/backwards so invert the comparison. Further since there is a following conditional
jump bytecode define non-merge fixups and leave the cond bytecode to set the mergeness."
self genConditionalBranch: (branchDescriptor isBranchTrue
ifTrue: [primDescriptor opcode]
ifFalse: [self inverseBranchFor: primDescriptor opcode])
+ operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
- operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
+ self Jump: (self ensureNonMergeFixupAt: postBranchPC).
- self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC).
countTripped jmpTarget: (jumpNotSmallInts jmpTarget: self Label).
argIsInt ifTrue:
[self MoveCq: argInt R: Arg0Reg].
index := byte0 - self firstSpecialSelectorBytecodeOffset.
^self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines!
Item was changed:
----- Method: SistaCogitClone>>genBinaryInlineComparison:opFalse:destReg: (in category 'inline primitive generators') -----
genBinaryInlineComparison: opTrue opFalse: opFalse destReg: destReg
"Inlined comparison. opTrue = jump for true and opFalse = jump for false"
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
| nextPC branchDescriptor targetBytecodePC postBranchPC |
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse])
ifTrue: "This is the path where the inlined comparison is followed immediately by a branch"
[ (self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
+ self ensureFixupAt: targetBytecodePC.
+ self ensureFixupAt: postBranchPC ]
- self ensureFixupAt: targetBytecodePC - initialPC.
- self ensureFixupAt: postBranchPC - initialPC ]
ifFalse:
[self ssPushConstant: objectMemory trueObject]. "dummy value"
self genConditionalBranch: (branchDescriptor isBranchTrue ifTrue: [opTrue] ifFalse: [opFalse])
+ operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
+ deadCode ifFalse: [ self Jump: (self ensureNonMergeFixupAt: postBranchPC) ] ]
- operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- deadCode ifFalse: [ self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC) ] ]
ifFalse: "This is the path where the inlined comparison is *not* followed immediately by a branch"
[| condJump jump |
condJump := self genConditionalBranch: opTrue operand: 0.
self genMoveFalseR: destReg.
jump := self Jump: 0.
condJump jmpTarget: (self genMoveTrueR: destReg).
jump jmpTarget: self Label].
^ 0!
Item was changed:
----- Method: SistaCogitClone>>genExtJumpIfNotInstanceOfBehaviorsBytecode (in category 'bytecode generators') -----
genExtJumpIfNotInstanceOfBehaviorsBytecode
"SistaV1: * 254 11111110 kkkkkkkk jjjjjjjj branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
| reg literal distance targetFixUp inverse |
"We lose the information of in which register is stack top
when jitting the branch target so we need to flush everything.
We could use a fixed register here...."
reg := self allocateRegForStackEntryAt: 0.
self ssTop popToReg: reg.
self ssFlushTo: simStackPtr. "flushed but the value is still in reg"
self ssPop: 1.
literal := self getLiteral: (extA * 256 + byte1).
(inverse := extB < 0) ifTrue:
[extB := extB + 128].
distance := extB * 256 + byte2.
extA := extB := numExtB := 0.
+ targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance) to: #'AbstractInstruction *'.
- targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
inverse
ifFalse:
[(objectMemory isArrayNonImm: literal)
ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp] ]
ifTrue:
[(objectMemory isArrayNonImm: literal)
ifTrue: [objectRepresentation branchIf: reg instanceOfBehaviors: literal target: targetFixUp]
ifFalse: [objectRepresentation branchIf: reg instanceOfBehavior: literal target: targetFixUp]].
^0!
Item was changed:
----- Method: SistaRegisterAllocatingCogit>>genCounterTripOnlyJumpIf:to: (in category 'bytecode generator support') -----
genCounterTripOnlyJumpIf: boolean to: targetBytecodePC
"Specific version if the branch is only reached while falling through if the counter trips after an inlined #== branch. We do not regenerate the counter logic in this case to avoid 24 bytes instructions."
<var: #ok type: #'AbstractInstruction *'>
<var: #mustBeBooleanTrampoline type: #'AbstractInstruction *'>
| ok mustBeBooleanTrampoline |
extA := 0.
self ssTop popToReg: TempReg.
self ssPop: 1.
counterIndex := counterIndex + 1. "counters are increased / decreased in the inlined branch"
"We need SendNumArgsReg because of the mustBeBooleanTrampoline"
self ssAllocateRequiredReg: SendNumArgsReg.
self MoveCq: 1 R: SendNumArgsReg.
"The first time this is reached, it calls necessarily the counter trip for the trampoline because SendNumArgsReg is non zero"
mustBeBooleanTrampoline := self genCallMustBeBooleanFor: boolean.
self annotateBytecode: self Label.
"Cunning trick by LPD. If true and false are contiguous subtract the smaller.
Correct result is either 0 or the distance between them. If result is not 0 or
their distance send mustBeBoolean."
self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
self genSubConstant: boolean R: TempReg.
+ self JumpZero: (self ensureFixupAt: targetBytecodePC).
- self JumpZero: (self ensureFixupAt: targetBytecodePC - initialPC).
self CmpCq: (boolean = objectMemory falseObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: TempReg.
ok := self JumpZero: 0.
self MoveCq: 0 R: SendNumArgsReg. "if counterReg is 0 this is a mustBeBoolean, not a counter trip."
self Jump: mustBeBooleanTrampoline.
ok jmpTarget: self Label.
^0!
Item was changed:
----- Method: SistaRegisterAllocatingCogit>>genExtJumpIfNotInstanceOfBehaviorsBytecode (in category 'bytecode generators') -----
genExtJumpIfNotInstanceOfBehaviorsBytecode
"SistaV1: * 254 11111110 kkkkkkkk jjjjjjjj branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
| reg literal distance targetFixUp inverse |
"We lose the information of in which register is stack top
when jitting the branch target so we need to flush everything.
We could use a fixed register here...."
reg := self allocateRegForStackEntryAt: 0.
self ssTop popToReg: reg.
self ssPop: 1.
literal := self getLiteral: (extA * 256 + byte1).
(inverse := extB < 0) ifTrue:
[extB := extB + 128].
distance := extB * 256 + byte2.
extA := extB := numExtB := 0.
"For now just deny we're in the situation we have yet to implement ;-)"
self deny: (self mergeRequiredForJumpTo: bytecodePC + 3 + distance).
+ targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance) to: #'AbstractInstruction *'.
- targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
inverse
ifFalse:
[(objectMemory isArrayNonImm: literal)
ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp] ]
ifTrue:
[(objectMemory isArrayNonImm: literal)
ifTrue: [objectRepresentation branchIf: reg instanceOfBehaviors: literal target: targetFixUp]
ifFalse: [objectRepresentation branchIf: reg instanceOfBehavior: literal target: targetFixUp]].
^0!
Item was changed:
----- Method: SistaRegisterAllocatingCogit>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genForwardersInlinedIdenticalOrNotIf: orNot
"Override to count inlined branches if followed by a conditional branch.
We borrow the following conditional branch's counter and when about to
inline the comparison we decrement the counter (without writing it back)
and if it trips simply abort the inlining, falling back to the normal send which
will then continue to the conditional branch which will trip and enter the abort."
| nextPC postBranchPC targetBytecodePC branchDescriptor counterReg fixup jumpEqual jumpNotEqual
counterAddress countTripped unforwardArg unforwardRcvr argReg rcvrReg regMask |
<var: #fixup type: #'BytecodeFixup *'>
<var: #countTripped type: #'AbstractInstruction *'>
<var: #label type: #'AbstractInstruction *'>
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #jumpEqual type: #'AbstractInstruction *'>
<var: #jumpNotEqual type: #'AbstractInstruction *'>
((coInterpreter isOptimizedMethod: methodObj) or: [needsFrame not]) ifTrue:
[^super genForwardersInlinedIdenticalOrNotIf: orNot].
regMask := 0.
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
"If an operand is an annotable constant, it may be forwarded, so we need to store it into a
register so the forwarder check can jump back to the comparison after unforwarding the constant.
However, if one of the operand is an unnanotable constant, does not allocate a register for it
(machine code will use operations on constants)."
rcvrReg:= argReg := NoReg.
self
allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
rcvrNeedsReg: unforwardRcvr
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
argReg ~= NoReg ifTrue: [ regMask := self registerMaskFor: argReg ].
rcvrReg ~= NoReg ifTrue: [ regMask := regMask bitOr: (self registerMaskFor: rcvrReg) ].
"Only interested in inlining if followed by a conditional branch."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: unforwardArg not
rcvrIsConstant: unforwardRcvr not
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
unforwardArg ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg ].
unforwardRcvr ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg ].
counterReg := self allocateRegNotConflictingWith: regMask.
self
genExecutionCountLogicInto: [ :cAddress :countTripBranch |
counterAddress := cAddress.
countTripped := countTripBranch ]
counterReg: counterReg.
self assert: (unforwardArg or: [ unforwardRcvr ]).
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
ifFalse:
+ [ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
- [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
ifTrue:
+ [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger ].
- [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ].
self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
self Jump: fixup.
countTripped jmpTarget: self Label.
"inlined version of #== ignoring the branchDescriptor if the counter trips to have normal state for the optimizer"
self ssPop: -2.
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"This code necessarily directly falls through the jumpIf: code which pops the top of the stack into TempReg.
We therefore directly assign the result to TempReg to save one move instruction"
jumpEqual := orNot ifFalse: [self JumpZero: 0] ifTrue: [self JumpNonZero: 0].
self genMoveFalseR: TempReg.
jumpNotEqual := self Jump: 0.
jumpEqual jmpTarget: (self genMoveTrueR: TempReg).
jumpNotEqual jmpTarget: self Label.
self ssPushRegister: TempReg.
(self fixupAt: nextPC - initialPC) notAFixup ifTrue: [ branchReachedOnlyForCounterTrip := true ].
^ 0!
Item was changed:
----- Method: SistaRegisterAllocatingCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
genJumpIf: boolean to: targetBytecodePC
"The heart of performance counting in Sista. Conditional branches are 6 times less
frequent than sends and can provide basic block frequencies (send counters can't).
Each conditional has a 32-bit counter split into an upper 16 bits counting executions
and a lower half counting untaken executions of the branch. Executing the branch
decrements the upper half, tripping if the count goes negative. Not taking the branch
decrements the lower half. N.B. We *do not* eliminate dead branches (true ifTrue:/true ifFalse:)
so that scanning for send and branch data is simplified and that branch data is correct."
<inline: false>
| ok counterAddress countTripped retry nextPC nextDescriptor desc eventualTarget reg |
<var: #ok type: #'AbstractInstruction *'>
<var: #desc type: #'CogSimStackEntry *'>
<var: #retry type: #'AbstractInstruction *'>
<var: #countTripped type: #'AbstractInstruction *'>
<var: #nextDescriptor type: #'BytecodeDescriptor *'>
"In optimized code we don't generate counters to improve performance"
(coInterpreter isOptimizedMethod: methodObj) ifTrue:
[^super genJumpIf: boolean to: targetBytecodePC].
"If the branch is reached only for the counter trip trampoline
(typically, var1 == var2 ifTrue: falls through to the branch only for the trampoline)
we generate a specific path to drastically reduce the number of machine instructions"
branchReachedOnlyForCounterTrip ifTrue:
[branchReachedOnlyForCounterTrip := false.
^self genCounterTripOnlyJumpIf: boolean to: targetBytecodePC].
"We detect and: / or:, if found, we don't generate the counters to avoid pathological counter slow down"
boolean = objectMemory falseObject ifTrue:
[ nextPC := bytecodePC + (self generatorAt: byte0) numBytes.
nextDescriptor := self generatorAt: (objectMemory fetchByte: nextPC ofObject: methodObj) + bytecodeSetOffset.
nextDescriptor generator == #genPushConstantTrueBytecode ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ].
nextDescriptor := self generatorAt: (objectMemory fetchByte: targetBytecodePC ofObject: methodObj) + bytecodeSetOffset.
nextDescriptor generator == #genPushConstantFalseBytecode ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ]. ].
extA := 0. "We ignore the noMustBeBoolean flag. It should not be present in methods with counters, and if it is we don't care."
"We don't generate counters on branches on true/false, the basicblock usage can be inferred"
desc := self ssTop.
(desc type == SSConstant
and: [desc constant = objectMemory trueObject or: [desc constant = objectMemory falseObject]]) ifTrue:
[ ^ super genJumpIf: boolean to: targetBytecodePC ].
eventualTarget := self eventualTargetOf: targetBytecodePC.
self flag: 'Because of the restriction on x64 that absolute loads must target %rax, it would perhaps be a better choice to use TempReg (%rax) for the counter reg and SendNumArgsReg for the boolean.'.
"try and use the top entry's register if any, but only if it can be destroyed."
reg := (desc type ~= SSRegister
or: [(self anyReferencesToRegister: desc register inAllButTopNItems: 0)
or: [(desc register = ReceiverResultReg and: [optStatus isReceiverResultRegLive])]])
ifTrue: [TempReg]
ifFalse: [desc register].
desc popToReg: reg.
self ssPop: 1.
"We need SendNumArgsReg because of the mustBeBooleanTrampoline"
self ssAllocateRequiredReg: SendNumArgsReg.
retry := self Label.
self
genExecutionCountLogicInto: [ :cAddress :countTripBranch |
counterAddress := cAddress.
countTripped := countTripBranch ]
counterReg: SendNumArgsReg.
counterIndex := counterIndex + 1.
"Cunning trick by LPD. If true and false are contiguous subtract the smaller.
Correct result is either 0 or the distance between them. If result is not 0 or
their distance send mustBeBoolean."
self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
self genSubConstant: boolean R: reg.
+ self JumpZero: (self ensureFixupAt: eventualTarget).
- self JumpZero: (self ensureFixupAt: eventualTarget - initialPC).
self genFallsThroughCountLogicCounterReg: SendNumArgsReg counterAddress: counterAddress.
self CmpCq: (boolean = objectMemory falseObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: reg.
ok := self JumpZero: 0.
self MoveCq: 0 R: SendNumArgsReg. "if counterReg is 0 this is a mustBeBoolean, not a counter trip."
reg ~= TempReg ifTrue:
[self MoveR: reg R: TempReg].
countTripped jmpTarget: self Label.
self copySimStackToScratch: simSpillBase.
self ssFlushTo: simStackPtr.
self genCallMustBeBooleanFor: boolean.
"If we're in an image which hasn't got the Sista code loaded then the ceCounterTripped: trampoline
will return directly to machine code, returning the boolean. So the code should jump back to the
retry point. The trampoline preserves register state when taking the ceCounterTripped: path."
"Clément: For some reason if I write self annotateBytecode: (self Jump: retry) the annotation is not at the correct place."
"Eliot: Annotations apply the the address following an instruction, and the annotation must be for the return address
of the call (since this is the address the run-time sees), so it must be on a label before the jump, not after the jump."
self annotateBytecode: self Label.
simSpillBase ~= scratchSpillBase ifTrue:
[self assert: simSpillBase > scratchSpillBase.
self AddCq: simSpillBase - scratchSpillBase * objectMemory wordSize R: SPReg].
self Jump: retry.
ok jmpTarget: self Label.
self restoreSimStackFromScratch.
^0!
Item was changed:
----- Method: SistaRegisterAllocatingCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
genSpecialSelectorComparison
"Override to count inlined branches if followed by a conditional branch.
We borrow the following conditional branch's counter and when about to
inline the comparison we decrement the counter (without writing it back)
and if it trips simply abort the inlining, falling back to the normal send which
will then continue to the conditional branch which will trip and enter the abort."
| nextPC postBranchPC targetBytecodePC primDescriptor branchDescriptor
rcvrIsInt argIsInt argInt jumpNotSmallInts inlineCAB
counterAddress countTripped counterReg index rcvrReg argReg |
<var: #countTripped type: #'AbstractInstruction *'>
<var: #primDescriptor type: #'BytecodeDescriptor *'>
<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
(coInterpreter isOptimizedMethod: methodObj) ifTrue:
[^self genSpecialSelectorComparisonWithoutCounters].
primDescriptor := self generatorAt: byte0.
argIsInt := self ssTop type = SSConstant
and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
rcvrIsInt := (self ssValue: 1) type = SSConstant
and: [objectMemory isIntegerObject: (self ssValue: 1) constant].
"short-cut the jump if operands are SmallInteger constants."
(argIsInt and: [rcvrIsInt]) ifTrue:
[^ self genStaticallyResolvedSpecialSelectorComparison].
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
"Only interested in inlining if followed by a conditional branch."
inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse].
"Further, only interested in inlining = and ~= if there's a SmallInteger constant involved.
The relational operators successfully statically predict SmallIntegers; the equality operators do not."
(inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue:
[inlineCAB := argIsInt or: [rcvrIsInt]].
inlineCAB ifFalse:
[^self genSpecialSelectorSend].
"In-line the comparison and the jump, but if the types are not SmallInteger then we will need
to do a send and fall through to the following conditional branch. Since we're allocating values
in registers we would like to keep those registers live on the inlined path and reload registers
along the non-inlined send path. The merge logic at the branch destinations handles this."
argIsInt
ifTrue:
[rcvrReg := self allocateRegForStackEntryAt: 1.
(self ssValue: 1) popToReg: rcvrReg.
self MoveR: rcvrReg R: TempReg.
counterReg := self allocateRegNotConflictingWith: (self registerMaskFor: rcvrReg)]
ifFalse:
[self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext| argReg := rTop. rcvrReg := rNext].
rcvrReg = Arg0Reg ifTrue:
[rcvrReg := argReg. argReg := Arg0Reg].
self ssTop popToReg: argReg.
(self ssValue: 1) popToReg: rcvrReg.
self MoveR: argReg R: TempReg.
counterReg := self allocateRegNotConflictingWith: (self registerMaskFor: rcvrReg and: argReg)].
jumpNotSmallInts := (argIsInt or: [rcvrIsInt])
ifTrue: [objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg]
ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: rcvrReg andScratch: TempReg scratch: ClassReg].
self
genExecutionCountLogicInto: [ :cAddress :countTripBranch |
counterAddress := cAddress.
countTripped := countTripBranch ]
counterReg: counterReg.
argIsInt
ifTrue: [self CmpCq: argInt R: rcvrReg]
ifFalse: [self CmpR: argReg R: rcvrReg].
"Cmp is weird/backwards so invert the comparison. Further since there is a following conditional
jump bytecode define non-merge fixups and leave the cond bytecode to set the mergeness."
self genConditionalBranch: (branchDescriptor isBranchTrue
ifTrue: [primDescriptor opcode]
ifFalse: [self inverseBranchFor: primDescriptor opcode])
+ operand: (self ensureFixupAt: targetBytecodePC) asUnsignedInteger.
- operand: (self ensureFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
+ self Jump: (self ensureFixupAt: postBranchPC).
- self Jump: (self ensureFixupAt: postBranchPC - initialPC).
countTripped jmpTarget: (jumpNotSmallInts jmpTarget: self Label).
self ssFlushTo: simStackPtr.
self deny: rcvrReg = Arg0Reg.
argIsInt
ifTrue: [self MoveCq: argInt R: Arg0Reg]
ifFalse: [argReg ~= Arg0Reg ifTrue: [self MoveR: argReg R: Arg0Reg]].
rcvrReg ~= ReceiverResultReg ifTrue: [self MoveR: rcvrReg R: ReceiverResultReg].
index := byte0 - self firstSpecialSelectorBytecodeOffset.
^self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines!
Item was added:
+ ----- Method: SpurGenerationScavenger class>>simulatorClass (in category 'simulation') -----
+ simulatorClass
+ ^SpurGenerationScavengerSimulator!
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was removed:
- ----- Method: SpurMemoryManager>>allOldSpaceEntitiesForCompactingFrom:do: (in category 'object enumeration') -----
- allOldSpaceEntitiesForCompactingFrom: initialObject do: aBlock
- <inline: true>
- | prevObj prevPrevObj objOop nextObj |
- self assert: (self isOldObject: initialObject).
- prevPrevObj := prevObj := nil.
- objOop := initialObject.
- [self assert: objOop \\ self allocationUnit = 0.
- self oop: objOop isLessThan: endOfMemory] whileTrue:
- [self assert: (self long64At: objOop) ~= 0.
- nextObj := self objectAfter: objOop limit: endOfMemory.
- aBlock value: objOop value: nextObj.
- prevPrevObj := prevObj.
- prevObj := objOop.
- objOop := nextObj].
- self touch: prevPrevObj.
- self touch: prevObj!
Item was added:
+ ----- Method: SpurMemoryManager>>allOldSpaceEntitiesForCompactingFrom:to:do: (in category 'object enumeration') -----
+ allOldSpaceEntitiesForCompactingFrom: initialObject to: finalObject do: aBlock
+ <inline: true>
+ | limit prevObj prevPrevObj objOop nextObj |
+ self assert: (self isOldObject: initialObject).
+ self assert: (self oop: finalObject isLessThanOrEqualTo: endOfMemory).
+ prevPrevObj := prevObj := nil.
+ objOop := initialObject.
+ limit := (self oop: finalObject isLessThan: endOfMemory) ifTrue: [self addressAfter: finalObject] ifFalse: [endOfMemory].
+ [self assert: objOop \\ self allocationUnit = 0.
+ self oop: objOop isLessThan: limit] whileTrue:
+ [self assert: (self long64At: objOop) ~= 0.
+ nextObj := self objectAfter: objOop limit: endOfMemory.
+ aBlock value: objOop value: nextObj.
+ prevPrevObj := prevObj.
+ prevObj := objOop.
+ objOop := nextObj].
+ self touch: prevPrevObj.
+ self touch: prevObj!
Item was changed:
----- Method: SpurMemoryManager>>allocateMemoryOfSize:newSpaceSize:stackSize:codeSize: (in category 'spur bootstrap') -----
allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes stackSize: stackBytes codeSize: codeBytes
"Intialize the receiver for bootsraping an image.
Set up a large oldSpace and an empty newSpace and set-up freeStart and scavengeThreshold
to allocate in oldSpace. Later on (in initializePostBootstrap) freeStart and scavengeThreshold
will be set to sane values."
<doNotGenerate>
self assert: (memoryBytes \\ self allocationUnit = 0
and: [newSpaceBytes \\ self allocationUnit = 0
and: [codeBytes \\ self allocationUnit = 0]]).
self allocateMemoryOfSize: memoryBytes + newSpaceBytes + codeBytes + stackBytes.
newSpaceStart := codeBytes + stackBytes.
endOfMemory := freeOldSpaceStart := memoryBytes + newSpaceBytes + codeBytes + stackBytes.
"leave newSpace empty for the bootstrap"
freeStart := newSpaceBytes + newSpaceStart.
oldSpaceStart := newSpaceLimit := newSpaceBytes + newSpaceStart.
scavengeThreshold := memory size * memory bytesPerElement. "i.e. /don't/ scavenge."
+ scavenger := SpurGenerationScavenger simulatorClass new.
- scavenger := SpurGenerationScavengerSimulator new.
scavenger manager: self.
scavenger newSpaceStart: newSpaceStart
newSpaceBytes: newSpaceBytes
survivorBytes: newSpaceBytes // self scavengerDenominator.
+ compactor := self class compactorClass simulatorClass new manager: self; yourself!
- compactor := self class compactorClass new manager: self; yourself.!
Item was changed:
----- Method: SpurMemoryManager>>classAtIndex: (in category 'class table') -----
classAtIndex: classIndex
<api>
+ <inline: true>
| classTablePage |
+ self assert: (classIndex >= 0 and: [classIndex <= self tagMask or: [classIndex >= self arrayClassIndexPun and: [classIndex <= self classIndexMask]]]).
- self assert: (classIndex <= self tagMask or: [classIndex >= self arrayClassIndexPun]).
classTablePage := self fetchPointer: classIndex >> self classTableMajorIndexShift
ofObject: hiddenRootsObj.
classTablePage = nilObj ifTrue:
[^nil].
^self
fetchPointer: (classIndex bitAnd: self classTableMinorIndexMask)
ofObject: classTablePage!
Item was changed:
----- Method: SpurMemoryManager>>fullGC (in category 'gc - global') -----
fullGC
"Perform a full lazy compacting GC. Answer the size of the largest free chunk."
<returnTypeC: #usqLong>
<inline: #never> "for profiling"
needGCFlag := false.
+ gcStartUsecs := coInterpreter ioUTCMicrosecondsNow.
- gcStartUsecs := self ioUTCMicrosecondsNow.
statMarkCount := 0.
coInterpreter preGCAction: GCModeFull.
self globalGarbageCollect.
coInterpreter postGCAction: GCModeFull.
statFullGCs := statFullGCs + 1.
+ statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow.
- statGCEndUsecs := self ioUTCMicrosecondsNow.
statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs).
+ statCompactionUsecs := statCompactionUsecs + (statGCEndUsecs - compactionStartUsecs).
^(freeLists at: 0) ~= 0
ifTrue: [self bytesInObject: self findLargestFreeChunk]
ifFalse: [0]!
Item was changed:
----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
globalGarbageCollect
<inline: true> "inline into fullGC"
self assert: self validObjStacks.
self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
"Mark objects /before/ scavenging, to empty the rememberedTable of unmarked roots."
self markObjects: true.
scavenger forgetUnmarkedRememberedObjects.
self doScavenge: MarkOnTenure.
"Mid-way the leak check must be more lenient. Unmarked classes will have been
expunged from the table, but unmarked instances will not yet have been reclaimed."
self runLeakCheckerFor: GCModeFull
excludeUnmarkedObjs: true
classIndicesShouldBeValid: true.
+ compactionStartUsecs := coInterpreter ioUTCMicrosecondsNow.
segmentManager prepareForGlobalSweep. "for notePinned:"
compactor compact.
self attemptToShrink.
self setHeapSizeAtPreviousGC.
self assert: self validObjStacks.
self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
self assert: self allObjectsUnmarked.
self runLeakCheckerFor: GCModeFull!
Item was changed:
----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
initialize
"We can put all initializations that set something to 0 or to false here.
In C all global variables are initialized to 0, and 0 is false."
remapBuffer := Array new: RemapBufferSize.
remapBufferCount := extraRootCount := 0. "see below"
freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
checkForLeaks := 0.
needGCFlag := signalLowSpace := marking := false.
becomeEffectsFlags := gcPhaseInProgress := 0.
statScavenges := statIncrGCs := statFullGCs := 0.
+ statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statCompactionUsecs := statGCEndUsecs := 0.
- statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0.
statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
statGrowMemory := statShrinkMemory := statRootTableCount := 0.
statRootTableOverflows := statMarkCount := statCompactPassCount := statCoalesces := 0.
"We can initialize things that are allocated but are lazily initialized."
unscannedEphemerons := SpurContiguousObjStack new.
"we can initialize things that are virtual in C."
+ scavenger := SpurGenerationScavenger simulatorClass new manager: self; yourself.
+ segmentManager := SpurSegmentManager simulatorClass new manager: self; yourself.
+ compactor := self class compactorClass simulatorClass new manager: self; yourself.
- scavenger := SpurGenerationScavengerSimulator new manager: self; yourself.
- segmentManager := SpurSegmentManager new manager: self; yourself.
- compactor := self class compactorClass new manager: self; yourself.
"We can also initialize here anything that is only for simulation."
heapMap := CogCheck32BitHeapMap new.
"N.B. We *don't* initialize extraRoots because we don't simulate it."
maxOldSpaceSize := self class initializationOptions
ifNotNil: [:initOpts| initOpts at: #maxOldSpaceSize ifAbsent: [0]]
ifNil: [0]!
Item was changed:
----- Method: SpurMemoryManager>>printFreeChunk:printAsTreeNode: (in category 'debug printing') -----
printFreeChunk: freeChunk printAsTreeNode: printAsTreeNode
| numBytes |
numBytes := self bytesInObject: freeChunk.
coInterpreter
+ print: 'freeChunk '; printHexPtrnp: freeChunk.
+ printAsTreeNode ifTrue:
+ [coInterpreter print: ' - '; printHexPtrnp:(self addressAfter: freeChunk)].
+ coInterpreter
- print: 'freeChunk '; printHexPtrnp: freeChunk;
print: ' bytes '; printNum: numBytes;
print: ' next '; printHexPtrnp: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: freeChunk).
(numBytes >= (self numFreeLists * self allocationUnit)
and: [printAsTreeNode]) ifTrue:
[coInterpreter
print: ' ^ '; printHexPtrnp: (self fetchPointer: self freeChunkParentIndex
ofFreeChunk: freeChunk);
print: ' < '; printHexPtrnp: (self fetchPointer: self freeChunkSmallerIndex
ofFreeChunk: freeChunk);
print: ' > '; printHexPtrnp: (self fetchPointer: self freeChunkLargerIndex
ofFreeChunk: freeChunk)].
coInterpreter cr!
Item was changed:
----- Method: SpurMemoryManager>>printOopsFrom:to: (in category 'debug printing') -----
printOopsFrom: startAddress to: endAddress
<api>
+ | oop limit firstNonEntity inEmptySpace lastNonEntity |
- | oop limit |
oop := self objectBefore: startAddress.
limit := endAddress asUnsignedIntegerPtr min: endOfMemory.
oop := oop
ifNil: [startAddress]
ifNotNil: [(self objectAfter: oop) = startAddress
ifTrue: [startAddress]
ifFalse: [oop]].
+ inEmptySpace := false.
[self oop: oop isLessThan: limit] whileTrue:
[self printEntity: oop.
+ [oop := self objectAfter: oop.
+ (self long64At: oop) = 0] whileTrue:
+ [inEmptySpace ifFalse:
+ [inEmptySpace := true.
+ firstNonEntity := oop].
+ lastNonEntity := oop].
+ inEmptySpace ifTrue:
+ [inEmptySpace := false.
+ coInterpreter
+ print: 'skipped empty space from '; printHexPtrnp: firstNonEntity;
+ print:' to '; printHexPtrnp: lastNonEntity; cr.
+ oop := self objectStartingAt: oop]]!
- oop := self objectAfter: oop]!
Item was changed:
----- Method: SpurMemoryManager>>resetFreeListHeads (in category 'free space') -----
resetFreeListHeads
+ freeListsMask := 0.
0 to: self numFreeLists - 1 do:
[:i| freeLists at: i put: 0]!
Item was added:
+ ----- Method: SpurMemoryManager>>statCompactionUsecs (in category 'accessing') -----
+ statCompactionUsecs
+ ^statCompactionUsecs!
Item was added:
+ ----- Method: SpurMemoryManager>>unlinkFreeChunk: (in category 'free space') -----
+ unlinkFreeChunk: freeChunk
+ "Unlink a free object from the free lists. Do not alter totalFreeOldSpace. Used for coalescing."
+ | chunkBytes index node next prev child childBytes |
+ index := (chunkBytes := self bytesInObject: freeChunk) / self allocationUnit.
+ (index < self numFreeLists and: [1 << index <= freeListsMask]) ifTrue:
+ [self assert: ((freeListsMask anyMask: 1 << index) and: [(freeLists at: index) ~= 0]).
+ node := freeLists at: index.
+ prev := 0.
+ [node ~= 0] whileTrue:
+ [self assert: node = (self startOfObject: node).
+ self assert: (self isValidFreeObject: node).
+ next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
+ node = freeChunk ifTrue:
+ [prev = 0
+ ifTrue: [freeLists at: index put: next]
+ ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
+ ^self].
+ prev := node.
+ node := next].
+ self error: 'freeChunk not found in free lists'].
+
+ "Large chunk. Search the large chunk tree."
+ child := freeLists at: 0.
+ node := 0.
+ [child ~= 0] whileTrue:
+ [self assert: (self isValidFreeObject: child).
+ childBytes := self bytesInObject: child.
+ childBytes = chunkBytes ifTrue: "size match; try to remove from list at node."
+ [node := child.
+ [prev := node.
+ node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
+ node ~= 0] whileTrue:
+ [node = freeChunk ifTrue:
+ [self assert: (self isValidFreeObject: node).
+ self storePointer: self freeChunkNextIndex
+ ofFreeChunk: prev
+ withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node).
+ ^self]].
+ child = freeChunk ifTrue:
+ [next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child.
+ next = 0
+ ifTrue: "no list; remove the interior node"
+ [self unlinkSolitaryFreeTreeNode: child]
+ ifFalse: "list; replace node with it"
+ [self inFreeTreeReplace: child with: next].
+ ^self]].
+ child ~= 0 ifTrue:
+ [childBytes < chunkBytes
+ ifTrue: "node too small; walk down the larger size of the tree"
+ [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
+ ifFalse:
+ [node := child.
+ child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: node]]].
+
+ self error: 'freeChunk not found in free tree'
+ !
Item was changed:
CogClass subclass: #SpurPlanningCompactor
+ instanceVariableNames: 'manager scavenger coInterpreter biasForGC firstFreeObject mobileStart firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceNotInOldSpace firstFieldOfRememberedSet anomaly objectAfterLastMobileObject'
- instanceVariableNames: 'manager scavenger coInterpreter biasForGC firstFreeObject mobileStart firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceNotInOldSpace firstFieldOfRememberedSet interestingObj anomaly objectAfterLastMobileObject relocationMap'
classVariableNames: ''
poolDictionaries: 'SpurMemoryManagementConstants VMBasicConstants VMBytecodeConstants VMSpurObjectRepresentationConstants'
category: 'VMMaker-SpurMemoryManager'!
!SpurPlanningCompactor commentStamp: 'eem 12/23/2016 17:50' prior: 0!
SpurPlanningCompactor implements the classic planning compaction algorithm for Spur. It makes at least three passes through the heap. The first pass plans where live movable objects will go, copying their forwarding field to the next slot in savedFirstFieldsSpace, and setting their forwarding pointer to point to their eventual location. The second pass updates all pointers in live pointer objects to point to objects' final destinations. The third pass moves objects to their final positions, unmarking objects as it does so. If the forwarding fields of live objects in the to-be-moved portion of the entire heap won't fit in savedFirstFieldsSpace, then additional passes are made until the entire heap has been compacted.
Instance Variables
biasForGC <Boolean>
coInterpreter: <StackInterpreter>
firstFieldOfRememberedSet <Oop>
firstFreeObject <Oop>
firstMobileObject <Oop>
lastMobileObject <Oop>
manager: <SpurMemoryManager>
savedFirstFieldsSpace <SpurContiguousObjStack>
savedFirstFieldsSpaceWasAllocated <Boolean>
scavenger: <SpurGenerationScavenger>
biasForGC
- true if compacting for GC, in which case do only one pass, or false if compacting for snapshot, in which case do as many passes as necessary to compact the entire heap.
firstFieldOfRememberedSet
- the saved first field of the rememberedSet. The rememberedSet must be relocated specially because it is not a pointer object. And hence the first field needs to be extracted for proper relocation.
firstFreeObject
- the first free object in a compaction pass.
firstMobileObject
- the first mobile object in a compaction. Unpinned objects from the firstMobileObject through to the lastMobileObject are implicitly forwarded.
lastMobileObject
- the last mobile object in a compaction. Unpinned objects from the firstMobileObject through to the lastMobileObject are implicitly forwarded.
savedFirstFieldsSpace
- the space holding the saved first fields, each overwritten by a forwarding pointer, for the objects from firstMobileObject through to lastMobileObject.
savedFirstFieldsSpaceWasAllocated
- if true, the memory for savedFirstFieldsSpace was obtained via a call of sqAllocateMemorySegmentOfSize:Above:AllocatedSizeInto:!
Item was changed:
----- Method: SpurPlanningCompactor class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
self declareCAsOop: (self instVarNames select: [:iv| iv endsWith: 'Object']) in: aCCodeGenerator.
aCCodeGenerator
+ var: 'savedFirstFieldsSpace' type: #SpurContiguousObjStack!
- var: 'savedFirstFieldsSpace' type: #SpurContiguousObjStack;
- removeVariable: 'interestingObj';
- removeVariable: 'relocationMap'!
Item was added:
+ ----- Method: SpurPlanningCompactor class>>simulatorClass (in category 'simulation') -----
+ simulatorClass
+ ^SpurPlanningCompactorSimulator!
Item was changed:
----- Method: SpurPlanningCompactor>>check: (in category 'private') -----
check: obj
+ "No-op in the real class."
+ <inline: true>!
- <inline: true>
- self cCode: '' inSmalltalk: [obj = interestingObj ifTrue: [self halt]].
- "this debugged the misuse of the largest free chunk:"
- "(manager checkForLeaks bitAnd: GCModeFull+GCModeFreeSpace) = GCModeFull ifTrue:
- [self deny: ((manager isEnumerableObject: obj) and: [(manager heapMapAtWord: obj) = 0])]"!
Item was added:
+ ----- Method: SpurPlanningCompactor>>coalesceFrom: (in category 'private') -----
+ coalesceFrom: maybeStartOfFree
+ "manager printOopsFrom: maybeStartOfFree to: manager endOfMemory"
+ <var: 'maybeStartOfFree' type: #usqInt>
+ | obj next |
+ <var: 'obj' type: #usqInt>
+ <var: 'next' type: #usqInt>
+ maybeStartOfFree >= manager endOfMemory ifTrue:
+ [^self].
+ obj := manager objectStartingAt: maybeStartOfFree.
+ [next := manager oldSpaceObjectAfter: obj.
+ next < manager endOfMemory] whileTrue:
+ [((manager isFreeObject: obj) and: [manager isFreeObject: next])
+ ifTrue:
+ [manager unlinkFreeChunk: obj.
+ manager unlinkFreeChunk: next.
+ obj := manager freeChunkWithBytes: (manager bytesInObject: obj) + (manager bytesInObject: next) at: (manager startOfObject: obj)]
+ ifFalse:
+ [obj := next]]!
Item was changed:
----- Method: SpurPlanningCompactor>>compact (in category 'compaction - api') -----
compact
"Sweep all of old space, sliding unpinned marked objects down over free and unmarked objects.
Let the segmentManager mark which segments contain pinned objects via notePinned:."
+ | finalPass firstPass |
- | onePass firstPass |
<inline: #never> "for profiling"
self initializeScanCheckingForFullyCompactedHeap ifTrue:
[^self unmarkObjectsInFullyCompactedHeap].
self initializeCompaction.
firstPass := true.
+ [finalPass := self planCompactSavingForwarders.
+ self assert: (self validRelocationPlanInPass: finalPass) = 0.
- [onePass := self planCompactSavingForwarders.
- self assert: (self validRelocationPlanInPass: onePass) = 0.
- objectAfterLastMobileObject := manager oldSpaceObjectAfter: lastMobileObject.
self updatePointers.
self copyAndUnmark: firstPass.
+ "Would like to check here, but can't if multi-pass."
+ false ifTrue: [manager checkFreeSpace: GCModeFull].
+ "Currently we do only a single pass if a normal GC, assuming that a pass will
+ always compact plenty of space. But we should perhaps check this assumption
+ by looking at the large free tree and seeing that the ratio of the largest free
+ chunk to the total ammount of free space is high."
+ finalPass or: [biasForGC]] whileFalse:
- manager checkFreeSpace: GCModeFull.
- onePass or: [biasForGC]] whileFalse:
[firstPass := false.
+ self reinitializeScanFrom: firstFreeObject;
- self reinitializeScan;
updateSavedFirstFieldsSpaceIfNecessary].
+ manager checkFreeSpace: GCModeFull.
self endCompaction!
Item was changed:
----- Method: SpurPlanningCompactor>>copyAndUnmark: (in category 'compaction') -----
copyAndUnmark: firstPass
"Sweep the heap, unmarking all objects and moving mobile objects to their correct positions,
restoring their savedFirstFields."
<inline: #never>
+ | finalPass |
- | onePass |
self logPhase: 'copying and unmarking...'.
firstPass ifTrue:
[self unmarkInitialImmobileObjects].
+ finalPass := self copyAndUnmarkMobileObjects.
+ (self thereAreObjectsToMove
+ and: [finalPass not
+ and: [biasForGC]]) ifTrue: "only ever one pass if biasForGC is true."
- "If savedFirstFieldsSpace is empty there is nothing to move, and no second pass."
- savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue:
- [self assert: (self oop: firstMobileObject isGreaterThanOrEqualTo: manager endOfMemory).
- ^self].
- onePass := self copyAndUnmarkMobileObjects.
- (onePass not and: [biasForGC]) ifTrue: "only ever one pass if biasForGC is true."
[self unmarkObjectsAfterLastMobileObject]!
Item was changed:
----- Method: SpurPlanningCompactor>>copyAndUnmarkMobileObjects (in category 'compaction') -----
copyAndUnmarkMobileObjects
"Sweep the mobile portion of the heap, moving objects to their eventual locations, and clearing their marked bits.
Remember to update the savedFirstFields of pointer objects, as these have been forwarded.
Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed).
The enumerations in planCompactSavingForwarders, updatePointersInMobileObjects and copyAndUnmarkMobileObjects
match. We could implement them as a single enumeration method taking several block arguments, but arguably that
would make understanding an already tricky algorithm more difficult. Instead we tolerate the duplication and encourage
the reader to diff the three methods to see where they diverge (e.g. via Cmd-shift-C)."
<inline: #never>
+ | toFinger top previousPin startOfPreviousPin |
- | toFinger top previousPin |
<var: 'o' type: #usqInt>
<var: 'top' type: #usqInt>
<var: 'toFinger' type: #usqInt>
<var: 'previousPin' type: #usqInt>
+ <var: 'startOfPreviousPin' type: #usqInt>
self deny: (manager isMarked: firstFreeObject).
toFinger := manager startOfObject: firstFreeObject.
top := savedFirstFieldsSpace start.
+ startOfPreviousPin := 0.
+ manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject to: (lastMobileObject ifNil: manager nilObject) do:
- manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject do:
[:o :n|
self check: o.
self assert: (previousPin
ifNil: [toFinger <= (manager startOfObject: o)]
+ ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= startOfPreviousPin]]).
- ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= (manager startOfObject: previousPin)]]).
self assert: (savedFirstFieldsSpaceNotInOldSpace or: [toFinger < top]).
(manager isMarked: o) ifTrue:
+ [(manager isPinned: o)
- [o > lastMobileObject ifTrue:
- [self assert: ((manager isPinned: o) not or: [previousPin isNil]).
- self freeFrom: toFinger upTo: manager endOfMemory previousPin: ((manager isPinned: o) ifTrue: [o] ifFalse: [previousPin]).
- ^true].
- (manager isPinned: o)
ifTrue:
[previousPin ifNil:
+ [previousPin := o. startOfPreviousPin := manager startOfObject: o]]
- [previousPin := o]]
ifFalse:
[| availableSpace bytes |
bytes := manager bytesInObject: o.
+ [toFinger <= startOfPreviousPin
+ and: [bytes ~= (availableSpace := startOfPreviousPin - toFinger)
+ and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue:
- [previousPin notNil
- and: [availableSpace := (manager startOfObject: previousPin) - toFinger.
- bytes ~= availableSpace
- and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue:
["The object does not fit in the space between toFinger and previousPin.
Move toFinger up to point at the first unmarked or mobile object after
previousPin, or, if previousPin is contiguous with o, to the start of this
object. Update previousPin to be the next pinned object above toFInger
and below this object, or nil if no such pinned object exists.
Any unfillable gaps between adjacent pinned objects will be freed."
availableSpace > 0 ifTrue:
[manager addFreeChunkWithBytes: availableSpace at: toFinger].
[self assert: ((manager isMarked: previousPin) and: [manager isPinned: previousPin]).
self unmarkPinned: previousPin.
toFinger := manager addressAfter: previousPin.
previousPin := manager objectStartingAt: toFinger.
(manager isMarked: previousPin)
and: [(manager isPinned: previousPin)
and: [previousPin < o]]]
whileTrue.
"Now previousPin is either equal to o or mobile.
Move it to the next pinned object below o"
[previousPin >= o
or: [(manager isMarked: previousPin)
and: [manager isPinned: previousPin]]] whileFalse:
[previousPin := manager oldSpaceObjectAfter: previousPin].
+ previousPin >= o
+ ifTrue: [previousPin := nil. startOfPreviousPin := 0]
+ ifFalse: [startOfPreviousPin := manager startOfObject: previousPin]].
- previousPin >= o ifTrue:
- [previousPin := nil]].
self copyAndUnmarkObject: o to: toFinger bytes: bytes firstField: (manager longAt: top).
toFinger := toFinger + bytes.
(top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
+ [self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop).
+ self assert: n = objectAfterLastMobileObject.
+ previousPin ifNil: [previousPin := n. startOfPreviousPin := manager startOfObject: n].
+ "Create a free object for firstFreeObject to be set to on the next pass, but
+ do not link it into the free tree as it will be written over in that next pass."
+ toFinger < startOfPreviousPin
+ ifTrue:
+ [firstFreeObject := manager initFreeChunkWithBytes: startOfPreviousPin - toFinger at: toFinger]
+ ifFalse:
+ [firstFreeObject := previousPin].
+ ^false]]]].
+ self freeFrom: toFinger upTo: manager endOfMemory nextObject: (previousPin ifNil: [objectAfterLastMobileObject ifNil: [manager objectAfter: firstFreeObject]]).
+ self coalesceFrom: toFinger.
- [| done |
- self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop).
- done := self noMobileObjectsAfter: n.
- done
- ifTrue: [self freeAllUnpinnedObjectsFromObject: (previousPin ifNil: [n]) toFinger: toFinger]
- ifFalse: [self freeFrom: toFinger upTo: (manager startOfObject: n) previousPin: previousPin].
- ^done]]]].
- self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin.
^true!
Item was changed:
----- Method: SpurPlanningCompactor>>forwardMobileObject:to:savedFirstFieldPtr: (in category 'private') -----
forwardMobileObject: o to: toFinger savedFirstFieldPtr: savedFirstFieldPtr
"Forward a mobile object to some new location, saving its first field through savedFirstFieldPtr.
Don't use forward:to:; we dont want to alter the object in any way other than by setting the forwarding pointer."
<inline: true>
lastMobileObject := o.
manager
longAt: savedFirstFieldPtr
put: (manager fetchPointer: 0 ofObject: o);
storePointerUnchecked: 0
ofObject: o
withValue: ((manager hasOverflowHeader: o)
ifTrue: [toFinger + manager baseHeaderSize]
ifFalse: [toFinger]).
+ self recordMovementOf: o to: toFinger savedFirstFieldPtr: savedFirstFieldPtr!
- self cCode: '' inSmalltalk: [relocationMap ifNotNil: [:rm| rm at: o put: savedFirstFieldPtr]]!
Item was added:
+ ----- Method: SpurPlanningCompactor>>freeFrom:upTo:nextObject: (in category 'private') -----
+ freeFrom: initialToFinger upTo: limit nextObject: nextObject
+ "Free from toFinger up to limit, dealing with possible intervening pinned objects."
+ <inline: false>
+ <var: 'limit' type: #usqInt>
+ <var: 'initialToFinger' type: #usqInt>
+ | toFinger obj objStart |
+ <var: 'objStart' type: #usqInt>
+ <var: 'toFinger' type: #usqInt>
+ self cCode: [] inSmalltalk:
+ [coInterpreter cr; cr; print: 'freeing at '; printHexnp: initialToFinger; print: ' up to '; printHexnp: limit; cr].
+ toFinger := initialToFinger.
+ objStart := manager startOfObject: nextObject.
+ toFinger < objStart ifTrue:
+ [manager addFreeChunkWithBytes: objStart - toFinger at: toFinger].
+ toFinger := objStart.
+ [objStart < limit] whileTrue:
+ [obj := manager objectStartingAt: objStart.
+ ((manager isMarked: obj) and: [manager isPinned: obj])
+ ifTrue:
+ [self unmarkPinned: obj.
+ toFinger < objStart ifTrue:
+ [manager addFreeChunkWithBytes: objStart - toFinger at: toFinger].
+ toFinger := objStart := manager addressAfter: obj]
+ ifFalse:
+ [objStart := manager addressAfter: obj]].
+ limit > toFinger ifTrue:
+ [manager addFreeChunkWithBytes: limit - toFinger at: toFinger]!
Item was removed:
- ----- Method: SpurPlanningCompactor>>freeFrom:upTo:previousPin: (in category 'private') -----
- freeFrom: toFinger upTo: limit previousPin: previousPinOrNil
- "Free from toFinger up to limit, dealing with a possible intervening run of pinned objects starting at previousPinOrNil."
- <inline: false>
- <var: 'limit' type: #usqInt>
- <var: 'toFinger' type: #usqInt>
- <var: 'previousPinOrNil' type: #usqInt>
- | effectiveToFinger pin nextUnpinned start seg |
- <var: 'nextUnpinned' type: #usqInt>
- <var: #seg type: #'SpurSegmentInfo *'>
- self cCode: [] inSmalltalk:
- [coInterpreter cr; cr; print: 'freeing at '; printHexnp: toFinger; print: ' up to '; printHexnp: limit; print: ' pin '; printHexnp: previousPinOrNil; cr].
- effectiveToFinger := toFinger.
- pin := previousPinOrNil.
- "If the range toFinger to limit spans segments but there is no pin (as when freeing to the end of memory)
- segment boundaries must still be observed. So in this case use the nearest bridge above toFinger as the pin."
- pin ifNil:
- [seg := manager segmentManager segmentContainingObj: toFinger.
- seg segLimit < limit ifTrue:
- [pin := manager segmentManager bridgeFor: seg]].
- [pin notNil] whileTrue:
- [(start := manager startOfObject: pin) > toFinger ifTrue:
- [manager addFreeChunkWithBytes: start - effectiveToFinger at: effectiveToFinger].
- nextUnpinned := self unmarkPinnedObjectsAndFindFirstUnpinnedOrFreeEntityFollowing: pin.
- nextUnpinned >= limit ifTrue:
- [^self].
- effectiveToFinger := manager startOfObject: nextUnpinned.
- pin := self findNextMarkedPinnedAfter: nextUnpinned].
- manager addFreeChunkWithBytes: limit - effectiveToFinger at: effectiveToFinger!
Item was changed:
----- Method: SpurPlanningCompactor>>initializeScanCheckingForFullyCompactedHeap (in category 'compaction') -----
initializeScanCheckingForFullyCompactedHeap
+ "Scan for firstFreeObject and firstMobileObject from the start of memory.
+ Answer if the heap is already fully compacted."
+ firstMobileObject := lastMobileObject := objectAfterLastMobileObject := nil.
+ self reinitializeScanFrom: manager hiddenRootsObject.
+ firstFreeObject ifNil:
+ [self error: 'uncompactable heap; no unmarked objects found'].
- "Scan for firstFreeObject and firstMobileObject from the start of memory (actually
- from lastMobileObject so that reInitializeScan can work on subsequent passes).
- Answer if the heap is already fully compacted. Set "
- firstFreeObject := lastMobileObject := manager hiddenRootsObject.
- self reinitializeScan.
^firstMobileObject >= manager endOfMemory!
Item was removed:
- ----- Method: SpurPlanningCompactor>>interestingObj: (in category 'instance initialization') -----
- interestingObj: obj
- interestingObj := obj!
Item was removed:
- ----- Method: SpurPlanningCompactor>>noMobileObjectsAfter: (in category 'private') -----
- noMobileObjectsAfter: mobileObj
- self assert: ((manager isMarked: mobileObj) and: [(manager isPinned: mobileObj) not]).
- manager allOldSpaceEntitiesFrom: mobileObj do:
- [:o|
- ((manager isMarked: o) and: [(manager isPinned: o) not]) ifTrue:
- [^false]].
- ^true!
Item was changed:
----- Method: SpurPlanningCompactor>>planCompactSavingForwarders (in category 'compaction') -----
planCompactSavingForwarders
"Sweep the heap from firstFreeObject forwarding marked objects to where they
can be moved to, saving their forwarding pointer in savedFirstFieldsSpace.
Continue until either the end of the heap is reached or savedFirstFieldsSpace is full.
Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed).
The enumerations in planCompactSavingForwarders, updatePointersInMobileObjects and copyAndUnmarkMobileObjects
match. We could implement them as a single enumeration method taking several block arguments, but arguably that
would make understanding an already tricky algorithm more difficult. Instead we tolerate the duplication and encourage
the reader to diff the three methods to see where they diverge (e.g. via Cmd-shift-C)."
<inline: #never>
+ | toFinger top previousPin startOfPreviousPin |
- | toFinger top previousPin |
<var: 'o' type: #usqInt>
<var: 'top' type: #usqInt>
<var: 'toFinger' type: #usqInt>
<var: 'previousPin' type: #usqInt>
+ <var: 'startOfPreviousPin' type: #usqInt>
savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue:
[self logPhase: 'planning...'].
self deny: (manager isMarked: firstFreeObject).
toFinger := manager startOfObject: firstFreeObject.
top := savedFirstFieldsSpace start.
+ startOfPreviousPin := 0.
manager allOldSpaceEntitiesFrom: firstFreeObject do:
[:o|
self check: o.
self assert: (previousPin
ifNil: [toFinger <= (manager startOfObject: o)]
+ ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= startOfPreviousPin]]).
- ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= (manager startOfObject: previousPin)]]).
self assert: (savedFirstFieldsSpaceNotInOldSpace or: [toFinger < top]).
(manager isMarked: o) ifTrue:
[(manager isPinned: o)
ifTrue:
[previousPin ifNil:
+ [previousPin := o. startOfPreviousPin := manager startOfObject: o]]
- [previousPin := o]]
ifFalse:
[| availableSpace bytes |
bytes := manager bytesInObject: o.
+ [toFinger <= startOfPreviousPin
+ and: [bytes ~= (availableSpace := startOfPreviousPin - toFinger)
+ and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue:
- [previousPin notNil
- and: [availableSpace := (manager startOfObject: previousPin) - toFinger.
- bytes ~= availableSpace
- and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue:
["The object does not fit in the space between toFinger and previousPin.
Move toFinger up to point at the first unmarked or mobile object after
previousPin, or, if previousPin is contiguous with o, to the start of this
object. Update previousPin to be the next pinned object above toFInger
and below this object, or nil if no such pinned object exists.
Any unfillable gaps between adjacent pinned objects will be freed."
[toFinger := manager addressAfter: previousPin.
previousPin := manager objectStartingAt: toFinger.
(manager isMarked: previousPin)
and: [(manager isPinned: previousPin)
and: [previousPin < o]]]
whileTrue.
"Now previousPin is either equal to o or mobile.
Move it to the next pinned object below o"
[previousPin >= o
or: [(manager isMarked: previousPin)
and: [manager isPinned: previousPin]]] whileFalse:
[previousPin := manager oldSpaceObjectAfter: previousPin].
+ previousPin >= o
+ ifTrue: [previousPin := nil. startOfPreviousPin := 0]
+ ifFalse: [startOfPreviousPin := manager startOfObject: previousPin]].
- previousPin >= o ifTrue:
- [previousPin := nil]].
self forwardMobileObject: o to: toFinger savedFirstFieldPtr: top.
toFinger := toFinger + bytes.
(top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
[savedFirstFieldsSpace top: top - manager bytesPerOop.
+ objectAfterLastMobileObject := manager oldSpaceObjectAfter: lastMobileObject.
+ ^false]]]].
+ "If the heap is already fully compacted there will be no lastMobileObject..."
+ lastMobileObject ifNotNil:
+ [savedFirstFieldsSpace top: top - manager bytesPerOop.
+ objectAfterLastMobileObject := manager oldSpaceObjectAfter: lastMobileObject].
- ^self noMobileObjectsAfter: o]]]].
- savedFirstFieldsSpace top: top - manager bytesPerOop.
^true!
Item was added:
+ ----- Method: SpurPlanningCompactor>>recordMovementOf:to:savedFirstFieldPtr: (in category 'private') -----
+ recordMovementOf: o to: toFinger savedFirstFieldPtr: savedFirstFieldPtr
+ "No-op in the real class."
+ <inline: true>!
Item was removed:
- ----- Method: SpurPlanningCompactor>>recordMovements (in category 'compaction') -----
- recordMovements
- relocationMap := Dictionary new!
Item was removed:
- ----- Method: SpurPlanningCompactor>>reinitializeScan (in category 'compaction') -----
- reinitializeScan
- "Search for firstFreeObject and firstMobileObject from lastMobileObject (which is
- set to the hiddenRootsObject on the first pass)."
- firstMobileObject := manager endOfMemory.
- firstFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: lastMobileObject.
- firstFreeObject ifNil:
- [self error: 'uncompactable heap; no unmarked objects found'].
- mobileStart := manager startOfObject: firstFreeObject!
Item was added:
+ ----- Method: SpurPlanningCompactor>>reinitializeScanFrom: (in category 'compaction') -----
+ reinitializeScanFrom: initialObject
+ "Search for firstFreeObject and firstMobileObject from initialObject, which is the
+ hiddenRootsObject on the first pass, and the objectAfterLastMobileObject on
+ subsequent passes)."
+ firstMobileObject := manager endOfMemory.
+ firstFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: initialObject.
+ firstFreeObject ifNotNil:
+ [mobileStart := manager startOfObject: firstFreeObject].
+ objectAfterLastMobileObject ifNotNil:
+ [manager allOldSpaceEntitiesFrom: firstFreeObject to: objectAfterLastMobileObject do:
+ [:o|
+ ((manager isPinned: o)
+ or: [(manager isMarked: o) not
+ or: [objectAfterLastMobileObject = o]]) ifFalse:
+ [manager setIsMarkedOf: o to: false]].
+ firstMobileObject := objectAfterLastMobileObject]!
Item was added:
+ ----- Method: SpurPlanningCompactor>>thereAreObjectsToMove (in category 'private') -----
+ thereAreObjectsToMove
+ <inline: true>
+ ^lastMobileObject notNil!
Item was added:
+ ----- Method: SpurPlanningCompactor>>unmarkAndScanForFirstUnpinnedObjectFrom: (in category 'compaction') -----
+ unmarkAndScanForFirstUnpinnedObjectFrom: initialObject
+ "Scan from initialObject, unmarking any marked pinned objects, and answering the first mobile or freeable object found, or nil if none."
+ manager allOldSpaceEntitiesFrom: initialObject do:
+ [:o|
+ ((manager isMarked: o) and: [manager isPinned: o]) ifFalse:
+ [^o].
+ self unmarkPinned: o].
+ ^nil!
Item was changed:
----- Method: SpurPlanningCompactor>>unmarkObjectsAfterLastMobileObject (in category 'compaction') -----
unmarkObjectsAfterLastMobileObject
+ "Sweep the final immobile heap, freeing and coalescing unmarked and free objects,
+ and unmarking all marked objects up to the end of memory."
+ | startOfFree freeBytes |
+ freeBytes := 0.
+ manager allOldSpaceEntitiesFrom: objectAfterLastMobileObject do:
- "Sweep the final immobile heap, unmarking all objects up to the end of memory."
- manager allOldSpaceObjectsFrom: objectAfterLastMobileObject do:
[:o|
self check: o.
+ (manager isMarked: o)
+ ifFalse:
+ [startOfFree ifNil: [startOfFree := manager startOfObject: o].
+ freeBytes := freeBytes + (manager bytesInObject: o)]
+ ifTrue:
+ [startOfFree ifNotNil:
+ [manager addFreeChunkWithBytes: freeBytes at: startOfFree.
+ startOfFree := nil.
+ freeBytes := 0].
+ (manager isPinned: o)
+ ifTrue: [self unmarkPinned: o]
+ ifFalse: [manager setIsMarkedOf: o to: false]]]!
- manager setIsMarkedOf: o to: false]!
Item was changed:
----- Method: SpurPlanningCompactor>>updatePointers (in category 'compaction') -----
updatePointers
"Sweep the heap, updating all objects to their eventual locations.
Remember to update the savedFirstFields of pointer objects, as these have been forwarded."
<inline: #never>
| onePass |
self logPhase: 'updating pointers...'.
+ self thereAreObjectsToMove ifFalse:
- "If savedFirstFieldsSpace is empty there is nothing to do."
- savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue:
[^self].
self assert: (manager startOfObject: firstFreeObject) = mobileStart.
coInterpreter mapInterpreterOops.
manager mapExtraRoots.
self updatePointersInManagerHeapEntities.
self updatePointersInSurvivingObjects.
self updatePointersInInitialImmobileObjects.
onePass := self updatePointersInMobileObjects.
onePass ifFalse:
[self updatePointersInObjectsOverflowingSavedFirstFieldsSpace]!
Item was changed:
----- Method: SpurPlanningCompactor>>updatePointersInInitialImmobileObjects (in category 'compaction') -----
updatePointersInInitialImmobileObjects
"Sweep the initial immobile heap, updating all references to mobile objects to their eventual locations."
manager allOldSpaceObjectsFrom: manager firstObject do:
[:o|
self check: o.
(self oop: o isGreaterThanOrEqualTo: firstFreeObject) ifTrue:
[^self].
+ "would like to assert this, but it isn't true if more than one pass: self assert: (manager isMarked: o)."
- self assert: (manager isMarked: o).
self updatePointersIn: o]!
Item was changed:
----- Method: SpurPlanningCompactor>>updatePointersInMobileObjects (in category 'compaction') -----
updatePointersInMobileObjects
"Sweep the mobile portion of the heap, updating all references to objects to their eventual locations.
Remember to update the savedFirstFields of pointer objects, as these have been forwarded.
Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed).
The enumerations in planCompactSavingForwarders, updatePointersInMobileObjects and copyAndUnmarkMobileObjects
match. We could implement them as a single enumeration method taking several block arguments, but arguably that
would make understanding an already tricky algorithm more difficult. Instead we tolerate the duplication and encourage
the reader to diff the three methods to see where they diverge (e.g. via Cmd-shift-C)."
+ | toFinger top previousPin startOfPreviousPin |
- | toFinger top previousPin |
<var: 'o' type: #usqInt>
<var: 'top' type: #usqInt>
<var: 'toFinger' type: #usqInt>
<var: 'previousPin' type: #usqInt>
+ <var: 'startOfPreviousPin' type: #usqInt>
self deny: (manager isMarked: firstFreeObject).
toFinger := manager startOfObject: firstFreeObject.
top := savedFirstFieldsSpace start.
+ startOfPreviousPin := 0.
manager allOldSpaceEntitiesFrom: firstFreeObject do:
[:o|
self check: o.
self assert: (previousPin
ifNil: [toFinger <= (manager startOfObject: o)]
+ ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= startOfPreviousPin]]).
- ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= (manager startOfObject: previousPin)]]).
(manager isMarked: o) ifTrue:
[(manager isPinned: o)
ifTrue:
[previousPin ifNil:
+ [previousPin := o. startOfPreviousPin := manager startOfObject: o].
- [previousPin := o].
self updatePointersIn: o]
ifFalse:
[| availableSpace bytes |
bytes := manager bytesInObject: o.
+ [toFinger <= startOfPreviousPin
+ and: [bytes ~= (availableSpace := startOfPreviousPin - toFinger)
+ and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue:
- [previousPin notNil
- and: [availableSpace := (manager startOfObject: previousPin) - toFinger.
- bytes ~= availableSpace
- and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue:
["The object does not fit in the space between toFinger and previousPin.
Move toFinger up to point at the first unmarked or mobile object after
previousPin, or, if previousPin is contiguous with o, to the start of this
object. Update previousPin to be the next pinned object above toFInger
and below this object, or nil if no such pinned object exists.
Any unfillable gaps between adjacent pinned objects will be freed."
[toFinger := manager addressAfter: previousPin.
previousPin := manager objectStartingAt: toFinger.
(manager isMarked: previousPin)
and: [(manager isPinned: previousPin)
and: [previousPin < o]]]
whileTrue.
"Now previousPin is either equal to o or mobile.
Move it to the next pinned object below o"
[previousPin >= o
or: [(manager isMarked: previousPin)
and: [manager isPinned: previousPin]]] whileFalse:
[previousPin := manager oldSpaceObjectAfter: previousPin].
+ previousPin >= o
+ ifTrue: [previousPin := nil. startOfPreviousPin := 0]
+ ifFalse: [startOfPreviousPin := manager startOfObject: previousPin]].
- previousPin >= o ifTrue:
- [previousPin := nil]].
self updatePointersIn: o savedFirstFieldPointer: top.
toFinger := toFinger + bytes.
(top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
[self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop).
+ ^false]]]].
- ^self noMobileObjectsAfter: o]]]].
self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop).
^true!
Item was changed:
----- Method: SpurPlanningCompactor>>updatePointersInObjectsOverflowingSavedFirstFieldsSpace (in category 'compaction') -----
updatePointersInObjectsOverflowingSavedFirstFieldsSpace
"Sweep the final immobile heap, is any (those objects with no room in savedFirstFieldsSpace
in the current pass) updating all references to mobile objects to their eventual locations."
manager allOldSpaceObjectsFrom: objectAfterLastMobileObject do:
[:o|
self check: o.
+ (manager isMarked: o) ifTrue:
+ [self updatePointersIn: o]]!
- self assert: (manager isMarked: o).
- self updatePointersIn: o]!
Item was changed:
----- Method: SpurPlanningCompactor>>updateSavedFirstFieldsSpaceIfNecessary (in category 'space management') -----
updateSavedFirstFieldsSpaceIfNecessary
"If savedFirstFieldsSpace is a free chunk then it may need to be repositioned if there is more than one pass."
<inline: true>
self savedFirstFieldsSpaceInFreeChunk ifTrue:
[self useFreeChunkForSavedFirstFieldsSpace: manager findLargestFreeChunk].
+ savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop!
- savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop.
- manager resetFreeListHeads!
Item was changed:
----- Method: SpurPlanningCompactor>>validRelocationPlanInPass: (in category 'private') -----
validRelocationPlanInPass: onePass
"Answer 0 if all the mobile objects from firstMobileObject to lastMobileObject
have sane forwarding addresses, and that savedFirstFieldsSpace is of
matching capacity. Otherwise answer an error code identifying the anomaly."
| nMobiles toFinger |
<var: 'toFinger' type: #usqInt>
<var: 'destination' type: #usqInt>
nMobiles := 0.
toFinger := mobileStart.
anomaly := nil.
manager allOldSpaceEntitiesFrom: firstMobileObject do:
[:o| | destination |
self check: o.
(manager isMarked: o) ifTrue:
[(manager isPinned: o) ifFalse:
[nMobiles := nMobiles + 1.
destination := manager fetchPointer: 0 ofObject: o.
destination >= toFinger ifFalse:
[anomaly := o. ^1].
toFinger := toFinger + (manager bytesInObject: o).
(self oop: o isGreaterThan: lastMobileObject) ifTrue:
[anomaly := o. ^2].
o = lastMobileObject ifTrue:
+ [^savedFirstFieldsSpace top + manager bytesPerOop - savedFirstFieldsSpace start / manager bytesPerOop
- [^savedFirstFieldsSpace top - savedFirstFieldsSpace start / manager bytesPerOop + 1
= nMobiles
ifTrue: [0]
ifFalse: [3]]]]].
+ "N.B. written this way so that if there are no mobiles the expression evaluates to 0 in Smalltalk /and/ in C unsigned arithmetic."
+ ^savedFirstFieldsSpace top + manager bytesPerOop - savedFirstFieldsSpace start / manager bytesPerOop
- ^savedFirstFieldsSpace top - savedFirstFieldsSpace start / manager bytesPerOop + 1
= nMobiles
ifTrue: [0]
ifFalse: [4]!
Item was added:
+ SpurPlanningCompactor subclass: #SpurPlanningCompactorSimulator
+ instanceVariableNames: 'interestingObj relocationMap sffsMode'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-SpurMemoryManagerSimulation'!
Item was added:
+ ----- Method: SpurPlanningCompactorSimulator>>check: (in category 'private') -----
+ check: obj
+ <inline: true>
+ sffsMode ifNotNil: [self deny: ((manager isGrey: obj) or: [(manager isImmutable: obj) or: [manager isRemembered: obj]])].
+ obj = interestingObj ifTrue: [self halt].
+ "this debugged the misuse of the largest free chunk:"
+ "(manager checkForLeaks bitAnd: GCModeFull+GCModeFreeSpace) = GCModeFull ifTrue:
+ [self deny: ((manager isEnumerableObject: obj) and: [(manager heapMapAtWord: obj) = 0])]"!
Item was added:
+ ----- Method: SpurPlanningCompactorSimulator>>forceMultiPass (in category 'accessing') -----
+ forceMultiPass
+ sffsMode := #multiPass!
Item was added:
+ ----- Method: SpurPlanningCompactorSimulator>>interestingObj: (in category 'accessing') -----
+ interestingObj: obj
+ interestingObj := obj!
Item was added:
+ ----- Method: SpurPlanningCompactorSimulator>>recordMovementOf:to:savedFirstFieldPtr: (in category 'private') -----
+ recordMovementOf: o to: toFinger savedFirstFieldPtr: savedFirstFieldPtr
+ relocationMap ifNotNil: [:rm| rm at: o put: savedFirstFieldPtr]!
Item was added:
+ ----- Method: SpurPlanningCompactorSimulator>>recordMovements (in category 'accessing') -----
+ recordMovements
+ relocationMap := Dictionary new!
Item was added:
+ ----- Method: SpurPlanningCompactorSimulator>>selectSavedFirstFieldsSpace (in category 'space management') -----
+ selectSavedFirstFieldsSpace
+ "Override to make savedFirstFieldsSpace small enough for multi-pass compaction, if desired (for testing)."
+ super selectSavedFirstFieldsSpace.
+ "testRandomAssortment: et al create 1000 objects, aboput 5% pnned and about 33% reclaimable. Sp 512 objects should force multi-pass."
+ sffsMode == #multiPass ifTrue:
+ [savedFirstFieldsSpace limit: savedFirstFieldsSpace start + (512 * manager bytesPerOop).
+ biasForGC := false]!
Item was changed:
+ LongTestCase subclass: #SpurPlanningCompactorTests
- TestCase subclass: #SpurPlanningCompactorTests
instanceVariableNames: ''
classVariableNames: ''
+ poolDictionaries: 'VMBasicConstants VMSqueakClassIndices'
- poolDictionaries: 'VMSqueakClassIndices'
category: 'VMMaker-Tests'!
Item was added:
+ ----- Method: SpurPlanningCompactorTests>>checkForLeaksIn: (in category 'private') -----
+ checkForLeaksIn: om
+ om setCheckForLeaks: GCModeFreeSpace + GCModeFull;
+ runLeakCheckerFor: GCModeFull;
+ checkFreeSpace: GCModeFull!
Item was added:
+ ----- Method: SpurPlanningCompactorTests>>expectedFailures (in category 'failures') -----
+ expectedFailures
+ ^(FileDirectory default fileExists: self class imageNameForTests)
+ ifTrue: [#()]
+ ifFalse: [self testSelectors]!
Item was added:
+ ----- Method: SpurPlanningCompactorTests>>testCompactedHeap (in category 'tests') -----
+ testCompactedHeap
+ "First test for valid compactibility of an already compacted heap via fullGC"
+ | freeSpace om |
+ om := self initializedVM objectMemory.
+ freeSpace := om bytesLeftInOldSpace.
+ om fullGC.
+ self assert: freeSpace equals: om bytesLeftInOldSpace.
+ self checkForLeaksIn: om.
+ om fullGC.
+ self assert: freeSpace equals: om bytesLeftInOldSpace.
+ self checkForLeaksIn: om!
Item was added:
+ ----- Method: SpurPlanningCompactorTests>>testInitializedVM (in category 'tests') -----
+ testInitializedVM
+ self checkForLeaksIn: self initializedVM objectMemory!
Item was added:
+ ----- Method: SpurPlanningCompactorTests>>testMultiPassRandomAssortments (in category 'tests') -----
+ testMultiPassRandomAssortments
+ "Test that the compactor can handle multi-pass compaction of some
+ number of random assortments of live, pinned, dead, and free chunks."
+ <timeout: 60>
+ | random |
+ random := Random new.
+ 10 timesRepeat:
+ [| theVM |
+ theVM := self initializedVM.
+ theVM objectMemory compactor forceMultiPass.
+ self testRandomAssortment: (random next: 3000) readStream
+ with: theVM]!
Item was added:
+ ----- Method: SpurPlanningCompactorTests>>testMultiPassRandomAssortmentsWithNewSegment (in category 'tests') -----
+ testMultiPassRandomAssortmentsWithNewSegment
+ "Test that the compactor can handle multi-pass compaction of some number of
+ random assortments of live, pinned, dead, and free chunks allocated in a new segment."
+ <timeout: 60>
+ | random |
+ random := Random new.
+ 10 timesRepeat:
+ [| theVM |
+ theVM := self initializedVM.
+ theVM objectMemory compactor forceMultiPass.
+ self testRandomAssortmentWithNewSegment: (random next: 5000) readStream
+ with: theVM]!
Item was removed:
- ----- Method: SpurPlanningCompactorTests>>testRandomAssortment: (in category 'private') -----
- testRandomAssortment: random
- "Test that the compactor can handle a random assortment of live, pinned, dead, and free chunks."
- | om lastObj obj expectedFreeSpace liveFill pinFill liveCount pinCount totalLive totalPinned pinned |
- random reset. "random is a read stream on 3000 random numbers; for repeatability"
- om := self initializedVM objectMemory.
- om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true. lastObj := o].
- pinFill := 16r99999900.
- liveFill := 16r55AA0000.
- liveCount := pinCount := expectedFreeSpace := 0.
- pinned := Set new.
- 1000 timesRepeat:
- [| nSlots next newObj |
- nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory."
- newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
- (next := random next) > 0.95
- ifTrue: "pinned"
- [om
- fillObj: newObj numSlots: nSlots with: pinFill + (pinCount := pinCount + 1);
- setIsPinnedOf: newObj to: true]
- ifFalse: "mobile"
- [om
- fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1)].
- (next := random next) >= 0.333
- ifTrue:
- [om setIsMarkedOf: newObj to: true.
- (om isPinned: newObj) ifTrue:
- [pinned add: newObj]]
- ifFalse: "dead or free"
- [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj).
- (om isPinned: newObj) "Must check /before/ setObjectFree: which clears all bits"
- ifTrue: [pinCount := pinCount - 1]
- ifFalse: [liveCount := liveCount - 1].
- next >= 0.2
- ifTrue: [om setIsMarkedOf: newObj to: false]
- ifFalse: [om setObjectFree: newObj]]].
- totalPinned := pinCount.
- totalLive := liveCount.
- self assert: totalPinned < (totalPinned + totalLive / 10). "should average 5%"
-
- "useful pre-compaction printing:"
- false ifTrue:
- [liveCount := pinCount := 0.
- om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
- [:o|
- om coInterpreter print:
- ((om isMarked: o)
- ifTrue: [(((om isPinned: o)
- ifTrue: [pinCount := pinCount + 1]
- ifFalse: [liveCount := liveCount + 1])
- printPaddedWith: Character space to: 3 base: 10), ' ']
- ifFalse: [' ']).
- om printEntity: o]].
-
- expectedFreeSpace := expectedFreeSpace + om bytesLeftInOldSpace.
- om compactor compact.
- self assert: expectedFreeSpace equals: om bytesLeftInOldSpace.
- self assert: om allObjectsUnmarked.
-
- "useful post-compaction printing:"
- false ifTrue:
- [liveCount := pinCount := 0.
- om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
- [:o|
- om coInterpreter print:
- ((om isFreeObject: o)
- ifFalse: [(((om isPinned: o)
- ifTrue: [pinCount := pinCount + 1]
- ifFalse: [liveCount := liveCount + 1])
- printPaddedWith: Character space to: 3 base: 10), ' ']
- ifTrue: [' ']).
- om printEntity: o]].
-
- "First check and/or count populations..."
- liveCount := pinCount := 0.
- om allOldSpaceObjectsFrom: (om objectAfter: lastObj) do:
- [:o|
- (om isPinned: o)
- ifTrue:
- [pinCount := pinCount + 1.
- self assert: (pinned includes: o)]
- ifFalse: [liveCount := liveCount + 1]].
- self assert: totalPinned equals: pinCount.
- self assert: totalLive equals: liveCount.
-
- "Now check fills, which also tests update of first field on move..."
- liveCount := pinCount := 0.
- obj := lastObj.
- 1 to: totalLive + totalPinned do:
- [:n| | expectedFill actualFill |
- [obj := om objectAfter: obj. (om isEnumerableObject: obj) or: [obj >= om endOfMemory]] whileFalse.
- expectedFill := (om isPinned: obj)
- ifTrue: [pinFill + (pinCount := pinCount + 1)]
- ifFalse: [liveFill + (liveCount := liveCount + 1)].
- 1 to: (om numSlotsOf: obj) do:
- [:i| self assert: expectedFill equals: (actualFill := om fetchPointer: i - 1 ofObject: obj)]].
- "They should be the last objects..."
- self assert: (om isFreeObject: (om objectAfter: obj)).
- self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: obj))!
Item was added:
+ ----- Method: SpurPlanningCompactorTests>>testRandomAssortment:with: (in category 'private') -----
+ testRandomAssortment: random with: theVM
+ "Test that the compactor can handle a random assortment of live, pinned, dead, and free chunks."
+ | om lastObj obj expectedFreeSpace liveFill pinFill liveCount pinCount totalLive totalPinned pinned |
+ random reset. "random is a read stream on 3000 random numbers; for repeatability"
+ om := theVM objectMemory.
+ om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true. lastObj := o].
+ pinFill := 16r99999900.
+ liveFill := 16r55AA0000.
+ liveCount := pinCount := expectedFreeSpace := 0.
+ pinned := Set new.
+ 1000 timesRepeat:
+ [| nSlots next newObj |
+ nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory."
+ newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassByteArrayCompactIndex.
+ (next := random next) > 0.95
+ ifTrue: "pinned"
+ [om
+ fillObj: newObj numSlots: nSlots with: pinFill + (pinCount := pinCount + 1);
+ setIsPinnedOf: newObj to: true]
+ ifFalse: "mobile"
+ [om
+ fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1)].
+ (next := random next) >= 0.333
+ ifTrue:
+ [om setIsMarkedOf: newObj to: true.
+ (om isPinned: newObj) ifTrue:
+ [pinned add: newObj]]
+ ifFalse: "dead or free"
+ [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj).
+ (om isPinned: newObj) "Must check /before/ setObjectFree: which clears all bits"
+ ifTrue: [pinCount := pinCount - 1]
+ ifFalse: [liveCount := liveCount - 1].
+ next >= 0.2
+ ifTrue: [om setIsMarkedOf: newObj to: false]
+ ifFalse: [om setObjectFree: newObj]]].
+ totalPinned := pinCount.
+ totalLive := liveCount.
+ self assert: totalPinned < (totalPinned + totalLive / 10). "should average 5%"
+
+ "useful pre-compaction printing:"
+ false ifTrue:
+ [liveCount := pinCount := 0.
+ om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
+ [:o|
+ om coInterpreter print:
+ ((om isMarked: o)
+ ifTrue: [(((om isPinned: o)
+ ifTrue: [pinCount := pinCount + 1]
+ ifFalse: [liveCount := liveCount + 1])
+ printPaddedWith: Character space to: 3 base: 10), ' ']
+ ifFalse: [' ']).
+ om printEntity: o].
+ om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
+ [:o|
+ ((om isMarked: o) and: [om isPinned: o]) ifTrue:
+ [om printEntity: o]]].
+
+ expectedFreeSpace := expectedFreeSpace + om bytesLeftInOldSpace.
+ om compactor compact.
+ self assert: expectedFreeSpace equals: om bytesLeftInOldSpace.
+ self assert: om allObjectsUnmarked.
+
+ "useful post-compaction printing:"
+ false ifTrue:
+ [liveCount := pinCount := 0.
+ om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
+ [:o|
+ om coInterpreter print:
+ ((om isFreeObject: o)
+ ifFalse: [(((om isPinned: o)
+ ifTrue: [pinCount := pinCount + 1]
+ ifFalse: [liveCount := liveCount + 1])
+ printPaddedWith: Character space to: 3 base: 10), ' ']
+ ifTrue: [' ']).
+ om printEntity: o].
+ om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
+ [:o|
+ (om isPinned: o) ifTrue:
+ [om printEntity: o]]].
+
+ "First check and/or count populations..."
+ liveCount := pinCount := 0.
+ om allOldSpaceObjectsFrom: (om objectAfter: lastObj) do:
+ [:o|
+ (om isPinned: o)
+ ifTrue:
+ [pinCount := pinCount + 1.
+ self assert: (pinned includes: o)]
+ ifFalse: [liveCount := liveCount + 1]].
+ self assert: totalPinned equals: pinCount.
+ self assert: totalLive equals: liveCount.
+
+ "Now check fills, which also tests update of first field on move..."
+ liveCount := pinCount := 0.
+ obj := lastObj.
+ 1 to: totalLive + totalPinned do:
+ [:n| | expectedFill actualFill |
+ [obj := om objectAfter: obj. (om isEnumerableObject: obj) or: [obj >= om endOfMemory]] whileFalse.
+ expectedFill := (om isPinned: obj)
+ ifTrue: [pinFill + (pinCount := pinCount + 1)]
+ ifFalse: [liveFill + (liveCount := liveCount + 1)].
+ 1 to: (om numSlotsOf: obj) do:
+ [:i| self assert: expectedFill equals: (actualFill := om fetchPointer: i - 1 ofObject: obj)]].
+ "They should be the last objects..."
+ self assert: (om isFreeObject: (om objectAfter: obj)).
+ self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: obj)).
+ self checkForLeaksIn: om!
Item was removed:
- ----- Method: SpurPlanningCompactorTests>>testRandomAssortmentWithNewSegment: (in category 'private') -----
- testRandomAssortmentWithNewSegment: random
- "Test that the compactor can handle a random assortment of live, pinned, dead, and free chunks,
- with some allocation in a new segment. No live pinned objects are created in the new segment
- to obtain the situation that the last segment is entirely empty after compaction. This tests shrinkage."
- | om pig lastObj obj expectedFreeSpace liveFill pinFill liveCount pinCount totalLive totalPinned pinned |
- random reset. "random is a read stream on 3000 random numbers; for repeatability"
- om := self initializedVM objectMemory.
- om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true. lastObj := o].
-
- pinFill := 16r99999900.
- liveFill := 16r55AA0000.
- liveCount := pinCount := expectedFreeSpace := 0.
- pinned := Set new.
-
- 1000 timesRepeat:
- [| nSlots next newObj |
- nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory."
- newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
- (next := random next) > 0.95
- ifTrue: "pinned"
- [om
- fillObj: newObj numSlots: nSlots with: pinFill + (pinCount := pinCount + 1);
- setIsPinnedOf: newObj to: true]
- ifFalse: "mobile"
- [om
- fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1)].
- (next := random next) >= 0.333
- ifTrue:
- [om setIsMarkedOf: newObj to: true.
- (om isPinned: newObj) ifTrue:
- [pinned add: newObj]]
- ifFalse: "dead or free"
- [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj).
- (om isPinned: newObj) "Must check /before/ setObjectFree: which clears all bits"
- ifTrue: [pinCount := pinCount - 1]
- ifFalse: [liveCount := liveCount - 1].
- next >= 0.2
- ifTrue: [om setIsMarkedOf: newObj to: false]
- ifFalse: [om setObjectFree: newObj]]].
-
- pig := om allocateSlotsInOldSpace: (om numSlotsOfAny: om findLargestFreeChunk) format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
- self deny: pig isNil.
- self assert: 0 equals: om bytesLeftInOldSpace.
- om growOldSpaceByAtLeast: om growHeadroom // 2.
- self assert: om growHeadroom equals: om bytesLeftInOldSpace + om bridgeSize.
- expectedFreeSpace := expectedFreeSpace + (om bytesInObject: pig).
-
- 1000 timesRepeat:
- [| nSlots next newObj |
- nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory."
- newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
- "No pinned objects in second segment."
- om fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1).
- (next := random next) >= 0.333
- ifTrue:
- [om setIsMarkedOf: newObj to: true.
- (om isPinned: newObj) ifTrue:
- [pinned add: newObj]]
- ifFalse: "dead or free"
- [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj).
- liveCount := liveCount - 1.
- next >= 0.2
- ifTrue: [om setIsMarkedOf: newObj to: false]
- ifFalse: [om setObjectFree: newObj]]].
-
- totalPinned := pinCount.
- totalLive := liveCount.
- self assert: totalPinned < (totalPinned + totalLive / 20). "should average 2.5%"
-
- "useful pre-compaction printing:"
- false ifTrue:
- [liveCount := pinCount := 0.
- om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
- [:o|
- om coInterpreter print:
- ((om isMarked: o)
- ifTrue: [(((om isPinned: o)
- ifTrue: [pinCount := pinCount + 1]
- ifFalse: [liveCount := liveCount + 1])
- printPaddedWith: Character space to: 3 base: 10), ' ']
- ifFalse: [' ']).
- om printEntity: o]].
-
- expectedFreeSpace := expectedFreeSpace + om bytesLeftInOldSpace.
- om compactor compact.
- self assert: expectedFreeSpace equals: om bytesLeftInOldSpace.
- self assert: om allObjectsUnmarked.
-
- "useful post-compaction printing:"
- false ifTrue:
- [liveCount := pinCount := 0.
- om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
- [:o|
- om coInterpreter print:
- ((om isFreeObject: o)
- ifFalse: [(((om isPinned: o)
- ifTrue: [pinCount := pinCount + 1]
- ifFalse: [liveCount := liveCount + 1])
- printPaddedWith: Character space to: 3 base: 10), ' ']
- ifTrue: [' ']).
- om printEntity: o]].
-
- "First check and/or count populations..."
- liveCount := pinCount := 0.
- om allOldSpaceObjectsFrom: (om objectAfter: lastObj) do:
- [:o|
- (om isPinned: o)
- ifTrue:
- [pinCount := pinCount + 1.
- self assert: (pinned includes: o)]
- ifFalse: [liveCount := liveCount + 1]].
- self assert: totalPinned equals: pinCount.
- self assert: totalLive equals: liveCount.
-
- "Now check fills, which also tests update of first field on move..."
- liveCount := pinCount := 0.
- obj := lastObj.
- 1 to: totalLive + totalPinned do:
- [:n| | expectedFill actualFill |
- [obj := om objectAfter: obj. (om isEnumerableObject: obj) or: [obj >= om endOfMemory]] whileFalse.
- expectedFill := (om isPinned: obj)
- ifTrue: [pinFill + (pinCount := pinCount + 1)]
- ifFalse: [liveFill + (liveCount := liveCount + 1)].
- 1 to: (om numSlotsOf: obj) do:
- [:i| self assert: expectedFill equals: (actualFill := om fetchPointer: i - 1 ofObject: obj)]].
- "the Last segment should be empty"
- self assert: (om segmentManager isEmptySegment: (om segmentManager segments at: 1)).
- "They should be the last objects, followed by a free object to the end fo the first segment, a bridge, then an empty segment with a single free object in it."
- self assert: (om isFreeObject: (om objectAfter: obj)).
- self assert: (om isSegmentBridge: (om objectAfter: (om objectAfter: obj))).
- self assert: (om isFreeObject: (om objectAfter: (om objectAfter: (om objectAfter: obj)))).
- self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: (om objectAfter: (om objectAfter: obj)))).
-
- "And the memory should shrink if the shrinkThreshold is low enough"
- om shrinkThreshold: om growHeadroom.
- om attemptToShrink.
- self assert: om segmentManager numSegments = 1!
Item was added:
+ ----- Method: SpurPlanningCompactorTests>>testRandomAssortmentWithNewSegment:with: (in category 'private') -----
+ testRandomAssortmentWithNewSegment: random with: theVM
+ "Test that the compactor can handle a random assortment of live, pinned, dead, and free chunks,
+ with some allocation in a new segment. No live pinned objects are created in the new segment
+ to obtain the situation that the last segment is entirely empty after compaction. This tests shrinkage."
+ | om pig lastObj obj expectedFreeSpace liveFill pinFill liveCount pinCount totalLive totalPinned pinned |
+ random reset. "random is a read stream on 3000 random numbers; for repeatability"
+ om := theVM objectMemory.
+ om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true. lastObj := o].
+
+ pinFill := 16r99999900.
+ liveFill := 16r55AA0000.
+ liveCount := pinCount := expectedFreeSpace := 0.
+ pinned := Set new.
+
+ 1000 timesRepeat:
+ [| nSlots next newObj |
+ nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory."
+ newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassByteArrayCompactIndex.
+ (next := random next) > 0.95
+ ifTrue: "pinned"
+ [om
+ fillObj: newObj numSlots: nSlots with: pinFill + (pinCount := pinCount + 1);
+ setIsPinnedOf: newObj to: true]
+ ifFalse: "mobile"
+ [om
+ fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1)].
+ (next := random next) >= 0.333
+ ifTrue:
+ [om setIsMarkedOf: newObj to: true.
+ (om isPinned: newObj) ifTrue:
+ [pinned add: newObj]]
+ ifFalse: "dead or free"
+ [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj).
+ (om isPinned: newObj) "Must check /before/ setObjectFree: which clears all bits"
+ ifTrue: [pinCount := pinCount - 1]
+ ifFalse: [liveCount := liveCount - 1].
+ next >= 0.2
+ ifTrue: [om setIsMarkedOf: newObj to: false]
+ ifFalse: [om setObjectFree: newObj]]].
+
+ pig := om allocateSlotsInOldSpace: (om numSlotsOfAny: om findLargestFreeChunk) format: om firstLongFormat classIndex: ClassByteArrayCompactIndex.
+ self deny: pig isNil.
+ self assert: 0 equals: om bytesLeftInOldSpace.
+ om growOldSpaceByAtLeast: om growHeadroom // 2.
+ self assert: om growHeadroom equals: om bytesLeftInOldSpace + om bridgeSize.
+ expectedFreeSpace := expectedFreeSpace + (om bytesInObject: pig).
+
+ 1000 timesRepeat:
+ [| nSlots next newObj |
+ nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory."
+ newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassByteArrayCompactIndex.
+ "No pinned objects in second segment."
+ om fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1).
+ (next := random next) >= 0.333
+ ifTrue:
+ [om setIsMarkedOf: newObj to: true.
+ (om isPinned: newObj) ifTrue:
+ [pinned add: newObj]]
+ ifFalse: "dead or free"
+ [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj).
+ liveCount := liveCount - 1.
+ next >= 0.2
+ ifTrue: [om setIsMarkedOf: newObj to: false]
+ ifFalse: [om setObjectFree: newObj]]].
+
+ totalPinned := pinCount.
+ totalLive := liveCount.
+ self assert: totalPinned < (totalPinned + totalLive / 20). "should average 2.5%"
+
+ "useful pre-compaction printing:"
+ false ifTrue:
+ [liveCount := pinCount := 0.
+ om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
+ [:o|
+ om coInterpreter print:
+ ((om isMarked: o)
+ ifTrue: [(((om isPinned: o)
+ ifTrue: [pinCount := pinCount + 1]
+ ifFalse: [liveCount := liveCount + 1])
+ printPaddedWith: Character space to: 3 base: 10), ' ']
+ ifFalse: [' ']).
+ om printEntity: o].
+ om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
+ [:o|
+ ((om isMarked: o) and: [om isPinned: o]) ifTrue:
+ [om printEntity: o]]].
+
+ expectedFreeSpace := expectedFreeSpace + om bytesLeftInOldSpace.
+ om compactor compact.
+ self assert: expectedFreeSpace equals: om bytesLeftInOldSpace.
+ self assert: om allObjectsUnmarked.
+
+ "useful post-compaction printing:"
+ false ifTrue:
+ [liveCount := pinCount := 0.
+ om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
+ [:o|
+ om coInterpreter print:
+ ((om isFreeObject: o)
+ ifFalse: [(((om isPinned: o)
+ ifTrue: [pinCount := pinCount + 1]
+ ifFalse: [liveCount := liveCount + 1])
+ printPaddedWith: Character space to: 3 base: 10), ' ']
+ ifTrue: [' ']).
+ om printEntity: o].
+ om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
+ [:o|
+ (om isPinned: o) ifTrue:
+ [om printEntity: o]]].
+
+ "First check and/or count populations..."
+ liveCount := pinCount := 0.
+ om allOldSpaceObjectsFrom: (om objectAfter: lastObj) do:
+ [:o|
+ (om isPinned: o)
+ ifTrue:
+ [pinCount := pinCount + 1.
+ self assert: (pinned includes: o)]
+ ifFalse: [liveCount := liveCount + 1]].
+ self assert: totalPinned equals: pinCount.
+ self assert: totalLive equals: liveCount.
+
+ "Now check fills, which also tests update of first field on move..."
+ liveCount := pinCount := 0.
+ obj := lastObj.
+ 1 to: totalLive + totalPinned do:
+ [:n| | expectedFill actualFill |
+ [obj := om objectAfter: obj. (om isEnumerableObject: obj) or: [obj >= om endOfMemory]] whileFalse.
+ expectedFill := (om isPinned: obj)
+ ifTrue: [pinFill + (pinCount := pinCount + 1)]
+ ifFalse: [liveFill + (liveCount := liveCount + 1)].
+ 1 to: (om numSlotsOf: obj) do:
+ [:i| self assert: expectedFill equals: (actualFill := om fetchPointer: i - 1 ofObject: obj)]].
+ "the Last segment should be empty"
+ self assert: (om segmentManager isEmptySegment: (om segmentManager segments at: 1)).
+ "They should be the last objects, followed by a free object to the end fo the first segment, a bridge, then an empty segment with a single free object in it."
+ self assert: (om isFreeObject: (om objectAfter: obj)).
+ self assert: (om isSegmentBridge: (om objectAfter: (om objectAfter: obj))).
+ self assert: (om isFreeObject: (om objectAfter: (om objectAfter: (om objectAfter: obj)))).
+ self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: (om objectAfter: (om objectAfter: obj)))).
+
+ "And the memory should shrink if the shrinkThreshold is low enough"
+ om shrinkThreshold: om growHeadroom.
+ om attemptToShrink.
+ self assert: om segmentManager numSegments = 1.
+ self checkForLeaksIn: om!
Item was changed:
----- Method: SpurPlanningCompactorTests>>testRandomAssortments (in category 'tests') -----
testRandomAssortments
"Test that the compactor can handle some number of random assortments of live, pinned, dead, and free chunks."
<timeout: 60>
| random |
random := Random new.
+ 10 timesRepeat:
+ [self testRandomAssortment: (random next: 3000) readStream
+ with: self initializedVM]!
- 10 timesRepeat: [self testRandomAssortment: (random next: 3000) readStream]!
Item was changed:
----- Method: SpurPlanningCompactorTests>>testRandomAssortmentsWithNewSegment (in category 'tests') -----
testRandomAssortmentsWithNewSegment
"Test that the compactor can handle some number of random assortments of live, pinned, dead, and free chunks
allocated in a new segment."
<timeout: 60>
| random |
random := Random new.
+ 10 timesRepeat:
+ [self testRandomAssortmentWithNewSegment: (random next: 6000) readStream
+ with: self initializedVM]!
- 10 timesRepeat: [self testRandomAssortmentWithNewSegment: (random next: 6000) readStream]!
Item was added:
+ ----- Method: SpurPlanningCompactorTestsImageResource>>reset (in category 'accessing') -----
+ reset
+ "self current reset"
+ emptyVM := nil!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveVMParameter (in category 'system control primitives') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: StackInterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
primitiveDirectoryEntry
| name pathName arrayNilOrSymbol result |
name := self stringOf: self stackTop.
pathName := self stringOf: (self stackValue: 1).
"temporary work-around to make it work in Pharo..."
self cppIf: PharoVM ifTrue: [ pathName := Smalltalk imagePath ].
self successful ifFalse:
[^self primitiveFail].
arrayNilOrSymbol := FileDirectory default primLookupEntryIn: pathName name: name.
arrayNilOrSymbol ifNil:
[self pop: 3 thenPush: objectMemory nilObject.
^self].
arrayNilOrSymbol isArray ifFalse:
["arrayNilOrSymbol ~~ #primFailed ifTrue:
[self halt]. "
+ self transcript show: name , ' NOT FOUND'.
- Transcript show: name , ' NOT FOUND'.
^self primitiveFail].
result := PharoVM
ifTrue:
[self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size
createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3)
isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5)
posixPermissions: (arrayNilOrSymbol at: 6) isSymlink: (arrayNilOrSymbol at: 7) ]
ifFalse:
[self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size
createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3)
isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5) ].
self pop: 3 thenPush: result!
Item was changed:
----- Method: StackToRegisterMappingCogit>>ensureFixupAt: (in category 'compile abstract instructions') -----
+ ensureFixupAt: targetPC
+ "Make sure there's a flagged fixup at the target pc in fixups.
- ensureFixupAt: targetIndex
- "Make sure there's a flagged fixup at the targetIndex (pc relative to first pc) in fixups.
Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction."
<returnTypeC: #'BytecodeFixup *'>
| fixup |
<var: #fixup type: #'BytecodeFixup *'>
+ fixup := self fixupAt: targetPC - initialPC.
- fixup := self fixupAt: targetIndex.
self traceFixup: fixup.
self cCode: '' inSmalltalk:
+ [self assert: simStackPtr = (self debugStackPointerFor: targetPC).
- [self assert: simStackPtr = (self debugStackPointerFor: targetIndex + initialPC).
(fixup isMergeFixupOrIsFixedUp
and: [fixup isBackwardBranchFixup not]) ifTrue: "ignore backward branch targets"
[self assert: fixup simStackPtr = simStackPtr]].
fixup isNonMergeFixupOrNotAFixup
ifTrue: "convert a non-merge into a merge"
[fixup becomeMergeFixup.
fixup simStackPtr: simStackPtr.
LowcodeVM ifTrue: [
fixup simNativeStackPtr: simNativeStackPtr.
fixup simNativeStackSize: simNativeStackSize]]
ifFalse:
[fixup isBackwardBranchFixup
ifTrue: "this is the target of a backward branch and
so doesn't have a simStackPtr assigned yet."
[fixup simStackPtr: simStackPtr.
LowcodeVM ifTrue:
[fixup simNativeStackPtr: simNativeStackPtr.
fixup simNativeStackSize: simNativeStackSize]]
ifFalse:
[self assert: fixup simStackPtr = simStackPtr.
LowcodeVM ifTrue:
[self assert: fixup simNativeStackPtr = simNativeStackPtr.
self assert: fixup simNativeStackSize = simNativeStackSize]]].
fixup recordBcpc: bytecodePC.
^fixup!
Item was changed:
----- Method: StackToRegisterMappingCogit>>ensureNonMergeFixupAt: (in category 'compile abstract instructions') -----
+ ensureNonMergeFixupAt: targetPC
+ "Make sure there's a flagged fixup at the target pc in fixups.
- ensureNonMergeFixupAt: targetIndex
- "Make sure there's a flagged fixup at the targetIndex (pc relative to first pc) in fixups.
Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction."
<returnTypeC: #'BytecodeFixup *'>
| fixup |
<var: #fixup type: #'BytecodeFixup *'>
+ fixup := self fixupAt: targetPC - initialPC.
- fixup := self fixupAt: targetIndex.
fixup notAFixup ifTrue:
[fixup becomeNonMergeFixup].
self cCode: '' inSmalltalk:
[fixup isMergeFixupOrIsFixedUp ifTrue:
[self assert:
(fixup isBackwardBranchFixup
+ or: [fixup simStackPtr = (self debugStackPointerFor: targetPC)])]].
- or: [fixup simStackPtr = (self debugStackPointerFor: targetIndex + initialPC)])]].
fixup recordBcpc: bytecodePC.
^fixup!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genForwardersInlinedIdenticalOrNotIf: orNot
| nextPC branchDescriptor unforwardRcvr argReg targetBytecodePC
unforwardArg rcvrReg postBranchPC label fixup |
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #label type: #'AbstractInstruction *'>
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
"If an operand is an annotable constant, it may be forwarded, so we need to store it into a
register so the forwarder check can jump back to the comparison after unforwarding the constant.
However, if one of the operand is an unnanotable constant, does not allocate a register for it
(machine code will use operations on constants) and does not generate forwarder checks."
unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
self
allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
rcvrNeedsReg: unforwardRcvr
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
"If not followed by a branch, resolve to true or false."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: unforwardArg not
rcvrIsConstant: unforwardRcvr not
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
"If branching the stack must be flushed for the merge"
self ssFlushTo: simStackPtr - 2.
label := self Label.
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"Further since there is a following conditional jump bytecode, define
non-merge fixups and leave the cond bytecode to set the mergeness."
(self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
+ self ensureFixupAt: targetBytecodePC.
+ self ensureFixupAt: postBranchPC]
- self ensureFixupAt: targetBytecodePC - initialPC.
- self ensureFixupAt: postBranchPC - initialPC]
ifFalse:
[self deny: deadCode]. "push dummy value below"
self assert: (unforwardArg or: [unforwardRcvr]).
orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
ifFalse:
+ [ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
- [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
ifTrue:
+ [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger ].
- [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ].
deadCode ifFalse:
[self ssPushConstant: objectMemory trueObject]. "dummy value"
"The forwarders checks need to jump back to the comparison (label) if a forwarder is found, else
jump forward either to the next forwarder check or to the postBranch or branch target (fixup)."
unforwardArg ifTrue:
[ unforwardRcvr
ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: label ]
ifFalse: [ objectRepresentation
genEnsureOopInRegNotForwarded: argReg
scratchReg: TempReg
ifForwarder: label
ifNotForwarder: fixup ] ].
unforwardRcvr ifTrue:
[ objectRepresentation
genEnsureOopInRegNotForwarded: rcvrReg
scratchReg: TempReg
ifForwarder: label
ifNotForwarder: fixup ].
"Not reached, execution flow have jumped to fixup"
^0!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
genJumpIf: boolean to: targetBytecodePC
<inline: false>
| desc fixup ok eventualTarget |
<var: #desc type: #'CogSimStackEntry *'>
<var: #fixup type: #'BytecodeFixup *'>
<var: #ok type: #'AbstractInstruction *'>
eventualTarget := self eventualTargetOf: targetBytecodePC.
self ssFlushTo: simStackPtr - 1.
desc := self ssTop.
self ssPop: 1.
(desc type == SSConstant
and: [desc constant = objectMemory trueObject or: [desc constant = objectMemory falseObject]]) ifTrue:
["Must arrange there's a fixup at the target whether it is jumped to or
not so that the simStackPtr can be kept correct."
+ fixup := self ensureFixupAt: eventualTarget.
- fixup := self ensureFixupAt: eventualTarget - initialPC.
"Must annotate the bytecode for correct pc mapping."
self annotateBytecode: (desc constant = boolean
ifTrue: [self Jump: fixup]
ifFalse: [self prevInstIsPCAnnotated
ifTrue: [self Nop]
ifFalse: [self Label]]).
extA := 0.
^0].
desc popToReg: TempReg.
"Cunning trick by LPD. If true and false are contiguous subtract the smaller.
Correct result is either 0 or the distance between them. If result is not 0 or
their distance send mustBeBoolean."
self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
self genSubConstant: boolean R: TempReg.
+ self JumpZero: (self ensureFixupAt: eventualTarget).
- self JumpZero: (self ensureFixupAt: eventualTarget - initialPC).
self extASpecifiesNoMustBeBoolean ifTrue:
[ extA := 0.
self annotateBytecode: self lastOpcode.
^ 0].
extA := 0.
self CmpCq: (boolean = objectMemory falseObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: TempReg.
ok := self JumpZero: 0.
self genCallMustBeBooleanFor: boolean.
ok jmpTarget: (self annotateBytecode: self Label).
^0!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genJumpTo: (in category 'bytecode generator support') -----
genJumpTo: targetBytecodePC
self ssFlushTo: simStackPtr.
deadCode := true. "can't fall through"
+ self Jump: (self ensureFixupAt: (self eventualTargetOf: targetBytecodePC)).
- self Jump: (self ensureFixupAt: (self eventualTargetOf: targetBytecodePC) - initialPC).
^0!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
genSpecialSelectorComparison
| nextPC postBranchPC targetBytecodePC primDescriptor branchDescriptor
rcvrIsInt argIsInt argInt jumpNotSmallInts inlineCAB index |
<var: #primDescriptor type: #'BytecodeDescriptor *'>
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
self ssFlushTo: simStackPtr - 2.
primDescriptor := self generatorAt: byte0.
argIsInt := self ssTop type = SSConstant
and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
rcvrIsInt := (self ssValue: 1) type = SSConstant
and: [objectMemory isIntegerObject: (self ssValue: 1) constant].
(argIsInt and: [rcvrIsInt]) ifTrue:
[^ self genStaticallyResolvedSpecialSelectorComparison].
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
"Only interested in inlining if followed by a conditional branch."
inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse].
"Further, only interested in inlining = and ~= if there's a SmallInteger constant involved.
The relational operators successfully statically predict SmallIntegers; the equality operators do not."
(inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue:
[inlineCAB := argIsInt or: [rcvrIsInt]].
inlineCAB ifFalse:
[^self genSpecialSelectorSend].
argIsInt
ifTrue:
[(self ssValue: 1) popToReg: ReceiverResultReg.
self ssPop: 2.
self MoveR: ReceiverResultReg R: TempReg]
ifFalse:
[self marshallSendArguments: 1.
self MoveR: Arg0Reg R: TempReg].
jumpNotSmallInts := (argIsInt or: [rcvrIsInt])
ifTrue: [objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg]
ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: ReceiverResultReg andScratch: TempReg scratch: ClassReg].
argIsInt
ifTrue: [self CmpCq: argInt R: ReceiverResultReg]
ifFalse: [self CmpR: Arg0Reg R: ReceiverResultReg].
"Cmp is weird/backwards so invert the comparison. Further since there is a following conditional
jump bytecode define non-merge fixups and leave the cond bytecode to set the mergeness."
self genConditionalBranch: (branchDescriptor isBranchTrue
ifTrue: [primDescriptor opcode]
ifFalse: [self inverseBranchFor: primDescriptor opcode])
+ operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
+ self Jump: (self ensureNonMergeFixupAt: postBranchPC).
- operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC).
jumpNotSmallInts jmpTarget: self Label.
argIsInt ifTrue:
[self MoveCq: argInt R: Arg0Reg].
index := byte0 - self firstSpecialSelectorBytecodeOffset.
^self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genVanillaInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genVanillaInlinedIdenticalOrNotIf: orNot
| nextPC postBranchPC targetBytecodePC branchDescriptor
rcvrReg argReg argIsConstant rcvrIsConstant |
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
argIsConstant := self ssTop type = SSConstant.
"They can't be both constants to use correct machine opcodes.
However annotable constants can't be resolved statically, hence we need to careful."
rcvrIsConstant := argIsConstant not and: [(self ssValue: 1) type = SSConstant].
self
allocateEqualsEqualsRegistersArgNeedsReg: argIsConstant not
rcvrNeedsReg: rcvrIsConstant not
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
"If not followed by a branch, resolve to true or false."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: argIsConstant
rcvrIsConstant: rcvrIsConstant
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
"If branching the stack must be flushed for the merge"
self ssFlushTo: simStackPtr - 2.
self genCmpArgIsConstant: argIsConstant rcvrIsConstant: rcvrIsConstant argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"Further since there is a following conditional jump bytecode, define
non-merge fixups and leave the cond bytecode to set the mergeness."
(self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
+ self ensureFixupAt: targetBytecodePC.
+ self ensureFixupAt: postBranchPC]
- self ensureFixupAt: targetBytecodePC - initialPC.
- self ensureFixupAt: postBranchPC - initialPC]
ifFalse:
[self deny: deadCode]. "push dummy value below"
self genConditionalBranch: (orNot == branchDescriptor isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero])
+ operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
- operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
"If the branch is dead, then we can just fall through postBranchPC (only a nop in-between), else
we need to jump over the code of the branch"
deadCode ifFalse:
+ [self Jump: (self ensureNonMergeFixupAt: postBranchPC).
- [self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC).
self ssPushConstant: objectMemory trueObject]. "dummy value"
^0!
Item was added:
+ ----- Method: TInlineNode>>nodesDo:parent: (in category 'enumerating') -----
+ nodesDo: aBlock parent: parent
+ "Apply aBlock to all nodes in the receiver with each node's parent.
+ N.B. This is assumed to be bottom-up, leaves first."
+ method parseTree nodesDo: aBlock parent: self.
+ aBlock value: self value: parent!
Item was added:
+ ----- Method: TMethod>>readsVariable: (in category 'accessing') -----
+ readsVariable: variableName
+ "Answer if the receiver reads the variable (i.e. ignore assignments to the variable)."
+ parseTree nodesWithParentsDo:
+ [:node :parent|
+ (node isVariable
+ and: [node name = variableName]) ifTrue:
+ [(parent notNil
+ and: [parent isAssignment
+ and: [node == parent variable]]) ifFalse:
+ [^true]]].
+ ^false!
Item was added:
+ ----- Method: VMClass class>>simulatorClass (in category 'simulation') -----
+ simulatorClass
+ "For running from Smalltalk - answer a class that can be used to simulate the receiver."
+
+ ^self!
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscogSPC-eem.2125.mcz
==================== Summary ====================
Name: VMMaker.oscogSPC-eem.2125
Author: eem
Time: 8 February 2017, 5:30:53.044288 pm
UUID: c99756cb-c65f-480e-86bb-408657e31e7c
Ancestors: VMMaker.oscogSPC-eem.2124, VMMaker.oscog-cb.2117
Merge with VMMaker.oscog-cb.2117.
Better code for RegisterAllocatingCogit popStoreTemp of a constant.
=============== Diff against VMMaker.oscogSPC-eem.2124 ===============
Item was changed:
----- Method: CoInterpreter>>ceCannotAssignTo:withIndex:valueToAssign: (in category 'trampolines') -----
ceCannotAssignTo: immutableObject withIndex: index valueToAssign: valueToAssign
+ "index is unboxed and 0-based. The call-back expects 1-based value (to perform the operation with instVarAt:put:"
- "index is unboxed."
<api>
<option: #IMMUTABILITY>
instructionPointer := self popStack.
self push: immutableObject.
self push: valueToAssign.
+ self push: (objectMemory integerObjectOf: index + 1).
- self push: (objectMemory integerObjectOf: index).
self push: instructionPointer.
^ self
ceSendAbort: (objectMemory splObj: SelectorAttemptToAssign)
to: immutableObject
numArgs: 2!
Item was changed:
----- Method: RegisterAllocatingCogit>>genStorePop:TemporaryVariable: (in category 'bytecode generator support') -----
genStorePop: popBoolean TemporaryVariable: tempIndex
<inline: false>
| srcRegOrNone destReg |
self ssFlushUpThroughTemporaryVariable: tempIndex.
"To avoid a stall writing through destReg, remember srcReg before the potential ssPop: 1 in ssStorePop:toReg:"
srcRegOrNone := self ssTop registerOrNone.
"ssStorePop:toPreferredReg: will allocate a register, and indeed may allocate ReceiverResultReg
if, for example, the ssEntry to be popped is already in ReceiverResultReg (as the result of a send).
ReceiverResultReg is not a good choice for a temporary variable; it has other uses. So if the ssEntry
at top of stack has ReceiverResultReg as its live variable, try and allocate an alternative."
+ ((self ssTop type = SSConstant
+ or: [self ssTop registerMaskOrNone anyMask: self registerMaskUndesirableForTempVars])
- ((self ssTop registerMaskOrNone anyMask: self registerMaskUndesirableForTempVars)
and: [(destReg := self availableRegOrNoneNotConflictingWith: (self registerMaskUndesirableForTempVars bitOr: self liveRegisters)) ~= NoReg])
ifTrue: [self ssStorePop: popBoolean toReg: destReg]
ifFalse: [destReg := self ssStorePop: popBoolean toPreferredReg: TempReg].
self MoveR: (srcRegOrNone ~= NoReg ifTrue: [srcRegOrNone] ifFalse: [destReg])
Mw: (self frameOffsetOfTemporary: tempIndex)
r: FPReg.
destReg ~= TempReg ifTrue:
[(self simStackAt: tempIndex) liveRegister: destReg.
self copyLiveRegisterToCopiesOf: (self simStackAt: tempIndex)].
^0!
1
0
Hi,
Is it true that the Windows version the of OSProcess plugin does not
support running a process in a different directory than the one in
which the VM itself runs?
I found primGetCurrentWorkingDirectory, but no setter equivalent.
There are accessors for pwd in ExternalWindowsOSProcess, but the value
is never used. Disappointing decoy...
The two primitives calling CreateProcess only supply NULL for the
lpCurrentDirectory parameter.
Have I missed something? I could not imagine that the requirement to
run a process in another directory under Windows did never arise for
anybody.
Kind regards,
Jakob
2
2
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscogSPC-eem.2124.mcz
==================== Summary ====================
Name: VMMaker.oscogSPC-eem.2124
Author: eem
Time: 7 February 2017, 6:30:18.710736 pm
UUID: 22d143af-9360-4d0d-9f4a-598e85c9970b
Ancestors: VMMaker.oscogSPC-eem.2123
Cogit:
Refactor sends of ensure[NonMerge]FixupAt:, moving the ever-present "- initialPC" into ensure[NonMerge]FixupAt:.
=============== Diff against VMMaker.oscogSPC-eem.2123 ===============
Item was changed:
----- Method: Cogit>>ensureFixupAt: (in category 'compile abstract instructions') -----
+ ensureFixupAt: targetPC
+ "Make sure there's a flagged fixup at the target pc in fixups.
- ensureFixupAt: targetIndex
- "Make sure there's a flagged fixup at the targetIndex (pc relative to first pc) in fixups.
Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction."
<returnTypeC: #'BytecodeFixup *'>
| fixup |
<var: #fixup type: #'BytecodeFixup *'>
+ fixup := self fixupAt: targetPC - initialPC.
- fixup := self fixupAt: targetIndex.
fixup notAFixup ifTrue:
[fixup becomeFixup].
fixup recordBcpc: bytecodePC.
^fixup!
Item was changed:
----- Method: RegisterAllocatingCogit>>ensureFixupAt: (in category 'bytecode generator support') -----
+ ensureFixupAt: targetPC
+ "Make sure there's a flagged fixup at the target pc in fixups.
+ Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction.
+ Override to enerate stack merging code if required."
- ensureFixupAt: targetIndex
| fixup |
<var: #fixup type: #'BytecodeFixup *'>
+ fixup := self fixupAt: targetPC - initialPC.
- fixup := self fixupAt: targetIndex.
fixup needsFixup
ifTrue:
[fixup mergeSimStack
ifNil: [self setMergeSimStackOf: fixup]
ifNotNil: [self mergeCurrentSimStackWith: fixup]]
ifFalse:
[self assert: fixup mergeSimStack isNil.
+ self moveVolatileSimStackEntriesToRegisters.
+ self setMergeSimStackOf: fixup].
+ ^super ensureFixupAt: targetPC!
- self moveVolatileSimStackEntriesToRegisters.
- self setMergeSimStackOf: fixup].
- ^super ensureFixupAt: targetIndex!
Item was changed:
----- Method: RegisterAllocatingCogit>>ensureNonMergeFixupAt: (in category 'compile abstract instructions') -----
+ ensureNonMergeFixupAt: targetPC
+ "Make sure there's a flagged fixup at the target pc in fixups.
+ Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction.
+ Override to remember the simStack state at tyeh target, if required."
- ensureNonMergeFixupAt: targetIndex
- "Make sure there's a flagged fixup at the targetIndex (pc relative to first pc) in fixups.
- Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction."
| fixup |
+ fixup := super ensureNonMergeFixupAt: targetPC.
- fixup := super ensureNonMergeFixupAt: targetIndex.
fixup mergeSimStack ifNil: [self setMergeSimStackOf: fixup].
^fixup!
Item was changed:
----- Method: RegisterAllocatingCogit>>genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode (in category 'bytecode generators') -----
genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode
"SistaV1: * 254 11111110 kkkkkkkk jjjjjjjj branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
| reg literal distance targetFixUp |
reg := self allocateRegForStackEntryAt: 0.
self ssTop popToReg: reg.
literal := self getLiteral: (extA * 256 + byte1).
extA := 0.
distance := extB * 256 + byte2.
extB := 0.
numExtB := 0.
"Because ensureFixupAt: will generate code to merge with the target simStack when required, it is
necessary to tease apart the jump and the merge so that the merge code is only executed if the
branch is taken. i.e. if merge code is required we generate
jump not cond Lcontinue
... merge code ...
jump Ltarget
Lcontinue:
instead of the incorrect
... merge code ...
jump cond Ltarget"
+ (self mergeRequiredForJumpTo: bytecodePC + 3 + distance) ifTrue:
- (self mergeRequiredForJumpTo: bytecodePC + 3 + distance - initialPC) ifTrue:
[self shouldBeImplemented].
+ targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance) to: #'AbstractInstruction *'.
- targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
(objectMemory isArrayNonImm: literal)
ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp].
self ssPop: 1.
^0!
Item was changed:
----- Method: RegisterAllocatingCogit>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genForwardersInlinedIdenticalOrNotIf: orNot
| nextPC branchDescriptor unforwardRcvr argReg targetBytecodePC
unforwardArg rcvrReg postBranchPC label fixup |
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #label type: #'AbstractInstruction *'>
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
"If an operand is an annotable constant, it may be forwarded, so we need to store it into a
register so the forwarder check can jump back to the comparison after unforwarding the constant.
However, if one of the operand is an unnanotable constant, does not allocate a register for it
(machine code will use operations on constants) and does not generate forwarder checks."
unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
self
allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
rcvrNeedsReg: unforwardRcvr
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
"If not followed by a branch, resolve to true or false."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: unforwardArg not
rcvrIsConstant: unforwardRcvr not
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
label := self Label.
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
+ "For now just deny we're in the situation we have yet to implement ;-)
+ self printSimStack; printSimStack: (self fixupAt: postBranchPC - initialPC) mergeSimStack"
- "For now just deny we're in the situation we have yet to implement ;-)"
self deny: (self mergeRequiredForJumpTo: targetBytecodePC).
self deny: (self mergeRequiredForJumpTo: postBranchPC).
"Further since there is a following conditional jump bytecode, define
non-merge fixups and leave the cond bytecode to set the mergeness."
(self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
+ self ensureFixupAt: targetBytecodePC.
+ self ensureFixupAt: postBranchPC]
- self ensureFixupAt: targetBytecodePC - initialPC.
- self ensureFixupAt: postBranchPC - initialPC]
ifFalse:
[self deny: deadCode]. "push dummy value below"
self assert: (unforwardArg or: [unforwardRcvr]).
orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
ifFalse: "branchDescriptor is branchFalse"
+ [ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
- [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
ifTrue:
+ [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger ].
- [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ].
deadCode ifFalse:
[self ssPushConstant: objectMemory trueObject]. "dummy value"
"The forwarders checks need to jump back to the comparison (label) if a forwarder is found, else
jump forward either to the next forwarder check or to the postBranch or branch target (fixup)."
unforwardArg ifTrue:
[ unforwardRcvr
ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: label ]
ifFalse: [ objectRepresentation
genEnsureOopInRegNotForwarded: argReg
scratchReg: TempReg
ifForwarder: label
ifNotForwarder: fixup ] ].
unforwardRcvr ifTrue:
[ objectRepresentation
genEnsureOopInRegNotForwarded: rcvrReg
scratchReg: TempReg
ifForwarder: label
ifNotForwarder: fixup ].
"Not reached, execution flow have jumped to fixup"
^0!
Item was changed:
----- Method: RegisterAllocatingCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
genJumpIf: boolean to: targetBytecodePC
<inline: false>
| eventualTarget desc reg fixup ok mbb noMustBeBoolean |
<var: #fixup type: #'BytecodeFixup *'>
<var: #ok type: #'AbstractInstruction *'>
<var: #desc type: #'CogSimStackEntry *'>
<var: #mbb type: #'AbstractInstruction *'>
eventualTarget := self eventualTargetOf: targetBytecodePC.
desc := self ssTop.
self ssPop: 1.
noMustBeBoolean := self extASpecifiesNoMustBeBoolean.
extA := 0.
(desc type == SSConstant
and: [desc constant = objectMemory trueObject or: [desc constant = objectMemory falseObject]]) ifTrue:
["Must annotate the bytecode for correct pc mapping."
desc constant = boolean
ifTrue:
[deadCode := true. "Can't fall through."
+ fixup := self ensureFixupAt: eventualTarget.
- fixup := self ensureFixupAt: eventualTarget - initialPC.
self annotateBytecode: (self Jump: fixup)]
ifFalse:
[self annotateBytecode: (self prevInstIsPCAnnotated
ifTrue: [self Nop]
ifFalse: [self Label])].
^0].
"try and use the top entry's register if any, but only if it can be destroyed."
reg := (desc type ~= SSRegister
or: [(self anyReferencesToRegister: desc register inAllButTopNItems: 0)
or: [(desc register = ReceiverResultReg and: [optStatus isReceiverResultRegLive])]])
ifTrue: [TempReg]
ifFalse: [desc register].
desc popToReg: reg.
"Cunning trick by LPD. If true and false are contiguous subtract the smaller.
Correct result is either 0 or the distance between them. If result is not 0 or
their distance send mustBeBoolean."
self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
"Merge required; must not generate merge code along untaken branch, so flip the order."
(self mergeRequiredForJumpTo: eventualTarget)
ifTrue:
[self genSubConstant: (boolean = objectMemory trueObject
ifTrue: [objectMemory falseObject]
ifFalse: [objectMemory trueObject])
R: reg.
ok := self JumpZero: 0.
self CmpCq: (boolean = objectMemory trueObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: reg.
noMustBeBoolean ifTrue:
+ [self JumpZero: (self ensureFixupAt: eventualTarget). "generates merge code"
- [self JumpZero: (self ensureFixupAt: eventualTarget - initialPC). "generates merge code"
ok jmpTarget: (self annotateBytecode: self lastOpcode).
^0].
mbb := self JumpNonZero: 0.
+ self Jump: (self ensureFixupAt: eventualTarget). "generates merge code"
- self Jump: (self ensureFixupAt: eventualTarget - initialPC). "generates merge code"
mbb jmpTarget: self Label]
ifFalse:
[self genSubConstant: boolean R: reg.
+ self JumpZero: (self ensureFixupAt: eventualTarget).
- self JumpZero: (self ensureFixupAt: eventualTarget - initialPC).
noMustBeBoolean ifTrue:
[self annotateBytecode: self lastOpcode.
^0].
self CmpCq: (boolean = objectMemory falseObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: reg.
ok := self JumpZero: 0].
reg ~= TempReg ifTrue:
[self MoveR: reg R: TempReg].
self copySimStackToScratch: simSpillBase.
self ssFlushTo: simStackPtr.
self genCallMustBeBooleanFor: boolean.
"NOTREACHED"
ok jmpTarget: (self annotateBytecode: self Label).
self restoreSimStackFromScratch.
^0!
Item was changed:
----- Method: RegisterAllocatingCogit>>genJumpTo: (in category 'bytecode generator support') -----
genJumpTo: targetBytecodePC
"Overriden to avoid the flush because in this cogit stack state is merged at merge point."
deadCode := true. "can't fall through"
+ self Jump: (self ensureFixupAt: (self eventualTargetOf: targetBytecodePC)).
- self Jump: (self ensureFixupAt: (self eventualTargetOf: targetBytecodePC) - initialPC).
^ 0!
Item was changed:
----- Method: RegisterAllocatingCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
genSpecialSelectorComparison
| nextPC postBranchPC targetBytecodePC primDescriptor branchDescriptor
rcvrIsInt argIsInt argInt jumpNotSmallInts inlineCAB index rcvrReg argReg |
<var: #primDescriptor type: #'BytecodeDescriptor *'>
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
primDescriptor := self generatorAt: byte0.
argIsInt := self ssTop type = SSConstant
and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
rcvrIsInt := (self ssValue: 1) type = SSConstant
and: [objectMemory isIntegerObject: (self ssValue: 1) constant].
(argIsInt and: [rcvrIsInt]) ifTrue:
[^self genStaticallyResolvedSpecialSelectorComparison].
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
"Only interested in inlining if followed by a conditional branch."
inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse].
"Further, only interested in inlining = and ~= if there's a SmallInteger constant involved.
The relational operators successfully statically predict SmallIntegers; the equality operators do not."
(inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue:
[inlineCAB := argIsInt or: [rcvrIsInt]].
inlineCAB ifFalse:
[^self genSpecialSelectorSend].
"In-line the comparison and the jump, but if the types are not SmallInteger then we will need
to do a send and fall through to the following conditional branch. Since we're allocating values
in registers we would like to keep those registers live on the inlined path and reload registers
along the non-inlined send path. The merge logic at the branch destinations handles this."
argIsInt
ifTrue:
[rcvrReg := self allocateRegForStackEntryAt: 1.
(self ssValue: 1) popToReg: rcvrReg.
self MoveR: rcvrReg R: TempReg]
ifFalse:
[self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext| argReg := rTop. rcvrReg := rNext].
rcvrReg = Arg0Reg ifTrue:
[rcvrReg := argReg. argReg := Arg0Reg].
self ssTop popToReg: argReg.
(self ssValue: 1) popToReg: rcvrReg.
self MoveR: argReg R: TempReg].
self ssPop: 2.
jumpNotSmallInts := (argIsInt or: [rcvrIsInt])
ifTrue: [objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg]
ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: rcvrReg andScratch: TempReg scratch: ClassReg].
argIsInt
ifTrue: [self CmpCq: argInt R: rcvrReg]
ifFalse: [self CmpR: argReg R: rcvrReg].
"For now just deny we're in the situation we have yet to implement ;-)"
self deny: (self mergeRequiredForJumpTo: targetBytecodePC).
self deny: (self mergeRequiredForJumpTo: postBranchPC).
"Cmp is weird/backwards so invert the comparison. Further since there is a following conditional
jump bytecode define non-merge fixups and leave the cond bytecode to set the mergeness."
self genConditionalBranch: (branchDescriptor isBranchTrue
ifTrue: [primDescriptor opcode]
ifFalse: [self inverseBranchFor: primDescriptor opcode])
+ operand: (self ensureFixupAt: targetBytecodePC) asUnsignedInteger.
+ self Jump: (self ensureFixupAt: postBranchPC).
- operand: (self ensureFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- self Jump: (self ensureFixupAt: postBranchPC - initialPC).
jumpNotSmallInts jmpTarget: self Label.
self ssFlushTo: simStackPtr.
self deny: rcvrReg = Arg0Reg.
argIsInt
ifTrue: [self MoveCq: argInt R: Arg0Reg]
ifFalse: [argReg ~= Arg0Reg ifTrue: [self MoveR: argReg R: Arg0Reg]].
rcvrReg ~= ReceiverResultReg ifTrue: [self MoveR: rcvrReg R: ReceiverResultReg].
index := byte0 - self firstSpecialSelectorBytecodeOffset.
^self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines!
Item was changed:
----- Method: RegisterAllocatingCogit>>genVanillaInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genVanillaInlinedIdenticalOrNotIf: orNot
| nextPC postBranchPC targetBytecodePC branchDescriptor
rcvrReg argReg argIsConstant rcvrIsConstant |
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
argIsConstant := self ssTop type = SSConstant.
"They can't be both constants to use correct machine opcodes.
However annotable constants can't be resolved statically, hence we need to careful."
rcvrIsConstant := argIsConstant not and: [(self ssValue: 1) type = SSConstant].
self
allocateEqualsEqualsRegistersArgNeedsReg: argIsConstant not
rcvrNeedsReg: rcvrIsConstant not
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
"If not followed by a branch, resolve to true or false."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: argIsConstant
rcvrIsConstant: rcvrIsConstant
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
self genCmpArgIsConstant: argIsConstant rcvrIsConstant: rcvrIsConstant argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"For now just deny we're in the situation we have yet to implement ;-)"
self deny: (self mergeRequiredForJumpTo: targetBytecodePC).
self deny: (self mergeRequiredForJumpTo: postBranchPC).
"Further since there is a following conditional jump bytecode, define
non-merge fixups and leave the cond bytecode to set the mergeness."
(self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
+ self ensureFixupAt: targetBytecodePC.
+ self ensureFixupAt: postBranchPC]
- self ensureFixupAt: targetBytecodePC - initialPC.
- self ensureFixupAt: postBranchPC - initialPC]
ifFalse:
[self deny: deadCode]. "push dummy value below"
self genConditionalBranch: (orNot == branchDescriptor isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero])
+ operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
- operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
"If the branch is dead, then we can just fall through postBranchPC (only a nop in-between), else
we need to jump over the code of the branch"
deadCode ifFalse:
+ [self Jump: (self ensureNonMergeFixupAt: postBranchPC).
- [self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC).
self ssPushConstant: objectMemory trueObject]. "dummy value"
^0!
Item was changed:
----- Method: RegisterAllocatingCogit>>mergeRequiredForJumpTo: (in category 'bytecode generator support') -----
+ mergeRequiredForJumpTo: targetPC
- mergeRequiredForJumpTo: target
"While this is a multi-pass compiler, no intermediate control-flow graph is built from bytecode and
there is a monotonically increasing one-to-one relationship between bytecode pcs and machine
code pcs that map to one another. Therefore, when jumping forward, any required code to merge
the state of the current simStack with that at the target must be generated before the jump
(because at the target the simStack state will be whatever falls through). If only one forward jump
to the target exists then that jump can simply install its simStack as the required simStack at the
target and the merge code wil be generated just before the target as control falls through. But if
there are two or more forward jumps to the target, a situation that occurs given that the
StackToRegisterMappingCogit follows jump chains, then jumps other than the first must generate
merge code before jumping. This poses a problem for conditional branches. The merge code must
only be generated along the path that takes the jump Therefore this must *not* be generated:
... merge code ...
jump cond Ltarget
which incorrectly executes the merge code along both the taken and untaken paths. Instead
this must be generated so that the merge code is only executed if the branch is taken.
jump not cond Lcontinue
... merge code ...
jump Ltarget
Lcontinue:
Note that no merge code is required for code such as self at: (expr ifTrue: [1] ifFalse: [2])
17 <70> self
18 <71> pushConstant: true
19 <99> jumpFalse: 22
20 <76> pushConstant: 1
21 <90> jumpTo: 23
22 <77> pushConstant: 2
23 <C0> send: at:
provided that 1 and 2 are assigned to the same target register."
self flag: 'be lazy for now; this needs more work to ignore compatible sim stacks'.
+ ^(self fixupAt: targetPC - initialPC) hasMergeSimStack!
- ^(self fixupAt: target - initialPC) hasMergeSimStack!
Item was changed:
----- Method: SimpleStackBasedCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
genJumpIf: boolean to: targetBytecodePC
<inline: false>
"Cunning trick by LPD. If true and false are contiguous subtract the smaller.
Correct result is either 0 or the distance between them. If result is not 0 or
their distance send mustBeBoolean."
| ok |
<var: #ok type: #'AbstractInstruction *'>
extA := 0.
self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
self PopR: TempReg.
self genSubConstant: boolean R: TempReg.
+ self JumpZero: (self ensureFixupAt: targetBytecodePC).
- self JumpZero: (self ensureFixupAt: targetBytecodePC - initialPC).
self CmpCq: (boolean == objectMemory falseObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: TempReg.
ok := self JumpZero: 0.
self genCallMustBeBooleanFor: boolean.
ok jmpTarget: (self annotateBytecode: self Label).
^0!
Item was changed:
----- Method: SimpleStackBasedCogit>>genJumpTo: (in category 'bytecode generator support') -----
genJumpTo: targetBytecodePC
+ self Jump: (self ensureFixupAt: targetBytecodePC).
- self Jump: (self ensureFixupAt: targetBytecodePC - initialPC).
^0!
Item was changed:
----- Method: SistaCogit>>genBinaryInlineComparison:opFalse:destReg: (in category 'inline primitive generators') -----
genBinaryInlineComparison: opTrue opFalse: opFalse destReg: destReg
"Inlined comparison. opTrue = jump for true and opFalse = jump for false"
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
| nextPC branchDescriptor targetBytecodePC postBranchPC |
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse])
ifTrue: "This is the path where the inlined comparison is followed immediately by a branch"
[ (self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
+ self ensureFixupAt: targetBytecodePC.
+ self ensureFixupAt: postBranchPC ]
- self ensureFixupAt: targetBytecodePC - initialPC.
- self ensureFixupAt: postBranchPC - initialPC ]
ifFalse:
[self ssPushConstant: objectMemory trueObject]. "dummy value"
self genConditionalBranch: (branchDescriptor isBranchTrue ifTrue: [opTrue] ifFalse: [opFalse])
+ operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
- operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
"We can only elide the jump if the pc after nextPC is the same as postBranchPC.
Branch following means it may not be."
self nextDescriptorExtensionsAndNextPCInto:
[:iguana1 :iguana2 :iguana3 :followingPC| nextPC := followingPC].
(deadCode and: [nextPC = postBranchPC]) ifFalse:
+ [ self Jump: (self ensureNonMergeFixupAt: postBranchPC) ] ]
- [ self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC) ] ]
ifFalse: "This is the path where the inlined comparison is *not* followed immediately by a branch"
[| condJump jump |
condJump := self genConditionalBranch: opTrue operand: 0.
self genMoveFalseR: destReg.
jump := self Jump: 0.
condJump jmpTarget: (self genMoveTrueR: destReg).
jump jmpTarget: self Label].
^ 0!
Item was changed:
----- Method: SistaCogit>>genCounterTripOnlyJumpIf:to: (in category 'bytecode generator support') -----
genCounterTripOnlyJumpIf: boolean to: targetBytecodePC
"Specific version if the branch is only reached while falling through if the counter trips after an inlined #== branch. We do not regenerate the counter logic in this case to avoid 24 bytes instructions."
<var: #ok type: #'AbstractInstruction *'>
<var: #mustBeBooleanTrampoline type: #'AbstractInstruction *'>
| ok mustBeBooleanTrampoline |
extA := 0.
self ssFlushTo: simStackPtr - 1.
self ssTop popToReg: TempReg.
self ssPop: 1.
counterIndex := counterIndex + 1. "counters are increased / decreased in the inlined branch"
"We need SendNumArgsReg because of the mustBeBooleanTrampoline"
self ssAllocateRequiredReg: SendNumArgsReg.
self MoveCq: 1 R: SendNumArgsReg.
"The first time this is reached, it calls necessarily the counter trip for the trampoline because SendNumArgsReg is non zero"
mustBeBooleanTrampoline := self genCallMustBeBooleanFor: boolean.
self annotateBytecode: self Label.
"Cunning trick by LPD. If true and false are contiguous subtract the smaller.
Correct result is either 0 or the distance between them. If result is not 0 or
their distance send mustBeBoolean."
self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
self genSubConstant: boolean R: TempReg.
+ self JumpZero: (self ensureFixupAt: targetBytecodePC).
- self JumpZero: (self ensureFixupAt: targetBytecodePC - initialPC).
self CmpCq: (boolean = objectMemory falseObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: TempReg.
ok := self JumpZero: 0.
self MoveCq: 0 R: SendNumArgsReg. "if counterReg is 0 this is a mustBeBoolean, not a counter trip."
self Jump: mustBeBooleanTrampoline.
ok jmpTarget: self Label.
^0!
Item was changed:
----- Method: SistaCogit>>genExtJumpIfNotInstanceOfBehaviorsBytecode (in category 'bytecode generators') -----
genExtJumpIfNotInstanceOfBehaviorsBytecode
"SistaV1: * 254 11111110 kkkkkkkk jjjjjjjj branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
| reg literal distance targetFixUp inverse |
"We lose the information of in which register is stack top
when jitting the branch target so we need to flush everything.
We could use a fixed register here...."
reg := self allocateRegForStackEntryAt: 0.
self ssTop popToReg: reg.
self ssPop: 1.
self ssFlushTo: simStackPtr. "flushed but the value is still in reg"
literal := self getLiteral: (extA * 256 + byte1).
(inverse := extB < 0) ifTrue:
[extB := extB + 128].
distance := extB * 256 + byte2.
extA := extB := numExtB := 0.
+ targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance) to: #'AbstractInstruction *'.
- targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
inverse
ifFalse:
[(objectMemory isArrayNonImm: literal)
ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp] ]
ifTrue:
[(objectMemory isArrayNonImm: literal)
ifTrue: [objectRepresentation branchIf: reg instanceOfBehaviors: literal target: targetFixUp]
ifFalse: [objectRepresentation branchIf: reg instanceOfBehavior: literal target: targetFixUp]].
^0!
Item was changed:
----- Method: SistaCogit>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genForwardersInlinedIdenticalOrNotIf: orNot
"Override to count inlined branches if followed by a conditional branch.
We borrow the following conditional branch's counter and when about to
inline the comparison we decrement the counter (without writing it back)
and if it trips simply abort the inlining, falling back to the normal send which
will then continue to the conditional branch which will trip and enter the abort."
| nextPC postBranchPC targetBytecodePC branchDescriptor counterReg fixup jumpEqual jumpNotEqual
counterAddress countTripped unforwardArg unforwardRcvr argReg rcvrReg regMask |
<var: #fixup type: #'BytecodeFixup *'>
<var: #countTripped type: #'AbstractInstruction *'>
<var: #label type: #'AbstractInstruction *'>
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #jumpEqual type: #'AbstractInstruction *'>
<var: #jumpNotEqual type: #'AbstractInstruction *'>
((coInterpreter isOptimizedMethod: methodObj) or: [needsFrame not]) ifTrue:
[^super genForwardersInlinedIdenticalOrNotIf: orNot].
regMask := 0.
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
"If an operand is an annotable constant, it may be forwarded, so we need to store it into a
register so the forwarder check can jump back to the comparison after unforwarding the constant.
However, if one of the operand is an unnanotable constant, does not allocate a register for it
(machine code will use operations on constants)."
rcvrReg:= argReg := NoReg.
self
allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
rcvrNeedsReg: unforwardRcvr
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
argReg ~= NoReg ifTrue: [ regMask := self registerMaskFor: argReg ].
rcvrReg ~= NoReg ifTrue: [ regMask := regMask bitOr: (self registerMaskFor: rcvrReg) ].
"Only interested in inlining if followed by a conditional branch."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: unforwardArg not
rcvrIsConstant: unforwardRcvr not
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
"If branching the stack must be flushed for the merge"
self ssFlushTo: simStackPtr - 2.
unforwardArg ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg ].
unforwardRcvr ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg ].
counterReg := self allocateRegNotConflictingWith: regMask.
self
genExecutionCountLogicInto: [ :cAddress :countTripBranch |
counterAddress := cAddress.
countTripped := countTripBranch ]
counterReg: counterReg.
self assert: (unforwardArg or: [ unforwardRcvr ]).
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
ifFalse:
+ [ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
- [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
ifTrue:
+ [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger ].
- [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ].
self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
self Jump: fixup.
countTripped jmpTarget: self Label.
"inlined version of #== ignoring the branchDescriptor if the counter trips to have normal state for the optimizer"
self ssPop: -2.
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"This code necessarily directly falls through the jumpIf: code which pops the top of the stack into TempReg.
We therefore directly assign the result to TempReg to save one move instruction"
jumpEqual := orNot ifFalse: [self JumpZero: 0] ifTrue: [self JumpNonZero: 0].
self genMoveFalseR: TempReg.
jumpNotEqual := self Jump: 0.
jumpEqual jmpTarget: (self genMoveTrueR: TempReg).
jumpNotEqual jmpTarget: self Label.
self ssPushRegister: TempReg.
(self fixupAt: nextPC - initialPC) notAFixup ifTrue: [ branchReachedOnlyForCounterTrip := true ].
^ 0!
Item was changed:
----- Method: SistaCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
genJumpIf: boolean to: targetBytecodePC
"The heart of performance counting in Sista. Conditional branches are 6 times less
frequent than sends and can provide basic block frequencies (send counters can't).
Each conditional has a 32-bit counter split into an upper 16 bits counting executions
and a lower half counting untaken executions of the branch. Executing the branch
decrements the upper half, tripping if the count goes negative. Not taking the branch
decrements the lower half. N.B. We *do not* eliminate dead branches (true ifTrue:/true ifFalse:)
so that scanning for send and branch data is simplified and that branch data is correct."
<inline: false>
| ok counterAddress countTripped retry nextPC nextDescriptor desc eventualTarget |
<var: #ok type: #'AbstractInstruction *'>
<var: #desc type: #'CogSimStackEntry *'>
<var: #retry type: #'AbstractInstruction *'>
<var: #countTripped type: #'AbstractInstruction *'>
<var: #nextDescriptor type: #'BytecodeDescriptor *'>
"In optimized code we don't generate counters to improve performance"
(coInterpreter isOptimizedMethod: methodObj) ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ].
"If the branch is reached only for the counter trip trampoline
(typically, var1 == var2 ifTrue: falls through to the branch only for the trampoline)
we generate a specific path to drastically reduce the number of machine instructions"
branchReachedOnlyForCounterTrip ifTrue:
[ branchReachedOnlyForCounterTrip := false.
^ self genCounterTripOnlyJumpIf: boolean to: targetBytecodePC ].
"We detect and: / or:, if found, we don't generate the counters to avoid pathological counter slow down"
boolean = objectMemory falseObject ifTrue:
[ nextPC := bytecodePC + (self generatorAt: byte0) numBytes.
nextDescriptor := self generatorAt: (objectMemory fetchByte: nextPC ofObject: methodObj) + bytecodeSetOffset.
nextDescriptor generator == #genPushConstantTrueBytecode ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ].
nextDescriptor := self generatorAt: (objectMemory fetchByte: targetBytecodePC ofObject: methodObj) + bytecodeSetOffset.
nextDescriptor generator == #genPushConstantFalseBytecode ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ]. ].
extA := 0. "We ignore the noMustBeBoolean flag. It should not be present in methods with counters, and if it is we don't care."
"We don't generate counters on branches on true/false, the basicblock usage can be inferred"
desc := self ssTop.
(desc type == SSConstant
and: [desc constant = objectMemory trueObject or: [desc constant = objectMemory falseObject]]) ifTrue:
[ ^ super genJumpIf: boolean to: targetBytecodePC ].
eventualTarget := self eventualTargetOf: targetBytecodePC.
self ssFlushTo: simStackPtr - 1.
desc popToReg: TempReg.
self ssPop: 1.
"We need SendNumArgsReg because of the mustBeBooleanTrampoline"
self ssAllocateRequiredReg: SendNumArgsReg.
retry := self Label.
self
genExecutionCountLogicInto: [ :cAddress :countTripBranch |
counterAddress := cAddress.
countTripped := countTripBranch ]
counterReg: SendNumArgsReg.
counterIndex := counterIndex + 1.
"Cunning trick by LPD. If true and false are contiguous subtract the smaller.
Correct result is either 0 or the distance between them. If result is not 0 or
their distance send mustBeBoolean."
self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
self genSubConstant: boolean R: TempReg.
+ self JumpZero: (self ensureFixupAt: eventualTarget).
- self JumpZero: (self ensureFixupAt: eventualTarget - initialPC).
self genFallsThroughCountLogicCounterReg: SendNumArgsReg counterAddress: counterAddress.
self CmpCq: (boolean = objectMemory falseObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: TempReg.
ok := self JumpZero: 0.
self MoveCq: 0 R: SendNumArgsReg. "if counterReg is 0 this is a mustBeBoolean, not a counter trip."
countTripped jmpTarget: (self genCallMustBeBooleanFor: boolean).
"If we're in an image which hasn't got the Sista code loaded then the ceCounterTripped:
trampoline will return directly to machine code, returning the boolean. So the code should
jump back to the retry point. The trampoline makes sure that TempReg has been reloaded."
"Clément: For some reason if I write self annotateBytecode: (self Jump: retry) the annotation is not at the correct place."
"Eliot: Annotations apply the the address following an instruction, and the annotation must be for the return address
of the call (since this is the address the run-time sees), so it must be on a label before the jump, not after the jump."
self annotateBytecode: self Label.
self Jump: retry.
ok jmpTarget: self Label.
^0!
Item was changed:
----- Method: SistaCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
genSpecialSelectorComparison
"Override to count inlined branches if followed by a conditional branch.
We borrow the following conditional branch's counter and when about to
inline the comparison we decrement the counter (without writing it back)
and if it trips simply abort the inlining, falling back to the normal send which
will then continue to the conditional branch which will trip and enter the abort."
| nextPC postBranchPC targetBytecodePC primDescriptor branchDescriptor
rcvrIsInt argIsInt argInt jumpNotSmallInts inlineCAB
counterAddress countTripped counterReg index |
<var: #countTripped type: #'AbstractInstruction *'>
<var: #primDescriptor type: #'BytecodeDescriptor *'>
<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
(coInterpreter isOptimizedMethod: methodObj) ifTrue: [ ^ self genSpecialSelectorComparisonWithoutCounters ].
self ssFlushTo: simStackPtr - 2.
primDescriptor := self generatorAt: byte0.
argIsInt := self ssTop type = SSConstant
and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
rcvrIsInt := (self ssValue: 1) type = SSConstant
and: [objectMemory isIntegerObject: (self ssValue: 1) constant].
"short-cut the jump if operands are SmallInteger constants."
(argIsInt and: [rcvrIsInt]) ifTrue:
[^ self genStaticallyResolvedSpecialSelectorComparison].
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
"Only interested in inlining if followed by a conditional branch."
inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse].
"Further, only interested in inlining = and ~= if there's a SmallInteger constant involved.
The relational operators successfully statically predict SmallIntegers; the equality operators do not."
(inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue:
[inlineCAB := argIsInt or: [rcvrIsInt]].
inlineCAB ifFalse:
[^self genSpecialSelectorSend].
argIsInt
ifTrue:
[(self ssValue: 1) popToReg: ReceiverResultReg.
self ssPop: 2.
self MoveR: ReceiverResultReg R: TempReg]
ifFalse:
[self marshallSendArguments: 1.
self MoveR: Arg0Reg R: TempReg].
jumpNotSmallInts := (argIsInt or: [rcvrIsInt])
ifTrue: [objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg]
ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: ReceiverResultReg andScratch: TempReg scratch: ClassReg].
counterReg := self allocateRegNotConflictingWith: (self registerMaskFor: ReceiverResultReg and: Arg0Reg).
self
genExecutionCountLogicInto: [ :cAddress :countTripBranch |
counterAddress := cAddress.
countTripped := countTripBranch ]
counterReg: counterReg.
argIsInt
ifTrue: [self CmpCq: argInt R: ReceiverResultReg]
ifFalse: [self CmpR: Arg0Reg R: ReceiverResultReg].
"Cmp is weird/backwards so invert the comparison. Further since there is a following conditional
jump bytecode define non-merge fixups and leave the cond bytecode to set the mergeness."
self genConditionalBranch: (branchDescriptor isBranchTrue
ifTrue: [primDescriptor opcode]
ifFalse: [self inverseBranchFor: primDescriptor opcode])
+ operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
- operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
+ self Jump: (self ensureNonMergeFixupAt: postBranchPC).
- self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC).
countTripped jmpTarget: (jumpNotSmallInts jmpTarget: self Label).
argIsInt ifTrue:
[self MoveCq: argInt R: Arg0Reg].
index := byte0 - self firstSpecialSelectorBytecodeOffset.
^self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines!
Item was changed:
----- Method: SistaCogitClone>>genBinaryInlineComparison:opFalse:destReg: (in category 'inline primitive generators') -----
genBinaryInlineComparison: opTrue opFalse: opFalse destReg: destReg
"Inlined comparison. opTrue = jump for true and opFalse = jump for false"
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
| nextPC branchDescriptor targetBytecodePC postBranchPC |
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse])
ifTrue: "This is the path where the inlined comparison is followed immediately by a branch"
[ (self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
+ self ensureFixupAt: targetBytecodePC.
+ self ensureFixupAt: postBranchPC ]
- self ensureFixupAt: targetBytecodePC - initialPC.
- self ensureFixupAt: postBranchPC - initialPC ]
ifFalse:
[self ssPushConstant: objectMemory trueObject]. "dummy value"
self genConditionalBranch: (branchDescriptor isBranchTrue ifTrue: [opTrue] ifFalse: [opFalse])
+ operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
+ deadCode ifFalse: [ self Jump: (self ensureNonMergeFixupAt: postBranchPC) ] ]
- operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- deadCode ifFalse: [ self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC) ] ]
ifFalse: "This is the path where the inlined comparison is *not* followed immediately by a branch"
[| condJump jump |
condJump := self genConditionalBranch: opTrue operand: 0.
self genMoveFalseR: destReg.
jump := self Jump: 0.
condJump jmpTarget: (self genMoveTrueR: destReg).
jump jmpTarget: self Label].
^ 0!
Item was changed:
----- Method: SistaCogitClone>>genExtJumpIfNotInstanceOfBehaviorsBytecode (in category 'bytecode generators') -----
genExtJumpIfNotInstanceOfBehaviorsBytecode
"SistaV1: * 254 11111110 kkkkkkkk jjjjjjjj branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
| reg literal distance targetFixUp inverse |
"We lose the information of in which register is stack top
when jitting the branch target so we need to flush everything.
We could use a fixed register here...."
reg := self allocateRegForStackEntryAt: 0.
self ssTop popToReg: reg.
self ssFlushTo: simStackPtr. "flushed but the value is still in reg"
self ssPop: 1.
literal := self getLiteral: (extA * 256 + byte1).
(inverse := extB < 0) ifTrue:
[extB := extB + 128].
distance := extB * 256 + byte2.
extA := extB := numExtB := 0.
+ targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance) to: #'AbstractInstruction *'.
- targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
inverse
ifFalse:
[(objectMemory isArrayNonImm: literal)
ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp] ]
ifTrue:
[(objectMemory isArrayNonImm: literal)
ifTrue: [objectRepresentation branchIf: reg instanceOfBehaviors: literal target: targetFixUp]
ifFalse: [objectRepresentation branchIf: reg instanceOfBehavior: literal target: targetFixUp]].
^0!
Item was changed:
----- Method: SistaRegisterAllocatingCogit>>genCounterTripOnlyJumpIf:to: (in category 'bytecode generator support') -----
genCounterTripOnlyJumpIf: boolean to: targetBytecodePC
"Specific version if the branch is only reached while falling through if the counter trips after an inlined #== branch. We do not regenerate the counter logic in this case to avoid 24 bytes instructions."
<var: #ok type: #'AbstractInstruction *'>
<var: #mustBeBooleanTrampoline type: #'AbstractInstruction *'>
| ok mustBeBooleanTrampoline |
extA := 0.
self ssTop popToReg: TempReg.
self ssPop: 1.
counterIndex := counterIndex + 1. "counters are increased / decreased in the inlined branch"
"We need SendNumArgsReg because of the mustBeBooleanTrampoline"
self ssAllocateRequiredReg: SendNumArgsReg.
self MoveCq: 1 R: SendNumArgsReg.
"The first time this is reached, it calls necessarily the counter trip for the trampoline because SendNumArgsReg is non zero"
mustBeBooleanTrampoline := self genCallMustBeBooleanFor: boolean.
self annotateBytecode: self Label.
"Cunning trick by LPD. If true and false are contiguous subtract the smaller.
Correct result is either 0 or the distance between them. If result is not 0 or
their distance send mustBeBoolean."
self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
self genSubConstant: boolean R: TempReg.
+ self JumpZero: (self ensureFixupAt: targetBytecodePC).
- self JumpZero: (self ensureFixupAt: targetBytecodePC - initialPC).
self CmpCq: (boolean = objectMemory falseObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: TempReg.
ok := self JumpZero: 0.
self MoveCq: 0 R: SendNumArgsReg. "if counterReg is 0 this is a mustBeBoolean, not a counter trip."
self Jump: mustBeBooleanTrampoline.
ok jmpTarget: self Label.
^0!
Item was changed:
----- Method: SistaRegisterAllocatingCogit>>genExtJumpIfNotInstanceOfBehaviorsBytecode (in category 'bytecode generators') -----
genExtJumpIfNotInstanceOfBehaviorsBytecode
"SistaV1: * 254 11111110 kkkkkkkk jjjjjjjj branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
| reg literal distance targetFixUp inverse |
"We lose the information of in which register is stack top
when jitting the branch target so we need to flush everything.
We could use a fixed register here...."
reg := self allocateRegForStackEntryAt: 0.
self ssTop popToReg: reg.
self ssPop: 1.
literal := self getLiteral: (extA * 256 + byte1).
(inverse := extB < 0) ifTrue:
[extB := extB + 128].
distance := extB * 256 + byte2.
extA := extB := numExtB := 0.
"For now just deny we're in the situation we have yet to implement ;-)"
self deny: (self mergeRequiredForJumpTo: bytecodePC + 3 + distance).
+ targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance) to: #'AbstractInstruction *'.
- targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
inverse
ifFalse:
[(objectMemory isArrayNonImm: literal)
ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp] ]
ifTrue:
[(objectMemory isArrayNonImm: literal)
ifTrue: [objectRepresentation branchIf: reg instanceOfBehaviors: literal target: targetFixUp]
ifFalse: [objectRepresentation branchIf: reg instanceOfBehavior: literal target: targetFixUp]].
^0!
Item was changed:
----- Method: SistaRegisterAllocatingCogit>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genForwardersInlinedIdenticalOrNotIf: orNot
"Override to count inlined branches if followed by a conditional branch.
We borrow the following conditional branch's counter and when about to
inline the comparison we decrement the counter (without writing it back)
and if it trips simply abort the inlining, falling back to the normal send which
will then continue to the conditional branch which will trip and enter the abort."
| nextPC postBranchPC targetBytecodePC branchDescriptor counterReg fixup jumpEqual jumpNotEqual
counterAddress countTripped unforwardArg unforwardRcvr argReg rcvrReg regMask |
<var: #fixup type: #'BytecodeFixup *'>
<var: #countTripped type: #'AbstractInstruction *'>
<var: #label type: #'AbstractInstruction *'>
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #jumpEqual type: #'AbstractInstruction *'>
<var: #jumpNotEqual type: #'AbstractInstruction *'>
((coInterpreter isOptimizedMethod: methodObj) or: [needsFrame not]) ifTrue:
[^super genForwardersInlinedIdenticalOrNotIf: orNot].
regMask := 0.
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
"If an operand is an annotable constant, it may be forwarded, so we need to store it into a
register so the forwarder check can jump back to the comparison after unforwarding the constant.
However, if one of the operand is an unnanotable constant, does not allocate a register for it
(machine code will use operations on constants)."
rcvrReg:= argReg := NoReg.
self
allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
rcvrNeedsReg: unforwardRcvr
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
argReg ~= NoReg ifTrue: [ regMask := self registerMaskFor: argReg ].
rcvrReg ~= NoReg ifTrue: [ regMask := regMask bitOr: (self registerMaskFor: rcvrReg) ].
"Only interested in inlining if followed by a conditional branch."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: unforwardArg not
rcvrIsConstant: unforwardRcvr not
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
unforwardArg ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg ].
unforwardRcvr ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg ].
counterReg := self allocateRegNotConflictingWith: regMask.
self
genExecutionCountLogicInto: [ :cAddress :countTripBranch |
counterAddress := cAddress.
countTripped := countTripBranch ]
counterReg: counterReg.
self assert: (unforwardArg or: [ unforwardRcvr ]).
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
ifFalse:
+ [ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
- [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
ifTrue:
+ [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger ].
- [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ].
self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
self Jump: fixup.
countTripped jmpTarget: self Label.
"inlined version of #== ignoring the branchDescriptor if the counter trips to have normal state for the optimizer"
self ssPop: -2.
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"This code necessarily directly falls through the jumpIf: code which pops the top of the stack into TempReg.
We therefore directly assign the result to TempReg to save one move instruction"
jumpEqual := orNot ifFalse: [self JumpZero: 0] ifTrue: [self JumpNonZero: 0].
self genMoveFalseR: TempReg.
jumpNotEqual := self Jump: 0.
jumpEqual jmpTarget: (self genMoveTrueR: TempReg).
jumpNotEqual jmpTarget: self Label.
self ssPushRegister: TempReg.
(self fixupAt: nextPC - initialPC) notAFixup ifTrue: [ branchReachedOnlyForCounterTrip := true ].
^ 0!
Item was changed:
----- Method: SistaRegisterAllocatingCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
genJumpIf: boolean to: targetBytecodePC
"The heart of performance counting in Sista. Conditional branches are 6 times less
frequent than sends and can provide basic block frequencies (send counters can't).
Each conditional has a 32-bit counter split into an upper 16 bits counting executions
and a lower half counting untaken executions of the branch. Executing the branch
decrements the upper half, tripping if the count goes negative. Not taking the branch
decrements the lower half. N.B. We *do not* eliminate dead branches (true ifTrue:/true ifFalse:)
so that scanning for send and branch data is simplified and that branch data is correct."
<inline: false>
| ok counterAddress countTripped retry nextPC nextDescriptor desc eventualTarget reg |
<var: #ok type: #'AbstractInstruction *'>
<var: #desc type: #'CogSimStackEntry *'>
<var: #retry type: #'AbstractInstruction *'>
<var: #countTripped type: #'AbstractInstruction *'>
<var: #nextDescriptor type: #'BytecodeDescriptor *'>
"In optimized code we don't generate counters to improve performance"
(coInterpreter isOptimizedMethod: methodObj) ifTrue:
[^super genJumpIf: boolean to: targetBytecodePC].
"If the branch is reached only for the counter trip trampoline
(typically, var1 == var2 ifTrue: falls through to the branch only for the trampoline)
we generate a specific path to drastically reduce the number of machine instructions"
branchReachedOnlyForCounterTrip ifTrue:
[branchReachedOnlyForCounterTrip := false.
^self genCounterTripOnlyJumpIf: boolean to: targetBytecodePC].
"We detect and: / or:, if found, we don't generate the counters to avoid pathological counter slow down"
boolean = objectMemory falseObject ifTrue:
[ nextPC := bytecodePC + (self generatorAt: byte0) numBytes.
nextDescriptor := self generatorAt: (objectMemory fetchByte: nextPC ofObject: methodObj) + bytecodeSetOffset.
nextDescriptor generator == #genPushConstantTrueBytecode ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ].
nextDescriptor := self generatorAt: (objectMemory fetchByte: targetBytecodePC ofObject: methodObj) + bytecodeSetOffset.
nextDescriptor generator == #genPushConstantFalseBytecode ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ]. ].
extA := 0. "We ignore the noMustBeBoolean flag. It should not be present in methods with counters, and if it is we don't care."
"We don't generate counters on branches on true/false, the basicblock usage can be inferred"
desc := self ssTop.
(desc type == SSConstant
and: [desc constant = objectMemory trueObject or: [desc constant = objectMemory falseObject]]) ifTrue:
[ ^ super genJumpIf: boolean to: targetBytecodePC ].
eventualTarget := self eventualTargetOf: targetBytecodePC.
self flag: 'Because of the restriction on x64 that absolute loads must target %rax, it would perhaps be a better choice to use TempReg (%rax) for the counter reg and SendNumArgsReg for the boolean.'.
"try and use the top entry's register if any, but only if it can be destroyed."
reg := (desc type ~= SSRegister
or: [(self anyReferencesToRegister: desc register inAllButTopNItems: 0)
or: [(desc register = ReceiverResultReg and: [optStatus isReceiverResultRegLive])]])
ifTrue: [TempReg]
ifFalse: [desc register].
desc popToReg: reg.
self ssPop: 1.
"We need SendNumArgsReg because of the mustBeBooleanTrampoline"
self ssAllocateRequiredReg: SendNumArgsReg.
retry := self Label.
self
genExecutionCountLogicInto: [ :cAddress :countTripBranch |
counterAddress := cAddress.
countTripped := countTripBranch ]
counterReg: SendNumArgsReg.
counterIndex := counterIndex + 1.
"Cunning trick by LPD. If true and false are contiguous subtract the smaller.
Correct result is either 0 or the distance between them. If result is not 0 or
their distance send mustBeBoolean."
self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
self genSubConstant: boolean R: reg.
+ self JumpZero: (self ensureFixupAt: eventualTarget).
- self JumpZero: (self ensureFixupAt: eventualTarget - initialPC).
self genFallsThroughCountLogicCounterReg: SendNumArgsReg counterAddress: counterAddress.
self CmpCq: (boolean = objectMemory falseObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: reg.
ok := self JumpZero: 0.
self MoveCq: 0 R: SendNumArgsReg. "if counterReg is 0 this is a mustBeBoolean, not a counter trip."
reg ~= TempReg ifTrue:
[self MoveR: reg R: TempReg].
countTripped jmpTarget: self Label.
self copySimStackToScratch: simSpillBase.
self ssFlushTo: simStackPtr.
self genCallMustBeBooleanFor: boolean.
"If we're in an image which hasn't got the Sista code loaded then the ceCounterTripped: trampoline
will return directly to machine code, returning the boolean. So the code should jump back to the
retry point. The trampoline preserves register state when taking the ceCounterTripped: path."
"Clément: For some reason if I write self annotateBytecode: (self Jump: retry) the annotation is not at the correct place."
"Eliot: Annotations apply the the address following an instruction, and the annotation must be for the return address
of the call (since this is the address the run-time sees), so it must be on a label before the jump, not after the jump."
self annotateBytecode: self Label.
simSpillBase ~= scratchSpillBase ifTrue:
[self assert: simSpillBase > scratchSpillBase.
self AddCq: simSpillBase - scratchSpillBase * objectMemory wordSize R: SPReg].
self Jump: retry.
ok jmpTarget: self Label.
self restoreSimStackFromScratch.
^0!
Item was changed:
----- Method: SistaRegisterAllocatingCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
genSpecialSelectorComparison
"Override to count inlined branches if followed by a conditional branch.
We borrow the following conditional branch's counter and when about to
inline the comparison we decrement the counter (without writing it back)
and if it trips simply abort the inlining, falling back to the normal send which
will then continue to the conditional branch which will trip and enter the abort."
| nextPC postBranchPC targetBytecodePC primDescriptor branchDescriptor
rcvrIsInt argIsInt argInt jumpNotSmallInts inlineCAB
counterAddress countTripped counterReg index rcvrReg argReg |
<var: #countTripped type: #'AbstractInstruction *'>
<var: #primDescriptor type: #'BytecodeDescriptor *'>
<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
(coInterpreter isOptimizedMethod: methodObj) ifTrue:
[^self genSpecialSelectorComparisonWithoutCounters].
primDescriptor := self generatorAt: byte0.
argIsInt := self ssTop type = SSConstant
and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
rcvrIsInt := (self ssValue: 1) type = SSConstant
and: [objectMemory isIntegerObject: (self ssValue: 1) constant].
"short-cut the jump if operands are SmallInteger constants."
(argIsInt and: [rcvrIsInt]) ifTrue:
[^ self genStaticallyResolvedSpecialSelectorComparison].
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
"Only interested in inlining if followed by a conditional branch."
inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse].
"Further, only interested in inlining = and ~= if there's a SmallInteger constant involved.
The relational operators successfully statically predict SmallIntegers; the equality operators do not."
(inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue:
[inlineCAB := argIsInt or: [rcvrIsInt]].
inlineCAB ifFalse:
[^self genSpecialSelectorSend].
"In-line the comparison and the jump, but if the types are not SmallInteger then we will need
to do a send and fall through to the following conditional branch. Since we're allocating values
in registers we would like to keep those registers live on the inlined path and reload registers
along the non-inlined send path. The merge logic at the branch destinations handles this."
argIsInt
ifTrue:
[rcvrReg := self allocateRegForStackEntryAt: 1.
(self ssValue: 1) popToReg: rcvrReg.
self MoveR: rcvrReg R: TempReg.
counterReg := self allocateRegNotConflictingWith: (self registerMaskFor: rcvrReg)]
ifFalse:
[self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext| argReg := rTop. rcvrReg := rNext].
rcvrReg = Arg0Reg ifTrue:
[rcvrReg := argReg. argReg := Arg0Reg].
self ssTop popToReg: argReg.
(self ssValue: 1) popToReg: rcvrReg.
self MoveR: argReg R: TempReg.
counterReg := self allocateRegNotConflictingWith: (self registerMaskFor: rcvrReg and: argReg)].
jumpNotSmallInts := (argIsInt or: [rcvrIsInt])
ifTrue: [objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg]
ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: rcvrReg andScratch: TempReg scratch: ClassReg].
self
genExecutionCountLogicInto: [ :cAddress :countTripBranch |
counterAddress := cAddress.
countTripped := countTripBranch ]
counterReg: counterReg.
argIsInt
ifTrue: [self CmpCq: argInt R: rcvrReg]
ifFalse: [self CmpR: argReg R: rcvrReg].
"Cmp is weird/backwards so invert the comparison. Further since there is a following conditional
jump bytecode define non-merge fixups and leave the cond bytecode to set the mergeness."
self genConditionalBranch: (branchDescriptor isBranchTrue
ifTrue: [primDescriptor opcode]
ifFalse: [self inverseBranchFor: primDescriptor opcode])
+ operand: (self ensureFixupAt: targetBytecodePC) asUnsignedInteger.
- operand: (self ensureFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
+ self Jump: (self ensureFixupAt: postBranchPC).
- self Jump: (self ensureFixupAt: postBranchPC - initialPC).
countTripped jmpTarget: (jumpNotSmallInts jmpTarget: self Label).
self ssFlushTo: simStackPtr.
self deny: rcvrReg = Arg0Reg.
argIsInt
ifTrue: [self MoveCq: argInt R: Arg0Reg]
ifFalse: [argReg ~= Arg0Reg ifTrue: [self MoveR: argReg R: Arg0Reg]].
rcvrReg ~= ReceiverResultReg ifTrue: [self MoveR: rcvrReg R: ReceiverResultReg].
index := byte0 - self firstSpecialSelectorBytecodeOffset.
^self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines!
Item was changed:
----- Method: StackToRegisterMappingCogit>>ensureFixupAt: (in category 'compile abstract instructions') -----
+ ensureFixupAt: targetPC
+ "Make sure there's a flagged fixup at the target pc in fixups.
- ensureFixupAt: targetIndex
- "Make sure there's a flagged fixup at the targetIndex (pc relative to first pc) in fixups.
Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction."
<returnTypeC: #'BytecodeFixup *'>
| fixup |
<var: #fixup type: #'BytecodeFixup *'>
+ fixup := self fixupAt: targetPC - initialPC.
- fixup := self fixupAt: targetIndex.
self traceFixup: fixup.
self cCode: '' inSmalltalk:
+ [self assert: simStackPtr = (self debugStackPointerFor: targetPC).
- [self assert: simStackPtr = (self debugStackPointerFor: targetIndex + initialPC).
(fixup isMergeFixupOrIsFixedUp
and: [fixup isBackwardBranchFixup not]) ifTrue: "ignore backward branch targets"
[self assert: fixup simStackPtr = simStackPtr]].
fixup isNonMergeFixupOrNotAFixup
ifTrue: "convert a non-merge into a merge"
[fixup becomeMergeFixup.
fixup simStackPtr: simStackPtr.
LowcodeVM ifTrue: [
fixup simNativeStackPtr: simNativeStackPtr.
fixup simNativeStackSize: simNativeStackSize]]
ifFalse:
[fixup isBackwardBranchFixup
ifTrue: "this is the target of a backward branch and
so doesn't have a simStackPtr assigned yet."
[fixup simStackPtr: simStackPtr.
LowcodeVM ifTrue:
[fixup simNativeStackPtr: simNativeStackPtr.
fixup simNativeStackSize: simNativeStackSize]]
ifFalse:
[self assert: fixup simStackPtr = simStackPtr.
LowcodeVM ifTrue:
[self assert: fixup simNativeStackPtr = simNativeStackPtr.
self assert: fixup simNativeStackSize = simNativeStackSize]]].
fixup recordBcpc: bytecodePC.
^fixup!
Item was changed:
----- Method: StackToRegisterMappingCogit>>ensureNonMergeFixupAt: (in category 'compile abstract instructions') -----
+ ensureNonMergeFixupAt: targetPC
+ "Make sure there's a flagged fixup at the target pc in fixups.
- ensureNonMergeFixupAt: targetIndex
- "Make sure there's a flagged fixup at the targetIndex (pc relative to first pc) in fixups.
Initially a fixup's target is just a flag. Later on it is replaced with a proper instruction."
<returnTypeC: #'BytecodeFixup *'>
| fixup |
<var: #fixup type: #'BytecodeFixup *'>
+ fixup := self fixupAt: targetPC - initialPC.
- fixup := self fixupAt: targetIndex.
fixup notAFixup ifTrue:
[fixup becomeNonMergeFixup].
self cCode: '' inSmalltalk:
[fixup isMergeFixupOrIsFixedUp ifTrue:
[self assert:
(fixup isBackwardBranchFixup
+ or: [fixup simStackPtr = (self debugStackPointerFor: targetPC)])]].
- or: [fixup simStackPtr = (self debugStackPointerFor: targetIndex + initialPC)])]].
fixup recordBcpc: bytecodePC.
^fixup!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genForwardersInlinedIdenticalOrNotIf: orNot
| nextPC branchDescriptor unforwardRcvr argReg targetBytecodePC
unforwardArg rcvrReg postBranchPC label fixup |
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #label type: #'AbstractInstruction *'>
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
"If an operand is an annotable constant, it may be forwarded, so we need to store it into a
register so the forwarder check can jump back to the comparison after unforwarding the constant.
However, if one of the operand is an unnanotable constant, does not allocate a register for it
(machine code will use operations on constants) and does not generate forwarder checks."
unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
self
allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
rcvrNeedsReg: unforwardRcvr
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
"If not followed by a branch, resolve to true or false."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: unforwardArg not
rcvrIsConstant: unforwardRcvr not
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
"If branching the stack must be flushed for the merge"
self ssFlushTo: simStackPtr - 2.
label := self Label.
self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"Further since there is a following conditional jump bytecode, define
non-merge fixups and leave the cond bytecode to set the mergeness."
(self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
+ self ensureFixupAt: targetBytecodePC.
+ self ensureFixupAt: postBranchPC]
- self ensureFixupAt: targetBytecodePC - initialPC.
- self ensureFixupAt: postBranchPC - initialPC]
ifFalse:
[self deny: deadCode]. "push dummy value below"
self assert: (unforwardArg or: [unforwardRcvr]).
orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
ifFalse:
+ [ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
- [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
ifTrue:
+ [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
+ self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger ].
- [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ].
deadCode ifFalse:
[self ssPushConstant: objectMemory trueObject]. "dummy value"
"The forwarders checks need to jump back to the comparison (label) if a forwarder is found, else
jump forward either to the next forwarder check or to the postBranch or branch target (fixup)."
unforwardArg ifTrue:
[ unforwardRcvr
ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: label ]
ifFalse: [ objectRepresentation
genEnsureOopInRegNotForwarded: argReg
scratchReg: TempReg
ifForwarder: label
ifNotForwarder: fixup ] ].
unforwardRcvr ifTrue:
[ objectRepresentation
genEnsureOopInRegNotForwarded: rcvrReg
scratchReg: TempReg
ifForwarder: label
ifNotForwarder: fixup ].
"Not reached, execution flow have jumped to fixup"
^0!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
genJumpIf: boolean to: targetBytecodePC
<inline: false>
| desc fixup ok eventualTarget |
<var: #desc type: #'CogSimStackEntry *'>
<var: #fixup type: #'BytecodeFixup *'>
<var: #ok type: #'AbstractInstruction *'>
eventualTarget := self eventualTargetOf: targetBytecodePC.
self ssFlushTo: simStackPtr - 1.
desc := self ssTop.
self ssPop: 1.
(desc type == SSConstant
and: [desc constant = objectMemory trueObject or: [desc constant = objectMemory falseObject]]) ifTrue:
["Must arrange there's a fixup at the target whether it is jumped to or
not so that the simStackPtr can be kept correct."
+ fixup := self ensureFixupAt: eventualTarget.
- fixup := self ensureFixupAt: eventualTarget - initialPC.
"Must annotate the bytecode for correct pc mapping."
self annotateBytecode: (desc constant = boolean
ifTrue: [self Jump: fixup]
ifFalse: [self prevInstIsPCAnnotated
ifTrue: [self Nop]
ifFalse: [self Label]]).
extA := 0.
^0].
desc popToReg: TempReg.
"Cunning trick by LPD. If true and false are contiguous subtract the smaller.
Correct result is either 0 or the distance between them. If result is not 0 or
their distance send mustBeBoolean."
self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
self genSubConstant: boolean R: TempReg.
+ self JumpZero: (self ensureFixupAt: eventualTarget).
- self JumpZero: (self ensureFixupAt: eventualTarget - initialPC).
self extASpecifiesNoMustBeBoolean ifTrue:
[ extA := 0.
self annotateBytecode: self lastOpcode.
^ 0].
extA := 0.
self CmpCq: (boolean = objectMemory falseObject
ifTrue: [objectMemory trueObject - objectMemory falseObject]
ifFalse: [objectMemory falseObject - objectMemory trueObject])
R: TempReg.
ok := self JumpZero: 0.
self genCallMustBeBooleanFor: boolean.
ok jmpTarget: (self annotateBytecode: self Label).
^0!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genJumpTo: (in category 'bytecode generator support') -----
genJumpTo: targetBytecodePC
self ssFlushTo: simStackPtr.
deadCode := true. "can't fall through"
+ self Jump: (self ensureFixupAt: (self eventualTargetOf: targetBytecodePC)).
- self Jump: (self ensureFixupAt: (self eventualTargetOf: targetBytecodePC) - initialPC).
^0!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
genSpecialSelectorComparison
| nextPC postBranchPC targetBytecodePC primDescriptor branchDescriptor
rcvrIsInt argIsInt argInt jumpNotSmallInts inlineCAB index |
<var: #primDescriptor type: #'BytecodeDescriptor *'>
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
self ssFlushTo: simStackPtr - 2.
primDescriptor := self generatorAt: byte0.
argIsInt := self ssTop type = SSConstant
and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
rcvrIsInt := (self ssValue: 1) type = SSConstant
and: [objectMemory isIntegerObject: (self ssValue: 1) constant].
(argIsInt and: [rcvrIsInt]) ifTrue:
[^ self genStaticallyResolvedSpecialSelectorComparison].
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
"Only interested in inlining if followed by a conditional branch."
inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse].
"Further, only interested in inlining = and ~= if there's a SmallInteger constant involved.
The relational operators successfully statically predict SmallIntegers; the equality operators do not."
(inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue:
[inlineCAB := argIsInt or: [rcvrIsInt]].
inlineCAB ifFalse:
[^self genSpecialSelectorSend].
argIsInt
ifTrue:
[(self ssValue: 1) popToReg: ReceiverResultReg.
self ssPop: 2.
self MoveR: ReceiverResultReg R: TempReg]
ifFalse:
[self marshallSendArguments: 1.
self MoveR: Arg0Reg R: TempReg].
jumpNotSmallInts := (argIsInt or: [rcvrIsInt])
ifTrue: [objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg]
ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: ReceiverResultReg andScratch: TempReg scratch: ClassReg].
argIsInt
ifTrue: [self CmpCq: argInt R: ReceiverResultReg]
ifFalse: [self CmpR: Arg0Reg R: ReceiverResultReg].
"Cmp is weird/backwards so invert the comparison. Further since there is a following conditional
jump bytecode define non-merge fixups and leave the cond bytecode to set the mergeness."
self genConditionalBranch: (branchDescriptor isBranchTrue
ifTrue: [primDescriptor opcode]
ifFalse: [self inverseBranchFor: primDescriptor opcode])
+ operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
+ self Jump: (self ensureNonMergeFixupAt: postBranchPC).
- operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC).
jumpNotSmallInts jmpTarget: self Label.
argIsInt ifTrue:
[self MoveCq: argInt R: Arg0Reg].
index := byte0 - self firstSpecialSelectorBytecodeOffset.
^self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines!
Item was changed:
----- Method: StackToRegisterMappingCogit>>genVanillaInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genVanillaInlinedIdenticalOrNotIf: orNot
| nextPC postBranchPC targetBytecodePC branchDescriptor
rcvrReg argReg argIsConstant rcvrIsConstant |
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
argIsConstant := self ssTop type = SSConstant.
"They can't be both constants to use correct machine opcodes.
However annotable constants can't be resolved statically, hence we need to careful."
rcvrIsConstant := argIsConstant not and: [(self ssValue: 1) type = SSConstant].
self
allocateEqualsEqualsRegistersArgNeedsReg: argIsConstant not
rcvrNeedsReg: rcvrIsConstant not
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
"If not followed by a branch, resolve to true or false."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^ self
genIdenticalNoBranchArgIsConstant: argIsConstant
rcvrIsConstant: rcvrIsConstant
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
"If branching the stack must be flushed for the merge"
self ssFlushTo: simStackPtr - 2.
self genCmpArgIsConstant: argIsConstant rcvrIsConstant: rcvrIsConstant argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
"Further since there is a following conditional jump bytecode, define
non-merge fixups and leave the cond bytecode to set the mergeness."
(self fixupAt: nextPC - initialPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
+ self ensureFixupAt: targetBytecodePC.
+ self ensureFixupAt: postBranchPC]
- self ensureFixupAt: targetBytecodePC - initialPC.
- self ensureFixupAt: postBranchPC - initialPC]
ifFalse:
[self deny: deadCode]. "push dummy value below"
self genConditionalBranch: (orNot == branchDescriptor isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero])
+ operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
- operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
"If the branch is dead, then we can just fall through postBranchPC (only a nop in-between), else
we need to jump over the code of the branch"
deadCode ifFalse:
+ [self Jump: (self ensureNonMergeFixupAt: postBranchPC).
- [self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC).
self ssPushConstant: objectMemory trueObject]. "dummy value"
^0!
1
0
[OpenSmalltalk/opensmalltalk-vm] d3dc22: Merge commit '6df2f02e128e83a3f4615e2acfd8b125f496...
by GitHub 07 Feb '17
by GitHub 07 Feb '17
07 Feb '17
Branch: refs/heads/Cog
Home: https://github.com/OpenSmalltalk/opensmalltalk-vm
Commit: d3dc222254a0f5397c971dc9dd6470b36fddacc1
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/d3dc222254a0f5397c…
Author: Esteban Lorenzano <estebanlm(a)gmail.com>
Date: 2017-01-26 (Thu, 26 Jan 2017)
Changed paths:
M src/plugins/SqueakFFIPrims/ARM32FFIPlugin.c
M src/plugins/SqueakFFIPrims/IA32FFIPlugin.c
M src/plugins/SqueakFFIPrims/SqueakFFIPrims.c
M src/plugins/SqueakFFIPrims/X64SysVFFIPlugin.c
M src/plugins/SqueakFFIPrims/X64Win64FFIPlugin.c
Log Message:
-----------
Merge commit '6df2f02e128e83a3f4615e2acfd8b125f496ca1a'
Commit: bb66f132db0f48f20aab32345b2a539ba6c0a53e
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/bb66f132db0f48f20a…
Author: Esteban Lorenzano <estebanlm(a)gmail.com>
Date: 2017-01-27 (Fri, 27 Jan 2017)
Changed paths:
M build.win32x86/pharo.cog.spur/Pharo.exe.manifest
M build.win32x86/pharo.cog.spur/Pharo.rc
Log Message:
-----------
put some “Pharo” names here and there
Commit: 2aefd288c1501d334670261807787778a420ea39
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/2aefd288c1501d3346…
Author: Esteban Lorenzano <estebanlm(a)gmail.com>
Date: 2017-02-03 (Fri, 03 Feb 2017)
Changed paths:
M image/ensureSqueakV50sources.sh
M image/getsqueak50.sh
M image/updatespurimage.sh
M nsspur64src/vm/cogit.h
M nsspur64src/vm/cointerp.c
M nsspur64src/vm/cointerp.h
M nsspur64src/vm/gcc3x-cointerp.c
M nsspursrc/vm/cogit.h
M nsspursrc/vm/cointerp.c
M nsspursrc/vm/cointerp.h
M nsspursrc/vm/gcc3x-cointerp.c
M nsspurstack64src/vm/gcc3x-interp.c
M nsspurstack64src/vm/interp.c
M nsspurstacksrc/vm/gcc3x-interp.c
M nsspurstacksrc/vm/interp.c
M spur64src/vm/cogit.h
M spur64src/vm/cointerp.c
M spur64src/vm/cointerp.h
M spur64src/vm/gcc3x-cointerp.c
M spursista64src/vm/cogit.h
M spursista64src/vm/cointerp.c
M spursista64src/vm/cointerp.h
M spursista64src/vm/gcc3x-cointerp.c
M spursistasrc/vm/cogit.h
M spursistasrc/vm/cointerp.c
M spursistasrc/vm/cointerp.h
M spursistasrc/vm/gcc3x-cointerp.c
M spursrc/vm/cogit.h
M spursrc/vm/cointerp.c
M spursrc/vm/cointerp.h
M spursrc/vm/gcc3x-cointerp.c
M spurstack64src/vm/gcc3x-interp.c
M spurstack64src/vm/interp.c
M spurstacksrc/vm/gcc3x-interp.c
M spurstacksrc/vm/interp.c
Log Message:
-----------
Merge commit '98fb4e4973db117828305e35d157ad2cb707d434'
Commit: fec94cb81299d8a76105eff3667dbe8588649220
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/fec94cb81299d8a761…
Author: Holger Hans Peter Freyther <holger(a)moiji-mobile.com>
Date: 2017-02-05 (Sun, 05 Feb 2017)
Changed paths:
M .travis.yml
M .travis_install.sh
M build.linux32ARMv6/pharo.cog.spur/prepare-rpi.sh
M platforms/unix/config/Makefile
M platforms/unix/config/Makefile.in
M platforms/unix/config/acinclude.m4
M platforms/unix/config/configure.ac
M platforms/unix/plugins/MIDIPlugin/acinclude.m4
M platforms/unix/plugins/MIDIPlugin/sqUnixMIDI.c
M platforms/unix/plugins/PseudoTTYPlugin/acinclude.m4
M platforms/unix/plugins/UnixOSProcessPlugin/acinclude.m4
M platforms/unix/vm-display-Quartz/acinclude.m4
M platforms/unix/vm-display-X11/Makefile.in
M platforms/unix/vm-display-X11/acinclude.m4
M platforms/unix/vm-sound-Sun/acinclude.m4
M platforms/unix/vm/acinclude.m4
Log Message:
-----------
configure.ac: Modernize scripts to allow autoreconf
Allow to autoreconf with autoconf released in 2012. It might be
best to remove the generated (and manually patched) configure
file, as a start regenerate the file as part of the CI process.
This is based on the unreviewed pull request of the squeakvm.
Commit: 37866a565fc7448032f46652812535d494f81493
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/37866a565fc7448032…
Author: Esteban Lorenzano <estebanlm(a)gmail.com>
Date: 2017-02-06 (Mon, 06 Feb 2017)
Changed paths:
A build-makefile-linux.sh
Log Message:
-----------
using a script (direct bash does not seems to work)
Commit: 74a13ac80adbee60367c7af94d31e1bc1fca84d7
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/74a13ac80adbee6036…
Author: Esteban Lorenzano <estebanlm(a)gmail.com>
Date: 2017-02-06 (Mon, 06 Feb 2017)
Changed paths:
M build-makefile-linux.sh
Log Message:
-----------
add -x
Commit: ff627f9d6d6b425fce390c855893be3666a7d96f
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/ff627f9d6d6b425fce…
Author: Esteban Lorenzano <estebanlm(a)gmail.com>
Date: 2017-02-06 (Mon, 06 Feb 2017)
Changed paths:
R build-makefile-linux.sh
Log Message:
-----------
ouch, bad dir
Commit: 4aea3547e6cf0fd92ad391c73af4a1e256003ec7
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/4aea3547e6cf0fd92a…
Author: Esteban Lorenzano <estebanlm(a)gmail.com>
Date: 2017-02-07 (Tue, 07 Feb 2017)
Changed paths:
M .travis.yml
M .travis_install.sh
M build.linux32ARMv6/pharo.cog.spur/prepare-rpi.sh
M build.win32x86/pharo.cog.spur/Pharo.exe.manifest
M build.win32x86/pharo.cog.spur/Pharo.rc
M platforms/unix/config/Makefile
M platforms/unix/config/Makefile.in
M platforms/unix/config/acinclude.m4
M platforms/unix/config/configure.ac
M platforms/unix/plugins/MIDIPlugin/acinclude.m4
M platforms/unix/plugins/MIDIPlugin/sqUnixMIDI.c
M platforms/unix/plugins/PseudoTTYPlugin/acinclude.m4
M platforms/unix/plugins/UnixOSProcessPlugin/acinclude.m4
M platforms/unix/vm-display-Quartz/acinclude.m4
M platforms/unix/vm-display-X11/Makefile.in
M platforms/unix/vm-display-X11/acinclude.m4
M platforms/unix/vm-sound-Sun/acinclude.m4
M platforms/unix/vm/acinclude.m4
Log Message:
-----------
Merge pull request #116 from estebanlm/Cog
configure.ac: Modernize scripts to allow autoreconf
Compare: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/98fb4e4973db...4a…
1
0
[OpenSmalltalk/opensmalltalk-vm] 015127: CogVM source as per VMMaker.oscogSPC-eem.2123
by GitHub 06 Feb '17
by GitHub 06 Feb '17
06 Feb '17
Branch: refs/heads/SpurPlanningCompactor
Home: https://github.com/OpenSmalltalk/opensmalltalk-vm
Commit: 015127f8c5d66a2ea00f6c9f6bd586bfc74c5af1
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/015127f8c5d66a2ea0…
Author: Eliot Miranda <eliot.miranda(a)gmail.com>
Date: 2017-02-06 (Mon, 06 Feb 2017)
Changed paths:
M nsspur64src/vm/cointerp.c
M nsspur64src/vm/cointerp.h
M nsspur64src/vm/gcc3x-cointerp.c
M nsspursrc/vm/cointerp.c
M nsspursrc/vm/cointerp.h
M nsspursrc/vm/gcc3x-cointerp.c
M nsspurstack64src/vm/gcc3x-interp.c
M nsspurstack64src/vm/interp.c
M nsspurstacksrc/vm/gcc3x-interp.c
M nsspurstacksrc/vm/interp.c
M spur64src/vm/cointerp.c
M spur64src/vm/cointerp.h
M spur64src/vm/gcc3x-cointerp.c
M spursista64src/vm/cointerp.c
M spursista64src/vm/cointerp.h
M spursista64src/vm/gcc3x-cointerp.c
M spursistasrc/vm/cointerp.c
M spursistasrc/vm/cointerp.h
M spursistasrc/vm/gcc3x-cointerp.c
M spursrc/vm/cointerp.c
M spursrc/vm/cointerp.h
M spursrc/vm/gcc3x-cointerp.c
M spurstack64src/vm/gcc3x-interp.c
M spurstack64src/vm/interp.c
M spurstacksrc/vm/gcc3x-interp.c
M spurstacksrc/vm/interp.c
M src/vm/cointerp.c
M src/vm/cointerp.h
M src/vm/cointerpmt.c
M src/vm/cointerpmt.h
M src/vm/gcc3x-cointerp.c
M src/vm/gcc3x-cointerpmt.c
M stacksrc/vm/gcc3x-interp.c
M stacksrc/vm/interp.c
Log Message:
-----------
CogVM source as per VMMaker.oscogSPC-eem.2123
Oops...fix slip in new primitiveVMParameter
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscogSPC-eem.2123.mcz
==================== Summary ====================
Name: VMMaker.oscogSPC-eem.2123
Author: eem
Time: 6 February 2017, 1:32:04.439179 pm
UUID: bf2ad7c1-26dc-4eb7-b3f7-a95061b1f522
Ancestors: VMMaker.oscogSPC-eem.2122
Oops...fix slip in new primitiveVMParameter
=============== Diff against VMMaker.oscogSPC-eem.2122 ===============
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveVMParameter (in category 'system control primitives') -----
(excessive size, no diff calculated)
1
0
[OpenSmalltalk/opensmalltalk-vm] 13cfe4: CogVM source as per VMMaker.oscogSPC-eem.2120
by GitHub 06 Feb '17
by GitHub 06 Feb '17
06 Feb '17
Branch: refs/heads/SpurPlanningCompactor
Home: https://github.com/OpenSmalltalk/opensmalltalk-vm
Commit: 13cfe4e0b4ac44735a46dd5a4bcee49c7ba541cf
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/13cfe4e0b4ac44735a…
Author: Eliot Miranda <eliot.miranda(a)gmail.com>
Date: 2017-02-05 (Sun, 05 Feb 2017)
Changed paths:
M nsspur64src/vm/cogit.h
M nsspur64src/vm/cogitX64.c
M nsspur64src/vm/cointerp.c
M nsspur64src/vm/cointerp.h
M nsspur64src/vm/gcc3x-cointerp.c
M nsspursrc/vm/cogit.h
M nsspursrc/vm/cogitARMv5.c
M nsspursrc/vm/cogitIA32.c
M nsspursrc/vm/cogitMIPSEL.c
M nsspursrc/vm/cointerp.c
M nsspursrc/vm/cointerp.h
M nsspursrc/vm/gcc3x-cointerp.c
M nsspurstack64src/vm/gcc3x-interp.c
M nsspurstack64src/vm/interp.c
M nsspurstacksrc/vm/gcc3x-interp.c
M nsspurstacksrc/vm/interp.c
M spur64src/vm/cogit.h
M spur64src/vm/cogitX64.c
M spur64src/vm/cointerp.c
M spur64src/vm/cointerp.h
M spur64src/vm/gcc3x-cointerp.c
M spursista64src/vm/cogit.h
M spursista64src/vm/cogitX64.c
M spursista64src/vm/cointerp.c
M spursista64src/vm/cointerp.h
M spursista64src/vm/gcc3x-cointerp.c
M spursistasrc/vm/cogit.h
M spursistasrc/vm/cogitARMv5.c
M spursistasrc/vm/cogitIA32.c
M spursistasrc/vm/cogitMIPSEL.c
M spursistasrc/vm/cointerp.c
M spursistasrc/vm/cointerp.h
M spursistasrc/vm/gcc3x-cointerp.c
M spursrc/vm/cogit.h
M spursrc/vm/cogitARMv5.c
M spursrc/vm/cogitIA32.c
M spursrc/vm/cogitMIPSEL.c
M spursrc/vm/cointerp.c
M spursrc/vm/cointerp.h
M spursrc/vm/gcc3x-cointerp.c
M spurstack64src/vm/gcc3x-interp.c
M spurstack64src/vm/interp.c
M spurstacksrc/vm/gcc3x-interp.c
M spurstacksrc/vm/interp.c
M src/vm/cogit.h
M src/vm/cogitARMv5.c
M src/vm/cogitIA32.c
M src/vm/cogitMIPSEL.c
Log Message:
-----------
CogVM source as per VMMaker.oscogSPC-eem.2120
Temporary branch for SpurPlanningCompactor as default compactor.
SpurPlanningCompactor:
Get the transition from first to subsequent passes correct (scan starts at
firstMobileObject; previous pass must initialize, but not free the memory at
toFinger, and set firstFreeObject to this; all objects from firstFreeObject
to lastMobileObject must be unmarked to avoid copying them twice).
Optimize the three mobile passes to cache startOfPreviousPin since if there
are pins, most of the moves will occur under a pin.
Rename onePass to finalPass in them because this is what it really means.
Remove reliance on noMobileObjectsAfter:.
Simplify the termination condition for copyAndUnmarkMobileObjects by introducing
allOldSpaceEntitiesForCompactingFrom:to:do:. Replace freeFrom:upTo:previousPin:
with freeFrom:upTo:nextObject: cuz parsing the objects beyond the lastMobileObject
always needs a pointer to an object in the sequence.
freeFrom:upTo:nextObject: must respect the limit it is given and not free beyond
it. Doing so causes double freeing. It must guard against trying to free zero
bytes at the end of memory.
coaleseFrom: must take a start address, not an object.
unmarkObjectsAfterLastMobileObject must free unmarked objects.
updatePointersInObjectsOverflowingSavedFirstFieldsSpace must ignore unmarked
objects.
validRelocationPlanInPass: must be written just so to avoid an empty
savedFirstFieldsSpace causing unsigned integer overflow.
updateSavedFirstFieldsSpaceIfNecessary must not reset the free space carefully
built up by previous compaction passes.
SpurMemoryManager:
Fix a regression with classAtIndex:; it used to be inlined but the extra phrase
in the assert lifted it above the inlining level.
Make printOopsFrom:to: skip free space instead of printing an empty object every
16 bytes.
resetFreeLists should reset the freeListsMask! (old bug)
Have printFreeChunk:printAsTreeNode: print the address after for tree chunks.
Put a limit on valid class indices in the assert in classAtIndex:
Cogit:
Rename offsetCacheTagAndCouldBeObjectAt:annotation:into: to the more accurate
entryCacheTagAndCouldBeObjectAt:annotation:into: and extract
entryPointTagIsSelector: for use below.
Fix the check for valid selectors for 64-bits (unlinked cacheTags are
literal/specialSelector indices) in checkIfValidOopRefAndTarget:pc:cogMethod:.
Slang:
Don't localize globals that are used in only one function if they are only
written to. Such variables are typically for debugging (observation).
Commit: 192b9ddc4db5e3c952ad04d1ae4926876ee95844
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/192b9ddc4db5e3c952…
Author: Eliot Miranda <eliot.miranda(a)gmail.com>
Date: 2017-02-05 (Sun, 05 Feb 2017)
Changed paths:
M nsspur64src/vm/cogit.h
M nsspur64src/vm/cogitX64.c
M nsspur64src/vm/cointerp.c
M nsspur64src/vm/cointerp.h
M nsspur64src/vm/gcc3x-cointerp.c
M nsspursrc/vm/cogit.h
M nsspursrc/vm/cogitARMv5.c
M nsspursrc/vm/cogitIA32.c
M nsspursrc/vm/cogitMIPSEL.c
M nsspursrc/vm/cointerp.c
M nsspursrc/vm/cointerp.h
M nsspursrc/vm/gcc3x-cointerp.c
M nsspurstack64src/vm/gcc3x-interp.c
M nsspurstack64src/vm/interp.c
M nsspurstacksrc/vm/gcc3x-interp.c
M nsspurstacksrc/vm/interp.c
M spur64src/vm/cogit.h
M spur64src/vm/cogitX64.c
M spur64src/vm/cointerp.c
M spur64src/vm/cointerp.h
M spur64src/vm/gcc3x-cointerp.c
M spursista64src/vm/cogit.h
M spursista64src/vm/cogitX64.c
M spursista64src/vm/cointerp.c
M spursista64src/vm/cointerp.h
M spursista64src/vm/gcc3x-cointerp.c
M spursistasrc/vm/cogit.h
M spursistasrc/vm/cogitARMv5.c
M spursistasrc/vm/cogitIA32.c
M spursistasrc/vm/cogitMIPSEL.c
M spursistasrc/vm/cointerp.c
M spursistasrc/vm/cointerp.h
M spursistasrc/vm/gcc3x-cointerp.c
M spursrc/vm/cogit.h
M spursrc/vm/cogitARMv5.c
M spursrc/vm/cogitIA32.c
M spursrc/vm/cogitMIPSEL.c
M spursrc/vm/cointerp.c
M spursrc/vm/cointerp.h
M spursrc/vm/gcc3x-cointerp.c
M spurstack64src/vm/gcc3x-interp.c
M spurstack64src/vm/interp.c
M spurstacksrc/vm/gcc3x-interp.c
M spurstacksrc/vm/interp.c
Log Message:
-----------
CogVM source as per VMMaker.oscogSPC-eem.2121
Temporary branch for SpurPlanningCompactor as default compactor.
Fix a couple of typos that cause the generated C code to mis- or not compile.
Commit: 014bd126eeb734c24d0463f56a1b2c48070762d7
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/014bd126eeb734c24d…
Author: Eliot Miranda <eliot.miranda(a)gmail.com>
Date: 2017-02-06 (Mon, 06 Feb 2017)
Changed paths:
M nsspur64src/vm/cogit.h
M nsspur64src/vm/cointerp.c
M nsspur64src/vm/cointerp.h
M nsspur64src/vm/gcc3x-cointerp.c
M nsspursrc/vm/cogit.h
M nsspursrc/vm/cointerp.c
M nsspursrc/vm/cointerp.h
M nsspursrc/vm/gcc3x-cointerp.c
M nsspurstack64src/vm/gcc3x-interp.c
M nsspurstack64src/vm/interp.c
M nsspurstacksrc/vm/gcc3x-interp.c
M nsspurstacksrc/vm/interp.c
M spur64src/vm/cogit.h
M spur64src/vm/cointerp.c
M spur64src/vm/cointerp.h
M spur64src/vm/gcc3x-cointerp.c
M spursista64src/vm/cogit.h
M spursista64src/vm/cointerp.c
M spursista64src/vm/cointerp.h
M spursista64src/vm/gcc3x-cointerp.c
M spursistasrc/vm/cogit.h
M spursistasrc/vm/cointerp.c
M spursistasrc/vm/cointerp.h
M spursistasrc/vm/gcc3x-cointerp.c
M spursrc/vm/cogit.h
M spursrc/vm/cointerp.c
M spursrc/vm/cointerp.h
M spursrc/vm/gcc3x-cointerp.c
M spurstack64src/vm/gcc3x-interp.c
M spurstack64src/vm/interp.c
M spurstacksrc/vm/gcc3x-interp.c
M spurstacksrc/vm/interp.c
M src/vm/cointerp.c
M src/vm/cointerp.h
M src/vm/cointerpmt.c
M src/vm/cointerpmt.h
M src/vm/gcc3x-cointerp.c
M src/vm/gcc3x-cointerpmt.c
M stacksrc/vm/gcc3x-interp.c
M stacksrc/vm/interp.c
Log Message:
-----------
CogVM source as per VMMaker.oscogSPC-eem.2122
SpurPlanningCompactor:
Fix compaction with a fully compacted heap (lastMobileObject may be nil).
SpurMemoryManager:
add a VM parameter to collect the time spent in compaction (a subset of the time
spent in fullGC).
The system now holds up while rnning the Squeak test suite.
Compare: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/3689748e3dd6...01…
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscogSPC-eem.2122.mcz
==================== Summary ====================
Name: VMMaker.oscogSPC-eem.2122
Author: eem
Time: 6 February 2017, 12:50:07.26467 pm
UUID: a8c5aec3-0d43-42c4-911a-2d8c8cb6edef
Ancestors: VMMaker.oscogSPC-eem.2121
SpurPlanningCompactor:
Fix compaction with a fully compacted heap (lastMobileObject may be nil).
SpurMemoryManager:
add a VM parameter to collect the time spent in compaction (a subset of the time spent in fullGC).
The system now holds up while rnning the Squeak test suite.
=============== Diff against VMMaker.oscogSPC-eem.2121 ===============
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was changed:
----- Method: SpurMemoryManager>>fullGC (in category 'gc - global') -----
fullGC
"Perform a full lazy compacting GC. Answer the size of the largest free chunk."
<returnTypeC: #usqLong>
<inline: #never> "for profiling"
needGCFlag := false.
+ gcStartUsecs := coInterpreter ioUTCMicrosecondsNow.
- gcStartUsecs := self ioUTCMicrosecondsNow.
statMarkCount := 0.
coInterpreter preGCAction: GCModeFull.
self globalGarbageCollect.
coInterpreter postGCAction: GCModeFull.
statFullGCs := statFullGCs + 1.
+ statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow.
- statGCEndUsecs := self ioUTCMicrosecondsNow.
statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs).
+ statCompactionUsecs := statCompactionUsecs + (statGCEndUsecs - compactionStartUsecs).
^(freeLists at: 0) ~= 0
ifTrue: [self bytesInObject: self findLargestFreeChunk]
ifFalse: [0]!
Item was changed:
----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
globalGarbageCollect
<inline: true> "inline into fullGC"
self assert: self validObjStacks.
self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
"Mark objects /before/ scavenging, to empty the rememberedTable of unmarked roots."
self markObjects: true.
scavenger forgetUnmarkedRememberedObjects.
self doScavenge: MarkOnTenure.
"Mid-way the leak check must be more lenient. Unmarked classes will have been
expunged from the table, but unmarked instances will not yet have been reclaimed."
self runLeakCheckerFor: GCModeFull
excludeUnmarkedObjs: true
classIndicesShouldBeValid: true.
+ compactionStartUsecs := coInterpreter ioUTCMicrosecondsNow.
segmentManager prepareForGlobalSweep. "for notePinned:"
compactor compact.
self attemptToShrink.
self setHeapSizeAtPreviousGC.
self assert: self validObjStacks.
self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
self assert: self allObjectsUnmarked.
self runLeakCheckerFor: GCModeFull!
Item was changed:
----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
initialize
"We can put all initializations that set something to 0 or to false here.
In C all global variables are initialized to 0, and 0 is false."
remapBuffer := Array new: RemapBufferSize.
remapBufferCount := extraRootCount := 0. "see below"
freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
checkForLeaks := 0.
needGCFlag := signalLowSpace := marking := false.
becomeEffectsFlags := gcPhaseInProgress := 0.
statScavenges := statIncrGCs := statFullGCs := 0.
+ statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statCompactionUsecs := statGCEndUsecs := 0.
- statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0.
statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
statGrowMemory := statShrinkMemory := statRootTableCount := 0.
statRootTableOverflows := statMarkCount := statCompactPassCount := statCoalesces := 0.
"We can initialize things that are allocated but are lazily initialized."
unscannedEphemerons := SpurContiguousObjStack new.
"we can initialize things that are virtual in C."
scavenger := SpurGenerationScavenger simulatorClass new manager: self; yourself.
segmentManager := SpurSegmentManager simulatorClass new manager: self; yourself.
compactor := self class compactorClass simulatorClass new manager: self; yourself.
"We can also initialize here anything that is only for simulation."
heapMap := CogCheck32BitHeapMap new.
"N.B. We *don't* initialize extraRoots because we don't simulate it."
maxOldSpaceSize := self class initializationOptions
ifNotNil: [:initOpts| initOpts at: #maxOldSpaceSize ifAbsent: [0]]
ifNil: [0]!
Item was added:
+ ----- Method: SpurMemoryManager>>statCompactionUsecs (in category 'accessing') -----
+ statCompactionUsecs
+ ^statCompactionUsecs!
Item was changed:
----- Method: SpurPlanningCompactor>>compact (in category 'compaction - api') -----
compact
"Sweep all of old space, sliding unpinned marked objects down over free and unmarked objects.
Let the segmentManager mark which segments contain pinned objects via notePinned:."
| finalPass firstPass |
<inline: #never> "for profiling"
self initializeScanCheckingForFullyCompactedHeap ifTrue:
[^self unmarkObjectsInFullyCompactedHeap].
self initializeCompaction.
firstPass := true.
[finalPass := self planCompactSavingForwarders.
self assert: (self validRelocationPlanInPass: finalPass) = 0.
- objectAfterLastMobileObject := manager oldSpaceObjectAfter: lastMobileObject.
self updatePointers.
self copyAndUnmark: firstPass.
"Would like to check here, but can't if multi-pass."
false ifTrue: [manager checkFreeSpace: GCModeFull].
"Currently we do only a single pass if a normal GC, assuming that a pass will
always compact plenty of space. But we should perhaps check this assumption
by looking at the large free tree and seeing that the ratio of the largest free
chunk to the total ammount of free space is high."
finalPass or: [biasForGC]] whileFalse:
[firstPass := false.
self reinitializeScanFrom: firstFreeObject;
updateSavedFirstFieldsSpaceIfNecessary].
manager checkFreeSpace: GCModeFull.
self endCompaction!
Item was changed:
----- Method: SpurPlanningCompactor>>copyAndUnmark: (in category 'compaction') -----
copyAndUnmark: firstPass
"Sweep the heap, unmarking all objects and moving mobile objects to their correct positions,
restoring their savedFirstFields."
<inline: #never>
| finalPass |
self logPhase: 'copying and unmarking...'.
firstPass ifTrue:
[self unmarkInitialImmobileObjects].
- "If savedFirstFieldsSpace is empty there is nothing to move, and no second pass."
- savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue:
- [self assert: ((self oop: firstMobileObject isGreaterThanOrEqualTo: manager endOfMemory)
- or: [lastMobileObject < firstMobileObject]).
- ^self].
finalPass := self copyAndUnmarkMobileObjects.
+ (self thereAreObjectsToMove
+ and: [finalPass not
+ and: [biasForGC]]) ifTrue: "only ever one pass if biasForGC is true."
- (finalPass not and: [biasForGC]) ifTrue: "only ever one pass if biasForGC is true."
[self unmarkObjectsAfterLastMobileObject]!
Item was changed:
----- Method: SpurPlanningCompactor>>copyAndUnmarkMobileObjects (in category 'compaction') -----
copyAndUnmarkMobileObjects
"Sweep the mobile portion of the heap, moving objects to their eventual locations, and clearing their marked bits.
Remember to update the savedFirstFields of pointer objects, as these have been forwarded.
Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed).
The enumerations in planCompactSavingForwarders, updatePointersInMobileObjects and copyAndUnmarkMobileObjects
match. We could implement them as a single enumeration method taking several block arguments, but arguably that
would make understanding an already tricky algorithm more difficult. Instead we tolerate the duplication and encourage
the reader to diff the three methods to see where they diverge (e.g. via Cmd-shift-C)."
<inline: #never>
| toFinger top previousPin startOfPreviousPin |
<var: 'o' type: #usqInt>
<var: 'top' type: #usqInt>
<var: 'toFinger' type: #usqInt>
<var: 'previousPin' type: #usqInt>
<var: 'startOfPreviousPin' type: #usqInt>
self deny: (manager isMarked: firstFreeObject).
toFinger := manager startOfObject: firstFreeObject.
top := savedFirstFieldsSpace start.
startOfPreviousPin := 0.
+ manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject to: (lastMobileObject ifNil: manager nilObject) do:
- manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject to: lastMobileObject do:
[:o :n|
self check: o.
self assert: (previousPin
ifNil: [toFinger <= (manager startOfObject: o)]
ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= startOfPreviousPin]]).
self assert: (savedFirstFieldsSpaceNotInOldSpace or: [toFinger < top]).
(manager isMarked: o) ifTrue:
[(manager isPinned: o)
ifTrue:
[previousPin ifNil:
[previousPin := o. startOfPreviousPin := manager startOfObject: o]]
ifFalse:
[| availableSpace bytes |
bytes := manager bytesInObject: o.
[toFinger <= startOfPreviousPin
and: [bytes ~= (availableSpace := startOfPreviousPin - toFinger)
and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue:
["The object does not fit in the space between toFinger and previousPin.
Move toFinger up to point at the first unmarked or mobile object after
previousPin, or, if previousPin is contiguous with o, to the start of this
object. Update previousPin to be the next pinned object above toFInger
and below this object, or nil if no such pinned object exists.
Any unfillable gaps between adjacent pinned objects will be freed."
availableSpace > 0 ifTrue:
[manager addFreeChunkWithBytes: availableSpace at: toFinger].
[self assert: ((manager isMarked: previousPin) and: [manager isPinned: previousPin]).
self unmarkPinned: previousPin.
toFinger := manager addressAfter: previousPin.
previousPin := manager objectStartingAt: toFinger.
(manager isMarked: previousPin)
and: [(manager isPinned: previousPin)
and: [previousPin < o]]]
whileTrue.
"Now previousPin is either equal to o or mobile.
Move it to the next pinned object below o"
[previousPin >= o
or: [(manager isMarked: previousPin)
and: [manager isPinned: previousPin]]] whileFalse:
[previousPin := manager oldSpaceObjectAfter: previousPin].
previousPin >= o
ifTrue: [previousPin := nil. startOfPreviousPin := 0]
ifFalse: [startOfPreviousPin := manager startOfObject: previousPin]].
self copyAndUnmarkObject: o to: toFinger bytes: bytes firstField: (manager longAt: top).
toFinger := toFinger + bytes.
(top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
[self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop).
self assert: n = objectAfterLastMobileObject.
previousPin ifNil: [previousPin := n. startOfPreviousPin := manager startOfObject: n].
"Create a free object for firstFreeObject to be set to on the next pass, but
do not link it into the free tree as it will be written over in that next pass."
toFinger < startOfPreviousPin
ifTrue:
[firstFreeObject := manager initFreeChunkWithBytes: startOfPreviousPin - toFinger at: toFinger]
ifFalse:
[firstFreeObject := previousPin].
^false]]]].
+ self freeFrom: toFinger upTo: manager endOfMemory nextObject: (previousPin ifNil: [objectAfterLastMobileObject ifNil: [manager objectAfter: firstFreeObject]]).
- self freeFrom: toFinger upTo: manager endOfMemory nextObject: (previousPin ifNil: [objectAfterLastMobileObject]).
self coalesceFrom: toFinger.
^true!
Item was changed:
----- Method: SpurPlanningCompactor>>planCompactSavingForwarders (in category 'compaction') -----
planCompactSavingForwarders
"Sweep the heap from firstFreeObject forwarding marked objects to where they
can be moved to, saving their forwarding pointer in savedFirstFieldsSpace.
Continue until either the end of the heap is reached or savedFirstFieldsSpace is full.
Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed).
The enumerations in planCompactSavingForwarders, updatePointersInMobileObjects and copyAndUnmarkMobileObjects
match. We could implement them as a single enumeration method taking several block arguments, but arguably that
would make understanding an already tricky algorithm more difficult. Instead we tolerate the duplication and encourage
the reader to diff the three methods to see where they diverge (e.g. via Cmd-shift-C)."
<inline: #never>
| toFinger top previousPin startOfPreviousPin |
<var: 'o' type: #usqInt>
<var: 'top' type: #usqInt>
<var: 'toFinger' type: #usqInt>
<var: 'previousPin' type: #usqInt>
<var: 'startOfPreviousPin' type: #usqInt>
savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue:
[self logPhase: 'planning...'].
self deny: (manager isMarked: firstFreeObject).
toFinger := manager startOfObject: firstFreeObject.
top := savedFirstFieldsSpace start.
startOfPreviousPin := 0.
manager allOldSpaceEntitiesFrom: firstFreeObject do:
[:o|
self check: o.
self assert: (previousPin
ifNil: [toFinger <= (manager startOfObject: o)]
ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= startOfPreviousPin]]).
self assert: (savedFirstFieldsSpaceNotInOldSpace or: [toFinger < top]).
(manager isMarked: o) ifTrue:
[(manager isPinned: o)
ifTrue:
[previousPin ifNil:
[previousPin := o. startOfPreviousPin := manager startOfObject: o]]
ifFalse:
[| availableSpace bytes |
bytes := manager bytesInObject: o.
[toFinger <= startOfPreviousPin
and: [bytes ~= (availableSpace := startOfPreviousPin - toFinger)
and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue:
["The object does not fit in the space between toFinger and previousPin.
Move toFinger up to point at the first unmarked or mobile object after
previousPin, or, if previousPin is contiguous with o, to the start of this
object. Update previousPin to be the next pinned object above toFInger
and below this object, or nil if no such pinned object exists.
Any unfillable gaps between adjacent pinned objects will be freed."
[toFinger := manager addressAfter: previousPin.
previousPin := manager objectStartingAt: toFinger.
(manager isMarked: previousPin)
and: [(manager isPinned: previousPin)
and: [previousPin < o]]]
whileTrue.
"Now previousPin is either equal to o or mobile.
Move it to the next pinned object below o"
[previousPin >= o
or: [(manager isMarked: previousPin)
and: [manager isPinned: previousPin]]] whileFalse:
[previousPin := manager oldSpaceObjectAfter: previousPin].
previousPin >= o
ifTrue: [previousPin := nil. startOfPreviousPin := 0]
ifFalse: [startOfPreviousPin := manager startOfObject: previousPin]].
self forwardMobileObject: o to: toFinger savedFirstFieldPtr: top.
toFinger := toFinger + bytes.
(top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
[savedFirstFieldsSpace top: top - manager bytesPerOop.
+ objectAfterLastMobileObject := manager oldSpaceObjectAfter: lastMobileObject.
^false]]]].
+ "If the heap is already fully compacted there will be no lastMobileObject..."
+ lastMobileObject ifNotNil:
+ [savedFirstFieldsSpace top: top - manager bytesPerOop.
+ objectAfterLastMobileObject := manager oldSpaceObjectAfter: lastMobileObject].
- savedFirstFieldsSpace top: top - manager bytesPerOop.
^true!
Item was added:
+ ----- Method: SpurPlanningCompactor>>thereAreObjectsToMove (in category 'private') -----
+ thereAreObjectsToMove
+ <inline: true>
+ ^lastMobileObject notNil!
Item was changed:
----- Method: SpurPlanningCompactor>>updatePointers (in category 'compaction') -----
updatePointers
"Sweep the heap, updating all objects to their eventual locations.
Remember to update the savedFirstFields of pointer objects, as these have been forwarded."
<inline: #never>
| onePass |
self logPhase: 'updating pointers...'.
+ self thereAreObjectsToMove ifFalse:
- "If savedFirstFieldsSpace is empty there is nothing to do."
- savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue:
[^self].
self assert: (manager startOfObject: firstFreeObject) = mobileStart.
coInterpreter mapInterpreterOops.
manager mapExtraRoots.
self updatePointersInManagerHeapEntities.
self updatePointersInSurvivingObjects.
self updatePointersInInitialImmobileObjects.
onePass := self updatePointersInMobileObjects.
onePass ifFalse:
[self updatePointersInObjectsOverflowingSavedFirstFieldsSpace]!
Item was changed:
+ LongTestCase subclass: #SpurPlanningCompactorTests
- TestCase subclass: #SpurPlanningCompactorTests
instanceVariableNames: ''
classVariableNames: ''
+ poolDictionaries: 'VMBasicConstants VMSqueakClassIndices'
- poolDictionaries: 'VMSqueakClassIndices'
category: 'VMMaker-Tests'!
Item was added:
+ ----- Method: SpurPlanningCompactorTests>>checkForLeaksIn: (in category 'private') -----
+ checkForLeaksIn: om
+ om setCheckForLeaks: GCModeFreeSpace + GCModeFull;
+ runLeakCheckerFor: GCModeFull;
+ checkFreeSpace: GCModeFull!
Item was added:
+ ----- Method: SpurPlanningCompactorTests>>expectedFailures (in category 'failures') -----
+ expectedFailures
+ ^(FileDirectory default fileExists: self class imageNameForTests)
+ ifTrue: [#()]
+ ifFalse: [self testSelectors]!
Item was changed:
----- Method: SpurPlanningCompactorTests>>testCompactedHeap (in category 'tests') -----
testCompactedHeap
"First test for valid compactibility of an already compacted heap via fullGC"
| freeSpace om |
om := self initializedVM objectMemory.
freeSpace := om bytesLeftInOldSpace.
om fullGC.
+ self assert: freeSpace equals: om bytesLeftInOldSpace.
+ self checkForLeaksIn: om.
+ om fullGC.
+ self assert: freeSpace equals: om bytesLeftInOldSpace.
+ self checkForLeaksIn: om!
- self assert: freeSpace equals: om bytesLeftInOldSpace!
Item was added:
+ ----- Method: SpurPlanningCompactorTests>>testInitializedVM (in category 'tests') -----
+ testInitializedVM
+ self checkForLeaksIn: self initializedVM objectMemory!
Item was changed:
----- Method: SpurPlanningCompactorTests>>testRandomAssortment:with: (in category 'private') -----
testRandomAssortment: random with: theVM
"Test that the compactor can handle a random assortment of live, pinned, dead, and free chunks."
| om lastObj obj expectedFreeSpace liveFill pinFill liveCount pinCount totalLive totalPinned pinned |
random reset. "random is a read stream on 3000 random numbers; for repeatability"
om := theVM objectMemory.
om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true. lastObj := o].
pinFill := 16r99999900.
liveFill := 16r55AA0000.
liveCount := pinCount := expectedFreeSpace := 0.
pinned := Set new.
1000 timesRepeat:
[| nSlots next newObj |
nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory."
+ newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassByteArrayCompactIndex.
- newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
(next := random next) > 0.95
ifTrue: "pinned"
[om
fillObj: newObj numSlots: nSlots with: pinFill + (pinCount := pinCount + 1);
setIsPinnedOf: newObj to: true]
ifFalse: "mobile"
[om
fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1)].
(next := random next) >= 0.333
ifTrue:
[om setIsMarkedOf: newObj to: true.
(om isPinned: newObj) ifTrue:
[pinned add: newObj]]
ifFalse: "dead or free"
[expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj).
(om isPinned: newObj) "Must check /before/ setObjectFree: which clears all bits"
ifTrue: [pinCount := pinCount - 1]
ifFalse: [liveCount := liveCount - 1].
next >= 0.2
ifTrue: [om setIsMarkedOf: newObj to: false]
ifFalse: [om setObjectFree: newObj]]].
totalPinned := pinCount.
totalLive := liveCount.
self assert: totalPinned < (totalPinned + totalLive / 10). "should average 5%"
"useful pre-compaction printing:"
false ifTrue:
[liveCount := pinCount := 0.
om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
[:o|
om coInterpreter print:
((om isMarked: o)
ifTrue: [(((om isPinned: o)
ifTrue: [pinCount := pinCount + 1]
ifFalse: [liveCount := liveCount + 1])
printPaddedWith: Character space to: 3 base: 10), ' ']
ifFalse: [' ']).
om printEntity: o].
om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
[:o|
((om isMarked: o) and: [om isPinned: o]) ifTrue:
[om printEntity: o]]].
expectedFreeSpace := expectedFreeSpace + om bytesLeftInOldSpace.
om compactor compact.
self assert: expectedFreeSpace equals: om bytesLeftInOldSpace.
self assert: om allObjectsUnmarked.
"useful post-compaction printing:"
false ifTrue:
[liveCount := pinCount := 0.
om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
[:o|
om coInterpreter print:
((om isFreeObject: o)
ifFalse: [(((om isPinned: o)
ifTrue: [pinCount := pinCount + 1]
ifFalse: [liveCount := liveCount + 1])
printPaddedWith: Character space to: 3 base: 10), ' ']
ifTrue: [' ']).
om printEntity: o].
om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
[:o|
(om isPinned: o) ifTrue:
[om printEntity: o]]].
"First check and/or count populations..."
liveCount := pinCount := 0.
om allOldSpaceObjectsFrom: (om objectAfter: lastObj) do:
[:o|
(om isPinned: o)
ifTrue:
[pinCount := pinCount + 1.
self assert: (pinned includes: o)]
ifFalse: [liveCount := liveCount + 1]].
self assert: totalPinned equals: pinCount.
self assert: totalLive equals: liveCount.
"Now check fills, which also tests update of first field on move..."
liveCount := pinCount := 0.
obj := lastObj.
1 to: totalLive + totalPinned do:
[:n| | expectedFill actualFill |
[obj := om objectAfter: obj. (om isEnumerableObject: obj) or: [obj >= om endOfMemory]] whileFalse.
expectedFill := (om isPinned: obj)
ifTrue: [pinFill + (pinCount := pinCount + 1)]
ifFalse: [liveFill + (liveCount := liveCount + 1)].
1 to: (om numSlotsOf: obj) do:
[:i| self assert: expectedFill equals: (actualFill := om fetchPointer: i - 1 ofObject: obj)]].
"They should be the last objects..."
self assert: (om isFreeObject: (om objectAfter: obj)).
+ self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: obj)).
+ self checkForLeaksIn: om!
- self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: obj))!
Item was changed:
----- Method: SpurPlanningCompactorTests>>testRandomAssortmentWithNewSegment:with: (in category 'private') -----
testRandomAssortmentWithNewSegment: random with: theVM
"Test that the compactor can handle a random assortment of live, pinned, dead, and free chunks,
with some allocation in a new segment. No live pinned objects are created in the new segment
to obtain the situation that the last segment is entirely empty after compaction. This tests shrinkage."
| om pig lastObj obj expectedFreeSpace liveFill pinFill liveCount pinCount totalLive totalPinned pinned |
random reset. "random is a read stream on 3000 random numbers; for repeatability"
om := theVM objectMemory.
om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true. lastObj := o].
pinFill := 16r99999900.
liveFill := 16r55AA0000.
liveCount := pinCount := expectedFreeSpace := 0.
pinned := Set new.
1000 timesRepeat:
[| nSlots next newObj |
nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory."
+ newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassByteArrayCompactIndex.
- newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
(next := random next) > 0.95
ifTrue: "pinned"
[om
fillObj: newObj numSlots: nSlots with: pinFill + (pinCount := pinCount + 1);
setIsPinnedOf: newObj to: true]
ifFalse: "mobile"
[om
fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1)].
(next := random next) >= 0.333
ifTrue:
[om setIsMarkedOf: newObj to: true.
(om isPinned: newObj) ifTrue:
[pinned add: newObj]]
ifFalse: "dead or free"
[expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj).
(om isPinned: newObj) "Must check /before/ setObjectFree: which clears all bits"
ifTrue: [pinCount := pinCount - 1]
ifFalse: [liveCount := liveCount - 1].
next >= 0.2
ifTrue: [om setIsMarkedOf: newObj to: false]
ifFalse: [om setObjectFree: newObj]]].
+ pig := om allocateSlotsInOldSpace: (om numSlotsOfAny: om findLargestFreeChunk) format: om firstLongFormat classIndex: ClassByteArrayCompactIndex.
- pig := om allocateSlotsInOldSpace: (om numSlotsOfAny: om findLargestFreeChunk) format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
self deny: pig isNil.
self assert: 0 equals: om bytesLeftInOldSpace.
om growOldSpaceByAtLeast: om growHeadroom // 2.
self assert: om growHeadroom equals: om bytesLeftInOldSpace + om bridgeSize.
expectedFreeSpace := expectedFreeSpace + (om bytesInObject: pig).
1000 timesRepeat:
[| nSlots next newObj |
nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory."
+ newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassByteArrayCompactIndex.
- newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
"No pinned objects in second segment."
om fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1).
(next := random next) >= 0.333
ifTrue:
[om setIsMarkedOf: newObj to: true.
(om isPinned: newObj) ifTrue:
[pinned add: newObj]]
ifFalse: "dead or free"
[expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj).
liveCount := liveCount - 1.
next >= 0.2
ifTrue: [om setIsMarkedOf: newObj to: false]
ifFalse: [om setObjectFree: newObj]]].
totalPinned := pinCount.
totalLive := liveCount.
self assert: totalPinned < (totalPinned + totalLive / 20). "should average 2.5%"
"useful pre-compaction printing:"
false ifTrue:
[liveCount := pinCount := 0.
om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
[:o|
om coInterpreter print:
((om isMarked: o)
ifTrue: [(((om isPinned: o)
ifTrue: [pinCount := pinCount + 1]
ifFalse: [liveCount := liveCount + 1])
printPaddedWith: Character space to: 3 base: 10), ' ']
ifFalse: [' ']).
om printEntity: o].
om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
[:o|
((om isMarked: o) and: [om isPinned: o]) ifTrue:
[om printEntity: o]]].
expectedFreeSpace := expectedFreeSpace + om bytesLeftInOldSpace.
om compactor compact.
self assert: expectedFreeSpace equals: om bytesLeftInOldSpace.
self assert: om allObjectsUnmarked.
"useful post-compaction printing:"
false ifTrue:
[liveCount := pinCount := 0.
om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
[:o|
om coInterpreter print:
((om isFreeObject: o)
ifFalse: [(((om isPinned: o)
ifTrue: [pinCount := pinCount + 1]
ifFalse: [liveCount := liveCount + 1])
printPaddedWith: Character space to: 3 base: 10), ' ']
ifTrue: [' ']).
om printEntity: o].
om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
[:o|
(om isPinned: o) ifTrue:
[om printEntity: o]]].
"First check and/or count populations..."
liveCount := pinCount := 0.
om allOldSpaceObjectsFrom: (om objectAfter: lastObj) do:
[:o|
(om isPinned: o)
ifTrue:
[pinCount := pinCount + 1.
self assert: (pinned includes: o)]
ifFalse: [liveCount := liveCount + 1]].
self assert: totalPinned equals: pinCount.
self assert: totalLive equals: liveCount.
"Now check fills, which also tests update of first field on move..."
liveCount := pinCount := 0.
obj := lastObj.
1 to: totalLive + totalPinned do:
[:n| | expectedFill actualFill |
[obj := om objectAfter: obj. (om isEnumerableObject: obj) or: [obj >= om endOfMemory]] whileFalse.
expectedFill := (om isPinned: obj)
ifTrue: [pinFill + (pinCount := pinCount + 1)]
ifFalse: [liveFill + (liveCount := liveCount + 1)].
1 to: (om numSlotsOf: obj) do:
[:i| self assert: expectedFill equals: (actualFill := om fetchPointer: i - 1 ofObject: obj)]].
"the Last segment should be empty"
self assert: (om segmentManager isEmptySegment: (om segmentManager segments at: 1)).
"They should be the last objects, followed by a free object to the end fo the first segment, a bridge, then an empty segment with a single free object in it."
self assert: (om isFreeObject: (om objectAfter: obj)).
self assert: (om isSegmentBridge: (om objectAfter: (om objectAfter: obj))).
self assert: (om isFreeObject: (om objectAfter: (om objectAfter: (om objectAfter: obj)))).
self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: (om objectAfter: (om objectAfter: obj)))).
"And the memory should shrink if the shrinkThreshold is low enough"
om shrinkThreshold: om growHeadroom.
om attemptToShrink.
+ self assert: om segmentManager numSegments = 1.
+ self checkForLeaksIn: om!
- self assert: om segmentManager numSegments = 1!
Item was added:
+ ----- Method: SpurPlanningCompactorTestsImageResource>>reset (in category 'accessing') -----
+ reset
+ "self current reset"
+ emptyVM := nil!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveVMParameter (in category 'system control primitives') -----
(excessive size, no diff calculated)
1
0